Compare commits
106
Commits
zipfs
...
unwanted-commit
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
200e2e211e | ||
|
|
c5bbe85f29 | ||
|
|
bea160e7f6 | ||
|
|
a0c7ff582a | ||
|
|
b3dceb5360 | ||
|
|
4c1c62892a | ||
|
|
434a115a3c | ||
|
|
74707353e8 | ||
|
|
538c6791ab | ||
|
|
22a5d73ebf | ||
|
|
ce6023fade | ||
|
|
4e9742386c | ||
|
|
030a749dc8 | ||
|
|
2f4c1aecdb | ||
|
|
1ff54c600e | ||
|
|
1337738c22 | ||
|
|
96b9e6e871 | ||
|
|
52c009322f | ||
|
|
016dc0c5f0 | ||
|
|
97ed5b117d | ||
|
|
fbc8feeb40 | ||
|
|
5f392f74b6 | ||
|
|
fef802ea7a | ||
|
|
d7a697aa50 | ||
|
|
9654f8c692 | ||
|
|
125b29bfe3 | ||
|
|
c69ccc749e | ||
|
|
983b95bdbd | ||
|
|
49cd80a29d | ||
|
|
c201290179 | ||
|
|
0c78f5bbad | ||
|
|
2e0a0b5305 | ||
|
|
1caba8a761 | ||
|
|
6efd8f71f2 | ||
|
|
e5cf3448bd | ||
|
|
ea29292705 | ||
|
|
d32d625787 | ||
|
|
49aba3d99e | ||
|
|
09446c7544 | ||
|
|
8a4ad6884b | ||
|
|
2021349249 | ||
|
|
6b0dccd9d5 | ||
|
|
e006418946 | ||
|
|
2881b5c3df | ||
|
|
e0209e39ea | ||
|
|
e1196c53f2 | ||
|
|
56b431c4c2 | ||
|
|
ac4291f473 | ||
|
|
bbdb1f12a0 | ||
|
|
f9a4d9f781 | ||
|
|
1a664df87f | ||
|
|
cc4dae5c0f | ||
|
|
8985ee2114 | ||
|
|
85aac3aef7 | ||
|
|
c3c71b5f3c | ||
|
|
9feb8b7c29 | ||
|
|
50a1375461 | ||
|
|
3d5f129cb0 | ||
|
|
6cdb3193ec | ||
|
|
bf46b6a1da | ||
|
|
d5583552c0 | ||
|
|
338b9ec9d2 | ||
|
|
6d3aeef45e | ||
|
|
63ef0e3d26 | ||
|
|
39318d91b7 | ||
|
|
d24a3eb2ba | ||
|
|
cdce5491b3 | ||
|
|
9a15a1b586 | ||
|
|
95db69f27b | ||
|
|
e80eaec4d3 | ||
|
|
b9577c0641 | ||
|
|
754bb107b4 | ||
|
|
227db01958 | ||
|
|
41954059c4 | ||
|
|
b169c964e6 | ||
|
|
3771e638b0 | ||
|
|
4588d7300e | ||
|
|
d690b84738 | ||
|
|
6bc8c27b7f | ||
|
|
6a58a0cab2 | ||
|
|
1357172367 | ||
|
|
466fd1d930 | ||
|
|
441e4f6796 | ||
|
|
3117af219f | ||
|
|
a0e1b18138 | ||
|
|
70af5c2b82 | ||
|
|
d38ae8f974 | ||
|
|
0d887fa465 | ||
|
|
e9bb0992b0 | ||
|
|
f35c0dc2ed | ||
|
|
e80e214673 | ||
|
|
731f40c6d9 | ||
|
|
767cf6314a | ||
|
|
b00317d174 | ||
|
|
a8408767a4 | ||
|
|
4f8b177250 | ||
|
|
25aad1ab18 | ||
|
|
3b48db4a90 | ||
|
|
58eff8f224 | ||
|
|
97721e9675 | ||
|
|
d88d33f74d | ||
|
|
0a9706f48f | ||
|
|
45f91441a5 | ||
|
|
38781266d3 | ||
|
|
843d29b448 | ||
|
|
1a73baff09 |
+236
@@ -0,0 +1,236 @@
|
||||
dist: trusty
|
||||
sudo: false
|
||||
language: c
|
||||
matrix:
|
||||
include:
|
||||
- os: linux
|
||||
compiler: clang
|
||||
env:
|
||||
- MATRIX_EVAL="" BUILD_DIR=unix
|
||||
- os: linux
|
||||
compiler: clang
|
||||
env:
|
||||
- MATRIX_EVAL="" BUILD_DIR=unix CFGOPT=--disable-shared
|
||||
- os: linux
|
||||
compiler: gcc
|
||||
env:
|
||||
- MATRIX_EVAL="" BUILD_DIR=unix
|
||||
- os: linux
|
||||
compiler: gcc
|
||||
env:
|
||||
- MATRIX_EVAL="" BUILD_DIR=unix CFGOPT=--disable-shared
|
||||
- os: linux
|
||||
compiler: gcc
|
||||
addons:
|
||||
apt:
|
||||
sources:
|
||||
- ubuntu-toolchain-r-test
|
||||
packages:
|
||||
- g++-4.9
|
||||
env:
|
||||
- MATRIX_EVAL="CC=gcc-4.9" BUILD_DIR=unix
|
||||
- os: linux
|
||||
compiler: gcc
|
||||
addons:
|
||||
apt:
|
||||
sources:
|
||||
- ubuntu-toolchain-r-test
|
||||
packages:
|
||||
- g++-5
|
||||
env:
|
||||
- MATRIX_EVAL="CC=gcc-5" BUILD_DIR=unix
|
||||
- os: linux
|
||||
compiler: gcc
|
||||
addons:
|
||||
apt:
|
||||
sources:
|
||||
- ubuntu-toolchain-r-test
|
||||
packages:
|
||||
- g++-6
|
||||
env:
|
||||
- MATRIX_EVAL="CC=gcc-6" BUILD_DIR=unix
|
||||
- os: linux
|
||||
compiler: gcc
|
||||
addons:
|
||||
apt:
|
||||
sources:
|
||||
- ubuntu-toolchain-r-test
|
||||
packages:
|
||||
- g++-7
|
||||
env:
|
||||
- MATRIX_EVAL="CC=gcc-7" BUILD_DIR=unix
|
||||
- os: osx
|
||||
osx_image: xcode8
|
||||
env:
|
||||
- MATRIX_EVAL="" BUILD_DIR=unix
|
||||
- os: osx
|
||||
osx_image: xcode8
|
||||
env:
|
||||
- MATRIX_EVAL="" BUILD_DIR=macosx NO_DIRECT_CONFIGURE=1
|
||||
- os: osx
|
||||
osx_image: xcode9
|
||||
env:
|
||||
- MATRIX_EVAL="" BUILD_DIR=macosx NO_DIRECT_CONFIGURE=1
|
||||
- os: osx
|
||||
osx_image: xcode10
|
||||
env:
|
||||
- MATRIX_EVAL="" BUILD_DIR=macosx NO_DIRECT_CONFIGURE=1
|
||||
### C builds not currently supported on Windows instances
|
||||
# - os: windows
|
||||
# env:
|
||||
# - MATRIX_EVAL="" BUILD_DIR=win
|
||||
|
||||
before_install:
|
||||
- eval "${MATRIX_EVAL}"
|
||||
- export ERROR_ON_FAILURES=1
|
||||
- cd ${BUILD_DIR}
|
||||
install:
|
||||
- test -n "$NO_DIRECT_CONFIGURE" || ./configure ${CFGOPT}
|
||||
script:
|
||||
- make
|
||||
- make test
|
||||
dist: trusty
|
||||
sudo: false
|
||||
language: c
|
||||
matrix:
|
||||
include:
|
||||
- os: linux
|
||||
compiler: clang
|
||||
env:
|
||||
- MATRIX_EVAL=""
|
||||
- BUILD_DIR=unix
|
||||
- os: linux
|
||||
compiler: clang
|
||||
env:
|
||||
- MATRIX_EVAL=""
|
||||
- BUILD_DIR=unix
|
||||
- CFGOPT=--disable-shared
|
||||
- os: linux
|
||||
compiler: gcc
|
||||
env:
|
||||
- MATRIX_EVAL=""
|
||||
- BUILD_DIR=unix
|
||||
- os: linux
|
||||
compiler: gcc
|
||||
env:
|
||||
- MATRIX_EVAL=""
|
||||
- BUILD_DIR=unix
|
||||
- CFGOPT=--disable-shared
|
||||
- os: linux
|
||||
compiler: gcc
|
||||
addons:
|
||||
apt:
|
||||
sources:
|
||||
- ubuntu-toolchain-r-test
|
||||
packages:
|
||||
- g++-4.9
|
||||
env:
|
||||
- MATRIX_EVAL="CC=gcc-4.9"
|
||||
- BUILD_DIR=unix
|
||||
- os: linux
|
||||
compiler: gcc
|
||||
addons:
|
||||
apt:
|
||||
sources:
|
||||
- ubuntu-toolchain-r-test
|
||||
packages:
|
||||
- g++-5
|
||||
env:
|
||||
- MATRIX_EVAL="CC=gcc-5"
|
||||
- BUILD_DIR=unix
|
||||
- os: linux
|
||||
compiler: gcc
|
||||
addons:
|
||||
apt:
|
||||
sources:
|
||||
- ubuntu-toolchain-r-test
|
||||
packages:
|
||||
- g++-6
|
||||
env:
|
||||
- MATRIX_EVAL="CC=gcc-6"
|
||||
- BUILD_DIR=unix
|
||||
- os: linux
|
||||
compiler: gcc
|
||||
addons:
|
||||
apt:
|
||||
sources:
|
||||
- ubuntu-toolchain-r-test
|
||||
packages:
|
||||
- g++-7
|
||||
env:
|
||||
- MATRIX_EVAL="CC=gcc-7"
|
||||
- BUILD_DIR=unix
|
||||
- os: osx
|
||||
osx_image: xcode8
|
||||
env:
|
||||
- MATRIX_EVAL=""
|
||||
- BUILD_DIR=unix
|
||||
- os: osx
|
||||
osx_image: xcode8
|
||||
env:
|
||||
- MATRIX_EVAL=""
|
||||
- BUILD_DIR=macosx
|
||||
- NO_DIRECT_CONFIGURE=1
|
||||
- os: osx
|
||||
osx_image: xcode9
|
||||
env:
|
||||
- MATRIX_EVAL=""
|
||||
- BUILD_DIR=macosx
|
||||
- NO_DIRECT_CONFIGURE=1
|
||||
- os: osx
|
||||
osx_image: xcode10
|
||||
env:
|
||||
- MATRIX_EVAL=""
|
||||
- BUILD_DIR=macosx
|
||||
- NO_DIRECT_CONFIGURE=1
|
||||
# Test with mingw-w64 (32 bit)
|
||||
- os: linux
|
||||
compiler: i686-w64-mingw32-gcc
|
||||
addons:
|
||||
apt:
|
||||
packages:
|
||||
- gcc-mingw-w64-base
|
||||
- binutils-mingw-w64-i686
|
||||
- gcc-mingw-w64-i686
|
||||
- gcc-mingw-w64
|
||||
- gcc-multilib
|
||||
- wine
|
||||
env:
|
||||
- MATRIX_EVAL=""
|
||||
- BUILD_DIR=win
|
||||
- CFGOPT=--host=i686-w64-mingw32
|
||||
- NO_DIRECT_TEST=1
|
||||
|
||||
# Test with mingw-w64 (64 bit)
|
||||
- os: linux
|
||||
compiler: x86_64-w64-mingw32-gcc
|
||||
addons:
|
||||
apt:
|
||||
packages:
|
||||
- gcc-mingw-w64-base
|
||||
- binutils-mingw-w64-x86-64
|
||||
- gcc-mingw-w64-x86-64
|
||||
- gcc-mingw-w64
|
||||
- wine
|
||||
env:
|
||||
- MATRIX_EVAL=""
|
||||
- BUILD_DIR=win
|
||||
- CFGOPT=--host=x86_64-w64-mingw32 --enable-64bit
|
||||
- NO_DIRECT_TEST=1
|
||||
|
||||
### C builds not currently supported on Windows instances
|
||||
# - os: windows
|
||||
# env:
|
||||
# - MATRIX_EVAL=""
|
||||
# - BUILD_DIR=win
|
||||
|
||||
before_install:
|
||||
- if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then rvm get stable; fi
|
||||
- eval "${MATRIX_EVAL}"
|
||||
- export ERROR_ON_FAILURES=1
|
||||
- cd ${BUILD_DIR}
|
||||
install:
|
||||
- test -n "$NO_DIRECT_CONFIGURE" || ./configure ${CFGOPT}
|
||||
script:
|
||||
- make
|
||||
- test -n "$NO_DIRECT_TEST" || make test
|
||||
@@ -1,185 +0,0 @@
|
||||
README: Tcl
|
||||
This is the Tcl 8.6.8 source distribution.
|
||||
http://sourceforge.net/projects/tcl/files/Tcl/
|
||||
You can get any source release of Tcl from the URL above.
|
||||
|
||||
Contents
|
||||
--------
|
||||
1. Introduction
|
||||
2. Documentation
|
||||
3. Compiling and installing Tcl
|
||||
4. Development tools
|
||||
5. Tcl newsgroup
|
||||
6. The Tcler's Wiki
|
||||
7. Mailing lists
|
||||
8. Support and Training
|
||||
9. Tracking Development
|
||||
10. Thank You
|
||||
|
||||
1. Introduction
|
||||
---------------
|
||||
Tcl provides a powerful platform for creating integration applications that
|
||||
tie together diverse applications, protocols, devices, and frameworks.
|
||||
When paired with the Tk toolkit, Tcl provides the fastest and most powerful
|
||||
way to create GUI applications that run on PCs, Unix, and Mac OS X.
|
||||
Tcl can also be used for a variety of web-related tasks and for creating
|
||||
powerful command languages for applications.
|
||||
|
||||
Tcl is maintained, enhanced, and distributed freely by the Tcl community.
|
||||
Source code development and tracking of bug reports and feature requests
|
||||
takes place at:
|
||||
|
||||
http://core.tcl.tk/
|
||||
|
||||
Tcl/Tk release and mailing list services are hosted by SourceForge:
|
||||
|
||||
http://sourceforge.net/projects/tcl/
|
||||
|
||||
with the Tcl Developer Xchange hosted at:
|
||||
|
||||
http://www.tcl.tk/
|
||||
|
||||
Tcl is a freely available open source package. You can do virtually
|
||||
anything you like with it, such as modifying it, redistributing it,
|
||||
and selling it either in whole or in part. See the file
|
||||
"license.terms" for complete information.
|
||||
|
||||
2. Documentation
|
||||
----------------
|
||||
|
||||
Extensive documentation is available at our website.
|
||||
The home page for this release, including new features, is
|
||||
http://www.tcl.tk/software/tcltk/8.6.html
|
||||
|
||||
Detailed release notes can be found at the file distributions page
|
||||
by clicking on the relevant version.
|
||||
http://sourceforge.net/projects/tcl/files/Tcl/
|
||||
|
||||
Information about Tcl itself can be found at
|
||||
http://www.tcl.tk/about/
|
||||
|
||||
There have been many Tcl books on the market. Many are mentioned in the Wiki:
|
||||
http://wiki.tcl.tk/_/ref?N=25206
|
||||
|
||||
To view the complete set of reference manual entries for Tcl 8.6 online,
|
||||
visit the URL:
|
||||
http://www.tcl.tk/man/tcl8.6/
|
||||
|
||||
2a. Unix Documentation
|
||||
----------------------
|
||||
|
||||
The "doc" subdirectory in this release contains a complete set of
|
||||
reference manual entries for Tcl. Files with extension ".1" are for
|
||||
programs (for example, tclsh.1); files with extension ".3" are for C
|
||||
library procedures; and files with extension ".n" describe Tcl
|
||||
commands. The file "doc/Tcl.n" gives a quick summary of the Tcl
|
||||
language syntax. To print any of the man pages on Unix, cd to the
|
||||
"doc" directory and invoke your favorite variant of troff using the
|
||||
normal -man macros, for example
|
||||
|
||||
ditroff -man Tcl.n
|
||||
|
||||
to print Tcl.n. If Tcl has been installed correctly and your "man" program
|
||||
supports it, you should be able to access the Tcl manual entries using the
|
||||
normal "man" mechanisms, such as
|
||||
|
||||
man Tcl
|
||||
|
||||
2b. Windows Documentation
|
||||
-------------------------
|
||||
|
||||
The "doc" subdirectory in this release contains a complete set of Windows
|
||||
help files for Tcl. Once you install this Tcl release, a shortcut to the
|
||||
Windows help Tcl documentation will appear in the "Start" menu:
|
||||
|
||||
Start | Programs | Tcl | Tcl Help
|
||||
|
||||
3. Compiling and installing Tcl
|
||||
-------------------------------
|
||||
|
||||
There are brief notes in the unix/README, win/README, and macosx/README about
|
||||
compiling on these different platforms. There is additional information
|
||||
about building Tcl from sources at
|
||||
|
||||
http://www.tcl.tk/doc/howto/compile.html
|
||||
|
||||
4. Development tools
|
||||
---------------------------
|
||||
|
||||
ActiveState produces a high quality set of commercial quality development
|
||||
tools that is available to accelerate your Tcl application development.
|
||||
Tcl Dev Kit builds on the earlier TclPro toolset and provides a debugger,
|
||||
static code checker, single-file wrapping utility, bytecode compiler and
|
||||
more. More information can be found at
|
||||
|
||||
http://www.ActiveState.com/Tcl
|
||||
|
||||
5. Tcl newsgroup
|
||||
----------------
|
||||
|
||||
There is a USENET news group, "comp.lang.tcl", intended for the exchange of
|
||||
information about Tcl, Tk, and related applications. The newsgroup is a
|
||||
great place to ask general information questions. For bug reports, please
|
||||
see the "Support and bug fixes" section below.
|
||||
|
||||
6. Tcl'ers Wiki
|
||||
---------------
|
||||
|
||||
A Wiki-based open community site covering all aspects of Tcl/Tk is at:
|
||||
|
||||
http://wiki.tcl.tk/
|
||||
|
||||
It is dedicated to the Tcl programming language and its extensions. A
|
||||
wealth of useful information can be found there. It contains code
|
||||
snippets, references to papers, books, and FAQs, as well as pointers to
|
||||
development tools, extensions, and applications. You can also recommend
|
||||
additional URLs by editing the wiki yourself.
|
||||
|
||||
7. Mailing lists
|
||||
----------------
|
||||
|
||||
Several mailing lists are hosted at SourceForge to discuss development or
|
||||
use issues (like Macintosh and Windows topics). For more information and
|
||||
to subscribe, visit:
|
||||
|
||||
http://sourceforge.net/projects/tcl/
|
||||
|
||||
and go to the Mailing Lists page.
|
||||
|
||||
8. Support and Training
|
||||
------------------------
|
||||
|
||||
We are very interested in receiving bug reports, patches, and suggestions
|
||||
for improvements. We prefer that you send this information to us as
|
||||
tickets entered into our tracker at:
|
||||
|
||||
http://core.tcl.tk/tcl/reportlist
|
||||
|
||||
We will log and follow-up on each bug, although we cannot promise a
|
||||
specific turn-around time. Enhancements may take longer and may not happen
|
||||
at all unless there is widespread support for them (we're trying to
|
||||
slow the rate at which Tcl/Tk turns into a kitchen sink). It's very
|
||||
difficult to make incompatible changes to Tcl/Tk at this point, due to
|
||||
the size of the installed base.
|
||||
|
||||
The Tcl community is too large for us to provide much individual support
|
||||
for users. If you need help we suggest that you post questions to
|
||||
comp.lang.tcl. We read the newsgroup and will attempt to answer esoteric
|
||||
questions for which no one else is likely to know the answer. In addition,
|
||||
see the following Web site for links to other organizations that offer
|
||||
Tcl/Tk training:
|
||||
|
||||
http://wiki.tcl.tk/training
|
||||
|
||||
9. Tracking Development
|
||||
-----------------------
|
||||
|
||||
Tcl is developed in public. To keep an eye on how Tcl is changing, see
|
||||
http://core.tcl.tk/
|
||||
|
||||
10. Thank You
|
||||
-------------
|
||||
|
||||
We'd like to express our thanks to the Tcl community for all the
|
||||
helpful suggestions, bug reports, and patches we have received.
|
||||
Tcl/Tk has improved vastly and will continue to do so with your help.
|
||||
|
||||
@@ -1,36 +0,0 @@
|
||||
/*
|
||||
* fixstrtod.c --
|
||||
*
|
||||
* Source code for the "fixstrtod" procedure. This procedure is
|
||||
* used in place of strtod under Solaris 2.4, in order to fix
|
||||
* a bug where the "end" pointer gets set incorrectly.
|
||||
*
|
||||
* Copyright (c) 1995 Sun Microsystems, Inc.
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution
|
||||
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
|
||||
#undef strtod
|
||||
|
||||
/*
|
||||
* Declare strtod explicitly rather than including stdlib.h, since in
|
||||
* somes systems (e.g. SunOS 4.1.4) stdlib.h doesn't declare strtod.
|
||||
*/
|
||||
|
||||
extern double strtod(char *, char **);
|
||||
|
||||
double
|
||||
fixstrtod(
|
||||
char *string,
|
||||
char **endPtr)
|
||||
{
|
||||
double d;
|
||||
d = strtod(string, endPtr);
|
||||
if ((endPtr != NULL) && (*endPtr != string) && ((*endPtr)[-1] == 0)) {
|
||||
*endPtr -= 1;
|
||||
}
|
||||
return d;
|
||||
}
|
||||
@@ -29,7 +29,6 @@ extern char * malloc(unsigned int numBytes);
|
||||
extern void qsort(void *base, int n, int size, int (*compar)(
|
||||
const void *element1, const void *element2));
|
||||
extern char * realloc(char *ptr, unsigned int numBytes);
|
||||
extern double strtod(const char *string, char **endPtr);
|
||||
extern long strtol(const char *string, char **endPtr, int base);
|
||||
extern unsigned long strtoul(const char *string, char **endPtr, int base);
|
||||
|
||||
|
||||
-252
@@ -1,252 +0,0 @@
|
||||
/*
|
||||
* strtod.c --
|
||||
*
|
||||
* Source code for the "strtod" library procedure.
|
||||
*
|
||||
* Copyright (c) 1988-1993 The Regents of the University of California.
|
||||
* Copyright (c) 1994 Sun Microsystems, Inc.
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution
|
||||
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*/
|
||||
|
||||
#include "tclInt.h"
|
||||
|
||||
#ifndef TRUE
|
||||
#define TRUE 1
|
||||
#define FALSE 0
|
||||
#endif
|
||||
#ifndef NULL
|
||||
#define NULL 0
|
||||
#endif
|
||||
|
||||
static const int maxExponent = 511; /* Largest possible base 10 exponent. Any
|
||||
* exponent larger than this will already
|
||||
* produce underflow or overflow, so there's
|
||||
* no need to worry about additional digits.
|
||||
*/
|
||||
static const double powersOf10[] = { /* Table giving binary powers of 10. Entry */
|
||||
10., /* is 10^2^i. Used to convert decimal */
|
||||
100., /* exponents into floating-point numbers. */
|
||||
1.0e4,
|
||||
1.0e8,
|
||||
1.0e16,
|
||||
1.0e32,
|
||||
1.0e64,
|
||||
1.0e128,
|
||||
1.0e256
|
||||
};
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* strtod --
|
||||
*
|
||||
* This procedure converts a floating-point number from an ASCII
|
||||
* decimal representation to internal double-precision format.
|
||||
*
|
||||
* Results:
|
||||
* The return value is the double-precision floating-point
|
||||
* representation of the characters in string. If endPtr isn't
|
||||
* NULL, then *endPtr is filled in with the address of the
|
||||
* next character after the last one that was part of the
|
||||
* floating-point number.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
double
|
||||
strtod(
|
||||
const char *string, /* A decimal ASCII floating-point number,
|
||||
* optionally preceded by white space. Must
|
||||
* have form "-I.FE-X", where I is the integer
|
||||
* part of the mantissa, F is the fractional
|
||||
* part of the mantissa, and X is the
|
||||
* exponent. Either of the signs may be "+",
|
||||
* "-", or omitted. Either I or F may be
|
||||
* omitted, or both. The decimal point isn't
|
||||
* necessary unless F is present. The "E" may
|
||||
* actually be an "e". E and X may both be
|
||||
* omitted (but not just one). */
|
||||
char **endPtr) /* If non-NULL, store terminating character's
|
||||
* address here. */
|
||||
{
|
||||
int sign, expSign = FALSE;
|
||||
double fraction, dblExp;
|
||||
const double *d;
|
||||
register const char *p;
|
||||
register int c;
|
||||
int exp = 0; /* Exponent read from "EX" field. */
|
||||
int fracExp = 0; /* Exponent that derives from the fractional
|
||||
* part. Under normal circumstatnces, it is
|
||||
* the negative of the number of digits in F.
|
||||
* However, if I is very long, the last digits
|
||||
* of I get dropped (otherwise a long I with a
|
||||
* large negative exponent could cause an
|
||||
* unnecessary overflow on I alone). In this
|
||||
* case, fracExp is incremented one for each
|
||||
* dropped digit. */
|
||||
int mantSize; /* Number of digits in mantissa. */
|
||||
int decPt; /* Number of mantissa digits BEFORE decimal
|
||||
* point. */
|
||||
const char *pExp; /* Temporarily holds location of exponent in
|
||||
* string. */
|
||||
|
||||
/*
|
||||
* Strip off leading blanks and check for a sign.
|
||||
*/
|
||||
|
||||
p = string;
|
||||
while (isspace(UCHAR(*p))) {
|
||||
p += 1;
|
||||
}
|
||||
if (*p == '-') {
|
||||
sign = TRUE;
|
||||
p += 1;
|
||||
} else {
|
||||
if (*p == '+') {
|
||||
p += 1;
|
||||
}
|
||||
sign = FALSE;
|
||||
}
|
||||
|
||||
/*
|
||||
* Count the number of digits in the mantissa (including the decimal
|
||||
* point), and also locate the decimal point.
|
||||
*/
|
||||
|
||||
decPt = -1;
|
||||
for (mantSize = 0; ; mantSize += 1)
|
||||
{
|
||||
c = *p;
|
||||
if (!isdigit(c)) {
|
||||
if ((c != '.') || (decPt >= 0)) {
|
||||
break;
|
||||
}
|
||||
decPt = mantSize;
|
||||
}
|
||||
p += 1;
|
||||
}
|
||||
|
||||
/*
|
||||
* Now suck up the digits in the mantissa. Use two integers to collect 9
|
||||
* digits each (this is faster than using floating-point). If the mantissa
|
||||
* has more than 18 digits, ignore the extras, since they can't affect the
|
||||
* value anyway.
|
||||
*/
|
||||
|
||||
pExp = p;
|
||||
p -= mantSize;
|
||||
if (decPt < 0) {
|
||||
decPt = mantSize;
|
||||
} else {
|
||||
mantSize -= 1; /* One of the digits was the point. */
|
||||
}
|
||||
if (mantSize > 18) {
|
||||
fracExp = decPt - 18;
|
||||
mantSize = 18;
|
||||
} else {
|
||||
fracExp = decPt - mantSize;
|
||||
}
|
||||
if (mantSize == 0) {
|
||||
fraction = 0.0;
|
||||
p = string;
|
||||
goto done;
|
||||
} else {
|
||||
int frac1, frac2;
|
||||
|
||||
frac1 = 0;
|
||||
for ( ; mantSize > 9; mantSize -= 1) {
|
||||
c = *p;
|
||||
p += 1;
|
||||
if (c == '.') {
|
||||
c = *p;
|
||||
p += 1;
|
||||
}
|
||||
frac1 = 10*frac1 + (c - '0');
|
||||
}
|
||||
frac2 = 0;
|
||||
for (; mantSize > 0; mantSize -= 1) {
|
||||
c = *p;
|
||||
p += 1;
|
||||
if (c == '.') {
|
||||
c = *p;
|
||||
p += 1;
|
||||
}
|
||||
frac2 = 10*frac2 + (c - '0');
|
||||
}
|
||||
fraction = (1.0e9 * frac1) + frac2;
|
||||
}
|
||||
|
||||
/*
|
||||
* Skim off the exponent.
|
||||
*/
|
||||
|
||||
p = pExp;
|
||||
if ((*p == 'E') || (*p == 'e')) {
|
||||
p += 1;
|
||||
if (*p == '-') {
|
||||
expSign = TRUE;
|
||||
p += 1;
|
||||
} else {
|
||||
if (*p == '+') {
|
||||
p += 1;
|
||||
}
|
||||
expSign = FALSE;
|
||||
}
|
||||
if (!isdigit(UCHAR(*p))) {
|
||||
p = pExp;
|
||||
goto done;
|
||||
}
|
||||
while (isdigit(UCHAR(*p))) {
|
||||
exp = exp * 10 + (*p - '0');
|
||||
p += 1;
|
||||
}
|
||||
}
|
||||
if (expSign) {
|
||||
exp = fracExp - exp;
|
||||
} else {
|
||||
exp = fracExp + exp;
|
||||
}
|
||||
|
||||
/*
|
||||
* Generate a floating-point number that represents the exponent. Do this
|
||||
* by processing the exponent one bit at a time to combine many powers of
|
||||
* 2 of 10. Then combine the exponent with the fraction.
|
||||
*/
|
||||
|
||||
if (exp < 0) {
|
||||
expSign = TRUE;
|
||||
exp = -exp;
|
||||
} else {
|
||||
expSign = FALSE;
|
||||
}
|
||||
if (exp > maxExponent) {
|
||||
exp = maxExponent;
|
||||
errno = ERANGE;
|
||||
}
|
||||
dblExp = 1.0;
|
||||
for (d = powersOf10; exp != 0; exp >>= 1, ++d) {
|
||||
if (exp & 01) {
|
||||
dblExp *= *d;
|
||||
}
|
||||
}
|
||||
if (expSign) {
|
||||
fraction /= dblExp;
|
||||
} else {
|
||||
fraction *= dblExp;
|
||||
}
|
||||
|
||||
done:
|
||||
if (endPtr != NULL) {
|
||||
*endPtr = (char *) p;
|
||||
}
|
||||
|
||||
if (sign) {
|
||||
return -fraction;
|
||||
}
|
||||
return fraction;
|
||||
}
|
||||
+3
-3
@@ -224,10 +224,10 @@ Although it is the common escape algorithm, but, in fact, the way how the
|
||||
executable parses the command-line (resp. splits it into single arguments)
|
||||
is decisive.
|
||||
.PP
|
||||
Unfortunately, there is currently no way to supply newline character within
|
||||
an argument to the batch files (\fB.cmd\fR or \fB.bat\fR) or to the command
|
||||
Unfortunately, there is currently no way to supply newline character within
|
||||
an argument to the batch files (\fB.cmd\fR or \fB.bat\fR) or to the command
|
||||
processor (\fBcmd.exe /c\fR), because this causes truncation of command-line
|
||||
(also the argument chain) on the first newline character.
|
||||
(also the argument chain) on the first newline character.
|
||||
But it works properly with an executable (using CommandLineToArgv, etc).
|
||||
.PP
|
||||
The Tk console text widget does not provide real standard IO capabilities.
|
||||
|
||||
+177
-9
@@ -6,14 +6,14 @@
|
||||
'\" See the file "license.terms" for information on usage and redistribution
|
||||
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
'\"
|
||||
.TH "http" n 2.7 http "Tcl Bundled Packages"
|
||||
.TH "http" n 2.9 http "Tcl Bundled Packages"
|
||||
.so man.macros
|
||||
.BS
|
||||
'\" Note: do not modify the .SH NAME line immediately below!
|
||||
.SH NAME
|
||||
http \- Client-side implementation of the HTTP/1.1 protocol
|
||||
.SH SYNOPSIS
|
||||
\fBpackage require http ?2.7?\fR
|
||||
\fBpackage require http ?2.8?\fR
|
||||
.\" See Also -useragent option documentation in body!
|
||||
.sp
|
||||
\fB::http::config ?\fI\-option value\fR ...?
|
||||
@@ -22,6 +22,8 @@ http \- Client-side implementation of the HTTP/1.1 protocol
|
||||
.sp
|
||||
\fB::http::formatQuery\fR \fIkey value\fR ?\fIkey value\fR ...?
|
||||
.sp
|
||||
\fB::http::quoteString\fR \fIvalue\fR
|
||||
.sp
|
||||
\fB::http::reset\fR \fItoken\fR ?\fIwhy\fR?
|
||||
.sp
|
||||
\fB::http::wait \fItoken\fR
|
||||
@@ -44,12 +46,14 @@ http \- Client-side implementation of the HTTP/1.1 protocol
|
||||
.sp
|
||||
\fB::http::register \fIproto port command\fR
|
||||
.sp
|
||||
\fB::http::registerError \fIport\fR ?\fImessage\fR?
|
||||
.sp
|
||||
\fB::http::unregister \fIproto\fR
|
||||
.BE
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
The \fBhttp\fR package provides the client side of the HTTP/1.1
|
||||
protocol, as defined in RFC 2616.
|
||||
protocol, as defined in RFC 7230 to RFC 7235, which supersede RFC 2616.
|
||||
The package implements the GET, POST, and HEAD operations
|
||||
of HTTP/1.1. It allows configuration of a proxy host to get through
|
||||
firewalls. The package is compatible with the \fBSafesock\fR security
|
||||
@@ -95,6 +99,19 @@ comma-separated list of mime type patterns that you are
|
||||
willing to receive. For example,
|
||||
.QW "image/gif, image/jpeg, text/*" .
|
||||
.TP
|
||||
\fB\-pipeline\fR \fIboolean\fR
|
||||
.
|
||||
Specifies whether HTTP/1.1 transactions on a persistent socket will be
|
||||
pipelined. See the \fBPERSISTENT SOCKETS\fR section for details. The default
|
||||
is 1.
|
||||
.TP
|
||||
\fB\-postfresh\fR \fIboolean\fR
|
||||
.
|
||||
Specifies whether requests that use the \fBPOST\fR method will always use a
|
||||
fresh socket, overriding the \fB-keepalive\fR option of
|
||||
command \fBhttp::geturl\fR. See the \fBPERSISTENT SOCKETS\fR section for details.
|
||||
The default is 0.
|
||||
.TP
|
||||
\fB\-proxyhost\fR \fIhostname\fR
|
||||
.
|
||||
The name of the proxy host, if any. If this value is the
|
||||
@@ -116,20 +133,47 @@ an empty list. The default filter returns the values of the
|
||||
\fB\-proxyhost\fR and \fB\-proxyport\fR settings if they are
|
||||
non-empty.
|
||||
.TP
|
||||
\fB\-repost\fR \fIboolean\fR
|
||||
.
|
||||
Specifies what to do if a POST request over a persistent connection fails
|
||||
because the server has half-closed the connection. If boolean \fBtrue\fR, the
|
||||
request
|
||||
will be automatically retried; if boolean \fBfalse\fR it will not, and the
|
||||
application
|
||||
that uses \fBhttp::geturl\fR is expected to seek user confirmation before
|
||||
retrying the POST. The value \fBtrue\fR should be used only under certain
|
||||
conditions. See the \fBPERSISTENT SOCKETS\fR section for details. The
|
||||
default is 0.
|
||||
.TP
|
||||
\fB\-urlencoding\fR \fIencoding\fR
|
||||
.
|
||||
The \fIencoding\fR used for creating the x-url-encoded URLs with
|
||||
\fB::http::formatQuery\fR. The default is \fButf-8\fR, as specified by RFC
|
||||
\fB::http::formatQuery\fR and \fB::http::quoteString\fR.
|
||||
The default is \fButf-8\fR, as specified by RFC
|
||||
2718. Prior to http 2.5 this was unspecified, and that behavior can be
|
||||
returned by specifying the empty string (\fB{}\fR), although
|
||||
\fIiso8859-1\fR is recommended to restore similar behavior but without the
|
||||
\fB::http::formatQuery\fR throwing an error processing non-latin-1
|
||||
characters.
|
||||
\fB::http::formatQuery\fR or \fB::http::quoteString\fR
|
||||
throwing an error processing non-latin-1 characters.
|
||||
.TP
|
||||
\fB\-useragent\fR \fIstring\fR
|
||||
.
|
||||
The value of the User-Agent header in the HTTP request. The default is
|
||||
.QW "\fBTcl http client package 2.7\fR" .
|
||||
The value of the User-Agent header in the HTTP request. In an unsafe
|
||||
interpreter, the default value depends upon the operating system, and
|
||||
the version numbers of \fBhttp\fR and \fBTcl\fR, and is (for example)
|
||||
.QW "\fBMozilla/5.0 (Windows; U; Windows NT 10.0) http/2.8.12 Tcl/8.6.8\fR" .
|
||||
A safe interpreter cannot determine its operating system, and so the default
|
||||
in a safe interpreter is to use a Windows 10 value with the current version
|
||||
numbers of \fBhttp\fR and \fBTcl\fR.
|
||||
.TP
|
||||
\fB\-zip\fR \fIboolean\fR
|
||||
.
|
||||
If the value is boolean \fBtrue\fR, then by default requests will send a header
|
||||
.QW "\fBAccept-Encoding: gzip,deflate,compress\fR" .
|
||||
If the value is boolean \fBfalse\fR, then by default this header will not be sent.
|
||||
In either case the default can be overridden for an individual request by
|
||||
supplying a custom \fBAccept-Encoding\fR header in the \fB-headers\fR option
|
||||
of \fBhttp::geturl\fR. The default is 1.
|
||||
.RE
|
||||
.TP
|
||||
\fB::http::geturl\fR \fIurl\fR ?\fIoptions\fR?
|
||||
@@ -227,7 +271,7 @@ Pragma: no-cache
|
||||
.TP
|
||||
\fB\-keepalive\fR \fIboolean\fR
|
||||
.
|
||||
If true, attempt to keep the connection open for servicing
|
||||
If boolean \fBtrue\fR, attempt to keep the connection open for servicing
|
||||
multiple requests. Default is 0.
|
||||
.TP
|
||||
\fB\-method\fR \fItype\fR
|
||||
@@ -334,6 +378,11 @@ encodes the keys and values, and generates one string that has the
|
||||
proper & and = separators. The result is suitable for the
|
||||
\fB\-query\fR value passed to \fB::http::geturl\fR.
|
||||
.TP
|
||||
\fB::http::quoteString\fR \fIvalue\fR
|
||||
.
|
||||
This procedure does x-url-encoding of string. It takes a single argument and
|
||||
encodes it.
|
||||
.TP
|
||||
\fB::http::reset\fR \fItoken\fR ?\fIwhy\fR?
|
||||
.
|
||||
This command resets the HTTP transaction identified by \fItoken\fR, if any.
|
||||
@@ -415,6 +464,17 @@ set token [::http::geturl https://my.secure.site/]
|
||||
.CE
|
||||
.RE
|
||||
.TP
|
||||
\fB::http::registerError\fR \fIport\fR ?\fImessage\fR?
|
||||
.
|
||||
This procedure allows a registered protocol handler to deliver an error
|
||||
message for use by \fBhttp\fR. Calling this command does not raise an
|
||||
error. The command is useful when a registered protocol detects an problem
|
||||
(for example, an invalid TLS certificate) that will cause an error to
|
||||
propagate to \fBhttp\fR. The command allows \fBhttp\fR to provide a
|
||||
precise error message rather than a general one. The command returns the
|
||||
value provided by the last call with argument \fImessage\fR, or the empty
|
||||
string if no such call has been made.
|
||||
.TP
|
||||
\fB::http::unregister\fR \fIproto\fR
|
||||
.
|
||||
This procedure unregisters a protocol handler that was previously
|
||||
@@ -504,6 +564,14 @@ The following elements of
|
||||
the array are supported:
|
||||
.RS
|
||||
.TP
|
||||
\fBbinary\fR
|
||||
.
|
||||
This is boolean \fBtrue\fR if (after decoding any compression specified
|
||||
by the
|
||||
.QW "Content-Encoding"
|
||||
response header) the HTTP response is binary. It is boolean \fBfalse\fR
|
||||
if the HTTP response is text.
|
||||
.TP
|
||||
\fBbody\fR
|
||||
.
|
||||
The contents of the URL. This will be empty if the \fB\-channel\fR
|
||||
@@ -602,6 +670,106 @@ A copy of the \fBContent-Type\fR meta-data value.
|
||||
.
|
||||
The requested URL.
|
||||
.RE
|
||||
.SH "PERSISTENT CONNECTIONS"
|
||||
.PP
|
||||
.SS "BASICS"
|
||||
.PP
|
||||
See RFC 7230 Sec 6, which supersedes RFC 2616 Sec 8.1.
|
||||
.PP
|
||||
A persistent connection allows multiple HTTP/1.1 transactions to be
|
||||
carried over the same TCP connection. Pipelining allows a
|
||||
client to make multiple requests over a persistent connection without
|
||||
waiting for each response. The server sends responses in the same order
|
||||
that the requests were received.
|
||||
.PP
|
||||
If a POST request fails to complete, typically user confirmation is
|
||||
needed before sending the request again. The user may wish to verify
|
||||
whether the server was modified by the failed POST request, before
|
||||
sending the same request again.
|
||||
.PP
|
||||
A HTTP request will use a persistent socket if the call to
|
||||
\fBhttp::geturl\fR has the option \fB-keepalive true\fR. It will use
|
||||
pipelining where permitted if the \fBhttp::config\fR option
|
||||
\fB-pipeline\fR is boolean \fBtrue\fR (its default value).
|
||||
.PP
|
||||
The http package maintains no more than one persistent connection to each
|
||||
server (i.e. each value of
|
||||
.QW "domain:port" ).
|
||||
If \fBhttp::geturl\fR is called to make a request over a persistent
|
||||
connection while the connection is busy with another request, the new
|
||||
request will be held in a queue until the connection is free.
|
||||
.PP
|
||||
The http package does not support HTTP/1.0 persistent connections
|
||||
controlled by the \fBKeep-Alive\fR header.
|
||||
.SS "SPECIAL CASES"
|
||||
.PP
|
||||
This subsection discusses issues related to closure of the
|
||||
persistent connection by the server, automatic retry of failed requests,
|
||||
the special treatment necessary for POST requests, and the options for
|
||||
dealing with these cases.
|
||||
.PP
|
||||
In accordance with RFC 7230, \fBhttp::geturl\fR does not pipeline
|
||||
requests that use the POST method. If a POST uses a persistent
|
||||
connection and is not the first request on that connection,
|
||||
\fBhttp::geturl\fR waits until it has received the response for the previous
|
||||
request; or (if \fBhttp::config\fR option \fB-postfresh\fR is boolean \fBtrue\fR) it
|
||||
uses a new connection for each POST.
|
||||
.PP
|
||||
If the server is processing a number of pipelined requests, and sends a
|
||||
response header
|
||||
.QW "\fBConnection: close\fR"
|
||||
with one of the responses (other than the last), then subsequent responses
|
||||
are unfulfilled. \fBhttp::geturl\fR will send the unfulfilled requests again
|
||||
over a new connection.
|
||||
.PP
|
||||
A difficulty arises when a HTTP client sends a request over a persistent
|
||||
connection that has been idle for a while. The HTTP server may
|
||||
half-close an apparently idle connection while the client is sending a
|
||||
request, but before the request arrives at the server: in this case (an
|
||||
.QW "asynchronous close event" )
|
||||
the request will fail. The difficulty arises because the client cannot
|
||||
be certain whether the POST modified the state of the server. For HEAD or
|
||||
GET requests, \fBhttp::geturl\fR opens another connection and retransmits
|
||||
the failed request. However, if the request was a POST, RFC 7230 forbids
|
||||
automatic retry by default, suggesting either user confirmation, or
|
||||
confirmation by user-agent software that has semantic understanding of
|
||||
the application. The \fBhttp::config\fR option \fB-repost\fR allows for
|
||||
either possibility.
|
||||
.PP
|
||||
Asynchronous close events can occur only in a short interval of time. The
|
||||
\fBhttp\fR package monitors each persistent connection for closure by the
|
||||
server. Upon detection, the connection is also closed at the client end,
|
||||
and subsequent requests will use a fresh connection.
|
||||
.PP
|
||||
If the \fBhttp::geturl\fR command is called with option \fB-keepalive true\fR,
|
||||
then it will both try to use an existing persistent connection
|
||||
(if one is available), and it will send the server a
|
||||
.QW "\fBConnection: keep-alive\fR"
|
||||
request header asking to keep the connection open for future requests.
|
||||
.PP
|
||||
The \fBhttp::config\fR options \fB-pipeline\fR, \fB-postfresh\fR, and
|
||||
\fB-repost\fR relate to persistent connections.
|
||||
.PP
|
||||
Option \fB-pipeline\fR, if boolean \fBtrue\fR, will pipeline GET and HEAD requests
|
||||
made
|
||||
over a persistent connection. POST requests will not be pipelined - if the
|
||||
POST is not the first transaction on the connection, its request will not
|
||||
be sent until the previous response has finished. GET and HEAD requests
|
||||
made after a POST will not be sent until the POST response has been
|
||||
delivered, and will not be sent if the POST fails.
|
||||
.PP
|
||||
Option \fB-postfresh\fR, if boolean \fBtrue\fR, will override the \fBhttp::geturl\fR option
|
||||
\fB-keepalive\fR, and always open a fresh connection for a POST request.
|
||||
.PP
|
||||
Option \fB-repost\fR, if \fBtrue\fR, permits automatic retry of a POST request
|
||||
that fails because it uses a persistent connection that the server has
|
||||
half-closed (an
|
||||
.QW "asynchronous close event" ).
|
||||
Subsequent GET and HEAD requests in a failed pipeline will also be retried.
|
||||
\fIThe -repost option should be used only if the application understands
|
||||
that the retry is appropriate\fR - specifically, the application must know
|
||||
that if the failed POST successfully modified the state of the server, a repeat POST
|
||||
would have no adverse effect.
|
||||
.SH EXAMPLE
|
||||
.PP
|
||||
This example creates a procedure to copy a URL to a file while printing a
|
||||
|
||||
+30
-10
@@ -17,7 +17,7 @@ lreplace \- Replace elements in a list with new elements
|
||||
.BE
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
\fBlreplace\fR returns a new list formed by replacing one or more elements of
|
||||
\fBlreplace\fR returns a new list formed by replacing zero or more elements of
|
||||
\fIlist\fR with the \fIelement\fR arguments.
|
||||
\fIfirst\fR and \fIlast\fR are index values specifying the first and
|
||||
last elements of the range to replace.
|
||||
@@ -27,23 +27,26 @@ supporting simple index arithmetic and indices relative to the
|
||||
end of the list.
|
||||
0 refers to the first element of the
|
||||
list, and \fBend\fR refers to the last element of the list.
|
||||
If \fIlist\fR is empty, then \fIfirst\fR and \fIlast\fR are ignored.
|
||||
.PP
|
||||
If \fIfirst\fR is less than zero, it is considered to refer to before the
|
||||
first element of the list. For non-empty lists, the element indicated
|
||||
by \fIfirst\fR must exist or \fIfirst\fR must indicate before the
|
||||
start of the list.
|
||||
If either \fIfirst\fR or \fIlast\fR is less than zero, it is considered
|
||||
to refer to before the first element of the list. This allows \fBlreplace\fR
|
||||
to prepend elements to \fIlist\fR.
|
||||
.VS TIP505
|
||||
If either \fIfirst\fR or \fIlast\fR indicates a position greater than the
|
||||
index of the last element of the list, it is treated as if it is an
|
||||
index one greater than the last element. This allows \fBlreplace\fR to
|
||||
append elements to \fIlist\fR.
|
||||
.VE TIP505
|
||||
.PP
|
||||
If \fIlast\fR is less than \fIfirst\fR, then any specified elements
|
||||
will be inserted into the list before the point specified by \fIfirst\fR
|
||||
will be inserted into the list before the element specified by \fIfirst\fR
|
||||
with no elements being deleted.
|
||||
.PP
|
||||
The \fIelement\fR arguments specify zero or more new arguments to
|
||||
The \fIelement\fR arguments specify zero or more new elements to
|
||||
be added to the list in place of those that were deleted.
|
||||
Each \fIelement\fR argument will become a separate element of
|
||||
the list. If no \fIelement\fR arguments are specified, then the elements
|
||||
between \fIfirst\fR and \fIlast\fR are simply deleted. If \fIlist\fR
|
||||
is empty, any \fIelement\fR arguments are added to the end of the list.
|
||||
between \fIfirst\fR and \fIlast\fR are simply deleted.
|
||||
.SH EXAMPLES
|
||||
.PP
|
||||
Replacing an element of a list with another:
|
||||
@@ -78,9 +81,26 @@ proc lremove {listVariable value} {
|
||||
set var [\fBlreplace\fR $var $idx $idx]
|
||||
}
|
||||
.CE
|
||||
.PP
|
||||
.VS TIP505
|
||||
Appending elements to the list; note that \fBend+2\fR will initially
|
||||
be treated as if it is \fB6\fR here, but both that and \fB12345\fR are greater
|
||||
than the index of the final item so they behave identically:
|
||||
.PP
|
||||
.CS
|
||||
% set var {a b c d e}
|
||||
a b c d e
|
||||
% set var [\fBlreplace\fR $var 12345 end+2 f g h i]
|
||||
a b c d e f g h i
|
||||
.CE
|
||||
.VE TIP505
|
||||
.SH "SEE ALSO"
|
||||
list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
|
||||
lset(n), lrange(n), lsort(n),
|
||||
string(n)
|
||||
.SH KEYWORDS
|
||||
element, list, replace
|
||||
.\" Local variables:
|
||||
.\" mode: nroff
|
||||
.\" fill-column: 78
|
||||
.\" End:
|
||||
|
||||
+12
-2
@@ -8,7 +8,7 @@
|
||||
'\" See the file "license.terms" for information on usage and redistribution
|
||||
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
'\"
|
||||
.TH "tcltest" n 2.3 tcltest "Tcl Bundled Packages"
|
||||
.TH "tcltest" n 2.5 tcltest "Tcl Bundled Packages"
|
||||
.so man.macros
|
||||
.BS
|
||||
'\" Note: do not modify the .SH NAME line immediately below!
|
||||
@@ -16,7 +16,7 @@
|
||||
tcltest \- Test harness support code and utilities
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
\fBpackage require tcltest\fR ?\fB2.3\fR?
|
||||
\fBpackage require tcltest\fR ?\fB2.5\fR?
|
||||
|
||||
\fBtcltest::test \fIname description\fR ?\fI\-option value ...\fR?
|
||||
\fBtcltest::test \fIname description\fR ?\fIconstraints\fR? \fIbody result\fR
|
||||
@@ -454,6 +454,7 @@ The valid options for \fBtest\fR are summarized:
|
||||
?\fB\-output \fIexpectedOutput\fR?
|
||||
?\fB\-errorOutput \fIexpectedError\fR?
|
||||
?\fB\-returnCodes \fIcodeList\fR?
|
||||
?\fB\-errorCode \fIexpectedErrorCode\fR?
|
||||
?\fB\-match \fImode\fR?
|
||||
.CE
|
||||
.PP
|
||||
@@ -577,6 +578,15 @@ return codes known to \fBreturn\fR, in both numeric and symbolic
|
||||
form, including extended return codes, are acceptable elements in
|
||||
the \fIexpectedCodeList\fR. Default value is
|
||||
.QW "\fBok return\fR" .
|
||||
.TP
|
||||
\fB\-errorCode \fIexpectedErrorCode\fR
|
||||
.
|
||||
The optional \fB\-errorCode\fR attribute supplies \fIexpectedErrorCode\fR,
|
||||
a glob pattern that should match the error code reported from evaluation of the
|
||||
\fB\-body\fR script. If evaluation of the \fB\-body\fR script returns
|
||||
a code not matching \fIexpectedErrorCode\fR, the test fails. Default value is
|
||||
.QW "\fB*\fR" .
|
||||
If \fB\-returnCodes\fR does not include \fBerror\fR it is set to \fBerror\fR.
|
||||
.PP
|
||||
To pass, a test must successfully evaluate its \fB\-setup\fR, \fB\-body\fR,
|
||||
and \fB\-cleanup\fR scripts. The return code of the \fB\-body\fR script and
|
||||
|
||||
+3
-14
@@ -2747,21 +2747,10 @@ Tcl_LreplaceObjCmd(
|
||||
if (first < 0) {
|
||||
first = 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* Complain if the user asked for a start element that is greater than the
|
||||
* list length. This won't ever trigger for the "end-*" case as that will
|
||||
* be properly constrained by TclGetIntForIndex because we use listLen-1
|
||||
* (to allow for replacing the last elem).
|
||||
*/
|
||||
|
||||
if ((first >= listLen) && (listLen > 0)) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"list doesn't contain element %s", TclGetString(objv[2])));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPLACE", "BADIDX",
|
||||
NULL);
|
||||
return TCL_ERROR;
|
||||
if (first > listLen) {
|
||||
first = listLen;
|
||||
}
|
||||
|
||||
if (last >= listLen) {
|
||||
last = listLen - 1;
|
||||
}
|
||||
|
||||
+4
-55
@@ -1472,7 +1472,7 @@ TclCompileLreplaceCmd(
|
||||
{
|
||||
Tcl_Token *tokenPtr, *listTokenPtr;
|
||||
DefineLineInformation; /* TIP #280 */
|
||||
int idx1, idx2, i, offset, offset2;
|
||||
int idx1, idx2, i;
|
||||
int emptyPrefix=1, suffixStart = 0;
|
||||
|
||||
if (parsePtr->numWords < 4) {
|
||||
@@ -1492,23 +1492,6 @@ TclCompileLreplaceCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* idx1, idx2 are the conventional encoded forms of the tokens parsed
|
||||
* as all forms of index values. Values of idx1 that come before the
|
||||
* list are treated the same as if they were the start of the list.
|
||||
* Values of idx2 that come after the list are treated the same as if
|
||||
* they were the end of the list.
|
||||
*/
|
||||
|
||||
if (idx1 == TCL_INDEX_AFTER) {
|
||||
/*
|
||||
* [lreplace] treats idx1 value end+1 differently from end+2, etc.
|
||||
* The operand encoding cannot distinguish them, so we must bail
|
||||
* out to direct evaluation.
|
||||
*/
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* General structure of the [lreplace] result is
|
||||
* prefix replacement suffix
|
||||
@@ -1520,7 +1503,9 @@ TclCompileLreplaceCmd(
|
||||
* we must defer to direct evaluation.
|
||||
*/
|
||||
|
||||
if (idx2 == TCL_INDEX_BEFORE) {
|
||||
if (idx1 == TCL_INDEX_AFTER) {
|
||||
suffixStart = idx1;
|
||||
} else if (idx2 == TCL_INDEX_BEFORE) {
|
||||
suffixStart = idx1;
|
||||
} else if (idx2 == TCL_INDEX_END) {
|
||||
suffixStart = TCL_INDEX_AFTER;
|
||||
@@ -1552,42 +1537,6 @@ TclCompileLreplaceCmd(
|
||||
emptyPrefix = 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* [lreplace] raises an error when idx1 points after the list, but
|
||||
* only when the list is not empty. This is maximum stupidity.
|
||||
*
|
||||
* TODO: TIP this nonsense away!
|
||||
*/
|
||||
if (idx1 >= TCL_INDEX_START) {
|
||||
if (emptyPrefix) {
|
||||
TclEmitOpcode( INST_DUP, envPtr);
|
||||
} else {
|
||||
TclEmitInstInt4( INST_OVER, 1, envPtr);
|
||||
}
|
||||
TclEmitOpcode( INST_LIST_LENGTH, envPtr);
|
||||
TclEmitOpcode( INST_DUP, envPtr);
|
||||
offset = CurrentOffset(envPtr);
|
||||
TclEmitInstInt1( INST_JUMP_FALSE1, 0, envPtr);
|
||||
|
||||
/* List is not empty */
|
||||
TclEmitPush(TclAddLiteralObj(envPtr, Tcl_NewIntObj(idx1),
|
||||
NULL), envPtr);
|
||||
TclEmitOpcode( INST_GT, envPtr);
|
||||
offset2 = CurrentOffset(envPtr);
|
||||
TclEmitInstInt1( INST_JUMP_TRUE1, 0, envPtr);
|
||||
|
||||
/* Idx1 >= list length ===> raise an error */
|
||||
TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
|
||||
"list doesn't contain element %d", idx1), NULL), envPtr);
|
||||
CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
|
||||
Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
|
||||
TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
|
||||
envPtr->codeStart + offset + 1);
|
||||
TclEmitOpcode( INST_POP, envPtr);
|
||||
TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2,
|
||||
envPtr->codeStart + offset2 + 1);
|
||||
}
|
||||
|
||||
if ((idx1 == suffixStart) && (parsePtr->numWords == 4)) {
|
||||
/*
|
||||
* This is a "no-op". Example: [lreplace {a b c} 2 0]
|
||||
|
||||
@@ -1494,7 +1494,7 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData,
|
||||
#endif
|
||||
|
||||
#define TclGetInt4AtPtr(p) \
|
||||
(((int) TclGetInt1AtPtr(p) << 24) | \
|
||||
(((int) (TclGetUInt1AtPtr(p) << 24)) | \
|
||||
(*((p)+1) << 16) | \
|
||||
(*((p)+2) << 8) | \
|
||||
(*((p)+3)))
|
||||
|
||||
+69
-40
@@ -56,7 +56,6 @@ static const struct {
|
||||
* Function declarations for things defined in this file.
|
||||
*/
|
||||
|
||||
static Class * AllocClass(Tcl_Interp *interp, Object *useThisObj);
|
||||
static Object * AllocObject(Tcl_Interp *interp, const char *nameStr,
|
||||
Namespace *nsPtr, const char *nsNameStr);
|
||||
static int CloneClassMethod(Tcl_Interp *interp, Class *clsPtr,
|
||||
@@ -79,8 +78,6 @@ static void ObjectNamespaceDeleted(ClientData clientData);
|
||||
static void ObjectRenamedTrace(ClientData clientData,
|
||||
Tcl_Interp *interp, const char *oldName,
|
||||
const char *newName, int flags);
|
||||
static void ReleaseClassContents(Tcl_Interp *interp,Object *oPtr);
|
||||
static void DeleteDescendants(Tcl_Interp *interp,Object *oPtr);
|
||||
static inline void SquelchCachedName(Object *oPtr);
|
||||
|
||||
static int PublicObjectCmd(ClientData clientData,
|
||||
@@ -392,10 +389,10 @@ InitFoundation(
|
||||
|
||||
/* Stand up a phony class for bootstrapping. */
|
||||
fPtr->objectCls = &fakeCls;
|
||||
/* referenced in AllocClass to increment the refCount. */
|
||||
/* referenced in TclOOAllocClass to increment the refCount. */
|
||||
fakeCls.thisPtr = &fakeObject;
|
||||
|
||||
fPtr->objectCls = AllocClass(interp,
|
||||
fPtr->objectCls = TclOOAllocClass(interp,
|
||||
AllocObject(interp, "object", (Namespace *)fPtr->ooNs, NULL));
|
||||
/* Corresponding TclOODecrRefCount in KillFoudation */
|
||||
AddRef(fPtr->objectCls->thisPtr);
|
||||
@@ -411,7 +408,7 @@ InitFoundation(
|
||||
fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT;
|
||||
fPtr->objectCls->flags |= ROOT_OBJECT;
|
||||
|
||||
fPtr->classCls = AllocClass(interp,
|
||||
fPtr->classCls = TclOOAllocClass(interp,
|
||||
AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL));
|
||||
/* Corresponding TclOODecrRefCount in KillFoudation */
|
||||
AddRef(fPtr->classCls->thisPtr);
|
||||
@@ -829,15 +826,15 @@ ObjectRenamedTrace(
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* DeleteDescendants --
|
||||
* TclOODeleteDescendants --
|
||||
*
|
||||
* Delete all descendants of a particular class.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static void
|
||||
DeleteDescendants(
|
||||
void
|
||||
TclOODeleteDescendants(
|
||||
Tcl_Interp *interp, /* The interpreter containing the class. */
|
||||
Object *oPtr) /* The object representing the class. */
|
||||
{
|
||||
@@ -854,7 +851,8 @@ DeleteDescendants(
|
||||
/* This condition also covers the case where mixinSubclassPtr ==
|
||||
* clsPtr
|
||||
*/
|
||||
if (!Deleted(mixinSubclassPtr->thisPtr)) {
|
||||
if (!Deleted(mixinSubclassPtr->thisPtr)
|
||||
&& !(mixinSubclassPtr->thisPtr->flags & DONT_DELETE)) {
|
||||
Tcl_DeleteCommandFromToken(interp,
|
||||
mixinSubclassPtr->thisPtr->command);
|
||||
}
|
||||
@@ -872,8 +870,10 @@ DeleteDescendants(
|
||||
if (clsPtr->subclasses.num > 0) {
|
||||
while (clsPtr->subclasses.num > 0) {
|
||||
subclassPtr = clsPtr->subclasses.list[clsPtr->subclasses.num-1];
|
||||
if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr)) {
|
||||
Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command);
|
||||
if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr)
|
||||
&& !(subclassPtr->thisPtr->flags & DONT_DELETE)) {
|
||||
Tcl_DeleteCommandFromToken(interp,
|
||||
subclassPtr->thisPtr->command);
|
||||
}
|
||||
TclOORemoveFromSubclasses(subclassPtr, clsPtr);
|
||||
}
|
||||
@@ -892,7 +892,8 @@ DeleteDescendants(
|
||||
while (clsPtr->instances.num > 0) {
|
||||
instancePtr = clsPtr->instances.list[clsPtr->instances.num-1];
|
||||
/* This condition also covers the case where instancePtr == oPtr */
|
||||
if (!Deleted(instancePtr) && !IsRoot(instancePtr)) {
|
||||
if (!Deleted(instancePtr) && !IsRoot(instancePtr) &&
|
||||
!(instancePtr->flags & DONT_DELETE)) {
|
||||
Tcl_DeleteCommandFromToken(interp, instancePtr->command);
|
||||
}
|
||||
TclOORemoveFromInstances(instancePtr, clsPtr);
|
||||
@@ -909,7 +910,7 @@ DeleteDescendants(
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* ReleaseClassContents --
|
||||
* TclOOReleaseClassContents --
|
||||
*
|
||||
* Tear down the special class data structure, including deleting all
|
||||
* dependent classes and objects.
|
||||
@@ -917,8 +918,8 @@ DeleteDescendants(
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static void
|
||||
ReleaseClassContents(
|
||||
void
|
||||
TclOOReleaseClassContents(
|
||||
Tcl_Interp *interp, /* The interpreter containing the class. */
|
||||
Object *oPtr) /* The object representing the class. */
|
||||
{
|
||||
@@ -940,9 +941,6 @@ ReleaseClassContents(
|
||||
} else if (IsRootObject(oPtr)) {
|
||||
Tcl_Panic("deleting class structure for non-deleted %s",
|
||||
"::oo::object");
|
||||
} else {
|
||||
Tcl_Panic("deleting class structure for non-deleted %s",
|
||||
"general object");
|
||||
}
|
||||
}
|
||||
|
||||
@@ -1037,6 +1035,7 @@ ReleaseClassContents(
|
||||
if (IsRootClass(oPtr) && !Deleted(fPtr->objectCls->thisPtr)) {
|
||||
Tcl_DeleteCommandFromToken(interp, fPtr->objectCls->thisPtr->command);
|
||||
}
|
||||
oPtr->classPtr = NULL;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -1082,7 +1081,7 @@ ObjectNamespaceDeleted(
|
||||
|
||||
/* Let the dominoes fall */
|
||||
if (oPtr->classPtr) {
|
||||
DeleteDescendants(interp, oPtr);
|
||||
TclOODeleteDescendants(interp, oPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -1194,27 +1193,25 @@ ObjectNamespaceDeleted(
|
||||
}
|
||||
|
||||
/*
|
||||
* Because an object can be a class that is an instance of itself, the
|
||||
* A class object's class structure should only be cleaned after most of
|
||||
* the cleanup on the object is done.
|
||||
*/
|
||||
|
||||
|
||||
/*
|
||||
* Because an object can be a class that is an instance of itself, the
|
||||
* class object's class structure should only be cleaned after most of
|
||||
* the cleanup on the object is done.
|
||||
*
|
||||
* The class of objects needs some special care; if it is deleted (and
|
||||
* we're not killing the whole interpreter) we force the delete of the
|
||||
* class of classes now as well. Due to the incestuous nature of those two
|
||||
* classes, if one goes the other must too and yet the tangle can
|
||||
* sometimes not go away automatically; we force it here. [Bug 2962664]
|
||||
*/
|
||||
|
||||
if (IsRootObject(oPtr) && !Deleted(fPtr->classCls->thisPtr)
|
||||
&& !Tcl_InterpDeleted(interp)) {
|
||||
&& !Tcl_InterpDeleted(interp)) {
|
||||
|
||||
Tcl_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command);
|
||||
}
|
||||
|
||||
if (oPtr->classPtr != NULL) {
|
||||
ReleaseClassContents(interp, oPtr);
|
||||
TclOOReleaseClassContents(interp, oPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -1325,6 +1322,37 @@ TclOOAddToInstances(
|
||||
AddRef(oPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TclOORemoveFromMixins --
|
||||
*
|
||||
* Utility function to remove a class from the list of mixins within an
|
||||
* object.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
TclOORemoveFromMixins(
|
||||
Class *mixinPtr, /* The mixin to remove. */
|
||||
Object *oPtr) /* The object (possibly) containing the
|
||||
* reference to the mixin. */
|
||||
{
|
||||
int i, res = 0;
|
||||
Class *mixPtr;
|
||||
|
||||
FOREACH(mixPtr, oPtr->mixins) {
|
||||
if (mixinPtr == mixPtr) {
|
||||
RemoveItem(Class, oPtr->mixins, i);
|
||||
TclOODecrRefCount(mixPtr->thisPtr);
|
||||
res++;
|
||||
break;
|
||||
}
|
||||
}
|
||||
return res;
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
@@ -1381,7 +1409,8 @@ TclOOAddToSubclasses(
|
||||
if (superPtr->subclasses.size == ALLOC_CHUNK) {
|
||||
superPtr->subclasses.list = ckalloc(sizeof(Class *) * ALLOC_CHUNK);
|
||||
} else {
|
||||
superPtr->subclasses.list = ckrealloc(superPtr->subclasses.list, sizeof(Class *) * superPtr->subclasses.size);
|
||||
superPtr->subclasses.list = ckrealloc(superPtr->subclasses.list,
|
||||
sizeof(Class *) * superPtr->subclasses.size);
|
||||
}
|
||||
}
|
||||
superPtr->subclasses.list[superPtr->subclasses.num++] = subPtr;
|
||||
@@ -1456,16 +1485,16 @@ TclOOAddToMixinSubs(
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* AllocClass --
|
||||
* TclOOAllocClass --
|
||||
*
|
||||
* Allocate a basic class. Does not add class to its
|
||||
* class's instance list.
|
||||
* Allocate a basic class. Does not add class to its class's instance
|
||||
* list.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static Class *
|
||||
AllocClass(
|
||||
Class *
|
||||
TclOOAllocClass(
|
||||
Tcl_Interp *interp, /* Interpreter within which to allocate the
|
||||
* class. */
|
||||
Object *useThisObj) /* Object that is to act as the class
|
||||
@@ -1709,13 +1738,13 @@ TclNewObjectInstanceCommon(
|
||||
|
||||
if (TclOOIsReachable(fPtr->classCls, classPtr)) {
|
||||
/*
|
||||
* Is a class, so attach a class structure. Note that the AllocClass
|
||||
* function splices the structure into the object, so we don't have
|
||||
* to. Once that's done, we need to repatch the object to have the
|
||||
* right class since AllocClass interferes with that.
|
||||
* Is a class, so attach a class structure. Note that the
|
||||
* TclOOAllocClass function splices the structure into the object, so
|
||||
* we don't have to. Once that's done, we need to repatch the object
|
||||
* to have the right class since TclOOAllocClass interferes with that.
|
||||
*/
|
||||
|
||||
AllocClass(interp, oPtr);
|
||||
TclOOAllocClass(interp, oPtr);
|
||||
TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls);
|
||||
} else {
|
||||
oPtr->classPtr = NULL;
|
||||
|
||||
@@ -1444,7 +1444,6 @@ AddSimpleClassChainToCallContext(
|
||||
if (flags & CONSTRUCTOR) {
|
||||
AddMethodToCallChain(classPtr->constructorPtr, cbPtr, doneFilters,
|
||||
filterDecl, flags);
|
||||
|
||||
} else if (flags & DESTRUCTOR) {
|
||||
AddMethodToCallChain(classPtr->destructorPtr, cbPtr, doneFilters,
|
||||
filterDecl, flags);
|
||||
|
||||
@@ -1083,6 +1083,8 @@ TclOODefineClassObjCmd(
|
||||
{
|
||||
Object *oPtr;
|
||||
Class *clsPtr;
|
||||
Foundation *fPtr = TclOOGetFoundation(interp);
|
||||
int wasClass, willBeClass;
|
||||
|
||||
/*
|
||||
* Parse the context to get the object to operate on.
|
||||
@@ -1118,12 +1120,20 @@ TclOODefineClassObjCmd(
|
||||
if (clsPtr == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
if (oPtr == clsPtr->thisPtr) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"may not change classes into an instance of themselves", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Set the object's class.
|
||||
*/
|
||||
|
||||
wasClass = (oPtr->classPtr != NULL);
|
||||
willBeClass = (TclOOIsReachable(fPtr->classCls, clsPtr));
|
||||
|
||||
if (oPtr->selfCls != clsPtr) {
|
||||
TclOORemoveFromInstances(oPtr, oPtr->selfCls);
|
||||
TclOODecrRefCount(oPtr->selfCls->thisPtr);
|
||||
@@ -1131,6 +1141,26 @@ TclOODefineClassObjCmd(
|
||||
AddRef(oPtr->selfCls->thisPtr);
|
||||
TclOOAddToInstances(oPtr, oPtr->selfCls);
|
||||
|
||||
/*
|
||||
* Create or delete the class guts if necessary.
|
||||
*/
|
||||
|
||||
if (wasClass && !willBeClass) {
|
||||
/*
|
||||
* This is the most global of all epochs. Bump it! No cache can be
|
||||
* trusted!
|
||||
*/
|
||||
|
||||
TclOORemoveFromMixins(oPtr->classPtr, oPtr);
|
||||
oPtr->fPtr->epoch++;
|
||||
oPtr->flags |= DONT_DELETE;
|
||||
TclOODeleteDescendants(interp, oPtr);
|
||||
oPtr->flags &= ~DONT_DELETE;
|
||||
TclOOReleaseClassContents(interp, oPtr);
|
||||
} else if (!wasClass && willBeClass) {
|
||||
TclOOAllocClass(interp, oPtr);
|
||||
}
|
||||
|
||||
if (oPtr->classPtr != NULL) {
|
||||
BumpGlobalEpoch(interp, oPtr->classPtr);
|
||||
} else {
|
||||
|
||||
@@ -214,6 +214,7 @@ typedef struct Object {
|
||||
* other spots). */
|
||||
#define FORCE_UNKNOWN 0x10000 /* States that we are *really* looking up the
|
||||
* unknown method handler at that point. */
|
||||
#define DONT_DELETE 0x20000 /* Inhibit deletion of this object. */
|
||||
|
||||
/*
|
||||
* And the definition of a class. Note that every class also has an associated
|
||||
@@ -484,6 +485,8 @@ MODULE_SCOPE int TclOO_Object_VarName(ClientData clientData,
|
||||
MODULE_SCOPE void TclOOAddToInstances(Object *oPtr, Class *clsPtr);
|
||||
MODULE_SCOPE void TclOOAddToMixinSubs(Class *subPtr, Class *mixinPtr);
|
||||
MODULE_SCOPE void TclOOAddToSubclasses(Class *subPtr, Class *superPtr);
|
||||
MODULE_SCOPE Class * TclOOAllocClass(Tcl_Interp *interp,
|
||||
Object *useThisObj);
|
||||
MODULE_SCOPE int TclNRNewObjectInstance(Tcl_Interp *interp,
|
||||
Tcl_Class cls, const char *nameStr,
|
||||
const char *nsNameStr, int objc,
|
||||
@@ -498,6 +501,8 @@ MODULE_SCOPE int TclOODefineSlots(Foundation *fPtr);
|
||||
MODULE_SCOPE void TclOODeleteChain(CallChain *callPtr);
|
||||
MODULE_SCOPE void TclOODeleteChainCache(Tcl_HashTable *tablePtr);
|
||||
MODULE_SCOPE void TclOODeleteContext(CallContext *contextPtr);
|
||||
MODULE_SCOPE void TclOODeleteDescendants(Tcl_Interp *interp,
|
||||
Object *oPtr);
|
||||
MODULE_SCOPE void TclOODelMethodRef(Method *method);
|
||||
MODULE_SCOPE CallContext *TclOOGetCallContext(Object *oPtr,
|
||||
Tcl_Obj *methodNameObj, int flags,
|
||||
@@ -523,7 +528,10 @@ MODULE_SCOPE int TclNRObjectContextInvokeNext(Tcl_Interp *interp,
|
||||
MODULE_SCOPE void TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr,
|
||||
const DeclaredClassMethod *dcm);
|
||||
MODULE_SCOPE Tcl_Obj * TclOOObjectName(Tcl_Interp *interp, Object *oPtr);
|
||||
MODULE_SCOPE void TclOOReleaseClassContents(Tcl_Interp *interp,
|
||||
Object *oPtr);
|
||||
MODULE_SCOPE int TclOORemoveFromInstances(Object *oPtr, Class *clsPtr);
|
||||
MODULE_SCOPE int TclOORemoveFromMixins(Class *mixinPtr, Object *oPtr);
|
||||
MODULE_SCOPE int TclOORemoveFromMixinSubs(Class *subPtr,
|
||||
Class *mixinPtr);
|
||||
MODULE_SCOPE int TclOORemoveFromSubclasses(Class *subPtr,
|
||||
|
||||
+23
-21
@@ -504,10 +504,11 @@ TclCreateProc(
|
||||
goto procError;
|
||||
}
|
||||
|
||||
nameLength = Tcl_NumUtfChars(Tcl_GetString(fieldValues[0]), fieldValues[0]->length);
|
||||
argname = Tcl_GetStringFromObj(fieldValues[0], &plen);
|
||||
nameLength = Tcl_NumUtfChars(argname, plen);
|
||||
if (fieldCount == 2) {
|
||||
valueLength = Tcl_NumUtfChars(Tcl_GetString(fieldValues[1]),
|
||||
fieldValues[1]->length);
|
||||
const char * value = TclGetString(fieldValues[1]);
|
||||
valueLength = Tcl_NumUtfChars(value, fieldValues[1]->length);
|
||||
} else {
|
||||
valueLength = 0;
|
||||
}
|
||||
@@ -516,7 +517,6 @@ TclCreateProc(
|
||||
* Check that the formal parameter name is a scalar.
|
||||
*/
|
||||
|
||||
argname = Tcl_GetStringFromObj(fieldValues[0], &plen);
|
||||
argnamei = argname;
|
||||
argnamelast = argname[plen-1];
|
||||
while (plen--) {
|
||||
@@ -611,7 +611,7 @@ TclCreateProc(
|
||||
procPtr->lastLocalPtr = localPtr;
|
||||
}
|
||||
localPtr->nextPtr = NULL;
|
||||
localPtr->nameLength = Tcl_NumUtfChars(argname, fieldValues[0]->length);
|
||||
localPtr->nameLength = nameLength;
|
||||
localPtr->frameIndex = i;
|
||||
localPtr->flags = VAR_ARGUMENT;
|
||||
localPtr->resolveInfo = NULL;
|
||||
@@ -1035,7 +1035,6 @@ ProcWrongNumArgs(
|
||||
{
|
||||
CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
|
||||
register Proc *procPtr = framePtr->procPtr;
|
||||
register Var *defPtr;
|
||||
int localCt = procPtr->numCompiledLocals, numArgs, i;
|
||||
Tcl_Obj **desiredObjs;
|
||||
const char *final = NULL;
|
||||
@@ -1059,23 +1058,26 @@ ProcWrongNumArgs(
|
||||
}
|
||||
Tcl_IncrRefCount(desiredObjs[0]);
|
||||
|
||||
defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);
|
||||
for (i=1 ; i<=numArgs ; i++, defPtr++) {
|
||||
Tcl_Obj *argObj;
|
||||
Tcl_Obj *namePtr = localName(framePtr, i-1);
|
||||
if (localCt > 0) {
|
||||
register Var *defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);
|
||||
|
||||
if (defPtr->value.objPtr != NULL) {
|
||||
TclNewObj(argObj);
|
||||
Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", NULL);
|
||||
} else if (defPtr->flags & VAR_IS_ARGS) {
|
||||
numArgs--;
|
||||
final = "?arg ...?";
|
||||
break;
|
||||
} else {
|
||||
argObj = namePtr;
|
||||
Tcl_IncrRefCount(namePtr);
|
||||
for (i=1 ; i<=numArgs ; i++, defPtr++) {
|
||||
Tcl_Obj *argObj;
|
||||
Tcl_Obj *namePtr = localName(framePtr, i-1);
|
||||
|
||||
if (defPtr->value.objPtr != NULL) {
|
||||
TclNewObj(argObj);
|
||||
Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", NULL);
|
||||
} else if (defPtr->flags & VAR_IS_ARGS) {
|
||||
numArgs--;
|
||||
final = "?arg ...?";
|
||||
break;
|
||||
} else {
|
||||
argObj = namePtr;
|
||||
Tcl_IncrRefCount(namePtr);
|
||||
}
|
||||
desiredObjs[i] = argObj;
|
||||
}
|
||||
desiredObjs[i] = argObj;
|
||||
}
|
||||
|
||||
Tcl_ResetResult(interp);
|
||||
|
||||
+15
-42
@@ -12,6 +12,10 @@
|
||||
#include "tclInt.h"
|
||||
#include "tommath.h"
|
||||
|
||||
#ifdef __CYGWIN__
|
||||
# include <wchar.h>
|
||||
#endif
|
||||
|
||||
#ifdef __GNUC__
|
||||
#pragma GCC dependency "tcl.decls"
|
||||
#pragma GCC dependency "tclInt.decls"
|
||||
@@ -106,10 +110,6 @@ static unsigned short TclWinNToHS(unsigned short ns) {
|
||||
# define TclWinFlushDirtyChannels doNothing
|
||||
# define TclWinResetInterfaces doNothing
|
||||
|
||||
#if TCL_UTF_MAX < 4
|
||||
static Tcl_Encoding winTCharEncoding;
|
||||
#endif
|
||||
|
||||
static int
|
||||
TclpIsAtty(int fd)
|
||||
{
|
||||
@@ -188,25 +188,11 @@ Tcl_WinUtfToTChar(
|
||||
int len,
|
||||
Tcl_DString *dsPtr)
|
||||
{
|
||||
#if TCL_UTF_MAX > 3
|
||||
WCHAR *wp;
|
||||
int size = MultiByteToWideChar(CP_UTF8, 0, string, len, 0, 0);
|
||||
|
||||
Tcl_DStringInit(dsPtr);
|
||||
Tcl_DStringSetLength(dsPtr, 2*size+2);
|
||||
wp = (WCHAR *)Tcl_DStringValue(dsPtr);
|
||||
MultiByteToWideChar(CP_UTF8, 0, string, len, wp, size+1);
|
||||
if (len == -1) --size; /* account for 0-byte at string end */
|
||||
Tcl_DStringSetLength(dsPtr, 2*size);
|
||||
wp[size] = 0;
|
||||
return (char *)wp;
|
||||
#else
|
||||
if (!winTCharEncoding) {
|
||||
winTCharEncoding = Tcl_GetEncoding(0, "unicode");
|
||||
if (!string) {
|
||||
return NULL;
|
||||
}
|
||||
return Tcl_UtfToExternalDString(winTCharEncoding,
|
||||
string, len, dsPtr);
|
||||
#endif
|
||||
return (char *)Tcl_UtfToUniCharDString(string, len, dsPtr);
|
||||
}
|
||||
|
||||
char *
|
||||
@@ -215,29 +201,16 @@ Tcl_WinTCharToUtf(
|
||||
int len,
|
||||
Tcl_DString *dsPtr)
|
||||
{
|
||||
#if TCL_UTF_MAX > 3
|
||||
char *p;
|
||||
int size;
|
||||
|
||||
if (len > 0) {
|
||||
Tcl_DStringInit(dsPtr);
|
||||
if (!string) {
|
||||
return NULL;
|
||||
}
|
||||
if (len < 0) {
|
||||
len = wcslen((wchar_t *)string);
|
||||
} else {
|
||||
len /= 2;
|
||||
}
|
||||
size = WideCharToMultiByte(CP_UTF8, 0, string, len, 0, 0, NULL, NULL);
|
||||
Tcl_DStringInit(dsPtr);
|
||||
Tcl_DStringSetLength(dsPtr, size+1);
|
||||
p = (char *)Tcl_DStringValue(dsPtr);
|
||||
WideCharToMultiByte(CP_UTF8, 0, string, len, p, size, NULL, NULL);
|
||||
if (len == -1) --size; /* account for 0-byte at string end */
|
||||
Tcl_DStringSetLength(dsPtr, size);
|
||||
p[size] = 0;
|
||||
return p;
|
||||
#else
|
||||
if (!winTCharEncoding) {
|
||||
winTCharEncoding = Tcl_GetEncoding(0, "unicode");
|
||||
}
|
||||
return Tcl_ExternalToUtfDString(winTCharEncoding,
|
||||
string, len, dsPtr);
|
||||
#endif
|
||||
return Tcl_UniCharToUtfDString((Tcl_UniChar *)string, len, dsPtr);
|
||||
}
|
||||
|
||||
#if defined(TCL_WIDE_INT_IS_LONG)
|
||||
|
||||
+15
-5
@@ -243,7 +243,7 @@ Tcl_UniCharToUtfDString(
|
||||
*/
|
||||
|
||||
oldLength = Tcl_DStringLength(dsPtr);
|
||||
Tcl_DStringSetLength(dsPtr, (oldLength + uniLength + 1) * TCL_UTF_MAX);
|
||||
Tcl_DStringSetLength(dsPtr, oldLength + (uniLength + 1) * TCL_UTF_MAX);
|
||||
string = Tcl_DStringValue(dsPtr) + oldLength;
|
||||
|
||||
p = string;
|
||||
@@ -432,17 +432,27 @@ Tcl_UtfToUniCharDString(
|
||||
*/
|
||||
|
||||
oldLength = Tcl_DStringLength(dsPtr);
|
||||
/* TODO: fix overreach! */
|
||||
|
||||
Tcl_DStringSetLength(dsPtr,
|
||||
(int) ((oldLength + length + 1) * sizeof(Tcl_UniChar)));
|
||||
oldLength + (int) ((length + 1) * sizeof(Tcl_UniChar)));
|
||||
wString = (Tcl_UniChar *) (Tcl_DStringValue(dsPtr) + oldLength);
|
||||
|
||||
w = wString;
|
||||
end = src + length;
|
||||
for (p = src; p < end; ) {
|
||||
p = src;
|
||||
end = src + length - TCL_UTF_MAX;
|
||||
while (p < end) {
|
||||
p += TclUtfToUniChar(p, &ch);
|
||||
*w++ = ch;
|
||||
}
|
||||
end += TCL_UTF_MAX;
|
||||
while (p < end) {
|
||||
if (Tcl_UtfCharComplete(p, end-p)) {
|
||||
p += TclUtfToUniChar(p, &ch);
|
||||
} else {
|
||||
ch = UCHAR(*p++);
|
||||
}
|
||||
*w++ = ch;
|
||||
}
|
||||
*w = '\0';
|
||||
Tcl_DStringSetLength(dsPtr,
|
||||
(oldLength + ((char *) w - (char *) wString)));
|
||||
|
||||
+30
-23
@@ -972,20 +972,24 @@ TclLookupSimpleVar(
|
||||
}
|
||||
}
|
||||
} else { /* Local var: look in frame varFramePtr. */
|
||||
int localLen, localCt = varFramePtr->numCompiledLocals;
|
||||
Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
|
||||
const char *localNameStr;
|
||||
int localCt = varFramePtr->numCompiledLocals;
|
||||
|
||||
for (i=0 ; i<localCt ; i++, objPtrPtr++) {
|
||||
register Tcl_Obj *objPtr = *objPtrPtr;
|
||||
if (localCt > 0) {
|
||||
Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
|
||||
const char *localNameStr;
|
||||
int localLen;
|
||||
|
||||
if (objPtr) {
|
||||
localNameStr = TclGetStringFromObj(objPtr, &localLen);
|
||||
for (i=0 ; i<localCt ; i++, objPtrPtr++) {
|
||||
register Tcl_Obj *objPtr = *objPtrPtr;
|
||||
|
||||
if ((varLen == localLen) && (varName[0] == localNameStr[0])
|
||||
if (objPtr) {
|
||||
localNameStr = TclGetStringFromObj(objPtr, &localLen);
|
||||
|
||||
if ((varLen == localLen) && (varName[0] == localNameStr[0])
|
||||
&& !memcmp(varName, localNameStr, varLen)) {
|
||||
*indexPtr = i;
|
||||
return (Var *) &varFramePtr->compiledLocals[i];
|
||||
*indexPtr = i;
|
||||
return (Var *) &varFramePtr->compiledLocals[i];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -6132,7 +6136,7 @@ AppendLocals(
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
Var *varPtr;
|
||||
int i, localVarCt, added;
|
||||
Tcl_Obj **varNamePtr, *objNamePtr;
|
||||
Tcl_Obj *objNamePtr;
|
||||
const char *varName;
|
||||
TclVarHashTable *localVarTablePtr;
|
||||
Tcl_HashSearch search;
|
||||
@@ -6142,27 +6146,30 @@ AppendLocals(
|
||||
localVarCt = iPtr->varFramePtr->numCompiledLocals;
|
||||
varPtr = iPtr->varFramePtr->compiledLocals;
|
||||
localVarTablePtr = iPtr->varFramePtr->varTablePtr;
|
||||
varNamePtr = &iPtr->varFramePtr->localCachePtr->varName0;
|
||||
if (includeLinks) {
|
||||
Tcl_InitObjHashTable(&addedTable);
|
||||
}
|
||||
|
||||
for (i = 0; i < localVarCt; i++, varNamePtr++) {
|
||||
/*
|
||||
* Skip nameless (temporary) variables and undefined variables.
|
||||
*/
|
||||
if (localVarCt > 0) {
|
||||
Tcl_Obj **varNamePtr = &iPtr->varFramePtr->localCachePtr->varName0;
|
||||
|
||||
if (*varNamePtr && !TclIsVarUndefined(varPtr)
|
||||
for (i = 0; i < localVarCt; i++, varNamePtr++) {
|
||||
/*
|
||||
* Skip nameless (temporary) variables and undefined variables.
|
||||
*/
|
||||
|
||||
if (*varNamePtr && !TclIsVarUndefined(varPtr)
|
||||
&& (includeLinks || !TclIsVarLink(varPtr))) {
|
||||
varName = TclGetString(*varNamePtr);
|
||||
if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
|
||||
Tcl_ListObjAppendElement(interp, listPtr, *varNamePtr);
|
||||
if (includeLinks) {
|
||||
Tcl_CreateHashEntry(&addedTable, *varNamePtr, &added);
|
||||
varName = TclGetString(*varNamePtr);
|
||||
if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
|
||||
Tcl_ListObjAppendElement(interp, listPtr, *varNamePtr);
|
||||
if (includeLinks) {
|
||||
Tcl_CreateHashEntry(&addedTable, *varNamePtr, &added);
|
||||
}
|
||||
}
|
||||
}
|
||||
varPtr++;
|
||||
}
|
||||
varPtr++;
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
if {([info commands ::tcl::pkgconfig] eq "")
|
||||
|| ([info sharedlibextension] ne ".dll")} return
|
||||
if {[::tcl::pkgconfig get debug]} {
|
||||
package ifneeded dde 1.4.0 [list load [file join $dir tcldde14g.dll] dde]
|
||||
package ifneeded dde 1.4.1 [list load [file join $dir tcldde14g.dll] dde]
|
||||
} else {
|
||||
package ifneeded dde 1.4.0 [list load [file join $dir tcldde14.dll] dde]
|
||||
package ifneeded dde 1.4.1 [list load [file join $dir tcldde14.dll] dde]
|
||||
}
|
||||
|
||||
+2177
-335
File diff suppressed because it is too large
Load Diff
@@ -1,2 +1,2 @@
|
||||
if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
|
||||
package ifneeded http 2.8.13 [list tclPkgSetup $dir http 2.8.13 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
|
||||
package ifneeded http 2.9.0 [list tclPkgSetup $dir http 2.9.0 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
|
||||
|
||||
@@ -1,9 +1,9 @@
|
||||
if {([info commands ::tcl::pkgconfig] eq "")
|
||||
|| ([info sharedlibextension] ne ".dll")} return
|
||||
if {[::tcl::pkgconfig get debug]} {
|
||||
package ifneeded registry 1.3.2 \
|
||||
package ifneeded registry 1.3.3 \
|
||||
[list load [file join $dir tclreg13g.dll] registry]
|
||||
} else {
|
||||
package ifneeded registry 1.3.2 \
|
||||
package ifneeded registry 1.3.3 \
|
||||
[list load [file join $dir tclreg13.dll] registry]
|
||||
}
|
||||
|
||||
@@ -8,5 +8,5 @@
|
||||
# script is sourced, the variable $dir must contain the
|
||||
# full path name of this file's directory.
|
||||
|
||||
if {![package vsatisfies [package provide Tcl] 8.5]} {return}
|
||||
package ifneeded tcltest 2.4.1 [list source [file join $dir tcltest.tcl]]
|
||||
if {![package vsatisfies [package provide Tcl] 8.5-]} {return}
|
||||
package ifneeded tcltest 2.5.0 [list source [file join $dir tcltest.tcl]]
|
||||
|
||||
+34
-17
@@ -22,7 +22,7 @@ namespace eval tcltest {
|
||||
# When the version number changes, be sure to update the pkgIndex.tcl file,
|
||||
# and the install directory in the Makefiles. When the minor version
|
||||
# changes (new feature) be sure to update the man page as well.
|
||||
variable Version 2.4.1
|
||||
variable Version 2.5.0
|
||||
|
||||
# Compatibility support for dumb variables defined in tcltest 1
|
||||
# Do not use these. Call [package provide Tcl] and [info patchlevel]
|
||||
@@ -1254,10 +1254,6 @@ proc tcltest::DefineConstraintInitializers {} {
|
||||
ConstraintInitializer interactive \
|
||||
{expr {[info exists ::tcl_interactive] && $::tcl_interactive}}
|
||||
|
||||
# Skip slow tests (to enable slow tests add parameter `-constraints slowTest`)
|
||||
|
||||
ConstraintInitializer slowTest {format 0}
|
||||
|
||||
# Some tests can only be run if the installation came from a CD
|
||||
# image instead of a web image. Some tests must be skipped if you
|
||||
# are running as root on Unix. Other tests can only be run if you
|
||||
@@ -1845,6 +1841,9 @@ proc tcltest::SubstArguments {argList} {
|
||||
# is optional; default is {}.
|
||||
# returnCodes - Expected return codes. This attribute is
|
||||
# optional; default is {0 2}.
|
||||
# errorCode - Expected error code. This attribute is
|
||||
# optional; default is {*}. It is a glob pattern.
|
||||
# If given, returnCodes defaults to {1}.
|
||||
# setup - Code to run before $script (above). This
|
||||
# attribute is optional; default is {}.
|
||||
# cleanup - Code to run after $script (above). This
|
||||
@@ -1886,7 +1885,7 @@ proc tcltest::test {name description args} {
|
||||
# Pre-define everything to null except output and errorOutput. We
|
||||
# determine whether or not to trap output based on whether or not
|
||||
# these variables (output & errorOutput) are defined.
|
||||
lassign {} constraints setup cleanup body result returnCodes match
|
||||
lassign {} constraints setup cleanup body result returnCodes errorCode match
|
||||
|
||||
# Set the default match mode
|
||||
set match exact
|
||||
@@ -1896,6 +1895,9 @@ proc tcltest::test {name description args} {
|
||||
# 'return' being used in the test script).
|
||||
set returnCodes [list 0 2]
|
||||
|
||||
# Set the default error code pattern
|
||||
set errorCode "*"
|
||||
|
||||
# The old test format can't have a 3rd argument (constraints or
|
||||
# script) that starts with '-'.
|
||||
if {[string match -* [lindex $args 0]] || ([llength $args] <= 1)} {
|
||||
@@ -1905,7 +1907,7 @@ proc tcltest::test {name description args} {
|
||||
set testAttributes($element) $value
|
||||
}
|
||||
foreach item {constraints match setup body cleanup \
|
||||
result returnCodes output errorOutput} {
|
||||
result returnCodes errorCode output errorOutput} {
|
||||
if {[info exists testAttributes(-$item)]} {
|
||||
set testAttributes(-$item) [uplevel 1 \
|
||||
::concat $testAttributes(-$item)]
|
||||
@@ -1916,7 +1918,7 @@ proc tcltest::test {name description args} {
|
||||
}
|
||||
|
||||
set validFlags {-setup -cleanup -body -result -returnCodes \
|
||||
-match -output -errorOutput -constraints}
|
||||
-errorCode -match -output -errorOutput -constraints}
|
||||
|
||||
foreach flag [array names testAttributes] {
|
||||
if {$flag ni $validFlags} {
|
||||
@@ -1948,6 +1950,10 @@ proc tcltest::test {name description args} {
|
||||
foreach {strcode numcode} {ok 0 normal 0 error 1 return 2 break 3 continue 4} {
|
||||
set returnCodes [string map -nocase [list $strcode $numcode] $returnCodes]
|
||||
}
|
||||
# errorCode without returnCode 1 is meaningless
|
||||
if {$errorCode ne "*" && 1 ni $returnCodes} {
|
||||
set returnCodes 1
|
||||
}
|
||||
} else {
|
||||
# This is parsing for the old test command format; it is here
|
||||
# for backward compatibility.
|
||||
@@ -1980,7 +1986,7 @@ proc tcltest::test {name description args} {
|
||||
set code [catch {uplevel 1 $setup} setupMsg]
|
||||
if {$code == 1} {
|
||||
set errorInfo(setup) $::errorInfo
|
||||
set errorCode(setup) $::errorCode
|
||||
set errorCodeRes(setup) $::errorCode
|
||||
}
|
||||
set setupFailure [expr {$code != 0}]
|
||||
|
||||
@@ -2007,7 +2013,7 @@ proc tcltest::test {name description args} {
|
||||
lassign $testResult actualAnswer returnCode
|
||||
if {$returnCode == 1} {
|
||||
set errorInfo(body) $::errorInfo
|
||||
set errorCode(body) $::errorCode
|
||||
set errorCodeRes(body) $::errorCode
|
||||
}
|
||||
}
|
||||
|
||||
@@ -2016,6 +2022,11 @@ proc tcltest::test {name description args} {
|
||||
if {!$setupFailure && ($returnCode ni $returnCodes)} {
|
||||
set codeFailure 1
|
||||
}
|
||||
set errorCodeFailure 0
|
||||
if {!$setupFailure && !$codeFailure && $returnCode == 1 && \
|
||||
![string match $errorCode $errorCodeRes(body)]} {
|
||||
set errorCodeFailure 1
|
||||
}
|
||||
|
||||
# If expected output/error strings exist, we have to compare
|
||||
# them. If the comparison fails, then so did the test.
|
||||
@@ -2059,7 +2070,7 @@ proc tcltest::test {name description args} {
|
||||
set code [catch {uplevel 1 $cleanup} cleanupMsg]
|
||||
if {$code == 1} {
|
||||
set errorInfo(cleanup) $::errorInfo
|
||||
set errorCode(cleanup) $::errorCode
|
||||
set errorCodeRes(cleanup) $::errorCode
|
||||
}
|
||||
set cleanupFailure [expr {$code != 0}]
|
||||
|
||||
@@ -2110,7 +2121,7 @@ proc tcltest::test {name description args} {
|
||||
variable numTests
|
||||
if {!($setupFailure || $cleanupFailure || $coreFailure
|
||||
|| $outputFailure || $errorFailure || $codeFailure
|
||||
|| $scriptFailure)} {
|
||||
|| $errorCodeFailure || $scriptFailure)} {
|
||||
if {$testLevel == 1} {
|
||||
incr numTests(Passed)
|
||||
if {[IsVerbose pass]} {
|
||||
@@ -2163,7 +2174,7 @@ proc tcltest::test {name description args} {
|
||||
failed:\n$setupMsg"
|
||||
if {[info exists errorInfo(setup)]} {
|
||||
puts [outputChannel] "---- errorInfo(setup): $errorInfo(setup)"
|
||||
puts [outputChannel] "---- errorCode(setup): $errorCode(setup)"
|
||||
puts [outputChannel] "---- errorCode(setup): $errorCodeRes(setup)"
|
||||
}
|
||||
}
|
||||
if {$scriptFailure} {
|
||||
@@ -2175,6 +2186,10 @@ proc tcltest::test {name description args} {
|
||||
($match matching):\n$result"
|
||||
}
|
||||
}
|
||||
if {$errorCodeFailure} {
|
||||
puts [outputChannel] "---- Error code was: '$errorCodeRes(body)'"
|
||||
puts [outputChannel] "---- Error code should have been: '$errorCode'"
|
||||
}
|
||||
if {$codeFailure} {
|
||||
switch -- $returnCode {
|
||||
0 { set msg "Test completed normally" }
|
||||
@@ -2190,7 +2205,7 @@ proc tcltest::test {name description args} {
|
||||
if {[IsVerbose error]} {
|
||||
if {[info exists errorInfo(body)] && (1 ni $returnCodes)} {
|
||||
puts [outputChannel] "---- errorInfo: $errorInfo(body)"
|
||||
puts [outputChannel] "---- errorCode: $errorCode(body)"
|
||||
puts [outputChannel] "---- errorCode: $errorCodeRes(body)"
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -2216,7 +2231,7 @@ proc tcltest::test {name description args} {
|
||||
puts [outputChannel] "---- Test cleanup failed:\n$cleanupMsg"
|
||||
if {[info exists errorInfo(cleanup)]} {
|
||||
puts [outputChannel] "---- errorInfo(cleanup): $errorInfo(cleanup)"
|
||||
puts [outputChannel] "---- errorCode(cleanup): $errorCode(cleanup)"
|
||||
puts [outputChannel] "---- errorCode(cleanup): $errorCodeRes(cleanup)"
|
||||
}
|
||||
}
|
||||
if {$coreFailure} {
|
||||
@@ -2726,7 +2741,7 @@ proc tcltest::GetMatchingDirectories {rootdir} {
|
||||
# shell being tested
|
||||
#
|
||||
# Results:
|
||||
# None.
|
||||
# Whether there were any failures.
|
||||
#
|
||||
# Side effects:
|
||||
# None.
|
||||
@@ -2737,6 +2752,7 @@ proc tcltest::runAllTests { {shell ""} } {
|
||||
variable numTests
|
||||
variable failFiles
|
||||
variable DefaultValue
|
||||
set failFilesAccum {}
|
||||
|
||||
FillFilesExisted
|
||||
if {[llength [info level 0]] == 1} {
|
||||
@@ -2826,6 +2842,7 @@ proc tcltest::runAllTests { {shell ""} } {
|
||||
}
|
||||
if {$Failed > 0} {
|
||||
lappend failFiles $testFile
|
||||
lappend failFilesAccum $testFile
|
||||
}
|
||||
} elseif {[regexp [join {
|
||||
{^Number of tests skipped }
|
||||
@@ -2872,7 +2889,7 @@ proc tcltest::runAllTests { {shell ""} } {
|
||||
puts [outputChannel] ""
|
||||
puts [outputChannel] [string repeat ~ 44]
|
||||
}
|
||||
return
|
||||
return [expr {[info exists testFileFailures] || [llength $failFilesAccum]}]
|
||||
}
|
||||
|
||||
#####################################################################
|
||||
|
||||
@@ -2,229 +2,59 @@
|
||||
|
||||
set TZData(:Africa/Casablanca) {
|
||||
{-9223372036854775808 -1820 0 LMT}
|
||||
{-1773012580 0 0 WET}
|
||||
{-956361600 3600 1 WEST}
|
||||
{-950490000 0 0 WET}
|
||||
{-942019200 3600 1 WEST}
|
||||
{-761187600 0 0 WET}
|
||||
{-617241600 3600 1 WEST}
|
||||
{-605149200 0 0 WET}
|
||||
{-81432000 3600 1 WEST}
|
||||
{-71110800 0 0 WET}
|
||||
{141264000 3600 1 WEST}
|
||||
{147222000 0 0 WET}
|
||||
{199756800 3600 1 WEST}
|
||||
{207702000 0 0 WET}
|
||||
{231292800 3600 1 WEST}
|
||||
{244249200 0 0 WET}
|
||||
{265507200 3600 1 WEST}
|
||||
{271033200 0 0 WET}
|
||||
{448243200 3600 0 CET}
|
||||
{504918000 0 0 WET}
|
||||
{1212278400 3600 1 WEST}
|
||||
{1220223600 0 0 WET}
|
||||
{1243814400 3600 1 WEST}
|
||||
{1250809200 0 0 WET}
|
||||
{1272758400 3600 1 WEST}
|
||||
{1281222000 0 0 WET}
|
||||
{1301788800 3600 1 WEST}
|
||||
{1312066800 0 0 WET}
|
||||
{1335664800 3600 1 WEST}
|
||||
{1342749600 0 0 WET}
|
||||
{1345428000 3600 1 WEST}
|
||||
{1348970400 0 0 WET}
|
||||
{1367114400 3600 1 WEST}
|
||||
{1373162400 0 0 WET}
|
||||
{1376100000 3600 1 WEST}
|
||||
{1382839200 0 0 WET}
|
||||
{1396144800 3600 1 WEST}
|
||||
{1403920800 0 0 WET}
|
||||
{1406944800 3600 1 WEST}
|
||||
{1414288800 0 0 WET}
|
||||
{1427594400 3600 1 WEST}
|
||||
{1434247200 0 0 WET}
|
||||
{1437271200 3600 1 WEST}
|
||||
{1445738400 0 0 WET}
|
||||
{1459044000 3600 1 WEST}
|
||||
{1465092000 0 0 WET}
|
||||
{1468116000 3600 1 WEST}
|
||||
{1477792800 0 0 WET}
|
||||
{1490493600 3600 1 WEST}
|
||||
{1495332000 0 0 WET}
|
||||
{1498960800 3600 1 WEST}
|
||||
{1509242400 0 0 WET}
|
||||
{1521943200 3600 1 WEST}
|
||||
{1526176800 0 0 WET}
|
||||
{1529200800 3600 1 WEST}
|
||||
{1540692000 0 0 WET}
|
||||
{1553997600 3600 1 WEST}
|
||||
{1557021600 0 0 WET}
|
||||
{1560045600 3600 1 WEST}
|
||||
{1572141600 0 0 WET}
|
||||
{1585447200 3600 1 WEST}
|
||||
{1587261600 0 0 WET}
|
||||
{1590285600 3600 1 WEST}
|
||||
{1603591200 0 0 WET}
|
||||
{1616896800 3600 1 WEST}
|
||||
{1618106400 0 0 WET}
|
||||
{1621130400 3600 1 WEST}
|
||||
{1635645600 0 0 WET}
|
||||
{1651975200 3600 1 WEST}
|
||||
{1667095200 0 0 WET}
|
||||
{1682215200 3600 1 WEST}
|
||||
{1698544800 0 0 WET}
|
||||
{1713060000 3600 1 WEST}
|
||||
{1729994400 0 0 WET}
|
||||
{1743904800 3600 1 WEST}
|
||||
{1761444000 0 0 WET}
|
||||
{1774749600 3600 1 WEST}
|
||||
{1792893600 0 0 WET}
|
||||
{1806199200 3600 1 WEST}
|
||||
{1824948000 0 0 WET}
|
||||
{1837648800 3600 1 WEST}
|
||||
{1856397600 0 0 WET}
|
||||
{1869098400 3600 1 WEST}
|
||||
{1887847200 0 0 WET}
|
||||
{1901152800 3600 1 WEST}
|
||||
{1919296800 0 0 WET}
|
||||
{1932602400 3600 1 WEST}
|
||||
{1950746400 0 0 WET}
|
||||
{1964052000 3600 1 WEST}
|
||||
{1982800800 0 0 WET}
|
||||
{1995501600 3600 1 WEST}
|
||||
{2014250400 0 0 WET}
|
||||
{2026951200 3600 1 WEST}
|
||||
{2045700000 0 0 WET}
|
||||
{2058400800 3600 1 WEST}
|
||||
{2077149600 0 0 WET}
|
||||
{2090455200 3600 1 WEST}
|
||||
{2107994400 0 0 WET}
|
||||
{2108602800 0 0 WET}
|
||||
{2121904800 3600 1 WEST}
|
||||
{2138234400 0 0 WET}
|
||||
{2140052400 0 0 WET}
|
||||
{2153354400 3600 1 WEST}
|
||||
{2172103200 0 0 WET}
|
||||
{2184804000 3600 1 WEST}
|
||||
{2203552800 0 0 WET}
|
||||
{2216253600 3600 1 WEST}
|
||||
{2235002400 0 0 WET}
|
||||
{2248308000 3600 1 WEST}
|
||||
{2266452000 0 0 WET}
|
||||
{2279757600 3600 1 WEST}
|
||||
{2297901600 0 0 WET}
|
||||
{2311207200 3600 1 WEST}
|
||||
{2329351200 0 0 WET}
|
||||
{2342656800 3600 1 WEST}
|
||||
{2361405600 0 0 WET}
|
||||
{2374106400 3600 1 WEST}
|
||||
{2392855200 0 0 WET}
|
||||
{2405556000 3600 1 WEST}
|
||||
{2424304800 0 0 WET}
|
||||
{2437610400 3600 1 WEST}
|
||||
{2455754400 0 0 WET}
|
||||
{2469060000 3600 1 WEST}
|
||||
{2487204000 0 0 WET}
|
||||
{2500509600 3600 1 WEST}
|
||||
{2519258400 0 0 WET}
|
||||
{2531959200 3600 1 WEST}
|
||||
{2550708000 0 0 WET}
|
||||
{2563408800 3600 1 WEST}
|
||||
{2582157600 0 0 WET}
|
||||
{2595463200 3600 1 WEST}
|
||||
{2613607200 0 0 WET}
|
||||
{2626912800 3600 1 WEST}
|
||||
{2645056800 0 0 WET}
|
||||
{2658362400 3600 1 WEST}
|
||||
{2676506400 0 0 WET}
|
||||
{2689812000 3600 1 WEST}
|
||||
{2708560800 0 0 WET}
|
||||
{2721261600 3600 1 WEST}
|
||||
{2740010400 0 0 WET}
|
||||
{2752711200 3600 1 WEST}
|
||||
{2771460000 0 0 WET}
|
||||
{2784765600 3600 1 WEST}
|
||||
{2802909600 0 0 WET}
|
||||
{2816215200 3600 1 WEST}
|
||||
{2834359200 0 0 WET}
|
||||
{2847664800 3600 1 WEST}
|
||||
{2866413600 0 0 WET}
|
||||
{2879114400 3600 1 WEST}
|
||||
{2897863200 0 0 WET}
|
||||
{2910564000 3600 1 WEST}
|
||||
{2929312800 0 0 WET}
|
||||
{2942013600 3600 1 WEST}
|
||||
{2960762400 0 0 WET}
|
||||
{2974068000 3600 1 WEST}
|
||||
{2992212000 0 0 WET}
|
||||
{3005517600 3600 1 WEST}
|
||||
{3023661600 0 0 WET}
|
||||
{3036967200 3600 1 WEST}
|
||||
{3055716000 0 0 WET}
|
||||
{3068416800 3600 1 WEST}
|
||||
{3087165600 0 0 WET}
|
||||
{3099866400 3600 1 WEST}
|
||||
{3118615200 0 0 WET}
|
||||
{3131920800 3600 1 WEST}
|
||||
{3150064800 0 0 WET}
|
||||
{3163370400 3600 1 WEST}
|
||||
{3181514400 0 0 WET}
|
||||
{3194820000 3600 1 WEST}
|
||||
{3212964000 0 0 WET}
|
||||
{3226269600 3600 1 WEST}
|
||||
{3245018400 0 0 WET}
|
||||
{3257719200 3600 1 WEST}
|
||||
{3276468000 0 0 WET}
|
||||
{3289168800 3600 1 WEST}
|
||||
{3307917600 0 0 WET}
|
||||
{3321223200 3600 1 WEST}
|
||||
{3339367200 0 0 WET}
|
||||
{3352672800 3600 1 WEST}
|
||||
{3370816800 0 0 WET}
|
||||
{3384122400 3600 1 WEST}
|
||||
{3402871200 0 0 WET}
|
||||
{3415572000 3600 1 WEST}
|
||||
{3434320800 0 0 WET}
|
||||
{3447021600 3600 1 WEST}
|
||||
{3465770400 0 0 WET}
|
||||
{3479076000 3600 1 WEST}
|
||||
{3497220000 0 0 WET}
|
||||
{3510525600 3600 1 WEST}
|
||||
{3528669600 0 0 WET}
|
||||
{3541975200 3600 1 WEST}
|
||||
{3560119200 0 0 WET}
|
||||
{3573424800 3600 1 WEST}
|
||||
{3592173600 0 0 WET}
|
||||
{3604874400 3600 1 WEST}
|
||||
{3623623200 0 0 WET}
|
||||
{3636324000 3600 1 WEST}
|
||||
{3655072800 0 0 WET}
|
||||
{3668378400 3600 1 WEST}
|
||||
{3686522400 0 0 WET}
|
||||
{3699828000 3600 1 WEST}
|
||||
{3717972000 0 0 WET}
|
||||
{3731277600 3600 1 WEST}
|
||||
{3750026400 0 0 WET}
|
||||
{3762727200 3600 1 WEST}
|
||||
{3781476000 0 0 WET}
|
||||
{3794176800 3600 1 WEST}
|
||||
{3812925600 0 0 WET}
|
||||
{3825626400 3600 1 WEST}
|
||||
{3844375200 0 0 WET}
|
||||
{3857680800 3600 1 WEST}
|
||||
{3875824800 0 0 WET}
|
||||
{3889130400 3600 1 WEST}
|
||||
{3907274400 0 0 WET}
|
||||
{3920580000 3600 1 WEST}
|
||||
{3939328800 0 0 WET}
|
||||
{3952029600 3600 1 WEST}
|
||||
{3970778400 0 0 WET}
|
||||
{3983479200 3600 1 WEST}
|
||||
{4002228000 0 0 WET}
|
||||
{4015533600 3600 1 WEST}
|
||||
{4033677600 0 0 WET}
|
||||
{4046983200 3600 1 WEST}
|
||||
{4065127200 0 0 WET}
|
||||
{4078432800 3600 1 WEST}
|
||||
{4096576800 0 0 WET}
|
||||
{-1773012580 0 0 +00}
|
||||
{-956361600 3600 1 +00}
|
||||
{-950490000 0 0 +00}
|
||||
{-942019200 3600 1 +00}
|
||||
{-761187600 0 0 +00}
|
||||
{-617241600 3600 1 +00}
|
||||
{-605149200 0 0 +00}
|
||||
{-81432000 3600 1 +00}
|
||||
{-71110800 0 0 +00}
|
||||
{141264000 3600 1 +00}
|
||||
{147222000 0 0 +00}
|
||||
{199756800 3600 1 +00}
|
||||
{207702000 0 0 +00}
|
||||
{231292800 3600 1 +00}
|
||||
{244249200 0 0 +00}
|
||||
{265507200 3600 1 +00}
|
||||
{271033200 0 0 +00}
|
||||
{448243200 3600 0 +01}
|
||||
{504918000 0 0 +00}
|
||||
{1212278400 3600 1 +00}
|
||||
{1220223600 0 0 +00}
|
||||
{1243814400 3600 1 +00}
|
||||
{1250809200 0 0 +00}
|
||||
{1272758400 3600 1 +00}
|
||||
{1281222000 0 0 +00}
|
||||
{1301788800 3600 1 +00}
|
||||
{1312066800 0 0 +00}
|
||||
{1335664800 3600 1 +00}
|
||||
{1342749600 0 0 +00}
|
||||
{1345428000 3600 1 +00}
|
||||
{1348970400 0 0 +00}
|
||||
{1367114400 3600 1 +00}
|
||||
{1373162400 0 0 +00}
|
||||
{1376100000 3600 1 +00}
|
||||
{1382839200 0 0 +00}
|
||||
{1396144800 3600 1 +00}
|
||||
{1403920800 0 0 +00}
|
||||
{1406944800 3600 1 +00}
|
||||
{1414288800 0 0 +00}
|
||||
{1427594400 3600 1 +00}
|
||||
{1434247200 0 0 +00}
|
||||
{1437271200 3600 1 +00}
|
||||
{1445738400 0 0 +00}
|
||||
{1459044000 3600 1 +00}
|
||||
{1465092000 0 0 +00}
|
||||
{1468116000 3600 1 +00}
|
||||
{1477792800 0 0 +00}
|
||||
{1490493600 3600 1 +00}
|
||||
{1495332000 0 0 +00}
|
||||
{1498960800 3600 1 +00}
|
||||
{1509242400 0 0 +00}
|
||||
{1521943200 3600 1 +00}
|
||||
{1526176800 0 0 +00}
|
||||
{1529200800 3600 1 +00}
|
||||
{1540598400 3600 0 +01}
|
||||
}
|
||||
|
||||
@@ -15,6 +15,7 @@ set TZData(:Africa/Ceuta) {
|
||||
{-1316390400 3600 1 WEST}
|
||||
{-1301270400 0 0 WET}
|
||||
{-1293840000 0 0 WET}
|
||||
{-94694400 0 0 WET}
|
||||
{-81432000 3600 1 WEST}
|
||||
{-71110800 0 0 WET}
|
||||
{141264000 3600 1 WEST}
|
||||
|
||||
+43
-213
@@ -3,217 +3,47 @@
|
||||
set TZData(:Africa/El_Aaiun) {
|
||||
{-9223372036854775808 -3168 0 LMT}
|
||||
{-1136070432 -3600 0 -01}
|
||||
{198291600 0 0 WET}
|
||||
{199756800 3600 1 WEST}
|
||||
{207702000 0 0 WET}
|
||||
{231292800 3600 1 WEST}
|
||||
{244249200 0 0 WET}
|
||||
{265507200 3600 1 WEST}
|
||||
{271033200 0 0 WET}
|
||||
{1212278400 3600 1 WEST}
|
||||
{1220223600 0 0 WET}
|
||||
{1243814400 3600 1 WEST}
|
||||
{1250809200 0 0 WET}
|
||||
{1272758400 3600 1 WEST}
|
||||
{1281222000 0 0 WET}
|
||||
{1301788800 3600 1 WEST}
|
||||
{1312066800 0 0 WET}
|
||||
{1335664800 3600 1 WEST}
|
||||
{1342749600 0 0 WET}
|
||||
{1345428000 3600 1 WEST}
|
||||
{1348970400 0 0 WET}
|
||||
{1367114400 3600 1 WEST}
|
||||
{1373162400 0 0 WET}
|
||||
{1376100000 3600 1 WEST}
|
||||
{1382839200 0 0 WET}
|
||||
{1396144800 3600 1 WEST}
|
||||
{1403920800 0 0 WET}
|
||||
{1406944800 3600 1 WEST}
|
||||
{1414288800 0 0 WET}
|
||||
{1427594400 3600 1 WEST}
|
||||
{1434247200 0 0 WET}
|
||||
{1437271200 3600 1 WEST}
|
||||
{1445738400 0 0 WET}
|
||||
{1459044000 3600 1 WEST}
|
||||
{1465092000 0 0 WET}
|
||||
{1468116000 3600 1 WEST}
|
||||
{1477792800 0 0 WET}
|
||||
{1490493600 3600 1 WEST}
|
||||
{1495332000 0 0 WET}
|
||||
{1498960800 3600 1 WEST}
|
||||
{1509242400 0 0 WET}
|
||||
{1521943200 3600 1 WEST}
|
||||
{1526176800 0 0 WET}
|
||||
{1529200800 3600 1 WEST}
|
||||
{1540692000 0 0 WET}
|
||||
{1553997600 3600 1 WEST}
|
||||
{1557021600 0 0 WET}
|
||||
{1560045600 3600 1 WEST}
|
||||
{1572141600 0 0 WET}
|
||||
{1585447200 3600 1 WEST}
|
||||
{1587261600 0 0 WET}
|
||||
{1590285600 3600 1 WEST}
|
||||
{1603591200 0 0 WET}
|
||||
{1616896800 3600 1 WEST}
|
||||
{1618106400 0 0 WET}
|
||||
{1621130400 3600 1 WEST}
|
||||
{1635645600 0 0 WET}
|
||||
{1651975200 3600 1 WEST}
|
||||
{1667095200 0 0 WET}
|
||||
{1682215200 3600 1 WEST}
|
||||
{1698544800 0 0 WET}
|
||||
{1713060000 3600 1 WEST}
|
||||
{1729994400 0 0 WET}
|
||||
{1743904800 3600 1 WEST}
|
||||
{1761444000 0 0 WET}
|
||||
{1774749600 3600 1 WEST}
|
||||
{1792893600 0 0 WET}
|
||||
{1806199200 3600 1 WEST}
|
||||
{1824948000 0 0 WET}
|
||||
{1837648800 3600 1 WEST}
|
||||
{1856397600 0 0 WET}
|
||||
{1869098400 3600 1 WEST}
|
||||
{1887847200 0 0 WET}
|
||||
{1901152800 3600 1 WEST}
|
||||
{1919296800 0 0 WET}
|
||||
{1932602400 3600 1 WEST}
|
||||
{1950746400 0 0 WET}
|
||||
{1964052000 3600 1 WEST}
|
||||
{1982800800 0 0 WET}
|
||||
{1995501600 3600 1 WEST}
|
||||
{2014250400 0 0 WET}
|
||||
{2026951200 3600 1 WEST}
|
||||
{2045700000 0 0 WET}
|
||||
{2058400800 3600 1 WEST}
|
||||
{2077149600 0 0 WET}
|
||||
{2090455200 3600 1 WEST}
|
||||
{2107994400 0 0 WET}
|
||||
{2108602800 0 0 WET}
|
||||
{2121904800 3600 1 WEST}
|
||||
{2138234400 0 0 WET}
|
||||
{2140052400 0 0 WET}
|
||||
{2153354400 3600 1 WEST}
|
||||
{2172103200 0 0 WET}
|
||||
{2184804000 3600 1 WEST}
|
||||
{2203552800 0 0 WET}
|
||||
{2216253600 3600 1 WEST}
|
||||
{2235002400 0 0 WET}
|
||||
{2248308000 3600 1 WEST}
|
||||
{2266452000 0 0 WET}
|
||||
{2279757600 3600 1 WEST}
|
||||
{2297901600 0 0 WET}
|
||||
{2311207200 3600 1 WEST}
|
||||
{2329351200 0 0 WET}
|
||||
{2342656800 3600 1 WEST}
|
||||
{2361405600 0 0 WET}
|
||||
{2374106400 3600 1 WEST}
|
||||
{2392855200 0 0 WET}
|
||||
{2405556000 3600 1 WEST}
|
||||
{2424304800 0 0 WET}
|
||||
{2437610400 3600 1 WEST}
|
||||
{2455754400 0 0 WET}
|
||||
{2469060000 3600 1 WEST}
|
||||
{2487204000 0 0 WET}
|
||||
{2500509600 3600 1 WEST}
|
||||
{2519258400 0 0 WET}
|
||||
{2531959200 3600 1 WEST}
|
||||
{2550708000 0 0 WET}
|
||||
{2563408800 3600 1 WEST}
|
||||
{2582157600 0 0 WET}
|
||||
{2595463200 3600 1 WEST}
|
||||
{2613607200 0 0 WET}
|
||||
{2626912800 3600 1 WEST}
|
||||
{2645056800 0 0 WET}
|
||||
{2658362400 3600 1 WEST}
|
||||
{2676506400 0 0 WET}
|
||||
{2689812000 3600 1 WEST}
|
||||
{2708560800 0 0 WET}
|
||||
{2721261600 3600 1 WEST}
|
||||
{2740010400 0 0 WET}
|
||||
{2752711200 3600 1 WEST}
|
||||
{2771460000 0 0 WET}
|
||||
{2784765600 3600 1 WEST}
|
||||
{2802909600 0 0 WET}
|
||||
{2816215200 3600 1 WEST}
|
||||
{2834359200 0 0 WET}
|
||||
{2847664800 3600 1 WEST}
|
||||
{2866413600 0 0 WET}
|
||||
{2879114400 3600 1 WEST}
|
||||
{2897863200 0 0 WET}
|
||||
{2910564000 3600 1 WEST}
|
||||
{2929312800 0 0 WET}
|
||||
{2942013600 3600 1 WEST}
|
||||
{2960762400 0 0 WET}
|
||||
{2974068000 3600 1 WEST}
|
||||
{2992212000 0 0 WET}
|
||||
{3005517600 3600 1 WEST}
|
||||
{3023661600 0 0 WET}
|
||||
{3036967200 3600 1 WEST}
|
||||
{3055716000 0 0 WET}
|
||||
{3068416800 3600 1 WEST}
|
||||
{3087165600 0 0 WET}
|
||||
{3099866400 3600 1 WEST}
|
||||
{3118615200 0 0 WET}
|
||||
{3131920800 3600 1 WEST}
|
||||
{3150064800 0 0 WET}
|
||||
{3163370400 3600 1 WEST}
|
||||
{3181514400 0 0 WET}
|
||||
{3194820000 3600 1 WEST}
|
||||
{3212964000 0 0 WET}
|
||||
{3226269600 3600 1 WEST}
|
||||
{3245018400 0 0 WET}
|
||||
{3257719200 3600 1 WEST}
|
||||
{3276468000 0 0 WET}
|
||||
{3289168800 3600 1 WEST}
|
||||
{3307917600 0 0 WET}
|
||||
{3321223200 3600 1 WEST}
|
||||
{3339367200 0 0 WET}
|
||||
{3352672800 3600 1 WEST}
|
||||
{3370816800 0 0 WET}
|
||||
{3384122400 3600 1 WEST}
|
||||
{3402871200 0 0 WET}
|
||||
{3415572000 3600 1 WEST}
|
||||
{3434320800 0 0 WET}
|
||||
{3447021600 3600 1 WEST}
|
||||
{3465770400 0 0 WET}
|
||||
{3479076000 3600 1 WEST}
|
||||
{3497220000 0 0 WET}
|
||||
{3510525600 3600 1 WEST}
|
||||
{3528669600 0 0 WET}
|
||||
{3541975200 3600 1 WEST}
|
||||
{3560119200 0 0 WET}
|
||||
{3573424800 3600 1 WEST}
|
||||
{3592173600 0 0 WET}
|
||||
{3604874400 3600 1 WEST}
|
||||
{3623623200 0 0 WET}
|
||||
{3636324000 3600 1 WEST}
|
||||
{3655072800 0 0 WET}
|
||||
{3668378400 3600 1 WEST}
|
||||
{3686522400 0 0 WET}
|
||||
{3699828000 3600 1 WEST}
|
||||
{3717972000 0 0 WET}
|
||||
{3731277600 3600 1 WEST}
|
||||
{3750026400 0 0 WET}
|
||||
{3762727200 3600 1 WEST}
|
||||
{3781476000 0 0 WET}
|
||||
{3794176800 3600 1 WEST}
|
||||
{3812925600 0 0 WET}
|
||||
{3825626400 3600 1 WEST}
|
||||
{3844375200 0 0 WET}
|
||||
{3857680800 3600 1 WEST}
|
||||
{3875824800 0 0 WET}
|
||||
{3889130400 3600 1 WEST}
|
||||
{3907274400 0 0 WET}
|
||||
{3920580000 3600 1 WEST}
|
||||
{3939328800 0 0 WET}
|
||||
{3952029600 3600 1 WEST}
|
||||
{3970778400 0 0 WET}
|
||||
{3983479200 3600 1 WEST}
|
||||
{4002228000 0 0 WET}
|
||||
{4015533600 3600 1 WEST}
|
||||
{4033677600 0 0 WET}
|
||||
{4046983200 3600 1 WEST}
|
||||
{4065127200 0 0 WET}
|
||||
{4078432800 3600 1 WEST}
|
||||
{4096576800 0 0 WET}
|
||||
{198291600 0 0 +00}
|
||||
{199756800 3600 1 +00}
|
||||
{207702000 0 0 +00}
|
||||
{231292800 3600 1 +00}
|
||||
{244249200 0 0 +00}
|
||||
{265507200 3600 1 +00}
|
||||
{271033200 0 0 +00}
|
||||
{1212278400 3600 1 +00}
|
||||
{1220223600 0 0 +00}
|
||||
{1243814400 3600 1 +00}
|
||||
{1250809200 0 0 +00}
|
||||
{1272758400 3600 1 +00}
|
||||
{1281222000 0 0 +00}
|
||||
{1301788800 3600 1 +00}
|
||||
{1312066800 0 0 +00}
|
||||
{1335664800 3600 1 +00}
|
||||
{1342749600 0 0 +00}
|
||||
{1345428000 3600 1 +00}
|
||||
{1348970400 0 0 +00}
|
||||
{1367114400 3600 1 +00}
|
||||
{1373162400 0 0 +00}
|
||||
{1376100000 3600 1 +00}
|
||||
{1382839200 0 0 +00}
|
||||
{1396144800 3600 1 +00}
|
||||
{1403920800 0 0 +00}
|
||||
{1406944800 3600 1 +00}
|
||||
{1414288800 0 0 +00}
|
||||
{1427594400 3600 1 +00}
|
||||
{1434247200 0 0 +00}
|
||||
{1437271200 3600 1 +00}
|
||||
{1445738400 0 0 +00}
|
||||
{1459044000 3600 1 +00}
|
||||
{1465092000 0 0 +00}
|
||||
{1468116000 3600 1 +00}
|
||||
{1477792800 0 0 +00}
|
||||
{1490493600 3600 1 +00}
|
||||
{1495332000 0 0 +00}
|
||||
{1498960800 3600 1 +00}
|
||||
{1509242400 0 0 +00}
|
||||
{1521943200 3600 1 +00}
|
||||
{1526176800 0 0 +00}
|
||||
{1529200800 3600 1 +00}
|
||||
{1540598400 3600 0 +01}
|
||||
}
|
||||
|
||||
+162
-162
@@ -124,166 +124,166 @@ set TZData(:America/Santiago) {
|
||||
{1502596800 -10800 1 -04}
|
||||
{1526180400 -14400 0 -04}
|
||||
{1534046400 -10800 1 -04}
|
||||
{1557630000 -14400 0 -04}
|
||||
{1565496000 -10800 1 -04}
|
||||
{1589079600 -14400 0 -04}
|
||||
{1596945600 -10800 1 -04}
|
||||
{1620529200 -14400 0 -04}
|
||||
{1629000000 -10800 1 -04}
|
||||
{1652583600 -14400 0 -04}
|
||||
{1660449600 -10800 1 -04}
|
||||
{1684033200 -14400 0 -04}
|
||||
{1691899200 -10800 1 -04}
|
||||
{1715482800 -14400 0 -04}
|
||||
{1723348800 -10800 1 -04}
|
||||
{1746932400 -14400 0 -04}
|
||||
{1754798400 -10800 1 -04}
|
||||
{1778382000 -14400 0 -04}
|
||||
{1786248000 -10800 1 -04}
|
||||
{1809831600 -14400 0 -04}
|
||||
{1818302400 -10800 1 -04}
|
||||
{1841886000 -14400 0 -04}
|
||||
{1849752000 -10800 1 -04}
|
||||
{1873335600 -14400 0 -04}
|
||||
{1881201600 -10800 1 -04}
|
||||
{1904785200 -14400 0 -04}
|
||||
{1912651200 -10800 1 -04}
|
||||
{1936234800 -14400 0 -04}
|
||||
{1944100800 -10800 1 -04}
|
||||
{1967684400 -14400 0 -04}
|
||||
{1976155200 -10800 1 -04}
|
||||
{1999738800 -14400 0 -04}
|
||||
{2007604800 -10800 1 -04}
|
||||
{2031188400 -14400 0 -04}
|
||||
{2039054400 -10800 1 -04}
|
||||
{2062638000 -14400 0 -04}
|
||||
{2070504000 -10800 1 -04}
|
||||
{2094087600 -14400 0 -04}
|
||||
{2101953600 -10800 1 -04}
|
||||
{2125537200 -14400 0 -04}
|
||||
{2133403200 -10800 1 -04}
|
||||
{2156986800 -14400 0 -04}
|
||||
{2165457600 -10800 1 -04}
|
||||
{2189041200 -14400 0 -04}
|
||||
{2196907200 -10800 1 -04}
|
||||
{2220490800 -14400 0 -04}
|
||||
{2228356800 -10800 1 -04}
|
||||
{2251940400 -14400 0 -04}
|
||||
{2259806400 -10800 1 -04}
|
||||
{2283390000 -14400 0 -04}
|
||||
{2291256000 -10800 1 -04}
|
||||
{2314839600 -14400 0 -04}
|
||||
{2322705600 -10800 1 -04}
|
||||
{2346894000 -14400 0 -04}
|
||||
{2354760000 -10800 1 -04}
|
||||
{2378343600 -14400 0 -04}
|
||||
{2386209600 -10800 1 -04}
|
||||
{2409793200 -14400 0 -04}
|
||||
{2417659200 -10800 1 -04}
|
||||
{2441242800 -14400 0 -04}
|
||||
{2449108800 -10800 1 -04}
|
||||
{2472692400 -14400 0 -04}
|
||||
{2480558400 -10800 1 -04}
|
||||
{2504142000 -14400 0 -04}
|
||||
{2512612800 -10800 1 -04}
|
||||
{2536196400 -14400 0 -04}
|
||||
{2544062400 -10800 1 -04}
|
||||
{2567646000 -14400 0 -04}
|
||||
{2575512000 -10800 1 -04}
|
||||
{2599095600 -14400 0 -04}
|
||||
{2606961600 -10800 1 -04}
|
||||
{2630545200 -14400 0 -04}
|
||||
{2638411200 -10800 1 -04}
|
||||
{2661994800 -14400 0 -04}
|
||||
{2669860800 -10800 1 -04}
|
||||
{2693444400 -14400 0 -04}
|
||||
{2701915200 -10800 1 -04}
|
||||
{2725498800 -14400 0 -04}
|
||||
{2733364800 -10800 1 -04}
|
||||
{2756948400 -14400 0 -04}
|
||||
{2764814400 -10800 1 -04}
|
||||
{2788398000 -14400 0 -04}
|
||||
{2796264000 -10800 1 -04}
|
||||
{2819847600 -14400 0 -04}
|
||||
{2827713600 -10800 1 -04}
|
||||
{2851297200 -14400 0 -04}
|
||||
{2859768000 -10800 1 -04}
|
||||
{2883351600 -14400 0 -04}
|
||||
{2891217600 -10800 1 -04}
|
||||
{2914801200 -14400 0 -04}
|
||||
{2922667200 -10800 1 -04}
|
||||
{2946250800 -14400 0 -04}
|
||||
{2954116800 -10800 1 -04}
|
||||
{2977700400 -14400 0 -04}
|
||||
{2985566400 -10800 1 -04}
|
||||
{3009150000 -14400 0 -04}
|
||||
{3017016000 -10800 1 -04}
|
||||
{3040599600 -14400 0 -04}
|
||||
{3049070400 -10800 1 -04}
|
||||
{3072654000 -14400 0 -04}
|
||||
{3080520000 -10800 1 -04}
|
||||
{3104103600 -14400 0 -04}
|
||||
{3111969600 -10800 1 -04}
|
||||
{3135553200 -14400 0 -04}
|
||||
{3143419200 -10800 1 -04}
|
||||
{3167002800 -14400 0 -04}
|
||||
{3174868800 -10800 1 -04}
|
||||
{3198452400 -14400 0 -04}
|
||||
{3206318400 -10800 1 -04}
|
||||
{3230506800 -14400 0 -04}
|
||||
{3238372800 -10800 1 -04}
|
||||
{3261956400 -14400 0 -04}
|
||||
{3269822400 -10800 1 -04}
|
||||
{3293406000 -14400 0 -04}
|
||||
{3301272000 -10800 1 -04}
|
||||
{3324855600 -14400 0 -04}
|
||||
{3332721600 -10800 1 -04}
|
||||
{3356305200 -14400 0 -04}
|
||||
{3364171200 -10800 1 -04}
|
||||
{3387754800 -14400 0 -04}
|
||||
{3396225600 -10800 1 -04}
|
||||
{3419809200 -14400 0 -04}
|
||||
{3427675200 -10800 1 -04}
|
||||
{3451258800 -14400 0 -04}
|
||||
{3459124800 -10800 1 -04}
|
||||
{3482708400 -14400 0 -04}
|
||||
{3490574400 -10800 1 -04}
|
||||
{3514158000 -14400 0 -04}
|
||||
{3522024000 -10800 1 -04}
|
||||
{3545607600 -14400 0 -04}
|
||||
{3553473600 -10800 1 -04}
|
||||
{3577057200 -14400 0 -04}
|
||||
{3585528000 -10800 1 -04}
|
||||
{3609111600 -14400 0 -04}
|
||||
{3616977600 -10800 1 -04}
|
||||
{3640561200 -14400 0 -04}
|
||||
{3648427200 -10800 1 -04}
|
||||
{3672010800 -14400 0 -04}
|
||||
{3679876800 -10800 1 -04}
|
||||
{3703460400 -14400 0 -04}
|
||||
{3711326400 -10800 1 -04}
|
||||
{3734910000 -14400 0 -04}
|
||||
{3743380800 -10800 1 -04}
|
||||
{3766964400 -14400 0 -04}
|
||||
{3774830400 -10800 1 -04}
|
||||
{3798414000 -14400 0 -04}
|
||||
{3806280000 -10800 1 -04}
|
||||
{3829863600 -14400 0 -04}
|
||||
{3837729600 -10800 1 -04}
|
||||
{3861313200 -14400 0 -04}
|
||||
{3869179200 -10800 1 -04}
|
||||
{3892762800 -14400 0 -04}
|
||||
{3900628800 -10800 1 -04}
|
||||
{3924212400 -14400 0 -04}
|
||||
{3932683200 -10800 1 -04}
|
||||
{3956266800 -14400 0 -04}
|
||||
{3964132800 -10800 1 -04}
|
||||
{3987716400 -14400 0 -04}
|
||||
{3995582400 -10800 1 -04}
|
||||
{4019166000 -14400 0 -04}
|
||||
{4027032000 -10800 1 -04}
|
||||
{4050615600 -14400 0 -04}
|
||||
{4058481600 -10800 1 -04}
|
||||
{4082065200 -14400 0 -04}
|
||||
{4089931200 -10800 1 -04}
|
||||
{1554606000 -14400 0 -04}
|
||||
{1567915200 -10800 1 -04}
|
||||
{1586055600 -14400 0 -04}
|
||||
{1599364800 -10800 1 -04}
|
||||
{1617505200 -14400 0 -04}
|
||||
{1630814400 -10800 1 -04}
|
||||
{1648954800 -14400 0 -04}
|
||||
{1662264000 -10800 1 -04}
|
||||
{1680404400 -14400 0 -04}
|
||||
{1693713600 -10800 1 -04}
|
||||
{1712458800 -14400 0 -04}
|
||||
{1725768000 -10800 1 -04}
|
||||
{1743908400 -14400 0 -04}
|
||||
{1757217600 -10800 1 -04}
|
||||
{1775358000 -14400 0 -04}
|
||||
{1788667200 -10800 1 -04}
|
||||
{1806807600 -14400 0 -04}
|
||||
{1820116800 -10800 1 -04}
|
||||
{1838257200 -14400 0 -04}
|
||||
{1851566400 -10800 1 -04}
|
||||
{1870311600 -14400 0 -04}
|
||||
{1883016000 -10800 1 -04}
|
||||
{1901761200 -14400 0 -04}
|
||||
{1915070400 -10800 1 -04}
|
||||
{1933210800 -14400 0 -04}
|
||||
{1946520000 -10800 1 -04}
|
||||
{1964660400 -14400 0 -04}
|
||||
{1977969600 -10800 1 -04}
|
||||
{1996110000 -14400 0 -04}
|
||||
{2009419200 -10800 1 -04}
|
||||
{2027559600 -14400 0 -04}
|
||||
{2040868800 -10800 1 -04}
|
||||
{2059614000 -14400 0 -04}
|
||||
{2072318400 -10800 1 -04}
|
||||
{2091063600 -14400 0 -04}
|
||||
{2104372800 -10800 1 -04}
|
||||
{2122513200 -14400 0 -04}
|
||||
{2135822400 -10800 1 -04}
|
||||
{2153962800 -14400 0 -04}
|
||||
{2167272000 -10800 1 -04}
|
||||
{2185412400 -14400 0 -04}
|
||||
{2198721600 -10800 1 -04}
|
||||
{2217466800 -14400 0 -04}
|
||||
{2230171200 -10800 1 -04}
|
||||
{2248916400 -14400 0 -04}
|
||||
{2262225600 -10800 1 -04}
|
||||
{2280366000 -14400 0 -04}
|
||||
{2293675200 -10800 1 -04}
|
||||
{2311815600 -14400 0 -04}
|
||||
{2325124800 -10800 1 -04}
|
||||
{2343265200 -14400 0 -04}
|
||||
{2356574400 -10800 1 -04}
|
||||
{2374714800 -14400 0 -04}
|
||||
{2388024000 -10800 1 -04}
|
||||
{2406769200 -14400 0 -04}
|
||||
{2419473600 -10800 1 -04}
|
||||
{2438218800 -14400 0 -04}
|
||||
{2451528000 -10800 1 -04}
|
||||
{2469668400 -14400 0 -04}
|
||||
{2482977600 -10800 1 -04}
|
||||
{2501118000 -14400 0 -04}
|
||||
{2514427200 -10800 1 -04}
|
||||
{2532567600 -14400 0 -04}
|
||||
{2545876800 -10800 1 -04}
|
||||
{2564017200 -14400 0 -04}
|
||||
{2577326400 -10800 1 -04}
|
||||
{2596071600 -14400 0 -04}
|
||||
{2609380800 -10800 1 -04}
|
||||
{2627521200 -14400 0 -04}
|
||||
{2640830400 -10800 1 -04}
|
||||
{2658970800 -14400 0 -04}
|
||||
{2672280000 -10800 1 -04}
|
||||
{2690420400 -14400 0 -04}
|
||||
{2703729600 -10800 1 -04}
|
||||
{2721870000 -14400 0 -04}
|
||||
{2735179200 -10800 1 -04}
|
||||
{2753924400 -14400 0 -04}
|
||||
{2766628800 -10800 1 -04}
|
||||
{2785374000 -14400 0 -04}
|
||||
{2798683200 -10800 1 -04}
|
||||
{2816823600 -14400 0 -04}
|
||||
{2830132800 -10800 1 -04}
|
||||
{2848273200 -14400 0 -04}
|
||||
{2861582400 -10800 1 -04}
|
||||
{2879722800 -14400 0 -04}
|
||||
{2893032000 -10800 1 -04}
|
||||
{2911172400 -14400 0 -04}
|
||||
{2924481600 -10800 1 -04}
|
||||
{2943226800 -14400 0 -04}
|
||||
{2955931200 -10800 1 -04}
|
||||
{2974676400 -14400 0 -04}
|
||||
{2987985600 -10800 1 -04}
|
||||
{3006126000 -14400 0 -04}
|
||||
{3019435200 -10800 1 -04}
|
||||
{3037575600 -14400 0 -04}
|
||||
{3050884800 -10800 1 -04}
|
||||
{3069025200 -14400 0 -04}
|
||||
{3082334400 -10800 1 -04}
|
||||
{3101079600 -14400 0 -04}
|
||||
{3113784000 -10800 1 -04}
|
||||
{3132529200 -14400 0 -04}
|
||||
{3145838400 -10800 1 -04}
|
||||
{3163978800 -14400 0 -04}
|
||||
{3177288000 -10800 1 -04}
|
||||
{3195428400 -14400 0 -04}
|
||||
{3208737600 -10800 1 -04}
|
||||
{3226878000 -14400 0 -04}
|
||||
{3240187200 -10800 1 -04}
|
||||
{3258327600 -14400 0 -04}
|
||||
{3271636800 -10800 1 -04}
|
||||
{3290382000 -14400 0 -04}
|
||||
{3303086400 -10800 1 -04}
|
||||
{3321831600 -14400 0 -04}
|
||||
{3335140800 -10800 1 -04}
|
||||
{3353281200 -14400 0 -04}
|
||||
{3366590400 -10800 1 -04}
|
||||
{3384730800 -14400 0 -04}
|
||||
{3398040000 -10800 1 -04}
|
||||
{3416180400 -14400 0 -04}
|
||||
{3429489600 -10800 1 -04}
|
||||
{3447630000 -14400 0 -04}
|
||||
{3460939200 -10800 1 -04}
|
||||
{3479684400 -14400 0 -04}
|
||||
{3492993600 -10800 1 -04}
|
||||
{3511134000 -14400 0 -04}
|
||||
{3524443200 -10800 1 -04}
|
||||
{3542583600 -14400 0 -04}
|
||||
{3555892800 -10800 1 -04}
|
||||
{3574033200 -14400 0 -04}
|
||||
{3587342400 -10800 1 -04}
|
||||
{3605482800 -14400 0 -04}
|
||||
{3618792000 -10800 1 -04}
|
||||
{3637537200 -14400 0 -04}
|
||||
{3650241600 -10800 1 -04}
|
||||
{3668986800 -14400 0 -04}
|
||||
{3682296000 -10800 1 -04}
|
||||
{3700436400 -14400 0 -04}
|
||||
{3713745600 -10800 1 -04}
|
||||
{3731886000 -14400 0 -04}
|
||||
{3745195200 -10800 1 -04}
|
||||
{3763335600 -14400 0 -04}
|
||||
{3776644800 -10800 1 -04}
|
||||
{3794785200 -14400 0 -04}
|
||||
{3808094400 -10800 1 -04}
|
||||
{3826839600 -14400 0 -04}
|
||||
{3839544000 -10800 1 -04}
|
||||
{3858289200 -14400 0 -04}
|
||||
{3871598400 -10800 1 -04}
|
||||
{3889738800 -14400 0 -04}
|
||||
{3903048000 -10800 1 -04}
|
||||
{3921188400 -14400 0 -04}
|
||||
{3934497600 -10800 1 -04}
|
||||
{3952638000 -14400 0 -04}
|
||||
{3965947200 -10800 1 -04}
|
||||
{3984692400 -14400 0 -04}
|
||||
{3997396800 -10800 1 -04}
|
||||
{4016142000 -14400 0 -04}
|
||||
{4029451200 -10800 1 -04}
|
||||
{4047591600 -14400 0 -04}
|
||||
{4060900800 -10800 1 -04}
|
||||
{4079041200 -14400 0 -04}
|
||||
{4092350400 -10800 1 -04}
|
||||
}
|
||||
|
||||
+49
-19
@@ -1,20 +1,56 @@
|
||||
# created by tools/tclZIC.tcl - do not edit
|
||||
|
||||
set TZData(:Asia/Macau) {
|
||||
{-9223372036854775808 27260 0 LMT}
|
||||
{-1830412800 28800 0 CST}
|
||||
{-9223372036854775808 27250 0 LMT}
|
||||
{-2056692850 28800 0 CST}
|
||||
{-884509200 32400 0 +09}
|
||||
{-873280800 36000 1 +09}
|
||||
{-855918000 32400 0 +09}
|
||||
{-841744800 36000 1 +09}
|
||||
{-828529200 32400 0 +10}
|
||||
{-765363600 28800 0 CT}
|
||||
{-747046800 32400 1 CDT}
|
||||
{-733827600 28800 0 CST}
|
||||
{-716461200 32400 1 CDT}
|
||||
{-697021200 28800 0 CST}
|
||||
{-683715600 32400 1 CDT}
|
||||
{-667990800 28800 0 CST}
|
||||
{-654771600 32400 1 CDT}
|
||||
{-636627600 28800 0 CST}
|
||||
{-623322000 32400 1 CDT}
|
||||
{-605178000 28800 0 CST}
|
||||
{-591872400 32400 1 CDT}
|
||||
{-573642000 28800 0 CST}
|
||||
{-559818000 32400 1 CDT}
|
||||
{-541674000 28800 0 CST}
|
||||
{-528368400 32400 1 CDT}
|
||||
{-510224400 28800 0 CST}
|
||||
{-498128400 32400 1 CDT}
|
||||
{-478774800 28800 0 CST}
|
||||
{-466678800 32400 1 CDT}
|
||||
{-446720400 28800 0 CST}
|
||||
{-435229200 32400 1 CDT}
|
||||
{-415258200 28800 0 CST}
|
||||
{-403158600 32400 1 CDT}
|
||||
{-383808600 28800 0 CST}
|
||||
{-371709000 32400 1 CDT}
|
||||
{-352359000 28800 0 CST}
|
||||
{-340259400 32400 1 CDT}
|
||||
{-320909400 28800 0 CST}
|
||||
{-308809800 32400 1 CDT}
|
||||
{-288855000 28800 0 CST}
|
||||
{-277360200 32400 1 CDT}
|
||||
{-257405400 28800 0 CST}
|
||||
{-245910600 32400 1 CDT}
|
||||
{-225955800 28800 0 CST}
|
||||
{-214473600 32400 1 CDT}
|
||||
{-213856200 32400 1 CDT}
|
||||
{-194506200 28800 0 CST}
|
||||
{-182406600 32400 1 CDT}
|
||||
{-163056600 28800 0 CST}
|
||||
{-150969600 32400 1 CDT}
|
||||
{-131619600 28800 0 CST}
|
||||
{-148537800 32400 1 CDT}
|
||||
{-132820200 28800 0 CST}
|
||||
{-117088200 32400 1 CDT}
|
||||
{-101367000 28800 0 CST}
|
||||
{-101370600 28800 0 CST}
|
||||
{-85638600 32400 1 CDT}
|
||||
{-69312600 28800 0 CST}
|
||||
{-53584200 32400 1 CDT}
|
||||
@@ -25,22 +61,16 @@ set TZData(:Asia/Macau) {
|
||||
{25036200 28800 0 CST}
|
||||
{40764600 32400 1 CDT}
|
||||
{56485800 28800 0 CST}
|
||||
{72201600 32400 1 CDT}
|
||||
{87922800 28800 0 CST}
|
||||
{103651200 32400 1 CDT}
|
||||
{119977200 28800 0 CST}
|
||||
{135705600 32400 1 CDT}
|
||||
{72214200 32400 1 CDT}
|
||||
{88540200 28800 0 CST}
|
||||
{104268600 32400 1 CDT}
|
||||
{119989800 28800 0 CST}
|
||||
{126041400 32400 1 CDT}
|
||||
{151439400 28800 0 CST}
|
||||
{167167800 32400 1 CDT}
|
||||
{182889000 28800 0 CST}
|
||||
{198617400 32400 1 CDT}
|
||||
{214338600 28800 0 CST}
|
||||
{230067000 32400 1 CDT}
|
||||
{245788200 28800 0 CST}
|
||||
{261504000 32400 1 CDT}
|
||||
{277225200 28800 0 CST}
|
||||
{292953600 32400 1 CDT}
|
||||
{309279600 28800 0 CST}
|
||||
{325008000 32400 1 CDT}
|
||||
{340729200 28800 0 CST}
|
||||
{295385400 32400 1 CDT}
|
||||
{309292200 28800 0 CST}
|
||||
}
|
||||
|
||||
@@ -3,13 +3,13 @@
|
||||
set TZData(:Asia/Manila) {
|
||||
{-9223372036854775808 -57360 0 LMT}
|
||||
{-3944621040 29040 0 LMT}
|
||||
{-2229321840 28800 0 +08}
|
||||
{-1046678400 32400 1 +08}
|
||||
{-1038733200 28800 0 +08}
|
||||
{-873273600 32400 0 +09}
|
||||
{-794221200 28800 0 +08}
|
||||
{-496224000 32400 1 +08}
|
||||
{-489315600 28800 0 +08}
|
||||
{259344000 32400 1 +08}
|
||||
{275151600 28800 0 +08}
|
||||
{-2229321840 28800 0 PST}
|
||||
{-1046678400 32400 1 PDT}
|
||||
{-1038733200 28800 0 PST}
|
||||
{-873273600 32400 0 JST}
|
||||
{-794221200 28800 0 PST}
|
||||
{-496224000 32400 1 PDT}
|
||||
{-489315600 28800 0 PST}
|
||||
{259344000 32400 1 PDT}
|
||||
{275151600 28800 0 PST}
|
||||
}
|
||||
|
||||
@@ -6,5 +6,5 @@ set TZData(:Asia/Pyongyang) {
|
||||
{-1830414600 32400 0 JST}
|
||||
{-768646800 32400 0 KST}
|
||||
{1439564400 30600 0 KST}
|
||||
{1525447800 32400 0 KST}
|
||||
{1525446000 32400 0 KST}
|
||||
}
|
||||
|
||||
@@ -3,21 +3,30 @@
|
||||
set TZData(:Asia/Shanghai) {
|
||||
{-9223372036854775808 29143 0 LMT}
|
||||
{-2177481943 28800 0 CST}
|
||||
{-933494400 32400 1 CDT}
|
||||
{-923130000 28800 0 CST}
|
||||
{-908784000 32400 1 CDT}
|
||||
{-891594000 28800 0 CST}
|
||||
{-662716800 28800 0 CST}
|
||||
{515520000 32400 1 CDT}
|
||||
{527007600 28800 0 CST}
|
||||
{545155200 32400 1 CDT}
|
||||
{558457200 28800 0 CST}
|
||||
{576604800 32400 1 CDT}
|
||||
{589906800 28800 0 CST}
|
||||
{608659200 32400 1 CDT}
|
||||
{621961200 28800 0 CST}
|
||||
{640108800 32400 1 CDT}
|
||||
{653410800 28800 0 CST}
|
||||
{671558400 32400 1 CDT}
|
||||
{684860400 28800 0 CST}
|
||||
{-933667200 32400 1 CDT}
|
||||
{-922093200 28800 0 CST}
|
||||
{-908870400 32400 1 CDT}
|
||||
{-888829200 28800 0 CST}
|
||||
{-881049600 32400 1 CDT}
|
||||
{-767869200 28800 0 CST}
|
||||
{-745833600 32400 1 CDT}
|
||||
{-733827600 28800 0 CST}
|
||||
{-716889600 32400 1 CDT}
|
||||
{-699613200 28800 0 CST}
|
||||
{-683884800 32400 1 CDT}
|
||||
{-670669200 28800 0 CST}
|
||||
{-652348800 32400 1 CDT}
|
||||
{-650016000 28800 0 CST}
|
||||
{515527200 32400 1 CDT}
|
||||
{527014800 28800 0 CST}
|
||||
{545162400 32400 1 CDT}
|
||||
{558464400 28800 0 CST}
|
||||
{577216800 32400 1 CDT}
|
||||
{589914000 28800 0 CST}
|
||||
{608666400 32400 1 CDT}
|
||||
{621968400 28800 0 CST}
|
||||
{640116000 32400 1 CDT}
|
||||
{653418000 28800 0 CST}
|
||||
{671565600 32400 1 CDT}
|
||||
{684867600 28800 0 CST}
|
||||
}
|
||||
|
||||
@@ -4,11 +4,11 @@ set TZData(:Asia/Tokyo) {
|
||||
{-9223372036854775808 33539 0 LMT}
|
||||
{-2587712400 32400 0 JST}
|
||||
{-683802000 36000 1 JDT}
|
||||
{-672314400 32400 0 JST}
|
||||
{-672310800 32400 0 JST}
|
||||
{-654771600 36000 1 JDT}
|
||||
{-640864800 32400 0 JST}
|
||||
{-640861200 32400 0 JST}
|
||||
{-620298000 36000 1 JDT}
|
||||
{-609415200 32400 0 JST}
|
||||
{-609411600 32400 0 JST}
|
||||
{-588848400 36000 1 JDT}
|
||||
{-577965600 32400 0 JST}
|
||||
{-577962000 32400 0 JST}
|
||||
}
|
||||
|
||||
@@ -68,4 +68,5 @@ set TZData(:Europe/Volgograd) {
|
||||
{1288479600 10800 0 +03}
|
||||
{1301180400 14400 0 +04}
|
||||
{1414274400 10800 0 +03}
|
||||
{1540681200 14400 0 +04}
|
||||
}
|
||||
|
||||
+162
-162
@@ -103,166 +103,166 @@ set TZData(:Pacific/Easter) {
|
||||
{1502596800 -18000 1 -06}
|
||||
{1526180400 -21600 0 -06}
|
||||
{1534046400 -18000 1 -06}
|
||||
{1557630000 -21600 0 -06}
|
||||
{1565496000 -18000 1 -06}
|
||||
{1589079600 -21600 0 -06}
|
||||
{1596945600 -18000 1 -06}
|
||||
{1620529200 -21600 0 -06}
|
||||
{1629000000 -18000 1 -06}
|
||||
{1652583600 -21600 0 -06}
|
||||
{1660449600 -18000 1 -06}
|
||||
{1684033200 -21600 0 -06}
|
||||
{1691899200 -18000 1 -06}
|
||||
{1715482800 -21600 0 -06}
|
||||
{1723348800 -18000 1 -06}
|
||||
{1746932400 -21600 0 -06}
|
||||
{1754798400 -18000 1 -06}
|
||||
{1778382000 -21600 0 -06}
|
||||
{1786248000 -18000 1 -06}
|
||||
{1809831600 -21600 0 -06}
|
||||
{1818302400 -18000 1 -06}
|
||||
{1841886000 -21600 0 -06}
|
||||
{1849752000 -18000 1 -06}
|
||||
{1873335600 -21600 0 -06}
|
||||
{1881201600 -18000 1 -06}
|
||||
{1904785200 -21600 0 -06}
|
||||
{1912651200 -18000 1 -06}
|
||||
{1936234800 -21600 0 -06}
|
||||
{1944100800 -18000 1 -06}
|
||||
{1967684400 -21600 0 -06}
|
||||
{1976155200 -18000 1 -06}
|
||||
{1999738800 -21600 0 -06}
|
||||
{2007604800 -18000 1 -06}
|
||||
{2031188400 -21600 0 -06}
|
||||
{2039054400 -18000 1 -06}
|
||||
{2062638000 -21600 0 -06}
|
||||
{2070504000 -18000 1 -06}
|
||||
{2094087600 -21600 0 -06}
|
||||
{2101953600 -18000 1 -06}
|
||||
{2125537200 -21600 0 -06}
|
||||
{2133403200 -18000 1 -06}
|
||||
{2156986800 -21600 0 -06}
|
||||
{2165457600 -18000 1 -06}
|
||||
{2189041200 -21600 0 -06}
|
||||
{2196907200 -18000 1 -06}
|
||||
{2220490800 -21600 0 -06}
|
||||
{2228356800 -18000 1 -06}
|
||||
{2251940400 -21600 0 -06}
|
||||
{2259806400 -18000 1 -06}
|
||||
{2283390000 -21600 0 -06}
|
||||
{2291256000 -18000 1 -06}
|
||||
{2314839600 -21600 0 -06}
|
||||
{2322705600 -18000 1 -06}
|
||||
{2346894000 -21600 0 -06}
|
||||
{2354760000 -18000 1 -06}
|
||||
{2378343600 -21600 0 -06}
|
||||
{2386209600 -18000 1 -06}
|
||||
{2409793200 -21600 0 -06}
|
||||
{2417659200 -18000 1 -06}
|
||||
{2441242800 -21600 0 -06}
|
||||
{2449108800 -18000 1 -06}
|
||||
{2472692400 -21600 0 -06}
|
||||
{2480558400 -18000 1 -06}
|
||||
{2504142000 -21600 0 -06}
|
||||
{2512612800 -18000 1 -06}
|
||||
{2536196400 -21600 0 -06}
|
||||
{2544062400 -18000 1 -06}
|
||||
{2567646000 -21600 0 -06}
|
||||
{2575512000 -18000 1 -06}
|
||||
{2599095600 -21600 0 -06}
|
||||
{2606961600 -18000 1 -06}
|
||||
{2630545200 -21600 0 -06}
|
||||
{2638411200 -18000 1 -06}
|
||||
{2661994800 -21600 0 -06}
|
||||
{2669860800 -18000 1 -06}
|
||||
{2693444400 -21600 0 -06}
|
||||
{2701915200 -18000 1 -06}
|
||||
{2725498800 -21600 0 -06}
|
||||
{2733364800 -18000 1 -06}
|
||||
{2756948400 -21600 0 -06}
|
||||
{2764814400 -18000 1 -06}
|
||||
{2788398000 -21600 0 -06}
|
||||
{2796264000 -18000 1 -06}
|
||||
{2819847600 -21600 0 -06}
|
||||
{2827713600 -18000 1 -06}
|
||||
{2851297200 -21600 0 -06}
|
||||
{2859768000 -18000 1 -06}
|
||||
{2883351600 -21600 0 -06}
|
||||
{2891217600 -18000 1 -06}
|
||||
{2914801200 -21600 0 -06}
|
||||
{2922667200 -18000 1 -06}
|
||||
{2946250800 -21600 0 -06}
|
||||
{2954116800 -18000 1 -06}
|
||||
{2977700400 -21600 0 -06}
|
||||
{2985566400 -18000 1 -06}
|
||||
{3009150000 -21600 0 -06}
|
||||
{3017016000 -18000 1 -06}
|
||||
{3040599600 -21600 0 -06}
|
||||
{3049070400 -18000 1 -06}
|
||||
{3072654000 -21600 0 -06}
|
||||
{3080520000 -18000 1 -06}
|
||||
{3104103600 -21600 0 -06}
|
||||
{3111969600 -18000 1 -06}
|
||||
{3135553200 -21600 0 -06}
|
||||
{3143419200 -18000 1 -06}
|
||||
{3167002800 -21600 0 -06}
|
||||
{3174868800 -18000 1 -06}
|
||||
{3198452400 -21600 0 -06}
|
||||
{3206318400 -18000 1 -06}
|
||||
{3230506800 -21600 0 -06}
|
||||
{3238372800 -18000 1 -06}
|
||||
{3261956400 -21600 0 -06}
|
||||
{3269822400 -18000 1 -06}
|
||||
{3293406000 -21600 0 -06}
|
||||
{3301272000 -18000 1 -06}
|
||||
{3324855600 -21600 0 -06}
|
||||
{3332721600 -18000 1 -06}
|
||||
{3356305200 -21600 0 -06}
|
||||
{3364171200 -18000 1 -06}
|
||||
{3387754800 -21600 0 -06}
|
||||
{3396225600 -18000 1 -06}
|
||||
{3419809200 -21600 0 -06}
|
||||
{3427675200 -18000 1 -06}
|
||||
{3451258800 -21600 0 -06}
|
||||
{3459124800 -18000 1 -06}
|
||||
{3482708400 -21600 0 -06}
|
||||
{3490574400 -18000 1 -06}
|
||||
{3514158000 -21600 0 -06}
|
||||
{3522024000 -18000 1 -06}
|
||||
{3545607600 -21600 0 -06}
|
||||
{3553473600 -18000 1 -06}
|
||||
{3577057200 -21600 0 -06}
|
||||
{3585528000 -18000 1 -06}
|
||||
{3609111600 -21600 0 -06}
|
||||
{3616977600 -18000 1 -06}
|
||||
{3640561200 -21600 0 -06}
|
||||
{3648427200 -18000 1 -06}
|
||||
{3672010800 -21600 0 -06}
|
||||
{3679876800 -18000 1 -06}
|
||||
{3703460400 -21600 0 -06}
|
||||
{3711326400 -18000 1 -06}
|
||||
{3734910000 -21600 0 -06}
|
||||
{3743380800 -18000 1 -06}
|
||||
{3766964400 -21600 0 -06}
|
||||
{3774830400 -18000 1 -06}
|
||||
{3798414000 -21600 0 -06}
|
||||
{3806280000 -18000 1 -06}
|
||||
{3829863600 -21600 0 -06}
|
||||
{3837729600 -18000 1 -06}
|
||||
{3861313200 -21600 0 -06}
|
||||
{3869179200 -18000 1 -06}
|
||||
{3892762800 -21600 0 -06}
|
||||
{3900628800 -18000 1 -06}
|
||||
{3924212400 -21600 0 -06}
|
||||
{3932683200 -18000 1 -06}
|
||||
{3956266800 -21600 0 -06}
|
||||
{3964132800 -18000 1 -06}
|
||||
{3987716400 -21600 0 -06}
|
||||
{3995582400 -18000 1 -06}
|
||||
{4019166000 -21600 0 -06}
|
||||
{4027032000 -18000 1 -06}
|
||||
{4050615600 -21600 0 -06}
|
||||
{4058481600 -18000 1 -06}
|
||||
{4082065200 -21600 0 -06}
|
||||
{4089931200 -18000 1 -06}
|
||||
{1554606000 -21600 0 -06}
|
||||
{1567915200 -18000 1 -06}
|
||||
{1586055600 -21600 0 -06}
|
||||
{1599364800 -18000 1 -06}
|
||||
{1617505200 -21600 0 -06}
|
||||
{1630814400 -18000 1 -06}
|
||||
{1648954800 -21600 0 -06}
|
||||
{1662264000 -18000 1 -06}
|
||||
{1680404400 -21600 0 -06}
|
||||
{1693713600 -18000 1 -06}
|
||||
{1712458800 -21600 0 -06}
|
||||
{1725768000 -18000 1 -06}
|
||||
{1743908400 -21600 0 -06}
|
||||
{1757217600 -18000 1 -06}
|
||||
{1775358000 -21600 0 -06}
|
||||
{1788667200 -18000 1 -06}
|
||||
{1806807600 -21600 0 -06}
|
||||
{1820116800 -18000 1 -06}
|
||||
{1838257200 -21600 0 -06}
|
||||
{1851566400 -18000 1 -06}
|
||||
{1870311600 -21600 0 -06}
|
||||
{1883016000 -18000 1 -06}
|
||||
{1901761200 -21600 0 -06}
|
||||
{1915070400 -18000 1 -06}
|
||||
{1933210800 -21600 0 -06}
|
||||
{1946520000 -18000 1 -06}
|
||||
{1964660400 -21600 0 -06}
|
||||
{1977969600 -18000 1 -06}
|
||||
{1996110000 -21600 0 -06}
|
||||
{2009419200 -18000 1 -06}
|
||||
{2027559600 -21600 0 -06}
|
||||
{2040868800 -18000 1 -06}
|
||||
{2059614000 -21600 0 -06}
|
||||
{2072318400 -18000 1 -06}
|
||||
{2091063600 -21600 0 -06}
|
||||
{2104372800 -18000 1 -06}
|
||||
{2122513200 -21600 0 -06}
|
||||
{2135822400 -18000 1 -06}
|
||||
{2153962800 -21600 0 -06}
|
||||
{2167272000 -18000 1 -06}
|
||||
{2185412400 -21600 0 -06}
|
||||
{2198721600 -18000 1 -06}
|
||||
{2217466800 -21600 0 -06}
|
||||
{2230171200 -18000 1 -06}
|
||||
{2248916400 -21600 0 -06}
|
||||
{2262225600 -18000 1 -06}
|
||||
{2280366000 -21600 0 -06}
|
||||
{2293675200 -18000 1 -06}
|
||||
{2311815600 -21600 0 -06}
|
||||
{2325124800 -18000 1 -06}
|
||||
{2343265200 -21600 0 -06}
|
||||
{2356574400 -18000 1 -06}
|
||||
{2374714800 -21600 0 -06}
|
||||
{2388024000 -18000 1 -06}
|
||||
{2406769200 -21600 0 -06}
|
||||
{2419473600 -18000 1 -06}
|
||||
{2438218800 -21600 0 -06}
|
||||
{2451528000 -18000 1 -06}
|
||||
{2469668400 -21600 0 -06}
|
||||
{2482977600 -18000 1 -06}
|
||||
{2501118000 -21600 0 -06}
|
||||
{2514427200 -18000 1 -06}
|
||||
{2532567600 -21600 0 -06}
|
||||
{2545876800 -18000 1 -06}
|
||||
{2564017200 -21600 0 -06}
|
||||
{2577326400 -18000 1 -06}
|
||||
{2596071600 -21600 0 -06}
|
||||
{2609380800 -18000 1 -06}
|
||||
{2627521200 -21600 0 -06}
|
||||
{2640830400 -18000 1 -06}
|
||||
{2658970800 -21600 0 -06}
|
||||
{2672280000 -18000 1 -06}
|
||||
{2690420400 -21600 0 -06}
|
||||
{2703729600 -18000 1 -06}
|
||||
{2721870000 -21600 0 -06}
|
||||
{2735179200 -18000 1 -06}
|
||||
{2753924400 -21600 0 -06}
|
||||
{2766628800 -18000 1 -06}
|
||||
{2785374000 -21600 0 -06}
|
||||
{2798683200 -18000 1 -06}
|
||||
{2816823600 -21600 0 -06}
|
||||
{2830132800 -18000 1 -06}
|
||||
{2848273200 -21600 0 -06}
|
||||
{2861582400 -18000 1 -06}
|
||||
{2879722800 -21600 0 -06}
|
||||
{2893032000 -18000 1 -06}
|
||||
{2911172400 -21600 0 -06}
|
||||
{2924481600 -18000 1 -06}
|
||||
{2943226800 -21600 0 -06}
|
||||
{2955931200 -18000 1 -06}
|
||||
{2974676400 -21600 0 -06}
|
||||
{2987985600 -18000 1 -06}
|
||||
{3006126000 -21600 0 -06}
|
||||
{3019435200 -18000 1 -06}
|
||||
{3037575600 -21600 0 -06}
|
||||
{3050884800 -18000 1 -06}
|
||||
{3069025200 -21600 0 -06}
|
||||
{3082334400 -18000 1 -06}
|
||||
{3101079600 -21600 0 -06}
|
||||
{3113784000 -18000 1 -06}
|
||||
{3132529200 -21600 0 -06}
|
||||
{3145838400 -18000 1 -06}
|
||||
{3163978800 -21600 0 -06}
|
||||
{3177288000 -18000 1 -06}
|
||||
{3195428400 -21600 0 -06}
|
||||
{3208737600 -18000 1 -06}
|
||||
{3226878000 -21600 0 -06}
|
||||
{3240187200 -18000 1 -06}
|
||||
{3258327600 -21600 0 -06}
|
||||
{3271636800 -18000 1 -06}
|
||||
{3290382000 -21600 0 -06}
|
||||
{3303086400 -18000 1 -06}
|
||||
{3321831600 -21600 0 -06}
|
||||
{3335140800 -18000 1 -06}
|
||||
{3353281200 -21600 0 -06}
|
||||
{3366590400 -18000 1 -06}
|
||||
{3384730800 -21600 0 -06}
|
||||
{3398040000 -18000 1 -06}
|
||||
{3416180400 -21600 0 -06}
|
||||
{3429489600 -18000 1 -06}
|
||||
{3447630000 -21600 0 -06}
|
||||
{3460939200 -18000 1 -06}
|
||||
{3479684400 -21600 0 -06}
|
||||
{3492993600 -18000 1 -06}
|
||||
{3511134000 -21600 0 -06}
|
||||
{3524443200 -18000 1 -06}
|
||||
{3542583600 -21600 0 -06}
|
||||
{3555892800 -18000 1 -06}
|
||||
{3574033200 -21600 0 -06}
|
||||
{3587342400 -18000 1 -06}
|
||||
{3605482800 -21600 0 -06}
|
||||
{3618792000 -18000 1 -06}
|
||||
{3637537200 -21600 0 -06}
|
||||
{3650241600 -18000 1 -06}
|
||||
{3668986800 -21600 0 -06}
|
||||
{3682296000 -18000 1 -06}
|
||||
{3700436400 -21600 0 -06}
|
||||
{3713745600 -18000 1 -06}
|
||||
{3731886000 -21600 0 -06}
|
||||
{3745195200 -18000 1 -06}
|
||||
{3763335600 -21600 0 -06}
|
||||
{3776644800 -18000 1 -06}
|
||||
{3794785200 -21600 0 -06}
|
||||
{3808094400 -18000 1 -06}
|
||||
{3826839600 -21600 0 -06}
|
||||
{3839544000 -18000 1 -06}
|
||||
{3858289200 -21600 0 -06}
|
||||
{3871598400 -18000 1 -06}
|
||||
{3889738800 -21600 0 -06}
|
||||
{3903048000 -18000 1 -06}
|
||||
{3921188400 -21600 0 -06}
|
||||
{3934497600 -18000 1 -06}
|
||||
{3952638000 -21600 0 -06}
|
||||
{3965947200 -18000 1 -06}
|
||||
{3984692400 -21600 0 -06}
|
||||
{3997396800 -18000 1 -06}
|
||||
{4016142000 -21600 0 -06}
|
||||
{4029451200 -18000 1 -06}
|
||||
{4047591600 -21600 0 -06}
|
||||
{4060900800 -18000 1 -06}
|
||||
{4079041200 -21600 0 -06}
|
||||
{4092350400 -18000 1 -06}
|
||||
}
|
||||
|
||||
+12
-12
@@ -26,7 +26,7 @@ set TZData(:Pacific/Fiji) {
|
||||
{1509804000 46800 1 +12}
|
||||
{1515852000 43200 0 +12}
|
||||
{1541253600 46800 1 +12}
|
||||
{1547906400 43200 0 +12}
|
||||
{1547301600 43200 0 +12}
|
||||
{1572703200 46800 1 +12}
|
||||
{1579356000 43200 0 +12}
|
||||
{1604152800 46800 1 +12}
|
||||
@@ -48,7 +48,7 @@ set TZData(:Pacific/Fiji) {
|
||||
{1856959200 46800 1 +12}
|
||||
{1863007200 43200 0 +12}
|
||||
{1888408800 46800 1 +12}
|
||||
{1895061600 43200 0 +12}
|
||||
{1894456800 43200 0 +12}
|
||||
{1919858400 46800 1 +12}
|
||||
{1926511200 43200 0 +12}
|
||||
{1951308000 46800 1 +12}
|
||||
@@ -60,7 +60,7 @@ set TZData(:Pacific/Fiji) {
|
||||
{2046261600 46800 1 +12}
|
||||
{2052309600 43200 0 +12}
|
||||
{2077711200 46800 1 +12}
|
||||
{2084364000 43200 0 +12}
|
||||
{2083759200 43200 0 +12}
|
||||
{2109160800 46800 1 +12}
|
||||
{2115813600 43200 0 +12}
|
||||
{2140610400 46800 1 +12}
|
||||
@@ -70,7 +70,7 @@ set TZData(:Pacific/Fiji) {
|
||||
{2204114400 46800 1 +12}
|
||||
{2210162400 43200 0 +12}
|
||||
{2235564000 46800 1 +12}
|
||||
{2242216800 43200 0 +12}
|
||||
{2241612000 43200 0 +12}
|
||||
{2267013600 46800 1 +12}
|
||||
{2273666400 43200 0 +12}
|
||||
{2298463200 46800 1 +12}
|
||||
@@ -82,7 +82,7 @@ set TZData(:Pacific/Fiji) {
|
||||
{2393416800 46800 1 +12}
|
||||
{2399464800 43200 0 +12}
|
||||
{2424866400 46800 1 +12}
|
||||
{2431519200 43200 0 +12}
|
||||
{2430914400 43200 0 +12}
|
||||
{2456316000 46800 1 +12}
|
||||
{2462968800 43200 0 +12}
|
||||
{2487765600 46800 1 +12}
|
||||
@@ -104,7 +104,7 @@ set TZData(:Pacific/Fiji) {
|
||||
{2740572000 46800 1 +12}
|
||||
{2746620000 43200 0 +12}
|
||||
{2772021600 46800 1 +12}
|
||||
{2778674400 43200 0 +12}
|
||||
{2778069600 43200 0 +12}
|
||||
{2803471200 46800 1 +12}
|
||||
{2810124000 43200 0 +12}
|
||||
{2834920800 46800 1 +12}
|
||||
@@ -116,7 +116,7 @@ set TZData(:Pacific/Fiji) {
|
||||
{2929874400 46800 1 +12}
|
||||
{2935922400 43200 0 +12}
|
||||
{2961324000 46800 1 +12}
|
||||
{2967976800 43200 0 +12}
|
||||
{2967372000 43200 0 +12}
|
||||
{2992773600 46800 1 +12}
|
||||
{2999426400 43200 0 +12}
|
||||
{3024223200 46800 1 +12}
|
||||
@@ -126,7 +126,7 @@ set TZData(:Pacific/Fiji) {
|
||||
{3087727200 46800 1 +12}
|
||||
{3093775200 43200 0 +12}
|
||||
{3119176800 46800 1 +12}
|
||||
{3125829600 43200 0 +12}
|
||||
{3125224800 43200 0 +12}
|
||||
{3150626400 46800 1 +12}
|
||||
{3157279200 43200 0 +12}
|
||||
{3182076000 46800 1 +12}
|
||||
@@ -138,7 +138,7 @@ set TZData(:Pacific/Fiji) {
|
||||
{3277029600 46800 1 +12}
|
||||
{3283077600 43200 0 +12}
|
||||
{3308479200 46800 1 +12}
|
||||
{3315132000 43200 0 +12}
|
||||
{3314527200 43200 0 +12}
|
||||
{3339928800 46800 1 +12}
|
||||
{3346581600 43200 0 +12}
|
||||
{3371378400 46800 1 +12}
|
||||
@@ -160,7 +160,7 @@ set TZData(:Pacific/Fiji) {
|
||||
{3624184800 46800 1 +12}
|
||||
{3630232800 43200 0 +12}
|
||||
{3655634400 46800 1 +12}
|
||||
{3662287200 43200 0 +12}
|
||||
{3661682400 43200 0 +12}
|
||||
{3687084000 46800 1 +12}
|
||||
{3693736800 43200 0 +12}
|
||||
{3718533600 46800 1 +12}
|
||||
@@ -172,7 +172,7 @@ set TZData(:Pacific/Fiji) {
|
||||
{3813487200 46800 1 +12}
|
||||
{3819535200 43200 0 +12}
|
||||
{3844936800 46800 1 +12}
|
||||
{3851589600 43200 0 +12}
|
||||
{3850984800 43200 0 +12}
|
||||
{3876386400 46800 1 +12}
|
||||
{3883039200 43200 0 +12}
|
||||
{3907836000 46800 1 +12}
|
||||
@@ -182,7 +182,7 @@ set TZData(:Pacific/Fiji) {
|
||||
{3971340000 46800 1 +12}
|
||||
{3977388000 43200 0 +12}
|
||||
{4002789600 46800 1 +12}
|
||||
{4009442400 43200 0 +12}
|
||||
{4008837600 43200 0 +12}
|
||||
{4034239200 46800 1 +12}
|
||||
{4040892000 43200 0 +12}
|
||||
{4065688800 46800 1 +12}
|
||||
|
||||
@@ -4,8 +4,9 @@ set TZData(:Pacific/Honolulu) {
|
||||
{-9223372036854775808 -37886 0 LMT}
|
||||
{-2334101314 -37800 0 HST}
|
||||
{-1157283000 -34200 1 HDT}
|
||||
{-1155436200 -37800 0 HST}
|
||||
{-880198200 -34200 1 HDT}
|
||||
{-1155436200 -34200 0 HST}
|
||||
{-880201800 -34200 1 HWT}
|
||||
{-769395600 -34200 1 HPT}
|
||||
{-765376200 -37800 0 HST}
|
||||
{-712150200 -36000 0 HST}
|
||||
}
|
||||
|
||||
+3
-1
@@ -22,5 +22,7 @@ if {[singleProcess]} {
|
||||
interp debug {} -frame 1
|
||||
}
|
||||
|
||||
runAllTests
|
||||
set ErrorOnFailures [info exists env(ERROR_ON_FAILURES)]
|
||||
unset -nocomplain env(ERROR_ON_FAILURES)
|
||||
if {[runAllTests] && $ErrorOnFailures} {exit 1}
|
||||
proc exit args {}
|
||||
|
||||
+1
-1
@@ -23,7 +23,7 @@ testConstraint testsetplatform [llength [info commands testsetplatform]]
|
||||
testConstraint testvolumetype [llength [info commands testvolumetype]]
|
||||
testConstraint linkDirectory [expr {
|
||||
![testConstraint win] ||
|
||||
([string index $tcl_platform(osVersion) 0] >= 5
|
||||
($::tcl_platform(osVersion) >= 5.0
|
||||
&& [lindex [file system [temporaryDirectory]] 1] eq "NTFS")
|
||||
}]
|
||||
|
||||
|
||||
+5
-6
@@ -65,11 +65,10 @@ if {[testConstraint unix]} {
|
||||
|
||||
# Also used in winFCmd...
|
||||
if {[testConstraint win]} {
|
||||
set major [string index $tcl_platform(osVersion) 0]
|
||||
if {[testConstraint nt] && $major > 4} {
|
||||
if {$major > 5} {
|
||||
if {[testConstraint nt] && $::tcl_platform(osVersion) >= 5.0} {
|
||||
if {$::tcl_platform(osVersion) >= 6.0} {
|
||||
testConstraint winVista 1
|
||||
} elseif {$major == 5} {
|
||||
} else {
|
||||
testConstraint win2000orXP 1
|
||||
}
|
||||
}
|
||||
@@ -78,7 +77,7 @@ if {[testConstraint win]} {
|
||||
testConstraint darwin9 [expr {
|
||||
[testConstraint unix]
|
||||
&& $tcl_platform(os) eq "Darwin"
|
||||
&& [package vsatisfies 1.$tcl_platform(osVersion) 1.9]
|
||||
&& [package vsatisfies 1.$::tcl_platform(osVersion) 1.9]
|
||||
}]
|
||||
testConstraint notDarwin9 [expr {![testConstraint darwin9]}]
|
||||
|
||||
@@ -2309,7 +2308,7 @@ test fCmd-27.6 {TclFileAttrsCmd - setting more than one option} -setup {
|
||||
|
||||
if {
|
||||
[testConstraint win] &&
|
||||
([string index $tcl_platform(osVersion) 0] < 5
|
||||
($::tcl_platform(osVersion) < 5.0
|
||||
|| [lindex [file system [temporaryDirectory]] 1] ne "NTFS")
|
||||
} then {
|
||||
testConstraint linkDirectory 0
|
||||
|
||||
+1
-1
@@ -23,7 +23,7 @@ testConstraint testtranslatefilename [llength [info commands testtranslatefilena
|
||||
testConstraint linkDirectory 1
|
||||
testConstraint symbolicLinkFile 1
|
||||
if {[testConstraint win]} {
|
||||
if {[string index $tcl_platform(osVersion) 0] < 5 \
|
||||
if {$::tcl_platform(osVersion) < 5.0 \
|
||||
|| [lindex [file system [temporaryDirectory]] 1] ne "NTFS"} {
|
||||
testConstraint linkDirectory 0
|
||||
}
|
||||
|
||||
+3
-3
@@ -86,7 +86,7 @@ if {[catch {package present Thread}] == 0 && [file exists $httpdFile]} {
|
||||
test http-1.1 {http::config} {
|
||||
http::config -useragent UserAgent
|
||||
http::config
|
||||
} [list -accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -urlencoding utf-8 -useragent "UserAgent"]
|
||||
} [list -accept */* -pipeline 1 -postfresh 0 -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -repost 0 -urlencoding utf-8 -useragent UserAgent -zip 1]
|
||||
test http-1.2 {http::config} {
|
||||
http::config -proxyfilter
|
||||
} http::ProxyRequired
|
||||
@@ -101,10 +101,10 @@ test http-1.4 {http::config} {
|
||||
set x [http::config]
|
||||
http::config {*}$savedconf
|
||||
set x
|
||||
} {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -urlencoding iso8859-1 -useragent {Tcl Test Suite}}
|
||||
} {-accept */* -pipeline 1 -postfresh 0 -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -repost 0 -urlencoding iso8859-1 -useragent {Tcl Test Suite} -zip 1}
|
||||
test http-1.5 {http::config} -returnCodes error -body {
|
||||
http::config -proxyhost {} -junk 8080
|
||||
} -result {Unknown option -junk, must be: -accept, -proxyfilter, -proxyhost, -proxyport, -urlencoding, -useragent}
|
||||
} -result {Unknown option -junk, must be: -accept, -pipeline, -postfresh, -proxyfilter, -proxyhost, -proxyport, -repost, -urlencoding, -useragent, -zip}
|
||||
test http-1.6 {http::config} -setup {
|
||||
set oldenc [http::config -urlencoding]
|
||||
} -body {
|
||||
|
||||
+1
-4
@@ -515,10 +515,7 @@ proc handler {var sock token} {
|
||||
set chunk [read $sock]
|
||||
append data $chunk
|
||||
#::http::Log "handler read [string length $chunk] ([chan configure $sock -buffersize])"
|
||||
if {[eof $sock]} {
|
||||
#::http::Log "handler eof $sock"
|
||||
chan event $sock readable {}
|
||||
}
|
||||
return [string length $chunk]
|
||||
}
|
||||
|
||||
test http11-3.0 "-handler,close,identity" -setup {
|
||||
|
||||
@@ -0,0 +1,866 @@
|
||||
# httpPipeline.test
|
||||
#
|
||||
# Test HTTP/1.1 concurrent requests including
|
||||
# queueing, pipelining and retries.
|
||||
#
|
||||
# Copyright (C) 2018 Keith Nash <kjnash@users.sourceforge.net>
|
||||
#
|
||||
# See the file "license.terms" for information on usage and redistribution
|
||||
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
|
||||
package require tcltest 2
|
||||
namespace import -force ::tcltest::*
|
||||
|
||||
package require http 2.8
|
||||
|
||||
set sourcedir [file normalize [file dirname [info script]]]
|
||||
source [file join $sourcedir httpTest.tcl]
|
||||
source [file join $sourcedir httpTestScript.tcl]
|
||||
|
||||
# ------------------------------------------------------------------------------
|
||||
# (1) Define the test scripts that will be used to generate logs for analysis -
|
||||
# and also define the "correct" results.
|
||||
# ------------------------------------------------------------------------------
|
||||
|
||||
proc ReturnTestScriptAndResult {ca cb delay te} {
|
||||
|
||||
switch -- $ca {
|
||||
1 {set start {
|
||||
START
|
||||
KEEPALIVE 0
|
||||
PIPELINE 0
|
||||
}}
|
||||
|
||||
2 {set start {
|
||||
START
|
||||
KEEPALIVE 0
|
||||
PIPELINE 1
|
||||
}}
|
||||
|
||||
3 {set start {
|
||||
START
|
||||
KEEPALIVE 1
|
||||
PIPELINE 0
|
||||
}}
|
||||
|
||||
4 {set start {
|
||||
START
|
||||
KEEPALIVE 1
|
||||
PIPELINE 1
|
||||
}}
|
||||
|
||||
default {
|
||||
return -code error {no matching script}
|
||||
}
|
||||
}
|
||||
|
||||
set middle "
|
||||
[list DELAY $delay]
|
||||
"
|
||||
|
||||
switch -- $cb {
|
||||
1 {set end {
|
||||
GET a
|
||||
GET b
|
||||
GET c
|
||||
GET a
|
||||
STOP
|
||||
}
|
||||
set resShort {1 ? ? ?}
|
||||
set resLong {1 2 3 4}
|
||||
}
|
||||
|
||||
2 {set end {
|
||||
GET a
|
||||
HEAD b
|
||||
GET c
|
||||
HEAD a
|
||||
HEAD c
|
||||
STOP
|
||||
}
|
||||
set resShort {1 ? ? ? ?}
|
||||
set resLong {1 2 3 4 5}
|
||||
}
|
||||
|
||||
3 {set end {
|
||||
HEAD a
|
||||
GET b
|
||||
HEAD c
|
||||
HEAD b
|
||||
GET a
|
||||
GET b
|
||||
STOP
|
||||
}
|
||||
set resShort {1 ? ? ? ? ?}
|
||||
set resLong {1 2 3 4 5 6}
|
||||
}
|
||||
|
||||
4 {set end {
|
||||
GET a
|
||||
GET b
|
||||
GET c
|
||||
GET a
|
||||
POST b address=home code=brief paid=yes
|
||||
GET c
|
||||
GET a
|
||||
GET b
|
||||
GET c
|
||||
STOP
|
||||
}
|
||||
set resShort {1 ? ? ? 5 ? ? ? ?}
|
||||
set resLong {1 2 3 4 5 6 7 8 9}
|
||||
}
|
||||
|
||||
5 {set end {
|
||||
POST a address=home code=brief paid=yes
|
||||
POST b address=home code=brief paid=yes
|
||||
POST c address=home code=brief paid=yes
|
||||
POST a address=home code=brief paid=yes
|
||||
POST b address=home code=brief paid=yes
|
||||
POST c address=home code=brief paid=yes
|
||||
POST a address=home code=brief paid=yes
|
||||
POST b address=home code=brief paid=yes
|
||||
POST c address=home code=brief paid=yes
|
||||
STOP
|
||||
}
|
||||
set resShort {1 2 3 4 5 6 7 8 9}
|
||||
set resLong {1 2 3 4 5 6 7 8 9}
|
||||
}
|
||||
|
||||
6 {set end {
|
||||
POST a address=home code=brief paid=yes
|
||||
GET b address=home code=brief paid=yes
|
||||
POST c address=home code=brief paid=yes
|
||||
GET a address=home code=brief paid=yes
|
||||
GET b address=home code=brief paid=yes
|
||||
POST c address=home code=brief paid=yes
|
||||
POST a address=home code=brief paid=yes
|
||||
HEAD b address=home code=brief paid=yes
|
||||
GET c address=home code=brief paid=yes
|
||||
STOP
|
||||
}
|
||||
set resShort {1 ? 3 ? ? 6 7 ? ?}
|
||||
set resLong {1 2 3 4 5 6 7 8 9}
|
||||
}
|
||||
|
||||
7 {set end {
|
||||
GET b address=home code=brief paid=yes
|
||||
POST a address=home code=brief paid=yes
|
||||
GET a address=home code=brief paid=yes
|
||||
POST c address=home code=brief paid=yes
|
||||
GET b address=home code=brief paid=yes
|
||||
HEAD b address=home code=brief paid=yes
|
||||
POST c address=home code=brief paid=yes
|
||||
POST a address=home code=brief paid=yes
|
||||
GET c address=home code=brief paid=yes
|
||||
STOP
|
||||
}
|
||||
set resShort {1 2 ? 4 ? ? 7 8 ?}
|
||||
set resLong {1 2 3 4 5 6 7 8 9}
|
||||
}
|
||||
|
||||
8 {set end {
|
||||
# Telling the server to close the connection.
|
||||
GET a
|
||||
GET b close=y
|
||||
GET c
|
||||
GET a
|
||||
GET b
|
||||
GET c
|
||||
GET a
|
||||
GET b
|
||||
GET c
|
||||
STOP
|
||||
}
|
||||
set resShort {1 ? 3 ? ? ? ? ? ?}
|
||||
set resLong {1 2 3 4 5 6 7 8 9}
|
||||
}
|
||||
|
||||
9 {set end {
|
||||
# Telling the server to close the connection.
|
||||
GET a
|
||||
POST b close=y address=home code=brief paid=yes
|
||||
GET c
|
||||
GET a
|
||||
GET b
|
||||
GET c
|
||||
GET a
|
||||
GET b
|
||||
GET c
|
||||
STOP
|
||||
}
|
||||
set resShort {1 2 3 ? ? ? ? ? ?}
|
||||
set resLong {1 2 3 4 5 6 7 8 9}
|
||||
}
|
||||
|
||||
10 {set end {
|
||||
# Telling the server to close the connection.
|
||||
GET a
|
||||
GET b close=y
|
||||
POST c address=home code=brief paid=yes
|
||||
GET a
|
||||
GET b
|
||||
GET c
|
||||
GET a
|
||||
GET b
|
||||
GET c
|
||||
STOP
|
||||
}
|
||||
set resShort {1 ? 3 ? ? ? ? ? ?}
|
||||
set resLong {1 2 3 4 5 6 7 8 9}
|
||||
}
|
||||
|
||||
11 {set end {
|
||||
# Telling the server to close the connection twice.
|
||||
GET a
|
||||
GET b close=y
|
||||
GET c
|
||||
GET a
|
||||
GET b close=y
|
||||
GET c
|
||||
GET a
|
||||
GET b
|
||||
GET c
|
||||
STOP
|
||||
}
|
||||
set resShort {1 ? 3 ? ? 6 ? ? ?}
|
||||
set resLong {1 2 3 4 5 6 7 8 9}
|
||||
}
|
||||
|
||||
12 {set end {
|
||||
# Telling the server to delay before sending the response.
|
||||
GET a
|
||||
GET b delay=1
|
||||
GET c
|
||||
GET a
|
||||
GET b
|
||||
STOP
|
||||
}
|
||||
set resShort {1 ? ? ? ?}
|
||||
set resLong {1 2 3 4 5}
|
||||
}
|
||||
|
||||
13 {set end {
|
||||
# Making the server close the connection (time out).
|
||||
GET a
|
||||
WAIT 2000
|
||||
GET b
|
||||
GET c
|
||||
GET a
|
||||
GET b
|
||||
STOP
|
||||
}
|
||||
set resShort {1 2 ? ? ?}
|
||||
set resLong {1 2 3 4 5}
|
||||
}
|
||||
|
||||
14 {set end {
|
||||
# Making the server close the connection (time out) twice.
|
||||
GET a
|
||||
WAIT 2000
|
||||
GET b
|
||||
GET c
|
||||
GET a
|
||||
WAIT 2000
|
||||
GET b
|
||||
GET c
|
||||
GET a
|
||||
GET b
|
||||
GET c
|
||||
STOP
|
||||
}
|
||||
set resShort {1 2 ? ? 5 ? ? ? ?}
|
||||
set resLong {1 2 3 4 5 6 7 8 9}
|
||||
}
|
||||
|
||||
15 {set end {
|
||||
POST a address=home code=brief paid=yes
|
||||
POST b address=home code=brief paid=yes close=y delay=1
|
||||
POST c address=home code=brief paid=yes delay=1
|
||||
POST a address=home code=brief paid=yes close=y
|
||||
WAIT 2000
|
||||
POST b address=home code=brief paid=yes delay=1
|
||||
POST c address=home code=brief paid=yes close=y
|
||||
POST a address=home code=brief paid=yes
|
||||
POST b address=home code=brief paid=yes close=y
|
||||
POST c address=home code=brief paid=yes
|
||||
STOP
|
||||
}
|
||||
set resShort {1 2 3 4 5 6 7 8 9}
|
||||
set resLong {1 2 3 4 5 6 7 8 9}
|
||||
}
|
||||
|
||||
16 {set end {
|
||||
POST a address=home code=brief paid=yes
|
||||
GET b address=home code=brief paid=yes
|
||||
POST c address=home code=brief paid=yes close=y
|
||||
GET a address=home code=brief paid=yes
|
||||
GET b address=home code=brief paid=yes close=y
|
||||
POST c address=home code=brief paid=yes
|
||||
WAIT 2000
|
||||
POST a address=home code=brief paid=yes
|
||||
HEAD b address=home code=brief paid=yes close=y
|
||||
GET c address=home code=brief paid=yes
|
||||
STOP
|
||||
}
|
||||
set resShort {1 ? 3 4 ? 6 7 ? 9}
|
||||
set resLong {1 2 3 4 5 6 7 8 9}
|
||||
}
|
||||
|
||||
17 {set end {
|
||||
GET b address=home code=brief paid=yes
|
||||
POST a address=home code=brief paid=yes
|
||||
GET a address=home code=brief paid=yes
|
||||
POST c address=home code=brief paid=yes close=y
|
||||
GET b address=home code=brief paid=yes
|
||||
HEAD b address=home code=brief paid=yes close=y
|
||||
POST c address=home code=brief paid=yes
|
||||
WAIT 2000
|
||||
POST a address=home code=brief paid=yes
|
||||
WAIT 2000
|
||||
GET c address=home code=brief paid=yes
|
||||
STOP
|
||||
}
|
||||
set resShort {1 2 3 4 5 ? 7 8 9}
|
||||
set resLong {1 2 3 4 5 6 7 8 9}
|
||||
}
|
||||
|
||||
|
||||
18 {set end {
|
||||
REPOST 0
|
||||
GET a
|
||||
WAIT 2000
|
||||
POST b address=home code=brief paid=yes
|
||||
GET c
|
||||
GET a
|
||||
STOP
|
||||
}
|
||||
set resShort {1 2 ? ?}
|
||||
set resLong {1 2 3 4}
|
||||
# resShort is overwritten below for the case ($te == 1).
|
||||
}
|
||||
|
||||
|
||||
19 {set end {
|
||||
REPOST 0
|
||||
GET a
|
||||
WAIT 2000
|
||||
GET b address=home code=brief paid=yes
|
||||
GET c
|
||||
GET a
|
||||
STOP
|
||||
}
|
||||
set resShort {1 2 ? ?}
|
||||
set resLong {1 2 3 4}
|
||||
}
|
||||
|
||||
|
||||
20 {set end {
|
||||
POSTFRESH 1
|
||||
GET a
|
||||
WAIT 2000
|
||||
POST b address=home code=brief paid=yes
|
||||
GET c
|
||||
GET a
|
||||
STOP
|
||||
}
|
||||
set resShort {1 3 ?}
|
||||
set resLong {1 3 4}
|
||||
}
|
||||
|
||||
|
||||
21 {set end {
|
||||
POSTFRESH 1
|
||||
GET a
|
||||
WAIT 2000
|
||||
GET b address=home code=brief paid=yes
|
||||
GET c
|
||||
GET a
|
||||
STOP
|
||||
}
|
||||
set resShort {1 2 ? ?}
|
||||
set resLong {1 2 3 4}
|
||||
}
|
||||
|
||||
22 {set end {
|
||||
GET a
|
||||
WAIT 2000
|
||||
KEEPALIVE 0
|
||||
POST b address=home code=brief paid=yes
|
||||
KEEPALIVE 1
|
||||
GET c
|
||||
GET a
|
||||
STOP
|
||||
}
|
||||
set resShort {1 3 ?}
|
||||
set resLong {1 3 4}
|
||||
}
|
||||
|
||||
|
||||
23 {set end {
|
||||
GET a
|
||||
WAIT 2000
|
||||
KEEPALIVE 0
|
||||
GET b address=home code=brief paid=yes
|
||||
KEEPALIVE 1
|
||||
GET c
|
||||
GET a
|
||||
STOP
|
||||
}
|
||||
set resShort {1 3 ?}
|
||||
set resLong {1 3 4}
|
||||
}
|
||||
|
||||
24 {set end {
|
||||
GET a
|
||||
KEEPALIVE 0
|
||||
POST b address=home code=brief paid=yes
|
||||
KEEPALIVE 1
|
||||
GET c
|
||||
GET a
|
||||
STOP
|
||||
}
|
||||
set resShort {1 ? ?}
|
||||
set resLong {1 3 4}
|
||||
}
|
||||
|
||||
|
||||
25 {set end {
|
||||
GET a
|
||||
KEEPALIVE 0
|
||||
GET b address=home code=brief paid=yes
|
||||
KEEPALIVE 1
|
||||
GET c
|
||||
GET a
|
||||
STOP
|
||||
}
|
||||
set resShort {1 ? ?}
|
||||
set resLong {1 3 4}
|
||||
}
|
||||
|
||||
default {
|
||||
return -code error {no matching script}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
if {$ca < 3} {
|
||||
# Not Keep-Alive.
|
||||
set result "Passed all sanity checks."
|
||||
|
||||
} elseif {$ca == 3} {
|
||||
# Keep-Alive, not pipelined.
|
||||
set result {}
|
||||
append result "Passed all sanity checks.\n"
|
||||
append result "Have overlaps including response body:\n"
|
||||
|
||||
} else {
|
||||
# Keep-Alive, pipelined: ($ca == 4)
|
||||
set result {}
|
||||
append result "Passed all sanity checks.\n"
|
||||
append result "Overlap-free without response body:\n"
|
||||
append result "$resShort"
|
||||
}
|
||||
|
||||
# - The special case of test *.18*-testEof needs test results to be
|
||||
# individually written.
|
||||
# - These test -repost 0 when there is a POST to apply it to, and the server
|
||||
# timeout has not been detected.
|
||||
if {($cb == 18) && ($te == 1)} {
|
||||
if {$ca < 3} {
|
||||
# Not Keep-Alive.
|
||||
set result "Passed all sanity checks."
|
||||
|
||||
} elseif {$ca == 3 && $delay == 0} {
|
||||
# Keep-Alive, not pipelined.
|
||||
set result [MakeMessage {
|
||||
|Problems with sanity checks:
|
||||
|Wrong sequence for token ::http::2 - {A B C D X X X}
|
||||
|- and error(s) X
|
||||
|Wrong sequence for token ::http::3 - {A X X}
|
||||
|- and error(s) X
|
||||
|Wrong sequence for token ::http::4 - {A X X X}
|
||||
|- and error(s) X
|
||||
|
|
||||
|Have overlaps including response body:
|
||||
|
|
||||
}]
|
||||
|
||||
} elseif {$ca == 3} {
|
||||
# Keep-Alive, not pipelined.
|
||||
set result [MakeMessage {
|
||||
|Problems with sanity checks:
|
||||
|Wrong sequence for token ::http::2 - {A B C D X X X}
|
||||
|- and error(s) X
|
||||
|
|
||||
|Have overlaps including response body:
|
||||
|
|
||||
}]
|
||||
|
||||
} elseif {$delay == 0} {
|
||||
# Keep-Alive, pipelined: ($ca == 4)
|
||||
set result [MakeMessage {
|
||||
|Problems with sanity checks:
|
||||
|Wrong sequence for token ::http::2 - {A B C D X X X}
|
||||
|- and error(s) X
|
||||
|Wrong sequence for token ::http::3 - {A X X}
|
||||
|- and error(s) X
|
||||
|Wrong sequence for token ::http::4 - {A X X X}
|
||||
|- and error(s) X
|
||||
|
|
||||
|Overlap-free without response body:
|
||||
|
|
||||
}]
|
||||
|
||||
} else {
|
||||
set result [MakeMessage {
|
||||
|Problems with sanity checks:
|
||||
|Wrong sequence for token ::http::2 - {A B C D X X X}
|
||||
|- and error(s) X
|
||||
|
|
||||
|Overlap-free without response body:
|
||||
|
|
||||
}]
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
return [list "$start$middle$end" $result]
|
||||
}
|
||||
|
||||
# ------------------------------------------------------------------------------
|
||||
# Proc MakeMessage
|
||||
# ------------------------------------------------------------------------------
|
||||
# WHD's one-line command to generate multi-line strings from readable code.
|
||||
#
|
||||
# Example:
|
||||
# set blurb [MakeMessage {
|
||||
# |This command allows multi-line strings to be created with readable
|
||||
# |code, and without breaking the rules for indentation.
|
||||
# |
|
||||
# |The command shifts the entire block of text to the left, omitting
|
||||
# |the pipe character and the spaces to its left.
|
||||
# }]
|
||||
# ------------------------------------------------------------------------------
|
||||
|
||||
proc MakeMessage {in} {
|
||||
regsub -all -line {^\s*\|} [string trim $in] {}
|
||||
# N.B. Implicit Return.
|
||||
}
|
||||
|
||||
|
||||
proc ReturnTestScript {ca cb delay te} {
|
||||
lassign [ReturnTestScriptAndResult $ca $cb $delay $te] script result
|
||||
return $script
|
||||
}
|
||||
|
||||
proc ReturnTestResult {ca cb delay te} {
|
||||
lassign [ReturnTestScriptAndResult $ca $cb $delay $te] script result
|
||||
return $result
|
||||
}
|
||||
|
||||
|
||||
# ------------------------------------------------------------------------------
|
||||
# (2) Command to run a test script and use httpTest to analyse the logs.
|
||||
# ------------------------------------------------------------------------------
|
||||
|
||||
namespace import httpTestScript::runHttpTestScript
|
||||
namespace import httpTestScript::cleanupHttpTestScript
|
||||
namespace import httpTest::cleanupHttpTest
|
||||
namespace import httpTest::logAnalyse
|
||||
namespace import httpTest::setHttpTestOptions
|
||||
|
||||
proc RunTest {header footer delay te} {
|
||||
set num [runHttpTestScript [ReturnTestScript $header $footer $delay $te]]
|
||||
set skipOverlaps 0
|
||||
set notPiped {}
|
||||
set notIncluded {}
|
||||
|
||||
# --------------------------------------------------------------------------
|
||||
# Custom code for specific tests
|
||||
# --------------------------------------------------------------------------
|
||||
if {$header < 3} {
|
||||
set skipOverlaps 1
|
||||
for {set i 1} {$i <= $num} {incr i} {
|
||||
lappend notPiped $i
|
||||
}
|
||||
} elseif {$header > 2 && $footer == 18 && $te == 1} {
|
||||
set skipOverlaps 1
|
||||
if {$delay == 0} {
|
||||
# Transaction 1 is conventional.
|
||||
# Check that transactions 2,3,4 are cancelled.
|
||||
set notPiped {1}
|
||||
set notIncluded $notPiped
|
||||
} else {
|
||||
# Transaction 1 is conventional.
|
||||
# Check that transaction 2 is cancelled.
|
||||
# The timing of transactions 3 and 4 is uncertain.
|
||||
set notPiped {1 3 4}
|
||||
set notIncluded $notPiped
|
||||
}
|
||||
} elseif {$footer in {20 22 23 24 25}} {
|
||||
# Transaction 2 uses its own socket.
|
||||
set notPiped 2
|
||||
set notIncluded $notPiped
|
||||
} else {
|
||||
}
|
||||
# --------------------------------------------------------------------------
|
||||
# End of custom code for specific tests
|
||||
# --------------------------------------------------------------------------
|
||||
|
||||
|
||||
set Results [logAnalyse $num $skipOverlaps $notIncluded $notPiped]
|
||||
lassign $Results msg cleanE cleanF dirtyE dirtyF
|
||||
if {$msg eq {}} {
|
||||
set msg "Passed all sanity checks."
|
||||
} else {
|
||||
set msg "Problems with sanity checks:\n$msg"
|
||||
}
|
||||
|
||||
if 0 {
|
||||
puts $msg
|
||||
puts "Overlap-free including response body:\n$cleanF"
|
||||
puts "Have overlaps including response body:\n$dirtyF"
|
||||
puts "Overlap-free without response body:\n$cleanE"
|
||||
puts "Have overlaps without response body:\n$dirtyE"
|
||||
}
|
||||
|
||||
if {$header < 3} {
|
||||
# No ordering, just check that transactions all finish
|
||||
set result $msg
|
||||
} elseif {$header == 3} {
|
||||
# Not pipelined - check overlaps with response body.
|
||||
set result "$msg\nHave overlaps including response body:\n$dirtyF"
|
||||
} else {
|
||||
# Pipelined - check overlaps without response body. Check that the
|
||||
# first request, the first requests after replay, and POSTs are clean.
|
||||
set result "$msg\nOverlap-free without response body:\n$cleanE"
|
||||
}
|
||||
set ::nTokens $num
|
||||
return $result
|
||||
}
|
||||
|
||||
|
||||
# ------------------------------------------------------------------------------
|
||||
# (3) VERBOSITY CONTROL
|
||||
# ------------------------------------------------------------------------------
|
||||
# If tests fail, run an individual test with -verbose 1 or 2 for diagnosis.
|
||||
# If still obscure, uncomment #Log and ##Log lines in the http package.
|
||||
# ------------------------------------------------------------------------------
|
||||
|
||||
setHttpTestOptions -verbose 0
|
||||
|
||||
# ------------------------------------------------------------------------------
|
||||
# (4) Define the base URLs used for testing. Each must have a query string.
|
||||
# ------------------------------------------------------------------------------
|
||||
# - A HTTP/1.1 server is required. It should be configured to provide
|
||||
# persistent connections when requested to do so, and to close these
|
||||
# connections if they are idle for one second.
|
||||
# - The resource must be served with status 200 in response to a valid GET or
|
||||
# POST.
|
||||
# - The value of "page" is always specified in the query-string. Different
|
||||
# resources for the three values of "page" allow testing of both chunked and
|
||||
# unchunked transfer encoding.
|
||||
# - The variables "close" and "delay" may be specified in the query-string (for
|
||||
# a GET) or the request body (for a POST).
|
||||
# - "delay" is a numerical value in seconds, and causes the server to delay
|
||||
# the response, including headers.
|
||||
# - "close", if it has the value "y", instructs the server to close the
|
||||
# connection ater the current request.
|
||||
# - Any other variables should be ignored.
|
||||
# ------------------------------------------------------------------------------
|
||||
|
||||
namespace eval ::httpTestScript {
|
||||
variable URL
|
||||
array set URL {
|
||||
a http://test-tcl-http.kerlin.org/index.html?page=privacy
|
||||
b http://test-tcl-http.kerlin.org/index.html?page=conditions
|
||||
c http://test-tcl-http.kerlin.org/index.html?page=welcome
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# ------------------------------------------------------------------------------
|
||||
# (5) Define the tests
|
||||
# ------------------------------------------------------------------------------
|
||||
# Constraints:
|
||||
# - serverNeeded - the URLs defined at (4) must be available, and must have the
|
||||
# properties specified there.
|
||||
# - duplicate - the value of -pipeline does not matter if -keepalive 0
|
||||
# - timeout1s - tests that work correctly only if the server closes
|
||||
# persistent connections after one second.
|
||||
#
|
||||
# Server timeout of persistent connections should be 1s. Delays of 2s are
|
||||
# intended to cause timeout.
|
||||
# Servers are usually configured to use a longer timeout: this will cause the
|
||||
# tests to fail. The "2000" could be replaced with a larger number, but the
|
||||
# tests will then be inconveniently slow.
|
||||
# ------------------------------------------------------------------------------
|
||||
|
||||
#testConstraint serverNeeded 1
|
||||
#testConstraint timeout1s 1
|
||||
#testConstraint duplicate 1
|
||||
|
||||
# ------------------------------------------------------------------------------
|
||||
# Proc SetTestEof - to edit the command ::http::KeepSocket
|
||||
# ------------------------------------------------------------------------------
|
||||
# The usual line in command ::http::KeepSocket is " set TEST_EOF 0".
|
||||
# Whether the value set in the file is 0 or 1, change it here to the value
|
||||
# specified by the argument.
|
||||
#
|
||||
# It is worth doing all tests for both values of the argument.
|
||||
#
|
||||
# test 0 - ::http::KeepSocket is unchanged, detects server eof where possible
|
||||
# and closes the connection.
|
||||
# test 1 - ::http::KeepSocket is edited, does not detect server eof, so the
|
||||
# reaction to finding server eof can be tested without the difficulty
|
||||
# of testing in the few milliseconds of an asynchronous close event.
|
||||
# ------------------------------------------------------------------------------
|
||||
|
||||
proc SetTestEof {test} {
|
||||
set body [info body ::http::KeepSocket]
|
||||
set subs " set TEST_EOF $test"
|
||||
set count [regsub -line -all -- {^\s*set TEST_EOF .*$} $body $subs newBody]
|
||||
if {$count != 1} {
|
||||
return -code error {proc ::http::KeepSocket has unexpected form}
|
||||
}
|
||||
proc ::http::KeepSocket {token} $newBody
|
||||
return
|
||||
}
|
||||
|
||||
for {set header 1} {$header <= 4} {incr header} {
|
||||
if {$header == 4} {
|
||||
setHttpTestOptions -dotted 1
|
||||
set match glob
|
||||
} else {
|
||||
setHttpTestOptions -dotted 0
|
||||
set match exact
|
||||
}
|
||||
|
||||
if {$header == 2} {
|
||||
set cons0 {serverNeeded duplicate}
|
||||
} else {
|
||||
set cons0 serverNeeded
|
||||
}
|
||||
|
||||
for {set footer 1} {$footer <= 25} {incr footer} {
|
||||
foreach {delay label} {
|
||||
0 a
|
||||
1 b
|
||||
2 c
|
||||
3 d
|
||||
5 e
|
||||
8 f
|
||||
12 g
|
||||
100 h
|
||||
500 i
|
||||
2000 j
|
||||
} {
|
||||
foreach te {0 1} {
|
||||
if {$te} {
|
||||
set tag testEof
|
||||
} else {
|
||||
set tag normal
|
||||
}
|
||||
set suffix {}
|
||||
set cons $cons0
|
||||
|
||||
# ------------------------------------------------------------------
|
||||
# Custom code for individual tests
|
||||
# ------------------------------------------------------------------
|
||||
if {$footer in {18}} {
|
||||
# Custom code:
|
||||
if {($label eq "j") && ($te == 1)} {
|
||||
continue
|
||||
}
|
||||
if {$te == 1} {
|
||||
# The test (of REPOST 0) is useful if tag is "testEof"
|
||||
# (server timeout without client reaction). The same test
|
||||
# has a different result if tag is "normal".
|
||||
|
||||
set suffix " - extra test for -repost 0 - ::http::2 must be"
|
||||
append suffix " cancelled"
|
||||
if {($delay == 0)} {
|
||||
append suffix ", along with ::http::3 ::http::4 if"
|
||||
append suffix " the test creates these before ::http::2"
|
||||
append suffix " is cancelled"
|
||||
}
|
||||
} else {
|
||||
}
|
||||
} elseif {$footer in {19}} {
|
||||
set suffix " - extra test for -repost 0"
|
||||
} elseif {$footer in {20 21}} {
|
||||
set suffix " - extra test for -postfresh 1"
|
||||
if {($footer == 20)} {
|
||||
append suffix " - ::http::2 uses a separate socket"
|
||||
append suffix ", other requests use a persistent connection"
|
||||
}
|
||||
} elseif {$footer in {22 23 24 25}} {
|
||||
append suffix " - ::http::2 uses a separate socket"
|
||||
append suffix ", other requests use a persistent connection"
|
||||
} else {
|
||||
}
|
||||
|
||||
if {($footer >= 13 && $footer <= 23)} {
|
||||
# Test use WAIT and depend on server timeout before this time.
|
||||
lappend cons timeout1s
|
||||
}
|
||||
# ------------------------------------------------------------------
|
||||
# End of custom code.
|
||||
# ------------------------------------------------------------------
|
||||
|
||||
set name "pipeline test header $header footer $footer delay $delay $tag$suffix"
|
||||
|
||||
|
||||
# Here's the test:
|
||||
test httpPipeline-${header}.${footer}${label}-${tag} $name \
|
||||
-constraints $cons \
|
||||
-setup [string map [list TE $te] {
|
||||
# Restore default values for tests:
|
||||
http::config -pipeline 1 -postfresh 0 -repost 1
|
||||
http::init
|
||||
set http::http(uid) 0
|
||||
SetTestEof {TE}
|
||||
}] -body [list RunTest $header $footer $delay $te] -cleanup {
|
||||
# Restore default values for tests:
|
||||
http::config -pipeline 1 -postfresh 0 -repost 1
|
||||
cleanupHttpTestScript
|
||||
SetTestEof 0
|
||||
cleanupHttpTest
|
||||
after 2000
|
||||
# Wait for persistent sockets on the server to time out.
|
||||
} -result [ReturnTestResult $header $footer $delay $te] -match $match
|
||||
|
||||
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# ------------------------------------------------------------------------------
|
||||
# (*) Notes on tests *.18*-testEof, *.19*-testEof - these test -repost 0
|
||||
# ------------------------------------------------------------------------------
|
||||
# These tests are a bit awkward because the main test kit analyses whether all
|
||||
# requests are satisfied, with retries if necessary, and it has result analysis
|
||||
# for processing retry logs.
|
||||
# - *.18*-testEof tests that certain requests are NOT satisfied, so the analysis
|
||||
# is a one-off.
|
||||
# - Tests *.18a-testEof depend on client/server timing - the test needs to call
|
||||
# http::geturl for all requests before the POST (request 2) is cancelled.
|
||||
# We test that requests 2, 3, 4 are all cancelled.
|
||||
# - Other tests *.18*-testEof may not request 3 and 4 in time for the to be
|
||||
# added to the write queue before request 2 is completed. We simply check that
|
||||
# request 2 is cancelled.
|
||||
# - The behaviour is different if all connections are allowed to time out
|
||||
# (label "j"). This case is not needed to test -repost 0, and is omitted.
|
||||
# - Tests *.18*-normal and *.19* are conventional (-repost 0 should have no
|
||||
# effect).
|
||||
# ------------------------------------------------------------------------------
|
||||
|
||||
|
||||
unset header footer delay label suffix match cons name te
|
||||
namespace delete ::httpTest
|
||||
namespace delete ::httpTestScript
|
||||
|
||||
::tcltest::cleanupTests
|
||||
@@ -0,0 +1,505 @@
|
||||
# httpTest.tcl
|
||||
#
|
||||
# Test HTTP/1.1 concurrent requests including
|
||||
# queueing, pipelining and retries.
|
||||
#
|
||||
# Copyright (C) 2018 Keith Nash <kjnash@users.sourceforge.net>
|
||||
#
|
||||
# See the file "license.terms" for information on usage and redistribution
|
||||
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
|
||||
# ------------------------------------------------------------------------------
|
||||
# "Package" httpTest for analysis of Log output of http requests.
|
||||
# ------------------------------------------------------------------------------
|
||||
# This is a specialised test kit for examining the presence, ordering, and
|
||||
# overlap of multiple HTTP transactions over a persistent ("Keep-Alive")
|
||||
# connection; and also for testing reconnection in accordance with RFC 7230 when
|
||||
# the connection is lost.
|
||||
#
|
||||
# This kit is probably not useful for other purposes. It depends on the
|
||||
# presence of specific Log commands in the http library, and it interprets the
|
||||
# logs that these commands create.
|
||||
# ------------------------------------------------------------------------------
|
||||
|
||||
package require http
|
||||
|
||||
namespace eval ::http {
|
||||
variable TestStartTimeInMs [clock milliseconds]
|
||||
# catch {puts stdout "Start time (zero ms) is $TestStartTimeInMs"}
|
||||
}
|
||||
|
||||
namespace eval ::httpTest {
|
||||
variable testResults {}
|
||||
variable testOptions
|
||||
array set testOptions {
|
||||
-verbose 0
|
||||
-dotted 1
|
||||
}
|
||||
# -verbose - 0 quiet 1 write to stdout 2 write more
|
||||
# -dotted - (boolean) use dots for absences in lists of transactions
|
||||
}
|
||||
|
||||
proc httpTest::Puts {txt} {
|
||||
variable testOptions
|
||||
if {$testOptions(-verbose) > 0} {
|
||||
puts stdout $txt
|
||||
flush stdout
|
||||
}
|
||||
return
|
||||
}
|
||||
|
||||
# http::Log
|
||||
#
|
||||
# A special-purpose logger used for running tests.
|
||||
# - Processes Log calls that have "^" in their arguments, and records them in
|
||||
# variable ::httpTest::testResults.
|
||||
# - Also writes them to stdout (using Puts) if ($testOptions(-verbose) > 0).
|
||||
# - Also writes Log calls that do not have "^", if ($testOptions(-verbose) > 1).
|
||||
|
||||
proc http::Log {args} {
|
||||
variable TestStartTimeInMs
|
||||
set time [expr {[clock milliseconds] - $TestStartTimeInMs}]
|
||||
set txt [list $time {*}$args]
|
||||
if {[string first ^ $txt] != -1} {
|
||||
::httpTest::LogRecord $txt
|
||||
::httpTest::Puts $txt
|
||||
} elseif {$::httpTest::testOptions(-verbose) > 1} {
|
||||
::httpTest::Puts $txt
|
||||
}
|
||||
return
|
||||
}
|
||||
|
||||
|
||||
# Called by http::Log (the "testing" version) to record logs for later analysis.
|
||||
|
||||
proc httpTest::LogRecord {txt} {
|
||||
variable testResults
|
||||
|
||||
set pos [string first ^ $txt]
|
||||
set len [string length $txt]
|
||||
if {$pos > $len - 3} {
|
||||
puts stdout "Logging Error: $txt"
|
||||
puts stdout "Fix this call to Log in http-*.tm so it has ^ then\
|
||||
a letter then a numeral."
|
||||
flush stdout
|
||||
} elseif {$pos == -1} {
|
||||
# Called by mistake.
|
||||
} else {
|
||||
set letter [string index $txt [incr pos]]
|
||||
set number [string index $txt [incr pos]]
|
||||
# Max 9 requests!
|
||||
lappend testResults [list $letter $number]
|
||||
}
|
||||
|
||||
return
|
||||
}
|
||||
|
||||
|
||||
# ------------------------------------------------------------------------------
|
||||
# Commands for analysing the logs recorded when calling http::geturl.
|
||||
# ------------------------------------------------------------------------------
|
||||
|
||||
# httpTest::TestOverlaps --
|
||||
#
|
||||
# The main test for correct behaviour of pipelined and sequential
|
||||
# (non-pipelined) transactions. Other tests should be run first to detect
|
||||
# any inconsistencies in the data (e.g. absence of the elements that are
|
||||
# examined here).
|
||||
#
|
||||
# Examine the sequence $someResults for each transaction from 1 to $n,
|
||||
# ignoring any that are listed in $badTrans.
|
||||
# Determine whether the elements "B" to $term for one transaction overlap
|
||||
# elements "B" to $term for the previous and following transactions.
|
||||
#
|
||||
# Transactions in the list $badTrans are not included in "clean" or
|
||||
# "dirty", but their possible overlap with other transactions is noted.
|
||||
# Transactions in the list $notPiped are a subset of $badTrans, and
|
||||
# their possible overlap with other transactions is NOT noted.
|
||||
#
|
||||
# Arguments:
|
||||
# someResults - list of results, each of the form {letter numeral}
|
||||
# n - number of HTTP transactions
|
||||
# term - letter that indicated end of search range. "E" for testing
|
||||
# overlaps from start of request to end of response headers.
|
||||
# "F" to extend to the end of the response body.
|
||||
# msg - the cumulative message from sanity checks. Append to it only
|
||||
# to report a test failure.
|
||||
# badTrans - list of transaction numbers not to be assessed as "clean" or
|
||||
# "dirty"
|
||||
# notPiped - subset of badTrans. List of transaction numbers that cannot
|
||||
# taint another transaction by overlapping with it, because it
|
||||
# used a different socket.
|
||||
#
|
||||
# Return value: [list $msg $clean $dirty]
|
||||
# msg - warning messages: nothing will be appended to argument $msg if there
|
||||
# is an error with the test.
|
||||
# clean - list of transactions that have no overlap with other transactions
|
||||
# dirty - list of transactions that have YES overlap with other transactions
|
||||
|
||||
proc httpTest::TestOverlaps {someResults n term msg badTrans notPiped} {
|
||||
variable testOptions
|
||||
|
||||
# Check whether transactions overlap:
|
||||
set clean {}
|
||||
set dirty {}
|
||||
for {set i 1} {$i <= $n} {incr i} {
|
||||
if {$i in $badTrans} {
|
||||
continue
|
||||
}
|
||||
set myStart [lsearch -exact $someResults [list B $i]]
|
||||
set myEnd [lsearch -exact $someResults [list $term $i]]
|
||||
|
||||
if {($myStart == -1 || $myEnd == -1)} {
|
||||
set res "Cannot find positions of transaction $i"
|
||||
append msg $res \n
|
||||
Puts $res
|
||||
}
|
||||
|
||||
set overlaps {}
|
||||
for {set j $myStart} {$j <= $myEnd} {incr j} {
|
||||
lassign [lindex $someResults $j] letter number
|
||||
if {$number != $i && $letter ne "A" && $number ni $notPiped} {
|
||||
lappend overlaps $number
|
||||
}
|
||||
}
|
||||
|
||||
if {[llength $overlaps] == 0} {
|
||||
set res "Transaction $i has no overlaps"
|
||||
Puts $res
|
||||
lappend clean $i
|
||||
if {$testOptions(-dotted)} {
|
||||
# N.B. results from different segments are concatenated.
|
||||
lappend dirty .
|
||||
} else {
|
||||
}
|
||||
} else {
|
||||
set res "Transaction $i overlaps with [join $overlaps { }]"
|
||||
Puts $res
|
||||
lappend dirty $i
|
||||
if {$testOptions(-dotted)} {
|
||||
# N.B. results from different segments are concatenated.
|
||||
lappend clean .
|
||||
} else {
|
||||
}
|
||||
}
|
||||
}
|
||||
return [list $msg $clean $dirty]
|
||||
}
|
||||
|
||||
# httpTest::PipelineNext --
|
||||
#
|
||||
# Test whether prevPair, pair are valid as consecutive elements of a pipelined
|
||||
# sequence (Start 1), (End 1), (Start 2), (End 2) ...
|
||||
# Numbers are integers increasing (by 1 if argument "any" is false), and need
|
||||
# not begin with 1.
|
||||
# The first element of the sequence has prevPair {} and is always passed as
|
||||
# valid.
|
||||
#
|
||||
# Arguments;
|
||||
# Start - string that labels the start of a segment
|
||||
# End - string that labels the end of a segment
|
||||
# prevPair - previous "pair" (list of string and number) element of a
|
||||
# sequence, or {} if argument "pair" is the first in the
|
||||
# sequence.
|
||||
# pair - current "pair" (list of string and number) element of a
|
||||
# sequence
|
||||
# any - (boolean) iff true, accept any increasing sequence of integers.
|
||||
# If false, integers must increase by 1.
|
||||
#
|
||||
# Return value - boolean, true iff the two pairs are valid consecutive elements.
|
||||
|
||||
proc httpTest::PipelineNext {Start End prevPair pair any} {
|
||||
if {$prevPair eq {}} {
|
||||
return 1
|
||||
}
|
||||
|
||||
lassign $prevPair letter number
|
||||
lassign $pair newLetter newNumber
|
||||
if {$letter eq $Start} {
|
||||
return [expr {($newLetter eq $End) && ($newNumber == $number)}]
|
||||
} elseif {$any} {
|
||||
set nxt [list $Start [expr {$number + 1}]]
|
||||
return [expr {($newLetter eq $Start) && ($newNumber > $number)}]
|
||||
} else {
|
||||
set nxt [list $Start [expr {$number + 1}]]
|
||||
return [expr {($newLetter eq $Start) && ($newNumber == $number + 1)}]
|
||||
}
|
||||
}
|
||||
|
||||
# httpTest::TestPipeline --
|
||||
#
|
||||
# Given a sequence of "pair" elements, check that the elements whose string is
|
||||
# $Start or $End form a valid pipeline. Ignore other elements.
|
||||
#
|
||||
# Return value: {} if valid pipeline, otherwise a non-empty error message.
|
||||
|
||||
proc httpTest::TestPipeline {someResults n Start End msg desc badTrans} {
|
||||
set sequence {}
|
||||
set prevPair {}
|
||||
set ok 1
|
||||
set any [llength $badTrans]
|
||||
foreach pair $someResults {
|
||||
lassign $pair letter number
|
||||
if {($letter in [list $Start $End]) && ($number ni $badTrans)} {
|
||||
lappend sequence $pair
|
||||
if {![PipelineNext $Start $End $prevPair $pair $any]} {
|
||||
set ok 0
|
||||
break
|
||||
}
|
||||
set prevPair $pair
|
||||
}
|
||||
}
|
||||
|
||||
if {!$ok} {
|
||||
set res "$desc are not pipelined: {$sequence}"
|
||||
append msg $res \n
|
||||
Puts $res
|
||||
}
|
||||
return $msg
|
||||
}
|
||||
|
||||
# httpTest::TestSequence --
|
||||
#
|
||||
# Examine each transaction from 1 to $n, ignoring any that are listed
|
||||
# in $badTrans.
|
||||
# Check that each transaction has elements A to F, in alphabetical order.
|
||||
|
||||
proc httpTest::TestSequence {someResults n msg badTrans} {
|
||||
variable testOptions
|
||||
|
||||
for {set i 1} {$i <= $n} {incr i} {
|
||||
if {$i in $badTrans} {
|
||||
continue
|
||||
}
|
||||
set sequence {}
|
||||
foreach pair $someResults {
|
||||
lassign $pair letter number
|
||||
if {$number == $i} {
|
||||
lappend sequence $letter
|
||||
}
|
||||
}
|
||||
if {$sequence eq {A B C D E F}} {
|
||||
} else {
|
||||
set res "Wrong sequence for token ::http::$i - {$sequence}"
|
||||
append msg $res \n
|
||||
Puts $res
|
||||
if {"X" in $sequence} {
|
||||
set res "- and error(s) X"
|
||||
append msg $res \n
|
||||
Puts $res
|
||||
}
|
||||
if {"Y" in $sequence} {
|
||||
set res "- and warnings(s) Y"
|
||||
append msg $res \n
|
||||
Puts $res
|
||||
}
|
||||
}
|
||||
}
|
||||
return $msg
|
||||
}
|
||||
|
||||
#
|
||||
# Arguments:
|
||||
# someResults - list of elements, each a list of a letter and a number
|
||||
# n - (positive integer) the number of HTTP requests
|
||||
# msg - accumulated warning messages
|
||||
# skipOverlaps - (boolean) whether to skip testing of transaction overlaps
|
||||
# badTrans - list of transaction numbers not to be assessed as "clean" or
|
||||
# "dirty" by their overlaps
|
||||
# for 1/2 includes all transactions
|
||||
# for 3/4 includes an increasing (with recursion) set that will not be included in the list because they are already handled.
|
||||
# notPiped - subset of badTrans. List of transaction numbers that cannot
|
||||
# taint another transaction by overlapping with it, because it
|
||||
# used a different socket.
|
||||
#
|
||||
# Return value: [list $msg $cleanE $cleanF $dirtyE $dirtyF]
|
||||
# msg - warning messages: nothing will be appended to argument $msg if there
|
||||
# is no error with the test.
|
||||
# cleanE - list of transactions that have no overlap with other transactions
|
||||
# (not considering response body)
|
||||
# dirtyE - list of transactions that have YES overlap with other transactions
|
||||
# (not considering response body)
|
||||
# cleanF - list of transactions that have no overlap with other transactions
|
||||
# (including response body)
|
||||
# dirtyF - list of transactions that have YES overlap with other transactions
|
||||
# (including response body)
|
||||
|
||||
proc httpTest::MostAnalysis {someResults n msg skipOverlaps badTrans notPiped} {
|
||||
variable testOptions
|
||||
|
||||
# Check that stages for "good" transactions are all present and correct:
|
||||
set msg [TestSequence $someResults $n $msg $badTrans]
|
||||
|
||||
# Check that requests are pipelined:
|
||||
set msg [TestPipeline $someResults $n B C $msg Requests $notPiped]
|
||||
|
||||
# Check that responses are pipelined:
|
||||
set msg [TestPipeline $someResults $n D F $msg Responses $notPiped]
|
||||
|
||||
if {$skipOverlaps} {
|
||||
set cleanE {}
|
||||
set dirtyE {}
|
||||
set cleanF {}
|
||||
set dirtyF {}
|
||||
} else {
|
||||
Puts "Overlaps including response body (test for non-pipelined case)"
|
||||
lassign [TestOverlaps $someResults $n F $msg $badTrans $notPiped] msg cleanF dirtyF
|
||||
|
||||
Puts "Overlaps without response body (test for pipelined case)"
|
||||
lassign [TestOverlaps $someResults $n E $msg $badTrans $notPiped] msg cleanE dirtyE
|
||||
}
|
||||
|
||||
return [list $msg $cleanE $cleanF $dirtyE $dirtyF]
|
||||
}
|
||||
|
||||
# httpTest::ProcessRetries --
|
||||
#
|
||||
# Command to examine results for socket-changing records [PQR],
|
||||
# divide the results into segments for each connection, and analyse each segment
|
||||
# individually.
|
||||
# (Could add $sock to the logging to simplify this, but never mind.)
|
||||
#
|
||||
# In each segment, identify any transactions that are not included, and
|
||||
# any that are aborted, to assist subsequent testing.
|
||||
#
|
||||
# Prepend A records (socket-independent) to each segment for transactions that
|
||||
# were scheduled (by A) but not completed (by F). Pass each segment to
|
||||
# MostAnalysis for processing.
|
||||
|
||||
proc httpTest::ProcessRetries {someResults n msg skipOverlaps notIncluded notPiped} {
|
||||
variable testOptions
|
||||
|
||||
set nextRetry [lsearch -glob -index 0 $someResults {[PQR]}]
|
||||
if {$nextRetry == -1} {
|
||||
return [MostAnalysis $someResults $n $msg $skipOverlaps $notIncluded $notPiped]
|
||||
}
|
||||
set badTrans $notIncluded
|
||||
set tryCount 0
|
||||
set try $nextRetry
|
||||
incr tryCount
|
||||
lassign [lindex $someResults $try] letter number
|
||||
Puts "Processing retry [lindex $someResults $try]"
|
||||
set beforeTry [lrange $someResults 0 $try-1]
|
||||
Puts [join $beforeTry \n]
|
||||
set afterTry [lrange $someResults $try+1 end]
|
||||
|
||||
set dummyTry {}
|
||||
for {set i 1} {$i <= $n} {incr i} {
|
||||
set first [lsearch -exact $beforeTry [list A $i]]
|
||||
set last [lsearch -exact $beforeTry [list F $i]]
|
||||
if {$first == -1} {
|
||||
set res "Transaction $i was not started in connection number $tryCount"
|
||||
# So lappend it to badTrans and don't include it in the call below of MostAnalysis.
|
||||
# append msg $res \n
|
||||
Puts $res
|
||||
if {$i ni $badTrans} {
|
||||
lappend badTrans $i
|
||||
} else {
|
||||
}
|
||||
} elseif {$last == -1} {
|
||||
set res "Transaction $i was started but unfinished in connection number $tryCount"
|
||||
# So lappend it to badTrans and don't include it in the call below of MostAnalysis.
|
||||
# append msg $res \n
|
||||
Puts $res
|
||||
lappend badTrans $i
|
||||
lappend dummyTry [list A $i]
|
||||
} else {
|
||||
set res "Transaction $i was started and finished in connection number $tryCount"
|
||||
# So include it in the call below of MostAnalysis.
|
||||
# So lappend it to notIncluded and don't include it in the recursive call of
|
||||
# ProcessRetries which handles the later connections.
|
||||
# append msg $res \n
|
||||
Puts $res
|
||||
lappend notIncluded $i
|
||||
}
|
||||
}
|
||||
|
||||
# Analyse the part of the results before the first replay:
|
||||
set HeadResults [MostAnalysis $beforeTry $n $msg $skipOverlaps $badTrans $notPiped]
|
||||
lassign $HeadResults msg cleanE1 cleanF1 dirtyE1 dirtyF1
|
||||
|
||||
# Pass the rest of the results to be processed recursively.
|
||||
set afterTry [concat $dummyTry $afterTry]
|
||||
set TailResults [ProcessRetries $afterTry $n $msg $skipOverlaps $notIncluded $notPiped]
|
||||
lassign $TailResults msg cleanE2 cleanF2 dirtyE2 dirtyF2
|
||||
|
||||
set cleanE [concat $cleanE1 $cleanE2]
|
||||
set cleanF [concat $cleanF1 $cleanF2]
|
||||
set dirtyE [concat $dirtyE1 $dirtyE2]
|
||||
set dirtyF [concat $dirtyF1 $dirtyF2]
|
||||
return [list $msg $cleanE $cleanF $dirtyE $dirtyF]
|
||||
}
|
||||
|
||||
# httpTest::logAnalyse --
|
||||
#
|
||||
# The main command called to analyse logs for a single test.
|
||||
#
|
||||
# Arguments:
|
||||
# n - (positive integer) the number of HTTP requests
|
||||
# skipOverlaps - (boolean) whether to skip testing of transaction overlaps
|
||||
# notIncluded - list of transaction numbers not to be assessed as "clean" or
|
||||
# "dirty" by their overlaps
|
||||
# notPiped - subset of notIncluded. List of transaction numbers that cannot
|
||||
# taint another transaction by overlapping with it, because it
|
||||
# used a different socket.
|
||||
#
|
||||
# Return value: [list $msg $cleanE $cleanF $dirtyE $dirtyF]
|
||||
# msg - warning messages: {} if there is no error with the test.
|
||||
# cleanE - list of transactions that have no overlap with other transactions
|
||||
# (not considering response body)
|
||||
# dirtyE - list of transactions that have YES overlap with other transactions
|
||||
# (not considering response body)
|
||||
# cleanF - list of transactions that have no overlap with other transactions
|
||||
# (including response body)
|
||||
# dirtyF - list of transactions that have YES overlap with other transactions
|
||||
# (including response body)
|
||||
|
||||
proc httpTest::logAnalyse {n skipOverlaps notIncluded notPiped} {
|
||||
variable testResults
|
||||
variable testOptions
|
||||
|
||||
# Check that each data item has the correct form {letter numeral}.
|
||||
set ii 0
|
||||
set ok 1
|
||||
foreach pair $testResults {
|
||||
lassign $pair letter number
|
||||
if { [string match {[A-Z]} $letter]
|
||||
&& [string match {[0-9]} $number]
|
||||
} {
|
||||
# OK
|
||||
} else {
|
||||
set ok 0
|
||||
set res "Error: testResults has bad element {$pair} at position $ii"
|
||||
append msg $res \n
|
||||
Puts $res
|
||||
}
|
||||
incr ii
|
||||
}
|
||||
|
||||
if {!$ok} {
|
||||
return $msg
|
||||
}
|
||||
set msg {}
|
||||
|
||||
Puts [join $testResults \n]
|
||||
ProcessRetries $testResults $n $msg $skipOverlaps $notIncluded $notPiped
|
||||
# N.B. Implicit Return.
|
||||
}
|
||||
|
||||
proc httpTest::cleanupHttpTest {} {
|
||||
variable testResults
|
||||
set testResults {}
|
||||
return
|
||||
}
|
||||
|
||||
proc httpTest::setHttpTestOptions {key args} {
|
||||
variable testOptions
|
||||
if {$key ni {-dotted -verbose}} {
|
||||
return -code error {valid options are -dotted, -verbose}
|
||||
}
|
||||
set testOptions($key) {*}$args
|
||||
}
|
||||
|
||||
namespace eval httpTest {
|
||||
namespace export cleanupHttpTest logAnalyse setHttpTestOptions
|
||||
}
|
||||
@@ -0,0 +1,509 @@
|
||||
# httpTestScript.tcl
|
||||
#
|
||||
# Test HTTP/1.1 concurrent requests including
|
||||
# queueing, pipelining and retries.
|
||||
#
|
||||
# Copyright (C) 2018 Keith Nash <kjnash@users.sourceforge.net>
|
||||
#
|
||||
# See the file "license.terms" for information on usage and redistribution
|
||||
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
|
||||
# ------------------------------------------------------------------------------
|
||||
# "Package" httpTestScript for executing test scripts written in a convenient
|
||||
# shorthand.
|
||||
# ------------------------------------------------------------------------------
|
||||
|
||||
# ------------------------------------------------------------------------------
|
||||
# Documentation for "package" httpTestScript.
|
||||
# ------------------------------------------------------------------------------
|
||||
# To use the package:
|
||||
# (a) define URLs as the values of elements in the array ::httpTestScript
|
||||
# (b) define a script in terms of the commands
|
||||
# START STOP DELAY KEEPALIVE WAIT PIPELINE GET HEAD POST
|
||||
# referring to URLs by the name of the corresponding array element. The
|
||||
# script can include any other Tcl commands, and evaluates in the
|
||||
# httpTestScript namespace.
|
||||
# (c) Use the command httpTestScript::runHttpTestScript to evaluate the script.
|
||||
# (d) For tcltest tests, wrap the runHttpTestScript call in a suitable "test"
|
||||
# command.
|
||||
# ------------------------------------------------------------------------------
|
||||
# START
|
||||
# Must be the first command of the script.
|
||||
#
|
||||
# STOP
|
||||
# Must be present in the script to avoid waiting for client timeout.
|
||||
# Usually the last command, but can be elsewhere to end a script prematurely.
|
||||
# Subsequent httpTestScript commands will have no effect.
|
||||
#
|
||||
# DELAY ms
|
||||
# If there are no WAIT commands, this sets the delay in ms between subsequent
|
||||
# calls to http::geturl. Default 500ms.
|
||||
#
|
||||
# KEEPALIVE
|
||||
# Set the value passed to http::geturl for the -keepalive option. The command
|
||||
# applies to subsequent requests in the script. Default 1.
|
||||
#
|
||||
# WAIT ms
|
||||
# Pause for a time in ms before sending subsequent requests.
|
||||
#
|
||||
# PIPELINE boolean
|
||||
# Set the value of -pipeline using http::config. The last PIPELINE command
|
||||
# in the script applies to every request. Default 1.
|
||||
#
|
||||
# POSTFRESH boolean
|
||||
# Set the value of -postfresh using http::config. The last POSTFRESH command
|
||||
# in the script applies to every request. Default 0.
|
||||
#
|
||||
# REPOST boolean
|
||||
# Set the value of -repost using http::config. The last REPOST command
|
||||
# in the script applies to every request. Default 1 for httpTestScript.
|
||||
# (Default value in http is 0).
|
||||
#
|
||||
# GET uriCode ?arg ...?
|
||||
# Send a HTTP request using the GET method.
|
||||
# Arguments:
|
||||
# uriCode - the code for the base URI - the value must be stored in
|
||||
# ::httpTestScript::URL($uriCode).
|
||||
# args - strings that will be joined by "&" and appended to the query
|
||||
# string with a preceding "&".
|
||||
#
|
||||
# HEAD uriCode ?arg ...?
|
||||
# Send a HTTP request using the HEAD method.
|
||||
# Arguments: as for GET
|
||||
#
|
||||
# POST uriCode ?arg ...?
|
||||
# Send a HTTP request using the POST method.
|
||||
# Arguments:
|
||||
# uriCode - the code for the base URI - the value must be stored in
|
||||
# ::httpTestScript::URL($uriCode).
|
||||
# args - strings that will be joined by "&" and used as the request body.
|
||||
# ------------------------------------------------------------------------------
|
||||
|
||||
namespace eval ::httpTestScript {
|
||||
namespace export runHttpTestScript cleanupHttpTestScript
|
||||
}
|
||||
|
||||
# httpTestScript::START --
|
||||
# Initialise, and create a long-stop timeout.
|
||||
|
||||
proc httpTestScript::START {} {
|
||||
variable CountRequestedSoFar
|
||||
variable RequestsWhenStopped
|
||||
variable KeepAlive
|
||||
variable Delay
|
||||
variable TimeOutCode
|
||||
variable TimeOutDone
|
||||
variable StartDone
|
||||
variable StopDone
|
||||
variable CountFinishedSoFar
|
||||
variable RequestList
|
||||
variable RequestsMade
|
||||
variable ExtraTime
|
||||
variable ActualKeepAlive
|
||||
|
||||
if {[info exists StartDone] && ($StartDone == 1)} {
|
||||
set msg {START has been called twice without an intervening STOP}
|
||||
return -code error $msg
|
||||
}
|
||||
|
||||
set StartDone 1
|
||||
set StopDone 0
|
||||
set TimeOutDone 0
|
||||
set CountFinishedSoFar 0
|
||||
set CountRequestedSoFar 0
|
||||
set RequestList {}
|
||||
set RequestsMade {}
|
||||
set ExtraTime 0
|
||||
set ActualKeepAlive 1
|
||||
|
||||
# Undefined until a STOP command:
|
||||
unset -nocomplain RequestsWhenStopped
|
||||
|
||||
# Default values:
|
||||
set KeepAlive 1
|
||||
set Delay 500
|
||||
|
||||
# Default values for tests:
|
||||
KEEPALIVE 1
|
||||
PIPELINE 1
|
||||
POSTFRESH 0
|
||||
REPOST 1
|
||||
|
||||
set TimeOutCode [after 30000 httpTestScript::TimeOutNow]
|
||||
# set TimeOutCode [after 4000 httpTestScript::TimeOutNow]
|
||||
return
|
||||
}
|
||||
|
||||
# httpTestScript::STOP --
|
||||
# Do not process any more commands. The commands will be executed but will
|
||||
# silently do nothing.
|
||||
|
||||
proc httpTestScript::STOP {} {
|
||||
variable CountRequestedSoFar
|
||||
variable CountFinishedSoFar
|
||||
variable RequestsWhenStopped
|
||||
variable TimeOutCode
|
||||
variable StartDone
|
||||
variable StopDone
|
||||
variable RequestsMade
|
||||
|
||||
if {$StopDone} {
|
||||
# Don't do anything on a second call.
|
||||
return
|
||||
}
|
||||
|
||||
if {![info exists StartDone]} {
|
||||
return -code error {initialise the script by calling command START}
|
||||
}
|
||||
|
||||
set StopDone 1
|
||||
set StartDone 0
|
||||
set RequestsWhenStopped $CountRequestedSoFar
|
||||
unset -nocomplain StartDone
|
||||
|
||||
if {$CountFinishedSoFar == $RequestsWhenStopped} {
|
||||
if {[info exists TimeOutCode]} {
|
||||
after cancel $TimeOutCode
|
||||
}
|
||||
set ::httpTestScript::FOREVER 0
|
||||
}
|
||||
return
|
||||
}
|
||||
|
||||
# httpTestScript::DELAY --
|
||||
# If there are no WAIT commands, this sets the delay in ms between subsequent
|
||||
# calls to http::geturl. Default 500ms.
|
||||
|
||||
proc httpTestScript::DELAY {t} {
|
||||
variable StartDone
|
||||
variable StopDone
|
||||
|
||||
if {$StopDone} {
|
||||
return
|
||||
}
|
||||
|
||||
if {![info exists StartDone]} {
|
||||
return -code error {initialise the script by calling command START}
|
||||
}
|
||||
|
||||
variable Delay
|
||||
|
||||
set Delay $t
|
||||
return
|
||||
}
|
||||
|
||||
# httpTestScript::KEEPALIVE --
|
||||
# Set the value passed to http::geturl for the -keepalive option. Default 1.
|
||||
|
||||
proc httpTestScript::KEEPALIVE {b} {
|
||||
variable StartDone
|
||||
variable StopDone
|
||||
|
||||
if {$StopDone} {
|
||||
return
|
||||
}
|
||||
|
||||
if {![info exists StartDone]} {
|
||||
return -code error {initialise the script by calling command START}
|
||||
}
|
||||
|
||||
variable KeepAlive
|
||||
set KeepAlive $b
|
||||
return
|
||||
}
|
||||
|
||||
# httpTestScript::WAIT --
|
||||
# Pause for a time in ms before processing any more commands.
|
||||
|
||||
proc httpTestScript::WAIT {t} {
|
||||
variable StartDone
|
||||
variable StopDone
|
||||
variable ExtraTime
|
||||
|
||||
if {$StopDone} {
|
||||
return
|
||||
}
|
||||
|
||||
if {![info exists StartDone]} {
|
||||
return -code error {initialise the script by calling command START}
|
||||
}
|
||||
|
||||
if {(![string is integer -strict $t]) || $t < 0} {
|
||||
return -code error {argument to WAIT must be a non-negative integer}
|
||||
}
|
||||
|
||||
incr ExtraTime $t
|
||||
|
||||
return
|
||||
}
|
||||
|
||||
# httpTestScript::PIPELINE --
|
||||
# Pass a value to http::config -pipeline.
|
||||
|
||||
proc httpTestScript::PIPELINE {b} {
|
||||
variable StartDone
|
||||
variable StopDone
|
||||
|
||||
if {$StopDone} {
|
||||
return
|
||||
}
|
||||
|
||||
if {![info exists StartDone]} {
|
||||
return -code error {initialise the script by calling command START}
|
||||
}
|
||||
|
||||
::http::config -pipeline $b
|
||||
##::http::Log http(-pipeline) is now [::http::config -pipeline]
|
||||
return
|
||||
}
|
||||
|
||||
# httpTestScript::POSTFRESH --
|
||||
# Pass a value to http::config -postfresh.
|
||||
|
||||
proc httpTestScript::POSTFRESH {b} {
|
||||
variable StartDone
|
||||
variable StopDone
|
||||
|
||||
if {$StopDone} {
|
||||
return
|
||||
}
|
||||
|
||||
if {![info exists StartDone]} {
|
||||
return -code error {initialise the script by calling command START}
|
||||
}
|
||||
|
||||
::http::config -postfresh $b
|
||||
##::http::Log http(-postfresh) is now [::http::config -postfresh]
|
||||
return
|
||||
}
|
||||
|
||||
# httpTestScript::REPOST --
|
||||
# Pass a value to http::config -repost.
|
||||
|
||||
proc httpTestScript::REPOST {b} {
|
||||
variable StartDone
|
||||
variable StopDone
|
||||
|
||||
if {$StopDone} {
|
||||
return
|
||||
}
|
||||
|
||||
if {![info exists StartDone]} {
|
||||
return -code error {initialise the script by calling command START}
|
||||
}
|
||||
|
||||
::http::config -repost $b
|
||||
##::http::Log http(-repost) is now [::http::config -repost]
|
||||
return
|
||||
}
|
||||
|
||||
# httpTestScript::GET --
|
||||
# Send a HTTP request using the GET method.
|
||||
# Arguments:
|
||||
# uriCode - the code for the base URI - the value must be stored in
|
||||
# ::httpTestScript::URL($uriCode).
|
||||
# args - strings that will each be preceded by "&" and appended to the query
|
||||
# string.
|
||||
|
||||
proc httpTestScript::GET {uriCode args} {
|
||||
variable RequestList
|
||||
lappend RequestList GET
|
||||
RequestAfter $uriCode 0 {} {*}$args
|
||||
return
|
||||
}
|
||||
|
||||
# httpTestScript::HEAD --
|
||||
# Send a HTTP request using the HEAD method.
|
||||
# Arguments: as for GET
|
||||
|
||||
proc httpTestScript::HEAD {uriCode args} {
|
||||
variable RequestList
|
||||
lappend RequestList HEAD
|
||||
RequestAfter $uriCode 1 {} {*}$args
|
||||
return
|
||||
}
|
||||
|
||||
# httpTestScript::POST --
|
||||
# Send a HTTP request using the POST method.
|
||||
# Arguments:
|
||||
# uriCode - the code for the base URI - the value must be stored in
|
||||
# ::httpTestScript::URL($uriCode).
|
||||
# args - strings that will be joined by "&" and used as the request body.
|
||||
|
||||
proc httpTestScript::POST {uriCode args} {
|
||||
variable RequestList
|
||||
lappend RequestList POST
|
||||
RequestAfter $uriCode 0 {use} {*}$args
|
||||
return
|
||||
}
|
||||
|
||||
|
||||
proc httpTestScript::RequestAfter {uriCode validate query args} {
|
||||
variable CountRequestedSoFar
|
||||
variable Delay
|
||||
variable ExtraTime
|
||||
variable StartDone
|
||||
variable StopDone
|
||||
variable KeepAlive
|
||||
|
||||
if {$StopDone} {
|
||||
return
|
||||
}
|
||||
|
||||
if {![info exists StartDone]} {
|
||||
return -code error {initialise the script by calling command START}
|
||||
}
|
||||
|
||||
incr CountRequestedSoFar
|
||||
set idelay [expr {($CountRequestedSoFar - 1) * $Delay + 10 + $ExtraTime}]
|
||||
|
||||
# Could pass values of -pipeline, -postfresh, -repost if it were
|
||||
# useful to change these mid-script.
|
||||
after $idelay [list httpTestScript::Requester $uriCode $KeepAlive $validate $query {*}$args]
|
||||
return
|
||||
}
|
||||
|
||||
proc httpTestScript::Requester {uriCode keepAlive validate query args} {
|
||||
variable URL
|
||||
|
||||
::http::config -accept {*/*}
|
||||
|
||||
set absUrl $URL($uriCode)
|
||||
if {$query eq {}} {
|
||||
if {$args ne {}} {
|
||||
append absUrl & [join $args &]
|
||||
}
|
||||
set queryArgs {}
|
||||
} elseif {$validate} {
|
||||
return -code error {cannot have both -validate (HEAD) and -query (POST)}
|
||||
} else {
|
||||
set queryArgs [list -query [join $args &]]
|
||||
}
|
||||
|
||||
if {[catch {
|
||||
::http::geturl $absUrl \
|
||||
-validate $validate \
|
||||
-timeout 10000 \
|
||||
{*}$queryArgs \
|
||||
-keepalive $keepAlive \
|
||||
-command ::httpTestScript::WhenFinished
|
||||
} token]} {
|
||||
set msg $token
|
||||
catch {puts stdout "Error: $msg"}
|
||||
return
|
||||
} else {
|
||||
# Request will begin.
|
||||
}
|
||||
|
||||
return
|
||||
|
||||
}
|
||||
|
||||
proc httpTestScript::TimeOutNow {} {
|
||||
variable TimeOutDone
|
||||
|
||||
set TimeOutDone 1
|
||||
set ::httpTestScript::FOREVER 0
|
||||
return
|
||||
}
|
||||
|
||||
proc httpTestScript::WhenFinished {hToken} {
|
||||
variable CountFinishedSoFar
|
||||
variable RequestsWhenStopped
|
||||
variable TimeOutCode
|
||||
variable StopDone
|
||||
variable RequestList
|
||||
variable RequestsMade
|
||||
variable ActualKeepAlive
|
||||
|
||||
upvar #0 $hToken state
|
||||
|
||||
if {[catch {
|
||||
if { [info exists state(transfer)]
|
||||
&& ($state(transfer) eq "chunked")
|
||||
} {
|
||||
set Trans chunked
|
||||
} else {
|
||||
set Trans unchunked
|
||||
}
|
||||
|
||||
if { [info exists ::httpTest::testOptions(-verbose)]
|
||||
&& ($::httpTest::testOptions(-verbose) > 0)
|
||||
} {
|
||||
puts "Token $hToken
|
||||
Response $state(http)
|
||||
Status $state(status)
|
||||
Method $state(method)
|
||||
Transfer $Trans
|
||||
Size $state(currentsize)
|
||||
URL $state(url)
|
||||
"
|
||||
}
|
||||
|
||||
if {!$state(-keepalive)} {
|
||||
set ActualKeepAlive 0
|
||||
}
|
||||
|
||||
if {[info exists state(method)]} {
|
||||
lappend RequestsMade $state(method)
|
||||
} else {
|
||||
lappend RequestsMade UNKNOWN
|
||||
}
|
||||
set tk [namespace tail $hToken]
|
||||
|
||||
if { ($state(http) != {HTTP/1.1 200 OK})
|
||||
|| ($state(status) != {ok})
|
||||
|| (($state(currentsize) == 0) && ($state(method) ne "HEAD"))
|
||||
} {
|
||||
::http::Log ^X$tk unexpected result Response $state(http) Status $state(status) Size $state(currentsize) - token $hToken
|
||||
}
|
||||
} err]} {
|
||||
::http::Log ^X$tk httpTestScript::WhenFinished failed with error status: $err - token $hToken
|
||||
}
|
||||
|
||||
incr CountFinishedSoFar
|
||||
if {$StopDone && ($CountFinishedSoFar == $RequestsWhenStopped)} {
|
||||
if {[info exists TimeOutCode]} {
|
||||
after cancel $TimeOutCode
|
||||
}
|
||||
if {$RequestsMade ne $RequestList && $ActualKeepAlive} {
|
||||
::http::Log ^X$tk unexpected result - Script asked for "{$RequestList}" but got "{$RequestsMade}" - token $hToken
|
||||
}
|
||||
set ::httpTestScript::FOREVER 0
|
||||
}
|
||||
|
||||
return
|
||||
}
|
||||
|
||||
|
||||
proc httpTestScript::runHttpTestScript {scr} {
|
||||
variable TimeOutDone
|
||||
variable RequestsWhenStopped
|
||||
|
||||
after idle [list namespace eval ::httpTestScript $scr]
|
||||
vwait ::httpTestScript::FOREVER
|
||||
# N.B. does not automatically execute in this namespace, unlike some other events.
|
||||
# Release when all requests have been served or have timed out.
|
||||
|
||||
if {$TimeOutDone} {
|
||||
return -code error {test script timed out}
|
||||
}
|
||||
|
||||
return $RequestsWhenStopped
|
||||
}
|
||||
|
||||
|
||||
proc httpTestScript::cleanupHttpTestScript {} {
|
||||
variable TimeOutDone
|
||||
variable RequestsWhenStopped
|
||||
|
||||
if {![info exists RequestsWhenStopped]} {
|
||||
return -code error {Cleanup Failed: RequestsWhenStopped is undefined}
|
||||
}
|
||||
|
||||
for {set i 1} {$i <= $RequestsWhenStopped} {incr i} {
|
||||
http::cleanup ::http::$i
|
||||
}
|
||||
|
||||
return
|
||||
}
|
||||
+4
-4
@@ -100,10 +100,10 @@ test lreplace-1.26 {lreplace command} {
|
||||
} {a {} {}}
|
||||
test lreplace-1.27 {lreplace command} -body {
|
||||
lreplace x 1 1
|
||||
} -returnCodes 1 -result {list doesn't contain element 1}
|
||||
} -result x
|
||||
test lreplace-1.28 {lreplace command} -body {
|
||||
lreplace x 1 1 y
|
||||
} -returnCodes 1 -result {list doesn't contain element 1}
|
||||
} -result {x y}
|
||||
test lreplace-1.29 {lreplace command} -body {
|
||||
lreplace x 1 1 [error foo]
|
||||
} -returnCodes 1 -result {foo}
|
||||
@@ -128,10 +128,10 @@ test lreplace-2.5 {lreplace errors} {
|
||||
} {1 {bad index "1x": must be integer?[+-]integer? or end?[+-]integer?}}
|
||||
test lreplace-2.6 {lreplace errors} {
|
||||
list [catch {lreplace x 3 2} msg] $msg
|
||||
} {1 {list doesn't contain element 3}}
|
||||
} {0 x}
|
||||
test lreplace-2.7 {lreplace errors} {
|
||||
list [catch {lreplace x 2 2} msg] $msg
|
||||
} {1 {list doesn't contain element 2}}
|
||||
} {0 x}
|
||||
|
||||
test lreplace-3.1 {lreplace won't modify shared argument objects} {
|
||||
proc p {} {
|
||||
|
||||
+11
-11
@@ -99,7 +99,7 @@ test macOSXFCmd-2.6 {MacOSXSetFileAttribute - hidden} {macosxFileAttr notRoot} {
|
||||
[catch {file attributes foo.test -hidden} msg] $msg \
|
||||
[file delete -force -- foo.test]
|
||||
} {0 {} 0 1 {}}
|
||||
test macOSXFCmd-2.7 {MacOSXSetFileAttribute - rsrclength} {macosxFileAttr notRoot} {
|
||||
test macOSXFCmd-2.7 {MacOSXSetFileAttribute - rsrclength} {macosxFileAttr notRoot nonPortable} {
|
||||
catch {file delete -force -- foo.test}
|
||||
close [open foo.test w]
|
||||
catch {
|
||||
@@ -151,16 +151,16 @@ test macOSXFCmd-4.1 {TclMacOSXMatchType} {macosxFileAttr notRoot} {
|
||||
file attributes dir.test -hidden 1
|
||||
}
|
||||
set res [list \
|
||||
[catch {glob *.test} msg] $msg \
|
||||
[catch {glob -types FOOT *.test} msg] $msg \
|
||||
[catch {glob -types {{macintosh type FOOT}} *.test} msg] $msg \
|
||||
[catch {glob -types FOOTT *.test} msg] $msg \
|
||||
[catch {glob -types {{macintosh type FOOTT}} *.test} msg] $msg \
|
||||
[catch {glob -types {{macintosh type {}}} *.test} msg] $msg \
|
||||
[catch {glob -types {{macintosh creator FOOC}} *.test} msg] $msg \
|
||||
[catch {glob -types {{macintosh creator FOOC} {macintosh type FOOT}} *.test} msg] $msg \
|
||||
[catch {glob -types hidden *.test} msg] $msg \
|
||||
[catch {glob -types {hidden FOOT} *.test} msg] $msg \
|
||||
[catch {lsort [glob *.test]} msg] $msg \
|
||||
[catch {lsort [glob -types FOOT *.test]} msg] $msg \
|
||||
[catch {lsort [glob -types {{macintosh type FOOT}} *.test]} msg] $msg \
|
||||
[catch {lsort [glob -types FOOTT *.test]} msg] $msg \
|
||||
[catch {lsort [glob -types {{macintosh type FOOTT}} *.test]} msg] $msg \
|
||||
[catch {lsort [glob -types {{macintosh type {}}} *.test]} msg] $msg \
|
||||
[catch {lsort [glob -types {{macintosh creator FOOC}} *.test]} msg] $msg \
|
||||
[catch {lsort [glob -types {{macintosh creator FOOC} {macintosh type FOOT}} *.test]} msg] $msg \
|
||||
[catch {lsort [glob -types hidden *.test]} msg] $msg \
|
||||
[catch {lsort [glob -types {hidden FOOT} *.test]} msg] $msg \
|
||||
]
|
||||
cd ..
|
||||
file delete -force globtest
|
||||
|
||||
+100
@@ -1804,6 +1804,106 @@ test oo-13.4 {OO: changing an object's class} -body {
|
||||
foo destroy
|
||||
bar destroy
|
||||
} -result {::foo ::foo ::foo ::bar}
|
||||
test oo-13.5 {OO: changing an object's class: non-class to class} -setup {
|
||||
oo::object create fooObj
|
||||
} -body {
|
||||
oo::objdefine fooObj {
|
||||
class oo::class
|
||||
}
|
||||
oo::define fooObj {
|
||||
method x {} {expr 1+2+3}
|
||||
}
|
||||
[fooObj new] x
|
||||
} -cleanup {
|
||||
fooObj destroy
|
||||
} -result 6
|
||||
test oo-13.6 {OO: changing an object's class: class to non-class} -setup {
|
||||
oo::class create foo
|
||||
unset -nocomplain ::result
|
||||
} -body {
|
||||
set result dangling
|
||||
oo::define foo {
|
||||
method x {} {expr 1+2+3}
|
||||
}
|
||||
oo::class create boo {
|
||||
superclass foo
|
||||
destructor {set ::result "ok"}
|
||||
}
|
||||
boo new
|
||||
foo create bar
|
||||
oo::objdefine foo {
|
||||
class oo::object
|
||||
}
|
||||
list $result [catch {bar x} msg] $msg
|
||||
} -cleanup {
|
||||
catch {bar destroy}
|
||||
foo destroy
|
||||
} -result {ok 1 {invalid command name "bar"}}
|
||||
test oo-13.7 {OO: changing an object's class} -setup {
|
||||
oo::class create foo
|
||||
oo::class create bar
|
||||
unset -nocomplain result
|
||||
} -body {
|
||||
oo::define bar method x {} {return ok}
|
||||
oo::define foo {
|
||||
method x {} {expr 1+2+3}
|
||||
self mixin foo
|
||||
}
|
||||
lappend result [foo x]
|
||||
oo::objdefine foo class bar
|
||||
lappend result [foo x]
|
||||
} -cleanup {
|
||||
foo destroy
|
||||
bar destroy
|
||||
} -result {6 ok}
|
||||
test oo-13.8 {OO: changing an object's class to itself} -setup {
|
||||
oo::class create foo
|
||||
} -body {
|
||||
oo::define foo {
|
||||
method x {} {expr 1+2+3}
|
||||
}
|
||||
oo::objdefine foo class foo
|
||||
} -cleanup {
|
||||
foo destroy
|
||||
} -returnCodes error -result {may not change classes into an instance of themselves}
|
||||
test oo-13.9 {OO: changing an object's class: roots are special} -setup {
|
||||
set i [interp create]
|
||||
} -body {
|
||||
$i eval {
|
||||
oo::objdefine oo::object {
|
||||
class oo::class
|
||||
}
|
||||
}
|
||||
} -cleanup {
|
||||
interp delete $i
|
||||
} -returnCodes error -result {may not modify the class of the root object class}
|
||||
test oo-13.10 {OO: changing an object's class: roots are special} -setup {
|
||||
set i [interp create]
|
||||
} -body {
|
||||
$i eval {
|
||||
oo::objdefine oo::class {
|
||||
class oo::object
|
||||
}
|
||||
}
|
||||
} -cleanup {
|
||||
interp delete $i
|
||||
} -returnCodes error -result {may not modify the class of the class of classes}
|
||||
test oo-13.11 {OO: changing an object's class in a tricky place} -setup {
|
||||
oo::class create cls
|
||||
unset -nocomplain result
|
||||
} -body {
|
||||
set result gorp
|
||||
list [catch {
|
||||
oo::define cls {
|
||||
method x {} {return}
|
||||
self class oo::object
|
||||
::set ::result ok
|
||||
method y {} {return}; # I'm sorry, Dave. I'm afraid I can't do that.
|
||||
}
|
||||
} msg] $msg $result
|
||||
} -cleanup {
|
||||
cls destroy
|
||||
} -result {1 {attempt to misuse API} ok}
|
||||
# todo: changing a class subtype (metaclass) to another class subtype
|
||||
|
||||
test oo-14.1 {OO: mixins} {
|
||||
|
||||
@@ -110,6 +110,14 @@ test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple name
|
||||
proc p {b:a b::a} {
|
||||
}
|
||||
} -returnCodes error -result {formal parameter "b::a" is not a simple name}
|
||||
test proc-1.9 {Tcl_ProcObjCmd, arguments via canonical list (string-representation bug [631b4c45df])} -body {
|
||||
set v 2
|
||||
binary scan AB cc a b
|
||||
proc p [list [list a $a] [list b $b] [list v [expr {$v + 2}]]] {expr {$a + $b + $v}}
|
||||
p
|
||||
} -result [expr {65+66+4}] -cleanup {
|
||||
rename p {}
|
||||
}
|
||||
|
||||
test proc-2.1 {TclFindProc, simple proc name and proc not in namespace} -setup {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
@@ -383,6 +391,14 @@ test proc-7.4 {Proc struct outlives its interp: Bug 3532959} {
|
||||
interp delete slave
|
||||
unset lambda
|
||||
} {}
|
||||
|
||||
test proc-7.5 {[631b4c45df] Crash in argument processing} {
|
||||
binary scan A c val
|
||||
proc foo [list [list from $val]] {}
|
||||
rename foo {}
|
||||
unset -nocomplain val
|
||||
} {}
|
||||
|
||||
|
||||
# cleanup
|
||||
catch {rename p ""}
|
||||
|
||||
+6
-6
@@ -19,7 +19,7 @@ testConstraint reg 0
|
||||
if {[testConstraint win]} {
|
||||
if {![catch {
|
||||
::tcltest::loadTestedCommands
|
||||
set ::regver [package require registry 1.3.2]
|
||||
set ::regver [package require registry 1.3.3]
|
||||
}]} {
|
||||
testConstraint reg 1
|
||||
}
|
||||
@@ -33,7 +33,7 @@ testConstraint english [expr {
|
||||
|
||||
test registry-1.0 {check if we are testing the right dll} {win reg} {
|
||||
set ::regver
|
||||
} {1.3.2}
|
||||
} {1.3.3}
|
||||
test registry-1.1 {argument parsing for registry command} {win reg} {
|
||||
list [catch {registry} msg] $msg
|
||||
} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}}
|
||||
@@ -283,7 +283,7 @@ test registry-4.7 {GetKeyNames: Unicode} {win reg english} {
|
||||
registry delete HKEY_CURRENT_USER\\TclFoobar
|
||||
set result
|
||||
} "baz\u00c7bar blat"
|
||||
test registry-4.8 {GetKeyNames: Unicode} {win reg nt} {
|
||||
test registry-4.8 {GetKeyNames: Unicode} {win reg} {
|
||||
registry delete HKEY_CURRENT_USER\\TclFoobar
|
||||
registry set HKEY_CURRENT_USER\\TclFoobar\\baz\u30b7bar
|
||||
registry set HKEY_CURRENT_USER\\TclFoobar\\blat
|
||||
@@ -487,7 +487,7 @@ test registry-6.17 {GetValue: Unicode value names} {win reg} {
|
||||
registry delete HKEY_CURRENT_USER\\TclFoobar
|
||||
set result
|
||||
} foobar
|
||||
test registry-6.18 {GetValue: values with Unicode strings} {win reg nt} {
|
||||
test registry-6.18 {GetValue: values with Unicode strings} {win reg} {
|
||||
registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u30b7r baz} multi_sz
|
||||
set result [registry get HKEY_CURRENT_USER\\TclFoobar val1]
|
||||
registry delete HKEY_CURRENT_USER\\TclFoobar
|
||||
@@ -505,7 +505,7 @@ test registry-6.20 {GetValue: values with Unicode strings with embedded nulls} {
|
||||
registry delete HKEY_CURRENT_USER\\TclFoobar
|
||||
set result
|
||||
} "foo ba r baz"
|
||||
test registry-6.21 {GetValue: very long value names and values} {pcOnly reg} {
|
||||
test registry-6.21 {GetValue: very long value names and values} {win reg} {
|
||||
registry set HKEY_CURRENT_USER\\TclFoobar [string repeat k 16383] [string repeat x 16383] multi_sz
|
||||
set result [registry get HKEY_CURRENT_USER\\TclFoobar [string repeat k 16383]]
|
||||
registry delete HKEY_CURRENT_USER\\TclFoobar
|
||||
@@ -604,7 +604,7 @@ test registry-9.3 {ParseKeyName: bad keys} -constraints {win reg} -body {
|
||||
test registry-9.4 {ParseKeyName: bad keys} -constraints {win reg} -body {
|
||||
registry values \\\\\\
|
||||
} -returnCodes error -result {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}
|
||||
test registry-9.5 {ParseKeyName: bad keys} -constraints {win reg english nt} -body {
|
||||
test registry-9.5 {ParseKeyName: bad keys} -constraints {win reg english} -body {
|
||||
registry values \\\\\\HKEY_CLASSES_ROOT
|
||||
} -returnCodes error -result {unable to open key: The network address is invalid.}
|
||||
test registry-9.6 {ParseKeyName: bad keys} -constraints {win reg} -body {
|
||||
|
||||
+6
-6
@@ -312,7 +312,7 @@ test tcltest-5.5 {InitConstraints: list of built-in constraints} \
|
||||
-result [lsort {
|
||||
95 98 asyncPipeClose eformat emptyTest exec hasIsoLocale interactive
|
||||
knownBug mac macCrash macOnly macOrPc macOrUnix macOrWin nonBlockFiles
|
||||
nonPortable notRoot nt pc pcCrash pcOnly root singleTestInterp slowTest socket
|
||||
nonPortable notRoot nt pc pcCrash pcOnly root singleTestInterp socket
|
||||
stdio tempNotMac tempNotPc tempNotUnix tempNotWin unix unixCrash unixExecs
|
||||
unixOnly unixOrPc unixOrWin userInteraction win winCrash winOnly
|
||||
}]
|
||||
@@ -908,7 +908,7 @@ removeFile load.tcl
|
||||
|
||||
# [interpreter]
|
||||
test tcltest-13.1 {interpreter} {
|
||||
-constraints notValgrind
|
||||
-constraints notValgrind
|
||||
-setup {
|
||||
#to do: Why is $::tcltest::tcltest being saved and restored here?
|
||||
set old $::tcltest::tcltest
|
||||
@@ -926,7 +926,7 @@ test tcltest-13.1 {interpreter} {
|
||||
# constraint, which involves a call to [exec] that might fail after
|
||||
# "fork" and before "exec", in which case the forked process will not
|
||||
# have a chance to clean itself up before exiting, which causes
|
||||
# valgrind to issue numerous "still reachable" reports.
|
||||
# valgrind to issue numerous "still reachable" reports.
|
||||
set ::tcltest::tcltest $old
|
||||
}
|
||||
}
|
||||
@@ -1207,7 +1207,7 @@ test tcltest-21.2 {force a test command failure} {
|
||||
} {1}
|
||||
}
|
||||
-returnCodes 1
|
||||
-result {bad option "1": must be -body, -cleanup, -constraints, -errorOutput, -match, -output, -result, -returnCodes, or -setup}
|
||||
-result {bad option "1": must be -body, -cleanup, -constraints, -errorCode, -errorOutput, -match, -output, -result, -returnCodes, or -setup}
|
||||
}
|
||||
|
||||
test tcltest-21.3 {test command with setup} {
|
||||
@@ -1300,7 +1300,7 @@ test tcltest-21.7 {test command - bad flag} {
|
||||
}
|
||||
}
|
||||
-returnCodes 1
|
||||
-result {bad option "-foobar": must be -body, -cleanup, -constraints, -errorOutput, -match, -output, -result, -returnCodes, or -setup}
|
||||
-result {bad option "-foobar": must be -body, -cleanup, -constraints, -errorCode, -errorOutput, -match, -output, -result, -returnCodes, or -setup}
|
||||
}
|
||||
|
||||
# alternate test command format (these are the same as 21.1-21.6, with the
|
||||
@@ -1320,7 +1320,7 @@ test tcltest-21.8 {force a test command failure} \
|
||||
} \
|
||||
-returnCodes 1 \
|
||||
-cleanup {set ::tcltest::currentFailure $fail} \
|
||||
-result {bad option "1": must be -body, -cleanup, -constraints, -errorOutput, -match, -output, -result, -returnCodes, or -setup}
|
||||
-result {bad option "1": must be -body, -cleanup, -constraints, -errorCode, -errorOutput, -match, -output, -result, -returnCodes, or -setup}
|
||||
|
||||
test tcltest-21.9 {test command with setup} \
|
||||
-setup {set foo 1} \
|
||||
|
||||
+2
-2
@@ -20,7 +20,7 @@ testConstraint dde 0
|
||||
if {[testConstraint win]} {
|
||||
if {![catch {
|
||||
::tcltest::loadTestedCommands
|
||||
set ::ddever [package require dde 1.4.0]
|
||||
set ::ddever [package require dde 1.4.1]
|
||||
set ::ddelib [lindex [package ifneeded dde $::ddever] 1]}]} {
|
||||
testConstraint dde 1
|
||||
}
|
||||
@@ -104,7 +104,7 @@ proc createChildProcess {ddeServerName args} {
|
||||
# -------------------------------------------------------------------------
|
||||
test winDde-1.0 {check if we are testing the right dll} {win dde} {
|
||||
set ::ddever
|
||||
} {1.4.0}
|
||||
} {1.4.1}
|
||||
|
||||
test winDde-1.1 {Settings the server's topic name} -constraints dde -body {
|
||||
list [dde servername foobar] [dde servername] [dde servername self]
|
||||
|
||||
+3
-4
@@ -57,11 +57,10 @@ proc cleanup {args} {
|
||||
}
|
||||
|
||||
if {[testConstraint winOnly]} {
|
||||
set major [string index $tcl_platform(osVersion) 0]
|
||||
if {[testConstraint nt] && $major > 4} {
|
||||
if {$major > 5} {
|
||||
if {[testConstraint nt] && $::tcl_platform(osVersion) >= 5.0} {
|
||||
if {$::tcl_platform(osVersion) >= 6.0} {
|
||||
testConstraint winVista 1
|
||||
} elseif {$major == 5} {
|
||||
} else {
|
||||
testConstraint win2000orXP 1
|
||||
}
|
||||
} else {
|
||||
|
||||
+10
-9
@@ -30,6 +30,7 @@ testConstraint cat32 [file exists $cat32]
|
||||
testConstraint AllocConsole [catch {puts console1 ""}]
|
||||
testConstraint RealConsole [expr {![testConstraint AllocConsole]}]
|
||||
testConstraint testexcept [llength [info commands testexcept]]
|
||||
testConstraint slowTest 0
|
||||
|
||||
|
||||
set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
|
||||
@@ -41,7 +42,7 @@ append big $big
|
||||
append big $big
|
||||
|
||||
set path(little) [makeFile {} little]
|
||||
set f [open $path(little) w]
|
||||
set f [open $path(little) w]
|
||||
puts -nonewline $f "little"
|
||||
close $f
|
||||
|
||||
@@ -323,16 +324,16 @@ proc _testExecArgs {single args} {
|
||||
lappend cmds [list $path(echoArgs.bat)]
|
||||
} else {
|
||||
if {![info exists path(echoArgs2.bat)] || ![file exists $path(echoArgs2.bat)]} {
|
||||
file mkdir [file join [temporaryDirectory] test(Dir)Check]
|
||||
set path(echoArgs2.bat) [makeFile "@[file native [interpreter]] $path(echoArgs.tcl) %*" \
|
||||
"test(Dir)Check/echo(Cmd)Test Args & Batch.bat"]
|
||||
set path(echoArgs2.bat) [makeFile \
|
||||
"@[file native [interpreter]] $path(echoArgs.tcl) %*" \
|
||||
"echo(Cmd)Test Args & Batch.bat" [makeDirectory test(Dir)Check]]
|
||||
}
|
||||
lappend cmds [list $path(echoArgs2.bat)]
|
||||
}
|
||||
set broken {}
|
||||
foreach args $args {
|
||||
if {$single & 1} {
|
||||
# enclose single test-arg between 1st/3rd to be sure nothing is truncated
|
||||
# enclose single test-arg between 1st/3rd to be sure nothing is truncated
|
||||
# (e. g. to cover unexpected trim by nts-zero case, and args don't recombined):
|
||||
set args [list "1st" $args "3rd"]
|
||||
}
|
||||
@@ -569,7 +570,7 @@ set injectList {
|
||||
|
||||
test winpipe-8.6 {BuildCommandLine/parse_cmdline pass-thru: check new-line quoted in args} \
|
||||
-constraints {win exec} -body {
|
||||
# test exe only, because currently there is no proper way to escape a new-line char resp.
|
||||
# test exe only, because currently there is no proper way to escape a new-line char resp.
|
||||
# to supply a new-line to the batch-files within arguments (command line is truncated).
|
||||
_testExecArgs 8 \
|
||||
[list START {*}$injectList END] \
|
||||
@@ -603,9 +604,9 @@ removeFile more
|
||||
removeFile stdout
|
||||
removeFile stderr
|
||||
removeFile nothing
|
||||
removeFile echoArgs.tcl
|
||||
removeFile echoArgs.bat
|
||||
file delete -force [file join [temporaryDirectory] test(Dir)Check]
|
||||
if {[info exists path(echoArgs.tcl)]} { removeFile echoArgs.tcl }
|
||||
if {[info exists path(echoArgs.bat)]} { removeFile echoArgs.bat }
|
||||
if {[info exists path(echoArgs2.bat)]} { removeDirectory test(Dir)Check }
|
||||
::tcltest::cleanupTests
|
||||
return
|
||||
|
||||
|
||||
+43
-8
@@ -191,12 +191,28 @@ proc genStubs::declare {args} {
|
||||
regsub -all "\[ \t\n\]+" [string trim $decl] " " decl
|
||||
set decl [parseDecl $decl]
|
||||
|
||||
foreach platform $platformList {
|
||||
if {$decl ne ""} {
|
||||
set stubs($curName,$platform,$index) $decl
|
||||
if {![info exists stubs($curName,$platform,lastNum)] \
|
||||
|| ($index > $stubs($curName,$platform,lastNum))} {
|
||||
set stubs($curName,$platform,lastNum) $index
|
||||
if {([lindex $platformList 0] eq "deprecated")} {
|
||||
set stubs($curName,deprecated,$index) [lindex $platformList 1]
|
||||
set stubs($curName,generic,$index) $decl
|
||||
if {![info exists stubs($curName,generic,lastNum)] \
|
||||
|| ($index > $stubs($curName,generic,lastNum))} {
|
||||
set stubs($curName,generic,lastNum) $index
|
||||
}
|
||||
} elseif {([lindex $platformList 0] eq "nostub")} {
|
||||
set stubs($curName,nostub,$index) [lindex $platformList 1]
|
||||
set stubs($curName,generic,$index) $decl
|
||||
if {![info exists stubs($curName,generic,lastNum)] \
|
||||
|| ($index > $stubs($curName,generic,lastNum))} {
|
||||
set stubs($curName,generic,lastNum) $index
|
||||
}
|
||||
} else {
|
||||
foreach platform $platformList {
|
||||
if {$decl ne ""} {
|
||||
set stubs($curName,$platform,$index) $decl
|
||||
if {![info exists stubs($curName,$platform,lastNum)] \
|
||||
|| ($index > $stubs($curName,$platform,lastNum))} {
|
||||
set stubs($curName,$platform,lastNum) $index
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -455,10 +471,17 @@ proc genStubs::parseArg {arg} {
|
||||
|
||||
proc genStubs::makeDecl {name decl index} {
|
||||
variable scspec
|
||||
variable stubs
|
||||
variable libraryName
|
||||
lassign $decl rtype fname args
|
||||
|
||||
append text "/* $index */\n"
|
||||
set line "$scspec $rtype"
|
||||
if {[info exists stubs($name,deprecated,$index)]} {
|
||||
append text "[string toupper $libraryName]_DEPRECATED(\"$stubs($name,deprecated,$index)\")\n"
|
||||
set line "$rtype"
|
||||
} else {
|
||||
set line "$scspec $rtype"
|
||||
}
|
||||
set count [expr {2 - ([string length $line] / 8)}]
|
||||
append line [string range "\t\t\t" 0 $count]
|
||||
set pad [expr {24 - [string length $line]}]
|
||||
@@ -569,11 +592,17 @@ proc genStubs::makeMacro {name decl index} {
|
||||
|
||||
proc genStubs::makeSlot {name decl index} {
|
||||
lassign $decl rtype fname args
|
||||
variable stubs
|
||||
|
||||
set lfname [string tolower [string index $fname 0]]
|
||||
append lfname [string range $fname 1 end]
|
||||
|
||||
set text " "
|
||||
if {[info exists stubs($name,deprecated,$index)]} {
|
||||
append text "TCL_DEPRECATED_API(\"$stubs($name,deprecated,$index)\") "
|
||||
} elseif {[info exists stubs($name,nostub,$index)]} {
|
||||
append text "TCL_DEPRECATED_API(\"$stubs($name,nostub,$index)\") "
|
||||
}
|
||||
if {$args eq ""} {
|
||||
append text $rtype " *" $lfname "; /* $index */\n"
|
||||
return $text
|
||||
@@ -682,7 +711,13 @@ proc genStubs::forAllStubs {name slotProc onAll textVar
|
||||
for {set i 0} {$i <= $lastNum} {incr i} {
|
||||
set slots [array names stubs $name,*,$i]
|
||||
set emit 0
|
||||
if {[info exists stubs($name,generic,$i)]} {
|
||||
if {[info exists stubs($name,deprecated,$i)]} {
|
||||
append text [$slotProc $name $stubs($name,generic,$i) $i]
|
||||
set emit 1
|
||||
} elseif {[info exists stubs($name,nostub,$i)]} {
|
||||
append text [$slotProc $name $stubs($name,generic,$i) $i]
|
||||
set emit 1
|
||||
} elseif {[info exists stubs($name,generic,$i)]} {
|
||||
if {[llength $slots] > 1} {
|
||||
puts stderr "conflicting generic and platform entries:\
|
||||
$name $i"
|
||||
|
||||
+4
-10
@@ -842,8 +842,8 @@ install-libraries: libraries
|
||||
do \
|
||||
$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/http1.0; \
|
||||
done;
|
||||
@echo "Installing package http 2.8.13 as a Tcl Module";
|
||||
@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.13.tm;
|
||||
@echo "Installing package http 2.9.0 as a Tcl Module";
|
||||
@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.9.0.tm;
|
||||
@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/";
|
||||
@for i in $(TOP_DIR)/library/opt/*.tcl ; \
|
||||
do \
|
||||
@@ -851,8 +851,8 @@ install-libraries: libraries
|
||||
done;
|
||||
@echo "Installing package msgcat 1.6.1 as a Tcl Module";
|
||||
@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.6.1.tm;
|
||||
@echo "Installing package tcltest 2.4.1 as a Tcl Module";
|
||||
@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.4.1.tm;
|
||||
@echo "Installing package tcltest 2.5.0 as a Tcl Module";
|
||||
@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.5.0.tm;
|
||||
|
||||
@echo "Installing package platform 1.0.14 as a Tcl Module";
|
||||
@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.14.tm;
|
||||
@@ -1632,9 +1632,6 @@ tclXtTest.o: $(UNIX_DIR)/tclXtTest.c
|
||||
# relocatable.
|
||||
#--------------------------------------------------------------------------
|
||||
|
||||
fixstrtod.o: $(COMPAT_DIR)/fixstrtod.c
|
||||
$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/fixstrtod.c
|
||||
|
||||
opendir.o: $(COMPAT_DIR)/opendir.c
|
||||
$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/opendir.c
|
||||
|
||||
@@ -1650,9 +1647,6 @@ strncasecmp.o: $(COMPAT_DIR)/strncasecmp.c
|
||||
strstr.o: $(COMPAT_DIR)/strstr.c
|
||||
$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strstr.c
|
||||
|
||||
strtod.o: $(COMPAT_DIR)/strtod.c
|
||||
$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtod.c
|
||||
|
||||
strtol.o: $(COMPAT_DIR)/strtol.c
|
||||
$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtol.c
|
||||
|
||||
|
||||
Vendored
+2
-354
@@ -7511,7 +7511,7 @@ fi
|
||||
fi
|
||||
|
||||
;;
|
||||
FreeBSD-*)
|
||||
DragonFly-*|FreeBSD-*)
|
||||
# This configuration from FreeBSD Ports.
|
||||
SHLIB_CFLAGS="-fPIC"
|
||||
SHLIB_LD="${CC} -shared"
|
||||
@@ -8719,7 +8719,7 @@ fi
|
||||
BSD/OS*) ;;
|
||||
CYGWIN_*|MINGW32_*) ;;
|
||||
IRIX*) ;;
|
||||
NetBSD-*|FreeBSD-*|OpenBSD-*) ;;
|
||||
NetBSD-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;;
|
||||
Darwin-*) ;;
|
||||
SCO_SV-3.2*) ;;
|
||||
*) SHLIB_CFLAGS="-fPIC" ;;
|
||||
@@ -14982,358 +14982,6 @@ esac
|
||||
fi
|
||||
|
||||
|
||||
#--------------------------------------------------------------------
|
||||
# Check for the strtod function. This is tricky because in some
|
||||
# versions of Linux strtod mis-parses strings starting with "+".
|
||||
#--------------------------------------------------------------------
|
||||
|
||||
|
||||
echo "$as_me:$LINENO: checking for strtod" >&5
|
||||
echo $ECHO_N "checking for strtod... $ECHO_C" >&6
|
||||
if test "${ac_cv_func_strtod+set}" = set; then
|
||||
echo $ECHO_N "(cached) $ECHO_C" >&6
|
||||
else
|
||||
cat >conftest.$ac_ext <<_ACEOF
|
||||
/* confdefs.h. */
|
||||
_ACEOF
|
||||
cat confdefs.h >>conftest.$ac_ext
|
||||
cat >>conftest.$ac_ext <<_ACEOF
|
||||
/* end confdefs.h. */
|
||||
/* Define strtod to an innocuous variant, in case <limits.h> declares strtod.
|
||||
For example, HP-UX 11i <limits.h> declares gettimeofday. */
|
||||
#define strtod innocuous_strtod
|
||||
|
||||
/* System header to define __stub macros and hopefully few prototypes,
|
||||
which can conflict with char strtod (); below.
|
||||
Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
|
||||
<limits.h> exists even on freestanding compilers. */
|
||||
|
||||
#ifdef __STDC__
|
||||
# include <limits.h>
|
||||
#else
|
||||
# include <assert.h>
|
||||
#endif
|
||||
|
||||
#undef strtod
|
||||
|
||||
/* Override any gcc2 internal prototype to avoid an error. */
|
||||
#ifdef __cplusplus
|
||||
extern "C"
|
||||
{
|
||||
#endif
|
||||
/* We use char because int might match the return type of a gcc2
|
||||
builtin and then its argument prototype would still apply. */
|
||||
char strtod ();
|
||||
/* The GNU C library defines this for functions which it implements
|
||||
to always fail with ENOSYS. Some functions are actually named
|
||||
something starting with __ and the normal name is an alias. */
|
||||
#if defined (__stub_strtod) || defined (__stub___strtod)
|
||||
choke me
|
||||
#else
|
||||
char (*f) () = strtod;
|
||||
#endif
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
int
|
||||
main ()
|
||||
{
|
||||
return f != strtod;
|
||||
;
|
||||
return 0;
|
||||
}
|
||||
_ACEOF
|
||||
rm -f conftest.$ac_objext conftest$ac_exeext
|
||||
if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
|
||||
(eval $ac_link) 2>conftest.er1
|
||||
ac_status=$?
|
||||
grep -v '^ *+' conftest.er1 >conftest.err
|
||||
rm -f conftest.er1
|
||||
cat conftest.err >&5
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); } &&
|
||||
{ ac_try='test -z "$ac_c_werror_flag"
|
||||
|| test ! -s conftest.err'
|
||||
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
|
||||
(eval $ac_try) 2>&5
|
||||
ac_status=$?
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); }; } &&
|
||||
{ ac_try='test -s conftest$ac_exeext'
|
||||
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
|
||||
(eval $ac_try) 2>&5
|
||||
ac_status=$?
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); }; }; then
|
||||
ac_cv_func_strtod=yes
|
||||
else
|
||||
echo "$as_me: failed program was:" >&5
|
||||
sed 's/^/| /' conftest.$ac_ext >&5
|
||||
|
||||
ac_cv_func_strtod=no
|
||||
fi
|
||||
rm -f conftest.err conftest.$ac_objext \
|
||||
conftest$ac_exeext conftest.$ac_ext
|
||||
fi
|
||||
echo "$as_me:$LINENO: result: $ac_cv_func_strtod" >&5
|
||||
echo "${ECHO_T}$ac_cv_func_strtod" >&6
|
||||
if test $ac_cv_func_strtod = yes; then
|
||||
tcl_ok=1
|
||||
else
|
||||
tcl_ok=0
|
||||
fi
|
||||
|
||||
if test "$tcl_ok" = 1; then
|
||||
echo "$as_me:$LINENO: checking proper strtod implementation" >&5
|
||||
echo $ECHO_N "checking proper strtod implementation... $ECHO_C" >&6
|
||||
if test "${tcl_cv_strtod_unbroken+set}" = set; then
|
||||
echo $ECHO_N "(cached) $ECHO_C" >&6
|
||||
else
|
||||
if test "$cross_compiling" = yes; then
|
||||
tcl_cv_strtod_unbroken=unknown
|
||||
else
|
||||
cat >conftest.$ac_ext <<_ACEOF
|
||||
/* confdefs.h. */
|
||||
_ACEOF
|
||||
cat confdefs.h >>conftest.$ac_ext
|
||||
cat >>conftest.$ac_ext <<_ACEOF
|
||||
/* end confdefs.h. */
|
||||
int main() {
|
||||
extern double strtod();
|
||||
char *term, *string = " +69";
|
||||
exit(strtod(string,&term) != 69 || term != string+4);
|
||||
}
|
||||
_ACEOF
|
||||
rm -f conftest$ac_exeext
|
||||
if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
|
||||
(eval $ac_link) 2>&5
|
||||
ac_status=$?
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); } && { ac_try='./conftest$ac_exeext'
|
||||
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
|
||||
(eval $ac_try) 2>&5
|
||||
ac_status=$?
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); }; }; then
|
||||
tcl_cv_strtod_unbroken=ok
|
||||
else
|
||||
echo "$as_me: program exited with status $ac_status" >&5
|
||||
echo "$as_me: failed program was:" >&5
|
||||
sed 's/^/| /' conftest.$ac_ext >&5
|
||||
|
||||
( exit $ac_status )
|
||||
tcl_cv_strtod_unbroken=broken
|
||||
fi
|
||||
rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
|
||||
fi
|
||||
fi
|
||||
echo "$as_me:$LINENO: result: $tcl_cv_strtod_unbroken" >&5
|
||||
echo "${ECHO_T}$tcl_cv_strtod_unbroken" >&6
|
||||
if test "$tcl_cv_strtod_unbroken" = "ok"; then
|
||||
tcl_ok=1
|
||||
else
|
||||
tcl_ok=0
|
||||
fi
|
||||
fi
|
||||
if test "$tcl_ok" = 0; then
|
||||
case $LIBOBJS in
|
||||
"strtod.$ac_objext" | \
|
||||
*" strtod.$ac_objext" | \
|
||||
"strtod.$ac_objext "* | \
|
||||
*" strtod.$ac_objext "* ) ;;
|
||||
*) LIBOBJS="$LIBOBJS strtod.$ac_objext" ;;
|
||||
esac
|
||||
|
||||
USE_COMPAT=1
|
||||
fi
|
||||
|
||||
|
||||
#--------------------------------------------------------------------
|
||||
# Under Solaris 2.4, strtod returns the wrong value for the
|
||||
# terminating character under some conditions. Check for this
|
||||
# and if the problem exists use a substitute procedure
|
||||
# "fixstrtod" that corrects the error.
|
||||
#--------------------------------------------------------------------
|
||||
|
||||
|
||||
echo "$as_me:$LINENO: checking for strtod" >&5
|
||||
echo $ECHO_N "checking for strtod... $ECHO_C" >&6
|
||||
if test "${ac_cv_func_strtod+set}" = set; then
|
||||
echo $ECHO_N "(cached) $ECHO_C" >&6
|
||||
else
|
||||
cat >conftest.$ac_ext <<_ACEOF
|
||||
/* confdefs.h. */
|
||||
_ACEOF
|
||||
cat confdefs.h >>conftest.$ac_ext
|
||||
cat >>conftest.$ac_ext <<_ACEOF
|
||||
/* end confdefs.h. */
|
||||
/* Define strtod to an innocuous variant, in case <limits.h> declares strtod.
|
||||
For example, HP-UX 11i <limits.h> declares gettimeofday. */
|
||||
#define strtod innocuous_strtod
|
||||
|
||||
/* System header to define __stub macros and hopefully few prototypes,
|
||||
which can conflict with char strtod (); below.
|
||||
Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
|
||||
<limits.h> exists even on freestanding compilers. */
|
||||
|
||||
#ifdef __STDC__
|
||||
# include <limits.h>
|
||||
#else
|
||||
# include <assert.h>
|
||||
#endif
|
||||
|
||||
#undef strtod
|
||||
|
||||
/* Override any gcc2 internal prototype to avoid an error. */
|
||||
#ifdef __cplusplus
|
||||
extern "C"
|
||||
{
|
||||
#endif
|
||||
/* We use char because int might match the return type of a gcc2
|
||||
builtin and then its argument prototype would still apply. */
|
||||
char strtod ();
|
||||
/* The GNU C library defines this for functions which it implements
|
||||
to always fail with ENOSYS. Some functions are actually named
|
||||
something starting with __ and the normal name is an alias. */
|
||||
#if defined (__stub_strtod) || defined (__stub___strtod)
|
||||
choke me
|
||||
#else
|
||||
char (*f) () = strtod;
|
||||
#endif
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
int
|
||||
main ()
|
||||
{
|
||||
return f != strtod;
|
||||
;
|
||||
return 0;
|
||||
}
|
||||
_ACEOF
|
||||
rm -f conftest.$ac_objext conftest$ac_exeext
|
||||
if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
|
||||
(eval $ac_link) 2>conftest.er1
|
||||
ac_status=$?
|
||||
grep -v '^ *+' conftest.er1 >conftest.err
|
||||
rm -f conftest.er1
|
||||
cat conftest.err >&5
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); } &&
|
||||
{ ac_try='test -z "$ac_c_werror_flag"
|
||||
|| test ! -s conftest.err'
|
||||
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
|
||||
(eval $ac_try) 2>&5
|
||||
ac_status=$?
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); }; } &&
|
||||
{ ac_try='test -s conftest$ac_exeext'
|
||||
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
|
||||
(eval $ac_try) 2>&5
|
||||
ac_status=$?
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); }; }; then
|
||||
ac_cv_func_strtod=yes
|
||||
else
|
||||
echo "$as_me: failed program was:" >&5
|
||||
sed 's/^/| /' conftest.$ac_ext >&5
|
||||
|
||||
ac_cv_func_strtod=no
|
||||
fi
|
||||
rm -f conftest.err conftest.$ac_objext \
|
||||
conftest$ac_exeext conftest.$ac_ext
|
||||
fi
|
||||
echo "$as_me:$LINENO: result: $ac_cv_func_strtod" >&5
|
||||
echo "${ECHO_T}$ac_cv_func_strtod" >&6
|
||||
if test $ac_cv_func_strtod = yes; then
|
||||
tcl_strtod=1
|
||||
else
|
||||
tcl_strtod=0
|
||||
fi
|
||||
|
||||
if test "$tcl_strtod" = 1; then
|
||||
echo "$as_me:$LINENO: checking for Solaris2.4/Tru64 strtod bugs" >&5
|
||||
echo $ECHO_N "checking for Solaris2.4/Tru64 strtod bugs... $ECHO_C" >&6
|
||||
if test "${tcl_cv_strtod_buggy+set}" = set; then
|
||||
echo $ECHO_N "(cached) $ECHO_C" >&6
|
||||
else
|
||||
|
||||
if test "$cross_compiling" = yes; then
|
||||
tcl_cv_strtod_buggy=buggy
|
||||
else
|
||||
cat >conftest.$ac_ext <<_ACEOF
|
||||
/* confdefs.h. */
|
||||
_ACEOF
|
||||
cat confdefs.h >>conftest.$ac_ext
|
||||
cat >>conftest.$ac_ext <<_ACEOF
|
||||
/* end confdefs.h. */
|
||||
|
||||
extern double strtod();
|
||||
int main() {
|
||||
char *infString="Inf", *nanString="NaN", *spaceString=" ";
|
||||
char *term;
|
||||
double value;
|
||||
value = strtod(infString, &term);
|
||||
if ((term != infString) && (term[-1] == 0)) {
|
||||
exit(1);
|
||||
}
|
||||
value = strtod(nanString, &term);
|
||||
if ((term != nanString) && (term[-1] == 0)) {
|
||||
exit(1);
|
||||
}
|
||||
value = strtod(spaceString, &term);
|
||||
if (term == (spaceString+1)) {
|
||||
exit(1);
|
||||
}
|
||||
exit(0);
|
||||
}
|
||||
_ACEOF
|
||||
rm -f conftest$ac_exeext
|
||||
if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
|
||||
(eval $ac_link) 2>&5
|
||||
ac_status=$?
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); } && { ac_try='./conftest$ac_exeext'
|
||||
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
|
||||
(eval $ac_try) 2>&5
|
||||
ac_status=$?
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); }; }; then
|
||||
tcl_cv_strtod_buggy=ok
|
||||
else
|
||||
echo "$as_me: program exited with status $ac_status" >&5
|
||||
echo "$as_me: failed program was:" >&5
|
||||
sed 's/^/| /' conftest.$ac_ext >&5
|
||||
|
||||
( exit $ac_status )
|
||||
tcl_cv_strtod_buggy=buggy
|
||||
fi
|
||||
rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
|
||||
fi
|
||||
fi
|
||||
echo "$as_me:$LINENO: result: $tcl_cv_strtod_buggy" >&5
|
||||
echo "${ECHO_T}$tcl_cv_strtod_buggy" >&6
|
||||
if test "$tcl_cv_strtod_buggy" = buggy; then
|
||||
case $LIBOBJS in
|
||||
"fixstrtod.$ac_objext" | \
|
||||
*" fixstrtod.$ac_objext" | \
|
||||
"fixstrtod.$ac_objext "* | \
|
||||
*" fixstrtod.$ac_objext "* ) ;;
|
||||
*) LIBOBJS="$LIBOBJS fixstrtod.$ac_objext" ;;
|
||||
esac
|
||||
|
||||
USE_COMPAT=1
|
||||
|
||||
cat >>confdefs.h <<\_ACEOF
|
||||
#define strtod fixstrtod
|
||||
_ACEOF
|
||||
|
||||
fi
|
||||
fi
|
||||
|
||||
|
||||
#--------------------------------------------------------------------
|
||||
# Check for various typedefs and provide substitutes if
|
||||
# they don't exist.
|
||||
|
||||
@@ -358,26 +358,6 @@ SC_TCL_CHECK_BROKEN_FUNC(strtoul, [
|
||||
exit(strtoul(string,&term,0) != 0 || term != string+1);
|
||||
])
|
||||
|
||||
#--------------------------------------------------------------------
|
||||
# Check for the strtod function. This is tricky because in some
|
||||
# versions of Linux strtod mis-parses strings starting with "+".
|
||||
#--------------------------------------------------------------------
|
||||
|
||||
SC_TCL_CHECK_BROKEN_FUNC(strtod, [
|
||||
extern double strtod();
|
||||
char *term, *string = " +69";
|
||||
exit(strtod(string,&term) != 69 || term != string+4);
|
||||
])
|
||||
|
||||
#--------------------------------------------------------------------
|
||||
# Under Solaris 2.4, strtod returns the wrong value for the
|
||||
# terminating character under some conditions. Check for this
|
||||
# and if the problem exists use a substitute procedure
|
||||
# "fixstrtod" that corrects the error.
|
||||
#--------------------------------------------------------------------
|
||||
|
||||
SC_BUGGY_STRTOD
|
||||
|
||||
#--------------------------------------------------------------------
|
||||
# Check for various typedefs and provide substitutes if
|
||||
# they don't exist.
|
||||
|
||||
+2
-55
@@ -1516,7 +1516,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
|
||||
LDFLAGS="$LDFLAGS -pthread"
|
||||
])
|
||||
;;
|
||||
FreeBSD-*)
|
||||
DragonFly-*|FreeBSD-*)
|
||||
# This configuration from FreeBSD Ports.
|
||||
SHLIB_CFLAGS="-fPIC"
|
||||
SHLIB_LD="${CC} -shared"
|
||||
@@ -2012,7 +2012,7 @@ dnl # preprocessing tests use only CPPFLAGS.
|
||||
BSD/OS*) ;;
|
||||
CYGWIN_*|MINGW32_*) ;;
|
||||
IRIX*) ;;
|
||||
NetBSD-*|FreeBSD-*|OpenBSD-*) ;;
|
||||
NetBSD-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;;
|
||||
Darwin-*) ;;
|
||||
SCO_SV-3.2*) ;;
|
||||
*) SHLIB_CFLAGS="-fPIC" ;;
|
||||
@@ -2397,59 +2397,6 @@ AC_DEFUN([SC_TIME_HANDLER], [
|
||||
fi
|
||||
])
|
||||
|
||||
#--------------------------------------------------------------------
|
||||
# SC_BUGGY_STRTOD
|
||||
#
|
||||
# Under Solaris 2.4, strtod returns the wrong value for the
|
||||
# terminating character under some conditions. Check for this
|
||||
# and if the problem exists use a substitute procedure
|
||||
# "fixstrtod" (provided by Tcl) that corrects the error.
|
||||
# Also, on Compaq's Tru64 Unix 5.0,
|
||||
# strtod(" ") returns 0.0 instead of a failure to convert.
|
||||
#
|
||||
# Arguments:
|
||||
# none
|
||||
#
|
||||
# Results:
|
||||
#
|
||||
# Might defines some of the following vars:
|
||||
# strtod (=fixstrtod)
|
||||
#
|
||||
#--------------------------------------------------------------------
|
||||
|
||||
AC_DEFUN([SC_BUGGY_STRTOD], [
|
||||
AC_CHECK_FUNC(strtod, tcl_strtod=1, tcl_strtod=0)
|
||||
if test "$tcl_strtod" = 1; then
|
||||
AC_CACHE_CHECK([for Solaris2.4/Tru64 strtod bugs], tcl_cv_strtod_buggy,[
|
||||
AC_TRY_RUN([
|
||||
extern double strtod();
|
||||
int main() {
|
||||
char *infString="Inf", *nanString="NaN", *spaceString=" ";
|
||||
char *term;
|
||||
double value;
|
||||
value = strtod(infString, &term);
|
||||
if ((term != infString) && (term[-1] == 0)) {
|
||||
exit(1);
|
||||
}
|
||||
value = strtod(nanString, &term);
|
||||
if ((term != nanString) && (term[-1] == 0)) {
|
||||
exit(1);
|
||||
}
|
||||
value = strtod(spaceString, &term);
|
||||
if (term == (spaceString+1)) {
|
||||
exit(1);
|
||||
}
|
||||
exit(0);
|
||||
}], tcl_cv_strtod_buggy=ok, tcl_cv_strtod_buggy=buggy,
|
||||
tcl_cv_strtod_buggy=buggy)])
|
||||
if test "$tcl_cv_strtod_buggy" = buggy; then
|
||||
AC_LIBOBJ([fixstrtod])
|
||||
USE_COMPAT=1
|
||||
AC_DEFINE(strtod, fixstrtod, [Do we want to use the strtod() in compat?])
|
||||
fi
|
||||
fi
|
||||
])
|
||||
|
||||
#--------------------------------------------------------------------
|
||||
# SC_TCL_LINK_LIBS
|
||||
#
|
||||
|
||||
+8
-8
@@ -651,8 +651,8 @@ install-libraries: libraries install-tzdata install-msgs
|
||||
do \
|
||||
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \
|
||||
done;
|
||||
@echo "Installing package http 2.8.13 as a Tcl Module";
|
||||
@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.13.tm;
|
||||
@echo "Installing package http 2.9.0 as a Tcl Module";
|
||||
@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.9.0.tm;
|
||||
@echo "Installing library opt0.4 directory";
|
||||
@for j in $(ROOT_DIR)/library/opt/*.tcl; \
|
||||
do \
|
||||
@@ -660,8 +660,8 @@ install-libraries: libraries install-tzdata install-msgs
|
||||
done;
|
||||
@echo "Installing package msgcat 1.6.1 as a Tcl Module";
|
||||
@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.6.1.tm;
|
||||
@echo "Installing package tcltest 2.4.1 as a Tcl Module";
|
||||
@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.4.1.tm;
|
||||
@echo "Installing package tcltest 2.5.0 as a Tcl Module";
|
||||
@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.5.0.tm;
|
||||
@echo "Installing package platform 1.0.14 as a Tcl Module";
|
||||
@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.14.tm;
|
||||
@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
|
||||
@@ -712,15 +712,15 @@ test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE)
|
||||
TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
|
||||
./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
|
||||
-load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
|
||||
package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
|
||||
package ifneeded registry 1.3.2 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32)
|
||||
package ifneeded dde 1.4.1 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
|
||||
package ifneeded registry 1.3.3 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32)
|
||||
|
||||
# Useful target to launch a built tclsh with the proper path,...
|
||||
runtest: binaries $(TCLSH) $(TEST_DLL_FILE)
|
||||
@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
|
||||
./$(TCLSH) $(TESTFLAGS) -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
|
||||
package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
|
||||
package ifneeded registry 1.3.2 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT)
|
||||
package ifneeded dde 1.4.1 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
|
||||
package ifneeded registry 1.3.3 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT)
|
||||
|
||||
# This target can be used to run tclsh from the build directory via
|
||||
# `make shell SCRIPT=foo.tcl`
|
||||
|
||||
+2
-2
@@ -384,8 +384,8 @@ test: test-core test-pkgs
|
||||
test-core: setup $(TCLTEST) dlls $(CAT32)
|
||||
set TCL_LIBRARY=$(ROOT:\=/)/library
|
||||
$(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
|
||||
package ifneeded dde 1.4.0 [list load "$(TCLDDELIB:\=/)" dde]
|
||||
package ifneeded registry 1.3.2 [list load "$(TCLREGLIB:\=/)" registry]
|
||||
package ifneeded dde 1.4.1 [list load "$(TCLDDELIB:\=/)" dde]
|
||||
package ifneeded registry 1.3.3 [list load "$(TCLREGLIB:\=/)" registry]
|
||||
<<
|
||||
|
||||
runtest: setup $(TCLTEST) dlls $(CAT32)
|
||||
|
||||
+12
-51
@@ -33,10 +33,6 @@ static int platformId; /* Running under NT, or 95/98? */
|
||||
#define cpuid __asm __emit 0fh __asm __emit 0a2h
|
||||
#endif
|
||||
|
||||
#if TCL_UTF_MAX < 4
|
||||
static Tcl_Encoding winTCharEncoding = NULL;
|
||||
#endif
|
||||
|
||||
/*
|
||||
* The following declaration is for the VC++ DLL entry point.
|
||||
*/
|
||||
@@ -201,8 +197,6 @@ TclWinInit(
|
||||
if (platformId == VER_PLATFORM_WIN32_WINDOWS) {
|
||||
Tcl_Panic("Windows 9x is not a supported platform");
|
||||
}
|
||||
|
||||
TclWinResetInterfaces();
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -282,10 +276,6 @@ TclWinNoBackslash(
|
||||
void
|
||||
TclpSetInterfaces(void)
|
||||
{
|
||||
#if TCL_UTF_MAX < 4
|
||||
TclWinResetInterfaces();
|
||||
winTCharEncoding = Tcl_GetEncoding(NULL, "unicode");
|
||||
#endif
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -313,8 +303,6 @@ TclWinEncodingsCleanup(void)
|
||||
{
|
||||
MountPointMap *dlIter, *dlIter2;
|
||||
|
||||
TclWinResetInterfaces();
|
||||
|
||||
/*
|
||||
* Clean up the mount point map.
|
||||
*/
|
||||
@@ -348,12 +336,6 @@ TclWinEncodingsCleanup(void)
|
||||
void
|
||||
TclWinResetInterfaces(void)
|
||||
{
|
||||
#if TCL_UTF_MAX < 4
|
||||
if (winTCharEncoding != NULL) {
|
||||
Tcl_FreeEncoding(winTCharEncoding);
|
||||
winTCharEncoding = NULL;
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -565,22 +547,11 @@ Tcl_WinUtfToTChar(
|
||||
Tcl_DString *dsPtr) /* Uninitialized or free DString in which the
|
||||
* converted string is stored. */
|
||||
{
|
||||
#if TCL_UTF_MAX > 3
|
||||
TCHAR *wp;
|
||||
int size = MultiByteToWideChar(CP_UTF8, 0, string, len, 0, 0);
|
||||
|
||||
Tcl_DStringInit(dsPtr);
|
||||
Tcl_DStringSetLength(dsPtr, 2*size+2);
|
||||
wp = (TCHAR *)Tcl_DStringValue(dsPtr);
|
||||
MultiByteToWideChar(CP_UTF8, 0, string, len, wp, size+1);
|
||||
if (len == -1) --size; /* account for 0-byte at string end */
|
||||
Tcl_DStringSetLength(dsPtr, 2*size);
|
||||
wp[size] = 0;
|
||||
return wp;
|
||||
#else
|
||||
return (TCHAR *) Tcl_UtfToExternalDString(winTCharEncoding,
|
||||
string, len, dsPtr);
|
||||
#endif
|
||||
if (!string) {
|
||||
return NULL;
|
||||
}
|
||||
return Tcl_UtfToUniCharDString(string, len, dsPtr);
|
||||
}
|
||||
|
||||
char *
|
||||
@@ -591,26 +562,16 @@ Tcl_WinTCharToUtf(
|
||||
Tcl_DString *dsPtr) /* Uninitialized or free DString in which the
|
||||
* converted string is stored. */
|
||||
{
|
||||
#if TCL_UTF_MAX > 3
|
||||
char *p;
|
||||
int size;
|
||||
|
||||
if (len > 0) {
|
||||
Tcl_DStringInit(dsPtr);
|
||||
if (!string) {
|
||||
return NULL;
|
||||
}
|
||||
if (len < 0) {
|
||||
len = wcslen(string);
|
||||
} else {
|
||||
len /= 2;
|
||||
}
|
||||
size = WideCharToMultiByte(CP_UTF8, 0, string, len, 0, 0, NULL, NULL);
|
||||
Tcl_DStringInit(dsPtr);
|
||||
Tcl_DStringSetLength(dsPtr, size+1);
|
||||
p = (char *)Tcl_DStringValue(dsPtr);
|
||||
WideCharToMultiByte(CP_UTF8, 0, string, len, p, size, NULL, NULL);
|
||||
if (len == -1) --size; /* account for 0-byte at string end */
|
||||
Tcl_DStringSetLength(dsPtr, size);
|
||||
p[size] = 0;
|
||||
return p;
|
||||
#else
|
||||
return Tcl_ExternalToUtfDString(winTCharEncoding,
|
||||
(const char *) string, len, dsPtr);
|
||||
#endif
|
||||
return Tcl_UniCharToUtfDString(string, len, dsPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
+180
-139
@@ -17,15 +17,7 @@
|
||||
#include "tclInt.h"
|
||||
#include <dde.h>
|
||||
#include <ddeml.h>
|
||||
|
||||
#ifndef UNICODE
|
||||
# undef CP_WINUNICODE
|
||||
# define CP_WINUNICODE CP_WINANSI
|
||||
# undef Tcl_WinTCharToUtf
|
||||
# define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c)
|
||||
# undef Tcl_WinUtfToTChar
|
||||
# define Tcl_WinUtfToTChar(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c)
|
||||
#endif
|
||||
#include <tchar.h>
|
||||
|
||||
#if !defined(NDEBUG)
|
||||
/* test POKE server Implemented for debug mode only */
|
||||
@@ -33,16 +25,6 @@
|
||||
# define CBF_FAIL_POKES 0
|
||||
#endif
|
||||
|
||||
/*
|
||||
* TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the Dde_Init
|
||||
* declaration is in the source file itself, which is only accessed when we
|
||||
* are building a library. DO NOT MOVE BEFORE ANY #include LINES. ONLY USE
|
||||
* EXTERN TO INDICATE EXPORTED FUNCTIONS FROM NOW ON.
|
||||
*/
|
||||
|
||||
#undef TCL_STORAGE_CLASS
|
||||
#define TCL_STORAGE_CLASS DLLEXPORT
|
||||
|
||||
/*
|
||||
* The following structure is used to keep track of the interpreters
|
||||
* registered by this process.
|
||||
@@ -69,7 +51,7 @@ typedef struct Conversation {
|
||||
Tcl_Obj *returnPackagePtr; /* The result package for this conversation. */
|
||||
} Conversation;
|
||||
|
||||
typedef struct DdeEnumServices {
|
||||
typedef struct {
|
||||
Tcl_Interp *interp;
|
||||
int result;
|
||||
ATOM service;
|
||||
@@ -77,7 +59,7 @@ typedef struct DdeEnumServices {
|
||||
HWND hwnd;
|
||||
} DdeEnumServices;
|
||||
|
||||
typedef struct ThreadSpecificData {
|
||||
typedef struct {
|
||||
Conversation *currentConversations;
|
||||
/* A list of conversations currently being
|
||||
* processed. */
|
||||
@@ -97,7 +79,7 @@ static DWORD ddeInstance; /* The application instance handle given to us
|
||||
* by DdeInitialize. */
|
||||
static int ddeIsServer = 0;
|
||||
|
||||
#define TCL_DDE_VERSION "1.4.0"
|
||||
#define TCL_DDE_VERSION "1.4.1"
|
||||
#define TCL_DDE_PACKAGE_NAME "dde"
|
||||
#define TCL_DDE_SERVICE_NAME TEXT("TclEval")
|
||||
#define TCL_DDE_EXECUTE_RESULT TEXT("$TCLEVAL$EXECUTE$RESULT")
|
||||
@@ -114,7 +96,7 @@ TCL_DECLARE_MUTEX(ddeMutex)
|
||||
|
||||
static LRESULT CALLBACK DdeClientWindowProc(HWND hwnd, UINT uMsg,
|
||||
WPARAM wParam, LPARAM lParam);
|
||||
static int DdeCreateClient(struct DdeEnumServices *es);
|
||||
static int DdeCreateClient(DdeEnumServices *es);
|
||||
static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget,
|
||||
LPARAM lParam);
|
||||
static void DdeExitProc(ClientData clientData);
|
||||
@@ -135,8 +117,27 @@ static int DdeObjCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
|
||||
EXTERN int Dde_Init(Tcl_Interp *interp);
|
||||
EXTERN int Dde_SafeInit(Tcl_Interp *interp);
|
||||
static unsigned char *
|
||||
getByteArrayFromObj(
|
||||
Tcl_Obj *objPtr,
|
||||
size_t *lengthPtr
|
||||
) {
|
||||
int length;
|
||||
|
||||
unsigned char *result = Tcl_GetByteArrayFromObj(objPtr, &length);
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
if (sizeof(TCL_HASH_TYPE) > sizeof(int)) {
|
||||
/* 64-bit and TIP #494 situation: */
|
||||
*lengthPtr = *(TCL_HASH_TYPE *) objPtr->internalRep.twoPtrValue.ptr1;
|
||||
} else
|
||||
#endif
|
||||
/* 32-bit or without TIP #494 */
|
||||
*lengthPtr = (size_t) (unsigned) length;
|
||||
return result;
|
||||
}
|
||||
|
||||
DLLEXPORT int Dde_Init(Tcl_Interp *interp);
|
||||
DLLEXPORT int Dde_SafeInit(Tcl_Interp *interp);
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -162,13 +163,6 @@ Dde_Init(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
#ifdef UNICODE
|
||||
if (TclWinGetPlatformId() < VER_PLATFORM_WIN32_NT) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"Win32s and Windows 9x are not supported platforms", -1));
|
||||
return TCL_ERROR;
|
||||
}
|
||||
#endif
|
||||
Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL);
|
||||
Tcl_CreateExitHandler(DdeExitProc, NULL);
|
||||
return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION);
|
||||
@@ -399,7 +393,7 @@ DdeSetServerName(
|
||||
Tcl_DString ds;
|
||||
|
||||
Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr);
|
||||
Tcl_WinUtfToTChar(Tcl_GetString(namePtr), -1, &ds);
|
||||
Tcl_WinUtfToTChar(Tcl_GetString(namePtr), -1, &ds);
|
||||
if (_tcscmp(actualName, (TCHAR *)Tcl_DStringValue(&ds)) == 0) {
|
||||
suffix++;
|
||||
Tcl_DStringFree(&ds);
|
||||
@@ -414,9 +408,9 @@ DdeSetServerName(
|
||||
* We have found a unique name. Now add it to the registry.
|
||||
*/
|
||||
|
||||
riPtr = ckalloc(sizeof(RegisteredInterp));
|
||||
riPtr = (RegisteredInterp *) Tcl_Alloc(sizeof(RegisteredInterp));
|
||||
riPtr->interp = interp;
|
||||
riPtr->name = ckalloc((_tcslen(actualName) + 1) * sizeof(TCHAR));
|
||||
riPtr->name = (TCHAR *) Tcl_Alloc((_tcslen(actualName) + 1) * sizeof(TCHAR));
|
||||
riPtr->nextPtr = tsdPtr->interpListPtr;
|
||||
riPtr->handlerPtr = handlerPtr;
|
||||
if (riPtr->handlerPtr != NULL) {
|
||||
@@ -517,7 +511,7 @@ DeleteProc(
|
||||
prevPtr->nextPtr = searchPtr->nextPtr;
|
||||
}
|
||||
}
|
||||
ckfree(riPtr->name);
|
||||
Tcl_Free((char *) riPtr->name);
|
||||
if (riPtr->handlerPtr) {
|
||||
Tcl_DecrRefCount(riPtr->handlerPtr);
|
||||
}
|
||||
@@ -555,7 +549,7 @@ ExecuteRemoteObject(
|
||||
Tcl_Obj *returnPackagePtr;
|
||||
int result = TCL_OK;
|
||||
|
||||
if (riPtr->handlerPtr == NULL && Tcl_IsSafe(riPtr->interp)) {
|
||||
if ((riPtr->handlerPtr == NULL) && Tcl_IsSafe(riPtr->interp)) {
|
||||
Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj("permission denied: "
|
||||
"a handler procedure must be defined for use in a safe "
|
||||
"interp", -1));
|
||||
@@ -637,7 +631,7 @@ DdeServerProc(
|
||||
/* Transaction-dependent data. */
|
||||
{
|
||||
Tcl_DString dString;
|
||||
int len;
|
||||
size_t len;
|
||||
DWORD dlen;
|
||||
TCHAR *utilString;
|
||||
Tcl_Obj *ddeObjectPtr;
|
||||
@@ -687,7 +681,7 @@ DdeServerProc(
|
||||
for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
|
||||
riPtr = riPtr->nextPtr) {
|
||||
if (_tcsicmp(riPtr->name, utilString) == 0) {
|
||||
convPtr = ckalloc(sizeof(Conversation));
|
||||
convPtr = (Conversation *) Tcl_Alloc(sizeof(Conversation));
|
||||
convPtr->nextPtr = tsdPtr->currentConversations;
|
||||
convPtr->returnPackagePtr = NULL;
|
||||
convPtr->hConv = hConv;
|
||||
@@ -717,7 +711,7 @@ DdeServerProc(
|
||||
if (convPtr->returnPackagePtr != NULL) {
|
||||
Tcl_DecrRefCount(convPtr->returnPackagePtr);
|
||||
}
|
||||
ckfree(convPtr);
|
||||
Tcl_Free((char *) convPtr);
|
||||
break;
|
||||
}
|
||||
}
|
||||
@@ -743,22 +737,24 @@ DdeServerProc(
|
||||
}
|
||||
|
||||
if (convPtr != NULL) {
|
||||
Tcl_DString dsBuf;
|
||||
char *returnString;
|
||||
|
||||
len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE);
|
||||
Tcl_DStringInit(&dString);
|
||||
Tcl_DStringInit(&dsBuf);
|
||||
Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
|
||||
utilString = (TCHAR *) Tcl_DStringValue(&dString);
|
||||
DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1,
|
||||
CP_WINUNICODE);
|
||||
if (_tcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) {
|
||||
if (uFmt == CF_TEXT) {
|
||||
returnString =
|
||||
Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);
|
||||
} else {
|
||||
returnString = (char *)
|
||||
Tcl_GetUnicodeFromObj(convPtr->returnPackagePtr, &len);
|
||||
len = sizeof(TCHAR) * len + 1;
|
||||
returnString =
|
||||
Tcl_GetString(convPtr->returnPackagePtr);
|
||||
len = convPtr->returnPackagePtr->length;
|
||||
if (uFmt != CF_TEXT) {
|
||||
Tcl_WinUtfToTChar(returnString, len, &dsBuf);
|
||||
returnString = Tcl_DStringValue(&dsBuf);
|
||||
len = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR) - 1;
|
||||
}
|
||||
ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString,
|
||||
(DWORD) len+1, 0, ddeItem, uFmt, 0);
|
||||
@@ -768,18 +764,18 @@ DdeServerProc(
|
||||
} else {
|
||||
Tcl_DString ds;
|
||||
Tcl_Obj *variableObjPtr;
|
||||
|
||||
Tcl_WinTCharToUtf(utilString, -1, &ds);
|
||||
variableObjPtr = Tcl_GetVar2Ex(
|
||||
convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL,
|
||||
TCL_GLOBAL_ONLY);
|
||||
if (variableObjPtr != NULL) {
|
||||
if (uFmt == CF_TEXT) {
|
||||
returnString = Tcl_GetStringFromObj(
|
||||
variableObjPtr, &len);
|
||||
} else {
|
||||
returnString = (char *) Tcl_GetUnicodeFromObj(
|
||||
variableObjPtr, &len);
|
||||
len = sizeof(TCHAR) * len + 1;
|
||||
returnString = Tcl_GetString(variableObjPtr);
|
||||
len = variableObjPtr->length;
|
||||
if (uFmt != CF_TEXT) {
|
||||
Tcl_WinUtfToTChar(returnString, len, &dsBuf);
|
||||
returnString = Tcl_DStringValue(&dsBuf);
|
||||
len = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR) - 1;
|
||||
}
|
||||
ddeReturn = DdeCreateDataHandle(ddeInstance,
|
||||
(BYTE *)returnString, (DWORD) len+1, 0, ddeItem,
|
||||
@@ -790,6 +786,7 @@ DdeServerProc(
|
||||
Tcl_DStringFree(&ds);
|
||||
}
|
||||
}
|
||||
Tcl_DStringFree(&dsBuf);
|
||||
Tcl_DStringFree(&dString);
|
||||
}
|
||||
return ddeReturn;
|
||||
@@ -814,26 +811,30 @@ DdeServerProc(
|
||||
}
|
||||
|
||||
if (convPtr && !Tcl_IsSafe(convPtr->riPtr->interp)) {
|
||||
Tcl_DString ds;
|
||||
Tcl_DString ds, ds2;
|
||||
Tcl_Obj *variableObjPtr;
|
||||
DWORD len2;
|
||||
|
||||
len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE);
|
||||
Tcl_DStringInit(&dString);
|
||||
Tcl_DStringInit(&ds2);
|
||||
len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE);
|
||||
Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
|
||||
utilString = (TCHAR *) Tcl_DStringValue(&dString);
|
||||
DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1,
|
||||
CP_WINUNICODE);
|
||||
Tcl_WinTCharToUtf(utilString, -1, &ds);
|
||||
utilString = (TCHAR *) DdeAccessData(hData, &dlen);
|
||||
if (uFmt == CF_TEXT) {
|
||||
variableObjPtr = Tcl_NewStringObj((char *)utilString, -1);
|
||||
} else {
|
||||
variableObjPtr = Tcl_NewUnicodeObj(utilString, -1);
|
||||
utilString = (TCHAR *) DdeAccessData(hData, &len2);
|
||||
len = len2;
|
||||
if (uFmt != CF_TEXT) {
|
||||
Tcl_WinTCharToUtf(utilString, -1, &ds2);
|
||||
utilString = (TCHAR *) Tcl_DStringValue(&ds2);
|
||||
}
|
||||
variableObjPtr = Tcl_NewStringObj((char *)utilString, -1);
|
||||
|
||||
Tcl_SetVar2Ex(convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL,
|
||||
variableObjPtr, TCL_GLOBAL_ONLY);
|
||||
|
||||
Tcl_DStringFree(&ds2);
|
||||
Tcl_DStringFree(&ds);
|
||||
Tcl_DStringFree(&dString);
|
||||
ddeReturn = (HDDEDATA) DDE_FACK;
|
||||
@@ -874,8 +875,12 @@ DdeServerProc(
|
||||
ddeObjectPtr = Tcl_NewStringObj(string, dlen);
|
||||
} else {
|
||||
/* unicode */
|
||||
dlen >>= 1;
|
||||
ddeObjectPtr = Tcl_NewUnicodeObj((Tcl_UniChar *)utilString, dlen - 1);
|
||||
Tcl_DString dsBuf;
|
||||
|
||||
Tcl_WinTCharToUtf(utilString, dlen - sizeof(TCHAR), &dsBuf);
|
||||
ddeObjectPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf),
|
||||
Tcl_DStringLength(&dsBuf));
|
||||
Tcl_DStringFree(&dsBuf);
|
||||
}
|
||||
Tcl_IncrRefCount(ddeObjectPtr);
|
||||
DdeUnaccessData(hData);
|
||||
@@ -1040,7 +1045,7 @@ MakeDdeConnection(
|
||||
|
||||
static int
|
||||
DdeCreateClient(
|
||||
struct DdeEnumServices *es)
|
||||
DdeEnumServices *es)
|
||||
{
|
||||
WNDCLASSEX wc;
|
||||
static const TCHAR *szDdeClientClassName = TEXT("TclEval client class");
|
||||
@@ -1050,7 +1055,7 @@ DdeCreateClient(
|
||||
wc.cbSize = sizeof(wc);
|
||||
wc.lpfnWndProc = DdeClientWindowProc;
|
||||
wc.lpszClassName = szDdeClientClassName;
|
||||
wc.cbWndExtra = sizeof(struct DdeEnumServices *);
|
||||
wc.cbWndExtra = sizeof(DdeEnumServices *);
|
||||
|
||||
/*
|
||||
* Register and create the callback window.
|
||||
@@ -1072,8 +1077,8 @@ DdeClientWindowProc(
|
||||
switch (uMsg) {
|
||||
case WM_CREATE: {
|
||||
LPCREATESTRUCT lpcs = (LPCREATESTRUCT) lParam;
|
||||
struct DdeEnumServices *es =
|
||||
(struct DdeEnumServices *) lpcs->lpCreateParams;
|
||||
DdeEnumServices *es =
|
||||
(DdeEnumServices *) lpcs->lpCreateParams;
|
||||
|
||||
#ifdef _WIN64
|
||||
SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR) es);
|
||||
@@ -1098,18 +1103,18 @@ DdeServicesOnAck(
|
||||
HWND hwndRemote = (HWND)wParam;
|
||||
ATOM service = (ATOM)LOWORD(lParam);
|
||||
ATOM topic = (ATOM)HIWORD(lParam);
|
||||
struct DdeEnumServices *es;
|
||||
DdeEnumServices *es;
|
||||
TCHAR sz[255];
|
||||
Tcl_DString dString;
|
||||
|
||||
#ifdef _WIN64
|
||||
es = (struct DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA);
|
||||
es = (DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA);
|
||||
#else
|
||||
es = (struct DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA);
|
||||
es = (DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA);
|
||||
#endif
|
||||
|
||||
if ((es->service == (ATOM)0 || es->service == service)
|
||||
&& (es->topic == (ATOM)0 || es->topic == topic)) {
|
||||
if (((es->service == (ATOM)0) || (es->service == service))
|
||||
&& ((es->topic == (ATOM)0) || (es->topic == topic))) {
|
||||
Tcl_Obj *matchPtr = Tcl_NewListObj(0, NULL);
|
||||
Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp);
|
||||
|
||||
@@ -1156,7 +1161,7 @@ DdeEnumWindowsCallback(
|
||||
LPARAM lParam)
|
||||
{
|
||||
DWORD_PTR dwResult = 0;
|
||||
struct DdeEnumServices *es = (struct DdeEnumServices *) lParam;
|
||||
DdeEnumServices *es = (DdeEnumServices *) lParam;
|
||||
|
||||
SendMessageTimeout(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd,
|
||||
MAKELONG(es->service, es->topic), SMTO_ABORTIFHUNG, 1000,
|
||||
@@ -1170,7 +1175,7 @@ DdeGetServicesList(
|
||||
const TCHAR *serviceName,
|
||||
const TCHAR *topicName)
|
||||
{
|
||||
struct DdeEnumServices es;
|
||||
DdeEnumServices es;
|
||||
|
||||
es.interp = interp;
|
||||
es.result = TCL_OK;
|
||||
@@ -1291,7 +1296,8 @@ DdeObjCmd(
|
||||
"-binary", NULL
|
||||
};
|
||||
|
||||
int index, i, length, argIndex;
|
||||
int index, i, argIndex;
|
||||
size_t length;
|
||||
int flags = 0, result = TCL_OK, firstArg = 0;
|
||||
HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL;
|
||||
HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn;
|
||||
@@ -1300,6 +1306,7 @@ DdeObjCmd(
|
||||
const char *string;
|
||||
DWORD ddeResult;
|
||||
Tcl_Obj *objPtr, *handlerPtr = NULL;
|
||||
Tcl_DString serviceBuf, topicBuf, itemBuf;
|
||||
|
||||
/*
|
||||
* Initialize DDE server/client
|
||||
@@ -1315,6 +1322,9 @@ DdeObjCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
Tcl_DStringInit(&serviceBuf);
|
||||
Tcl_DStringInit(&topicBuf);
|
||||
Tcl_DStringInit(&itemBuf);
|
||||
switch ((enum DdeSubcommands) index) {
|
||||
case DDE_SERVERNAME:
|
||||
for (i = 2; i < objc; i++) {
|
||||
@@ -1364,7 +1374,7 @@ DdeObjCmd(
|
||||
if (objc == 5) {
|
||||
firstArg = 2;
|
||||
break;
|
||||
} else if (objc >= 6 && objc <= 7) {
|
||||
} else if ((objc >= 6) && (objc <= 7)) {
|
||||
firstArg = objc - 3;
|
||||
for (i = 2; i < firstArg; i++) {
|
||||
if (Tcl_GetIndexFromObj(interp, objv[i], ddeExecOptions,
|
||||
@@ -1449,11 +1459,12 @@ DdeObjCmd(
|
||||
Initialize();
|
||||
|
||||
if (firstArg != 1) {
|
||||
#ifdef UNICODE
|
||||
serviceName = Tcl_GetUnicodeFromObj(objv[firstArg], &length);
|
||||
#else
|
||||
serviceName = Tcl_GetStringFromObj(objv[firstArg], &length);
|
||||
#endif
|
||||
const char *src = Tcl_GetString(objv[firstArg]);
|
||||
|
||||
length = objv[firstArg]->length;
|
||||
Tcl_WinUtfToTChar(src, length, &serviceBuf);
|
||||
serviceName = (TCHAR *) Tcl_DStringValue(&serviceBuf);
|
||||
length = Tcl_DStringLength(&serviceBuf) / sizeof(TCHAR);
|
||||
} else {
|
||||
length = 0;
|
||||
}
|
||||
@@ -1466,11 +1477,11 @@ DdeObjCmd(
|
||||
}
|
||||
|
||||
if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
|
||||
#ifdef UNICODE
|
||||
topicName = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 1], &length);
|
||||
#else
|
||||
topicName = Tcl_GetStringFromObj(objv[firstArg + 1], &length);
|
||||
#endif
|
||||
const char *src = Tcl_GetString(objv[firstArg + 1]);
|
||||
|
||||
length = objv[firstArg + 1]->length;
|
||||
topicName = Tcl_WinUtfToTChar(src, length, &topicBuf);
|
||||
length = Tcl_DStringLength(&topicBuf) / sizeof(TCHAR);
|
||||
if (length == 0) {
|
||||
topicName = NULL;
|
||||
} else {
|
||||
@@ -1484,32 +1495,40 @@ DdeObjCmd(
|
||||
serviceName = DdeSetServerName(interp, serviceName, flags,
|
||||
handlerPtr);
|
||||
if (serviceName != NULL) {
|
||||
#ifdef UNICODE
|
||||
Tcl_SetObjResult(interp, Tcl_NewUnicodeObj((Tcl_UniChar *) serviceName, -1));
|
||||
#else
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(serviceName, -1));
|
||||
#endif
|
||||
Tcl_DString dsBuf;
|
||||
|
||||
Tcl_WinTCharToUtf(serviceName, -1, &dsBuf);
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_DStringValue(&dsBuf),
|
||||
Tcl_DStringLength(&dsBuf)));
|
||||
Tcl_DStringFree(&dsBuf);
|
||||
} else {
|
||||
Tcl_ResetResult(interp);
|
||||
}
|
||||
break;
|
||||
|
||||
case DDE_EXECUTE: {
|
||||
int dataLength;
|
||||
const Tcl_UniChar *dataString;
|
||||
size_t dataLength;
|
||||
const void *dataString;
|
||||
Tcl_DString dsBuf;
|
||||
|
||||
Tcl_DStringInit(&dsBuf);
|
||||
if (flags & DDE_FLAG_BINARY) {
|
||||
dataString = (const Tcl_UniChar *)
|
||||
Tcl_GetByteArrayFromObj(objv[firstArg + 2], &dataLength);
|
||||
} else {
|
||||
dataString =
|
||||
Tcl_GetUnicodeFromObj(objv[firstArg + 2], &dataLength);
|
||||
dataLength = (dataLength + 1) * sizeof(Tcl_UniChar);
|
||||
getByteArrayFromObj(objv[firstArg + 2], &dataLength);
|
||||
} else {
|
||||
const char *src;
|
||||
|
||||
src = Tcl_GetString(objv[firstArg + 2]);
|
||||
dataLength = objv[firstArg + 2]->length;
|
||||
dataString = (const TCHAR *)
|
||||
Tcl_WinUtfToTChar(src, dataLength, &dsBuf);
|
||||
dataLength = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR);
|
||||
}
|
||||
|
||||
if (dataLength <= 0) {
|
||||
if (dataLength + 1 < 2) {
|
||||
Tcl_SetObjResult(interp,
|
||||
Tcl_NewStringObj("cannot execute null data", -1));
|
||||
Tcl_DStringFree(&dsBuf);
|
||||
Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
|
||||
result = TCL_ERROR;
|
||||
break;
|
||||
@@ -1519,6 +1538,7 @@ DdeObjCmd(
|
||||
DdeFreeStringHandle(ddeInstance, ddeTopic);
|
||||
|
||||
if (hConv == NULL) {
|
||||
Tcl_DStringFree(&dsBuf);
|
||||
SetDdeError(interp);
|
||||
result = TCL_ERROR;
|
||||
break;
|
||||
@@ -1544,16 +1564,17 @@ DdeObjCmd(
|
||||
SetDdeError(interp);
|
||||
result = TCL_ERROR;
|
||||
}
|
||||
Tcl_DStringFree(&dsBuf);
|
||||
break;
|
||||
}
|
||||
case DDE_REQUEST: {
|
||||
#ifdef UNICODE
|
||||
const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2],
|
||||
&length);
|
||||
#else
|
||||
const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2],
|
||||
&length);
|
||||
#endif
|
||||
const TCHAR *itemString;
|
||||
const char *src;
|
||||
|
||||
src = Tcl_GetString(objv[firstArg + 2]);
|
||||
length = objv[firstArg + 2]->length;
|
||||
itemString = Tcl_WinUtfToTChar(src, length, &itemBuf);
|
||||
length = Tcl_DStringLength(&itemBuf) / sizeof(TCHAR);
|
||||
|
||||
if (length == 0) {
|
||||
Tcl_SetObjResult(interp,
|
||||
@@ -1581,18 +1602,23 @@ DdeObjCmd(
|
||||
result = TCL_ERROR;
|
||||
} else {
|
||||
DWORD tmp;
|
||||
const Tcl_UniChar *dataString = (const Tcl_UniChar *) DdeAccessData(ddeData, &tmp);
|
||||
TCHAR *dataString = (TCHAR *) DdeAccessData(ddeData, &tmp);
|
||||
|
||||
if (flags & DDE_FLAG_BINARY) {
|
||||
returnObjPtr =
|
||||
Tcl_NewByteArrayObj((BYTE *) dataString, (int) tmp);
|
||||
Tcl_NewByteArrayObj((BYTE *) dataString, tmp);
|
||||
} else {
|
||||
tmp >>= 1;
|
||||
if (tmp && !dataString[(tmp-1)]) {
|
||||
--tmp;
|
||||
Tcl_DString dsBuf;
|
||||
|
||||
if ((tmp >= sizeof(TCHAR))
|
||||
&& !dataString[tmp / sizeof(TCHAR) - 1]) {
|
||||
tmp -= sizeof(TCHAR);
|
||||
}
|
||||
returnObjPtr = Tcl_NewUnicodeObj(dataString,
|
||||
(int) tmp);
|
||||
Tcl_WinTCharToUtf(dataString, tmp, &dsBuf);
|
||||
returnObjPtr =
|
||||
Tcl_NewStringObj(Tcl_DStringValue(&dsBuf),
|
||||
Tcl_DStringLength(&dsBuf));
|
||||
Tcl_DStringFree(&dsBuf);
|
||||
}
|
||||
DdeUnaccessData(ddeData);
|
||||
DdeFreeDataHandle(ddeData);
|
||||
@@ -1603,19 +1629,18 @@ DdeObjCmd(
|
||||
result = TCL_ERROR;
|
||||
}
|
||||
}
|
||||
|
||||
break;
|
||||
}
|
||||
case DDE_POKE: {
|
||||
#ifdef UNICODE
|
||||
const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2],
|
||||
&length);
|
||||
#else
|
||||
const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2],
|
||||
&length);
|
||||
#endif
|
||||
Tcl_DString dsBuf;
|
||||
const TCHAR *itemString;
|
||||
BYTE *dataString;
|
||||
const char *src;
|
||||
|
||||
src = Tcl_GetString(objv[firstArg + 2]);
|
||||
length = objv[firstArg + 2]->length;
|
||||
itemString = Tcl_WinUtfToTChar(src, length, &itemBuf);
|
||||
length = Tcl_DStringLength(&itemBuf) / sizeof(TCHAR);
|
||||
if (length == 0) {
|
||||
Tcl_SetObjResult(interp,
|
||||
Tcl_NewStringObj("cannot have a null item", -1));
|
||||
@@ -1623,13 +1648,17 @@ DdeObjCmd(
|
||||
result = TCL_ERROR;
|
||||
goto cleanup;
|
||||
}
|
||||
Tcl_DStringInit(&dsBuf);
|
||||
if (flags & DDE_FLAG_BINARY) {
|
||||
dataString = (BYTE *)
|
||||
Tcl_GetByteArrayFromObj(objv[firstArg + 3], &length);
|
||||
getByteArrayFromObj(objv[firstArg + 3], &length);
|
||||
} else {
|
||||
const char *data =
|
||||
Tcl_GetString(objv[firstArg + 3]);
|
||||
length = objv[firstArg + 3]->length;
|
||||
dataString = (BYTE *)
|
||||
Tcl_GetUnicodeFromObj(objv[firstArg + 3], &length);
|
||||
length = 2 * length + 1;
|
||||
Tcl_WinUtfToTChar(data, length, &dsBuf);
|
||||
length = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR);
|
||||
}
|
||||
|
||||
hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
|
||||
@@ -1654,6 +1683,7 @@ DdeObjCmd(
|
||||
result = TCL_ERROR;
|
||||
}
|
||||
}
|
||||
Tcl_DStringFree(&dsBuf);
|
||||
break;
|
||||
}
|
||||
|
||||
@@ -1712,7 +1742,7 @@ DdeObjCmd(
|
||||
* referring to deallocated objects.
|
||||
*/
|
||||
|
||||
if (Tcl_IsSafe(riPtr->interp) && riPtr->handlerPtr == NULL) {
|
||||
if (Tcl_IsSafe(riPtr->interp) && (riPtr->handlerPtr == NULL)) {
|
||||
Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj(
|
||||
"permission denied: a handler procedure must be"
|
||||
" defined for use in a safe interp", -1));
|
||||
@@ -1757,8 +1787,7 @@ DdeObjCmd(
|
||||
objPtr = Tcl_GetVar2Ex(sendInterp, "errorInfo", NULL,
|
||||
TCL_GLOBAL_ONLY);
|
||||
if (objPtr) {
|
||||
string = Tcl_GetStringFromObj(objPtr, &length);
|
||||
Tcl_AddObjErrorInfo(interp, string, length);
|
||||
Tcl_AppendObjToErrorInfo(interp, objPtr);
|
||||
}
|
||||
|
||||
objPtr = Tcl_GetVar2Ex(sendInterp, "errorCode", NULL,
|
||||
@@ -1772,6 +1801,8 @@ DdeObjCmd(
|
||||
Tcl_Release(riPtr);
|
||||
Tcl_Release(sendInterp);
|
||||
} else {
|
||||
Tcl_DString dsBuf;
|
||||
|
||||
/*
|
||||
* This is a non-local request. Send the script to the server and
|
||||
* poll it for a result.
|
||||
@@ -1787,9 +1818,14 @@ DdeObjCmd(
|
||||
}
|
||||
|
||||
objPtr = Tcl_ConcatObj(objc, objv);
|
||||
string = (const char *) Tcl_GetUnicodeFromObj(objPtr, &length);
|
||||
ddeItemData = DdeCreateDataHandle(ddeInstance,
|
||||
(BYTE *) string, (DWORD) 2*length+2, 0, 0, CF_UNICODETEXT, 0);
|
||||
string = Tcl_GetString(objPtr);
|
||||
length = objPtr->length;
|
||||
Tcl_WinUtfToTChar(string, length, &dsBuf);
|
||||
string = Tcl_DStringValue(&dsBuf);
|
||||
length = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR);
|
||||
ddeItemData = DdeCreateDataHandle(ddeInstance, (BYTE *) string,
|
||||
(DWORD) length, 0, 0, CF_UNICODETEXT, 0);
|
||||
Tcl_DStringFree(&dsBuf);
|
||||
|
||||
if (flags & DDE_FLAG_ASYNC) {
|
||||
ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
|
||||
@@ -1818,7 +1854,7 @@ DdeObjCmd(
|
||||
|
||||
if (!(flags & DDE_FLAG_ASYNC)) {
|
||||
Tcl_Obj *resultPtr;
|
||||
Tcl_UniChar *ddeDataString;
|
||||
TCHAR *ddeDataString;
|
||||
|
||||
/*
|
||||
* The return handle has a two or four element list in it. The
|
||||
@@ -1829,13 +1865,17 @@ DdeObjCmd(
|
||||
* variable "errorInfo".
|
||||
*/
|
||||
|
||||
resultPtr = Tcl_NewObj();
|
||||
length = DdeGetData(ddeData, NULL, 0, 0);
|
||||
ddeDataString = ckalloc(length);
|
||||
ddeDataString = (TCHAR *) Tcl_Alloc(length);
|
||||
DdeGetData(ddeData, (BYTE *) ddeDataString, (DWORD) length, 0);
|
||||
length = (length >> 1) - 1;
|
||||
resultPtr = Tcl_NewUnicodeObj(ddeDataString, length);
|
||||
ckfree(ddeDataString);
|
||||
if (length > sizeof(TCHAR)) {
|
||||
length -= sizeof(TCHAR);
|
||||
}
|
||||
Tcl_WinTCharToUtf(ddeDataString, length, &dsBuf);
|
||||
resultPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf),
|
||||
Tcl_DStringLength(&dsBuf));
|
||||
Tcl_DStringFree(&dsBuf);
|
||||
Tcl_Free((char *) ddeDataString);
|
||||
|
||||
if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) != TCL_OK) {
|
||||
Tcl_DecrRefCount(resultPtr);
|
||||
@@ -1853,9 +1893,7 @@ DdeObjCmd(
|
||||
Tcl_DecrRefCount(resultPtr);
|
||||
goto invalidServerResponse;
|
||||
}
|
||||
length = -1;
|
||||
string = Tcl_GetStringFromObj(objPtr, &length);
|
||||
Tcl_AddObjErrorInfo(interp, string, length);
|
||||
Tcl_AppendObjToErrorInfo(interp, objPtr);
|
||||
|
||||
Tcl_ListObjIndex(NULL, resultPtr, 2, &objPtr);
|
||||
Tcl_SetObjErrorCode(interp, objPtr);
|
||||
@@ -1887,6 +1925,9 @@ DdeObjCmd(
|
||||
if (hConv != NULL) {
|
||||
DdeDisconnect(hConv);
|
||||
}
|
||||
Tcl_DStringFree(&itemBuf);
|
||||
Tcl_DStringFree(&topicBuf);
|
||||
Tcl_DStringFree(&serviceBuf);
|
||||
return result;
|
||||
}
|
||||
|
||||
|
||||
+3
-4
@@ -1026,7 +1026,8 @@ DoRemoveJustDirectory(
|
||||
|
||||
if (nativePath == NULL || nativePath[0] == '\0') {
|
||||
Tcl_SetErrno(ENOENT);
|
||||
goto end;
|
||||
Tcl_DStringInit(errorPtr);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
attr = GetFileAttributes(nativePath);
|
||||
@@ -1108,9 +1109,7 @@ DoRemoveJustDirectory(
|
||||
|
||||
end:
|
||||
if (errorPtr != NULL) {
|
||||
char *p;
|
||||
Tcl_WinTCharToUtf(nativePath, -1, errorPtr);
|
||||
p = Tcl_DStringValue(errorPtr);
|
||||
char *p = Tcl_WinTCharToUtf(nativePath, -1, errorPtr);
|
||||
for (; *p; ++p) {
|
||||
if (*p == '\\') *p = '/';
|
||||
}
|
||||
|
||||
Regular → Executable
+9
@@ -531,6 +531,11 @@ TclWinSymLinkDelete(
|
||||
*--------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#if defined (__clang__) || ((__GNUC__) && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5))))
|
||||
#pragma GCC diagnostic push
|
||||
#pragma GCC diagnostic ignored "-Warray-bounds"
|
||||
#endif
|
||||
|
||||
static Tcl_Obj *
|
||||
WinReadLinkDirectory(
|
||||
const TCHAR *linkDirPath)
|
||||
@@ -648,6 +653,10 @@ WinReadLinkDirectory(
|
||||
Tcl_SetErrno(EINVAL);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
#if defined (__clang__) || ((__GNUC__) && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5))))
|
||||
#pragma GCC diagnostic pop
|
||||
#endif
|
||||
|
||||
/*
|
||||
*--------------------------------------------------------------------
|
||||
|
||||
+4
-4
@@ -1495,10 +1495,10 @@ QuoteCmdLinePart(
|
||||
QuoteCmdLineBackslash(dsPtr, start, *bspos, NULL);
|
||||
start = *bspos;
|
||||
}
|
||||
/*
|
||||
* escape all special chars enclosed in quotes like `"..."`, note that here we
|
||||
/*
|
||||
* escape all special chars enclosed in quotes like `"..."`, note that here we
|
||||
* don't must escape `\` (with `\`), because it's outside of the main quotes,
|
||||
* so `\` remains `\`, but important - not at end of part, because results as
|
||||
* so `\` remains `\`, but important - not at end of part, because results as
|
||||
* before the quote, so `%\%\` should be escaped as `"%\%"\\`).
|
||||
*/
|
||||
TclDStringAppendLiteral(dsPtr, "\""); /* opening escape quote-char */
|
||||
@@ -1653,7 +1653,7 @@ BuildCommandLine(
|
||||
special++;
|
||||
}
|
||||
/* rest of argument (and escape backslashes before closing main quote) */
|
||||
QuoteCmdLineBackslash(&ds, start, special,
|
||||
QuoteCmdLineBackslash(&ds, start, special,
|
||||
(quote & CL_QUOTE) ? bspos : NULL);
|
||||
}
|
||||
if (quote & CL_QUOTE) {
|
||||
|
||||
+44
-43
@@ -22,13 +22,6 @@
|
||||
#endif
|
||||
#include <stdlib.h>
|
||||
|
||||
#ifndef UNICODE
|
||||
# undef Tcl_WinTCharToUtf
|
||||
# define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c)
|
||||
# undef Tcl_WinUtfToTChar
|
||||
# define Tcl_WinUtfToTChar(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c)
|
||||
#endif /* !UNICODE */
|
||||
|
||||
/*
|
||||
* Ensure that we can say which registry is being accessed.
|
||||
*/
|
||||
@@ -131,6 +124,25 @@ static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
|
||||
Tcl_Obj *valueNameObj, Tcl_Obj *dataObj,
|
||||
Tcl_Obj *typeObj, REGSAM mode);
|
||||
|
||||
static unsigned char *
|
||||
getByteArrayFromObj(
|
||||
Tcl_Obj *objPtr,
|
||||
size_t *lengthPtr
|
||||
) {
|
||||
int length;
|
||||
|
||||
unsigned char *result = Tcl_GetByteArrayFromObj(objPtr, &length);
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
if (sizeof(TCL_HASH_TYPE) > sizeof(int)) {
|
||||
/* 64-bit and TIP #494 situation: */
|
||||
*lengthPtr = *(TCL_HASH_TYPE *) objPtr->internalRep.twoPtrValue.ptr1;
|
||||
} else
|
||||
#endif
|
||||
/* 32-bit or without TIP #494 */
|
||||
*lengthPtr = (size_t) (unsigned) length;
|
||||
return result;
|
||||
}
|
||||
|
||||
DLLEXPORT int Registry_Init(Tcl_Interp *interp);
|
||||
DLLEXPORT int Registry_Unload(Tcl_Interp *interp, int flags);
|
||||
|
||||
@@ -163,7 +175,7 @@ Registry_Init(
|
||||
cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd,
|
||||
interp, DeleteCmd);
|
||||
Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd);
|
||||
return Tcl_PkgProvide(interp, "registry", "1.3.2");
|
||||
return Tcl_PkgProvide(interp, "registry", "1.3.3");
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -414,12 +426,12 @@ DeleteKey(
|
||||
*/
|
||||
|
||||
keyName = Tcl_GetString(keyNameObj);
|
||||
buffer = ckalloc(keyNameObj->length + 1);
|
||||
buffer = Tcl_Alloc(keyNameObj->length + 1);
|
||||
strcpy(buffer, keyName);
|
||||
|
||||
if (ParseKeyName(interp, buffer, &hostName, &rootKey,
|
||||
&keyName) != TCL_OK) {
|
||||
ckfree(buffer);
|
||||
Tcl_Free(buffer);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
@@ -427,7 +439,7 @@ DeleteKey(
|
||||
Tcl_SetObjResult(interp,
|
||||
Tcl_NewStringObj("bad key: cannot delete root keys", -1));
|
||||
Tcl_SetErrorCode(interp, "WIN_REG", "DEL_ROOT_KEY", NULL);
|
||||
ckfree(buffer);
|
||||
Tcl_Free(buffer);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
@@ -442,7 +454,7 @@ DeleteKey(
|
||||
mode |= KEY_ENUMERATE_SUB_KEYS | DELETE;
|
||||
result = OpenSubKey(hostName, rootKey, keyName, mode, 0, &subkey);
|
||||
if (result != ERROR_SUCCESS) {
|
||||
ckfree(buffer);
|
||||
Tcl_Free(buffer);
|
||||
if (result == ERROR_FILE_NOT_FOUND) {
|
||||
return TCL_OK;
|
||||
}
|
||||
@@ -470,7 +482,7 @@ DeleteKey(
|
||||
}
|
||||
|
||||
RegCloseKey(subkey);
|
||||
ckfree(buffer);
|
||||
Tcl_Free(buffer);
|
||||
return result;
|
||||
}
|
||||
|
||||
@@ -499,7 +511,6 @@ DeleteValue(
|
||||
{
|
||||
HKEY key;
|
||||
char *valueName;
|
||||
size_t length;
|
||||
DWORD result;
|
||||
Tcl_DString ds;
|
||||
|
||||
@@ -513,8 +524,7 @@ DeleteValue(
|
||||
}
|
||||
|
||||
valueName = Tcl_GetString(valueNameObj);
|
||||
length = valueNameObj->length;
|
||||
Tcl_WinUtfToTChar(valueName, length, &ds);
|
||||
Tcl_WinUtfToTChar(valueName, valueNameObj->length, &ds);
|
||||
result = RegDeleteValue(key, (const TCHAR *)Tcl_DStringValue(&ds));
|
||||
Tcl_DStringFree(&ds);
|
||||
if (result != ERROR_SUCCESS) {
|
||||
@@ -603,8 +613,7 @@ GetKeyNames(
|
||||
}
|
||||
break;
|
||||
}
|
||||
Tcl_WinTCharToUtf(buffer, bufSize * sizeof(TCHAR), &ds);
|
||||
name = Tcl_DStringValue(&ds);
|
||||
name = Tcl_WinTCharToUtf(buffer, bufSize * sizeof(TCHAR), &ds);
|
||||
if (pattern && !Tcl_StringMatch(name, pattern)) {
|
||||
Tcl_DStringFree(&ds);
|
||||
continue;
|
||||
@@ -655,7 +664,6 @@ GetType(
|
||||
Tcl_DString ds;
|
||||
const char *valueName;
|
||||
const TCHAR *nativeValue;
|
||||
size_t length;
|
||||
|
||||
/*
|
||||
* Attempt to open the key for reading.
|
||||
@@ -671,8 +679,7 @@ GetType(
|
||||
*/
|
||||
|
||||
valueName = Tcl_GetString(valueNameObj);
|
||||
length = valueNameObj->length;
|
||||
nativeValue = Tcl_WinUtfToTChar(valueName, length, &ds);
|
||||
nativeValue = Tcl_WinUtfToTChar(valueName, valueNameObj->length, &ds);
|
||||
result = RegQueryValueEx(key, nativeValue, NULL, &type,
|
||||
NULL, NULL);
|
||||
Tcl_DStringFree(&ds);
|
||||
@@ -728,7 +735,6 @@ GetValue(
|
||||
const TCHAR *nativeValue;
|
||||
DWORD result, length, type;
|
||||
Tcl_DString data, buf;
|
||||
size_t nameLen;
|
||||
|
||||
/*
|
||||
* Attempt to open the key for reading.
|
||||
@@ -754,8 +760,7 @@ GetValue(
|
||||
length = TCL_DSTRING_STATIC_SIZE/sizeof(TCHAR) - 1;
|
||||
|
||||
valueName = Tcl_GetString(valueNameObj);
|
||||
nameLen = valueNameObj->length;
|
||||
nativeValue = Tcl_WinUtfToTChar(valueName, nameLen, &buf);
|
||||
nativeValue = Tcl_WinUtfToTChar(valueName, valueNameObj->length, &buf);
|
||||
|
||||
result = RegQueryValueEx(key, nativeValue, NULL, &type,
|
||||
(BYTE *) Tcl_DStringValue(&data), &length);
|
||||
@@ -944,13 +949,11 @@ OpenKey(
|
||||
HKEY *keyPtr) /* Returned HKEY. */
|
||||
{
|
||||
char *keyName, *buffer, *hostName;
|
||||
size_t length;
|
||||
HKEY rootKey;
|
||||
DWORD result;
|
||||
|
||||
keyName = Tcl_GetString(keyNameObj);
|
||||
length = keyNameObj->length;
|
||||
buffer = ckalloc(length + 1);
|
||||
buffer = Tcl_Alloc(keyNameObj->length + 1);
|
||||
strcpy(buffer, keyName);
|
||||
|
||||
result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName);
|
||||
@@ -966,7 +969,7 @@ OpenKey(
|
||||
}
|
||||
}
|
||||
|
||||
ckfree(buffer);
|
||||
Tcl_Free(buffer);
|
||||
return result;
|
||||
}
|
||||
|
||||
@@ -1019,7 +1022,9 @@ OpenSubKey(
|
||||
* this key must be closed by the caller.
|
||||
*/
|
||||
|
||||
keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf);
|
||||
if (keyName) {
|
||||
keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf);
|
||||
}
|
||||
if (flags & REG_CREATE) {
|
||||
DWORD create;
|
||||
|
||||
@@ -1037,7 +1042,9 @@ OpenSubKey(
|
||||
result = RegOpenKeyEx(rootKey, (TCHAR *)keyName, 0, mode,
|
||||
keyPtr);
|
||||
}
|
||||
Tcl_DStringFree(&buf);
|
||||
if (keyName) {
|
||||
Tcl_DStringFree(&buf);
|
||||
}
|
||||
|
||||
/*
|
||||
* Be sure to close the root key since we are done with it now.
|
||||
@@ -1248,7 +1255,6 @@ SetValue(
|
||||
REGSAM mode) /* Mode flags to pass. */
|
||||
{
|
||||
int type;
|
||||
size_t length;
|
||||
DWORD result;
|
||||
HKEY key;
|
||||
const char *valueName;
|
||||
@@ -1269,8 +1275,7 @@ SetValue(
|
||||
}
|
||||
|
||||
valueName = Tcl_GetString(valueNameObj);
|
||||
length = valueNameObj->length;
|
||||
valueName = (char *) Tcl_WinUtfToTChar(valueName, length, &nameBuf);
|
||||
valueName = (char *) Tcl_WinUtfToTChar(valueName, valueNameObj->length, &nameBuf);
|
||||
|
||||
if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
|
||||
int value;
|
||||
@@ -1305,8 +1310,7 @@ SetValue(
|
||||
for (i = 0; i < objc; i++) {
|
||||
const char *bytes = Tcl_GetString(objv[i]);
|
||||
|
||||
length = objv[i]->length;
|
||||
Tcl_DStringAppend(&data, bytes, length);
|
||||
Tcl_DStringAppend(&data, bytes, objv[i]->length);
|
||||
|
||||
/*
|
||||
* Add a null character to separate this value from the next.
|
||||
@@ -1326,28 +1330,26 @@ SetValue(
|
||||
Tcl_DString buf;
|
||||
const char *data = Tcl_GetString(dataObj);
|
||||
|
||||
length = dataObj->length;
|
||||
data = (char *) Tcl_WinUtfToTChar(data, length, &buf);
|
||||
data = (char *) Tcl_WinUtfToTChar(data, dataObj->length, &buf);
|
||||
|
||||
/*
|
||||
* Include the null in the length, padding if needed for WCHAR.
|
||||
*/
|
||||
|
||||
Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1);
|
||||
length = Tcl_DStringLength(&buf) + 1;
|
||||
|
||||
result = RegSetValueEx(key, (TCHAR *) valueName, 0,
|
||||
(DWORD) type, (BYTE *) data, (DWORD) length);
|
||||
(DWORD) type, (BYTE *) data, (DWORD) Tcl_DStringLength(&buf) + 1);
|
||||
Tcl_DStringFree(&buf);
|
||||
} else {
|
||||
BYTE *data;
|
||||
int bytelength;
|
||||
size_t bytelength;
|
||||
|
||||
/*
|
||||
* Store binary data in the registry.
|
||||
*/
|
||||
|
||||
data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &bytelength);
|
||||
data = (BYTE *) getByteArrayFromObj(dataObj, &bytelength);
|
||||
result = RegSetValueEx(key, (TCHAR *) valueName, 0,
|
||||
(DWORD) type, data, (DWORD) bytelength);
|
||||
}
|
||||
@@ -1408,8 +1410,7 @@ BroadcastValue(
|
||||
}
|
||||
|
||||
str = Tcl_GetString(objv[0]);
|
||||
len = objv[0]->length;
|
||||
wstr = (WCHAR *) Tcl_WinUtfToTChar(str, len, &ds);
|
||||
wstr = (WCHAR *) Tcl_WinUtfToTChar(str, objv[0]->length, &ds);
|
||||
if (Tcl_DStringLength(&ds) == 0) {
|
||||
wstr = NULL;
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user