Tcl Source Code

Check-in [1de35d1115]

Overview
Comment: merge 8.6 Tarball | ZIP archive | SQL archive family | ancestors | sebres-8-6-clock-speedup-cr2 files | file ages | folders 1de35d1115ba9a7e6485db06a87a066c6c75871604b9b634a5be496a6eb0e25f sebres 2019-01-10 14:43:25
Context
 2019-01-10 14:43 merge 8.6 Leaf check-in: 1de35d1115 user: sebres tags: sebres-8-6-clock-speedup-cr2 13:55 avoid possible leaking on tzName-object in error case (most impossible resp. rarely, but nevertheles... check-in: 50703055aa user: sebres tags: sebres-8-6-clock-speedup-cr2 2019-01-09 10:01 closes [cc1e91552c]: fixes lrange instruction on empty not canonical list (and acc. within expansion... check-in: 9d24a1b9db user: sebres tags: core-8-6-branch
Changes

     > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > >  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138  sudo: false language: c matrix: include: - os: linux dist: trusty compiler: clang env: - BUILD_DIR=unix - os: linux dist: trusty compiler: clang env: - CFGOPT=--disable-shared - BUILD_DIR=unix - os: linux dist: trusty compiler: gcc env: - BUILD_DIR=unix - os: linux dist: trusty compiler: gcc env: - CFGOPT=--disable-shared - BUILD_DIR=unix - os: linux dist: trusty compiler: gcc-4.9 addons: apt: sources: - ubuntu-toolchain-r-test packages: - g++-4.9 env: - BUILD_DIR=unix - os: linux dist: trusty compiler: gcc-5 addons: apt: sources: - ubuntu-toolchain-r-test packages: - g++-5 env: - BUILD_DIR=unix - os: linux dist: trusty compiler: gcc-6 addons: apt: sources: - ubuntu-toolchain-r-test packages: - g++-6 env: - BUILD_DIR=unix - os: linux dist: trusty compiler: gcc-7 addons: apt: sources: - ubuntu-toolchain-r-test packages: - g++-7 env: - BUILD_DIR=unix - os: osx osx_image: xcode8 env: - BUILD_DIR=unix - os: osx osx_image: xcode8 env: - BUILD_DIR=macosx - NO_DIRECT_CONFIGURE=1 - os: osx osx_image: xcode9 env: - BUILD_DIR=macosx - NO_DIRECT_CONFIGURE=1 - os: osx osx_image: xcode10 env: - BUILD_DIR=macosx - NO_DIRECT_CONFIGURE=1 ### C builds not currently supported on Windows instances # - os: windows # env: # - BUILD_DIR=win ### ... so proxy with a Mingw cross-compile # Test with mingw-w64 (32 bit) - os: linux dist: trusty 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: - BUILD_DIR=win - CFGOPT=--host=i686-w64-mingw32 - NO_DIRECT_TEST=1 # Test with mingw-w64 (64 bit) - os: linux dist: trusty 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: - BUILD_DIR=win - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit" - NO_DIRECT_TEST=1 before_install: - export ERROR_ON_FAILURES=1 - cd ${BUILD_DIR} install: - test -n "$NO_DIRECT_CONFIGURE" || ./configure ${CFGOPT} script: - make # The styles=develop avoids some weird problems on OSX - test -n "$NO_DIRECT_TEST" || make test styles=develop 

Changes to ChangeLog.

 1 2 3 4 5 6 7 8 9 10  A NOTE ON THE CHANGELOG: Starting in early 2011, Tcl source code has been under the management of fossil, hosted at http://core.tcl.tk/tcl/ . Fossil presents a "Timeline" view of changes made that is superior in every way to a hand edited log file. Because of this, many Tcl developers are now out of the habit of maintaining this log file. You may still find useful things in it, but the Timeline is a better first place to look now. ============================================================================ 2013-09-19 Don Porter   |  1 2 3 4 5 6 7 8 9 10  A NOTE ON THE CHANGELOG: Starting in early 2011, Tcl source code has been under the management of fossil, hosted at https://core.tcl-lang.org/tcl/ . Fossil presents a "Timeline" view of changes made that is superior in every way to a hand edited log file. Because of this, many Tcl developers are now out of the habit of maintaining this log file. You may still find useful things in it, but the Timeline is a better first place to look now. ============================================================================ 2013-09-19 Don Porter 

 1 2 3 4 5 6 7 8 9 .. 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 .. 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 ... 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 ... 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 ... 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185  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 ................................................................................ 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 ................................................................................ 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, ................................................................................ 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. ................................................................................ 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 2 3 4 5 6 7 8 9 .. 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 .. 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 ... 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 ... 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 ... 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185  README: Tcl This is the Tcl 8.6.9 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 ................................................................................ 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-lang.org/ 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-lang.org/ 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-lang.org/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-lang.org/about/ There have been many Tcl books on the market. Many are mentioned in the Wiki: http://wiki.tcl-lang.org/_/ref?N=25206 To view the complete set of reference manual entries for Tcl 8.6 online, visit the URL: http://www.tcl-lang.org/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 ................................................................................ 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-lang.org/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, ................................................................................ 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-lang.org/ 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. ................................................................................ 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-lang.org/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-lang.org/training 9. Tracking Development ----------------------- Tcl is developed in public. To keep an eye on how Tcl is changing, see http://core.tcl-lang.org/ 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. 

Changes to changes.

 8826 8827 8828 8829 8830 8831 8832  2017-12-06 (bug)[ce3a21] file normalize failure when tail is empty (porter) 2017-12-08 (new)[TIP 477] nmake build system reform (nadkarni) 2017-12-19 (bug)[586e71] EvalObjv exception handling at level #0 (sebres,porter) --- Released 8.6.8, December 22, 2017 --- http://core.tcl.tk/tcl/ for details   > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > >  8826 8827 8828 8829 8830 8831 8832 8833 8834 8835 8836 8837 8838 8839 8840 8841 8842 8843 8844 8845 8846 8847 8848 8849 8850 8851 8852 8853 8854 8855 8856 8857 8858 8859 8860 8861 8862 8863 8864 8865 8866 8867 8868 8869 8870 8871 8872 8873 8874 8875 8876 8877 8878 8879 8880 8881 8882 8883 8884 8885 8886 8887 8888 8889 8890 8891 8892 8893 8894 8895 8896  2017-12-06 (bug)[ce3a21] file normalize failure when tail is empty (porter) 2017-12-08 (new)[TIP 477] nmake build system reform (nadkarni) 2017-12-19 (bug)[586e71] EvalObjv exception handling at level #0 (sebres,porter) --- Released 8.6.8, December 22, 2017 --- http://core.tcl.tk/tcl/ for details 2018-02-11 (enhance) stop blocking conversion of object to/from class (coulter) 2018-02-12 (enhance) NR-enable [package require] (coulter) 2018-02-14 (bug)[9fd5c6] crash in object deletion, test oo-11.5 (coulter) 2018-02-14 (bug)[3c32a3] crash deleting object with class mixed in (coulter) 2018-02-15 (platform) stop using -lieee, removed from glibc-2.27 (porter) ***POTENTIAL INCOMPATIBILITY for math programs that embed Tcl*** 2018-02-23 (bug)[8e6a9a] bad binary [string match], test string-11.55 (porter) 2018-03-05 (bug)[1873ea] repair multi-thread std channel init (sebres) 2018-03-09 (bug)[db36fa] broken bytecode for index values (porter) 2018-03-13 (bug) broken compiled [string replace], test string-14.19 (porter) 2018-03-14 (bug) [string trim*] engine crashed on invalid UTF (sebres) 2018-04-17 (bug) missing trace in compiled [array set], test var-20.11 (porter) 2018-04-22 (bug)[46a241] crash in unset array with search, var-13.[23] (goth) 2018-04-30 (bug)[27b682] race made [file delete] raise "no such file" (sebres) 2018-06-04 (bug)[925643] 32/64 cleanup of filesystem DIR operations (sebres) 2018-06-18 (bug) leaks in TclSetEnv and env cache (coulter) 2018-06-24 (bug)[3592747] [yieldto] dying namespace, tailcall-14.1 (coulter) 2018-07-09 (bug)[270f78] race in [file mkdir] (sebres) 2018-07-12 (bug)[3f7af0] [file delete] raised "permission denied" (sebres) 2018-07-26 (bug)[d051b7] overflow crash in [format] (sebres) 2018-08-29 revised quoting of [exec] args in generated command line (sebres) ***POTENTIAL INCOMPATIBILITY*** 2018-09-20 HTTP Keep-Alive with pipelined requests (nash) => http 2.9.0 2018-09-27 (new)[TIP 505] [lreplace] accepts all out of range indices (porter) 2018-10-04 (bug) Prevent crash from NULL keyName (nijtmans) => registry 1.3.3 2018-10-26 (enhance) advance dde version (nijtmans) => dde 1.4.1 2018-10-27 tzdata updated to Olson's tzdata2018g (jima) 2018-10-29 Update tcltest package for Travis support (fellows) => tcltest 2.5.0 2018-11-09 (bug)[35a8f1] overlong string length of some lists (owens) 2018-11-16 (bug)[00d04c] Repair [binary encode base64] (sebres) - Released 8.6.9, November 16, 2018 - details at http://core.tcl-lang.org/tcl/ - 

Deleted compat/fixstrtod.c.

 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36  /* * 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 #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; }  < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < <     

Changes to compat/stdlib.h.

 25 26 27 28 29 30 31 32 33 34 35 36  extern void exit(int status); extern int free(char *blockPtr); extern char * getenv(const char *name); 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); #endif /* _STDLIB */   <  25 26 27 28 29 30 31 32 33 34 35  extern void exit(int status); extern int free(char *blockPtr); extern char * getenv(const char *name); 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 long strtol(const char *string, char **endPtr, int base); extern unsigned long strtoul(const char *string, char **endPtr, int base); #endif /* _STDLIB */ 

Deleted compat/strtod.c.

 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252  /* * 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; }  < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < <     

Changes to compat/zlib/contrib/minizip/miniunz.c.

 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107   0,NULL,OPEN_EXISTING,0,NULL); GetFileTime(hFile,&ftCreate,&ftLastAcc,&ftLastWrite); DosDateTimeToFileTime((WORD)(dosdate>>16),(WORD)dosdate,&ftLocal); LocalFileTimeToFileTime(&ftLocal,&ftm); SetFileTime(hFile,&ftm,&ftLastAcc,&ftm); CloseHandle(hFile); #else #ifdef unix || __APPLE__ struct utimbuf ut; struct tm newdate; newdate.tm_sec = tmu_date.tm_sec; newdate.tm_min=tmu_date.tm_min; newdate.tm_hour=tmu_date.tm_hour; newdate.tm_mday=tmu_date.tm_mday; newdate.tm_mon=tmu_date.tm_mon;   |  93 94 95 96 97 98 99 100 101 102 103 104 105 106 107   0,NULL,OPEN_EXISTING,0,NULL); GetFileTime(hFile,&ftCreate,&ftLastAcc,&ftLastWrite); DosDateTimeToFileTime((WORD)(dosdate>>16),(WORD)dosdate,&ftLocal); LocalFileTimeToFileTime(&ftLocal,&ftm); SetFileTime(hFile,&ftm,&ftLastAcc,&ftm); CloseHandle(hFile); #else #if defined(unix) || defined(__APPLE__) struct utimbuf ut; struct tm newdate; newdate.tm_sec = tmu_date.tm_sec; newdate.tm_min=tmu_date.tm_min; newdate.tm_hour=tmu_date.tm_hour; newdate.tm_mday=tmu_date.tm_mday; newdate.tm_mon=tmu_date.tm_mon; 

Changes to compat/zlib/contrib/minizip/minizip.c.

 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104   FindClose(hFind); ret = 1; } } return ret; } #else #ifdef unix || __APPLE__ uLong filetime(f, tmzip, dt) char *f; /* name of file to get info on */ tm_zip *tmzip; /* return value: access, modific. and creation times */ uLong *dt; /* dostime */ { int ret=0; struct stat s; /* results of stat() */   |  90 91 92 93 94 95 96 97 98 99 100 101 102 103 104   FindClose(hFind); ret = 1; } } return ret; } #else #if defined(unix) || defined(__APPLE__) uLong filetime(f, tmzip, dt) char *f; /* name of file to get info on */ tm_zip *tmzip; /* return value: access, modific. and creation times */ uLong *dt; /* dostime */ { int ret=0; struct stat s; /* results of stat() */ 

Changes to doc/clock.n.

 458 459 460 461 462 463 464 465 466 467 468 469 470 471  If a format string lacks a \fB%z\fR or \fB%Z\fR format group, it is possible for the time to be ambiguous because it appears twice in the same day, once without and once with Daylight Saving Time. If this situation occurs, the first occurrence of the time is chosen. (For this reason, it is wise to have the input string contain the time zone when converting local times. This caveat does not apply to UTC times.) .SH "FORMAT GROUPS" .PP The following format groups are recognized by the \fBclock scan\fR and \fBclock format\fR commands. .TP \fB%a\fR On output, receives an abbreviation (\fIe.g.,\fR \fBMon\fR) for the day   > > > > > > > > > > > > >  458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484  If a format string lacks a \fB%z\fR or \fB%Z\fR format group, it is possible for the time to be ambiguous because it appears twice in the same day, once without and once with Daylight Saving Time. If this situation occurs, the first occurrence of the time is chosen. (For this reason, it is wise to have the input string contain the time zone when converting local times. This caveat does not apply to UTC times.) .PP If the interpretation of the groups yields an impossible time because a field is out of range, enough of that field's unit will be added to or subtracted from the time to bring it in range. Thus, if attempting to scan or format day 0 of the month, one day will be subtracted from day 1 of the month, yielding the last day of the previous month. .PP If the interpretation of the groups yields an impossible time because a Daylight Saving Time change skips over that time, or an ambiguous time because a Daylight Saving Time change skips back so that the clock observes the given time twice, and no time zone specifier (\fB%z\fR or \fB%Z\fR) is present in the format, the time is interpreted as if the clock had not changed. .SH "FORMAT GROUPS" .PP The following format groups are recognized by the \fBclock scan\fR and \fBclock format\fR commands. .TP \fB%a\fR On output, receives an abbreviation (\fIe.g.,\fR \fBMon\fR) for the day 

Changes to doc/exec.n.

 212 213 214 215 216 217 218 219 220 221 222 223 224 225 ... 405 406 407 408 409 410 411 412 413 414 415 416 417 418  .QW \fB@\0\fIfileId\fR notation, does not work. When reading from a socket, a 16-bit DOS application will hang and a 32-bit application will return immediately with end-of-file. When either type of application writes to a socket, the information is instead sent to the console, if one is present, or is discarded. .RS .PP The Tk console text widget does not provide real standard IO capabilities. Under Tk, when redirecting from standard input, all applications will see an immediate end-of-file; information redirected to standard output or standard error will be discarded. .PP Either forward or backward slashes are accepted as path separators for ................................................................................ .CS \fBexec\fR cmp.bat somefile.c -o somefile .CE .PP With the file \fIcmp.bat\fR looking something like: .PP .CS @gcc %1 %2 %3 %4 %5 %6 %7 %8 %9 .CE .SS "WORKING WITH COMMAND BUILT-INS" .PP Sometimes you need to be careful, as different programs may have the same name and be in the path. It can then happen that typing a command at the DOS prompt finds \fIa different program\fR than the same   > > > > > > > > > > > > > > > > >  212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 ... 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435  .QW \fB@\0\fIfileId\fR notation, does not work. When reading from a socket, a 16-bit DOS application will hang and a 32-bit application will return immediately with end-of-file. When either type of application writes to a socket, the information is instead sent to the console, if one is present, or is discarded. .RS .PP Note that the current escape resp. quoting of arguments for windows works only with executables using CommandLineToArgv, CRT-library or similar, as well as with the windows batch files (excepting the newline, see below). 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 processor (\fBcmd.exe /c\fR), because this causes truncation of command-line (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. Under Tk, when redirecting from standard input, all applications will see an immediate end-of-file; information redirected to standard output or standard error will be discarded. .PP Either forward or backward slashes are accepted as path separators for ................................................................................ .CS \fBexec\fR cmp.bat somefile.c -o somefile .CE .PP With the file \fIcmp.bat\fR looking something like: .PP .CS @gcc %* .CE or like another variant using single parameters: .CS @gcc %1 %2 %3 %4 %5 %6 %7 %8 %9 .CE .SS "WORKING WITH COMMAND BUILT-INS" .PP Sometimes you need to be careful, as different programs may have the same name and be in the path. It can then happen that typing a command at the DOS prompt finds \fIa different program\fR than the same 

Changes to doc/http.n.

 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 .. 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 .. 90 91 92 93 94 95 96 97 98 99 100 101 102 103 ... 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 ... 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 ... 329 330 331 332 333 334 335 336 337 338 339 340 341 342 ... 410 411 412 413 414 415 416 417 418 419 420 421 422 423 ... 500 501 502 503 504 505 506 507 508 509 510 511 512 513 ... 598 599 600 601 602 603 604 605 606 607 608 609 610 611  '\" Copyright (c) 1995-1997 Sun Microsystems, Inc. '\" Copyright (c) 1998-2000 by Ajuba Solutions. '\" Copyright (c) 2004 ActiveState Corporation. '\" '\" 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" .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 .\" See Also -useragent option documentation in body! .sp \fB::http::config ?\fI\-option value\fR ...? .sp \fB::http::geturl \fIurl\fR ?\fI\-option value\fR ...? .sp \fB::http::formatQuery\fR \fIkey value\fR ?\fIkey value\fR ...? .sp \fB::http::reset\fR \fItoken\fR ?\fIwhy\fR? .sp \fB::http::wait \fItoken\fR .sp \fB::http::status \fItoken\fR .sp ................................................................................ .sp \fB::http::error \fItoken\fR .sp \fB::http::cleanup \fItoken\fR .sp \fB::http::register \fIproto port command\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. 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 policy, so it can be used by untrusted applets to do URL fetching from a restricted set of hosts. This package can be extended to support additional HTTP transport protocols, such as HTTPS, by providing a custom \fBsocket\fR command, via \fB::http::register\fR. ................................................................................ \fB\-accept\fR \fImimetypes\fR . The Accept header of the request. The default is */*, which means that all types of documents are accepted. Otherwise you can supply a comma-separated list of mime type patterns that you are willing to receive. For example, .QW "image/gif, image/jpeg, text/*" . .TP \fB\-proxyhost\fR \fIhostname\fR . The name of the proxy host, if any. If this value is the empty string, the URL host is contacted directly. .TP \fB\-proxyport\fR \fInumber\fR ................................................................................ to determine if a proxy is required for a given host. One argument, a host name, is added to \fIcommand\fR when it is invoked. If a proxy is required, the callback should return a two-element list containing the proxy server and proxy port. Otherwise the filter should return 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\-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 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. .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" . .RE .TP \fB::http::geturl\fR \fIurl\fR ?\fIoptions\fR? . The \fB::http::geturl\fR command is the main procedure in the package. The \fB\-query\fR option causes a POST operation and the \fB\-validate\fR option causes a HEAD operation; ................................................................................ .CS Pragma: no-cache .CE .RE .TP \fB\-keepalive\fR \fIboolean\fR . If true, attempt to keep the connection open for servicing multiple requests. Default is 0. .TP \fB\-method\fR \fItype\fR . Force the HTTP request method to \fItype\fR. \fB::http::geturl\fR will auto-select GET, POST or HEAD based on other options, but this option enables choices like PUT and DELETE for webdav support. ................................................................................ \fB::http::formatQuery\fR \fIkey value\fR ?\fIkey value\fR ...? . This procedure does x-url-encoding of query data. It takes an even number of arguments that are the keys and values of the query. It 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::reset\fR \fItoken\fR ?\fIwhy\fR? . This command resets the HTTP transaction identified by \fItoken\fR, if any. This sets the \fBstate(status)\fR value to \fIwhy\fR, which defaults to \fBreset\fR, and then calls the registered \fB\-command\fR callback. .TP ................................................................................ package require tls ::http::register https 443 ::tls::socket set token [::http::geturl https://my.secure.site/] .CE .RE .TP \fB::http::unregister\fR \fIproto\fR . This procedure unregisters a protocol handler that was previously registered via \fB::http::register\fR, returning a two-item list of the default port and handler command that was previously installed (via \fB::http::register\fR) if there was such a handler, and an error if ................................................................................ Once the data associated with the URL is no longer needed, the state array should be unset to free up storage. The \fB::http::cleanup\fR procedure is provided for that purpose. The following elements of the array are supported: .RS .TP \fBbody\fR . The contents of the URL. This will be empty if the \fB\-channel\fR option has been specified. This value is returned by the \fB::http::data\fR command. .TP \fBcharset\fR . ................................................................................ . A copy of the \fBContent-Type\fR meta-data value. .TP \fBurl\fR . The requested URL. .RE .SH EXAMPLE .PP This example creates a procedure to copy a URL to a file while printing a progress meter, and prints the meta-data associated with the URL. .PP .CS proc httpcopy { url file {chunk 4096} } {   | | > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | | > > > > > > > > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > >  2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 .. 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 .. 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 ... 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 ... 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 ... 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 ... 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 ... 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 ... 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779  '\" Copyright (c) 1995-1997 Sun Microsystems, Inc. '\" Copyright (c) 1998-2000 by Ajuba Solutions. '\" Copyright (c) 2004 ActiveState Corporation. '\" '\" 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.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.8?\fR .\" See Also -useragent option documentation in body! .sp \fB::http::config ?\fI\-option value\fR ...? .sp \fB::http::geturl \fIurl\fR ?\fI\-option value\fR ...? .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 .sp \fB::http::status \fItoken\fR .sp ................................................................................ .sp \fB::http::error \fItoken\fR .sp \fB::http::cleanup \fItoken\fR .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 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 policy, so it can be used by untrusted applets to do URL fetching from a restricted set of hosts. This package can be extended to support additional HTTP transport protocols, such as HTTPS, by providing a custom \fBsocket\fR command, via \fB::http::register\fR. ................................................................................ \fB\-accept\fR \fImimetypes\fR . The Accept header of the request. The default is */*, which means that all types of documents are accepted. Otherwise you can supply a 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 empty string, the URL host is contacted directly. .TP \fB\-proxyport\fR \fInumber\fR ................................................................................ to determine if a proxy is required for a given host. One argument, a host name, is added to \fIcommand\fR when it is invoked. If a proxy is required, the callback should return a two-element list containing the proxy server and proxy port. Otherwise the filter should return 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 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 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. 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? . The \fB::http::geturl\fR command is the main procedure in the package. The \fB\-query\fR option causes a POST operation and the \fB\-validate\fR option causes a HEAD operation; ................................................................................ .CS Pragma: no-cache .CE .RE .TP \fB\-keepalive\fR \fIboolean\fR . If boolean \fBtrue\fR, attempt to keep the connection open for servicing multiple requests. Default is 0. .TP \fB\-method\fR \fItype\fR . Force the HTTP request method to \fItype\fR. \fB::http::geturl\fR will auto-select GET, POST or HEAD based on other options, but this option enables choices like PUT and DELETE for webdav support. ................................................................................ \fB::http::formatQuery\fR \fIkey value\fR ?\fIkey value\fR ...? . This procedure does x-url-encoding of query data. It takes an even number of arguments that are the keys and values of the query. It 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. This sets the \fBstate(status)\fR value to \fIwhy\fR, which defaults to \fBreset\fR, and then calls the registered \fB\-command\fR callback. .TP ................................................................................ package require tls ::http::register https 443 ::tls::socket 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 registered via \fB::http::register\fR, returning a two-item list of the default port and handler command that was previously installed (via \fB::http::register\fR) if there was such a handler, and an error if ................................................................................ Once the data associated with the URL is no longer needed, the state array should be unset to free up storage. The \fB::http::cleanup\fR procedure is provided for that purpose. 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 option has been specified. This value is returned by the \fB::http::data\fR command. .TP \fBcharset\fR . ................................................................................ . A copy of the \fBContent-Type\fR meta-data value. .TP \fBurl\fR . 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 progress meter, and prints the meta-data associated with the URL. .PP .CS proc httpcopy { url file {chunk 4096} } { 

Changes to doc/lreplace.n.

 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 .. 74 75 76 77 78 79 80 81 82 83 84 85 86  .SH NAME lreplace \- Replace elements in a list with new elements .SH SYNOPSIS \fBlreplace \fIlist first last \fR?\fIelement element ...\fR? .BE .SH DESCRIPTION .PP \fBlreplace\fR returns a new list formed by replacing one 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. The index values \fIfirst\fR and \fIlast\fR are interpreted the same as index values for the command \fBstring index\fR, 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. .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 with no elements being deleted. .PP The \fIelement\fR arguments specify zero or more new arguments 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. .SH EXAMPLES .PP Replacing an element of a list with another: .PP .CS % \fBlreplace\fR {a b c d e} 1 1 foo a foo c d e ................................................................................ .CS proc lremove {listVariable value} { upvar 1 $listVariable var set idx [lsearch -exact$var $value] set var [\fBlreplace\fR$var $idx$idx] } .CE .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   | < > | | | | > > > > | | | < > > > > > > > > > > > > > > > > >  13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 .. 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106  .SH NAME lreplace \- Replace elements in a list with new elements .SH SYNOPSIS \fBlreplace \fIlist first last \fR?\fIelement element ...\fR? .BE .SH DESCRIPTION .PP \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. The index values \fIfirst\fR and \fIlast\fR are interpreted the same as index values for the command \fBstring index\fR, 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. .PP 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 element specified by \fIfirst\fR with no elements being deleted. .PP 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. .SH EXAMPLES .PP Replacing an element of a list with another: .PP .CS % \fBlreplace\fR {a b c d e} 1 1 foo a foo c d e ................................................................................ .CS proc lremove {listVariable value} { upvar 1 $listVariable var set idx [lsearch -exact$var $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:  Changes to doc/tcltest.n.  4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 ... 450 451 452 453 454 455 456 457 458 459 460 461 462 463 ... 573 574 575 576 577 578 579 580 581 582 583 584 585 586  '\" Copyright (c) 1998-1999 Scriptics Corporation '\" Copyright (c) 2000 Ajuba Solutions '\" Contributions from Don Porter, NIST, 2002. (not subject to US copyright) '\" '\" 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" .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME tcltest \- Test harness support code and utilities .SH SYNOPSIS .nf \fBpackage require tcltest\fR ?\fB2.3\fR? \fBtcltest::test \fIname description\fR ?\fI\-option value ...\fR? \fBtcltest::test \fIname description\fR ?\fIconstraints\fR? \fIbody result\fR \fBtcltest::loadTestedCommands\fR \fBtcltest::makeDirectory \fIname\fR ?\fIdirectory\fR? \fBtcltest::removeDirectory \fIname\fR ?\fIdirectory\fR? ................................................................................ ?\fB\-setup \fIsetupScript\fR? ?\fB\-body \fItestScript\fR? ?\fB\-cleanup \fIcleanupScript\fR? ?\fB\-result \fIexpectedAnswer\fR? ?\fB\-output \fIexpectedOutput\fR? ?\fB\-errorOutput \fIexpectedError\fR? ?\fB\-returnCodes \fIcodeList\fR? ?\fB\-match \fImode\fR? .CE .PP The \fIname\fR may be any string. It is conventional to choose a \fIname\fR according to the pattern: .PP .CS ................................................................................ a list of return codes that may be accepted from evaluation of the \fB\-body\fR script. If evaluation of the \fB\-body\fR script returns a code not in the \fIexpectedCodeList\fR, the test fails. All 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" . .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 its result must match expected values, and if specified, output and error data from the test must match expected \fB\-output\fR and \fB\-errorOutput\fR values. If any of these conditions are not met, then the test fails. Note that all scripts are evaluated in the context of the caller   | | > > > > > > > > > >  4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 ... 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 ... 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596  '\" Copyright (c) 1998-1999 Scriptics Corporation '\" Copyright (c) 2000 Ajuba Solutions '\" Contributions from Don Porter, NIST, 2002. (not subject to US copyright) '\" '\" 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.5 tcltest "Tcl Bundled Packages" .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME tcltest \- Test harness support code and utilities .SH SYNOPSIS .nf \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 \fBtcltest::loadTestedCommands\fR \fBtcltest::makeDirectory \fIname\fR ?\fIdirectory\fR? \fBtcltest::removeDirectory \fIname\fR ?\fIdirectory\fR? ................................................................................ ?\fB\-setup \fIsetupScript\fR? ?\fB\-body \fItestScript\fR? ?\fB\-cleanup \fIcleanupScript\fR? ?\fB\-result \fIexpectedAnswer\fR? ?\fB\-output \fIexpectedOutput\fR? ?\fB\-errorOutput \fIexpectedError\fR? ?\fB\-returnCodes \fIcodeList\fR? ?\fB\-errorCode \fIexpectedErrorCode\fR? ?\fB\-match \fImode\fR? .CE .PP The \fIname\fR may be any string. It is conventional to choose a \fIname\fR according to the pattern: .PP .CS ................................................................................ a list of return codes that may be accepted from evaluation of the \fB\-body\fR script. If evaluation of the \fB\-body\fR script returns a code not in the \fIexpectedCodeList\fR, the test fails. All 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 its result must match expected values, and if specified, output and error data from the test must match expected \fB\-output\fR and \fB\-errorOutput\fR values. If any of these conditions are not met, then the test fails. Note that all scripts are evaluated in the context of the caller  Changes to generic/tcl.decls.  2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378  ############################################################################## # Public functions that are not accessible via the stubs table. export { void Tcl_Main(int argc, char **argv, Tcl_AppInitProc *appInitProc) } export { const char *Tcl_InitStubs(Tcl_Interp *interp, const char *version, int exact) } export { const char *TclTomMathInitializeStubs(Tcl_Interp* interp, const char* version, int epoch, int revision)   > > > >  2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382  ############################################################################## # Public functions that are not accessible via the stubs table. export { void Tcl_Main(int argc, char **argv, Tcl_AppInitProc *appInitProc) } export { void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp) } export { const char *Tcl_InitStubs(Tcl_Interp *interp, const char *version, int exact) } export { const char *TclTomMathInitializeStubs(Tcl_Interp* interp, const char* version, int epoch, int revision)  Changes to generic/tcl.h.  38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68   * update the version numbers: * * library/init.tcl (1 LOC patch) * unix/configure.in (2 LOC Major, 2 LOC minor, 1 LOC patch) * win/configure.in (as above) * win/tcl.m4 (not patchlevel) * README (sections 0 and 2, with and without separator) * macosx/Tcl.pbproj/project.pbxproj (not patchlevel) 1 LOC * macosx/Tcl.pbproj/default.pbxuser (not patchlevel) 1 LOC * macosx/Tcl.xcode/project.pbxproj (not patchlevel) 2 LOC * macosx/Tcl.xcode/default.pbxuser (not patchlevel) 1 LOC * macosx/Tcl-Common.xcconfig (not patchlevel) 1 LOC * win/README (not patchlevel) (sections 0 and 2) * unix/tcl.spec (1 LOC patch) * tools/tcl.hpj.in (not patchlevel, for windows installer) */ #define TCL_MAJOR_VERSION 8 #define TCL_MINOR_VERSION 6 #define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE #define TCL_RELEASE_SERIAL 8 #define TCL_VERSION "8.6" #define TCL_PATCH_LEVEL "8.6.8" /* *---------------------------------------------------------------------------- * The following definitions set up the proper options for Windows compilers. * We use this method because there is no autoconf equivalent. */   < < < < | |  38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64   * update the version numbers: * * library/init.tcl (1 LOC patch) * unix/configure.in (2 LOC Major, 2 LOC minor, 1 LOC patch) * win/configure.in (as above) * win/tcl.m4 (not patchlevel) * README (sections 0 and 2, with and without separator) * macosx/Tcl-Common.xcconfig (not patchlevel) 1 LOC * win/README (not patchlevel) (sections 0 and 2) * unix/tcl.spec (1 LOC patch) * tools/tcl.hpj.in (not patchlevel, for windows installer) */ #define TCL_MAJOR_VERSION 8 #define TCL_MINOR_VERSION 6 #define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE #define TCL_RELEASE_SERIAL 9 #define TCL_VERSION "8.6" #define TCL_PATCH_LEVEL "8.6.9" /* *---------------------------------------------------------------------------- * The following definitions set up the proper options for Windows compilers. * We use this method because there is no autoconf equivalent. */  Changes to generic/tclBasic.c.  7609 7610 7611 7612 7613 7614 7615 7616 7617 7618 7619 7620 7621 7622 7623 7624 7625 7626 7627 7628 7629 7630 7631 7632 7633 7634 7635 7636   } if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { return TCL_ERROR; } if (type == TCL_NUMBER_DOUBLE) { d = *((const double *) ptr); if ((d >= (double)LONG_MAX) || (d <= (double)LONG_MIN)) { mp_int big; if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) { /* Infinity */ return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big)); return TCL_OK; } else { long result = (long) d; Tcl_SetObjResult(interp, Tcl_NewLongObj(result)); return TCL_OK; } } if (type != TCL_NUMBER_NAN) { /* * All integers are already of integer type. */   | > > > > > > > > > > > > < < < < <  7609 7610 7611 7612 7613 7614 7615 7616 7617 7618 7619 7620 7621 7622 7623 7624 7625 7626 7627 7628 7629 7630 7631 7632 7633 7634 7635 7636 7637 7638 7639 7640 7641 7642 7643   } if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { return TCL_ERROR; } if (type == TCL_NUMBER_DOUBLE) { d = *((const double *) ptr); if ((d < (double)LONG_MAX) && (d > (double)LONG_MIN)) { long result = (long) d; Tcl_SetObjResult(interp, Tcl_NewLongObj(result)); return TCL_OK; #ifndef TCL_WIDE_INT_IS_LONG } else if ((d < (double)LLONG_MAX) && (d > (double)LLONG_MIN)) { Tcl_WideInt result = (Tcl_WideInt) d; Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result)); return TCL_OK; #endif } else { mp_int big; if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) { /* Infinity */ return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big)); return TCL_OK; } } if (type != TCL_NUMBER_NAN) { /* * All integers are already of integer type. */  Changes to generic/tclBinary.c.  2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 .... 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956   */ if (data < dataend) { c = *data++; } else if (i > 1) { c = '='; } else { cut += 3; break; } /* * Load the character into the block value. Handle ='s specially * because they're only valid as the last character or two of the ................................................................................ value = (value << 6) | ((c - 'a' + 26) & 0x3f); } else if (c >= '0' && c <= '9') { value = (value << 6) | ((c - '0' + 52) & 0x3f); } else if (c == '+') { value = (value << 6) | 0x3e; } else if (c == '/') { value = (value << 6) | 0x3f; } else if (c == '=') { value <<= 6; cut++; } else if (strict || !isspace(c)) { goto bad64; } else { i--; } } *cursor++ = UCHAR((value >> 16) & 0xff);   > > > > > | > > |  2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 .... 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963   */ if (data < dataend) { c = *data++; } else if (i > 1) { c = '='; } else { if (strict && i <= 1) { /* single resp. unfulfilled char (each 4th next single char) * is rather bad64 error case in strict mode */ goto bad64; } cut += 3; break; } /* * Load the character into the block value. Handle ='s specially * because they're only valid as the last character or two of the ................................................................................ value = (value << 6) | ((c - 'a' + 26) & 0x3f); } else if (c >= '0' && c <= '9') { value = (value << 6) | ((c - '0' + 52) & 0x3f); } else if (c == '+') { value = (value << 6) | 0x3e; } else if (c == '/') { value = (value << 6) | 0x3f; } else if (c == '=' && ( !strict || i > 1) /* "=" and "a=" is rather bad64 error case in strict mode */ ) { value <<= 6; if (i) cut++; } else if (strict || !isspace(c)) { goto bad64; } else { i--; } } *cursor++ = UCHAR((value >> 16) & 0xff);  Changes to generic/tclCmdAH.c.  507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 .... 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194  { if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } return TCL_CONTINUE; } /* *---------------------------------------------------------------------- * * Tcl_EncodingObjCmd -- * * This command manipulates encodings. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_EncodingObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int index; static const char *const optionStrings[] = { "convertfrom", "convertto", "dirs", "names", "system", NULL }; enum options { ENC_CONVERTFROM, ENC_CONVERTTO, ENC_DIRS, ENC_NAMES, ENC_SYSTEM }; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum options) index) { case ENC_CONVERTTO: return EncodingConverttoObjCmd(dummy, interp, objc, objv); case ENC_CONVERTFROM: return EncodingConvertfromObjCmd(dummy, interp, objc, objv); case ENC_DIRS: return EncodingDirsObjCmd(dummy, interp, objc, objv); case ENC_NAMES: return EncodingNamesObjCmd(dummy, interp, objc, objv); case ENC_SYSTEM: return EncodingSystemObjCmd(dummy, interp, objc, objv); } return TCL_OK; } /* *----------------------------------------------------------------------------- * * TclInitEncodingCmd -- * * This function creates the 'encoding' ensemble. ................................................................................ int objc, Tcl_Obj *const objv[]) { if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?"); return TCL_ERROR; } Tcl_SetObjResult(interp, TclJoinPath(objc - 1, objv + 1)); return TCL_OK; } /* *---------------------------------------------------------------------- * * PathNativeNameCmd --   < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |  507 508 509 510 511 512 513 514 515 516 517 518 519 520 .... 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137  { if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } return TCL_CONTINUE; } /* *----------------------------------------------------------------------------- * * TclInitEncodingCmd -- * * This function creates the 'encoding' ensemble. ................................................................................ int objc, Tcl_Obj *const objv[]) { if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?"); return TCL_ERROR; } Tcl_SetObjResult(interp, TclJoinPath(objc - 1, objv + 1, 0)); return TCL_OK; } /* *---------------------------------------------------------------------- * * PathNativeNameCmd --  Changes to generic/tclCmdIL.c.  2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771   if (result != TCL_OK) { return result; } 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 (last >= listLen) { last = listLen - 1; } if (first <= last) { numToDelete = last - first + 1; } else { numToDelete = 0;   > > | < < < < < < < < < < < < <  2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760   if (result != TCL_OK) { return result; } if (first < 0) { first = 0; } if (first > listLen) { first = listLen; } if (last >= listLen) { last = listLen - 1; } if (first <= last) { numToDelete = last - first + 1; } else { numToDelete = 0;  Changes to generic/tclCmdMZ.c.  1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 .... 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 .... 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868   * is a *major* win when splitting on a long string (especially in the * megabyte range!) - DKF */ Tcl_InitHashTable(&charReuseTable, TCL_ONE_WORD_KEYS); for ( ; stringPtr < end; stringPtr += len) { int fullchar; len = TclUtfToUniChar(stringPtr, &ch); fullchar = ch; #if TCL_UTF_MAX == 4 if (!len) { len += TclUtfToUniChar(stringPtr, &ch); fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; ................................................................................ /* * From now on, we only access the two objects at the end of the argument * array. */ objv += objc-2; match = TclStringCmp (objv[0], objv[1], 0, nocase, reqlength); Tcl_SetObjResult(interp, Tcl_NewBooleanObj(match ? 0 : 1)); return TCL_OK; } /* *---------------------------------------------------------------------- * ................................................................................ * Remember to keep code here in some sync with the byte-compiled versions * in tclExecute.c (INST_STR_EQ, INST_STR_NEQ and INST_STR_CMP as well as * the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...). */ int match, nocase, reqlength, status; if ((status = TclStringCmpOpts(interp, objc, objv, &nocase, &reqlength)) != TCL_OK) { return status; } objv += objc-2; match = TclStringCmp (objv[0], objv[1], 0, nocase, reqlength); Tcl_SetObjResult(interp, Tcl_NewIntObj(match)); return TCL_OK; } int TclStringCmp ( Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr, int checkEq, /* comparison is only for equality */ int nocase, /* comparison is not case sensitive */ int reqlength /* requested length */ ) { char *s1, *s2; int empty, length, match, s1len, s2len; memCmpFn_t memCmpFn; if ((reqlength == 0) || (value1Ptr == value2Ptr)) { /* * Always match at 0 chars of if it is the same obj. */ match = 0; } else { if (!nocase && TclIsPureByteArray(value1Ptr) && TclIsPureByteArray(value2Ptr)) { /* * Use binary versions of comparisons since that won't cause undue * type conversions and it is much faster. Only do this if we're * case-sensitive (which is all that really makes sense with byte * arrays anyway, and we have no memcasecmp() for some reason... :^) */ s1 = (char *) Tcl_GetByteArrayFromObj(value1Ptr, &s1len); s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len); memCmpFn = memcmp; } else if ((value1Ptr->typePtr == &tclStringType) && (value2Ptr->typePtr == &tclStringType)) { /* * Do a unicode-specific comparison if both of the args are of * String type. If the char length == byte length, we can do a * memcmp. In benchmark testing this proved the most efficient * check between the unicode and string comparison operations. */ if (nocase) { s1 = (char *) Tcl_GetUnicodeFromObj(value1Ptr, &s1len); s2 = (char *) Tcl_GetUnicodeFromObj(value2Ptr, &s2len); memCmpFn = (memCmpFn_t)Tcl_UniCharNcasecmp; } else { s1len = Tcl_GetCharLength(value1Ptr); s2len = Tcl_GetCharLength(value2Ptr); if ((s1len == value1Ptr->length) && (value1Ptr->bytes != NULL) && (s2len == value2Ptr->length) && (value2Ptr->bytes != NULL)) { s1 = value1Ptr->bytes; s2 = value2Ptr->bytes; memCmpFn = memcmp; } else { s1 = (char *) Tcl_GetUnicode(value1Ptr); s2 = (char *) Tcl_GetUnicode(value2Ptr); if ( #ifdef WORDS_BIGENDIAN 1 #else checkEq #endif ) { memCmpFn = memcmp; s1len *= sizeof(Tcl_UniChar); s2len *= sizeof(Tcl_UniChar); } else { memCmpFn = (memCmpFn_t) Tcl_UniCharNcmp; } } } } else { if ((empty = TclCheckEmptyString(value1Ptr)) > 0) { switch (TclCheckEmptyString(value2Ptr)) { case -1: s1 = ""; s1len = 0; s2 = TclGetStringFromObj(value2Ptr, &s2len); break; case 0: match = -1; goto matchdone; case 1: default: /* avoid warn: s2 may be used uninitialized */ match = 0; goto matchdone; } } else if (TclCheckEmptyString(value2Ptr) > 0) { switch (empty) { case -1: s2 = ""; s2len = 0; s1 = TclGetStringFromObj(value1Ptr, &s1len); break; case 0: match = 1; goto matchdone; case 1: default: /* avoid warn: s1 may be used uninitialized */ match = 0; goto matchdone; } } else { s1 = TclGetStringFromObj(value1Ptr, &s1len); s2 = TclGetStringFromObj(value2Ptr, &s2len); } if (!nocase && checkEq) { /* * When we have equal-length we can check only for (in)equality. * We can use memcmp in all (n)eq cases because we * don't need to worry about lexical LE/BE variance. */ memCmpFn = memcmp; } else { /* * As a catch-all we will work with UTF-8. We cannot use memcmp() as * that is unsafe with any string containing NUL (\xC0\x80 in Tcl's * utf rep). We can use the more efficient TclpUtfNcmp2 if we are * case-sensitive and no specific length was requested. */ if ((reqlength < 0) && !nocase) { memCmpFn = (memCmpFn_t) TclpUtfNcmp2; } else { s1len = Tcl_NumUtfChars(s1, s1len); s2len = Tcl_NumUtfChars(s2, s2len); memCmpFn = (memCmpFn_t) (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp); } } } length = (s1len < s2len) ? s1len : s2len; if (reqlength > 0 && reqlength < length) { length = reqlength; } else if (reqlength < 0) { /* * The requested length is negative, so we ignore it by setting it to * length + 1 so we correct the match var. */ reqlength = length + 1; } if (checkEq && (s1len != s2len)) { match = 1; /* This will be reversed below. */ } else { /* * The comparison function should compare up to the minimum * byte length only. */ match = memCmpFn(s1, s2, (size_t) length); } if ((match == 0) && (reqlength > length)) { match = s1len - s2len; } match = (match > 0) ? 1 : (match < 0) ? -1 : 0; } matchdone: return match; } int TclStringCmpOpts ( Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[], /* Argument objects. */ int *nocase, int *reqlength ) { int i, length; const char *string; *reqlength = -1; *nocase = 0; if (objc < 3 || objc > 6) {   | < | < | | < | > > > | > > > > > > > > > > > > > > > > | | | | | < > > | < < > | > | | | | | | | | > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < > | | | | | | | | | | > > > > > | > | | | | | | | | < < | < < > | | | | | | | | | < < < > | < < > | | | | | > | | | | | | | | < | | | | | | | | | | | > | | | | | | | | | | | | | | | | | | | | | | | | | | | | < < | < | | <  1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 .... 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 .... 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883   * is a *major* win when splitting on a long string (especially in the * megabyte range!) - DKF */ Tcl_InitHashTable(&charReuseTable, TCL_ONE_WORD_KEYS); for ( ; stringPtr < end; stringPtr += len) { int fullchar; len = TclUtfToUniChar(stringPtr, &ch); fullchar = ch; #if TCL_UTF_MAX == 4 if (!len) { len += TclUtfToUniChar(stringPtr, &ch); fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; ................................................................................ /* * From now on, we only access the two objects at the end of the argument * array. */ objv += objc-2; match = TclStringCmp(objv[0], objv[1], 0, nocase, reqlength); Tcl_SetObjResult(interp, Tcl_NewBooleanObj(match ? 0 : 1)); return TCL_OK; } /* *---------------------------------------------------------------------- * ................................................................................ * Remember to keep code here in some sync with the byte-compiled versions * in tclExecute.c (INST_STR_EQ, INST_STR_NEQ and INST_STR_CMP as well as * the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...). */ int match, nocase, reqlength, status; status = TclStringCmpOpts(interp, objc, objv, &nocase, &reqlength); if (status != TCL_OK) { return status; } objv += objc-2; match = TclStringCmp(objv[0], objv[1], 0, nocase, reqlength); Tcl_SetObjResult(interp, Tcl_NewIntObj(match)); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclStringCmp -- * * This is the core of Tcl's string comparison. It only handles byte * arrays, UNICODE strings and UTF-8 strings correctly. * * Results: * -1 if value1Ptr is less than value2Ptr, 0 if they are equal, or 1 if * value1Ptr is greater. * * Side effects: * May cause string representations of objects to be allocated. * *---------------------------------------------------------------------- */ int TclStringCmp( Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr, int checkEq, /* comparison is only for equality */ int nocase, /* comparison is not case sensitive */ int reqlength) /* requested length; -1 to compare whole * strings */ { char *s1, *s2; int empty, length, match, s1len, s2len; memCmpFn_t memCmpFn; if ((reqlength == 0) || (value1Ptr == value2Ptr)) { /* * Always match at 0 chars or if it is the same obj. */ return 0; } if (!nocase && TclIsPureByteArray(value1Ptr) && TclIsPureByteArray(value2Ptr)) { /* * Use binary versions of comparisons since that won't cause undue * type conversions and it is much faster. Only do this if we're * case-sensitive (which is all that really makes sense with byte * arrays anyway, and we have no memcasecmp() for some reason... :^) */ s1 = (char *) Tcl_GetByteArrayFromObj(value1Ptr, &s1len); s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len); memCmpFn = memcmp; } else if ((value1Ptr->typePtr == &tclStringType) && (value2Ptr->typePtr == &tclStringType)) { /* * Do a unicode-specific comparison if both of the args are of String * type. If the char length == byte length, we can do a memcmp. In * benchmark testing this proved the most efficient check between the * unicode and string comparison operations. */ if (nocase) { s1 = (char *) Tcl_GetUnicodeFromObj(value1Ptr, &s1len); s2 = (char *) Tcl_GetUnicodeFromObj(value2Ptr, &s2len); memCmpFn = (memCmpFn_t)Tcl_UniCharNcasecmp; } else { s1len = Tcl_GetCharLength(value1Ptr); s2len = Tcl_GetCharLength(value2Ptr); if ((s1len == value1Ptr->length) && (value1Ptr->bytes != NULL) && (s2len == value2Ptr->length) && (value2Ptr->bytes != NULL)) { s1 = value1Ptr->bytes; s2 = value2Ptr->bytes; memCmpFn = memcmp; } else { s1 = (char *) Tcl_GetUnicode(value1Ptr); s2 = (char *) Tcl_GetUnicode(value2Ptr); if ( #ifdef WORDS_BIGENDIAN 1 #else checkEq #endif /* WORDS_BIGENDIAN */ ) { memCmpFn = memcmp; s1len *= sizeof(Tcl_UniChar); s2len *= sizeof(Tcl_UniChar); } else { memCmpFn = (memCmpFn_t) Tcl_UniCharNcmp; } } } } else { /* * Get the string representations, being careful in case we have * special empty string objects about. */ empty = TclCheckEmptyString(value1Ptr); if (empty > 0) { switch (TclCheckEmptyString(value2Ptr)) { case -1: s1 = ""; s1len = 0; s2 = TclGetStringFromObj(value2Ptr, &s2len); break; case 0: return -1; default: /* avoid warn: s2 may be used uninitialized */ return 0; } } else if (TclCheckEmptyString(value2Ptr) > 0) { switch (empty) { case -1: s2 = ""; s2len = 0; s1 = TclGetStringFromObj(value1Ptr, &s1len); break; case 0: return 1; default: /* avoid warn: s1 may be used uninitialized */ return 0; } } else { s1 = TclGetStringFromObj(value1Ptr, &s1len); s2 = TclGetStringFromObj(value2Ptr, &s2len); } if (!nocase && checkEq) { /* * When we have equal-length we can check only for (in)equality. * We can use memcmp() in all (n)eq cases because we don't need to * worry about lexical LE/BE variance. */ memCmpFn = memcmp; } else { /* * As a catch-all we will work with UTF-8. We cannot use memcmp() * as that is unsafe with any string containing NUL (\xC0\x80 in * Tcl's utf rep). We can use the more efficient TclpUtfNcmp2 if * we are case-sensitive and no specific length was requested. */ if ((reqlength < 0) && !nocase) { memCmpFn = (memCmpFn_t) TclpUtfNcmp2; } else { s1len = Tcl_NumUtfChars(s1, s1len); s2len = Tcl_NumUtfChars(s2, s2len); memCmpFn = (memCmpFn_t) (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp); } } } length = (s1len < s2len) ? s1len : s2len; if (reqlength > 0 && reqlength < length) { length = reqlength; } else if (reqlength < 0) { /* * The requested length is negative, so we ignore it by setting it to * length + 1 so we correct the match var. */ reqlength = length + 1; } if (checkEq && (s1len != s2len)) { match = 1; /* This will be reversed below. */ } else { /* * The comparison function should compare up to the minimum byte * length only. */ match = memCmpFn(s1, s2, (size_t) length); } if ((match == 0) && (reqlength > length)) { match = s1len - s2len; } return (match > 0) ? 1 : (match < 0) ? -1 : 0; } int TclStringCmpOpts( Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[], /* Argument objects. */ int *nocase, int *reqlength) { int i, length; const char *string; *reqlength = -1; *nocase = 0; if (objc < 3 || objc > 6) {  Changes to generic/tclCompCmdsGR.c.  1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 .... 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 .... 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597   * command. */ Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds the resulting instructions. */ { Tcl_Token *tokenPtr, *listTokenPtr; DefineLineInformation; /* TIP #280 */ int idx1, idx2, i, offset, offset2; int emptyPrefix=1, suffixStart = 0; if (parsePtr->numWords < 4) { return TCL_ERROR; } listTokenPtr = TokenAfter(parsePtr->tokenPtr); ................................................................................ tokenPtr = TokenAfter(tokenPtr); if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_END, &idx2) != TCL_OK) { 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 * In a few cases we can predict various parts will be empty and * take advantage. * * The proper suffix begins with the greater of indices idx1 or * idx2 + 1. If we cannot tell at compile time which is greater, * we must defer to direct evaluation. */ if (idx2 == TCL_INDEX_BEFORE) { suffixStart = idx1; } else if (idx2 == TCL_INDEX_END) { suffixStart = TCL_INDEX_AFTER; } else if (((idx2 < TCL_INDEX_END) && (idx1 <= TCL_INDEX_END)) || ((idx2 >= TCL_INDEX_START) && (idx1 >= TCL_INDEX_START))) { suffixStart = (idx1 > idx2 + 1) ? idx1 : idx2 + 1; } else { ................................................................................ /* Make a list of them... */ TclEmitInstInt4( INST_LIST, i - 4, envPtr); 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] * We still do a list operation to get list-verification * and canonicalization side effects. */ TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);   | < < < < < < < < < < < < < < < < < > > | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < <  1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 .... 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 .... 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546   * command. */ Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds the resulting instructions. */ { Tcl_Token *tokenPtr, *listTokenPtr; DefineLineInformation; /* TIP #280 */ int idx1, idx2, i; int emptyPrefix=1, suffixStart = 0; if (parsePtr->numWords < 4) { return TCL_ERROR; } listTokenPtr = TokenAfter(parsePtr->tokenPtr); ................................................................................ tokenPtr = TokenAfter(tokenPtr); if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_END, &idx2) != TCL_OK) { return TCL_ERROR; } /* * General structure of the [lreplace] result is * prefix replacement suffix * In a few cases we can predict various parts will be empty and * take advantage. * * The proper suffix begins with the greater of indices idx1 or * idx2 + 1. If we cannot tell at compile time which is greater, * we must defer to direct evaluation. */ 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; } else if (((idx2 < TCL_INDEX_END) && (idx1 <= TCL_INDEX_END)) || ((idx2 >= TCL_INDEX_START) && (idx1 >= TCL_INDEX_START))) { suffixStart = (idx1 > idx2 + 1) ? idx1 : idx2 + 1; } else { ................................................................................ /* Make a list of them... */ TclEmitInstInt4( INST_LIST, i - 4, envPtr); emptyPrefix = 0; } if ((idx1 == suffixStart) && (parsePtr->numWords == 4)) { /* * This is a "no-op". Example: [lreplace {a b c} 2 0] * We still do a list operation to get list-verification * and canonicalization side effects. */ TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);  Changes to generic/tclCompile.h.  1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504  # define TclGetInt1AtPtr(p) ((int) *((signed char *) p)) #else # define TclGetInt1AtPtr(p) \ (((int) *((char *) p)) | ((*(p) & 0200) ? (-256) : 0)) #endif #define TclGetInt4AtPtr(p) \ (((int) TclGetInt1AtPtr(p) << 24) | \ (*((p)+1) << 16) | \ (*((p)+2) << 8) | \ (*((p)+3))) #define TclGetUInt1AtPtr(p) \ ((unsigned int) *(p)) #define TclGetUInt4AtPtr(p) \   |  1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504  # define TclGetInt1AtPtr(p) ((int) *((signed char *) p)) #else # define TclGetInt1AtPtr(p) \ (((int) *((char *) p)) | ((*(p) & 0200) ? (-256) : 0)) #endif #define TclGetInt4AtPtr(p) \ (((int) (TclGetUInt1AtPtr(p) << 24)) | \ (*((p)+1) << 16) | \ (*((p)+2) << 8) | \ (*((p)+3))) #define TclGetUInt1AtPtr(p) \ ((unsigned int) *(p)) #define TclGetUInt4AtPtr(p) \  Changes to generic/tclEncoding.c.  1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 .... 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 192 ... 207 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 208 ... 223 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 224 ... 239 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 240 ... 255 */ }; Tcl_DStringInit(&lineString); Tcl_Gets(chan, &lineString); line = Tcl_DStringValue(&lineString); fallback = (int) strtol(line, &line, 16); symbol = (int) strtol(line, &line, 10); numPages = (int) strtol(line, &line, 10); Tcl_DStringFree(&lineString); ................................................................................ pageMemPtr = (unsigned short *) (dataPtr->toUnicode + 256); TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); for (i = 0; i < numPages; i++) { int ch; const char *p; Tcl_ReadChars(chan, objPtr, 3 + 16 * (16 * 4 + 1), 0); p = Tcl_GetString(objPtr); hi = (staticHex[UCHAR(p[0])] << 4) + staticHex[UCHAR(p[1])]; dataPtr->toUnicode[hi] = pageMemPtr; p += 2; for (lo = 0; lo < 256; lo++) { if ((lo & 0x0f) == 0) { p++;   | > > > | > >  1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 .... 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 192 ... 207 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 208 ... 223 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 224 ... 239 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 240 ... 255 */ }; Tcl_DStringInit(&lineString); if (Tcl_Gets(chan, &lineString) < 0) { return NULL; } line = Tcl_DStringValue(&lineString); fallback = (int) strtol(line, &line, 16); symbol = (int) strtol(line, &line, 10); numPages = (int) strtol(line, &line, 10); Tcl_DStringFree(&lineString); ................................................................................ pageMemPtr = (unsigned short *) (dataPtr->toUnicode + 256); TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); for (i = 0; i < numPages; i++) { int ch; const char *p; int expected = 3 + 16 * (16 * 4 + 1); if (Tcl_ReadChars(chan, objPtr, expected, 0) != expected) { return NULL; } p = Tcl_GetString(objPtr); hi = (staticHex[UCHAR(p[0])] << 4) + staticHex[UCHAR(p[1])]; dataPtr->toUnicode[hi] = pageMemPtr; p += 2; for (lo = 0; lo < 256; lo++) { if ((lo & 0x0f) == 0) { p++;  Changes to generic/tclEnsemble.c.  2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 .... 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 .... 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184  } /* *---------------------------------------------------------------------- * * TclSpellFix -- * * Record a spelling correction that needs making in the * generation of the WrongNumArgs usage message. * * Results: * None. * * Side effects: * Can create an alternative ensemble rewrite structure. * ................................................................................ static int FreeER( ClientData data[], Tcl_Interp *interp, int result) { Tcl_Obj **tmp = (Tcl_Obj **)data[0]; ckfree(tmp[2]); ckfree(tmp); return result; } void TclSpellFix( Tcl_Interp *interp, ................................................................................ if (iPtr->ensembleRewrite.sourceObjs == NULL) { iPtr->ensembleRewrite.sourceObjs = objv; iPtr->ensembleRewrite.numRemovedObjs = 0; iPtr->ensembleRewrite.numInsertedObjs = 0; } /* Compute the valid length of the ensemble root */ size = iPtr->ensembleRewrite.numRemovedObjs + objc - iPtr->ensembleRewrite.numInsertedObjs; search = iPtr->ensembleRewrite.sourceObjs; if (search[0] == NULL) { /* Awful casting abuse here */ search = (Tcl_Obj *const *) search[1]; } if (badIdx < iPtr->ensembleRewrite.numInsertedObjs) { /* * Misspelled value was inserted. We cannot directly jump * to the bad value, but have to search. */ idx = 1; while (idx < size) { if (search[idx] == bad) { break; } idx++; } if (idx == size) { return; } } else { /* Jump to the misspelled value. */ idx = iPtr->ensembleRewrite.numRemovedObjs + badIdx - iPtr->ensembleRewrite.numInsertedObjs; /* Verify */ if (search[idx] != bad) { Tcl_Panic("SpellFix: programming error"); } } search = iPtr->ensembleRewrite.sourceObjs; if (search[0] == NULL) { store = (Tcl_Obj **)search[2]; } else { Tcl_Obj **tmp = ckalloc(3 * sizeof(Tcl_Obj *)); tmp[0] = NULL; tmp[1] = (Tcl_Obj *)iPtr->ensembleRewrite.sourceObjs; tmp[2] = (Tcl_Obj *)ckalloc(size * sizeof(Tcl_Obj *)); memcpy(tmp[2], tmp[1], size*sizeof(Tcl_Obj *)); iPtr->ensembleRewrite.sourceObjs = (Tcl_Obj *const *) tmp; TclNRAddCallback(interp, FreeER, tmp, NULL, NULL, NULL); store = (Tcl_Obj **)tmp[2]; } store[idx] = fix; Tcl_IncrRefCount(fix); TclNRAddCallback(interp, TclNRReleaseValues, fix, NULL, NULL, NULL); }   | | | > | > | > > | > > | | > > | > > | < > > | | < > > > > > > > > > > | <  2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 .... 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 .... 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203  } /* *---------------------------------------------------------------------- * * TclSpellFix -- * * Record a spelling correction that needs making in the generation of * the WrongNumArgs usage message. * * Results: * None. * * Side effects: * Can create an alternative ensemble rewrite structure. * ................................................................................ static int FreeER( ClientData data[], Tcl_Interp *interp, int result) { Tcl_Obj **tmp = (Tcl_Obj **) data[0]; Tcl_Obj **store = (Tcl_Obj **) data[1]; ckfree(store); ckfree(tmp); return result; } void TclSpellFix( Tcl_Interp *interp, ................................................................................ if (iPtr->ensembleRewrite.sourceObjs == NULL) { iPtr->ensembleRewrite.sourceObjs = objv; iPtr->ensembleRewrite.numRemovedObjs = 0; iPtr->ensembleRewrite.numInsertedObjs = 0; } /* * Compute the valid length of the ensemble root. */ size = iPtr->ensembleRewrite.numRemovedObjs + objc - iPtr->ensembleRewrite.numInsertedObjs; search = iPtr->ensembleRewrite.sourceObjs; if (search[0] == NULL) { /* * Awful casting abuse here! */ search = (Tcl_Obj *const *) search[1]; } if (badIdx < iPtr->ensembleRewrite.numInsertedObjs) { /* * Misspelled value was inserted. We cannot directly jump to the bad * value, but have to search. */ idx = 1; while (idx < size) { if (search[idx] == bad) { break; } idx++; } if (idx == size) { return; } } else { /* * Jump to the misspelled value. */ idx = iPtr->ensembleRewrite.numRemovedObjs + badIdx - iPtr->ensembleRewrite.numInsertedObjs; /* Verify */ if (search[idx] != bad) { Tcl_Panic("SpellFix: programming error"); } } search = iPtr->ensembleRewrite.sourceObjs; if (search[0] == NULL) { store = (Tcl_Obj **) search[2]; } else { Tcl_Obj **tmp = ckalloc(3 * sizeof(Tcl_Obj *)); store = ckalloc(size * sizeof(Tcl_Obj *)); memcpy(store, iPtr->ensembleRewrite.sourceObjs, size * sizeof(Tcl_Obj *)); /* * Awful casting abuse here! Note that the NULL in the first element * indicates that the initial objects are a raw array in the second * element and the rewritten ones are a raw array in the third. */ tmp[0] = NULL; tmp[1] = (Tcl_Obj *) iPtr->ensembleRewrite.sourceObjs; tmp[2] = (Tcl_Obj *) store; iPtr->ensembleRewrite.sourceObjs = (Tcl_Obj *const *) tmp; TclNRAddCallback(interp, FreeER, tmp, store, NULL, NULL); } store[idx] = fix; Tcl_IncrRefCount(fix); TclNRAddCallback(interp, TclNRReleaseValues, fix, NULL, NULL, NULL); }  Changes to generic/tclExecute.c.  2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 .... 5233 5234 5235 5236 5237 5238 5239 5240 5241 5242 5243 5244 5245 5246 5247 5248   * * Side effects: * Almost certainly, depending on the ByteCode's instructions. * *---------------------------------------------------------------------- */ #define bcFramePtr (&TD->cmdFrame) #define initCatchTop ((ptrdiff_t *) (&TD->stack[-1])) #define initTosPtr ((Tcl_Obj **) (initCatchTop+codePtr->maxExceptDepth)) #define esPtr (iPtr->execEnvPtr->execStackPtr) int TclNRExecuteByteCode( Tcl_Interp *interp, /* Token for command interpreter. */ ByteCode *codePtr) /* The bytecode sequence to interpret. */ ................................................................................ if (*(pc+9) == INST_POP) { NEXT_INST_F(10, 1, 0); } #endif /* Every range of an empty list is an empty list */ if (objc == 0) { TRACE_APPEND(("\n")); NEXT_INST_F(9, 0, 0); } /* Decode index value operands. */ /* assert ( toIdx != TCL_INDEX_AFTER); *   | > > | | > >  2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 .... 5233 5234 5235 5236 5237 5238 5239 5240 5241 5242 5243 5244 5245 5246 5247 5248 5249 5250 5251 5252   * * Side effects: * Almost certainly, depending on the ByteCode's instructions. * *---------------------------------------------------------------------- */ #define bcFramePtr (&TD->cmdFrame) #define initCatchTop ((ptrdiff_t *) (TD->stack-1)) #define initTosPtr ((Tcl_Obj **) (initCatchTop+codePtr->maxExceptDepth)) #define esPtr (iPtr->execEnvPtr->execStackPtr) int TclNRExecuteByteCode( Tcl_Interp *interp, /* Token for command interpreter. */ ByteCode *codePtr) /* The bytecode sequence to interpret. */ ................................................................................ if (*(pc+9) == INST_POP) { NEXT_INST_F(10, 1, 0); } #endif /* Every range of an empty list is an empty list */ if (objc == 0) { /* avoid return of not canonical list (e. g. spaces in string repr.) */ if (ListObjIsCanonical(valuePtr)) { TRACE_APPEND(("\n")); NEXT_INST_F(9, 0, 0); } goto emptyList; } /* Decode index value operands. */ /* assert ( toIdx != TCL_INDEX_AFTER); *  Changes to generic/tclFCmd.c.  176 177 178 179 180 181 182 183 184 185 186 187 188 189 190   source = FileBasename(interp, objv[i]); if (source == NULL) { result = TCL_ERROR; break; } jargv[0] = objv[objc - 1]; jargv[1] = source; newFileName = TclJoinPath(2, jargv); Tcl_IncrRefCount(newFileName); result = CopyRenameOneFile(interp, objv[i], newFileName, copyFlag, force); Tcl_DecrRefCount(newFileName); Tcl_DecrRefCount(source); if (result == TCL_ERROR) {   |  176 177 178 179 180 181 182 183 184 185 186 187 188 189 190   source = FileBasename(interp, objv[i]); if (source == NULL) { result = TCL_ERROR; break; } jargv[0] = objv[objc - 1]; jargv[1] = source; newFileName = TclJoinPath(2, jargv, 1); Tcl_IncrRefCount(newFileName); result = CopyRenameOneFile(interp, objv[i], newFileName, copyFlag, force); Tcl_DecrRefCount(newFileName); Tcl_DecrRefCount(source); if (result == TCL_ERROR) {  Changes to generic/tclFileName.c.  804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835  Tcl_Obj * Tcl_FSJoinToPath( Tcl_Obj *pathPtr, /* Valid path or NULL. */ int objc, /* Number of array elements to join */ Tcl_Obj *const objv[]) /* Path elements to join. */ { if (pathPtr == NULL) { return TclJoinPath(objc, objv); } if (objc == 0) { return TclJoinPath(1, &pathPtr); } if (objc == 1) { Tcl_Obj *pair[2]; pair[0] = pathPtr; pair[1] = objv[0]; return TclJoinPath(2, pair); } else { int elemc = objc + 1; Tcl_Obj *ret, **elemv = ckalloc(elemc*sizeof(Tcl_Obj *)); elemv[0] = pathPtr; memcpy(elemv+1, objv, objc*sizeof(Tcl_Obj *)); ret = TclJoinPath(elemc, elemv); ckfree(elemv); return ret; } } /* *---------------------------------------------------------------------------   | | | |  804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835  Tcl_Obj * Tcl_FSJoinToPath( Tcl_Obj *pathPtr, /* Valid path or NULL. */ int objc, /* Number of array elements to join */ Tcl_Obj *const objv[]) /* Path elements to join. */ { if (pathPtr == NULL) { return TclJoinPath(objc, objv, 0); } if (objc == 0) { return TclJoinPath(1, &pathPtr, 0); } if (objc == 1) { Tcl_Obj *pair[2]; pair[0] = pathPtr; pair[1] = objv[0]; return TclJoinPath(2, pair, 0); } else { int elemc = objc + 1; Tcl_Obj *ret, **elemv = ckalloc(elemc*sizeof(Tcl_Obj *)); elemv[0] = pathPtr; memcpy(elemv+1, objv, objc*sizeof(Tcl_Obj *)); ret = TclJoinPath(elemc, elemv, 0); ckfree(elemv); return ret; } } /* *---------------------------------------------------------------------------  Changes to generic/tclIOUtil.c.  135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 .... 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 .... 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 .... 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 3716  Tcl_FSLstatProc TclpObjLstat; Tcl_FSCopyFileProc TclpObjCopyFile; Tcl_FSDeleteFileProc TclpObjDeleteFile; Tcl_FSRenameFileProc TclpObjRenameFile; Tcl_FSCreateDirectoryProc TclpObjCreateDirectory; Tcl_FSCopyDirectoryProc TclpObjCopyDirectory; Tcl_FSRemoveDirectoryProc TclpObjRemoveDirectory; Tcl_FSUnloadFileProc TclpUnloadFile; Tcl_FSLinkProc TclpObjLink; Tcl_FSListVolumesProc TclpObjListVolumes; /* * Define the native filesystem dispatch table. If necessary, it is ok to make * this non-static, but it should only be accessed by the functions actually * listed within it (or perhaps other helper functions of them). Anything ................................................................................ * unlink. The env variable TCL_TEMPLOAD_NO_UNLINK allows detection of a * users general request (unlink and not. * * By default the unlink is done (if not in AUFS). However if the variable is * present and set to true (any integer > 0) then the unlink is skipped. */ int TclSkipUnlink (Tcl_Obj* shlibFile) { /* Order of testing: * 1. On hpux we generally want to skip unlink in general * * Outside of hpux then: * 2. For a general user request (TCL_TEMPLOAD_NO_UNLINK present, non-empty, => int) * 3. For general AUFS environment (statfs, if available). ................................................................................ /* * Try to delete the file immediately - this is possible in some OSes, and * avoids any worries about leaving the copy laying around on exit. */ if ( !TclSkipUnlink (copyToPtr) && (Tcl_FSDeleteFile(copyToPtr) == TCL_OK)) { Tcl_DecrRefCount(copyToPtr); /* * We tell our caller about the real shared library which was loaded. * Note that this does mean that the package list maintained by 'load' * will store the original (vfs) path alongside the temporary load ................................................................................ if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot unload: filesystem does not support unloading", -1)); } return TCL_ERROR; } TclpUnloadFile(handle); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclpUnloadFile -- * * Unloads a library given its handle * * This function was once filesystem-specific, but has been made portable by * having TclpDlopen return a structure that includes procedure pointers. * *---------------------------------------------------------------------- */ void TclpUnloadFile( Tcl_LoadHandle handle) { if (handle->unloadFileProcPtr != NULL) { handle->unloadFileProcPtr(handle); } } /* *---------------------------------------------------------------------- * * TclFSUnloadTempFile -- *   < | | | < < < < < < < < < < < < < < < < < < < < < >  135 136 137 138 139 140 141 142 143 144 145 146 147 148 .... 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 .... 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 .... 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695  Tcl_FSLstatProc TclpObjLstat; Tcl_FSCopyFileProc TclpObjCopyFile; Tcl_FSDeleteFileProc TclpObjDeleteFile; Tcl_FSRenameFileProc TclpObjRenameFile; Tcl_FSCreateDirectoryProc TclpObjCreateDirectory; Tcl_FSCopyDirectoryProc TclpObjCopyDirectory; Tcl_FSRemoveDirectoryProc TclpObjRemoveDirectory; Tcl_FSLinkProc TclpObjLink; Tcl_FSListVolumesProc TclpObjListVolumes; /* * Define the native filesystem dispatch table. If necessary, it is ok to make * this non-static, but it should only be accessed by the functions actually * listed within it (or perhaps other helper functions of them). Anything ................................................................................ * unlink. The env variable TCL_TEMPLOAD_NO_UNLINK allows detection of a * users general request (unlink and not. * * By default the unlink is done (if not in AUFS). However if the variable is * present and set to true (any integer > 0) then the unlink is skipped. */ static int skipUnlink (Tcl_Obj* shlibFile) { /* Order of testing: * 1. On hpux we generally want to skip unlink in general * * Outside of hpux then: * 2. For a general user request (TCL_TEMPLOAD_NO_UNLINK present, non-empty, => int) * 3. For general AUFS environment (statfs, if available). ................................................................................ /* * Try to delete the file immediately - this is possible in some OSes, and * avoids any worries about leaving the copy laying around on exit. */ if ( !skipUnlink (copyToPtr) && (Tcl_FSDeleteFile(copyToPtr) == TCL_OK)) { Tcl_DecrRefCount(copyToPtr); /* * We tell our caller about the real shared library which was loaded. * Note that this does mean that the package list maintained by 'load' * will store the original (vfs) path alongside the temporary load ................................................................................ if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot unload: filesystem does not support unloading", -1)); } return TCL_ERROR; } if (handle->unloadFileProcPtr != NULL) { handle->unloadFileProcPtr(handle); } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclFSUnloadTempFile -- *  Changes to generic/tclInt.h.  2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945 .... 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038  MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr, Tcl_Obj *objPtr); MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr, Tcl_DString *toAppendPtr); MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr); MODULE_SCOPE Tcl_Obj *const * TclFetchEnsembleRoot(Tcl_Interp *interp, Tcl_Obj *const *objv, int objc, int *objcPtr); Tcl_Namespace * TclEnsureNamespace( Tcl_Interp *interp, Tcl_Namespace *namespacePtr); MODULE_SCOPE void TclFinalizeAllocSubsystem(void); MODULE_SCOPE void TclFinalizeAsync(void); MODULE_SCOPE void TclFinalizeDoubleConversion(void); MODULE_SCOPE void TclFinalizeEncodingSubsystem(void); ................................................................................ MODULE_SCOPE void TclInitNamespaceSubsystem(void); MODULE_SCOPE void TclInitNotifier(void); MODULE_SCOPE void TclInitObjSubsystem(void); MODULE_SCOPE void TclInitSubsystems(void); MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp); MODULE_SCOPE int TclIsSpaceProc(char byte); MODULE_SCOPE int TclIsBareword(char byte); MODULE_SCOPE Tcl_Obj * TclJoinPath(int elements, Tcl_Obj * const objv[]); MODULE_SCOPE int TclJoinThread(Tcl_ThreadId id, int *result); MODULE_SCOPE void TclLimitRemoveAllHandlers(Tcl_Interp *interp); MODULE_SCOPE Tcl_Obj * TclLindexList(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *argPtr); MODULE_SCOPE Tcl_Obj * TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, int indexCount, Tcl_Obj *const indexArray[]); /* TIP #280 */   | | >  2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945 .... 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039  MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr, Tcl_Obj *objPtr); MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr, Tcl_DString *toAppendPtr); MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr); MODULE_SCOPE Tcl_Obj *const * TclFetchEnsembleRoot(Tcl_Interp *interp, Tcl_Obj *const *objv, int objc, int *objcPtr); MODULE_SCOPE Tcl_Namespace * TclEnsureNamespace( Tcl_Interp *interp, Tcl_Namespace *namespacePtr); MODULE_SCOPE void TclFinalizeAllocSubsystem(void); MODULE_SCOPE void TclFinalizeAsync(void); MODULE_SCOPE void TclFinalizeDoubleConversion(void); MODULE_SCOPE void TclFinalizeEncodingSubsystem(void); ................................................................................ MODULE_SCOPE void TclInitNamespaceSubsystem(void); MODULE_SCOPE void TclInitNotifier(void); MODULE_SCOPE void TclInitObjSubsystem(void); MODULE_SCOPE void TclInitSubsystems(void); MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp); MODULE_SCOPE int TclIsSpaceProc(char byte); MODULE_SCOPE int TclIsBareword(char byte); MODULE_SCOPE Tcl_Obj * TclJoinPath(int elements, Tcl_Obj * const objv[], int forceRelative); MODULE_SCOPE int TclJoinThread(Tcl_ThreadId id, int *result); MODULE_SCOPE void TclLimitRemoveAllHandlers(Tcl_Interp *interp); MODULE_SCOPE Tcl_Obj * TclLindexList(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *argPtr); MODULE_SCOPE Tcl_Obj * TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, int indexCount, Tcl_Obj *const indexArray[]); /* TIP #280 */  Changes to generic/tclListObj.c.  1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015   } bytesNeeded += numElems; /* * Pass 2: copy into string rep buffer. */ listPtr->length = bytesNeeded - 1; listPtr->bytes = ckalloc(bytesNeeded); dst = listPtr->bytes; for (i = 0; i < numElems; i++) { flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0); elem = TclGetStringFromObj(elemPtrs[i], &length); dst += TclConvertElement(elem, length, dst, flagPtr[i]); *dst++ = ' '; } listPtr->bytes[listPtr->length] = '\0'; if (flagPtr != localFlags) { ckfree(flagPtr); } } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */   > > > > > > > > > > > > > > > > > |  1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032   } bytesNeeded += numElems; /* * Pass 2: copy into string rep buffer. */ /* * We used to set the string length here, relying on a presumed * guarantee that the number of bytes TclScanElement() calls reported * to be needed was a precise count and not an over-estimate, so long * as the same flag values were passed to TclConvertElement(). * * Then we saw [35a8f1c04a], where a bug in TclScanElement() caused * that guarantee to fail. Rather than trust there are no more bugs, * we set the length after the loop based on what was actually written, * an not on what was predicted. * listPtr->length = bytesNeeded - 1; * */ listPtr->bytes = ckalloc(bytesNeeded); dst = listPtr->bytes; for (i = 0; i < numElems; i++) { flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0); elem = TclGetStringFromObj(elemPtrs[i], &length); dst += TclConvertElement(elem, length, dst, flagPtr[i]); *dst++ = ' '; } dst[-1] = '\0'; /* Here is the safe setting of the string length. */ listPtr->length = dst - 1 - listPtr->bytes; if (flagPtr != localFlags) { ckfree(flagPtr); } } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */  Changes to generic/tclOO.c.  52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 .. 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 ... 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 ... 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 ... 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 ... 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 ... 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 ... 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 ... 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 ... 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 .... 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 .... 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 .... 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 .... 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 .... 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 .... 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 .... 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725   #define ALLOC_CHUNK 8 /* * 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, Method *mPtr, Tcl_Obj *namePtr, Method **newMPtrPtr); static int CloneObjectMethod(Tcl_Interp *interp, Object *oPtr, Method *mPtr, Tcl_Obj *namePtr); ................................................................................ static void KillFoundation(ClientData clientData, Tcl_Interp *interp); static void MyDeleted(ClientData clientData); 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, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int PublicNRObjectCmd(ClientData clientData, Tcl_Interp *interp, int objc, ................................................................................ /* * Create the objects at the core of the object system. These need to be * spliced manually. */ /* Stand up a phony class for bootstrapping. */ fPtr->objectCls = &fakeCls; /* referenced in AllocClass to increment the refCount. */ fakeCls.thisPtr = &fakeObject; fPtr->objectCls = AllocClass(interp, AllocObject(interp, "object", (Namespace *)fPtr->ooNs, NULL)); /* Corresponding TclOODecrRefCount in KillFoudation */ AddRef(fPtr->objectCls->thisPtr); /* This is why it is unnecessary in this routine to replace the * incremented reference count of fPtr->objectCls that was swallowed by * fakeObject. */ ................................................................................ ckfree(fPtr->objectCls->superclasses.list); fPtr->objectCls->superclasses.list = NULL; /* special initialization for the primordial objects */ fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT; fPtr->objectCls->flags |= ROOT_OBJECT; fPtr->classCls = AllocClass(interp, AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL)); /* Corresponding TclOODecrRefCount in KillFoudation */ AddRef(fPtr->classCls->thisPtr); /* * Increment reference counts for each reference because these * relationships can be dynamically changed. ................................................................................ TclOODecrRefCount(oPtr); return; } /* * ---------------------------------------------------------------------- * * DeleteDescendants -- * * Delete all descendants of a particular class. * * ---------------------------------------------------------------------- */ static void DeleteDescendants( Tcl_Interp *interp, /* The interpreter containing the class. */ Object *oPtr) /* The object representing the class. */ { Class *clsPtr = oPtr->classPtr, *subclassPtr, *mixinSubclassPtr; Object *instancePtr; /* ................................................................................ if (clsPtr->mixinSubs.num > 0) { while (clsPtr->mixinSubs.num > 0) { mixinSubclassPtr = clsPtr->mixinSubs.list[clsPtr->mixinSubs.num-1]; /* This condition also covers the case where mixinSubclassPtr == * clsPtr */ if (!Deleted(mixinSubclassPtr->thisPtr)) { Tcl_DeleteCommandFromToken(interp, mixinSubclassPtr->thisPtr->command); } TclOORemoveFromMixinSubs(mixinSubclassPtr, clsPtr); } } if (clsPtr->mixinSubs.size > 0) { ................................................................................ /* * Squelch subclasses of this class. */ 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); } TclOORemoveFromSubclasses(subclassPtr, clsPtr); } } if (clsPtr->subclasses.size > 0) { ckfree(clsPtr->subclasses.list); clsPtr->subclasses.list = NULL; ................................................................................ * Squelch instances of this class (includes objects we're mixed into). */ if (clsPtr->instances.num > 0) { 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)) { Tcl_DeleteCommandFromToken(interp, instancePtr->command); } TclOORemoveFromInstances(instancePtr, clsPtr); } } if (clsPtr->instances.size > 0) { ckfree(clsPtr->instances.list); ................................................................................ } } /* * ---------------------------------------------------------------------- * * ReleaseClassContents -- * * Tear down the special class data structure, including deleting all * dependent classes and objects. * * ---------------------------------------------------------------------- */ static void ReleaseClassContents( Tcl_Interp *interp, /* The interpreter containing the class. */ Object *oPtr) /* The object representing the class. */ { FOREACH_HASH_DECLS; int i; Class *clsPtr = oPtr->classPtr, *tmpClsPtr; Method *mPtr; ................................................................................ if (!Deleted(oPtr)) { if (IsRootClass(oPtr)) { Tcl_Panic("deleting class structure for non-deleted %s", "::oo::class"); } 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"); } } /* * Squelch method implementation chain caches. */ ................................................................................ * process of being deleted, nothing else may modify its bookeeping * records. This is the flag that */ oPtr->flags |= OBJECT_DELETED; /* Let the dominoes fall */ if (oPtr->classPtr) { DeleteDescendants(interp, oPtr); } /* * We do not run destructors on the core class objects when the * interpreter is being deleted; their incestuous nature causes problems * in that case when the destructor is partially deleted before the uses * of it have gone. [Bug 2949397] ................................................................................ TclOORemoveFromInstances(oPtr, oPtr->selfCls); if (oPtr->mixins.num > 0) { FOREACH(mixinPtr, oPtr->mixins) { TclOORemoveFromInstances(oPtr, mixinPtr); TclOODecrRefCount(mixinPtr->thisPtr); } ckfree(oPtr->mixins.list); } FOREACH(filterObj, oPtr->filters) { TclDecrRefCount(filterObj); } if (i) { ckfree(oPtr->filters.list); ................................................................................ } Tcl_DeleteHashTable(oPtr->metadataPtr); ckfree(oPtr->metadataPtr); oPtr->metadataPtr = NULL; } /* * 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. */ /* * 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_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command); } if (oPtr->classPtr != NULL) { ReleaseClassContents(interp, oPtr); } /* * Delete the object structure itself. */ TclNsDecrRefCount((Namespace *)oPtr->namespacePtr); ................................................................................ clsPtr->instances.list[clsPtr->instances.num++] = oPtr; AddRef(oPtr); } /* * ---------------------------------------------------------------------- * * TclOORemoveFromSubclasses -- * * Utility function to remove a class from the list of subclasses within * another class. Returns the number of removals performed. * * ---------------------------------------------------------------------- */ ................................................................................ return; } if (superPtr->subclasses.num >= superPtr->subclasses.size) { superPtr->subclasses.size += ALLOC_CHUNK; 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[superPtr->subclasses.num++] = subPtr; AddRef(subPtr->thisPtr); } /* ................................................................................ superPtr->mixinSubs.list[superPtr->mixinSubs.num++] = subPtr; AddRef(subPtr->thisPtr); } /* * ---------------------------------------------------------------------- * * AllocClass -- * * Allocate a basic class. Does not add class to its * class's instance list. * * ---------------------------------------------------------------------- */ static Class * AllocClass( Tcl_Interp *interp, /* Interpreter within which to allocate the * class. */ Object *useThisObj) /* Object that is to act as the class * representation. */ { Foundation *fPtr = GetFoundation(interp); Class *clsPtr = ckalloc(sizeof(Class)); ................................................................................ /* * Check to see if we're really creating a class. If so, allocate the * class structure as well. */ 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. */ AllocClass(interp, oPtr); TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls); } else { oPtr->classPtr = NULL; } return oPtr; }   < < < | | | | | | | > | > | > | > | | | < < < | > | > | | | < | < < > | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > | | | | | | | | | |  52 53 54 55 56 57 58 59 60 61 62 63 64 65 .. 74 75 76 77 78 79 80 81 82 83 84 85 86 87 ... 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 ... 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 ... 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 ... 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 ... 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 ... 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 ... 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 ... 937 938 939 940 941 942 943 944 945 946 947 948 949 950 .... 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 .... 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 .... 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 .... 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 .... 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 .... 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 .... 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759   #define ALLOC_CHUNK 8 /* * Function declarations for things defined in this file. */ static Object * AllocObject(Tcl_Interp *interp, const char *nameStr, Namespace *nsPtr, const char *nsNameStr); static int CloneClassMethod(Tcl_Interp *interp, Class *clsPtr, Method *mPtr, Tcl_Obj *namePtr, Method **newMPtrPtr); static int CloneObjectMethod(Tcl_Interp *interp, Object *oPtr, Method *mPtr, Tcl_Obj *namePtr); ................................................................................ static void KillFoundation(ClientData clientData, Tcl_Interp *interp); static void MyDeleted(ClientData clientData); static void ObjectNamespaceDeleted(ClientData clientData); static void ObjectRenamedTrace(ClientData clientData, Tcl_Interp *interp, const char *oldName, const char *newName, int flags); static inline void SquelchCachedName(Object *oPtr); static int PublicObjectCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int PublicNRObjectCmd(ClientData clientData, Tcl_Interp *interp, int objc, ................................................................................ /* * Create the objects at the core of the object system. These need to be * spliced manually. */ /* Stand up a phony class for bootstrapping. */ fPtr->objectCls = &fakeCls; /* referenced in TclOOAllocClass to increment the refCount. */ fakeCls.thisPtr = &fakeObject; fPtr->objectCls = TclOOAllocClass(interp, AllocObject(interp, "object", (Namespace *)fPtr->ooNs, NULL)); /* Corresponding TclOODecrRefCount in KillFoudation */ AddRef(fPtr->objectCls->thisPtr); /* This is why it is unnecessary in this routine to replace the * incremented reference count of fPtr->objectCls that was swallowed by * fakeObject. */ ................................................................................ ckfree(fPtr->objectCls->superclasses.list); fPtr->objectCls->superclasses.list = NULL; /* special initialization for the primordial objects */ fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT; fPtr->objectCls->flags |= ROOT_OBJECT; fPtr->classCls = TclOOAllocClass(interp, AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL)); /* Corresponding TclOODecrRefCount in KillFoudation */ AddRef(fPtr->classCls->thisPtr); /* * Increment reference counts for each reference because these * relationships can be dynamically changed. ................................................................................ TclOODecrRefCount(oPtr); return; } /* * ---------------------------------------------------------------------- * * TclOODeleteDescendants -- * * Delete all descendants of a particular class. * * ---------------------------------------------------------------------- */ void TclOODeleteDescendants( Tcl_Interp *interp, /* The interpreter containing the class. */ Object *oPtr) /* The object representing the class. */ { Class *clsPtr = oPtr->classPtr, *subclassPtr, *mixinSubclassPtr; Object *instancePtr; /* ................................................................................ if (clsPtr->mixinSubs.num > 0) { while (clsPtr->mixinSubs.num > 0) { mixinSubclassPtr = clsPtr->mixinSubs.list[clsPtr->mixinSubs.num-1]; /* This condition also covers the case where mixinSubclassPtr == * clsPtr */ if (!Deleted(mixinSubclassPtr->thisPtr) && !(mixinSubclassPtr->thisPtr->flags & DONT_DELETE)) { Tcl_DeleteCommandFromToken(interp, mixinSubclassPtr->thisPtr->command); } TclOORemoveFromMixinSubs(mixinSubclassPtr, clsPtr); } } if (clsPtr->mixinSubs.size > 0) { ................................................................................ /* * Squelch subclasses of this class. */ if (clsPtr->subclasses.num > 0) { while (clsPtr->subclasses.num > 0) { subclassPtr = clsPtr->subclasses.list[clsPtr->subclasses.num-1]; if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr) && !(subclassPtr->thisPtr->flags & DONT_DELETE)) { Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command); } TclOORemoveFromSubclasses(subclassPtr, clsPtr); } } if (clsPtr->subclasses.size > 0) { ckfree(clsPtr->subclasses.list); clsPtr->subclasses.list = NULL; ................................................................................ * Squelch instances of this class (includes objects we're mixed into). */ if (clsPtr->instances.num > 0) { 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) && !(instancePtr->flags & DONT_DELETE)) { Tcl_DeleteCommandFromToken(interp, instancePtr->command); } TclOORemoveFromInstances(instancePtr, clsPtr); } } if (clsPtr->instances.size > 0) { ckfree(clsPtr->instances.list); ................................................................................ } } /* * ---------------------------------------------------------------------- * * TclOOReleaseClassContents -- * * Tear down the special class data structure, including deleting all * dependent classes and objects. * * ---------------------------------------------------------------------- */ void TclOOReleaseClassContents( Tcl_Interp *interp, /* The interpreter containing the class. */ Object *oPtr) /* The object representing the class. */ { FOREACH_HASH_DECLS; int i; Class *clsPtr = oPtr->classPtr, *tmpClsPtr; Method *mPtr; ................................................................................ if (!Deleted(oPtr)) { if (IsRootClass(oPtr)) { Tcl_Panic("deleting class structure for non-deleted %s", "::oo::class"); } else if (IsRootObject(oPtr)) { Tcl_Panic("deleting class structure for non-deleted %s", "::oo::object"); } } /* * Squelch method implementation chain caches. */ ................................................................................ * process of being deleted, nothing else may modify its bookeeping * records. This is the flag that */ oPtr->flags |= OBJECT_DELETED; /* Let the dominoes fall */ if (oPtr->classPtr) { TclOODeleteDescendants(interp, oPtr); } /* * We do not run destructors on the core class objects when the * interpreter is being deleted; their incestuous nature causes problems * in that case when the destructor is partially deleted before the uses * of it have gone. [Bug 2949397] ................................................................................ TclOORemoveFromInstances(oPtr, oPtr->selfCls); if (oPtr->mixins.num > 0) { FOREACH(mixinPtr, oPtr->mixins) { TclOORemoveFromInstances(oPtr, mixinPtr); TclOODecrRefCount(mixinPtr->thisPtr); } if (oPtr->mixins.list != NULL) { ckfree(oPtr->mixins.list); } } FOREACH(filterObj, oPtr->filters) { TclDecrRefCount(filterObj); } if (i) { ckfree(oPtr->filters.list); ................................................................................ } Tcl_DeleteHashTable(oPtr->metadataPtr); ckfree(oPtr->metadataPtr); oPtr->metadataPtr = NULL; } /* * 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_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command); } if (oPtr->classPtr != NULL) { TclOOReleaseClassContents(interp, oPtr); } /* * Delete the object structure itself. */ TclNsDecrRefCount((Namespace *)oPtr->namespacePtr); ................................................................................ clsPtr->instances.list[clsPtr->instances.num++] = oPtr; 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; } } if (oPtr->mixins.num == 0) { ckfree(oPtr->mixins.list); oPtr->mixins.list = NULL; } return res; } /* * ---------------------------------------------------------------------- * * TclOORemoveFromSubclasses -- * * Utility function to remove a class from the list of subclasses within * another class. Returns the number of removals performed. * * ---------------------------------------------------------------------- */ ................................................................................ return; } if (superPtr->subclasses.num >= superPtr->subclasses.size) { superPtr->subclasses.size += ALLOC_CHUNK; 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[superPtr->subclasses.num++] = subPtr; AddRef(subPtr->thisPtr); } /* ................................................................................ superPtr->mixinSubs.list[superPtr->mixinSubs.num++] = subPtr; AddRef(subPtr->thisPtr); } /* * ---------------------------------------------------------------------- * * TclOOAllocClass -- * * Allocate a basic class. Does not add class to its class's instance * list. * * ---------------------------------------------------------------------- */ Class * TclOOAllocClass( Tcl_Interp *interp, /* Interpreter within which to allocate the * class. */ Object *useThisObj) /* Object that is to act as the class * representation. */ { Foundation *fPtr = GetFoundation(interp); Class *clsPtr = ckalloc(sizeof(Class)); ................................................................................ /* * Check to see if we're really creating a class. If so, allocate the * class structure as well. */ if (TclOOIsReachable(fPtr->classCls, classPtr)) { /* * 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. */ TclOOAllocClass(interp, oPtr); TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls); } else { oPtr->classPtr = NULL; } return oPtr; }  Changes to generic/tclOOCall.c.  1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454   AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr, doneFilters, flags|TRAVERSED_MIXIN, filterDecl); } if (flags & CONSTRUCTOR) { AddMethodToCallChain(classPtr->constructorPtr, cbPtr, doneFilters, filterDecl, flags); } else if (flags & DESTRUCTOR) { AddMethodToCallChain(classPtr->destructorPtr, cbPtr, doneFilters, filterDecl, flags); } else { Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods, (char *) methodNameObj);   <  1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453   AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr, doneFilters, flags|TRAVERSED_MIXIN, filterDecl); } if (flags & CONSTRUCTOR) { AddMethodToCallChain(classPtr->constructorPtr, cbPtr, doneFilters, filterDecl, flags); } else if (flags & DESTRUCTOR) { AddMethodToCallChain(classPtr->destructorPtr, cbPtr, doneFilters, filterDecl, flags); } else { Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods, (char *) methodNameObj);  Changes to generic/tclOODefineCmds.c.  1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 .... 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 .... 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610   ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Object *oPtr; Class *clsPtr; /* * Parse the context to get the object to operate on. */ oPtr = (Object *) TclOOGetDefineCmdContext(interp); if (oPtr == NULL) { ................................................................................ return TCL_ERROR; } clsPtr = GetClassInOuterContext(interp, objv[1], "the class of an object must be a class"); if (clsPtr == NULL) { return TCL_ERROR; } /* * Set the object's class. */ if (oPtr->selfCls != clsPtr) { TclOORemoveFromInstances(oPtr, oPtr->selfCls); TclOODecrRefCount(oPtr->selfCls->thisPtr); oPtr->selfCls = clsPtr; AddRef(oPtr->selfCls->thisPtr); TclOOAddToInstances(oPtr, oPtr->selfCls); if (oPtr->classPtr != NULL) { BumpGlobalEpoch(interp, oPtr->classPtr); } else { oPtr->epoch++; } } ................................................................................ if (TclOONewProcMethod(interp, oPtr->classPtr, isPublic, objv[1], objv[2], objv[3], NULL) == NULL) { return TCL_ERROR; } } return TCL_OK; } /* * ---------------------------------------------------------------------- * * TclOODefineMixinObjCmd -- * Implementation of the "mixin" subcommand of the "oo::define" and * "oo::objdefine" commands. * * ---------------------------------------------------------------------- */ int TclOODefineMixinObjCmd( ClientData clientData, Tcl_Interp *interp, const int objc, Tcl_Obj *const *objv) { int isInstanceMixin = (clientData != NULL); Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); Class **mixins; int i; if (oPtr == NULL) { return TCL_ERROR; } if (!isInstanceMixin && !oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } mixins = TclStackAlloc(interp, sizeof(Class *) * (objc-1)); for (i=1 ; iclassPtr, clsPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "may not mix a class into itself", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", NULL); goto freeAndError; } mixins[i-1] = clsPtr; } if (isInstanceMixin) { TclOOObjectSetMixins(oPtr, objc-1, mixins); } else { TclOOClassSetMixins(interp, oPtr->classPtr, objc-1, mixins); } TclStackFree(interp, mixins); return TCL_OK; freeAndError: TclStackFree(interp, mixins); return TCL_ERROR; } /* * ---------------------------------------------------------------------- * * TclOODefineRenameMethodObjCmd -- * Implementation of the "renamemethod" subcommand of the "oo::define" * and "oo::objdefine" commands.   > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < <  1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 .... 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 .... 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579   ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Object *oPtr; Class *clsPtr; Foundation *fPtr = TclOOGetFoundation(interp); int wasClass, willBeClass; /* * Parse the context to get the object to operate on. */ oPtr = (Object *) TclOOGetDefineCmdContext(interp); if (oPtr == NULL) { ................................................................................ return TCL_ERROR; } clsPtr = GetClassInOuterContext(interp, objv[1], "the class of an object must be a class"); 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); oPtr->selfCls = clsPtr; 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); ckfree(oPtr->classPtr); oPtr->classPtr = NULL; } else if (!wasClass && willBeClass) { TclOOAllocClass(interp, oPtr); } if (oPtr->classPtr != NULL) { BumpGlobalEpoch(interp, oPtr->classPtr); } else { oPtr->epoch++; } } ................................................................................ if (TclOONewProcMethod(interp, oPtr->classPtr, isPublic, objv[1], objv[2], objv[3], NULL) == NULL) { return TCL_ERROR; } } return TCL_OK; } /* * ---------------------------------------------------------------------- * * TclOODefineRenameMethodObjCmd -- * Implementation of the "renamemethod" subcommand of the "oo::define" * and "oo::objdefine" commands.  Changes to generic/tclOOInfo.c.  110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129   TclMakeEnsemble(interp, "::oo::InfoClass", infoClassCmds); /* * Install into the master [info] ensemble. */ infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY); Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict); Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("object", -1), Tcl_NewStringObj("::oo::InfoObject", -1)); Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("class", -1), Tcl_NewStringObj("::oo::InfoClass", -1)); Tcl_SetEnsembleMappingDict(interp, infoCmd, mapDict); } /* * ---------------------------------------------------------------------- * * GetClassFromObj -- *   > | | | | | | >  110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131   TclMakeEnsemble(interp, "::oo::InfoClass", infoClassCmds); /* * Install into the master [info] ensemble. */ infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY); if (infoCmd) { Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict); Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("object", -1), Tcl_NewStringObj("::oo::InfoObject", -1)); Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("class", -1), Tcl_NewStringObj("::oo::InfoClass", -1)); Tcl_SetEnsembleMappingDict(interp, infoCmd, mapDict); } } /* * ---------------------------------------------------------------------- * * GetClassFromObj -- *  Changes to generic/tclOOInt.h.  210 211 212 213 214 215 216 217 218 219 220 221 222 223 ... 480 481 482 483 484 485 486 487 488 489 490 491 492 493 ... 494 495 496 497 498 499 500 501 502 503 504 505 506 507 ... 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533   * no methods, mixins, or filters. */ #define ROOT_CLASS 0x8000 /* Flag to say that this object is the root * class of classes, and should be treated * specially during teardown (and in a few * other spots). */ #define FORCE_UNKNOWN 0x10000 /* States that we are *really* looking up the * unknown method handler at that point. */ /* * And the definition of a class. Note that every class also has an associated * object, through which it is manipulated. */ typedef struct Class { ................................................................................ * Private definitions, some of which perhaps ought to be exposed properly or * maybe just put in the internal stubs table. */ 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 int TclNRNewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, int objc, Tcl_Obj *const *objv, int skip, Tcl_Object *objectPtr); MODULE_SCOPE Object * TclNewObjectInstanceCommon(Tcl_Interp *interp, Class *classPtr, ................................................................................ const char *nameStr, const char *nsNameStr); MODULE_SCOPE int TclOODecrRefCount(Object *oPtr); 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 TclOODelMethodRef(Method *method); MODULE_SCOPE CallContext *TclOOGetCallContext(Object *oPtr, Tcl_Obj *methodNameObj, int flags, Tcl_Obj *cacheInThisObj); MODULE_SCOPE CallChain *TclOOGetStereotypeCallChain(Class *clsPtr, Tcl_Obj *methodNameObj, int flags); MODULE_SCOPE Foundation *TclOOGetFoundation(Tcl_Interp *interp); ................................................................................ Tcl_Obj *const objv[]); MODULE_SCOPE int TclNRObjectContextInvokeNext(Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip); MODULE_SCOPE void TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr, const DeclaredClassMethod *dcm); MODULE_SCOPE Tcl_Obj * TclOOObjectName(Tcl_Interp *interp, Object *oPtr); MODULE_SCOPE int TclOORemoveFromInstances(Object *oPtr, Class *clsPtr); MODULE_SCOPE int TclOORemoveFromMixinSubs(Class *subPtr, Class *mixinPtr); MODULE_SCOPE int TclOORemoveFromSubclasses(Class *subPtr, Class *superPtr); MODULE_SCOPE Tcl_Obj * TclOORenderCallChain(Tcl_Interp *interp, CallChain *callPtr); MODULE_SCOPE void TclOOStashContext(Tcl_Obj *objPtr,   > > > > > > > >  210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 ... 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 ... 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 ... 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541   * no methods, mixins, or filters. */ #define ROOT_CLASS 0x8000 /* Flag to say that this object is the root * class of classes, and should be treated * specially during teardown (and in a few * 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 * object, through which it is manipulated. */ typedef struct Class { ................................................................................ * Private definitions, some of which perhaps ought to be exposed properly or * maybe just put in the internal stubs table. */ 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, Tcl_Obj *const *objv, int skip, Tcl_Object *objectPtr); MODULE_SCOPE Object * TclNewObjectInstanceCommon(Tcl_Interp *interp, Class *classPtr, ................................................................................ const char *nameStr, const char *nsNameStr); MODULE_SCOPE int TclOODecrRefCount(Object *oPtr); 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, Tcl_Obj *cacheInThisObj); MODULE_SCOPE CallChain *TclOOGetStereotypeCallChain(Class *clsPtr, Tcl_Obj *methodNameObj, int flags); MODULE_SCOPE Foundation *TclOOGetFoundation(Tcl_Interp *interp); ................................................................................ Tcl_Obj *const objv[]); MODULE_SCOPE int TclNRObjectContextInvokeNext(Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip); 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, Class *superPtr); MODULE_SCOPE Tcl_Obj * TclOORenderCallChain(Tcl_Interp *interp, CallChain *callPtr); MODULE_SCOPE void TclOOStashContext(Tcl_Obj *objPtr,  Changes to generic/tclOOMethod.c.  966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983   *varPtr = rPtr->fetchProc(interp, rPtr); /* * Must not retain reference to resolved information. [Bug 3105999] */ if (rPtr != NULL) { rPtr->deleteProc(rPtr); } return (*varPtr? TCL_OK : TCL_CONTINUE); } static Tcl_Var ProcedureMethodCompiledVarConnect( Tcl_Interp *interp, Tcl_ResolvedVarInfo *rPtr) {   < | < |  966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981   *varPtr = rPtr->fetchProc(interp, rPtr); /* * Must not retain reference to resolved information. [Bug 3105999] */ rPtr->deleteProc(rPtr); return (*varPtr ? TCL_OK : TCL_CONTINUE); } static Tcl_Var ProcedureMethodCompiledVarConnect( Tcl_Interp *interp, Tcl_ResolvedVarInfo *rPtr) {  Changes to generic/tclPathObj.c.  825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 ... 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 ... 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 .... 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 .... 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 .... 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 .... 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477   Tcl_Obj * Tcl_FSJoinPath( Tcl_Obj *listObj, /* Path elements to join, may have a zero * reference count. */ int elements) /* Number of elements to use (-1 = all) */ { Tcl_Obj *copy, *res; int objc; Tcl_Obj **objv; if (Tcl_ListObjLength(NULL, listObj, &objc) != TCL_OK) { return NULL; } elements = ((elements >= 0) && (elements <= objc)) ? elements : objc; copy = TclListObjCopy(NULL, listObj); Tcl_ListObjGetElements(NULL, listObj, &objc, &objv); res = TclJoinPath(elements, objv); Tcl_DecrRefCount(copy); return res; } Tcl_Obj * TclJoinPath( int elements, Tcl_Obj * const objv[]) { Tcl_Obj *res = NULL; int i; const Tcl_Filesystem *fsPtr = NULL; assert ( elements >= 0 ); ................................................................................ * * Bugfix [a47641a0]. TclNewFSPathObj requires first argument * to be an absolute path. Added a check for that elt is absolute. */ if ((elt->typePtr == &tclFsPathType) && !((elt->bytes != NULL) && (elt->bytes[0] == '\0')) && TclGetPathType(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) { Tcl_Obj *tailObj = objv[1]; Tcl_PathType type = TclGetPathType(tailObj, NULL, NULL, NULL); if (type == TCL_PATH_RELATIVE) { const char *str; int len; str = Tcl_GetStringFromObj(tailObj, &len); if (len == 0) { /* ................................................................................ Tcl_PathType type; char *strElt, *ptr; Tcl_Obj *driveName = NULL; Tcl_Obj *elt = objv[i]; strElt = Tcl_GetStringFromObj(elt, &strEltLen); driveNameLength = 0; type = TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName); if (type != TCL_PATH_RELATIVE) { /* * Zero out the current result. */ if (res != NULL) { TclDecrRefCount(res); ................................................................................ len = 0; } break; default: count = 0; state = 1; } case 1: /* Scanning for next dirsep */ switch (*p) { case '/': case '\\': case ':': state = 0; break; ................................................................................ name = Tcl_GetStringFromObj(pathPtr, &len); /* * Handle tilde substitutions, if needed. */ if (name[0] == '~') { Tcl_DString temp; int split; char separator = '/'; split = FindSplitPos(name, separator); if (split != len) { /* * We have multiple pieces '~user/foo/bar...' */ name[split] = '\0'; } /* * Do some tilde substitution. */ if (name[1] == '\0') { /* * We have just '~' */ const char *dir; Tcl_DString dirString; if (split != len) { name[split] = separator; } dir = TclGetEnv("HOME", &dirString); if (dir == NULL) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "couldn't find HOME environment variable to" " expand path", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", ................................................................................ Tcl_JoinPath(1, &dir, &temp); Tcl_DStringFree(&dirString); } else { /* * We have a user name '~user' */ Tcl_DStringInit(&temp); if (TclpGetUserHome(name+1, &temp) == NULL) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "user \"%s\" doesn't exist", name+1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER", NULL); } Tcl_DStringFree(&temp); if (split != len) { name[split] = separator; } return TCL_ERROR; } if (split != len) { name[split] = separator; } } transPtr = TclDStringToObj(&temp); if (split != len) { /* * Join up the tilde substitution with the rest. ................................................................................ } TclDecrRefCount(parts); } else { Tcl_Obj *pair[2]; pair[0] = transPtr; pair[1] = Tcl_NewStringObj(name+split+1, -1); transPtr = TclJoinPath(2, pair); Tcl_DecrRefCount(pair[0]); Tcl_DecrRefCount(pair[1]); } } } else { transPtr = TclJoinPath(1, &pathPtr); } /* * Now we have a translated filename in 'transPtr'. This will have forward * slashes on Windows, and will not contain any ~user sequences. */   | < | < | | > > | | | > > > > > | > | < < | < > > | < < < > | | < < < < > > > > > > > | | > < < < < < < > | > | > > | > |  825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 ... 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 ... 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 .... 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 .... 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 .... 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 .... 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483   Tcl_Obj * Tcl_FSJoinPath( Tcl_Obj *listObj, /* Path elements to join, may have a zero * reference count. */ int elements) /* Number of elements to use (-1 = all) */ { Tcl_Obj *res; int objc; Tcl_Obj **objv; if (Tcl_ListObjLength(NULL, listObj, &objc) != TCL_OK) { return NULL; } elements = ((elements >= 0) && (elements <= objc)) ? elements : objc; Tcl_ListObjGetElements(NULL, listObj, &objc, &objv); res = TclJoinPath(elements, objv, 0); return res; } Tcl_Obj * TclJoinPath( int elements, /* Number of elements to use (-1 = all) */ Tcl_Obj * const objv[], /* Path elements to join */ int forceRelative) /* If non-zero, assume all more paths are * relative (e. g. simple normalization) */ { Tcl_Obj *res = NULL; int i; const Tcl_Filesystem *fsPtr = NULL; assert ( elements >= 0 ); ................................................................................ * * Bugfix [a47641a0]. TclNewFSPathObj requires first argument * to be an absolute path. Added a check for that elt is absolute. */ if ((elt->typePtr == &tclFsPathType) && !((elt->bytes != NULL) && (elt->bytes[0] == '\0')) && TclGetPathType(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) { Tcl_Obj *tailObj = objv[1]; Tcl_PathType type; /* if forceRelative - second path is relative */ type = forceRelative ? TCL_PATH_RELATIVE : TclGetPathType(tailObj, NULL, NULL, NULL); if (type == TCL_PATH_RELATIVE) { const char *str; int len; str = Tcl_GetStringFromObj(tailObj, &len); if (len == 0) { /* ................................................................................ Tcl_PathType type; char *strElt, *ptr; Tcl_Obj *driveName = NULL; Tcl_Obj *elt = objv[i]; strElt = Tcl_GetStringFromObj(elt, &strEltLen); driveNameLength = 0; /* if forceRelative - all paths excepting first one are relative */ type = (forceRelative && (i > 0)) ? TCL_PATH_RELATIVE : TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName); if (type != TCL_PATH_RELATIVE) { /* * Zero out the current result. */ if (res != NULL) { TclDecrRefCount(res); ................................................................................ len = 0; } break; default: count = 0; state = 1; } break; case 1: /* Scanning for next dirsep */ switch (*p) { case '/': case '\\': case ':': state = 0; break; ................................................................................ name = Tcl_GetStringFromObj(pathPtr, &len); /* * Handle tilde substitutions, if needed. */ if (len && name[0] == '~') { Tcl_DString temp; int split; char separator = '/'; /* * We have multiple cases '~/foo/bar...', '~user/foo/bar...', etc. * split becomes value 1 for '~/...' as well as for '~'. */ split = FindSplitPos(name, separator); /* * Do some tilde substitution. */ if (split == 1) { /* * We have just '~' (or '~/...') */ const char *dir; Tcl_DString dirString; dir = TclGetEnv("HOME", &dirString); if (dir == NULL) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "couldn't find HOME environment variable to" " expand path", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", ................................................................................ Tcl_JoinPath(1, &dir, &temp); Tcl_DStringFree(&dirString); } else { /* * We have a user name '~user' */ const char *expandedUser; Tcl_DString userName; Tcl_DStringInit(&userName); Tcl_DStringAppend(&userName, name+1, split-1); expandedUser = Tcl_DStringValue(&userName); Tcl_DStringInit(&temp); if (TclpGetUserHome(expandedUser, &temp) == NULL) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "user \"%s\" doesn't exist", expandedUser)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER", NULL); } Tcl_DStringFree(&userName); Tcl_DStringFree(&temp); return TCL_ERROR; } Tcl_DStringFree(&userName); } transPtr = TclDStringToObj(&temp); if (split != len) { /* * Join up the tilde substitution with the rest. ................................................................................ } TclDecrRefCount(parts); } else { Tcl_Obj *pair[2]; pair[0] = transPtr; pair[1] = Tcl_NewStringObj(name+split+1, -1); transPtr = TclJoinPath(2, pair, 1); if (transPtr != pair[0]) { Tcl_DecrRefCount(pair[0]); } if (transPtr != pair[1]) { Tcl_DecrRefCount(pair[1]); } } } } else { transPtr = TclJoinPath(1, &pathPtr, 1); } /* * Now we have a translated filename in 'transPtr'. This will have forward * slashes on Windows, and will not contain any ~user sequences. */  Changes to generic/tclProc.c.  500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 ... 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 .... 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 .... 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085   Tcl_SetObjResult(interp, Tcl_NewStringObj( "argument with no name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "FORMALARGUMENTFORMAT", NULL); goto procError; } nameLength = Tcl_NumUtfChars(Tcl_GetString(fieldValues[0]), fieldValues[0]->length); if (fieldCount == 2) { valueLength = Tcl_NumUtfChars(Tcl_GetString(fieldValues[1]), fieldValues[1]->length); } else { valueLength = 0; } /* * Check that the formal parameter name is a scalar. */ argname = Tcl_GetStringFromObj(fieldValues[0], &plen); argnamei = argname; argnamelast = argname[plen-1]; while (plen--) { if (argnamei[0] == '(') { if (argnamelast == ')') { /* We have an array element. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "formal parameter \"%s\" is an array element", ................................................................................ if (procPtr->firstLocalPtr == NULL) { procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr; } else { procPtr->lastLocalPtr->nextPtr = localPtr; procPtr->lastLocalPtr = localPtr; } localPtr->nextPtr = NULL; localPtr->nameLength = Tcl_NumUtfChars(argname, fieldValues[0]->length); localPtr->frameIndex = i; localPtr->flags = VAR_ARGUMENT; localPtr->resolveInfo = NULL; if (fieldCount == 2) { localPtr->defValuePtr = fieldValues[1]; Tcl_IncrRefCount(localPtr->defValuePtr); ................................................................................ static int ProcWrongNumArgs( Tcl_Interp *interp, int skip) { 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; /* * Build up desired argument list for Tcl_WrongNumArgs */ ................................................................................ desiredObjs[0] = framePtr->objv[skip-1]; #else desiredObjs[0] = Tcl_NewListObj(1, framePtr->objv + skip - 1); #endif /* AVOID_HACKS_FOR_ITCL */ } 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 (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; } Tcl_ResetResult(interp); Tcl_WrongNumArgs(interp, numArgs+1, desiredObjs, final); for (i=0 ; i<=numArgs ; i++) { Tcl_DecrRefCount(desiredObjs[i]);   > | | | < | < > | > | | | | | | | | | | | | | | | >  500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 ... 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 .... 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 .... 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087   Tcl_SetObjResult(interp, Tcl_NewStringObj( "argument with no name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "FORMALARGUMENTFORMAT", NULL); goto procError; } argname = Tcl_GetStringFromObj(fieldValues[0], &plen); nameLength = Tcl_NumUtfChars(argname, plen); if (fieldCount == 2) { const char * value = TclGetString(fieldValues[1]); valueLength = Tcl_NumUtfChars(value, fieldValues[1]->length); } else { valueLength = 0; } /* * Check that the formal parameter name is a scalar. */ argnamei = argname; argnamelast = argname[plen-1]; while (plen--) { if (argnamei[0] == '(') { if (argnamelast == ')') { /* We have an array element. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "formal parameter \"%s\" is an array element", ................................................................................ if (procPtr->firstLocalPtr == NULL) { procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr; } else { procPtr->lastLocalPtr->nextPtr = localPtr; procPtr->lastLocalPtr = localPtr; } localPtr->nextPtr = NULL; localPtr->nameLength = nameLength; localPtr->frameIndex = i; localPtr->flags = VAR_ARGUMENT; localPtr->resolveInfo = NULL; if (fieldCount == 2) { localPtr->defValuePtr = fieldValues[1]; Tcl_IncrRefCount(localPtr->defValuePtr); ................................................................................ static int ProcWrongNumArgs( Tcl_Interp *interp, int skip) { CallFrame *framePtr = ((Interp *)interp)->varFramePtr; register Proc *procPtr = framePtr->procPtr; int localCt = procPtr->numCompiledLocals, numArgs, i; Tcl_Obj **desiredObjs; const char *final = NULL; /* * Build up desired argument list for Tcl_WrongNumArgs */ ................................................................................ desiredObjs[0] = framePtr->objv[skip-1]; #else desiredObjs[0] = Tcl_NewListObj(1, framePtr->objv + skip - 1); #endif /* AVOID_HACKS_FOR_ITCL */ } Tcl_IncrRefCount(desiredObjs[0]); if (localCt > 0) { register Var *defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt); 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; } } Tcl_ResetResult(interp); Tcl_WrongNumArgs(interp, numArgs+1, desiredObjs, final); for (i=0 ; i<=numArgs ; i++) { Tcl_DecrRefCount(desiredObjs[i]);  Changes to generic/tclScan.c.  130 131 132 133 134 135 136 137 138 139 140 141 142 143 144   } else if (ch == '-') { /* * Check to see if this is the last character in the set, in which * case it is not a range and we should add the previous character * as well as the dash. */ if (*format == ']') { cset->chars[cset->nchars++] = start; cset->chars[cset->nchars++] = ch; } else { format += TclUtfToUniChar(format, &ch); /* * Check to see if the range is in reverse order.   |  130 131 132 133 134 135 136 137 138 139 140 141 142 143 144   } else if (ch == '-') { /* * Check to see if this is the last character in the set, in which * case it is not a range and we should add the previous character * as well as the dash. */ if (*format == ']' || !cset->ranges) { cset->chars[cset->nchars++] = start; cset->chars[cset->nchars++] = ch; } else { format += TclUtfToUniChar(format, &ch); /* * Check to see if the range is in reverse order.  Changes to generic/tclStringObj.c.  1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885   /* * Step 3. Minimum field width. */ width = 0; if (isdigit(UCHAR(ch))) { width = strtoul(format, &end, 10); format = end; step = TclUtfToUniChar(format, &ch); } else if (ch == '*') { if (objIndex >= objc - 1) { msg = badIndex[gotXpg]; errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH"; goto errorMsg;   > > > > >  1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890   /* * Step 3. Minimum field width. */ width = 0; if (isdigit(UCHAR(ch))) { width = strtoul(format, &end, 10); if (width < 0) { msg = overflow; errCode = "OVERFLOW"; goto errorMsg; } format = end; step = TclUtfToUniChar(format, &ch); } else if (ch == '*') { if (objIndex >= objc - 1) { msg = badIndex[gotXpg]; errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH"; goto errorMsg;  Changes to generic/tclStubInit.c.  7 8 9 10 11 12 13 14 15 16 17 18 19 20 ... 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 ... 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246   * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tommath.h" #ifdef __GNUC__ #pragma GCC dependency "tcl.decls" #pragma GCC dependency "tclInt.decls" #pragma GCC dependency "tclTomMath.decls" #endif ................................................................................ #elif defined(__CYGWIN__) # define TclpIsAtty TclPlatIsAtty # define TclWinSetInterfaces (void (*) (int)) doNothing # define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing # define TclWinFlushDirtyChannels doNothing # define TclWinResetInterfaces doNothing #if TCL_UTF_MAX < 4 static Tcl_Encoding winTCharEncoding; #endif static int TclpIsAtty(int fd) { return isatty(fd); } #define TclWinGetPlatformId winGetPlatformId ................................................................................ char * Tcl_WinUtfToTChar( const char *string, 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"); } return Tcl_UtfToExternalDString(winTCharEncoding, string, len, dsPtr); #endif } char * Tcl_WinTCharToUtf( const char *string, int len, Tcl_DString *dsPtr) { #if TCL_UTF_MAX > 3 char *p; int size; if (len > 0) { 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 } #if defined(TCL_WIDE_INT_IS_LONG) /* On Cygwin64, long is 64-bit while on Win64 long is 32-bit. Therefore * we have to make sure that all stub entries on Cygwin64 follow the Win64 * signature. Tcl 9 must find a better solution, but that cannot be done   > > > > < < < < | | | > > > > > > > > > > > > > > > > > > > | > | < < > > > > > > > > > > > > > > > > > > > > > > > > > > > > | < > > | < < < < | | > | < > > > > > > | > > < > | | | < < > > > > > > > > > > > > > > > > | < > | < < < < |  7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 ... 106 107 108 109 110 111 112 113 114 115 116 117 118 119 ... 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307   * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tommath.h" #ifdef __CYGWIN__ # include #endif #ifdef __GNUC__ #pragma GCC dependency "tcl.decls" #pragma GCC dependency "tclInt.decls" #pragma GCC dependency "tclTomMath.decls" #endif ................................................................................ #elif defined(__CYGWIN__) # define TclpIsAtty TclPlatIsAtty # define TclWinSetInterfaces (void (*) (int)) doNothing # define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing # define TclWinFlushDirtyChannels doNothing # define TclWinResetInterfaces doNothing static int TclpIsAtty(int fd) { return isatty(fd); } #define TclWinGetPlatformId winGetPlatformId ................................................................................ char * Tcl_WinUtfToTChar( const char *string, int len, Tcl_DString *dsPtr) { #if TCL_UTF_MAX > 4 Tcl_UniChar ch = 0; wchar_t *w, *wString; const char *p, *end; int oldLength; #endif Tcl_DStringInit(dsPtr); if (!string) { return NULL; } #if TCL_UTF_MAX > 4 if (len < 0) { len = strlen(string); } /* * Unicode string length in Tcl_UniChars will be <= UTF-8 string length in * bytes. */ oldLength = Tcl_DStringLength(dsPtr); Tcl_DStringSetLength(dsPtr, oldLength + (int) ((len + 1) * sizeof(wchar_t))); wString = (wchar_t *) (Tcl_DStringValue(dsPtr) + oldLength); w = wString; p = string; end = string + len - 4; while (p < end) { p += TclUtfToUniChar(p, &ch); if (ch > 0xFFFF) { *w++ = (wchar_t) (0xD800 + ((ch -= 0x10000) >> 10)); *w++ = (wchar_t) (0xDC00 | (ch & 0x3FF)); } else { *w++ = ch; } } end += 4; while (p < end) { if (Tcl_UtfCharComplete(p, end-p)) { p += TclUtfToUniChar(p, &ch); } else { ch = UCHAR(*p++); } if (ch > 0xFFFF) { *w++ = (wchar_t) (0xD800 + ((ch -= 0x10000) >> 10)); *w++ = (wchar_t) (0xDC00 | (ch & 0x3FF)); } else { *w++ = ch; } } *w = '\0'; Tcl_DStringSetLength(dsPtr, oldLength + ((char *) w - (char *) wString)); return (char *)wString; #else return (char *)Tcl_UtfToUniCharDString(string, len, dsPtr); #endif } char * Tcl_WinTCharToUtf( const char *string, int len, Tcl_DString *dsPtr) { #if TCL_UTF_MAX > 4 const wchar_t *w, *wEnd; char *p, *result; int oldLength, blen = 1; #endif Tcl_DStringInit(dsPtr); if (!string) { return NULL; } if (len < 0) { len = wcslen((wchar_t *)string); } else { len /= 2; } #if TCL_UTF_MAX > 4 oldLength = Tcl_DStringLength(dsPtr); Tcl_DStringSetLength(dsPtr, oldLength + (len + 1) * 4); result = Tcl_DStringValue(dsPtr) + oldLength; p = result; wEnd = (wchar_t *)string + len; for (w = (wchar_t *)string; w < wEnd; ) { if (!blen && ((*w & 0xFC00) != 0xDC00)) { /* Special case for handling upper surrogates. */ p += Tcl_UniCharToUtf(-1, p); } blen = Tcl_UniCharToUtf(*w, p); p += blen; w++; } if (!blen) { /* Special case for handling upper surrogates. */ p += Tcl_UniCharToUtf(-1, p); } Tcl_DStringSetLength(dsPtr, oldLength + (p - result)); return result; #else return Tcl_UniCharToUtfDString((Tcl_UniChar *)string, len, dsPtr); #endif } #if defined(TCL_WIDE_INT_IS_LONG) /* On Cygwin64, long is 64-bit while on Win64 long is 32-bit. Therefore * we have to make sure that all stub entries on Cygwin64 follow the Win64 * signature. Tcl 9 must find a better solution, but that cannot be done  Changes to generic/tclTrace.c.  533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 .... 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 .... 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 .... 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953   /* * We need to remove the interpreter-wide trace which * we created to allow 'step' traces. */ Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; if (tcmdPtr->startCmd != NULL) { ckfree(tcmdPtr->startCmd); } } if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) { /* * Postpone deletion. */ tcmdPtr->flags = 0; ................................................................................ if (flags & (TCL_TRACE_DESTROYED | TCL_TRACE_DELETE)) { int untraceFlags = tcmdPtr->flags; Tcl_InterpState state; if (tcmdPtr->stepTrace != NULL) { Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; if (tcmdPtr->startCmd != NULL) { ckfree(tcmdPtr->startCmd); } } if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) { /* * Postpone deletion, until exec trace returns. */ tcmdPtr->flags = 0; ................................................................................ */ if ((flags & TCL_TRACE_LEAVE_EXEC) && (tcmdPtr->stepTrace != NULL) && (level == tcmdPtr->startLevel) && (strcmp(command, tcmdPtr->startCmd) == 0)) { Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; if (tcmdPtr->startCmd != NULL) { ckfree(tcmdPtr->startCmd); } } /* * Second, create the tcl callback, if required. */ if (call) { ................................................................................ TraceExecutionProc, tcmdPtr, CommandObjTraceDeleted); } } if (flags & TCL_TRACE_DESTROYED) { if (tcmdPtr->stepTrace != NULL) { Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; if (tcmdPtr->startCmd != NULL) { ckfree(tcmdPtr->startCmd); } } } if (call) { if (tcmdPtr->refCount-- <= 1) { ckfree(tcmdPtr); } }   < | < < | < < | < < | <  533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 .... 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 .... 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 .... 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945   /* * We need to remove the interpreter-wide trace which * we created to allow 'step' traces. */ Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; ckfree(tcmdPtr->startCmd); } if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) { /* * Postpone deletion. */ tcmdPtr->flags = 0; ................................................................................ if (flags & (TCL_TRACE_DESTROYED | TCL_TRACE_DELETE)) { int untraceFlags = tcmdPtr->flags; Tcl_InterpState state; if (tcmdPtr->stepTrace != NULL) { Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; ckfree(tcmdPtr->startCmd); } if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) { /* * Postpone deletion, until exec trace returns. */ tcmdPtr->flags = 0; ................................................................................ */ if ((flags & TCL_TRACE_LEAVE_EXEC) && (tcmdPtr->stepTrace != NULL) && (level == tcmdPtr->startLevel) && (strcmp(command, tcmdPtr->startCmd) == 0)) { Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; ckfree(tcmdPtr->startCmd); } /* * Second, create the tcl callback, if required. */ if (call) { ................................................................................ TraceExecutionProc, tcmdPtr, CommandObjTraceDeleted); } } if (flags & TCL_TRACE_DESTROYED) { if (tcmdPtr->stepTrace != NULL) { Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; ckfree(tcmdPtr->startCmd); } } if (call) { if (tcmdPtr->refCount-- <= 1) { ckfree(tcmdPtr); } }  Changes to generic/tclUtf.c.  239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 ... 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450   /* * UTF-8 string length in bytes will be <= Unicode string length * * TCL_UTF_MAX. */ oldLength = Tcl_DStringLength(dsPtr); Tcl_DStringSetLength(dsPtr, (oldLength + uniLength + 1) * TCL_UTF_MAX); string = Tcl_DStringValue(dsPtr) + oldLength; p = string; wEnd = uniStr + uniLength; for (w = uniStr; w < wEnd; ) { p += Tcl_UniCharToUtf(*w, p); w++; ................................................................................ /* * Unicode string length in Tcl_UniChars will be <= UTF-8 string length in * bytes. */ oldLength = Tcl_DStringLength(dsPtr); /* TODO: fix overreach! */ Tcl_DStringSetLength(dsPtr, (int) ((oldLength + length + 1) * sizeof(Tcl_UniChar))); wString = (Tcl_UniChar *) (Tcl_DStringValue(dsPtr) + oldLength); w = wString; end = src + length; for (p = src; p < end; ) { p += TclUtfToUniChar(p, &ch); *w++ = ch; } *w = '\0'; Tcl_DStringSetLength(dsPtr, (oldLength + ((char *) w - (char *) wString))); return wString;   | | | | > | < > > > > > > > > > >  239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 ... 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460   /* * UTF-8 string length in bytes will be <= Unicode string length * * TCL_UTF_MAX. */ oldLength = Tcl_DStringLength(dsPtr); Tcl_DStringSetLength(dsPtr, oldLength + (uniLength + 1) * TCL_UTF_MAX); string = Tcl_DStringValue(dsPtr) + oldLength; p = string; wEnd = uniStr + uniLength; for (w = uniStr; w < wEnd; ) { p += Tcl_UniCharToUtf(*w, p); w++; ................................................................................ /* * Unicode string length in Tcl_UniChars will be <= UTF-8 string length in * bytes. */ oldLength = Tcl_DStringLength(dsPtr); Tcl_DStringSetLength(dsPtr, oldLength + (int) ((length + 1) * sizeof(Tcl_UniChar))); wString = (Tcl_UniChar *) (Tcl_DStringValue(dsPtr) + oldLength); w = wString; 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))); return wString;  Changes to generic/tclUtil.c.  1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054   /* * Empty string element must be brace quoted. */ *flagPtr = CONVERT_BRACE; return 2; } if ((*p == '{') || (*p == '"')) { /* * Must escape or protect so leading character of value is not * misinterpreted as list element delimiting syntax. */   > > > > > > > > > > > > > > > > >  1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071   /* * Empty string element must be brace quoted. */ *flagPtr = CONVERT_BRACE; return 2; } #if COMPAT /* * We have an established history in TclConvertElement() when quoting * because of a leading hash character to force what would be the * CONVERT_MASK mode into the CONVERT_BRACE mode. That is, we format * the element #{a"b} like this: * {#{a"b}} * and not like this: * \#{a\"b} * This is inconsistent with [list x{a"b}], but we will not change that now. * Set that preference here so that we compute a tight size requirement. */ if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) { preferBrace = 1; } #endif if ((*p == '{') || (*p == '"')) { /* * Must escape or protect so leading character of value is not * misinterpreted as list element delimiting syntax. */  Changes to generic/tclVar.c.  968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 .... 6128 6129 6130 6131 6132 6133 6134 6135 6136 6137 6138 6139 6140 6141 6142 6143 6144 6145 6146 6147 6148 6149 6150 6151 6152 6153 6154 6155 6156 6157 6158 6159 6160 6161 6162 6163 6164 6165 6166 6167 6168 6169 6170 6171 6172   } } else { /* Var wasn't found and not to create it. */ *errMsgPtr = noSuchVar; return NULL; } } } else { /* Local var: look in frame varFramePtr. */ int localLen, localCt = varFramePtr->numCompiledLocals; Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0; const char *localNameStr; for (i=0 ; icompiledLocals[i]; } } } tablePtr = varFramePtr->varTablePtr; if (create) { if (tablePtr == NULL) { tablePtr = ckalloc(sizeof(TclVarHashTable)); ................................................................................ Tcl_Obj *listPtr, /* List object to append names to. */ Tcl_Obj *patternPtr, /* Pattern to match against. */ int includeLinks) /* 1 if upvars should be included, else 0. */ { Interp *iPtr = (Interp *) interp; Var *varPtr; int i, localVarCt, added; Tcl_Obj **varNamePtr, *objNamePtr; const char *varName; TclVarHashTable *localVarTablePtr; Tcl_HashSearch search; Tcl_HashTable addedTable; const char *pattern = patternPtr? TclGetString(patternPtr) : NULL; 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 (*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); } } } varPtr++; } /* * Do nothing if no local variables. */ if (localVarTablePtr == NULL) {   | > > | | > | | | | | | | > | < > > > | | | | | | | | | | | | | | >  968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 .... 6132 6133 6134 6135 6136 6137 6138 6139 6140 6141 6142 6143 6144 6145 6146 6147 6148 6149 6150 6151 6152 6153 6154 6155 6156 6157 6158 6159 6160 6161 6162 6163 6164 6165 6166 6167 6168 6169 6170 6171 6172 6173 6174 6175 6176 6177 6178 6179   } } else { /* Var wasn't found and not to create it. */ *errMsgPtr = noSuchVar; return NULL; } } } else { /* Local var: look in frame varFramePtr. */ int localCt = varFramePtr->numCompiledLocals; if (localCt > 0) { Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0; const char *localNameStr; int localLen; for (i=0 ; icompiledLocals[i]; } } } } tablePtr = varFramePtr->varTablePtr; if (create) { if (tablePtr == NULL) { tablePtr = ckalloc(sizeof(TclVarHashTable)); ................................................................................ Tcl_Obj *listPtr, /* List object to append names to. */ Tcl_Obj *patternPtr, /* Pattern to match against. */ int includeLinks) /* 1 if upvars should be included, else 0. */ { Interp *iPtr = (Interp *) interp; Var *varPtr; int i, localVarCt, added; Tcl_Obj *objNamePtr; const char *varName; TclVarHashTable *localVarTablePtr; Tcl_HashSearch search; Tcl_HashTable addedTable; const char *pattern = patternPtr? TclGetString(patternPtr) : NULL; localVarCt = iPtr->varFramePtr->numCompiledLocals; varPtr = iPtr->varFramePtr->compiledLocals; localVarTablePtr = iPtr->varFramePtr->varTablePtr; if (includeLinks) { Tcl_InitObjHashTable(&addedTable); } if (localVarCt > 0) { Tcl_Obj **varNamePtr = &iPtr->varFramePtr->localCachePtr->varName0; 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); } } } varPtr++; } } /* * Do nothing if no local variables. */ if (localVarTablePtr == NULL) {  Changes to generic/tclZlib.c.  1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498   } } else { Tcl_ListObjLength(NULL, zshPtr->outData, &listLen); if (count == -1) { count = 0; for (i=0; ioutData, i, &itemObj); itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen); if (i == 0) { count += itemLen - zshPtr->outPos; } else { count += itemLen; } } }   |  1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498   } } else { Tcl_ListObjLength(NULL, zshPtr->outData, &listLen); if (count == -1) { count = 0; for (i=0; ioutData, i, &itemObj); (void) Tcl_GetByteArrayFromObj(itemObj, &itemLen); if (i == 0) { count += itemLen - zshPtr->outPos; } else { count += itemLen; } } }  Changes to library/dde/pkgIndex.tcl.  1 2 3 4 5 6 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] } else { package ifneeded dde 1.4.0 [list load [file join $dir tcldde14.dll] dde] }   | |  1 2 3 4 5 6 7  if {([info commands ::tcl::pkgconfig] eq "") || ([info sharedlibextension] ne ".dll")} return if {[::tcl::pkgconfig get debug]} { package ifneeded dde 1.4.1 [list load [file join$dir tcldde14g.dll] dde] } else { package ifneeded dde 1.4.1 [list load [file join $dir tcldde14.dll] dde] }  Changes to library/http/http.tcl.  7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 .. 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 .. 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 ... 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 ... 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 ... 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 ... 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 ... 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 ... 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 ... 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 ... 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 ... 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 ... 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 ... 891 892 893 894 895 896 897 898 899 900 901 902 903 904 ... 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 .... 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 .... 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 .... 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 .... 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 .... 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 .... 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 .... 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585  # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. package require Tcl 8.6- # Keep this in sync with pkgIndex.tcl and with the install directories in # Makefiles package provide http 2.8.13 namespace eval http { # Allow resourcing to not clobber existing data variable http if {![info exists http]} { array set http { -accept */* -proxyhost {} -proxyport {} -proxyfilter http::ProxyRequired -urlencoding utf-8 } # We need a useragent string of this style or various servers will refuse to # send us compressed content even when we ask for it. This follows the # de-facto layout of user-agent strings in current browsers. # Safe interpreters do not have ::tcl_platform(os) or # ::tcl_platform(osVersion). if {[interp issafe]} { set http(-useragent) "Mozilla/5.0\ (Windows; U;\ Windows NT 10.0)\ http/[package provide http] Tcl/[package provide Tcl]" } else { set http(-useragent) "Mozilla/5.0\ ([string totitle$::tcl_platform(platform)]; U;\ $::tcl_platform(os)$::tcl_platform(osVersion))\ http/[package provide http] Tcl/[package provide Tcl]" } } proc init {} { # Set up the map for quoting chars. RFC3986 Section 2.3 say percent # encode all except: "... percent-encoded octets in the ranges of # ALPHA (%41-%5A and %61-%7A), DIGIT (%30-%39), hyphen (%2D), period ................................................................................ } } # These are handled specially set map(\n) %0D%0A variable formMap [array get map] # Create a map for HTTP/1.1 open sockets variable socketmap if {[info exists socketmap]} { # Close but don't remove open sockets on re-init foreach {url sock} [array get socketmap] { catch {close $sock} } } array set socketmap {} } init variable urlTypes if {![info exists urlTypes]} { set urlTypes(http) [list 80 ::socket] } ................................................................................ # Let user control default keepalive for compatibility variable defaultKeepalive if {![info exists defaultKeepalive]} { set defaultKeepalive 0 } namespace export geturl config reset wait formatQuery register unregister # Useful, but not exported: data size status code } # http::Log -- # # Debugging output -- define this to observe HTTP/1.1 socket usage. # Should echo any args received. # ................................................................................ # http::Finish -- # # Clean up the socket and eval close time callbacks # # Arguments: # token Connection token. # errormsg (optional) If set, forces status to error. # skipCB (optional) If set, don't call the -command callback. This # is useful when geturl wants to throw an exception instead # of calling the callback. That way, the same error isn't # reported to two places. # # Side Effects: # Closes the socket proc http::Finish {token {errormsg ""} {skipCB 0}} { variable$token upvar 0 $token state global errorInfo errorCode if {$errormsg ne ""} { set state(error) [list $errormsg$errorInfo $errorCode] set state(status) "error" } if { ($state(status) eq "timeout") || ($state(status) eq "error") || ([info exists state(-keepalive)] && !$state(-keepalive)) || ([info exists state(connection)] && ($state(connection) eq "close")) } { CloseSocket$state(sock) $token } if {[info exists state(after)]} { after cancel$state(after) } if {[info exists state(-command)] && !$skipCB && ![info exists state(done-command-cb)]} { set state(done-command-cb) yes if {[catch {eval$state(-command) {$token}} err] &&$errormsg eq ""} { set state(error) [list $err$errorInfo $errorCode] set state(status) error } } } # http::CloseSocket - # # Close a socket and remove it from the persistent sockets table. If # possible an http token is included here but when we are called from a # fileevent on remote closure we need to find the correct entry - hence # the second section. proc ::http::CloseSocket {s {token {}}} { variable socketmap catch {fileevent$s readable {}} set conn_id {} if {$token ne ""} { variable$token upvar 0 $token state if {[info exists state(socketinfo)]} { set conn_id$state(socketinfo) } } else { set map [array get socketmap] set ndx [lsearch -exact $map$s] if {$ndx != -1} { incr ndx -1 set conn_id [lindex$map $ndx] } } if {$conn_id eq {} || ![info exists socketmap($conn_id)]} { Log "Closing socket$s (no connection info)" if {[catch {close $s} err]} { Log "Error:$err" } } else { if {[info exists socketmap($conn_id)]} { Log "Closing connection$conn_id (sock $socketmap($conn_id))" if {[catch {close $socketmap($conn_id)} err]} { Log "Error: $err" } unset socketmap($conn_id) } else { Log "Cannot close connection $conn_id - no socket in socket map" } } } # http::reset -- # # See documentation for details. # # Arguments: # token Connection token. # why Status info. # # Side Effects: # See Finish proc http::reset {token {why reset}} { variable$token upvar 0 $token state set state(status)$why catch {fileevent $state(sock) readable {}} catch {fileevent$state(sock) writable {}} ................................................................................ } # http::geturl -- # # Establishes a connection to a remote url via http. # # Arguments: # url The http URL to goget. # args Option value pairs. Valid options include: # -blocksize, -validate, -headers, -timeout # Results: # Returns a token for this connection. This token is the name of an # array that the caller should unset to garbage collect the state. proc http::geturl {url args} { variable http ................................................................................ # Initialize the state variable, an array. We'll return the name of this # array as the token for the transaction. if {![info exists http(uid)]} { set http(uid) 0 } set token [namespace current]::[incr http(uid)] variable $token upvar 0$token state reset $token # Process command options. array set state { -binary false -blocksize 8192 -queryblocksize 8192 ................................................................................ -validate 0 -headers {} -timeout 0 -type application/x-www-form-urlencoded -queryprogress {} -protocol 1.1 binary 0 state connecting meta {} coding {} currentsize 0 totalsize 0 querylength 0 queryoffset 0 type text/html body {} ................................................................................ if {$port != $defport} { append url :$port } append url $srvurl # Don't append the fragment! set state(url)$url # If a timeout is specified we set up the after event and arrange for an # asynchronous socket connection. set sockopts [list -async] if {$state(-timeout) > 0} { set state(after) [after$state(-timeout) \ [list http::reset $token timeout]] } # If we are using the proxy, we must pass in the full URL that includes # the server name. if {[info exists phost] && ($phost ne "")} { set srvurl $url set targetAddr [list$phost $pport] ................................................................................ } # Proxy connections aren't shared among different hosts. set state(socketinfo)$host:$port # Save the accept types at this point to prevent a race condition. [Bug # c11a51c482] set state(accept-types)$http(-accept) # See if we are supposed to use a previously opened channel. if {$state(-keepalive)} { variable socketmap if {[info exists socketmap($state(socketinfo))]} { if {[catch {fconfigure $socketmap($state(socketinfo))}]} { Log "WARNING: socket for $state(socketinfo) was closed" unset socketmap($state(socketinfo)) } else { set sock $socketmap($state(socketinfo)) Log "reusing socket $sock for$state(socketinfo)" catch {fileevent $sock writable {}} catch {fileevent$sock readable {}} } } # don't automatically close this connection socket set state(connection) {} } if {![info exists sock]} { # Pass -myaddr directly to the socket command if {[info exists state(-myaddr)]} { lappend sockopts -myaddr $state(-myaddr) } if {[catch {eval$defcmd $sockopts$targetAddr} sock errdict]} { # something went wrong while trying to establish the connection. # Clean up after events and such, but DON'T call the command # callback (if available) because we're going to throw an # exception from here instead. set state(sock) $sock Finish$token "" 1 cleanup $token dict unset errdict -level return -options$errdict $sock } } set state(sock)$sock Log "Using $sock for$state(socketinfo)" \ [expr {$state(-keepalive)?"keepalive":""}] if {$state(-keepalive)} { set socketmap($state(socketinfo))$sock } if {![info exists phost]} { set phost "" } fileevent $sock writable [list http::Connect$token $proto$phost $srvurl] # Wait for the connection to complete. if {![info exists state(-command)]} { # geturl does EVERYTHING asynchronously, so if the user # calls it synchronously, we just do a wait here. http::wait$token ................................................................................ # callback (if available) because we're going to throw an # exception from here instead. set err [lindex $state(error) 0] cleanup$token return -code error $err } } return$token } # http::Connected -- # # Callback used when the connection to the HTTP server is actually # established. # # Arguments: # token State token. # proto What protocol (http, https, etc.) was used to connect. # phost Are we using keep-alive? Non-empty if yes. # srvurl Service-local URL that we're requesting # Results: # None. proc http::Connected {token proto phost srvurl} { variable http variable urlTypes variable $token upvar 0$token state # Set back the variables needed here set sock $state(sock) set isQueryChannel [info exists state(-querychannel)] set isQuery [info exists state(-query)] set host [lindex [split$state(socketinfo) :] 0] set port [lindex [split $state(socketinfo) :] 1] set lower [string tolower$proto] set defport [lindex $urlTypes($lower) 0] # Send data in cr-lf format, but accept any line terminators fconfigure $sock -translation {auto crlf} -buffersize$state(-blocksize) # The following is disallowed in safe interpreters, but the socket is # already in non-blocking mode in that case. catch {fconfigure $sock -blocking off} set how GET if {$isQuery} { ................................................................................ } } elseif {$state(-validate)} { set how HEAD } elseif {$isQueryChannel} { set how POST # The query channel must be blocking for the async Write to # work properly. fconfigure $state(-querychannel) -blocking 1 -translation binary set contDone 0 } if {[info exists state(-method)] &&$state(-method) ne ""} { set how $state(-method) } # We cannot handle chunked encodings with -handler, so force HTTP/1.0 # until we can manage this. if {[info exists state(-handler)]} { set state(-protocol) 1.0 } set accept_types_seen 0 if {[catch { puts$sock "$how$srvurl HTTP/$state(-protocol)" if {[dict exists$state(-headers) Host]} { # Allow Host spoofing. [Bug 928154] puts $sock "Host: [dict get$state(-headers) Host]" } elseif {$port ==$defport} { # Don't add port in this case, to handle broken servers. [Bug # #504508] puts $sock "Host:$host" } else { puts $sock "Host:$host:$port" } puts$sock "User-Agent: $http(-useragent)" if {$state(-protocol) == 1.0 && $state(-keepalive)} { puts$sock "Connection: keep-alive" } if {$state(-protocol) > 1.0 && !$state(-keepalive)} { puts $sock "Connection: close" ;# RFC2616 sec 8.1.2.1 } if {[info exists phost] && ($phost ne "") && $state(-keepalive)} { puts$sock "Proxy-Connection: Keep-Alive" } set accept_encoding_seen 0 set content_type_seen 0 dict for {key value} $state(-headers) { set value [string map [list \n "" \r ""]$value] set key [string map {" " -} [string trim $key]] if {[string equal -nocase$key "host"]} { continue } ................................................................................ } } # Allow overriding the Accept header on a per-connection basis. Useful # for working with REST services. [Bug c11a51c482] if {!$accept_types_seen} { puts$sock "Accept: $state(accept-types)" } if {!$accept_encoding_seen && ![info exists state(-handler)]} { puts $sock "Accept-Encoding: gzip,deflate,compress" } if {$isQueryChannel && $state(querylength) == 0} { # Try to determine size of data in channel. If we cannot seek, the # surrounding catch will trap us set start [tell$state(-querychannel)] seek $state(-querychannel) 0 end set state(querylength) \ [expr {[tell$state(-querychannel)] - $start}] ................................................................................ # data. Having both fileevents active changes the timing and the # behavior, but no two platforms (among Solaris, Linux, and NT) behave # the same, and none behave all that well in any case. Servers should # always read their POST data if they expect the client to read their # response. if {$isQuery || $isQueryChannel} { if {!$content_type_seen} { puts $sock "Content-Type:$state(-type)" } if {!$contDone} { puts$sock "Content-Length: $state(querylength)" } puts$sock "" fconfigure $sock -translation {auto binary} fileevent$sock writable [list http::Write $token] } else { puts$sock "" flush $sock fileevent$sock readable [list http::Event $sock$token] } } err]} { # The socket probably was never connected, or the connection dropped # later. # if state(status) is error, it means someone's already called Finish # to do the above-described clean up. if {$state(status) ne "error"} { Finish$token $err } } } # Data access functions: # Data - the URL data # Status - the transaction status: ok, reset, eof, timeout # Code - the HTTP transaction code, e.g., 200 # Size - the size of the URL data proc http::data {token} { variable$token upvar 0 $token state return$state(body) ................................................................................ # # Side Effects # unsets the state array proc http::cleanup {token} { variable $token upvar 0$token state if {[info exists state]} { unset state } } # http::Connect # ................................................................................ # Side Effects # Sets the status of the connection, which unblocks # the waiting geturl call proc http::Connect {token proto phost srvurl} { variable $token upvar 0$token state set err "due to unexpected EOF" if { [eof $state(sock)] || [set err [fconfigure$state(sock) -error]] ne "" } { Finish $token "connect failed$err" } else { fileevent $state(sock) writable {} ::http::Connected$token $proto$phost $srvurl } return } # http::Write # # Write POST query data to the socket # # Arguments # token The token for the connection # # Side Effects # Write the socket and handle callbacks. proc http::Write {token} { variable$token upvar 0 $token state set sock$state(sock) # Output a block. Tcl will buffer this if the socket blocks set done 0 if {[catch { # Catch I/O errors on dead sockets if {[info exists state(-query)]} { # Chop up large query strings so queryprogress callback can give # smooth feedback. puts -nonewline $sock \ [string range$state(-query) $state(queryoffset) \ [expr {$state(queryoffset) + $state(-queryblocksize) - 1}]] incr state(queryoffset)$state(-queryblocksize) if {$state(queryoffset) >=$state(querylength)} { set state(queryoffset) $state(querylength) set done 1 } } else { # Copy blocks from the query channel set outStr [read$state(-querychannel) $state(-queryblocksize)] puts -nonewline$sock $outStr incr state(queryoffset) [string length$outStr] if {[eof $state(-querychannel)]} { set done 1 } } } err]} { # Do not call Finish here, but instead let the read half of the socket # process whatever server reply there is to get. set state(posterror)$err set done 1 } if {$done} { catch {flush$sock} fileevent $sock writable {} fileevent$sock readable [list http::Event $sock$token] } # Callback to the client after we've completely handled everything. if {[string length $state(-queryprogress)]} { eval$state(-queryprogress) \ [list $token$state(querylength) $state(queryoffset)] } } # http::Event # # Handle input on the socket # # Arguments # sock The socket receiving input. # token The token returned from http::geturl # # Side Effects # Read the socket and handle callbacks. proc http::Event {sock token} { variable$token upvar 0 $token state if {![info exists state]} { Log "Event$sock with invalid token '$token' - remote close?" if {![eof$sock]} { if {[set d [read $sock]] ne ""} { Log "WARNING: additional data left on closed socket" } } CloseSocket$sock return } if {$state(state) eq "connecting"} { if {[catch {gets$sock state(http)} n]} { return [Finish $token$n] } elseif {$n >= 0} { set state(state) "header" } } elseif {$state(state) eq "header"} { if {[catch {gets $sock line} n]} { return [Finish$token $n] } elseif {$n == 0} { # We have now read all headers # We ignore HTTP/1.1 100 Continue returns. RFC2616 sec 8.2.3 if {$state(http) == "" || ([regexp {^\S+\s(\d+)}$state(http) {} x] && $x == 100)} { set state(state) "connecting" return } set state(state) body # If doing a HEAD, then we won't get any body if {$state(-validate)} { Eof $token return } # For non-chunked transfer we may have no body - in this case we # may get no further file event if the connection doesn't close # and no more data is sent. We can tell and must finish up now - # not later. if { !(([info exists state(connection)] && ($state(connection) eq "close")) || [info exists state(transfer)]) && ($state(totalsize) == 0) } { Log "body size is 0 and no events likely - complete." Eof$token return } # We have to use binary translation to count bytes properly. fconfigure $sock -translation binary if {$state(-binary) || [IsBinaryContentType $state(type)] } { # Turn off conversions for non-text data set state(binary) 1 } if {[info exists state(-channel)]} { if {$state(binary) || [llength [ContentEncoding $token]]} { fconfigure$state(-channel) -translation binary } if {![info exists state(-handler)]} { # Initiate a sequence of background fcopies fileevent $sock readable {} CopyStart$sock $token return } } } elseif {$n > 0} { # Process header lines if {[regexp -nocase {^([^:]+):(.+)$}$line x key value]} { switch -- [string tolower $key] { content-type { set state(type) [string trim [string tolower$value]] # grab the optional charset information if {[regexp -nocase \ {charset\s*=\s*\"((?:[^""]|\\\")*)\"} \ $state(type) -> cs]} { set state(charset) [string map {{\"} \"}$cs] } else { regexp -nocase {charset\s*=\s*(\S+?);?} \ $state(type) -> state(charset) } } content-length { set state(totalsize) [string trim$value] } content-encoding { set state(coding) [string trim $value] } transfer-encoding { set state(transfer) \ [string trim [string tolower$value]] } proxy-connection - connection { set state(connection) \ [string trim [string tolower $value]] } } lappend state(meta)$key [string trim $value] } } } else { # Now reading body if {[catch { if {[info exists state(-handler)]} { set n [eval$state(-handler) [list $sock$token]] } elseif {[info exists state(transfer_final)]} { set line [getTextLine $sock] set n [string length$line] if {$n > 0} { Log "found$n bytes following final chunk" append state(transfer_final) $line } else { Log "final chunk part" Eof$token } } elseif { [info exists state(transfer)] && $state(transfer) eq "chunked" } { set size 0 set chunk [getTextLine$sock] set n [string length $chunk] if {[string trim$chunk] ne ""} { scan $chunk %x size if {$size != 0} { set bl [fconfigure $sock -blocking] fconfigure$sock -blocking 1 set chunk [read $sock$size] fconfigure $sock -blocking$bl set n [string length $chunk] if {$n >= 0} { append state(body) $chunk } if {$size != [string length $chunk]} { Log "WARNING: mis-sized chunk:\ was [string length$chunk], should be $size" } getTextLine$sock } else { set state(transfer_final) {} } } } else { #Log "read non-chunk $state(currentsize) of$state(totalsize)" set block [read $sock$state(-blocksize)] set n [string length $block] if {$n >= 0} { append state(body) $block } } if {[info exists state]} { if {$n >= 0} { incr state(currentsize) $n } # If Content-Length - check for end of data. if { ($state(totalsize) > 0) && ($state(currentsize) >=$state(totalsize)) } { Eof $token } } } err]} { return [Finish$token $err] } else { if {[info exists state(-progress)]} { eval$state(-progress) \ [list $token$state(totalsize) $state(currentsize)] } } } # catch as an Eof above may have closed the socket already if {![catch {eof$sock} eof] && $eof} { if {[info exists$token]} { set state(connection) close Eof $token } else { # open connection closed on a token that has been cleaned up. CloseSocket$sock } return } } # http::IsBinaryContentType -- # # Determine if the content-type means that we should definitely transfer # the data as binary. [Bug 838e99a76d] ................................................................................ return false } return true } # http::getTextLine -- # # Get one line with the stream in blocking crlf mode # # Arguments # sock The socket receiving input. # # Results: # The line of text, without trailing newline proc http::getTextLine {sock} { set tr [fconfigure $sock -translation] set bl [fconfigure$sock -blocking] fconfigure $sock -translation crlf -blocking 1 set r [gets$sock] fconfigure $sock -translation$tr -blocking $bl return$r } # http::CopyStart # # Error handling wrapper around fcopy # # Arguments # sock The socket to copy from ................................................................................ } else { if {$initial} { foreach coding [ContentEncoding$token] { zlib push $coding$sock } } if {[catch { fcopy $sock$state(-channel) -size $state(-blocksize) -command \ [list http::CopyDone$token] } err]} { Finish $token$err } } } ................................................................................ } puts -nonewline $state(-channel)$chunk if {[info exists state(-progress)]} { eval [linsert $state(-progress) end \$token $state(totalsize)$state(currentsize)] } } else { Log "CopyChunk Finish $token" if {[info exists state(zlib)]} { set excess "" foreach stream$state(zlib) { catch {set excess [$stream add -finalize$excess]} } puts -nonewline $state(-channel)$excess foreach stream $state(zlib) {$stream close } unset state(zlib) } Eof $token ;# FIX ME: pipelining. } } # http::CopyDone # # fcopy completion callback # ................................................................................ upvar 0$token state set sock $state(sock) incr state(currentsize)$count if {[info exists state(-progress)]} { eval $state(-progress) \ [list$token $state(totalsize)$state(currentsize)] } # At this point the token may have been reset if {[string length $error]} { Finish$token $error } elseif {[catch {eof$sock} iseof] || $iseof} { Eof$token } else { CopyStart $sock$token 0 } } # http::Eof # # Handle eof on the socket # # Arguments # token The token returned from http::geturl # # Side Effects # Clean up the socket proc http::Eof {token {force 0}} { variable $token upvar 0$token state if {$state(state) eq "header"} { # Premature eof set state(status) eof } else { set state(status) ok } if {[string length$state(body)] > 0} { if {[catch { foreach coding [ContentEncoding $token] { set state(body) [zlib$coding $state(body)] } } err]} { Log "error doing decompression:$err" return [Finish $token$err] } if {!$state(binary)} { # If we are getting text, set the incoming channel's encoding # correctly. iso8859-1 is the RFC default, but this could be any IANA # charset. However, we only know how to convert what we have # encodings for. set enc [CharsetToEncoding$state(charset)] if {$enc ne "binary"} { set state(body) [encoding convertfrom$enc $state(body)] } # Translate text line endings. set state(body) [string map {\r\n \n \r \n}$state(body)] } } Finish $token } # http::wait -- # # See documentation for details. # # Arguments: # token Connection token. # # Results: # The status after the wait. proc http::wait {token} { variable$token upvar 0 $token state if {![info exists state(status)] ||$state(status) eq ""} { # We must wait on the original variable name, not the upvar alias ................................................................................ # Arguments: # args A list of name-value pairs. # # Results: # TODO proc http::formatQuery {args} { set result "" set sep "" foreach i $args { append result$sep [mapReply $i] if {$sep eq "="} { set sep & } else { ................................................................................ regexp "$\u0100-\uffff$" $converted badChar # Return this error message for maximum compatibility... :^/ return -code error \ "can't read \"formMap($badChar)\": no such element in array" } return $converted } # http::ProxyRequired -- # Default proxy filter. # # Arguments: # host The destination host # ................................................................................ return -code error "unsupported content-encoding \"$coding\"" } } } } return $r } proc http::make-transformation-chunked {chan command} { set lambda {{chan command} { set data "" set size -1 yield while {1} { chan configure$chan -translation {crlf binary} while {[gets $chan line] < 1} { yield } chan configure$chan -translation {binary binary} if {[scan $line %x size] != 1} { return -code error "invalid size: \"$line\"" } set chunk "" while {$size && ![chan eof$chan]} { set part [chan read $chan$size] incr size -[string length $part] append chunk$part } if {[catch { uplevel #0 [linsert $command end$chunk] }]} { http::Log "Error in callback: $::errorInfo" } if {[string length$chunk] == 0} { # channel might have been closed in the callback catch {chan event $chan readable {}} return } } }} coroutine dechunk$chan ::apply $lambda$chan $command chan event$chan readable [namespace origin dechunk$chan] return } # Local variables: # indent-tabs-mode: t # End:   | > > > > | | | | | | | | | | > > > > > > | | | < > > > > > > > > > > > > > > > > > | > > > > > > | > | > > > > | | > > > > > > > > > > > > | > > > > | > > > > > > | | | > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > < > | | > > > > > > > > > | | | | | | | | | | | > | > > > > > > > > > > > > | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > < < < < > | > > > > > > > > > > > > | > | < > | | > | > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | > > > | > < < < < < < < > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > > > > > > > > > > > > > > | > > > > > > > > > > > > > > > > > > | > > > | > > > > > > | > > > > > > | | < < | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | > > > > > > > | > > > | > > > > > > > | | > | > > > | | > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > | | | > > > > > > > > > > > > > | | < > > > > | > | > | > > > > | > > | | | | | | > | > > | | > > > > > > > | > > > > > > > > > > > > > < > > > > | > > > > > > > > > > > > > > > | > > > > > > > > | < < > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > < > > > > > > > > > > > > > > > > > > > > > > > | > > > > > > > > > > > > > > > | > > > | > > > > > > > > > > > > > > > | | | | | > | | > | | | | > > > > > > > > > > | > > > > > > > > > > > > > > > > > | > > | > | > > > > > > > | > > > > > > > > > > | | > > | > | > > | | > | > | < > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | > > | | | | | | < < > > > > > > > > > > > | | > > | | | | > > > > | | | | > | | | | | | | | | | | | | | > | | | | | | > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > | | > | < > > > > > > > | > | > | | | < | | | > | | | | | | < < > | < | | | > > > | | | | > > > > > > > > | > > | | > | | > > > > > > > > | | > > > > > > > > > > > > > | > > > > > > > > > | | | | > > | | > > | | | > > > > | | | | | | > > > | | | | > | > | | | | | | | | > | > | | > > > > > > > | | > > > > > | > | | > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | | | > > > > > > > > > > > > > > > | | | > > > > > | | > | | | | > > > > > > > | < | | | | | | | > | > | | | | | | | | | | | | | | | | | < < > > > > | <  7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 .. 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 ... 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 ... 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 ... 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 ... 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 ... 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 ... 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 ... 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 .... 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 .... 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 .... 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 .... 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 .... 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 .... 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 .... 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 .... 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 .... 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 .... 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 .... 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 .... 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 .... 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427  # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. package require Tcl 8.6- # Keep this in sync with pkgIndex.tcl and with the install directories in # Makefiles package provide http 2.9.0 namespace eval http { # Allow resourcing to not clobber existing data variable http if {![info exists http]} { array set http { -accept */* -pipeline 1 -postfresh 0 -proxyhost {} -proxyport {} -proxyfilter http::ProxyRequired -repost 0 -urlencoding utf-8 -zip 1 } # We need a useragent string of this style or various servers will # refuse to send us compressed content even when we ask for it. This # follows the de-facto layout of user-agent strings in current browsers. # Safe interpreters do not have ::tcl_platform(os) or # ::tcl_platform(osVersion). if {[interp issafe]} { set http(-useragent) "Mozilla/5.0\ (Windows; U;\ Windows NT 10.0)\ http/[package provide http] Tcl/[package provide Tcl]" } else { set http(-useragent) "Mozilla/5.0\ ([string totitle$::tcl_platform(platform)]; U;\ $::tcl_platform(os)$::tcl_platform(osVersion))\ http/[package provide http] Tcl/[package provide Tcl]" } } proc init {} { # Set up the map for quoting chars. RFC3986 Section 2.3 say percent # encode all except: "... percent-encoded octets in the ranges of # ALPHA (%41-%5A and %61-%7A), DIGIT (%30-%39), hyphen (%2D), period ................................................................................ } } # These are handled specially set map(\n) %0D%0A variable formMap [array get map] # Create a map for HTTP/1.1 open sockets variable socketMapping variable socketRdState variable socketWrState variable socketRdQueue variable socketWrQueue variable socketClosing variable socketPlayCmd if {[info exists socketMapping]} { # Close open sockets on re-init. Do not permit retries. foreach {url sock} [array get socketMapping] { unset -nocomplain socketClosing($url) unset -nocomplain socketPlayCmd($url) CloseSocket $sock } } # CloseSocket should have unset the socket* arrays, one element at # a time. Now unset anything that was overlooked. # Traces on "unset socketRdState(*)" will call CancelReadPipeline and # cancel any queued responses. # Traces on "unset socketWrState(*)" will call CancelWritePipeline and # cancel any queued requests. array unset socketMapping array unset socketRdState array unset socketWrState array unset socketRdQueue array unset socketWrQueue array unset socketClosing array unset socketPlayCmd array set socketMapping {} array set socketRdState {} array set socketWrState {} array set socketRdQueue {} array set socketWrQueue {} array set socketClosing {} array set socketPlayCmd {} } init variable urlTypes if {![info exists urlTypes]} { set urlTypes(http) [list 80 ::socket] } ................................................................................ # Let user control default keepalive for compatibility variable defaultKeepalive if {![info exists defaultKeepalive]} { set defaultKeepalive 0 } namespace export geturl config reset wait formatQuery quoteString namespace export register unregister registerError # - Useful, but not exported: data, size, status, code, cleanup, error, # meta, ncode, mapReply, init. Comments suggest that "init" can be used # for re-initialisation, although the command is undocumented. # - Not exported, probably should be upper-case initial letter as part # of the internals: getTextLine, make-transformation-chunked. } # http::Log -- # # Debugging output -- define this to observe HTTP/1.1 socket usage. # Should echo any args received. # ................................................................................ # http::Finish -- # # Clean up the socket and eval close time callbacks # # Arguments: # token Connection token. # errormsg (optional) If set, forces status to error. # skipCB (optional) If set, don't call the -command callback. This # is useful when geturl wants to throw an exception instead # of calling the callback. That way, the same error isn't # reported to two places. # # Side Effects: # May close the socket. proc http::Finish {token {errormsg ""} {skipCB 0}} { variable socketMapping variable socketRdState variable socketWrState variable socketRdQueue variable socketWrQueue variable socketClosing variable socketPlayCmd variable$token upvar 0 $token state global errorInfo errorCode set closeQueue 0 if {$errormsg ne ""} { set state(error) [list $errormsg$errorInfo $errorCode] set state(status) "error" } if {[info commands${token}EventCoroutine] ne {}} { rename ${token}EventCoroutine {} } if { ($state(status) eq "timeout") || ($state(status) eq "error") || ($state(status) eq "eof") || ([info exists state(-keepalive)] && !$state(-keepalive)) || ([info exists state(connection)] && ($state(connection) eq "close")) } { set closeQueue 1 set connId $state(socketinfo) set sock$state(sock) CloseSocket $state(sock)$token } elseif { ([info exists state(-keepalive)] && $state(-keepalive)) && ([info exists state(connection)] && ($state(connection) ne "close")) } { KeepSocket $token } if {[info exists state(after)]} { after cancel$state(after) unset state(after) } if {[info exists state(-command)] && (!$skipCB) && (![info exists state(done-command-cb)])} { set state(done-command-cb) yes if {[catch {eval$state(-command) {$token}} err] &&$errormsg eq ""} { set state(error) [list $err$errorInfo $errorCode] set state(status) error } } if {$closeQueue && [info exists socketMapping($connId)] && ($socketMapping($connId) eq$sock) } { http::CloseQueuedQueries $connId$token } } # http::KeepSocket - # # Keep a socket in the persistent sockets table and connect it to its next # queued task if possible. Otherwise leave it idle and ready for its next # use. # # If $socketClosing(*), then ($state(connection) eq "close") and therefore # this command will not be called by Finish. # # Arguments: # token Connection token. proc http::KeepSocket {token} { variable http variable socketMapping variable socketRdState variable socketWrState variable socketRdQueue variable socketWrQueue variable socketClosing variable socketPlayCmd variable $token upvar 0$token state set tk [namespace tail $token] # Keep this socket open for another request ("Keep-Alive"). # React if the server half-closes the socket. # Discussion is in http::geturl. catch {fileevent$state(sock) readable [list http::CheckEof $state(sock)]} # The line below should not be changed in production code. # It is edited by the test suite. set TEST_EOF 0 if {$TEST_EOF} { # ONLY for testing reaction to server eof. # No server timeouts will be caught. catch {fileevent $state(sock) readable {}} } if { [info exists state(socketinfo)] && [info exists socketMapping($state(socketinfo))] } { set connId $state(socketinfo) # The value "Rready" is set only here. set socketRdState($connId) Rready if { $state(-pipeline) && [info exists socketRdQueue($connId)] && [llength $socketRdQueue($connId)] } { # The usual case for pipelined responses - if another response is # queued, arrange to read it. set token3 [lindex $socketRdQueue($connId) 0] set socketRdQueue($connId) [lrange$socketRdQueue($connId) 1 end] variable$token3 upvar 0 $token3 state3 set tk2 [namespace tail$token3] #Log pipelined, GRANT read access to $token3 in KeepSocket set socketRdState($connId) $token3 ReceiveResponse$token3 # Other pipelined cases. # - The test above ensures that, for the pipelined cases in the two # tests below, the read queue is empty. # - In those two tests, check whether the next write will be # nonpipeline. } elseif { $state(-pipeline) && [info exists socketWrState($connId)] && ($socketWrState($connId) eq "peNding") && [info exists socketWrQueue($connId)] && [llength$socketWrQueue($connId)] && (![set token3 [lindex$socketWrQueue($connId) 0] set${token3}(-pipeline) ] ) } { # This case: # - Now it the time to run the "pending" request. # - The next token in the write queue is nonpipeline, and # socketWrState has been marked "pending" (in # http::NextPipelinedWrite or http::geturl) so a new pipelined # request cannot jump the queue. # # Tests: # - In this case the read queue (tested above) is empty and this # "pending" write token is in front of the rest of the write # queue. # - The write state is not Wready and therefore appears to be busy, # but because it is "pending" we know that it is reserved for the # first item in the write queue, a non-pipelined request that is # waiting for the read queue to empty. That has now happened: so # give that request read and write access. variable $token3 set conn [set${token3}(tmpConnArgs)] #Log nonpipeline, GRANT r/w access to $token3 in KeepSocket set socketRdState($connId) $token3 set socketWrState($connId) $token3 set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end] # Connect does its own fconfigure. fileevent $state(sock) writable [list http::Connect$token3 {*}$conn] #Log ----$state(sock) << conn to $token3 for HTTP request (c) } elseif {$state(-pipeline) && [info exists socketWrState($connId)] && ($socketWrState($connId) eq "peNding") } { # Should not come here. The second block in the previous "elseif" # test should be tautologous (but was needed in an earlier # implementation) and will be removed after testing. # If we get here, the value "pending" was assigned in error. # This error would block the queue for ever. Log ^X$tk <<<<< Error in queueing of requests >>>>> - token $token } elseif {$state(-pipeline) && [info exists socketWrState($connId)] && ($socketWrState($connId) eq "Wready") && [info exists socketWrQueue($connId)] && [llength $socketWrQueue($connId)] && (![set token3 [lindex $socketWrQueue($connId) 0] set ${token3}(-pipeline) ] ) } { # This case: # - The next token in the write queue is nonpipeline, and # socketWrState is Wready. Get the next event from socketWrQueue. # Tests: # - In this case the read state (tested above) is Rready and the # write state (tested here) is Wready - there is no "pending" # request. # Code: # - The code is the same as the code below for the nonpipelined # case with a queued request. variable$token3 set conn [set ${token3}(tmpConnArgs)] #Log nonpipeline, GRANT r/w access to$token3 in KeepSocket set socketRdState($connId)$token3 set socketWrState($connId)$token3 set socketWrQueue($connId) [lrange$socketWrQueue($connId) 1 end] # Connect does its own fconfigure. fileevent$state(sock) writable [list http::Connect $token3 {*}$conn] #Log ---- $state(sock) << conn to$token3 for HTTP request (c) } elseif { (!$state(-pipeline)) && [info exists socketWrQueue($connId)] && [llength $socketWrQueue($connId)] && ($state(connection) ne "close") } { # If not pipelined, (socketRdState eq Rready) tells us that we are # ready for the next write - there is no need to check # socketWrState. Write the next request, if one is waiting. # If the next request is pipelined, it receives premature read # access to the socket. This is not a problem. set token3 [lindex$socketWrQueue($connId) 0] variable$token3 set conn [set ${token3}(tmpConnArgs)] #Log nonpipeline, GRANT r/w access to$token3 in KeepSocket set socketRdState($connId)$token3 set socketWrState($connId)$token3 set socketWrQueue($connId) [lrange$socketWrQueue($connId) 1 end] # Connect does its own fconfigure. fileevent$state(sock) writable [list http::Connect $token3 {*}$conn] #Log ---- $state(sock) << conn to$token3 for HTTP request (d) } elseif {(!$state(-pipeline))} { set socketWrState($connId) Wready # Rready and Wready and idle: nothing to do. } } else { CloseSocket $state(sock)$token # There is no socketMapping($state(socketinfo)), so it does not matter # that CloseQueuedQueries is not called. } } # http::CheckEof - # # Read from a socket and close it if eof. # The command is bound to "fileevent readable" on an idle socket, and # "eof" is the only event that should trigger the binding, occurring when # the server times out and half-closes the socket. # # A read is necessary so that [eof] gives a meaningful result. # Any bytes sent are junk (or a bug). proc http::CheckEof {sock} { set junk [read$sock] set n [string length $junk] if {$n} { Log "WARNING: $n bytes received but no HTTP request sent" } if {[catch {eof$sock} res] || $res} { # The server has half-closed the socket. # If a new write has started, its transaction will fail and # will then be error-handled. CloseSocket$sock } } # http::CloseSocket - # # Close a socket and remove it from the persistent sockets table. If # possible an http token is included here but when we are called from a # fileevent on remote closure we need to find the correct entry - hence # the "else" block of the first "if" command. proc http::CloseSocket {s {token {}}} { variable socketMapping variable socketRdState variable socketWrState variable socketRdQueue variable socketWrQueue variable socketClosing variable socketPlayCmd set tk [namespace tail $token] catch {fileevent$s readable {}} set connId {} if {$token ne ""} { variable$token upvar 0 $token state if {[info exists state(socketinfo)]} { set connId$state(socketinfo) } } else { set map [array get socketMapping] set ndx [lsearch -exact $map$s] if {$ndx != -1} { incr ndx -1 set connId [lindex$map $ndx] } } if { ($connId ne {}) && [info exists socketMapping($connId)] && ($socketMapping($connId) eq$s) } { Log "Closing connection $connId (sock$socketMapping($connId))" if {[catch {close$socketMapping($connId)} err]} { Log "Error closing connection:$err" } if {$token eq {}} { # Cases with a non-empty token are handled by Finish, so the tokens # are finished in connection order. http::CloseQueuedQueries$connId } } else { Log "Closing socket $s (no connection info)" if {[catch {close$s} err]} { Log "Error closing socket: $err" } } } # http::CloseQueuedQueries # # connId - identifier "domain:port" for the connection # token - (optional) used only for logging # # Called from http::CloseSocket and http::Finish, after a connection is closed, # to clear the read and write queues if this has not already been done. proc http::CloseQueuedQueries {connId {token {}}} { variable socketMapping variable socketRdState variable socketWrState variable socketRdQueue variable socketWrQueue variable socketClosing variable socketPlayCmd if {![info exists socketMapping($connId)]} { # Command has already been called. # Don't come here again - especially recursively. return } # Used only for logging. if {$token eq {}} { set tk {} } else { set tk [namespace tail$token] } if { [info exists socketPlayCmd($connId)] && ($socketPlayCmd($connId) ne {ReplayIfClose Wready {} {}}) } { # Before unsetting, there is some unfinished business. # - If the server sent "Connection: close", we have stored the command # for retrying any queued requests in socketPlayCmd, so copy that # value for execution below. socketClosing(*) was also set. # - Also clear the queues to prevent calls to Finish that would set the # state for the requests that will be retried to "finished with error # status". set unfinished$socketPlayCmd($connId) set socketRdQueue($connId) {} set socketWrQueue($connId) {} } else { set unfinished {} } Unset$connId if {$unfinished ne {}} { Log ^R$tk Any unfinished transactions (excluding $token) failed \ - token$token {*}$unfinished } } # http::Unset # # The trace on "unset socketRdState(*)" will call CancelReadPipeline # and cancel any queued responses. # The trace on "unset socketWrState(*)" will call CancelWritePipeline # and cancel any queued requests. proc http::Unset {connId} { variable socketMapping variable socketRdState variable socketWrState variable socketRdQueue variable socketWrQueue variable socketClosing variable socketPlayCmd unset socketMapping($connId) unset socketRdState($connId) unset socketWrState($connId) unset -nocomplain socketRdQueue($connId) unset -nocomplain socketWrQueue($connId) unset -nocomplain socketClosing($connId) unset -nocomplain socketPlayCmd($connId) } # http::reset -- # # See documentation for details. # # Arguments: # token Connection token. # why Status info. # # Side Effects: # See Finish proc http::reset {token {why reset}} { variable $token upvar 0$token state set state(status) $why catch {fileevent$state(sock) readable {}} catch {fileevent $state(sock) writable {}} ................................................................................ } # http::geturl -- # # Establishes a connection to a remote url via http. # # Arguments: # url The http URL to goget. # args Option value pairs. Valid options include: # -blocksize, -validate, -headers, -timeout # Results: # Returns a token for this connection. This token is the name of an # array that the caller should unset to garbage collect the state. proc http::geturl {url args} { variable http ................................................................................ # Initialize the state variable, an array. We'll return the name of this # array as the token for the transaction. if {![info exists http(uid)]} { set http(uid) 0 } set token [namespace current]::[incr http(uid)] ##Log Starting http::geturl - token$token variable $token upvar 0$token state set tk [namespace tail $token] reset$token Log ^A$tk URL$url - token $token # Process command options. array set state { -binary false -blocksize 8192 -queryblocksize 8192 ................................................................................ -validate 0 -headers {} -timeout 0 -type application/x-www-form-urlencoded -queryprogress {} -protocol 1.1 binary 0 state created meta {} method {} coding {} currentsize 0 totalsize 0 querylength 0 queryoffset 0 type text/html body {} ................................................................................ if {$port != $defport} { append url :$port } append url $srvurl # Don't append the fragment! set state(url)$url set sockopts [list -async] # If we are using the proxy, we must pass in the full URL that includes # the server name. if {[info exists phost] && ($phost ne "")} { set srvurl$url set targetAddr [list $phost$pport] ................................................................................ } # Proxy connections aren't shared among different hosts. set state(socketinfo) $host:$port # Save the accept types at this point to prevent a race condition. [Bug # c11a51c482] set state(accept-types) $http(-accept) if {$isQuery || $isQueryChannel} { # It's a POST. # A client wishing to send a non-idempotent request SHOULD wait to send # that request until it has received the response status for the # previous request. if {$http(-postfresh)} { # Override -keepalive for a POST. Use a new connection, and thus # avoid the small risk of a race against server timeout. set state(-keepalive) 0 } else { # Allow -keepalive but do not -pipeline - wait for the previous # transaction to finish. # There is a small risk of a race against server timeout. set state(-pipeline) 0 } } else { # It's a GET or HEAD. set state(-pipeline) $http(-pipeline) } # See if we are supposed to use a previously opened channel. # - In principle, ANY call to http::geturl could use a previously opened # channel if it is available - the "Connection: keep-alive" header is a # request to leave the channel open AFTER completion of this call. # - In fact, we try to use an existing channel only if -keepalive 1 -- this # means that at most one channel is left open for each value of #$state(socketinfo). This property simplifies the mapping of open # channels. set reusing 0 set alreadyQueued 0 if {$state(-keepalive)} { variable socketMapping variable socketRdState variable socketWrState variable socketRdQueue variable socketWrQueue variable socketClosing variable socketPlayCmd if {[info exists socketMapping($state(socketinfo))]} { # - If the connection is idle, it has a "fileevent readable" binding # to http::CheckEof, in case the server times out and half-closes # the socket (http::CheckEof closes the other half). # - We leave this binding in place until just before the last # puts+flush in http::Connected (GET/HEAD) or http::Write (POST), # after which the HTTP response might be generated. if { [info exists socketClosing($state(socketinfo))] &&$socketClosing($state(socketinfo)) } { # socketClosing(*) is set because the server has sent a # "Connection: close" header. # Do not use the persistent socket again. # Since we have only one persistent socket per server, and the # old socket is not yet dead, add the request to the write queue # of the dying socket, which will be replayed by ReplayIfClose. # Also add it to socketWrQueue(*) which is used only if an error # causes a call to Finish. set reusing 1 set sock$socketMapping($state(socketinfo)) Log "reusing socket$sock for $state(socketinfo) - token$token" set alreadyQueued 1 lassign $socketPlayCmd($state(socketinfo)) com0 com1 com2 com3 lappend com3 $token set socketPlayCmd($state(socketinfo)) [list $com0$com1 $com2$com3] lappend socketWrQueue($state(socketinfo))$token } elseif {[catch {fconfigure $socketMapping($state(socketinfo))}]} { # FIXME Is it still possible for this code to be executed? If # so, this could be another place to call TestForReplay, # rather than discarding the queued transactions. Log "WARNING: socket for $state(socketinfo) was closed\ - token$token" Log "WARNING - if testing, pay special attention to this\ case (GH) which is seldom executed - token $token" # This will call CancelReadPipeline, CancelWritePipeline, and # cancel any queued requests, responses. Unset$state(socketinfo) } else { # Use the persistent socket. # The socket may not be ready to write: an earlier request might # still be still writing (in the pipelined case) or # writing/reading (in the nonpipeline case). This possibility # is handled by socketWrQueue later in this command. set reusing 1 set sock $socketMapping($state(socketinfo)) Log "reusing socket $sock for$state(socketinfo) - token $token" } # Do not automatically close the connection socket. set state(connection) {} } } if {$reusing} { # Define state(tmpState) and state(tmpOpenCmd) for use # by http::ReplayIfDead if the persistent connection has died. set state(tmpState) [array get state] # Pass -myaddr directly to the socket command if {[info exists state(-myaddr)]} { lappend sockopts -myaddr $state(-myaddr) } set state(tmpOpenCmd) [list {*}$defcmd {*}$sockopts {*}$targetAddr] } set state(reusing) $reusing # Excluding ReplayIfDead and the decision whether to call it, there are four # places outside http::geturl where state(reusing) is used: # - Connected - if reusing and not pipelined, start the state(-timeout) # timeout (when writing). # - DoneRequest - if reusing and pipelined, send the next pipelined write # - Event - if reusing and pipelined, start the state(-timeout) # timeout (when reading). # - Event - if (not reusing) and pipelined, send the next pipelined # write # See comments above re the start of this timeout in other cases. if {(!$state(reusing)) && ($state(-timeout) > 0)} { set state(after) [after$state(-timeout) \ [list http::reset $token timeout]] } if {![info exists sock]} { # Pass -myaddr directly to the socket command if {[info exists state(-myaddr)]} { lappend sockopts -myaddr$state(-myaddr) } set pre [clock milliseconds] ##Log pre socket opened, - token $token ##Log [concat$defcmd $sockopts$targetAddr] - token $token if {[catch {eval$defcmd $sockopts$targetAddr} sock errdict]} { # Something went wrong while trying to establish the connection. # Clean up after events and such, but DON'T call the command # callback (if available) because we're going to throw an # exception from here instead. set state(sock) NONE Finish $token$sock 1 cleanup $token dict unset errdict -level return -options$errdict $sock } else { # Initialisation of a new socket. ##Log post socket opened, - token$token ##Log socket opened, now fconfigure - token $token set delay [expr {[clock milliseconds] -$pre}] if {$delay > 3000} { Log socket delay$delay - token $token } fconfigure$sock -translation {auto crlf} \ -buffersize $state(-blocksize) ##Log socket opened, DONE fconfigure - token$token } } # Command [socket] is called with -async, but takes 5s to 5.1s to return, # with probability of order 1 in 10,000. This may be a bizarre scheduling # issue with my (KJN's) system (Fedora Linux). # This does not cause a problem (unless the request times out when this # command returns). set state(sock) $sock Log "Using$sock for $state(socketinfo) - token$token" \ [expr {$state(-keepalive)?"keepalive":""}] if {$state(-keepalive) && (![info exists socketMapping($state(socketinfo))]) } { # Freshly-opened socket that we would like to become persistent. set socketMapping($state(socketinfo)) $sock if {![info exists socketRdState($state(socketinfo))]} { set socketRdState($state(socketinfo)) {} set varName ::http::socketRdState($state(socketinfo)) trace add variable $varName unset ::http::CancelReadPipeline } if {![info exists socketWrState($state(socketinfo))]} { set socketWrState($state(socketinfo)) {} set varName ::http::socketWrState($state(socketinfo)) trace add variable $varName unset ::http::CancelWritePipeline } if {$state(-pipeline)} { #Log new, init for pipelined, GRANT write access to $token in geturl # Also grant premature read access to the socket. This is OK. set socketRdState($state(socketinfo)) $token set socketWrState($state(socketinfo)) $token } else { # socketWrState is not used by this non-pipelined transaction. # We cannot leave it as "Wready" because the next call to # http::geturl with a pipelined transaction would conclude that the # socket is available for writing. #Log new, init for nonpipeline, GRANT r/w access to$token in geturl set socketRdState($state(socketinfo))$token set socketWrState($state(socketinfo))$token } set socketRdQueue($state(socketinfo)) {} set socketWrQueue($state(socketinfo)) {} set socketClosing($state(socketinfo)) 0 set socketPlayCmd($state(socketinfo)) {ReplayIfClose Wready {} {}} } if {![info exists phost]} { set phost "" } if {$reusing} { # For use by http::ReplayIfDead if the persistent connection has died. # Also used by NextPipelinedWrite. set state(tmpConnArgs) [list$proto $phost$srvurl] } # The element socketWrState($connId) has a value which is either the name of # the token that is permitted to write to the socket, or "Wready" if no # token is permitted to write. # # The code that sets the value to Wready immediately calls # http::NextPipelinedWrite, which examines socketWrQueue($connId) and # processes the next request in the queue, if there is one. The value # Wready is not found when the interpreter is in the event loop unless the # socket is idle. # # The element socketRdState($connId) has a value which is either the name of # the token that is permitted to read from the socket, or "Rready" if no # token is permitted to read. # # The code that sets the value to Rready then examines # socketRdQueue($connId) and processes the next request in the queue, if # there is one. The value Rready is not found when the interpreter is in # the event loop unless the socket is idle. if {$alreadyQueued} { # A write may or may not be in progress. There is no need to set # socketWrState to prevent another call stealing write access - all # subsequent calls on this socket will come here because the socket # will close after the current read, and its # socketClosing($connId) is 1. ##Log "HTTP request for token $token is queued" } elseif {$reusing && $state(-pipeline) && ($socketWrState($state(socketinfo)) ne "Wready") } { ##Log "HTTP request for token$token is queued for pipelined use" lappend socketWrQueue($state(socketinfo))$token } elseif { $reusing && (!$state(-pipeline)) && ($socketWrState($state(socketinfo)) ne "Wready") } { # A write is queued or in progress. Lappend to the write queue. ##Log "HTTP request for token $token is queued for nonpipeline use" lappend socketWrQueue($state(socketinfo)) $token } elseif {$reusing && (!$state(-pipeline)) && ($socketWrState($state(socketinfo)) eq "Wready") && ($socketRdState($state(socketinfo)) ne "Rready") } { # A read is queued or in progress, but not a write. Cannot start the # nonpipeline transaction, but must set socketWrState to prevent a # pipelined request jumping the queue. ##Log "HTTP request for token$token is queued for nonpipeline use" #Log re-use nonpipeline, GRANT delayed write access to $token in geturl set socketWrState($state(socketinfo)) peNding lappend socketWrQueue($state(socketinfo))$token } else { if {$reusing &&$state(-pipeline)} { #Log re-use pipelined, GRANT write access to $token in geturl set socketWrState($state(socketinfo)) $token } elseif {$reusing} { # Cf tests above - both are ready. #Log re-use nonpipeline, GRANT r/w access to $token in geturl set socketRdState($state(socketinfo)) $token set socketWrState($state(socketinfo)) $token } # All (!$reusing) cases come here, and also some $reusing cases if the # connection is ready. #Log ----$state(socketinfo) << conn to $token for HTTP request (a) # Connect does its own fconfigure. fileevent$sock writable \ [list http::Connect $token$proto $phost$srvurl] } # Wait for the connection to complete. if {![info exists state(-command)]} { # geturl does EVERYTHING asynchronously, so if the user # calls it synchronously, we just do a wait here. http::wait $token ................................................................................ # callback (if available) because we're going to throw an # exception from here instead. set err [lindex$state(error) 0] cleanup $token return -code error$err } } ##Log Leaving http::geturl - token $token return$token } # http::Connected -- # # Callback used when the connection to the HTTP server is actually # established. # # Arguments: # token State token. # proto What protocol (http, https, etc.) was used to connect. # phost Are we using keep-alive? Non-empty if yes. # srvurl Service-local URL that we're requesting # Results: # None. proc http::Connected {token proto phost srvurl} { variable http variable urlTypes variable socketMapping variable socketRdState variable socketWrState variable socketRdQueue variable socketWrQueue variable socketClosing variable socketPlayCmd variable $token upvar 0$token state set tk [namespace tail $token] if {$state(reusing) && (!$state(-pipeline)) && ($state(-timeout) > 0)} { set state(after) [after $state(-timeout) \ [list http::reset$token timeout]] } # Set back the variables needed here. set sock $state(sock) set isQueryChannel [info exists state(-querychannel)] set isQuery [info exists state(-query)] set host [lindex [split$state(socketinfo) :] 0] set port [lindex [split $state(socketinfo) :] 1] set lower [string tolower$proto] set defport [lindex $urlTypes($lower) 0] # Send data in cr-lf format, but accept any line terminators. # Initialisation to {auto *} now done in geturl, KeepSocket and DoneRequest. # We are concerned here with the request (write) not the response (read). lassign [fconfigure $sock -translation] trRead trWrite fconfigure$sock -translation [list $trRead crlf] \ -buffersize$state(-blocksize) # The following is disallowed in safe interpreters, but the socket is # already in non-blocking mode in that case. catch {fconfigure $sock -blocking off} set how GET if {$isQuery} { ................................................................................ } } elseif {$state(-validate)} { set how HEAD } elseif {$isQueryChannel} { set how POST # The query channel must be blocking for the async Write to # work properly. lassign [fconfigure $sock -translation] trRead trWrite fconfigure$state(-querychannel) -blocking 1 \ -translation [list $trRead binary] set contDone 0 } if {[info exists state(-method)] && ($state(-method) ne "")} { set how $state(-method) } # We cannot handle chunked encodings with -handler, so force HTTP/1.0 # until we can manage this. if {[info exists state(-handler)]} { set state(-protocol) 1.0 } set accept_types_seen 0 Log ^B$tk begin sending request - token $token if {[catch { set state(method)$how puts $sock "$how $srvurl HTTP/$state(-protocol)" if {[dict exists $state(-headers) Host]} { # Allow Host spoofing. [Bug 928154] puts$sock "Host: [dict get $state(-headers) Host]" } elseif {$port == $defport} { # Don't add port in this case, to handle broken servers. [Bug # #504508] puts$sock "Host: $host" } else { puts$sock "Host: $host:$port" } puts $sock "User-Agent:$http(-useragent)" if {($state(-protocol) >= 1.0) &&$state(-keepalive)} { # Send this header, because a 1.1 server is not compelled to treat # this as the default. puts $sock "Connection: keep-alive" } if {($state(-protocol) > 1.0) && !$state(-keepalive)} { puts$sock "Connection: close" ;# RFC2616 sec 8.1.2.1 } if {[info exists phost] && ($phost ne "") &&$state(-keepalive)} { puts $sock "Proxy-Connection: Keep-Alive" } set accept_encoding_seen 0 set content_type_seen 0 dict for {key value}$state(-headers) { set value [string map [list \n "" \r ""] $value] set key [string map {" " -} [string trim$key]] if {[string equal -nocase $key "host"]} { continue } ................................................................................ } } # Allow overriding the Accept header on a per-connection basis. Useful # for working with REST services. [Bug c11a51c482] if {!$accept_types_seen} { puts $sock "Accept:$state(accept-types)" } if { (!$accept_encoding_seen) && (![info exists state(-handler)]) &&$http(-zip) } { puts $sock "Accept-Encoding: gzip,deflate,compress" } if {$isQueryChannel && ($state(querylength) == 0)} { # Try to determine size of data in channel. If we cannot seek, the # surrounding catch will trap us set start [tell$state(-querychannel)] seek $state(-querychannel) 0 end set state(querylength) \ [expr {[tell$state(-querychannel)] - $start}] ................................................................................ # data. Having both fileevents active changes the timing and the # behavior, but no two platforms (among Solaris, Linux, and NT) behave # the same, and none behave all that well in any case. Servers should # always read their POST data if they expect the client to read their # response. if {$isQuery || $isQueryChannel} { # POST method. if {!$content_type_seen} { puts $sock "Content-Type:$state(-type)" } if {!$contDone} { puts$sock "Content-Length: $state(querylength)" } puts$sock "" flush $sock # Flush flushes the error in the https case with a bad handshake: # else the socket never becomes writable again, and hangs until # timeout (if any). lassign [fconfigure$sock -translation] trRead trWrite fconfigure $sock -translation [list$trRead binary] fileevent $sock writable [list http::Write$token] # The http::Write command decides when to make the socket readable, # using the same test as the GET/HEAD case below. } else { # GET or HEAD method. if { (![catch {fileevent $sock readable} binding]) && ($binding eq [list http::CheckEof $sock]) } { # Remove the "fileevent readable" binding of an idle persistent # socket to http::CheckEof. We can no longer treat bytes # received as junk. The server might still time out and # half-close the socket if it has not yet received the first # "puts". fileevent$sock readable {} } puts $sock "" flush$sock Log ^C$tk end sending request - token$token # End of writing (GET/HEAD methods). The request has been sent. DoneRequest $token } } err]} { # The socket probably was never connected, OR the connection dropped # later, OR https handshake error, which may be discovered as late as # the "flush" command above... Log "WARNING - if testing, pay special attention to this\ case (GI) which is seldom executed - token$token" if {[info exists state(reusing)] && $state(reusing)} { # The socket was closed at the server end, and closed at # this end by http::CheckEof. if {[TestForReplay$token write $err a]} { return } else { Finish$token {failed to re-use socket} } # else: # This is NOT a persistent socket that has been closed since its # last use. # If any other requests are in flight or pipelined/queued, they will # be discarded. } elseif {$state(status) eq ""} { # ...https handshake errors come here. set msg [registerError$sock] registerError $sock {} if {$msg eq {}} { set msg {failed to use socket} } Finish $token$msg } elseif {$state(status) ne "error"} { Finish$token $err } } } # http::registerError # # Called (for example when processing TclTLS activity) to register # an error for a connection on a specific socket. This helps # http::Connected to deliver meaningful error messages, e.g. when a TLS # certificate fails verification. # # Usage: http::registerError socket ?newValue? # # "set" semantics, except that a "get" (a call without a new value) for a # non-existent socket returns {}, not an error. proc http::registerError {sock args} { variable registeredErrors if { ([llength$args] == 0) && (![info exists registeredErrors($sock)]) } { return } elseif { ([llength$args] == 1) && ([lindex $args 0] eq {}) } { unset -nocomplain registeredErrors($sock) return } set registeredErrors($sock) {*}$args } # http::DoneRequest -- # # Command called when a request has been sent. It will arrange the # next request and/or response as appropriate. # # If this command is called when $socketClosing(*), the request$token # that calls it must be pipelined and destined to fail. proc http::DoneRequest {token} { variable http variable socketMapping variable socketRdState variable socketWrState variable socketRdQueue variable socketWrQueue variable socketClosing variable socketPlayCmd variable $token upvar 0$token state set tk [namespace tail $token] set sock$state(sock) # If pipelined, connect the next HTTP request to the socket. if {$state(reusing) &&$state(-pipeline)} { # Enable next token (if any) to write. # The value "Wready" is set only here, and # in http::Event after reading the response-headers of a # non-reusing transaction. # Previous value is $token. It cannot be pending. set socketWrState($state(socketinfo)) Wready # Now ready to write the next pipelined request (if any). http::NextPipelinedWrite $token } else { # If pipelined, this is the first transaction on this socket. We wait # for the response headers to discover whether the connection is # persistent. (If this is not done and the connection is not # persistent, we SHOULD retry and then MUST NOT pipeline before knowing # that we have a persistent connection # (rfc2616 8.1.2.2)). } # Connect to receive the response, unless the socket is pipelined # and another response is being sent. # This code block is separate from the code below because there are # cases where socketRdState already has the value$token. if { $state(-keepalive) &&$state(-pipeline) && [info exists socketRdState($state(socketinfo))] && ($socketRdState($state(socketinfo)) eq "Rready") } { #Log pipelined, GRANT read access to$token in Connected set socketRdState($state(socketinfo))$token } if { $state(-keepalive) &&$state(-pipeline) && [info exists socketRdState($state(socketinfo))] && ($socketRdState($state(socketinfo)) ne$token) } { # Do not read from the socket until it is ready. ##Log "HTTP response for token $token is queued for pipelined use" # If$socketClosing(*), then the caller will be a pipelined write and # execution will come here. # This token has already been recorded as "in flight" for writing. # When the socket is closed, the read queue will be cleared in # CloseQueuedQueries and so the "lappend" here has no effect. lappend socketRdQueue($state(socketinfo))$token } else { # In the pipelined case, connection for reading depends on the # value of socketRdState. # In the nonpipeline case, connection for reading always occurs. ReceiveResponse $token } } # http::ReceiveResponse # # Connects token to its socket for reading. proc http::ReceiveResponse {token} { variable$token upvar 0 $token state set tk [namespace tail$token] set sock $state(sock) #Log ----$state(socketinfo) >> conn to $token for HTTP response lassign [fconfigure$sock -translation] trRead trWrite fconfigure $sock -translation [list auto$trWrite] \ -buffersize $state(-blocksize) Log ^D$tk begin receiving response - token $token coroutine${token}EventCoroutine http::Event $sock$token fileevent $sock readable${token}EventCoroutine } # http::NextPipelinedWrite # # - Connecting a socket to a token for writing is done by this command and by # command KeepSocket. # - If another request has a pipelined write scheduled for $token's socket, # and if the socket is ready to accept it, connect the write and update # the queue accordingly. # - This command is called from http::DoneRequest and http::Event, # IF$state(-pipeline) AND (the current transfer has reached the point at # which the socket is ready for the next request to be written). # - This command is called when a token has write access and is pipelined and # keep-alive, and sets socketWrState to Wready. # - The command need not consider the case where socketWrState is set to a token # that does not yet have write access. Such a token is waiting for Rready, # and the assignment of the connection to the token will be done elsewhere (in # http::KeepSocket). # - This command cannot be called after socketWrState has been set to a # "pending" token value (that is then overwritten by the caller), because that # value is set by this command when it is called by an earlier token when it # relinquishes its write access, and the pending token is always the next in # line to write. proc http::NextPipelinedWrite {token} { variable http variable socketRdState variable socketWrState variable socketWrQueue variable socketClosing variable $token upvar 0$token state set connId $state(socketinfo) if { [info exists socketClosing($connId)] && $socketClosing($connId) } { # socketClosing(*) is set because the server has sent a # "Connection: close" header. # Behave as if the queues are empty - so do nothing. } elseif { $state(-pipeline) && [info exists socketWrState($connId)] && ($socketWrState($connId) eq "Wready") && [info exists socketWrQueue($connId)] && [llength$socketWrQueue($connId)] && ([set token2 [lindex$socketWrQueue($connId) 0] set${token2}(-pipeline) ] ) } { # - The usual case for a pipelined connection, ready for a new request. #Log pipelined, GRANT write access to $token2 in NextPipelinedWrite set conn [set${token2}(tmpConnArgs)] set socketWrState($connId)$token2 set socketWrQueue($connId) [lrange$socketWrQueue($connId) 1 end] # Connect does its own fconfigure. fileevent$state(sock) writable [list http::Connect $token2 {*}$conn] #Log ---- $connId << conn to$token2 for HTTP request (b) # In the tests below, the next request will be nonpipeline. } elseif { $state(-pipeline) && [info exists socketWrState($connId)] && ($socketWrState($connId) eq "Wready") && [info exists socketWrQueue($connId)] && [llength$socketWrQueue($connId)] && (![ set token3 [lindex$socketWrQueue($connId) 0] set${token3}(-pipeline) ] ) && [info exists socketRdState($connId)] && ($socketRdState($connId) eq "Rready") } { # The case in which the next request will be non-pipelined, and the read # and write queues is ready: which is the condition for a non-pipelined # write. variable$token3 upvar 0 $token3 state3 set conn [set${token3}(tmpConnArgs)] #Log nonpipeline, GRANT r/w access to $token3 in NextPipelinedWrite set socketRdState($connId) $token3 set socketWrState($connId) $token3 set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end] # Connect does its own fconfigure. fileevent $state(sock) writable [list http::Connect$token3 {*}$conn] #Log ----$state(sock) << conn to $token3 for HTTP request (c) } elseif {$state(-pipeline) && [info exists socketWrState($connId)] && ($socketWrState($connId) eq "Wready") && [info exists socketWrQueue($connId)] && [llength $socketWrQueue($connId)] && (![set token2 [lindex $socketWrQueue($connId) 0] set ${token2}(-pipeline) ] ) } { # - The case in which the next request will be non-pipelined, but the # read queue is NOT ready. # - A read is queued or in progress, but not a write. Cannot start the # nonpipeline transaction, but must set socketWrState to prevent a new # pipelined request (in http::geturl) jumping the queue. # - Because socketWrState($connId) is not set to Wready, the assignment # of the connection to $token2 will be done elsewhere - by command # http::KeepSocket when$socketRdState($connId) is set to "Rready". #Log re-use nonpipeline, GRANT delayed write access to$token in NextP.. set socketWrState($connId) peNding } } # http::CancelReadPipeline # # Cancel pipelined responses on a closing "Keep-Alive" socket. # # - Called by a variable trace on "unset socketRdState($connId)". # - The variable relates to a Keep-Alive socket, which has been closed. # - Cancels all pipelined responses. The requests have been sent, # the responses have not yet been received. # - This is a hard cancel that ends each transaction with error status, # and closes the connection. Do not use it if you want to replay failed # transactions. # - N.B. Always delete ::http::socketRdState($connId) before deleting # ::http::socketRdQueue($connId), or this command will do nothing. # # Arguments # As for a trace command on a variable. proc http::CancelReadPipeline {name1 connId op} { variable socketRdQueue ##Log CancelReadPipeline $name1$connId $op if {[info exists socketRdQueue($connId)]} { set msg {the connection was closed by CancelReadPipeline} foreach token $socketRdQueue($connId) { set tk [namespace tail $token] Log ^X$tk end of response "($msg)" - token$token set ${token}(status) eof Finish$token ;#$msg } set socketRdQueue($connId) {} } } # http::CancelWritePipeline # # Cancel queued events on a closing "Keep-Alive" socket. # # - Called by a variable trace on "unset socketWrState($connId)". # - The variable relates to a Keep-Alive socket, which has been closed. # - In pipelined or nonpipeline case: cancels all queued requests. The # requests have not yet been sent, the responses are not due. # - This is a hard cancel that ends each transaction with error status, # and closes the connection. Do not use it if you want to replay failed # transactions. # - N.B. Always delete ::http::socketWrState($connId) before deleting # ::http::socketWrQueue($connId), or this command will do nothing. # # Arguments # As for a trace command on a variable. proc http::CancelWritePipeline {name1 connId op} { variable socketWrQueue ##Log CancelWritePipeline$name1 $connId$op if {[info exists socketWrQueue($connId)]} { set msg {the connection was closed by CancelWritePipeline} foreach token$socketWrQueue($connId) { set tk [namespace tail$token] Log ^X$tk end of response "($msg)" - token $token set${token}(status) eof Finish $token ;#$msg } set socketWrQueue($connId) {} } } # http::ReplayIfDead -- # # - A query on a re-used persistent socket failed at the earliest opportunity, # because the socket had been closed by the server. Keep the token, tidy up, # and try to connect on a fresh socket. # - The connection is monitored for eof by the command http::CheckEof. Thus # http::ReplayIfDead is needed only when a server event (half-closing an # apparently idle connection), and a client event (sending a request) occur at # almost the same time, and neither client nor server detects the other's # action before performing its own (an "asynchronous close event"). # - To simplify testing of http::ReplayIfDead, set TEST_EOF 1 in # http::KeepSocket, and then http::ReplayIfDead will be called if http::geturl # is called at any time after the server timeout. # # Arguments: # token Connection token. # # Side Effects: # Use the same token, but try to open a new socket. proc http::ReplayIfDead {tokenArg doing} { variable socketMapping variable socketRdState variable socketWrState variable socketRdQueue variable socketWrQueue variable socketClosing variable socketPlayCmd variable$tokenArg upvar 0 $tokenArg stateArg Log running http::ReplayIfDead for$tokenArg $doing # 1. Merge the tokens for transactions in flight, the read (response) queue, # and the write (request) queue. set InFlightR {} set InFlightW {} # Obtain the tokens for transactions in flight. if {$stateArg(-pipeline)} { # Two transactions may be in flight. The "read" transaction was first. # It is unlikely that the server would close the socket if a response # was pending; however, an earlier request (as well as the present # request) may have been sent and ignored if the socket was half-closed # by the server. if { [info exists socketRdState($stateArg(socketinfo))] && ($socketRdState($stateArg(socketinfo)) ne "Rready") } { lappend InFlightR$socketRdState($stateArg(socketinfo)) } elseif {($doing eq "read")} { lappend InFlightR $tokenArg } if { [info exists socketWrState($stateArg(socketinfo))] && $socketWrState($stateArg(socketinfo)) ni {Wready peNding} } { lappend InFlightW $socketWrState($stateArg(socketinfo)) } elseif {($doing eq "write")} { lappend InFlightW$tokenArg } # Report any inconsistency of $tokenArg with socket*state. if { ($doing eq "read") && [info exists socketRdState($stateArg(socketinfo))] && ($tokenArg ne $socketRdState($stateArg(socketinfo))) } { Log WARNING - ReplayIfDead pipelined tokenArg $tokenArg$doing \ ne socketRdState($stateArg(socketinfo)) \$socketRdState($stateArg(socketinfo)) } elseif { ($doing eq "write") && [info exists socketWrState($stateArg(socketinfo))] && ($tokenArg ne $socketWrState($stateArg(socketinfo))) } { Log WARNING - ReplayIfDead pipelined tokenArg $tokenArg$doing \ ne socketWrState($stateArg(socketinfo)) \$socketWrState($stateArg(socketinfo)) } } else { # One transaction should be in flight. # socketRdState, socketWrQueue are used. # socketRdQueue should be empty. # Report any inconsistency of$tokenArg with socket*state. if {$tokenArg ne$socketRdState($stateArg(socketinfo))} { Log WARNING - ReplayIfDead nonpipeline tokenArg$tokenArg $doing \ ne socketRdState($stateArg(socketinfo)) \ $socketRdState($stateArg(socketinfo)) } # Report the inconsistency that socketRdQueue is non-empty. if { [info exists socketRdQueue($stateArg(socketinfo))] && ($socketRdQueue($stateArg(socketinfo)) ne {}) } { Log WARNING - ReplayIfDead nonpipeline tokenArg$tokenArg $doing \ has read queue socketRdQueue($stateArg(socketinfo)) \ $socketRdQueue($stateArg(socketinfo)) ne {} } lappend InFlightW $socketRdState($stateArg(socketinfo)) set socketRdQueue($stateArg(socketinfo)) {} } set newQueue {} lappend newQueue {*}$InFlightR lappend newQueue {*}$socketRdQueue($stateArg(socketinfo)) lappend newQueue {*}$InFlightW lappend newQueue {*}$socketWrQueue($stateArg(socketinfo)) # 2. Tidy up tokenArg. This is a cut-down form of Finish/CloseSocket. # Do not change state(status). # No need to after cancel stateArg(after) - either this is done in # ReplayCore/ReInit, or Finish is called. catch {close$stateArg(sock)} # 2a. Tidy the tokens in the queues - this is done in ReplayCore/ReInit. # - Transactions, if any, that are awaiting responses cannot be completed. # They are listed for re-sending in newQueue. # - All tokens are preserved for re-use by ReplayCore, and their variables # will be re-initialised by calls to ReInit. # - The relevant element of socketMapping, socketRdState, socketWrState, # socketRdQueue, socketWrQueue, socketClosing, socketPlayCmd will be set # to new values in ReplayCore. ReplayCore $newQueue } # http::ReplayIfClose -- # # A request on a socket that was previously "Connection: keep-alive" has # received a "Connection: close" response header. The server supplies # that response correctly, but any later requests already queued on this # connection will be lost when the socket closes. # # This command takes arguments that represent the socketWrState, # socketRdQueue and socketWrQueue for this connection. The socketRdState # is not needed because the server responds in full to the request that # received the "Connection: close" response header. # # Existing request tokens$token (::http::$n) are preserved. The caller # will be unaware that the request was processed this way. proc http::ReplayIfClose {Wstate Rqueue Wqueue} { Log running http::ReplayIfClose for$Wstate $Rqueue$Wqueue if {$Wstate in$Rqueue || $Wstate in$Wqueue} { Log WARNING duplicate token in http::ReplayIfClose - token $Wstate set Wstate Wready } # 1. Create newQueue set InFlightW {} if {$Wstate ni {Wready peNding}} { lappend InFlightW $Wstate } set newQueue {} lappend newQueue {*}$Rqueue lappend newQueue {*}$InFlightW lappend newQueue {*}$Wqueue # 2. Cleanup - none needed, done by the caller. ReplayCore $newQueue } # http::ReInit -- # # Command to restore a token's state to a condition that # makes it ready to replay a request. # # Command http::geturl stores extra state in state(tmp*) so # we don't need to do the argument processing again. # # The caller must: # - Set state(reusing) and state(sock) to their new values after calling # this command. # - Unset state(tmpState), state(tmpOpenCmd) if future calls to ReplayCore # or ReInit are inappropriate for this token. Typically only one retry # is allowed. # The caller may also unset state(tmpConnArgs) if this value (and the # token) will be used immediately. The value is needed by tokens that # will be stored in a queue. # # Arguments: # token Connection token. # # Return Value: (boolean) true iff the re-initialisation was successful. proc http::ReInit {token} { variable$token upvar 0 $token state if {!( [info exists state(tmpState)] && [info exists state(tmpOpenCmd)] && [info exists state(tmpConnArgs)] ) } { Log FAILED in http::ReInit via ReplayCore - NO tmp vars for$token return 0 } if {[info exists state(after)]} { after cancel $state(after) unset state(after) } # Don't alter state(status) - this would trigger http::wait if it is in use. set tmpState$state(tmpState) set tmpOpenCmd $state(tmpOpenCmd) set tmpConnArgs$state(tmpConnArgs) foreach name [array names state] { if {$name ne "status"} { unset state($name) } } # Don't alter state(status). # Restore state(tmp*) - the caller may decide to unset them. # Restore state(tmpConnArgs) which is needed for connection. # state(tmpState), state(tmpOpenCmd) are needed only for retries. dict unset tmpState status array set state $tmpState set state(tmpState)$tmpState set state(tmpOpenCmd) $tmpOpenCmd set state(tmpConnArgs)$tmpConnArgs return 1 } # http::ReplayCore -- # # Command to replay a list of requests, using existing connection tokens. # # Abstracted from http::geturl which stores extra state in state(tmp*) so # we don't need to do the argument processing again. # # Arguments: # newQueue List of connection tokens. # # Side Effects: # Use existing tokens, but try to open a new socket. proc http::ReplayCore {newQueue} { variable socketMapping variable socketRdState variable socketWrState variable socketRdQueue variable socketWrQueue variable socketClosing variable socketPlayCmd if {[llength $newQueue] == 0} { # Nothing to do. return } ##Log running ReplayCore for {*}$newQueue set newToken [lindex $newQueue 0] set newQueue [lrange$newQueue 1 end] # 3. Use newToken, and restore its values of state(*). Do not restore # elements tmp* - we try again only once. set token $newToken variable$token upvar 0 $token state if {![ReInit$token]} { Log FAILED in http::ReplayCore - NO tmp vars Finish $token {cannot send this request again} return } set tmpState$state(tmpState) set tmpOpenCmd $state(tmpOpenCmd) set tmpConnArgs$state(tmpConnArgs) unset state(tmpState) unset state(tmpOpenCmd) unset state(tmpConnArgs) set state(reusing) 0 if {$state(-timeout) > 0} { set resetCmd [list http::reset$token timeout] set state(after) [after $state(-timeout)$resetCmd] } set pre [clock milliseconds] ##Log pre socket opened, - token $token ##Log$tmpOpenCmd - token $token # 4. Open a socket. if {[catch {eval$tmpOpenCmd} sock]} { # Something went wrong while trying to establish the connection. Log FAILED - $sock set state(sock) NONE Finish$token $sock return } ##Log post socket opened, - token$token set delay [expr {[clock milliseconds] - $pre}] if {$delay > 3000} { Log socket delay $delay - token$token } # Command [socket] is called with -async, but takes 5s to 5.1s to return, # with probability of order 1 in 10,000. This may be a bizarre scheduling # issue with my (KJN's) system (Fedora Linux). # This does not cause a problem (unless the request times out when this # command returns). # 5. Configure the persistent socket data. if {$state(-keepalive)} { set socketMapping($state(socketinfo)) $sock if {![info exists socketRdState($state(socketinfo))]} { set socketRdState($state(socketinfo)) {} set varName ::http::socketRdState($state(socketinfo)) trace add variable $varName unset ::http::CancelReadPipeline } if {![info exists socketWrState($state(socketinfo))]} { set socketWrState($state(socketinfo)) {} set varName ::http::socketWrState($state(socketinfo)) trace add variable $varName unset ::http::CancelWritePipeline } if {$state(-pipeline)} { #Log new, init for pipelined, GRANT write acc to $token ReplayCore set socketRdState($state(socketinfo)) $token set socketWrState($state(socketinfo)) $token } else { #Log new, init for nonpipeline, GRANT r/w acc to$token ReplayCore set socketRdState($state(socketinfo))$token set socketWrState($state(socketinfo))$token } set socketRdQueue($state(socketinfo)) {} set socketWrQueue($state(socketinfo)) $newQueue set socketClosing($state(socketinfo)) 0 set socketPlayCmd($state(socketinfo)) {ReplayIfClose Wready {} {}} } ##Log pre newQueue ReInit, - token$token # 6. Configure sockets in the queue. foreach tok $newQueue { if {[ReInit$tok]} { set ${tok}(reusing) 1 set${tok}(sock) $sock } else { set${tok}(reusing) 1 set ${tok}(sock) NONE Finish$token {cannot send this request again} } } # 7. Configure the socket for newToken to send a request. set state(sock) $sock Log "Using$sock for $state(socketinfo) - token$token" \ [expr {$state(-keepalive)?"keepalive":""}] # Initialisation of a new socket. ##Log socket opened, now fconfigure - token$token fconfigure $sock -translation {auto crlf} -buffersize$state(-blocksize) ##Log socket opened, DONE fconfigure - token $token # Connect does its own fconfigure. fileevent$sock writable [list http::Connect $token {*}$tmpConnArgs] #Log ---- $sock << conn to$token for HTTP request (e) } # Data access functions: # Data - the URL data # Status - the transaction status: ok, reset, eof, timeout, error # Code - the HTTP transaction code, e.g., 200 # Size - the size of the URL data proc http::data {token} { variable $token upvar 0$token state return $state(body) ................................................................................ # # Side Effects # unsets the state array proc http::cleanup {token} { variable$token upvar 0 $token state if {[info commands${token}EventCoroutine] ne {}} { rename ${token}EventCoroutine {} } if {[info exists state(after)]} { after cancel$state(after) unset state(after) } if {[info exists state]} { unset state } } # http::Connect # ................................................................................ # Side Effects # Sets the status of the connection, which unblocks # the waiting geturl call proc http::Connect {token proto phost srvurl} { variable $token upvar 0$token state set tk [namespace tail $token] set err "due to unexpected EOF" if { [eof$state(sock)] || [set err [fconfigure $state(sock) -error]] ne "" } { Log "WARNING - if testing, pay special attention to this\ case (GJ) which is seldom executed - token$token" if {[info exists state(reusing)] && $state(reusing)} { # The socket was closed at the server end, and closed at # this end by http::CheckEof. if {[TestForReplay$token write $err b]} { return } # else: # This is NOT a persistent socket that has been closed since its # last use. # If any other requests are in flight or pipelined/queued, they will # be discarded. } Finish$token "connect failed $err" } else { set state(state) connecting fileevent$state(sock) writable {} ::http::Connected $token$proto $phost$srvurl } } # http::Write # # Write POST query data to the socket # # Arguments # token The token for the connection # # Side Effects # Write the socket and handle callbacks. proc http::Write {token} { variable http variable socketMapping variable socketRdState variable socketWrState variable socketRdQueue variable socketWrQueue variable socketClosing variable socketPlayCmd variable $token upvar 0$token state set tk [namespace tail $token] set sock$state(sock) # Output a block. Tcl will buffer this if the socket blocks set done 0 if {[catch { # Catch I/O errors on dead sockets if {[info exists state(-query)]} { # Chop up large query strings so queryprogress callback can give # smooth feedback. if { $state(queryoffset) +$state(-queryblocksize) >= $state(querylength) } { # This will be the last puts for the request-body. if { (![catch {fileevent$sock readable} binding]) && ($binding eq [list http::CheckEof$sock]) } { # Remove the "fileevent readable" binding of an idle # persistent socket to http::CheckEof. We can no longer # treat bytes received as junk. The server might still time # out and half-close the socket if it has not yet received # the first "puts". fileevent $sock readable {} } } puts -nonewline$sock \ [string range $state(-query)$state(queryoffset) \ [expr {$state(queryoffset) +$state(-queryblocksize) - 1}]] incr state(queryoffset) $state(-queryblocksize) if {$state(queryoffset) >= $state(querylength)} { set state(queryoffset)$state(querylength) set done 1 } } else { # Copy blocks from the query channel set outStr [read $state(-querychannel)$state(-queryblocksize)] if {[eof $state(-querychannel)]} { # This will be the last puts for the request-body. if { (![catch {fileevent$sock readable} binding]) && ($binding eq [list http::CheckEof$sock]) } { # Remove the "fileevent readable" binding of an idle # persistent socket to http::CheckEof. We can no longer # treat bytes received as junk. The server might still time # out and half-close the socket if it has not yet received # the first "puts". fileevent $sock readable {} } } puts -nonewline$sock $outStr incr state(queryoffset) [string length$outStr] if {[eof $state(-querychannel)]} { set done 1 } } } err]} { # Do not call Finish here, but instead let the read half of the socket # process whatever server reply there is to get. set state(posterror)$err set done 1 } if {$done} { catch {flush$sock} fileevent $sock writable {} Log ^C$tk end sending request - token $token # End of writing (POST method). The request has been sent. DoneRequest$token } # Callback to the client after we've completely handled everything. if {[string length $state(-queryprogress)]} { eval$state(-queryprogress) \ [list $token$state(querylength) $state(queryoffset)] } } # http::Event # # Handle input on the socket. This command is the core of # the coroutine commands${token}EventCoroutine that are # bound to "fileevent $sock readable" and process input. # # Arguments # sock The socket receiving input. # token The token returned from http::geturl # # Side Effects # Read the socket and handle callbacks. proc http::Event {sock token} { variable http variable socketMapping variable socketRdState variable socketWrState variable socketRdQueue variable socketWrQueue variable socketClosing variable socketPlayCmd variable$token upvar 0 $token state set tk [namespace tail$token] while 1 { yield ##Log Event call - token $token if {![info exists state]} { Log "Event$sock with invalid token '$token' - remote close?" if {![eof$sock]} { if {[set d [read $sock]] ne ""} { Log "WARNING: additional data left on closed socket\ - token$token" } } Log ^X$tk end of response (token error) - token$token CloseSocket $sock return } if {$state(state) eq "connecting"} { ##Log - connecting - token $token if {$state(reusing) && $state(-pipeline) && ($state(-timeout) > 0) && (![info exists state(after)]) } { set state(after) [after $state(-timeout) \ [list http::reset$token timeout]] } if {[catch {gets $sock state(http)} nsl]} { Log "WARNING - if testing, pay special attention to this\ case (GK) which is seldom executed - token$token" if {[info exists state(reusing)] && $state(reusing)} { # The socket was closed at the server end, and closed at # this end by http::CheckEof. if {[TestForReplay$token read $nsl c]} { return } # else: # This is NOT a persistent socket that has been closed since # its last use. # If any other requests are in flight or pipelined/queued, # they will be discarded. } else { Log ^X$tk end of response (error) - token $token Finish$token $nsl return } } elseif {$nsl >= 0} { ##Log - connecting 1 - token $token set state(state) "header" } elseif { [eof$sock] && [info exists state(reusing)] && $state(reusing) } { # The socket was closed at the server end, and we didn't notice. # This is the first read - where the closure is usually first # detected. if {[TestForReplay$token read {} d]} { return } # else: # This is NOT a persistent socket that has been closed since its # last use. # If any other requests are in flight or pipelined/queued, they # will be discarded. } } elseif {$state(state) eq "header"} { if {[catch {gets$sock line} nhl]} { ##Log header failed - token $token Log ^X$tk end of response (error) - token $token Finish$token $nhl return } elseif {$nhl == 0} { ##Log header done - token $token Log ^E$tk end of response headers - token $token # We have now read all headers # We ignore HTTP/1.1 100 Continue returns. RFC2616 sec 8.2.3 if { ($state(http) == "") || ([regexp {^\S+\s(\d+)} $state(http) {} x] &&$x == 100) } { set state(state) "connecting" continue # This was a "return" in the pre-coroutine code. } if { ([info exists state(connection)]) && ([info exists socketMapping($state(socketinfo))]) && ($state(connection) eq "keep-alive") && ($state(-keepalive)) && (!$state(reusing)) && ($state(-pipeline)) } { # Response headers received for first request on a # persistent socket. Now ready for pipelined writes (if # any). # Previous value is$token. It cannot be "pending". set socketWrState($state(socketinfo)) Wready http::NextPipelinedWrite$token } # Once a "close" has been signaled, the client MUST NOT send any # more requests on that connection. # # If either the client or the server sends the "close" token in # the Connection header, that request becomes the last one for # the connection. if { ([info exists state(connection)]) && ([info exists socketMapping($state(socketinfo))]) && ($state(connection) eq "close") && ($state(-keepalive)) } { # The server warns that it will close the socket after this # response. ##Log WARNING - socket will close after response for$token # Prepare data for a call to ReplayIfClose. if { ($socketRdQueue($state(socketinfo)) ne {}) || ($socketWrQueue($state(socketinfo)) ne {}) || ($socketWrState($state(socketinfo)) ni [list Wready peNding $token]) } { set InFlightW$socketWrState($state(socketinfo)) if {$InFlightW in [list Wready peNding $token]} { set InFlightW Wready } else { set msg "token${InFlightW} is InFlightW" ##Log $msg - token$token } set socketPlayCmd($state(socketinfo)) \ [list ReplayIfClose$InFlightW \ $socketRdQueue($state(socketinfo)) \ $socketWrQueue($state(socketinfo))] # - All tokens are preserved for re-use by ReplayCore. # - Queues are preserved in case of Finish with error, # but are not used for anything else because # socketClosing(*) is set below. # - Cancel the state(after) timeout events. foreach tokenVal $socketRdQueue($state(socketinfo)) { if {[info exists ${tokenVal}(after)]} { after cancel [set${tokenVal}(after)] unset ${tokenVal}(after) } } } else { set socketPlayCmd($state(socketinfo)) \ {ReplayIfClose Wready {} {}} } # Do not allow further connections on this socket. set socketClosing($state(socketinfo)) 1 } set state(state) body # If doing a HEAD, then we won't get any body if {$state(-validate)} { Log ^F$tk end of response for HEAD request - token$token set state(state) complete Eot $token return } # - For non-chunked transfer we may have no body - in this case # we may get no further file event if the connection doesn't # close and no more data is sent. We can tell and must finish # up now - not later - the alternative would be to wait until # the server times out. # - In this case, the server has NOT told the client it will # close the connection, AND it has NOT indicated the resource # length EITHER by setting the Content-Length (totalsize) OR # by using chunked Transfer-Encoding. # - Do not worry here about the case (Connection: close) because # the server should close the connection. # - IF (NOT Connection: close) AND (NOT chunked encoding) AND # (totalsize == 0). if { (!( [info exists state(connection)] && ($state(connection) eq "close") ) ) && (![info exists state(transfer)]) && ($state(totalsize) == 0) } { set msg {body size is 0 and no events likely - complete} Log "$msg - token $token" set msg {(length unknown, set to 0)} Log ^F$tk end of response body {*}$msg - token$token set state(state) complete Eot $token return } # We have to use binary translation to count bytes properly. lassign [fconfigure$sock -translation] trRead trWrite fconfigure $sock -translation [list binary$trWrite] if { $state(-binary) || [IsBinaryContentType$state(type)] } { # Turn off conversions for non-text data. set state(binary) 1 } if {[info exists state(-channel)]} { if {$state(binary) || [llength [ContentEncoding$token]]} { fconfigure $state(-channel) -translation binary } if {![info exists state(-handler)]} { # Initiate a sequence of background fcopies. fileevent$sock readable {} rename ${token}EventCoroutine {} CopyStart$sock $token return } } } elseif {$nhl > 0} { # Process header lines. ##Log header - token $token -$line if {[regexp -nocase {^([^:]+):(.+)$}$line x key value]} { switch -- [string tolower $key] { content-type { set state(type) [string trim [string tolower$value]] # Grab the optional charset information. if {[regexp -nocase \ {charset\s*=\s*\"((?:[^""]|\\\")*)\"} \ $state(type) -> cs]} { set state(charset) [string map {{\"} \"}$cs] } else { regexp -nocase {charset\s*=\s*(\S+?);?} \ $state(type) -> state(charset) } } content-length { set state(totalsize) [string trim$value] } content-encoding { set state(coding) [string trim $value] } transfer-encoding { set state(transfer) \ [string trim [string tolower$value]] } proxy-connection - connection { set state(connection) \ [string trim [string tolower $value]] } } lappend state(meta)$key [string trim $value] } } } else { # Now reading body ##Log body - token$token if {[catch { if {[info exists state(-handler)]} { set n [eval $state(-handler) [list$sock $token]] ##Log handler$n - token $token # N.B. the protocol has been set to 1.0 because the -handler # logic is not expected to handle chunked encoding. # FIXME Allow -handler with 1.1 on dechunked stacked chan. if {$state(totalsize) == 0} { # We know the transfer is complete only when the server # closes the connection - i.e. eof is not an error. set state(state) complete } if {![string is integer -strict $n]} { if 1 { # Do not tolerate bad -handler - fail with error # status. set msg {the -handler command for http::geturl must\ return an integer (the number of bytes\ read)} Log ^X$tk end of response (handler error) -\ token $token Eot$token $msg } else { # Tolerate the bad -handler, and continue. The # penalty: # (a) Because the handler returns nonsense, we know # the transfer is complete only when the server # closes the connection - i.e. eof is not an # error. # (b) http::size will not be accurate. # (c) The transaction is already downgraded to 1.0 # to avoid chunked transfer encoding. It MUST # also be forced to "Connection: close" or the # HTTP/1.0 equivalent; or it MUST fail (as # above) if the server sends # "Connection: keep-alive" or the HTTP/1.0 # equivalent. set n 0 set state(state) complete } } } elseif {[info exists state(transfer_final)]} { # This code forgives EOF in place of the final CRLF. set line [getTextLine$sock] set n [string length $line] set state(state) complete if {$n > 0} { # - HTTP trailers (late response headers) are permitted # by Chunked Transfer-Encoding, and can be safely # ignored. # - Do not count these bytes in the total received for # the response body. Log "trailer of $n bytes after final chunk -\ token$token" append state(transfer_final) $line set n 0 } else { Log ^F$tk end of response body (chunked) - token $token Log "final chunk part - token$token" Eot $token } } elseif { [info exists state(transfer)] && ($state(transfer) eq "chunked") } { ##Log chunked - token $token set size 0 set hexLenChunk [getTextLine$sock] #set ntl [string length $hexLenChunk] if {[string trim$hexLenChunk] ne ""} { scan $hexLenChunk %x size if {$size != 0} { ##Log chunk-measure $size - token$token set chunk [BlockingRead $sock$size] set n [string length $chunk] if {$n >= 0} { append state(body) $chunk incr state(log_size) [string length$chunk] ##Log chunk $n cumul$state(log_size) -\ token $token } if {$size != [string length $chunk]} { Log "WARNING: mis-sized chunk:\ was [string length$chunk], should be\ $size - token$token" set n 0 set state(connection) close Log ^X$tk end of response (chunk error) \ - token$token set msg {error in chunked encoding - fetch\ terminated} Eot $token$msg } # CRLF that follows chunk. # If eof, this is handled at the end of this proc. getTextLine $sock } else { set n 0 set state(transfer_final) {} } } else { # Line expected to hold chunk length is empty, or eof. ##Log bad-chunk-measure - token$token set n 0 set state(connection) close Log ^X$tk end of response (chunk error) - token$token Eot $token {error in chunked encoding -\ fetch terminated} } } else { ##Log unchunked - token$token if {$state(totalsize) == 0} { # We know the transfer is complete only when the server # closes the connection. set state(state) complete set reqSize$state(-blocksize) } else { # Ask for the whole of the unserved response-body. # This works around a problem with a tls::socket - for # https in keep-alive mode, and a request for # $state(-blocksize) bytes, the last part of the # resource does not get read until the server times out. set reqSize [expr {$state(totalsize) - $state(currentsize)}] # The workaround fails if reqSize is # capped at$state(-blocksize). # set reqSize [expr {min($reqSize,$state(-blocksize))}] } set c $state(currentsize) set t$state(totalsize) ##Log non-chunk currentsize $c of totalsize$t -\ token $token set block [read$sock $reqSize] set n [string length$block] if {$n >= 0} { append state(body)$block ##Log non-chunk [string length $state(body)] -\ token$token } } # This calculation uses n from the -handler, chunked, or # unchunked case as appropriate. if {[info exists state]} { if {$n >= 0} { incr state(currentsize)$n set c $state(currentsize) set t$state(totalsize) ##Log another $n currentsize$c totalsize $t -\ token$token } # If Content-Length - check for end of data. if { ($state(totalsize) > 0) && ($state(currentsize) >= $state(totalsize)) } { Log ^F$tk end of response body (unchunked) -\ token $token set state(state) complete Eot$token } } } err]} { Log ^X$tk end of response (error${err}) - token $token Finish$token $err return } else { if {[info exists state(-progress)]} { eval$state(-progress) \ [list $token$state(totalsize) $state(currentsize)] } } } # catch as an Eot above may have closed the socket already #$state(state) may be connecting, header, body, or complete if {![set cc [catch {eof $sock} eof]] &&$eof} { ##Log eof - token $token if {[info exists$token]} { set state(connection) close if {$state(state) eq "complete"} { # This includes all cases in which the transaction # can be completed by eof. # The value "complete" is set only in http::Event, and it is # used only in the test above. Log ^F$tk end of response body (unchunked, eof) -\ token $token Eot$token } else { # Premature eof. Log ^X$tk end of response (unexpected eof) - token$token Eot $token eof } } else { # open connection closed on a token that has been cleaned up. Log ^X$tk end of response (token error) - token $token CloseSocket$sock } } elseif {$cc} { return } } } # http::TestForReplay # # Command called if eof is discovered when a socket is first used for a # new transaction. Typically this occurs if a persistent socket is used # after a period of idleness and the server has half-closed the socket. # # token - the connection token returned by http::geturl # doing - "read" or "write" # err - error message, if any # caller - code to identify the caller - used only in logging # # Return Value: boolean, true iff the command calls http::ReplayIfDead. proc http::TestForReplay {token doing err caller} { variable http variable$token upvar 0 $token state set tk [namespace tail$token] if {$doing eq "read"} { set code Q set action response set ing reading } else { set code P set action request set ing writing } if {$err eq {}} { set err "detect eof when $ing (server timed out?)" } if {$state(method) eq "POST" && !$http(-repost)} { # No Replay. # The present transaction will end when Finish is called. # That call to Finish will abort any other transactions # currently in the write queue. # For calls from http::Event this occurs when execution # reaches the code block at the end of that proc. set msg {no retry for POST with http::config -repost 0} Log reusing socket failed "($caller)" - $msg - token$token Log error - $err - token$token Log ^X$tk end of$action (error) - token $token return 0 } else { # Replay. set msg {try a new socket} Log reusing socket failed "($caller)" - $msg - token$token Log error - $err - token$token Log ^$code$tk Any unfinished (incl this one) failed - token $token ReplayIfDead$token $doing return 1 } } # http::IsBinaryContentType -- # # Determine if the content-type means that we should definitely transfer # the data as binary. [Bug 838e99a76d] ................................................................................ return false } return true } # http::getTextLine -- # # Get one line with the stream in crlf mode. # Used if Transfer-Encoding is chunked. # Empty line is not distinguished from eof. The caller must # be able to handle this. # # Arguments # sock The socket receiving input. # # Results: # The line of text, without trailing newline proc http::getTextLine {sock} { set tr [fconfigure$sock -translation] lassign $tr trRead trWrite fconfigure$sock -translation [list crlf $trWrite] set r [BlockingGets$sock] fconfigure $sock -translation$tr return $r } # http::BlockingRead # # Replacement for a blocking read. # The caller must be a coroutine. proc http::BlockingRead {sock size} { if {$size < 1} { return } set result {} while 1 { set need [expr {$size - [string length$result]}] set block [read $sock$need] set eof [eof $sock] append result$block if {[string length $result] >=$size || $eof} { return$result } else { yield } } } # http::BlockingGets # # Replacement for a blocking gets. # The caller must be a coroutine. # Empty line is not distinguished from eof. The caller must # be able to handle this. proc http::BlockingGets {sock} { while 1 { set count [gets $sock line] set eof [eof$sock] if {$count > -1 ||$eof} { return $line } else { yield } } } # http::CopyStart # # Error handling wrapper around fcopy # # Arguments # sock The socket to copy from ................................................................................ } else { if {$initial} { foreach coding [ContentEncoding $token] { zlib push$coding $sock } } if {[catch { # FIXME Keep-Alive on https tls::socket with unchunked transfer # hangs until the server times out. A workaround is possible, as for # the case without -channel, but it does not use the neat "fcopy" # solution. fcopy$sock $state(-channel) -size$state(-blocksize) -command \ [list http::CopyDone $token] } err]} { Finish$token $err } } } ................................................................................ } puts -nonewline$state(-channel) $chunk if {[info exists state(-progress)]} { eval [linsert$state(-progress) end \ $token$state(totalsize) $state(currentsize)] } } else { Log "CopyChunk Finish - token$token" if {[info exists state(zlib)]} { set excess "" foreach stream $state(zlib) { catch {set excess [$stream add -finalize $excess]} } puts -nonewline$state(-channel) $excess foreach stream$state(zlib) { $stream close } unset state(zlib) } Eot$token ;# FIX ME: pipelining. } } # http::CopyDone # # fcopy completion callback # ................................................................................ upvar 0 $token state set sock$state(sock) incr state(currentsize) $count if {[info exists state(-progress)]} { eval$state(-progress) \ [list $token$state(totalsize) $state(currentsize)] } # At this point the token may have been reset. if {[string length$error]} { Finish $token$error } elseif {[catch {eof $sock} iseof] ||$iseof} { Eot $token } else { CopyStart$sock $token 0 } } # http::Eot # # Called when either: # a. An eof condition is detected on the socket. # b. The client decides that the response is complete. # c. The client detects an inconsistency and aborts the transaction. # # Does: # 1. Set state(status) # 2. Reverse any Content-Encoding # 3. Convert charset encoding and line ends if necessary # 4. Call http::Finish # # Arguments # token The token returned from http::geturl # force (previously) optional, has no effect # reason - "eof" means premature EOF (not EOF as the natural end of # the response) # - "" means completion of response, with or without EOF # - anything else describes an error confition other than # premature EOF. # # Side Effects # Clean up the socket proc http::Eot {token {reason {}}} { variable$token upvar 0 $token state if {$reason eq "eof"} { # Premature eof. set state(status) eof set reason {} } elseif {$reason ne ""} { # Abort the transaction. set state(status)$reason } else { # The response is complete. set state(status) ok } if {[string length $state(body)] > 0} { if {[catch { foreach coding [ContentEncoding$token] { set state(body) [zlib $coding$state(body)] } } err]} { Log "error doing decompression for token $token:$err" Finish $token$err return } if {!$state(binary)} { # If we are getting text, set the incoming channel's encoding # correctly. iso8859-1 is the RFC default, but this could be any # IANA charset. However, we only know how to convert what we have # encodings for. set enc [CharsetToEncoding$state(charset)] if {$enc ne "binary"} { set state(body) [encoding convertfrom$enc $state(body)] } # Translate text line endings. set state(body) [string map {\r\n \n \r \n}$state(body)] } } Finish $token$reason } # http::wait -- # # See documentation for details. # # Arguments: # token Connection token. # # Results: # The status after the wait. proc http::wait {token} { variable $token upvar 0$token state if {![info exists state(status)] || $state(status) eq ""} { # We must wait on the original variable name, not the upvar alias ................................................................................ # Arguments: # args A list of name-value pairs. # # Results: # TODO proc http::formatQuery {args} { if {[llength$args] % 2} { return \ -code error \ -errorcode [list HTTP BADARGCNT $args] \ {Incorrect number of arguments, must be an even number.} } set result "" set sep "" foreach i$args { append result $sep [mapReply$i] if {$sep eq "="} { set sep & } else { ................................................................................ regexp "$\u0100-\uffff$"$converted badChar # Return this error message for maximum compatibility... :^/ return -code error \ "can't read \"formMap($badChar)\": no such element in array" } return$converted } interp alias {} http::quoteString {} http::mapReply # http::ProxyRequired -- # Default proxy filter. # # Arguments: # host The destination host # ................................................................................ return -code error "unsupported content-encoding \"$coding\"" } } } } return$r } proc http::ReceiveChunked {chan command} { set data "" set size -1 yield while {1} { chan configure $chan -translation {crlf binary} while {[gets$chan line] < 1} { yield } chan configure $chan -translation {binary binary} if {[scan$line %x size] != 1} { return -code error "invalid size: \"$line\"" } set chunk "" while {$size && ![chan eof $chan]} { set part [chan read$chan $size] incr size -[string length$part] append chunk $part } if {[catch { uplevel #0 [linsert$command end $chunk] }]} { http::Log "Error in callback:$::errorInfo" } if {[string length $chunk] == 0} { # channel might have been closed in the callback catch {chan event$chan readable {}} return } } } proc http::make-transformation-chunked {chan command} { coroutine [namespace current]::dechunk$chan ::http::ReceiveChunked$chan $command chan event$chan readable [namespace current]::dechunk$chan } # Local variables: # indent-tabs-mode: t # End:  Changes to library/http/pkgIndex.tcl.  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}}}]   |  1 2  if {![package vsatisfies [package provide Tcl] 8.6-]} {return} 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}}}]  Changes to library/init.tcl.  12 13 14 15 16 17 18 19 20 21 22 23 24 25 26  # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # This test intentionally written in pre-7.5 Tcl if {[info commands package] == ""} { error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]" } package require -exact Tcl 8.6.8 # Compute the auto path to use in this interpreter. # The values on the path come from several locations: # # The environment variable TCLLIBPATH # # tcl_library, which is the directory containing this init.tcl script.   |  12 13 14 15 16 17 18 19 20 21 22 23 24 25 26  # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # This test intentionally written in pre-7.5 Tcl if {[info commands package] == ""} { error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]" } package require -exact Tcl 8.6.9 # Compute the auto path to use in this interpreter. # The values on the path come from several locations: # # The environment variable TCLLIBPATH # # tcl_library, which is the directory containing this init.tcl script.  Changes to library/reg/pkgIndex.tcl.  1 2 3 4 5 6 7 8 9  if {([info commands ::tcl::pkgconfig] eq "") || ([info sharedlibextension] ne ".dll")} return if {[::tcl::pkgconfig get debug]} { package ifneeded registry 1.3.2 \ [list load [file join$dir tclreg13g.dll] registry] } else { package ifneeded registry 1.3.2 \ [list load [file join $dir tclreg13.dll] registry] }   | |  1 2 3 4 5 6 7 8 9  if {([info commands ::tcl::pkgconfig] eq "") || ([info sharedlibextension] ne ".dll")} return if {[::tcl::pkgconfig get debug]} { package ifneeded registry 1.3.3 \ [list load [file join$dir tclreg13g.dll] registry] } else { package ifneeded registry 1.3.3 \ [list load [file join $dir tclreg13.dll] registry] }  Changes to library/tcltest/pkgIndex.tcl.  4 5 6 7 8 9 10 11 12  # by a "package unknown" script. It invokes the # "package ifneeded" command to set up package-related # information so that packages will be loaded automatically # in response to "package require" commands. When this # 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]]   | |  4 5 6 7 8 9 10 11 12  # by a "package unknown" script. It invokes the # "package ifneeded" command to set up package-related # information so that packages will be loaded automatically # in response to "package require" commands. When this # 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.5.0 [list source [file join $dir tcltest.tcl]]  Changes to library/tcltest/tcltest.tcl.  18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 .... 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 .... 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 .... 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 .... 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 .... 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 .... 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 .... 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 .... 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 .... 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 .... 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 .... 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 .... 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 .... 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891   package require Tcl 8.5- ;# -verbose line uses [info frame] 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 # Compatibility support for dumb variables defined in tcltest 1 # Do not use these. Call [package provide Tcl] and [info patchlevel] # yourself. You don't need tcltest to wrap it for you. variable version [package provide Tcl] variable patchLevel [info patchlevel] ................................................................................ # optional; default is {}. # output - Expected output sent to stdout. This attribute # is optional; default is {}. # errorOutput - Expected output sent to stderr. This attribute # is optional; default is {}. # returnCodes - Expected return codes. This attribute is # optional; default is {0 2}. # setup - Code to run before$script (above). This # attribute is optional; default is {}. # cleanup - Code to run after $script (above). This # attribute is optional; default is {}. # match - specifies type of matching to do on result, # output, errorOutput; this must be a string # previously registered by a call to [customMatch]. ................................................................................ FillFilesExisted incr testLevel # 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 # Set the default match mode set match exact # Set the default match values for return codes (0 is the standard # expected return value if everything went well; 2 represents # 'return' being used in the test script). set returnCodes [list 0 2] # 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)} { if {[llength$args] == 1} { set list [SubstArguments [lindex $args 0]] foreach {element value}$list { set testAttributes($element)$value } foreach item {constraints match setup body cleanup \ result returnCodes output errorOutput} { if {[info exists testAttributes(-$item)]} { set testAttributes(-$item) [uplevel 1 \ ::concat $testAttributes(-$item)] } } } else { array set testAttributes $args } set validFlags {-setup -cleanup -body -result -returnCodes \ -match -output -errorOutput -constraints} foreach flag [array names testAttributes] { if {$flag ni $validFlags} { incr testLevel -1 set sorted [lsort$validFlags] set options [join [lrange $sorted 0 end-1] ", "] append options ", or [lindex$sorted end]" ................................................................................ must be $values" } # Replace symbolic valies supplied for -returnCodes foreach {strcode numcode} {ok 0 normal 0 error 1 return 2 break 3 continue 4} { set returnCodes [string map -nocase [list$strcode $numcode]$returnCodes] } } else { # This is parsing for the old test command format; it is here # for backward compatibility. set result [lindex $args end] if {[llength$args] == 2} { set body [lindex $args 0] } elseif {[llength$args] == 3} { ................................................................................ } } # First, run the setup script set code [catch {uplevel 1 $setup} setupMsg] if {$code == 1} { set errorInfo(setup) $::errorInfo set errorCode(setup)$::errorCode } set setupFailure [expr {$code != 0}] # Only run the test body if the setup was successful if {!$setupFailure} { # Register startup time ................................................................................ set testResult [uplevel 1 [list [namespace origin Eval] $command 0]] } else { set testResult [uplevel 1 [list [namespace origin Eval]$command 1]] } lassign $testResult actualAnswer returnCode if {$returnCode == 1} { set errorInfo(body) $::errorInfo set errorCode(body)$::errorCode } } # check if the return code matched the expected return code set codeFailure 0 if {!$setupFailure && ($returnCode ni $returnCodes)} { set codeFailure 1 } # If expected output/error strings exist, we have to compare # them. If the comparison fails, then so did the test. set outputFailure 0 variable outData if {[info exists output] && !$codeFailure} { ................................................................................ set scriptFailure 1 } # Always run the cleanup script set code [catch {uplevel 1 $cleanup} cleanupMsg] if {$code == 1} { set errorInfo(cleanup) $::errorInfo set errorCode(cleanup)$::errorCode } set cleanupFailure [expr {$code != 0}] set coreFailure 0 set coreMsg "" # check for a core file first - if one was created by the test, # then the test failed ................................................................................ } } # if we didn't experience any failures, then we passed variable numTests if {!($setupFailure || $cleanupFailure ||$coreFailure || $outputFailure ||$errorFailure || $codeFailure ||$scriptFailure)} { if {$testLevel == 1} { incr numTests(Passed) if {[IsVerbose pass]} { puts [outputChannel] "++++$name PASSED" } } incr testLevel -1 ................................................................................ puts [outputChannel] $body } if {$setupFailure} { puts [outputChannel] "---- Test setup\ failed:\n$setupMsg" if {[info exists errorInfo(setup)]} { puts [outputChannel] "---- errorInfo(setup):$errorInfo(setup)" puts [outputChannel] "---- errorCode(setup): $errorCode(setup)" } } if {$scriptFailure} { if {$scriptCompare} { puts [outputChannel] "---- Error testing result:$scriptMatch" } else { puts [outputChannel] "---- Result was:\n$actualAnswer" puts [outputChannel] "---- Result should have been\ ($match matching):\n$result" } } if {$codeFailure} { switch -- $returnCode { 0 { set msg "Test completed normally" } 1 { set msg "Test generated error" } 2 { set msg "Test generated return exception" } 3 { set msg "Test generated break exception" } 4 { set msg "Test generated continue exception" } ................................................................................ } puts [outputChannel] "----$msg; Return code was: $returnCode" puts [outputChannel] "---- Return code should have been\ one of:$returnCodes" if {[IsVerbose error]} { if {[info exists errorInfo(body)] && (1 ni $returnCodes)} { puts [outputChannel] "---- errorInfo:$errorInfo(body)" puts [outputChannel] "---- errorCode: $errorCode(body)" } } } if {$outputFailure} { if {$outputCompare} { puts [outputChannel] "---- Error testing output:$outputMatch" } else { ................................................................................ been ($match matching):\n$errorOutput" } } if {$cleanupFailure} { puts [outputChannel] "---- Test cleanup failed:\n$cleanupMsg" if {[info exists errorInfo(cleanup)]} { puts [outputChannel] "---- errorInfo(cleanup): $errorInfo(cleanup)" puts [outputChannel] "---- errorCode(cleanup):$errorCode(cleanup)" } } if {$coreFailure} { puts [outputChannel] "---- Core file produced while running\ test!$coreMsg" } puts [outputChannel] "==== $name FAILED\n" ................................................................................ # skip patterns provided. after sourcing test files, it goes on # to source all.tcl files in matching test subdirectories. # # Arguments: # shell being tested # # Results: # None. # # Side effects: # None. proc tcltest::runAllTests { {shell ""} } { variable testSingleFile variable numTestFiles variable numTests variable failFiles variable DefaultValue FillFilesExisted if {[llength [info level 0]] == 1} { set shell [interpreter] } set testSingleFile false ................................................................................ } ""]$line null testFile \ Total Passed Skipped Failed]} { foreach index {Total Passed Skipped Failed} { incr numTests($index) [set$index] } if {$Failed > 0} { lappend failFiles$testFile } } elseif {[regexp [join { {^Number of tests skipped } {for each constraint:} {|^\t(\d+)\t(.+)$} } ""]$line match skipped constraint]} { if {[string match \t* $match]} { ................................................................................ uplevel 1 [list ::source [file join$directory all.tcl]] set endTime [eval $timeCmd] puts [outputChannel] "\n$dir test ended at $endTime" puts [outputChannel] "" puts [outputChannel] [string repeat ~ 44] } return } ##################################################################### # Test utility procs - not used in tcltest, but may be useful for # testing.   | > > > | > > > | | > > > > | | > > > > > | | | > > > > | | | > > |  18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 .... 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 .... 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 .... 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 .... 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 .... 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 .... 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 .... 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 .... 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 .... 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 .... 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 .... 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 .... 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 .... 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912   package require Tcl 8.5- ;# -verbose line uses [info frame] 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.5.0 # Compatibility support for dumb variables defined in tcltest 1 # Do not use these. Call [package provide Tcl] and [info patchlevel] # yourself. You don't need tcltest to wrap it for you. variable version [package provide Tcl] variable patchLevel [info patchlevel] ................................................................................ # optional; default is {}. # output - Expected output sent to stdout. This attribute # is optional; default is {}. # errorOutput - Expected output sent to stderr. This attribute # 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 # attribute is optional; default is {}. # match - specifies type of matching to do on result, # output, errorOutput; this must be a string # previously registered by a call to [customMatch]. ................................................................................ FillFilesExisted incr testLevel # 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 errorCode match # Set the default match mode set match exact # Set the default match values for return codes (0 is the standard # expected return value if everything went well; 2 represents # '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)} { if {[llength$args] == 1} { set list [SubstArguments [lindex $args 0]] foreach {element value}$list { set testAttributes($element)$value } foreach item {constraints match setup body cleanup \ result returnCodes errorCode output errorOutput} { if {[info exists testAttributes(-$item)]} { set testAttributes(-$item) [uplevel 1 \ ::concat $testAttributes(-$item)] } } } else { array set testAttributes $args } set validFlags {-setup -cleanup -body -result -returnCodes \ -errorCode -match -output -errorOutput -constraints} foreach flag [array names testAttributes] { if {$flag ni $validFlags} { incr testLevel -1 set sorted [lsort$validFlags] set options [join [lrange $sorted 0 end-1] ", "] append options ", or [lindex$sorted end]" ................................................................................ must be $values" } # Replace symbolic valies supplied for -returnCodes 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. set result [lindex $args end] if {[llength$args] == 2} { set body [lindex $args 0] } elseif {[llength$args] == 3} { ................................................................................ } } # First, run the setup script set code [catch {uplevel 1 $setup} setupMsg] if {$code == 1} { set errorInfo(setup) $::errorInfo set errorCodeRes(setup)$::errorCode } set setupFailure [expr {$code != 0}] # Only run the test body if the setup was successful if {!$setupFailure} { # Register startup time ................................................................................ set testResult [uplevel 1 [list [namespace origin Eval] $command 0]] } else { set testResult [uplevel 1 [list [namespace origin Eval]$command 1]] } lassign $testResult actualAnswer returnCode if {$returnCode == 1} { set errorInfo(body) $::errorInfo set errorCodeRes(body)$::errorCode } } # check if the return code matched the expected return code set codeFailure 0 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. set outputFailure 0 variable outData if {[info exists output] && !$codeFailure} { ................................................................................ set scriptFailure 1 } # Always run the cleanup script set code [catch {uplevel 1$cleanup} cleanupMsg] if {$code == 1} { set errorInfo(cleanup)$::errorInfo set errorCodeRes(cleanup) $::errorCode } set cleanupFailure [expr {$code != 0}] set coreFailure 0 set coreMsg "" # check for a core file first - if one was created by the test, # then the test failed ................................................................................ } } # if we didn't experience any failures, then we passed variable numTests if {!($setupFailure ||$cleanupFailure || $coreFailure ||$outputFailure || $errorFailure ||$codeFailure || $errorCodeFailure ||$scriptFailure)} { if {$testLevel == 1} { incr numTests(Passed) if {[IsVerbose pass]} { puts [outputChannel] "++++$name PASSED" } } incr testLevel -1 ................................................................................ puts [outputChannel] $body } if {$setupFailure} { puts [outputChannel] "---- Test setup\ failed:\n$setupMsg" if {[info exists errorInfo(setup)]} { puts [outputChannel] "---- errorInfo(setup):$errorInfo(setup)" puts [outputChannel] "---- errorCode(setup): $errorCodeRes(setup)" } } if {$scriptFailure} { if {$scriptCompare} { puts [outputChannel] "---- Error testing result:$scriptMatch" } else { puts [outputChannel] "---- Result was:\n$actualAnswer" puts [outputChannel] "---- Result should have been\ ($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" } 1 { set msg "Test generated error" } 2 { set msg "Test generated return exception" } 3 { set msg "Test generated break exception" } 4 { set msg "Test generated continue exception" } ................................................................................ } puts [outputChannel] "---- $msg; Return code was:$returnCode" puts [outputChannel] "---- Return code should have been\ one of: $returnCodes" if {[IsVerbose error]} { if {[info exists errorInfo(body)] && (1 ni$returnCodes)} { puts [outputChannel] "---- errorInfo: $errorInfo(body)" puts [outputChannel] "---- errorCode:$errorCodeRes(body)" } } } if {$outputFailure} { if {$outputCompare} { puts [outputChannel] "---- Error testing output: $outputMatch" } else { ................................................................................ been ($match matching):\n$errorOutput" } } if {$cleanupFailure} { puts [outputChannel] "---- Test cleanup failed:\n$cleanupMsg" if {[info exists errorInfo(cleanup)]} { puts [outputChannel] "---- errorInfo(cleanup):$errorInfo(cleanup)" puts [outputChannel] "---- errorCode(cleanup): $errorCodeRes(cleanup)" } } if {$coreFailure} { puts [outputChannel] "---- Core file produced while running\ test! $coreMsg" } puts [outputChannel] "====$name FAILED\n" ................................................................................ # skip patterns provided. after sourcing test files, it goes on # to source all.tcl files in matching test subdirectories. # # Arguments: # shell being tested # # Results: # Whether there were any failures. # # Side effects: # None. proc tcltest::runAllTests { {shell ""} } { variable testSingleFile variable numTestFiles variable numTests variable failFiles variable DefaultValue set failFilesAccum {} FillFilesExisted if {[llength [info level 0]] == 1} { set shell [interpreter] } set testSingleFile false ................................................................................ } ""] $line null testFile \ Total Passed Skipped Failed]} { foreach index {Total Passed Skipped Failed} { incr numTests($index) [set $index] } if {$Failed > 0} { lappend failFiles $testFile lappend failFilesAccum$testFile } } elseif {[regexp [join { {^Number of tests skipped } {for each constraint:} {|^\t(\d+)\t(.+)$} } ""]$line match skipped constraint]} { if {[string match \t* $match]} { ................................................................................ uplevel 1 [list ::source [file join$directory all.tcl]] set endTime [eval $timeCmd] puts [outputChannel] "\n$dir test ended at $endTime" puts [outputChannel] "" puts [outputChannel] [string repeat ~ 44] } return [expr {[info exists testFileFailures] || [llength$failFilesAccum]}] } ##################################################################### # Test utility procs - not used in tcltest, but may be useful for # testing. 

Changes to library/tzdata/Africa/Casablanca.

 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230  # created by tools/tclZIC.tcl - do not edit 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} }   | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < | | < < | | < < | | < > | < > | < > | < > | < > > > > > | > | > | < | | | | | | | | | < | < < < < | < > | < < > | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < <  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100  # created by tools/tclZIC.tcl - do not edit set TZData(:Africa/Casablanca) { {-9223372036854775808 -1820 0 LMT} {-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} {1540695600 3600 0 +01} {1557021600 0 1 +01} {1560045600 3600 0 +01} {1587261600 0 1 +01} {1590285600 3600 0 +01} {1618106400 0 1 +01} {1621130400 3600 0 +01} {1648346400 0 1 +01} {1651975200 3600 0 +01} {1679191200 0 1 +01} {1682215200 3600 0 +01} {1710036000 0 1 +01} {1713060000 3600 0 +01} {1740276000 0 1 +01} {1743904800 3600 0 +01} {1771120800 0 1 +01} {1774144800 3600 0 +01} {1801965600 0 1 +01} {1804989600 3600 0 +01} {1832205600 0 1 +01} {1835229600 3600 0 +01} {1863050400 0 1 +01} {1866074400 3600 0 +01} {1893290400 0 1 +01} {1896919200 3600 0 +01} {1924135200 0 1 +01} {1927159200 3600 0 +01} {1954980000 0 1 +01} {1958004000 3600 0 +01} {1985220000 0 1 +01} {1988848800 3600 0 +01} {2016064800 0 1 +01} {2019088800 3600 0 +01} {2046304800 0 1 +01} {2049933600 3600 0 +01} {2077149600 0 1 +01} {2080173600 3600 0 +01} {2107994400 0 1 +01} {2111018400 3600 0 +01} {2138234400 0 1 +01} {2141863200 3600 0 +01} } 

Changes to library/tzdata/Africa/Ceuta.

 11 12 13 14 15 16 17 18 19 20 21 22 23 24   {-1379293200 3600 1 WEST} {-1364774400 0 0 WET} {-1348448400 3600 1 WEST} {-1333324800 0 0 WET} {-1316390400 3600 1 WEST} {-1301270400 0 0 WET} {-1293840000 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}   >  11 12 13 14 15 16 17 18 19 20 21 22 23 24 25   {-1379293200 3600 1 WEST} {-1364774400 0 0 WET} {-1348448400 3600 1 WEST} {-1333324800 0 0 WET} {-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} {147222000 0 0 WET} {199756800 3600 1 WEST} {207702000 0 0 WET} {231292800 3600 1 WEST} 

Changes to library/tzdata/Africa/El_Aaiun.

 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219  # created by tools/tclZIC.tcl - do not edit 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} }   | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < | | < < | | < < | | < > | < > | < > | < > | < > > > > > | > | > | < | | | | | | | | | < | < < < < | < > | < < > | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < <  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89  # created by tools/tclZIC.tcl - do not edit set TZData(:Africa/El_Aaiun) { {-9223372036854775808 -3168 0 LMT} {-1136070432 -3600 0 -01} {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} {1540695600 3600 0 +01} {1557021600 0 1 +01} {1560045600 3600 0 +01} {1587261600 0 1 +01} {1590285600 3600 0 +01} {1618106400 0 1 +01} {1621130400 3600 0 +01} {1648346400 0 1 +01} {1651975200 3600 0 +01} {1679191200 0 1 +01} {1682215200 3600 0 +01} {1710036000 0 1 +01} {1713060000 3600 0 +01} {1740276000 0 1 +01} {1743904800 3600 0 +01} {1771120800 0 1 +01} {1774144800 3600 0 +01} {1801965600 0 1 +01} {1804989600 3600 0 +01} {1832205600 0 1 +01} {1835229600 3600 0 +01} {1863050400 0 1 +01} {1866074400 3600 0 +01} {1893290400 0 1 +01} {1896919200 3600 0 +01} {1924135200 0 1 +01} {1927159200 3600 0 +01} {1954980000 0 1 +01} {1958004000 3600 0 +01} {1985220000 0 1 +01} {1988848800 3600 0 +01} {2016064800 0 1 +01} {2019088800 3600 0 +01} {2046304800 0 1 +01} {2049933600 3600 0 +01} {2077149600 0 1 +01} {2080173600 3600 0 +01} {2107994400 0 1 +01} {2111018400 3600 0 +01} {2138234400 0 1 +01} {2141863200 3600 0 +01} } 

Changes to library/tzdata/Africa/Sao_Tome.

 1 2 3 4 5 6 7 8  # created by tools/tclZIC.tcl - do not edit set TZData(:Africa/Sao_Tome) { {-9223372036854775808 1616 0 LMT} {-2713912016 -2205 0 LMT} {-1830384000 0 0 GMT} {1514768400 3600 0 WAT} }   >  1 2 3 4 5 6 7 8 9  # created by tools/tclZIC.tcl - do not edit set TZData(:Africa/Sao_Tome) { {-9223372036854775808 1616 0 LMT} {-2713912016 -2205 0 LMT} {-1830384000 0 0 GMT} {1514768400 3600 0 WAT} {1546304400 0 0 GMT} } 

Changes to library/tzdata/America/Metlakatla.

 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57   {436356000 -28800 0 PST} {1446372000 -32400 0 AKST} {1457866800 -28800 1 AKDT} {1478426400 -32400 0 AKST} {1489316400 -28800 1 AKDT} {1509876000 -32400 0 AKST} {1520766000 -28800 1 AKDT} {1541325600 -32400 0 AKST} {1552215600 -28800 1 AKDT} {1572775200 -32400 0 AKST} {1583665200 -28800 1 AKDT} {1604224800 -32400 0 AKST} {1615719600 -28800 1 AKDT} {1636279200 -32400 0 AKST} {1647169200 -28800 1 AKDT} {1667728800 -32400 0 AKST}   | |  42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57   {436356000 -28800 0 PST} {1446372000 -32400 0 AKST} {1457866800 -28800 1 AKDT} {1478426400 -32400 0 AKST} {1489316400 -28800 1 AKDT} {1509876000 -32400 0 AKST} {1520766000 -28800 1 AKDT} {1541329200 -28800 0 PST} {1552215600 -28800 0 AKDT} {1572775200 -32400 0 AKST} {1583665200 -28800 1 AKDT} {1604224800 -32400 0 AKST} {1615719600 -28800 1 AKDT} {1636279200 -32400 0 AKST} {1647169200 -28800 1 AKDT} {1667728800 -32400 0 AKST} 

Changes to library/tzdata/America/Santiago.

 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289   {1410062400 -10800 1 -04} {1463281200 -14400 0 -04} {1471147200 -10800 1 -04} {1494730800 -14400 0 -04} {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} }   | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |  120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289   {1410062400 -10800 1 -04} {1463281200 -14400 0 -04} {1471147200 -10800 1 -04} {1494730800 -14400 0 -04} {1502596800 -10800 1 -04} {1526180400 -14400 0 -04} {1534046400 -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} } 

Changes to library/tzdata/Asia/Hong_Kong.

 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30  # created by tools/tclZIC.tcl - do not edit set TZData(:Asia/Hong_Kong) { {-9223372036854775808 27402 0 LMT} {-2056693002 28800 0 HKT} {-907389000 32400 1 HKST} {-891667800 28800 0 HKT} {-884246400 32400 0 JST} {-766746000 28800 0 HKT} {-747981000 32400 1 HKST} {-728544600 28800 0 HKT} {-717049800 32400 1 HKST} {-694503000 28800 0 HKT} {-683785800 32400 1 HKST} {-668064600 28800 0 HKT} {-654755400 32400 1 HKST} {-636615000 28800 0 HKT} {-623305800 32400 1 HKST} {-605165400 28800 0 HKT} {-591856200 32400 1 HKST} {-573715800 28800 0 HKT} {-559801800 32400 1 HKST} {-542352600 28800 0 HKT} {-528352200 32400 1 HKST} {-510211800 28800 0 HKT} {-498112200 32400 1 HKST} {-478762200 28800 0 HKT} {-466662600 32400 1 HKST} {-446707800 28800 0 HKT} {-435213000 32400 1 HKST}   | | | | | |  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30  # created by tools/tclZIC.tcl - do not edit set TZData(:Asia/Hong_Kong) { {-9223372036854775808 27402 0 LMT} {-2056690800 28800 0 HKT} {-900909000 32400 1 HKST} {-891579600 30600 0 HKT} {-884248200 32400 0 JST} {-766659600 28800 0 HKT} {-747981000 32400 1 HKST} {-728544600 28800 0 HKT} {-717049800 32400 1 HKST} {-694503000 28800 0 HKT} {-683785800 32400 1 HKST} {-668064600 28800 0 HKT} {-654755400 32400 1 HKST} {-636615000 28800 0 HKT} {-623305800 32400 1 HKST} {-605165400 28800 0 HKT} {-591856200 32400 1 HKST} {-573715800 28800 0 HKT} {-559801800 32400 1 HKST} {-541661400 28800 0 HKT} {-528352200 32400 1 HKST} {-510211800 28800 0 HKT} {-498112200 32400 1 HKST} {-478762200 28800 0 HKT} {-466662600 32400 1 HKST} {-446707800 28800 0 HKT} {-435213000 32400 1 HKST} 

Changes to library/tzdata/Asia/Macau.

 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46  # created by tools/tclZIC.tcl - do not edit set TZData(:Asia/Macau) { {-9223372036854775808 27260 0 LMT} {-1830412800 28800 0 CST} {-277360200 32400 1 CDT} {-257405400 28800 0 CST} {-245910600 32400 1 CDT} {-225955800 28800 0 CST} {-214473600 32400 1 CDT} {-194506200 28800 0 CST} {-182406600 32400 1 CDT} {-163056600 28800 0 CST} {-150969600 32400 1 CDT} {-131619600 28800 0 CST} {-117088200 32400 1 CDT} {-101367000 28800 0 CST} {-85638600 32400 1 CDT} {-69312600 28800 0 CST} {-53584200 32400 1 CDT} {-37863000 28800 0 CST} {-22134600 32400 1 CDT} {-6413400 28800 0 CST} {9315000 32400 1 CDT} {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} {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} }   | > > > > > > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > | | | | | | | | | | | < < < < < <  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76  # created by tools/tclZIC.tcl - do not edit set TZData(:Asia/Macau) { {-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} {-213856200 32400 1 CDT} {-194506200 28800 0 CST} {-182406600 32400 1 CDT} {-163056600 28800 0 CST} {-148537800 32400 1 CDT} {-132820200 28800 0 CST} {-117088200 32400 1 CDT} {-101370600 28800 0 CST} {-85638600 32400 1 CDT} {-69312600 28800 0 CST} {-53584200 32400 1 CDT} {-37863000 28800 0 CST} {-22134600 32400 1 CDT} {-6413400 28800 0 CST} {9315000 32400 1 CDT} {25036200 28800 0 CST} {40764600 32400 1 CDT} {56485800 28800 0 CST} {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} {295385400 32400 1 CDT} {309292200 28800 0 CST} } 

Changes to library/tzdata/Asia/Manila.

 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15  # created by tools/tclZIC.tcl - do not edit 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} }   | | | | | | | | |  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15  # created by tools/tclZIC.tcl - do not edit set TZData(:Asia/Manila) { {-9223372036854775808 -57360 0 LMT} {-3944621040 29040 0 LMT} {-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} } 

Changes to library/tzdata/Asia/Pyongyang.

 2 3 4 5 6 7 8 9 10   set TZData(:Asia/Pyongyang) { {-9223372036854775808 30180 0 LMT} {-1948782180 30600 0 KST} {-1830414600 32400 0 JST} {-768646800 32400 0 KST} {1439564400 30600 0 KST} {1525447800 32400 0 KST} }   |  2 3 4 5 6 7 8 9 10   set TZData(:Asia/Pyongyang) { {-9223372036854775808 30180 0 LMT} {-1948782180 30600 0 KST} {-1830414600 32400 0 JST} {-768646800 32400 0 KST} {1439564400 30600 0 KST} {1525446000 32400 0 KST} } 

     > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > >  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58  # created by tools/tclZIC.tcl - do not edit set TZData(:Asia/Qostanay) { {-9223372036854775808 15268 0 LMT} {-1441167268 14400 0 +04} {-1247544000 18000 0 +05} {354913200 21600 1 +06} {370720800 21600 0 +06} {386445600 18000 0 +05} {386449200 21600 1 +05} {402256800 18000 0 +05} {417985200 21600 1 +05} {433792800 18000 0 +05} {449607600 21600 1 +05} {465339600 18000 0 +05} {481064400 21600 1 +05} {496789200 18000 0 +05} {512514000 21600 1 +05} {528238800 18000 0 +05} {543963600 21600 1 +05} {559688400 18000 0 +05} {575413200 21600 1 +05} {591138000 18000 0 +05} {606862800 21600 1 +05} {622587600 18000 0 +05} {638312400 21600 1 +05} {654642000 18000 0 +05} {670366800 14400 0 +04} {670370400 18000 1 +04} {686095200 14400 0 +04} {695772000 18000 0 +05} {701816400 21600 1 +05} {717541200 18000 0 +05} {733266000 21600 1 +05} {748990800 18000 0 +05} {764715600 21600 1 +05} {780440400 18000 0 +05} {796165200 21600 1 +05} {811890000 18000 0 +05} {828219600 21600 1 +05} {846363600 18000 0 +05} {859669200 21600 1 +05} {877813200 18000 0 +05} {891118800 21600 1 +05} {909262800 18000 0 +05} {922568400 21600 1 +05} {941317200 18000 0 +05} {954018000 21600 1 +05} {972766800 18000 0 +05} {985467600 21600 1 +05} {1004216400 18000 0 +05} {1017522000 21600 1 +05} {1035666000 18000 0 +05} {1048971600 21600 1 +05} {1067115600 18000 0 +05} {1080421200 21600 1 +05} {1099170000 21600 0 +06} } 

Changes to library/tzdata/Asia/Qyzylorda.

 50 51 52 53 54 55 56 57   {1004216400 18000 0 +05} {1017522000 21600 1 +05} {1035666000 18000 0 +05} {1048971600 21600 1 +05} {1067115600 18000 0 +05} {1080421200 21600 1 +05} {1099170000 21600 0 +06} }   >  50 51 52 53 54 55 56 57 58   {1004216400 18000 0 +05} {1017522000 21600 1 +05} {1035666000 18000 0 +05} {1048971600 21600 1 +05} {1067115600 18000 0 +05} {1080421200 21600 1 +05} {1099170000 21600 0 +06} {1545328800 18000 0 +05} } 

Changes to library/tzdata/Asia/Shanghai.

 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23  # created by tools/tclZIC.tcl - do not edit 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} }   | | | | > | | | | | | > > > > | | | | > > | > > | |  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32  # created by tools/tclZIC.tcl - do not edit set TZData(:Asia/Shanghai) { {-9223372036854775808 29143 0 LMT} {-2177481943 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} } 

Changes to library/tzdata/Asia/Tehran.

 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211   {2042479800 12600 0 +0330} {2058121800 16200 1 +0330} {2074015800 12600 0 +0330} {2089657800 16200 1 +0330} {2105551800 12600 0 +0330} {2121193800 16200 1 +0330} {2137087800 12600 0 +0330} {2152729800 16200 1 +0330} {2168623800 12600 0 +0330} {2184265800 16200 1 +0330} {2200159800 12600 0 +0330} {2215888200 16200 1 +0330} {2231782200 12600 0 +0330} {2247424200 16200 1 +0330} {2263318200 12600 0 +0330} {2278960200 16200 1 +0330} {2294854200 12600 0 +0330} {2310496200 16200 1 +0330} {2326390200 12600 0 +0330} {2342118600 16200 1 +0330} {2358012600 12600 0 +0330} {2373654600 16200 1 +0330} {2389548600 12600 0 +0330} {2405190600 16200 1 +0330} {2421084600 12600 0 +0330} {2436726600 16200 1 +0330} {2452620600 12600 0 +0330} {2468349000 16200 1 +0330} {2484243000 12600 0 +0330} {2499885000 16200 1 +0330} {2515779000 12600 0 +0330} {2531421000 16200 1 +0330} {2547315000 12600 0 +0330} {2562957000 16200 1 +0330} {2578851000 12600 0 +0330} {2594579400 16200 1 +0330} {2610473400 12600 0 +0330} {2626115400 16200 1 +0330} {2642009400 12600 0 +0330} {2657651400 16200 1 +0330} {2673545400 12600 0 +0330} {2689187400 16200 1 +0330} {2705081400 12600 0 +0330} {2720809800 16200 1 +0330} {2736703800 12600 0 +0330} {2752345800 16200 1 +0330} {2768239800 12600 0 +0330} {2783881800 16200 1 +0330} {2799775800 12600 0 +0330} {2815417800 16200 1 +0330} {2831311800 12600 0 +0330} {2847040200 16200 1 +0330} {2862934200 12600 0 +0330} {2878576200 16200 1 +0330} {2894470200 12600 0 +0330} {2910112200 16200 1 +0330} {2926006200 12600 0 +0330} {2941648200 16200 1 +0330} {2957542200 12600 0 +0330} {2973270600 16200 1 +0330} {2989164600 12600 0 +0330} {3004806600 16200 1 +0330} {3020700600 12600 0 +0330} {3036342600 16200 1 +0330} {3052236600 12600 0 +0330} {3067878600 16200 1 +0330} {3083772600 12600 0 +0330} {3099501000 16200 1 +0330} {3115395000 12600 0 +0330} {3131037000 16200 1 +0330} {3146931000 12600 0 +0330} {3162573000 16200 1 +0330} {3178467000 12600 0 +0330} {3194109000 16200 1 +0330} {3210003000 12600 0 +0330} {3225731400 16200 1 +0330} {3241625400 12600 0 +0330} {3257267400 16200 1 +0330} {3273161400 12600 0 +0330} {3288803400 16200 1 +0330} {3304697400 12600 0 +0330} {3320339400 16200 1 +0330} {3336233400 12600 0 +0330} {3351961800 16200 1 +0330} {3367855800 12600 0 +0330} {3383497800 16200 1 +0330} {3399391800 12600 0 +0330} {3415033800 16200 1 +0330} {3430927800 12600 0 +0330} {3446569800 16200 1 +0330} {3462463800 12600 0 +0330} {3478192200 16200 1 +0330} {3494086200 12600 0 +0330} {3509728200 16200 1 +0330} {3525622200 12600 0 +0330} {3541264200 16200 1 +0330} {3557158200 12600 0 +0330} {3572800200 16200 1 +0330} {3588694200 12600 0 +0330} {3604422600 16200 1 +0330} {3620316600 12600 0 +0330} {3635958600 16200 1 +0330} {3651852600 12600 0 +0330} {3667494600 16200 1 +0330} {3683388600 12600 0 +0330} {3699030600 16200 1 +0330} {3714924600 12600 0 +0330} {3730653000 16200 1 +0330} {3746547000 12600 0 +0330} {3762189000 16200 1 +0330} {3778083000 12600 0 +0330} {3793725000 16200 1 +0330} {3809619000 12600 0 +0330} {3825261000 16200 1 +0330}   | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |  98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211   {2042479800 12600 0 +0330} {2058121800 16200 1 +0330} {2074015800 12600 0 +0330} {2089657800 16200 1 +0330} {2105551800 12600 0 +0330} {2121193800 16200 1 +0330} {2137087800 12600 0 +0330} {2152816200 16200 1 +0330} {2168710200 12600 0 +0330} {2184352200 16200 1 +0330} {2200246200 12600 0 +0330} {2215888200 16200 1 +0330} {2231782200 12600 0 +0330} {2247424200 16200 1 +0330} {2263318200 12600 0 +0330} {2279046600 16200 1 +0330} {2294940600 12600 0 +0330} {2310582600 16200 1 +0330} {2326476600 12600 0 +0330} {2342118600 16200 1 +0330} {2358012600 12600 0 +0330} {2373654600 16200 1 +0330} {2389548600 12600 0 +0330} {2405277000 16200 1 +0330} {2421171000 12600 0 +0330} {2436813000 16200 1 +0330} {2452707000 12600 0 +0330} {2468349000 16200 1 +0330} {2484243000 12600 0 +0330} {2499885000 16200 1 +0330} {2515779000 12600 0 +0330} {2531507400 16200 1 +0330} {2547401400 12600 0 +0330} {2563043400 16200 1 +0330} {2578937400 12600 0 +0330} {2594579400 16200 1 +0330} {2610473400 12600 0 +0330} {2626115400 16200 1 +0330} {2642009400 12600 0 +0330} {2657737800 16200 1 +0330} {2673631800 12600 0 +0330} {2689273800 16200 1 +0330} {2705167800 12600 0 +0330} {2720809800 16200 1 +0330} {2736703800 12600 0 +0330} {2752345800 16200 1 +0330} {2768239800 12600 0 +0330} {2783968200 16200 1 +0330} {2799862200 12600 0 +0330} {2815504200 16200 1 +0330} {2831398200 12600 0 +0330} {2847040200 16200 1 +0330} {2862934200 12600 0 +0330} {2878576200 16200 1 +0330} {2894470200 12600 0 +0330} {2910112200 16200 1 +0330} {2926006200 12600 0 +0330} {2941734600 16200 1 +0330} {2957628600 12600 0 +0330} {2973270600 16200 1 +0330} {2989164600 12600 0 +0330} {3004806600 16200 1 +0330} {3020700600 12600 0 +0330} {3036342600 16200 1 +0330} {3052236600 12600 0 +0330} {3067965000 16200 1 +0330} {3083859000 12600 0 +0330} {3099501000 16200 1 +0330} {3115395000 12600 0 +0330} {3131037000 16200 1 +0330} {3146931000 12600 0 +0330} {3162573000 16200 1 +0330} {3178467000 12600 0 +0330} {3194195400 16200 1 +0330} {3210089400 12600 0 +0330} {3225731400 16200 1 +0330} {3241625400 12600 0 +0330} {3257267400 16200 1 +0330} {3273161400 12600 0 +0330} {3288803400 16200 1 +0330} {3304697400 12600 0 +0330} {3320425800 16200 1 +0330} {3336319800 12600 0 +0330} {3351961800 16200 1 +0330} {3367855800 12600 0 +0330} {3383497800 16200 1 +0330} {3399391800 12600 0 +0330} {3415033800 16200 1 +0330} {3430927800 12600 0 +0330} {3446656200 16200 1 +0330} {3462550200 12600 0 +0330} {3478192200 16200 1 +0330} {3494086200 12600 0 +0330} {3509728200 16200 1 +0330} {3525622200 12600 0 +0330} {3541264200 16200 1 +0330} {3557158200 12600 0 +0330} {3572886600 16200 1 +0330} {3588780600 12600 0 +0330} {3604422600 16200 1 +0330} {3620316600 12600 0 +0330} {3635958600 16200 1 +0330} {3651852600 12600 0 +0330} {3667494600 16200 1 +0330} {3683388600 12600 0 +0330} {3699117000 16200 1 +0330} {3715011000 12600 0 +0330} {3730653000 16200 1 +0330} {3746547000 12600 0 +0330} {3762189000 16200 1 +0330} {3778083000 12600 0 +0330} {3793725000 16200 1 +0330} {3809619000 12600 0 +0330} {3825261000 16200 1 +0330} 

Changes to library/tzdata/Asia/Tokyo.

 1 2 3 4 5 6 7 8 9 10 11 12 13 14  # created by tools/tclZIC.tcl - do not edit set TZData(:Asia/Tokyo) { {-9223372036854775808 33539 0 LMT} {-2587712400 32400 0 JST} {-683802000 36000 1 JDT} {-672314400 32400 0 JST} {-654771600 36000 1 JDT} {-640864800 32400 0 JST} {-620298000 36000 1 JDT} {-609415200 32400 0 JST} {-588848400 36000 1 JDT} {-577965600 32400 0 JST} }   | | | |  1 2 3 4 5 6 7 8 9 10 11 12 13 14  # created by tools/tclZIC.tcl - do not edit set TZData(:Asia/Tokyo) { {-9223372036854775808 33539 0 LMT} {-2587712400 32400 0 JST} {-683802000 36000 1 JDT} {-672310800 32400 0 JST} {-654771600 36000 1 JDT} {-640861200 32400 0 JST} {-620298000 36000 1 JDT} {-609411600 32400 0 JST} {-588848400 36000 1 JDT} {-577962000 32400 0 JST} } 

 64 65 66 67 68 69 70 71   {1224975600 10800 0 +03} {1238281200 14400 1 +04} {1256425200 10800 0 +03} {1269730800 14400 1 +04} {1288479600 10800 0 +03} {1301180400 14400 0 +04} {1414274400 10800 0 +03} }   >  64 65 66 67 68 69 70 71 72   {1224975600 10800 0 +03} {1238281200 14400 1 +04} {1256425200 10800 0 +03} {1269730800 14400 1 +04} {1288479600 10800 0 +03} {1301180400 14400 0 +04} {1414274400 10800 0 +03} {1540681200 14400 0 +04} } 

Changes to library/tzdata/Pacific/Chuuk.

 1 2 3 4 5 6  # created by tools/tclZIC.tcl - do not edit set TZData(:Pacific/Chuuk) { {-9223372036854775808 36428 0 LMT} {-2177489228 36000 0 +10} }   | > > > > >  1 2 3 4 5 6 7 8 9 10 11  # created by tools/tclZIC.tcl - do not edit set TZData(:Pacific/Chuuk) { {-9223372036854775808 -49972 0 LMT} {-3944628428 36428 0 LMT} {-2177489228 36000 0 +10} {-1743674400 32400 0 +09} {-1606813200 36000 0 +10} {-907408800 32400 0 +09} {-770634000 36000 0 +10} } 

Changes to library/tzdata/Pacific/Easter.

 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268   {1410062400 -18000 1 -06} {1463281200 -21600 0 -06} {1471147200 -18000 1 -06} {1494730800 -21600 0 -06} {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} }   | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |  99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268   {1410062400 -18000 1 -06} {1463281200 -21600 0 -06} {1471147200 -18000 1 -06} {1494730800 -21600 0 -06} {1502596800 -18000 1 -06} {1526180400 -21600 0 -06} {1534046400 -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} } 

Changes to library/tzdata/Pacific/Fiji.

 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 .. 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 ... 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 ... 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191   {1446300000 46800 1 +12} {1452952800 43200 0 +12} {1478354400 46800 1 +12} {1484402400 43200 0 +12} {1509804000 46800 1 +12} {1515852000 43200 0 +12} {1541253600 46800 1 +12} {1547906400 43200 0 +12} {1572703200 46800 1 +12} {1579356000 43200 0 +12} {1604152800 46800 1 +12} {1610805600 43200 0 +12} {1636207200 46800 1 +12} {1642255200 43200 0 +12} {1667656800 46800 1 +12} ................................................................................ {1793455200 46800 1 +12} {1800108000 43200 0 +12} {1825509600 46800 1 +12} {1831557600 43200 0 +12} {1856959200 46800 1 +12} {1863007200 43200 0 +12} {1888408800 46800 1 +12} {1895061600 43200 0 +12} {1919858400 46800 1 +12} {1926511200 43200 0 +12} {1951308000 46800 1 +12} {1957960800 43200 0 +12} {1983362400 46800 1 +12} {1989410400 43200 0 +12} {2014812000 46800 1 +12} {2020860000 43200 0 +12} {2046261600 46800 1 +12} {2052309600 43200 0 +12} {2077711200 46800 1 +12} {2084364000 43200 0 +12} {2109160800 46800 1 +12} {2115813600 43200 0 +12} {2140610400 46800 1 +12} {2147263200 43200 0 +12} {2172664800 46800 1 +12} {2178712800 43200 0 +12} {2204114400 46800 1 +12} {2210162400 43200 0 +12} {2235564000 46800 1 +12} {2242216800 43200 0 +12} {2267013600 46800 1 +12} {2273666400 43200 0 +12} {2298463200 46800 1 +12} {2305116000 43200 0 +12} {2329912800 46800 1 +12} {2336565600 43200 0 +12} {2361967200 46800 1 +12} {2368015200 43200 0 +12} {2393416800 46800 1 +12} {2399464800 43200 0 +12} {2424866400 46800 1 +12} {2431519200 43200 0 +12} {2456316000 46800 1 +12} {2462968800 43200 0 +12} {2487765600 46800 1 +12} {2494418400 43200 0 +12} {2519820000 46800 1 +12} {2525868000 43200 0 +12} {2551269600 46800 1 +12} ................................................................................ {2677068000 46800 1 +12} {2683720800 43200 0 +12} {2709122400 46800 1 +12} {2715170400 43200 0 +12} {2740572000 46800 1 +12} {2746620000 43200 0 +12} {2772021600 46800 1 +12} {2778674400 43200 0 +12} {2803471200 46800 1 +12} {2810124000 43200 0 +12} {2834920800 46800 1 +12} {2841573600 43200 0 +12} {2866975200 46800 1 +12} {2873023200 43200 0 +12} {2898424800 46800 1 +12} {2904472800 43200 0 +12} {2929874400 46800 1 +12} {2935922400 43200 0 +12} {2961324000 46800 1 +12} {2967976800 43200 0 +12} {2992773600 46800 1 +12} {2999426400 43200 0 +12} {3024223200 46800 1 +12} {3030876000 43200 0 +12} {3056277600 46800 1 +12} {3062325600 43200 0 +12} {3087727200 46800 1 +12} {3093775200 43200 0 +12} {3119176800 46800 1 +12} {3125829600 43200 0 +12} {3150626400 46800 1 +12} {3157279200 43200 0 +12} {3182076000 46800 1 +12} {3188728800 43200 0 +12} {3213525600 46800 1 +12} {3220178400 43200 0 +12} {3245580000 46800 1 +12} {3251628000 43200 0 +12} {3277029600 46800 1 +12} {3283077600 43200 0 +12} {3308479200 46800 1 +12} {3315132000 43200 0 +12} {3339928800 46800 1 +12} {3346581600 43200 0 +12} {3371378400 46800 1 +12} {3378031200 43200 0 +12} {3403432800 46800 1 +12} {3409480800 43200 0 +12} {3434882400 46800 1 +12} ................................................................................ {3560680800 46800 1 +12} {3567333600 43200 0 +12} {3592735200 46800 1 +12} {3598783200 43200 0 +12} {3624184800 46800 1 +12} {3630232800 43200 0 +12} {3655634400 46800 1 +12} {3662287200 43200 0 +12} {3687084000 46800 1 +12} {3693736800 43200 0 +12} {3718533600 46800 1 +12} {3725186400 43200 0 +12} {3750588000 46800 1 +12} {3756636000 43200 0 +12} {3782037600 46800 1 +12} {3788085600 43200 0 +12} {3813487200 46800 1 +12} {3819535200 43200 0 +12} {3844936800 46800 1 +12} {3851589600 43200 0 +12} {3876386400 46800 1 +12} {3883039200 43200 0 +12} {3907836000 46800 1 +12} {3914488800 43200 0 +12} {3939890400 46800 1 +12} {3945938400 43200 0 +12} {3971340000 46800 1 +12} {3977388000 43200 0 +12} {4002789600 46800 1 +12} {4009442400 43200 0 +12} {4034239200 46800 1 +12} {4040892000 43200 0 +12} {4065688800 46800 1 +12} {4072341600 43200 0 +12} {4097138400 46800 1 +12} }   | | | | | | | | | | | |  22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 .. 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 ... 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 ... 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191   {1446300000 46800 1 +12} {1452952800 43200 0 +12} {1478354400 46800 1 +12} {1484402400 43200 0 +12} {1509804000 46800 1 +12} {1515852000 43200 0 +12} {1541253600 46800 1 +12} {1547301600 43200 0 +12} {1572703200 46800 1 +12} {1579356000 43200 0 +12} {1604152800 46800 1 +12} {1610805600 43200 0 +12} {1636207200 46800 1 +12} {1642255200 43200 0 +12} {1667656800 46800 1 +12} ................................................................................ {1793455200 46800 1 +12} {1800108000 43200 0 +12} {1825509600 46800 1 +12} {1831557600 43200 0 +12} {1856959200 46800 1 +12} {1863007200 43200 0 +12} {1888408800 46800 1 +12} {1894456800 43200 0 +12} {1919858400 46800 1 +12} {1926511200 43200 0 +12} {1951308000 46800 1 +12} {1957960800 43200 0 +12} {1983362400 46800 1 +12} {1989410400 43200 0 +12} {2014812000 46800 1 +12} {2020860000 43200 0 +12} {2046261600 46800 1 +12} {2052309600 43200 0 +12} {2077711200 46800 1 +12} {2083759200 43200 0 +12} {2109160800 46800 1 +12} {2115813600 43200 0 +12} {2140610400 46800 1 +12} {2147263200 43200 0 +12} {2172664800 46800 1 +12} {2178712800 43200 0 +12} {2204114400 46800 1 +12} {2210162400 43200 0 +12} {2235564000 46800 1 +12} {2241612000 43200 0 +12} {2267013600 46800 1 +12} {2273666400 43200 0 +12} {2298463200 46800 1 +12} {2305116000 43200 0 +12} {2329912800 46800 1 +12} {2336565600 43200 0 +12} {2361967200 46800 1 +12} {2368015200 43200 0 +12} {2393416800 46800 1 +12} {2399464800 43200 0 +12} {2424866400 46800 1 +12} {2430914400 43200 0 +12} {2456316000 46800 1 +12} {2462968800 43200 0 +12} {2487765600 46800 1 +12} {2494418400 43200 0 +12} {2519820000 46800 1 +12} {2525868000 43200 0 +12} {2551269600 46800 1 +12} ................................................................................ {2677068000 46800 1 +12} {2683720800 43200 0 +12} {2709122400 46800 1 +12} {2715170400 43200 0 +12} {2740572000 46800 1 +12} {2746620000 43200 0 +12} {2772021600 46800 1 +12} {2778069600 43200 0 +12} {2803471200 46800 1 +12} {2810124000 43200 0 +12} {2834920800 46800 1 +12} {2841573600 43200 0 +12} {2866975200 46800 1 +12} {2873023200 43200 0 +12} {2898424800 46800 1 +12} {2904472800 43200 0 +12} {2929874400 46800 1 +12} {2935922400 43200 0 +12} {2961324000 46800 1 +12} {2967372000 43200 0 +12} {2992773600 46800 1 +12} {2999426400 43200 0 +12} {3024223200 46800 1 +12} {3030876000 43200 0 +12} {3056277600 46800 1 +12} {3062325600 43200 0 +12} {3087727200 46800 1 +12} {3093775200 43200 0 +12} {3119176800 46800 1 +12} {3125224800 43200 0 +12} {3150626400 46800 1 +12} {3157279200 43200 0 +12} {3182076000 46800 1 +12} {3188728800 43200 0 +12} {3213525600 46800 1 +12} {3220178400 43200 0 +12} {3245580000 46800 1 +12} {3251628000 43200 0 +12} {3277029600 46800 1 +12} {3283077600 43200 0 +12} {3308479200 46800 1 +12} {3314527200 43200 0 +12} {3339928800 46800 1 +12} {3346581600 43200 0 +12} {3371378400 46800 1 +12} {3378031200 43200 0 +12} {3403432800 46800 1 +12} {3409480800 43200 0 +12} {3434882400 46800 1 +12} ................................................................................ {3560680800 46800 1 +12} {3567333600 43200 0 +12} {3592735200 46800 1 +12} {3598783200 43200 0 +12} {3624184800 46800 1 +12} {3630232800 43200 0 +12} {3655634400 46800 1 +12} {3661682400 43200 0 +12} {3687084000 46800 1 +12} {3693736800 43200 0 +12} {3718533600 46800 1 +12} {3725186400 43200 0 +12} {3750588000 46800 1 +12} {3756636000 43200 0 +12} {3782037600 46800 1 +12} {3788085600 43200 0 +12} {3813487200 46800 1 +12} {3819535200 43200 0 +12} {3844936800 46800 1 +12} {3850984800 43200 0 +12} {3876386400 46800 1 +12} {3883039200 43200 0 +12} {3907836000 46800 1 +12} {3914488800 43200 0 +12} {3939890400 46800 1 +12} {3945938400 43200 0 +12} {3971340000 46800 1 +12} {3977388000 43200 0 +12} {4002789600 46800 1 +12} {4008837600 43200 0 +12} {4034239200 46800 1 +12} {4040892000 43200 0 +12} {4065688800 46800 1 +12} {4072341600 43200 0 +12} {4097138400 46800 1 +12} } 

Changes to library/tzdata/Pacific/Guam.

 1 2 3 4 5 6 7 8  # created by tools/tclZIC.tcl - do not edit set TZData(:Pacific/Guam) { {-9223372036854775808 -51660 0 LMT} {-3944626740 34740 0 LMT} {-2177487540 36000 0 GST} {977493600 36000 0 ChST} }   > > > > > > > > > > > > > > > > > >  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26  # created by tools/tclZIC.tcl - do not edit set TZData(:Pacific/Guam) { {-9223372036854775808 -51660 0 LMT} {-3944626740 34740 0 LMT} {-2177487540 36000 0 GST} {-885549600 32400 0 +09} {-802256400 36000 0 GST} {-331891200 39600 1 GDT} {-281610000 36000 0 GST} {-73728000 39600 1 GDT} {-29415540 36000 0 GST} {-16704000 39600 1 GDT} {-10659600 36000 0 GST} {9907200 39600 1 GDT} {21394800 36000 0 GST} {41356800 39600 1 GDT} {52844400 36000 0 GST} {124819200 39600 1 GDT} {130863600 36000 0 GST} {201888000 39600 1 GDT} {209487660 36000 0 GST} {230659200 39600 1 GDT} {241542000 36000 0 GST} {977493600 36000 0 ChST} } 

Changes to library/tzdata/Pacific/Honolulu.

 1 2 3 4 5 6 7 8 9 10 11  # created by tools/tclZIC.tcl - do not edit set TZData(:Pacific/Honolulu) { {-9223372036854775808 -37886 0 LMT} {-2334101314 -37800 0 HST} {-1157283000 -34200 1 HDT} {-1155436200 -37800 0 HST} {-880198200 -34200 1 HDT} {-765376200 -37800 0 HST} {-712150200 -36000 0 HST} }   | > |  1 2 3 4 5 6 7 8 9 10 11 12  # created by tools/tclZIC.tcl - do not edit set TZData(:Pacific/Honolulu) { {-9223372036854775808 -37886 0 LMT} {-2334101314 -37800 0 HST} {-1157283000 -34200 1 HDT} {-1155436200 -34200 0 HST} {-880201800 -34200 1 HWT} {-769395600 -34200 1 HPT} {-765376200 -37800 0 HST} {-712150200 -36000 0 HST} } 

Changes to library/tzdata/Pacific/Kosrae.

 1 2 3 4 5 6 7 8  # created by tools/tclZIC.tcl - do not edit set TZData(:Pacific/Kosrae) { {-9223372036854775808 39116 0 LMT} {-2177491916 39600 0 +11} {-7988400 43200 0 +12} {915105600 39600 0 +11} }   | > > > > > >  1 2 3 4 5 6 7 8 9 10 11 12 13 14  # created by tools/tclZIC.tcl - do not edit set TZData(:Pacific/Kosrae) { {-9223372036854775808 -47284 0 LMT} {-3944631116 39116 0 LMT} {-2177491916 39600 0 +11} {-1743678000 32400 0 +09} {-1606813200 39600 0 +11} {-1041418800 36000 0 +10} {-907408800 32400 0 +09} {-770634000 39600 0 +11} {-7988400 43200 0 +12} {915105600 39600 0 +11} } 

Changes to library/tzdata/Pacific/Kwajalein.

 1 2 3 4 5 6 7 8  # created by tools/tclZIC.tcl - do not edit set TZData(:Pacific/Kwajalein) { {-9223372036854775808 40160 0 LMT} {-2177492960 39600 0 +11} {-7988400 -43200 0 -12} {745848000 43200 0 +12} }   > > > |  1 2 3 4 5 6 7 8 9 10 11  # created by tools/tclZIC.tcl - do not edit set TZData(:Pacific/Kwajalein) { {-9223372036854775808 40160 0 LMT} {-2177492960 39600 0 +11} {-1041418800 36000 0 +10} {-907408800 32400 0 +09} {-817462800 39600 0 +11} {-7988400 -43200 0 -12} {745934400 43200 0 +12} } 

Changes to library/tzdata/Pacific/Majuro.

 1 2 3 4 5 6 7  # created by tools/tclZIC.tcl - do not edit set TZData(:Pacific/Majuro) { {-9223372036854775808 41088 0 LMT} {-2177493888 39600 0 +11} {-7988400 43200 0 +12} }   > > > > >  1 2 3 4 5 6 7 8 9 10 11 12  # created by tools/tclZIC.tcl - do not edit set TZData(:Pacific/Majuro) { {-9223372036854775808 41088 0 LMT} {-2177493888 39600 0 +11} {-1743678000 32400 0 +09} {-1606813200 39600 0 +11} {-1041418800 36000 0 +10} {-907408800 32400 0 +09} {-818067600 39600 0 +11} {-7988400 43200 0 +12} } 

Changes to library/tzdata/Pacific/Nauru.

 1 2 3 4 5 6 7 8 9  # created by tools/tclZIC.tcl - do not edit set TZData(:Pacific/Nauru) { {-9223372036854775808 40060 0 LMT} {-1545131260 41400 0 +1130} {-877347000 32400 0 +09} {-800960400 41400 0 +1130} {294323400 43200 0 +12} }   | | |  1 2 3 4 5 6 7 8 9  # created by tools/tclZIC.tcl - do not edit set TZData(:Pacific/Nauru) { {-9223372036854775808 40060 0 LMT} {-1545131260 41400 0 +1130} {-862918200 32400 0 +09} {-767350800 41400 0 +1130} {287418600 43200 0 +12} } 

Changes to library/tzdata/Pacific/Palau.

 1 2 3 4 5 6  # created by tools/tclZIC.tcl - do not edit set TZData(:Pacific/Palau) { {-9223372036854775808 32276 0 LMT} {-2177485076 32400 0 +09} }   | >  1 2 3 4 5 6 7  # created by tools/tclZIC.tcl - do not edit set TZData(:Pacific/Palau) { {-9223372036854775808 -54124 0 LMT} {-3944624276 32276 0 LMT} {-2177485076 32400 0 +09} } 

Changes to library/tzdata/Pacific/Pohnpei.

 1 2 3 4 5 6  # created by tools/tclZIC.tcl - do not edit set TZData(:Pacific/Pohnpei) { {-9223372036854775808 37972 0 LMT} {-2177490772 39600 0 +11} }   | > > > > > >  1 2 3 4 5 6 7 8 9 10 11 12  # created by tools/tclZIC.tcl - do not edit set TZData(:Pacific/Pohnpei) { {-9223372036854775808 -48428 0 LMT} {-3944629972 37972 0 LMT} {-2177490772 39600 0 +11} {-1743678000 32400 0 +09} {-1606813200 39600 0 +11} {-1041418800 36000 0 +10} {-907408800 32400 0 +09} {-770634000 39600 0 +11} } 

Changes to libtommath/bn_fast_s_mp_mul_digs.c.

 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103   /* setup dest */ olduse = c->used; c->used = pa; { register mp_digit *tmpc; tmpc = c->dp; for (ix = 0; ix < pa+1; ix++) { /* now extract the previous digit [below the carry] */ *tmpc++ = W[ix]; } /* clear unused digits [that existed in the old copy of c] */ for (; ix < olduse; ix++) { *tmpc++ = 0; } } mp_clamp (c); return MP_OKAY; } #endif   |  83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103   /* setup dest */ olduse = c->used; c->used = pa; { register mp_digit *tmpc; tmpc = c->dp; for (ix = 0; ix < pa; ix++) { /* now extract the previous digit [below the carry] */ *tmpc++ = W[ix]; } /* clear unused digits [that existed in the old copy of c] */ for (; ix < olduse; ix++) { *tmpc++ = 0; } } mp_clamp (c); return MP_OKAY; } #endif 

Changes to macosx/GNUmakefile.

 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191  endif endif ifeq (${BUILD_STYLE}_${EMBEDDED_BUILD},Development_) # keep copy of debug library around, so that # Deployment build can be installed on top # of Development build without overwriting # the debug library @cd "${INSTALL_ROOT}${LIBDIR}/${PRODUCT_NAME}.framework/Versions/${VERSION}" && \ ln -f "${PRODUCT_NAME}" "${PRODUCT_NAME}_debug" endif clean-${PROJECT}: %-${PROJECT}: ${DO_MAKE} rm -rf "${SYMROOT}"/{${PRODUCT_NAME}.framework,${TCLSH},tcltest} rm -f "${OBJ_DIR}"{"${LIBDIR}","${BINDIR}"} && \ rmdir -p "${OBJ_DIR}"$(dir$(subst ${space},\ ,${LIBDIR})) 2>&- || true && \   > | | >  176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193  endif endif ifeq (${BUILD_STYLE}_${EMBEDDED_BUILD},Development_) # keep copy of debug library around, so that # Deployment build can be installed on top # of Development build without overwriting # the debug library @if [ -d "${INSTALL_ROOT}${LIBDIR}/${PRODUCT_NAME}.framework/Versions/${VERSION}" ]; then \ cd "${INSTALL_ROOT}${LIBDIR}/${PRODUCT_NAME}.framework/Versions/${VERSION}"; \ ln -f "${PRODUCT_NAME}" "${PRODUCT_NAME}_debug"; \ fi endif clean-${PROJECT}: %-${PROJECT}: ${DO_MAKE} rm -rf "${SYMROOT}"/{${PRODUCT_NAME}.framework,${TCLSH},tcltest} rm -f "${OBJ_DIR}"{"${LIBDIR}","${BINDIR}"} && \ rmdir -p "${OBJ_DIR}"$(dir$(subst ${space},\ ,${LIBDIR})) 2>&- || true && \ 

Changes to macosx/Tcl.xcode/project.pbxproj.

 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 .... 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800   F96D449208F272BA004A47F5 /* tclWinPipe.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinPipe.c; sourceTree = ""; }; F96D449308F272BA004A47F5 /* tclWinPort.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclWinPort.h; sourceTree = ""; }; F96D449408F272BA004A47F5 /* tclWinReg.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinReg.c; sourceTree = ""; }; F96D449508F272BA004A47F5 /* tclWinSerial.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinSerial.c; sourceTree = ""; }; F96D449608F272BA004A47F5 /* tclWinSock.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinSock.c; sourceTree = ""; }; F96D449708F272BA004A47F5 /* tclWinTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinTest.c; sourceTree = ""; }; F96D449808F272BA004A47F5 /* tclWinThrd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinThrd.c; sourceTree = ""; }; F96D449908F272BA004A47F5 /* tclWinThrd.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclWinThrd.h; sourceTree = ""; }; F96D449A08F272BA004A47F5 /* tclWinTime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinTime.c; sourceTree = ""; }; F974D56C0FBE7D6300BF728B /* http11.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http11.test; sourceTree = ""; }; F974D56D0FBE7D6300BF728B /* httpd11.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = httpd11.tcl; sourceTree = ""; }; F974D5720FBE7DC600BF728B /* coroutine.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = coroutine.n; sourceTree = ""; }; F974D5760FBE7E1900BF728B /* tailcall.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tailcall.n; sourceTree = ""; }; F974D5770FBE7E6100BF728B /* coroutine.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = coroutine.test; sourceTree = ""; }; F974D5780FBE7E6100BF728B /* tailcall.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tailcall.test; sourceTree = ""; }; ................................................................................ F96D449208F272BA004A47F5 /* tclWinPipe.c */, F96D449308F272BA004A47F5 /* tclWinPort.h */, F96D449408F272BA004A47F5 /* tclWinReg.c */, F96D449508F272BA004A47F5 /* tclWinSerial.c */, F96D449608F272BA004A47F5 /* tclWinSock.c */, F96D449708F272BA004A47F5 /* tclWinTest.c */, F96D449808F272BA004A47F5 /* tclWinThrd.c */, F96D449908F272BA004A47F5 /* tclWinThrd.h */, F96D449A08F272BA004A47F5 /* tclWinTime.c */, ); path = win; sourceTree = ""; }; F9ECB1110B26521500A28025 /* platform */ = { isa = PBXGroup;   < <  865 866 867 868 869 870 871 872 873 874 875 876 877 878 .... 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798   F96D449208F272BA004A47F5 /* tclWinPipe.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinPipe.c; sourceTree = ""; }; F96D449308F272BA004A47F5 /* tclWinPort.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclWinPort.h; sourceTree = ""; }; F96D449408F272BA004A47F5 /* tclWinReg.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinReg.c; sourceTree = ""; }; F96D449508F272BA004A47F5 /* tclWinSerial.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinSerial.c; sourceTree = ""; }; F96D449608F272BA004A47F5 /* tclWinSock.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinSock.c; sourceTree = ""; }; F96D449708F272BA004A47F5 /* tclWinTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinTest.c; sourceTree = ""; }; F96D449808F272BA004A47F5 /* tclWinThrd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinThrd.c; sourceTree = ""; }; F96D449A08F272BA004A47F5 /* tclWinTime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinTime.c; sourceTree = ""; }; F974D56C0FBE7D6300BF728B /* http11.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http11.test; sourceTree = ""; }; F974D56D0FBE7D6300BF728B /* httpd11.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = httpd11.tcl; sourceTree = ""; }; F974D5720FBE7DC600BF728B /* coroutine.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = coroutine.n; sourceTree = ""; }; F974D5760FBE7E1900BF728B /* tailcall.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tailcall.n; sourceTree = ""; }; F974D5770FBE7E6100BF728B /* coroutine.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = coroutine.test; sourceTree = ""; }; F974D5780FBE7E6100BF728B /* tailcall.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tailcall.test; sourceTree = ""; }; ................................................................................ F96D449208F272BA004A47F5 /* tclWinPipe.c */, F96D449308F272BA004A47F5 /* tclWinPort.h */, F96D449408F272BA004A47F5 /* tclWinReg.c */, F96D449508F272BA004A47F5 /* tclWinSerial.c */, F96D449608F272BA004A47F5 /* tclWinSock.c */, F96D449708F272BA004A47F5 /* tclWinTest.c */, F96D449808F272BA004A47F5 /* tclWinThrd.c */, F96D449A08F272BA004A47F5 /* tclWinTime.c */, ); path = win; sourceTree = ""; }; F9ECB1110B26521500A28025 /* platform */ = { isa = PBXGroup; 

Changes to macosx/Tcl.xcodeproj/project.pbxproj.

 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 .... 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800   F96D449208F272BA004A47F5 /* tclWinPipe.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinPipe.c; sourceTree = ""; }; F96D449308F272BA004A47F5 /* tclWinPort.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclWinPort.h; sourceTree = ""; }; F96D449408F272BA004A47F5 /* tclWinReg.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinReg.c; sourceTree = ""; }; F96D449508F272BA004A47F5 /* tclWinSerial.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinSerial.c; sourceTree = ""; }; F96D449608F272BA004A47F5 /* tclWinSock.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinSock.c; sourceTree = ""; }; F96D449708F272BA004A47F5 /* tclWinTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinTest.c; sourceTree = ""; }; F96D449808F272BA004A47F5 /* tclWinThrd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinThrd.c; sourceTree = ""; }; F96D449908F272BA004A47F5 /* tclWinThrd.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclWinThrd.h; sourceTree = ""; }; F96D449A08F272BA004A47F5 /* tclWinTime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinTime.c; sourceTree = ""; }; F974D56C0FBE7D6300BF728B /* http11.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http11.test; sourceTree = ""; }; F974D56D0FBE7D6300BF728B /* httpd11.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = httpd11.tcl; sourceTree = ""; }; F974D5720FBE7DC600BF728B /* coroutine.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = coroutine.n; sourceTree = ""; }; F974D5760FBE7E1900BF728B /* tailcall.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tailcall.n; sourceTree = ""; }; F974D5770FBE7E6100BF728B /* coroutine.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = coroutine.test; sourceTree = ""; }; F974D5780FBE7E6100BF728B /* tailcall.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tailcall.test; sourceTree = ""; }; ................................................................................ F96D449208F272BA004A47F5 /* tclWinPipe.c */, F96D449308F272BA004A47F5 /* tclWinPort.h */, F96D449408F272BA004A47F5 /* tclWinReg.c */, F96D449508F272BA004A47F5 /* tclWinSerial.c */, F96D449608F272BA004A47F5 /* tclWinSock.c */, F96D449708F272BA004A47F5 /* tclWinTest.c */, F96D449808F272BA004A47F5 /* tclWinThrd.c */, F96D449908F272BA004A47F5 /* tclWinThrd.h */, F96D449A08F272BA004A47F5 /* tclWinTime.c */, ); path = win; sourceTree = ""; }; F9ECB1110B26521500A28025 /* platform */ = { isa = PBXGroup;   < <  865 866 867 868 869 870 871 872 873 874 875 876 877 878 .... 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798   F96D449208F272BA004A47F5 /* tclWinPipe.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinPipe.c; sourceTree = ""; }; F96D449308F272BA004A47F5 /* tclWinPort.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclWinPort.h; sourceTree = ""; }; F96D449408F272BA004A47F5 /* tclWinReg.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinReg.c; sourceTree = ""; }; F96D449508F272BA004A47F5 /* tclWinSerial.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinSerial.c; sourceTree = ""; }; F96D449608F272BA004A47F5 /* tclWinSock.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinSock.c; sourceTree = ""; }; F96D449708F272BA004A47F5 /* tclWinTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinTest.c; sourceTree = ""; }; F96D449808F272BA004A47F5 /* tclWinThrd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinThrd.c; sourceTree = ""; }; F96D449A08F272BA004A47F5 /* tclWinTime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinTime.c; sourceTree = ""; }; F974D56C0FBE7D6300BF728B /* http11.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http11.test; sourceTree = ""; }; F974D56D0FBE7D6300BF728B /* httpd11.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = httpd11.tcl; sourceTree = ""; }; F974D5720FBE7DC600BF728B /* coroutine.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = coroutine.n; sourceTree = ""; }; F974D5760FBE7E1900BF728B /* tailcall.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tailcall.n; sourceTree = ""; }; F974D5770FBE7E6100BF728B /* coroutine.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = coroutine.test; sourceTree = ""; }; F974D5780FBE7E6100BF728B /* tailcall.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tailcall.test; sourceTree = ""; }; ................................................................................ F96D449208F272BA004A47F5 /* tclWinPipe.c */, F96D449308F272BA004A47F5 /* tclWinPort.h */, F96D449408F272BA004A47F5 /* tclWinReg.c */, F96D449508F272BA004A47F5 /* tclWinSerial.c */, F96D449608F272BA004A47F5 /* tclWinSock.c */, F96D449708F272BA004A47F5 /* tclWinTest.c */, F96D449808F272BA004A47F5 /* tclWinThrd.c */, F96D449A08F272BA004A47F5 /* tclWinTime.c */, ); path = win; sourceTree = ""; }; F9ECB1110B26521500A28025 /* platform */ = { isa = PBXGroup; 

Changes to tests/all.tcl.

 18 19 20 21 22 23 24 25 26  configure {*}$argv -testdir [file dirname [file dirname [file normalize [ info script]/...]]] if {[singleProcess]} { interp debug {} -frame 1 } runAllTests proc exit args {}   > > |  18 19 20 21 22 23 24 25 26 27 28  configure {*}$argv -testdir [file dirname [file dirname [file normalize [ info script]/...]]] if {[singleProcess]} { interp debug {} -frame 1 } set ErrorOnFailures [info exists env(ERROR_ON_FAILURES)] unset -nocomplain env(ERROR_ON_FAILURES) if {[runAllTests] && $ErrorOnFailures} {exit 1} proc exit args {}  Changes to tests/basic.test.  957 958 959 960 961 962 963 964 965 966 967 968 969 970   lappend res$t lappend res [catch { run { {*}{error Hejsan} } } err] lappend res $err } -cleanup { unset res t } -result {0 10 1 Hejsan} } ;# End of noComp loop test basic-49.1 {Tcl_EvalEx: verify TCL_EVAL_GLOBAL operation} testevalex { set ::x global namespace eval ns { variable x namespace   > > > > > >  957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976   lappend res$t lappend res [catch { run { {*}{error Hejsan} } } err] lappend res $err } -cleanup { unset res t } -result {0 10 1 Hejsan} test basic-48.24.$noComp {expansion: empty not canonical list, regression test, bug [cc1e91552c]} -constraints $constraints -setup { unset -nocomplain a } -body { run {list [list {*}{ }] [list {*}[format %c 32]] [list {*}[set a { }]]} } -result [lrepeat 3 {}] -cleanup {unset -nocomplain a} } ;# End of noComp loop test basic-49.1 {Tcl_EvalEx: verify TCL_EVAL_GLOBAL operation} testevalex { set ::x global namespace eval ns { variable x namespace  Changes to tests/binary.test.  2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720  } -returnCodes error -match glob -result {invalid base64 character *} test binary-73.30 {binary decode base64} -body { list [string length [set r [binary decode base64 -strict WFla\n]]]$r } -returnCodes error -match glob -result {invalid base64 character *} test binary-73.31 {binary decode base64} -body { list [string length [set r [binary decode base64 WA==WFla]]] $r } -returnCodes error -match glob -result {invalid base64 character *} test binary-74.1 {binary encode uuencode} -body { binary encode uuencode } -returnCodes error -match glob -result "wrong # args: *" test binary-74.2 {binary encode uuencode} -body { binary encode uuencode abc } -result {#86)C   > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > >  2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760  } -returnCodes error -match glob -result {invalid base64 character *} test binary-73.30 {binary decode base64} -body { list [string length [set r [binary decode base64 -strict WFla\n]]]$r } -returnCodes error -match glob -result {invalid base64 character *} test binary-73.31 {binary decode base64} -body { list [string length [set r [binary decode base64 WA==WFla]]] $r } -returnCodes error -match glob -result {invalid base64 character *} test binary-73.32 {binary decode base64, bug [00d04c4f12]} -body { list \ [string length [binary decode base64 =]] \ [string length [binary decode base64 " ="]] \ [string length [binary decode base64 " ="]] \ [string length [binary decode base64 "\r\n\t="]] \ } -result [lrepeat 4 0] test binary-73.33 {binary decode base64, bug [00d04c4f12]} -body { list \ [string length [binary decode base64 ==]] \ [string length [binary decode base64 " =="]] \ [string length [binary decode base64 " =="]] \ [string length [binary decode base64 " =="]] \ } -result [lrepeat 4 0] test binary-73.34 {binary decode base64, (compatibility) unfulfilled base64 (single char) in non-strict mode} -body { list \ [expr {[binary decode base64 a] eq [binary decode base64 ""]}] \ [expr {[binary decode base64 abcda] eq [binary decode base64 "abcd"]}] } -result [lrepeat 2 1] test binary-73.35 {binary decode base64, bad base64 in strict mode} -body { set r {} foreach c {a " a" " a" " a" " a" abcda abcdabcda a= a== abcda= abcda==} { lappend r \ [catch {binary decode base64$c}] \ [catch {binary decode base64 -strict $c}] } set r } -result [lrepeat 11 0 1] test binary-73.36 {binary decode base64: check encoded & decoded equals original} -body { set r {} for {set i 0} {$i < 255 && [llength $r] < 20} {incr i} { foreach c {1 2 3 4 5 6 7 8} { set c [string repeat [format %c$i] $c] if {[set a [binary decode base64 [set x [binary encode base64$c]]]] ne $c} { lappend r "encode & decode is wrong on string $c (encoded: $x): $a != $c" } } } join$r \n } -result {} test binary-74.1 {binary encode uuencode} -body { binary encode uuencode } -returnCodes error -match glob -result "wrong # args: *" test binary-74.2 {binary encode uuencode} -body { binary encode uuencode abc } -result {#86)C 

Changes to tests/chanio.test.

 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 .... 7442 7443 7444 7445 7446 7447 7448 7449 7450 7451 7452 7453 7454 7455   variable f variable i variable n variable v variable msg variable expected loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] package require tcltests testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testchannel [llength [info commands testchannel]] testConstraint openpipe 1 testConstraint testfevent [llength [info commands testfevent]] testConstraint testchannelevent [llength [info commands testchannelevent]] ................................................................................ chan close $f string equal$result [testmainthread] } {1} test chan-io-60.1 {writing illegal utf sequences} {openpipe fileevent testbytestring} { # This test will hang in older revisions of the core. set out [open $path(script) w] chan puts$out { chan puts [testbytestring \xe2] exit 1 } proc readit {pipe} { variable x variable result   > | | > > >  26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 .... 7445 7446 7447 7448 7449 7450 7451 7452 7453 7454 7455 7456 7457 7458 7459   variable f variable i variable n variable v variable msg variable expected catch { ::tcltest::loadTestedCommands package require -exact Tcltest [info patchlevel] set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1] } package require tcltests testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testchannel [llength [info commands testchannel]] testConstraint openpipe 1 testConstraint testfevent [llength [info commands testfevent]] testConstraint testchannelevent [llength [info commands testchannelevent]] ................................................................................ chan close $f string equal$result [testmainthread] } {1} test chan-io-60.1 {writing illegal utf sequences} {openpipe fileevent testbytestring} { # This test will hang in older revisions of the core. set out [open $path(script) w] chan puts$out "catch {load $::tcltestlib Tcltest}" chan puts$out { chan puts [testbytestring \xe2] exit 1 } proc readit {pipe} { variable x variable result 

Changes to tests/clock.test.

 265 266 267 268 269 270 271 272 273 274 275 276 277 278 ..... 35726 35727 35728 35729 35730 35731 35732 35733 35734 35735 35736 35737 35738 35739 35740 35741 35742 35743 35744 35745 35746 35747 35748 35749 35750 35751 35752 35753 35754 35755 35756 35757 35758 35759 35760 35761 35762 35763 35764 35765 35766 35767 35768 35769 35770 35771 35772 35773 35774 35775 35776 35777 35778 35779 35780 35781 35782 35783 35784 35785 35786 35787 35788 35789 35790 35791 35792 35793 35794 35795 35796 35797 35798 35799 ..... 36338 36339 36340 36341 36342 36343 36344 36345 36346 36347 36348 36349 36350 36351 36352   return -code error "test case attempts to write/query the registry" } if { ![dict exists $reg$path $key] } { return -code error "test case attempts to read unknown registry entry$path $key" } return [dict get$reg $path$key] } # Base test cases: test clock-0.1 "initial: auto-loading of ensemble and stubs on demand" no_tclclockmod { set i [interp create]; # because clock can be used somewhere, test it in new interp: set ret [$i eval { ................................................................................ expr [clock clicks]+1 concat {} } {} test clock-33.2 {clock clicks tests} { set start [clock clicks] after 10 set end [clock clicks] expr "$end > $start" } {1} test clock-33.3 {clock clicks tests} { list [catch {clock clicks foo} msg]$msg } {1 {bad option "foo": must be -milliseconds or -microseconds}} test clock-33.4 {clock clicks tests} { expr [clock clicks -milliseconds]+1 concat {} } {} test clock-33.4a {clock milliseconds} { expr { [clock milliseconds] + 1 } concat {} } {} test clock-33.5 {clock clicks tests, millisecond timing test} { # This test can fail on a system that is so heavily loaded that # the test takes >60 ms to run. set start [clock clicks -milli] after 10 set end [clock clicks -milli] # 60 msecs seems to be the max time slice under Windows 95/98 expr { ($end >$start) && (($end -$start) <= 60) ? "ok" : "test should have taken 0-60 ms, actually took [expr $end -$start]"} } {ok} test clock-33.5a {clock tests, millisecond timing test} { # This test can fail on a system that is so heavily loaded that # the test takes >60 ms to run. set start [clock milliseconds] after 10 set end [clock milliseconds] # 60 msecs seems to be the max time slice under Windows 95/98 expr { ($end >$start) && (($end -$start) <= 60) ? "ok" : "test should have taken 0-60 ms, actually took [expr $end -$start]"} } {ok} test clock-33.6 {clock clicks, milli with too much abbreviation} { list [catch { clock clicks ? } msg] $msg } {1 {bad option "?": must be -milliseconds or -microseconds}} test clock-33.7 {clock clicks, milli with too much abbreviation} { list [catch { clock clicks - } msg]$msg } {1 {ambiguous option "-": must be -milliseconds or -microseconds}} test clock-33.8 {clock clicks test, microsecond timing test} { # This test can fail on a system that is so heavily loaded that # the test takes >60 ms to run. set start [clock clicks -micro] after 10 set end [clock clicks -micro] expr {($end >$start) && (($end -$start) <= 60000)} } {1} test clock-33.8a {clock test, microsecond timing test} { # This test can fail on a system that is so heavily loaded that # the test takes >60 ms to run. set start [clock microseconds] after 10 set end [clock microseconds] expr {($end >$start) && (($end -$start) <= 60000)} } {1} test clock-33.9 {clock clicks test, millis align with seconds} { set t1 [clock seconds] while { 1 } { set t2 [clock clicks -millis] set t3 [clock seconds] if { $t3 ==$t1 } break ................................................................................ test clock-35.2 {clock seconds tests} { list [catch {clock seconds foo} msg] $msg } {1 {wrong # args: should be "clock seconds"}} test clock-35.3 {clock seconds tests} { set start [clock seconds] after 2000 set end [clock seconds] expr "$end > $start" } {1} test clock-36.1 {clock scan next monthname} { clock format [clock scan "next june" -base [clock scan "june 1, 2000"]] \ -format %m.%Y } "06.2001"   > > > > > > > > > > > > | | | | | | | | | | | | | | | | | < < < < < < | | | < | > | > | < | > | < | | > > | |  265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 ..... 35738 35739 35740 35741 35742 35743 35744 35745 35746 35747 35748 35749 35750 35751 35752 35753 35754 35755 35756 35757 35758 35759 35760 35761 35762 35763 35764 35765 35766 35767 35768 35769 35770 35771 35772 35773 35774 35775 35776 35777 35778 35779 35780 35781 35782 35783 35784 35785 35786 35787 35788 35789 35790 35791 35792 35793 35794 35795 35796 35797 35798 35799 35800 35801 35802 35803 35804 35805 35806 35807 ..... 36346 36347 36348 36349 36350 36351 36352 36353 36354 36355 36356 36357 36358 36359 36360   return -code error "test case attempts to write/query the registry" } if { ![dict exists$reg $path$key] } { return -code error "test case attempts to read unknown registry entry $path$key" } return [dict get $reg$path $key] } proc timeWithinDuration {duration start end} { regexp {([\d.]+)(s|ms|us)}$duration -> duration unit if {[llength $start] > 1} { set start [expr "([join$start +])/[llength $start]"] } if {[llength$end] > 1} { set end [expr "([join $end +])/[llength$end]"] } set delta [expr {$end -$start}] expr { ($delta > 0) && ($delta <= $duration) ? "ok" : "test should have taken 0-$duration $unit, actually took$delta"} } # Base test cases: test clock-0.1 "initial: auto-loading of ensemble and stubs on demand" no_tclclockmod { set i [interp create]; # because clock can be used somewhere, test it in new interp: set ret [$i eval { ................................................................................ expr [clock clicks]+1 concat {} } {} test clock-33.2 {clock clicks tests} { set start [clock clicks] after 10 set end [clock clicks] expr {$end > $start} } {1} test clock-33.3 {clock clicks tests} { list [catch {clock clicks foo} msg]$msg } {1 {bad option "foo": must be -milliseconds or -microseconds}} test clock-33.4 {clock clicks tests} { expr [clock clicks -milliseconds]+1 concat {} } {} test clock-33.4a {clock milliseconds} { expr { [clock milliseconds] + 1 } concat {} } {} test clock-33.5 {clock clicks tests, millisecond timing test} { set start [set end {}] lassign [time { lappend start [clock clicks -milli] after 1 {lappend end [clock clicks -milli]} vwait end } 5] tm timeWithinDuration [expr {int($tm/1000 + 1)}]ms$start $end } {ok} test clock-33.5a {clock tests, millisecond timing test} { set start [set end {}] lassign [time { lappend start [clock milliseconds] after 1 {lappend end [clock milliseconds]} vwait end } 5] tm timeWithinDuration [expr {int($tm/1000 + 1)}]ms $start$end } {ok} test clock-33.6 {clock clicks, milli with too much abbreviation} { list [catch { clock clicks ? } msg] $msg } {1 {bad option "?": must be -milliseconds or -microseconds}} test clock-33.7 {clock clicks, milli with too much abbreviation} { list [catch { clock clicks - } msg]$msg } {1 {ambiguous option "-": must be -milliseconds or -microseconds}} test clock-33.8 {clock clicks test, microsecond timing test} { set start [set end {}] lassign [time { lappend start [clock clicks -micro] after 1 {lappend end [clock clicks -micro]} vwait end } 5] tm timeWithinDuration [expr {int($tm + 10)}]us$start $end } {ok} test clock-33.8a {clock test, microsecond timing test} { set start [set end {}] lassign [time { lappend start [clock microseconds] after 1 {lappend end [clock microseconds]} vwait end } 5] tm timeWithinDuration [expr {int($tm + 10)}]us $start$end } {ok} test clock-33.9 {clock clicks test, millis align with seconds} { set t1 [clock seconds] while { 1 } { set t2 [clock clicks -millis] set t3 [clock seconds] if { $t3 ==$t1 } break ................................................................................ test clock-35.2 {clock seconds tests} { list [catch {clock seconds foo} msg] $msg } {1 {wrong # args: should be "clock seconds"}} test clock-35.3 {clock seconds tests} { set start [clock seconds] after 2000 set end [clock seconds] expr {$end > $start} } {1} test clock-36.1 {clock scan next monthname} { clock format [clock scan "next june" -base [clock scan "june 1, 2000"]] \ -format %m.%Y } "06.2001"  Changes to tests/cmdAH.test.  19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 ... 562 563 564 565 566 567 568 569 570 571 572 573 574 575  catch [list package require -exact Tcltest [info patchlevel]] testConstraint testchmod [llength [info commands testchmod]] testConstraint testsetplatform [llength [info commands testsetplatform]] testConstraint testvolumetype [llength [info commands testvolumetype]] testConstraint linkDirectory [expr { ![testConstraint win] || ([string index$tcl_platform(osVersion) 0] >= 5 && [lindex [file system [temporaryDirectory]] 1] eq "NTFS") }] global env set cmdAHwd [pwd] catch {set platform [testgetplatform]} ................................................................................ testsetplatform windows file tail {c:/foo\bar} } bar test cmdAH-9.51 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform windows file tail {foo\bar} } bar # rootname test cmdAH-10.1 {Tcl_FileObjCmd: rootname} -returnCodes error -body { file rootname a b } -result {wrong # args: should be "file rootname name"} test cmdAH-10.2 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform unix   | > > > > > > >  19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 ... 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582  catch [list package require -exact Tcltest [info patchlevel]] testConstraint testchmod [llength [info commands testchmod]] testConstraint testsetplatform [llength [info commands testsetplatform]] testConstraint testvolumetype [llength [info commands testvolumetype]] testConstraint linkDirectory [expr { ![testConstraint win] || ($::tcl_platform(osVersion) >= 5.0 && [lindex [file system [temporaryDirectory]] 1] eq "NTFS") }] global env set cmdAHwd [pwd] catch {set platform [testgetplatform]} ................................................................................ testsetplatform windows file tail {c:/foo\bar} } bar test cmdAH-9.51 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform windows file tail {foo\bar} } bar test cmdAH-9.52 {Tcl_FileObjCmd: tail / normalize, bug 7a9dc52b29} { list \ [file tail {~/~foo}] \ [file tail {~/test/~foo}] \ [file tail [file normalize {~/~foo}]] \ [file tail [file normalize {~/test/~foo}]] } [lrepeat 4 ./~foo] # rootname test cmdAH-10.1 {Tcl_FileObjCmd: rootname} -returnCodes error -body { file rootname a b } -result {wrong # args: should be "file rootname name"} test cmdAH-10.2 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform unix  Changes to tests/env.test.  49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 .. 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112   variable keep variable env2 set env2 [array get env] foreach name [array names env] { # Keep some environment variables that support operation of the tcltest # package. if {[string toupper$name] ni $keep} { unset env($name) } } return } ................................................................................ proc cleanup1 {} { encodingrestore envrestore } variable keep { TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH DISPLAY SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING SECURITYSESSIONID LANG WINDIR TERM CONNOMPROGRAMFILES PROGRAMFILES COMMONPROGRAMW6432 PROGRAMW6432 } variable printenvScript [makeFile [string map [list @keep@ [list $keep]] { encoding system iso8859-1 proc lrem {listname name} { upvar$listname list set i [lsearch -nocase $list$name]   | | | | |  49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 .. 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112   variable keep variable env2 set env2 [array get env] foreach name [array names env] { # Keep some environment variables that support operation of the tcltest # package. if {[string toupper $name] ni [string toupper$keep]} { unset env($name) } } return } ................................................................................ proc cleanup1 {} { encodingrestore envrestore } variable keep { TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING __CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM CommonProgramFiles ProgramFiles CommonProgramW6432 ProgramW6432 } variable printenvScript [makeFile [string map [list @keep@ [list$keep]] { encoding system iso8859-1 proc lrem {listname name} { upvar $listname list set i [lsearch -nocase$list $name]  Changes to tests/event.test.  523 524 525 526 527 528 529 530 531 532 533 534 535 536 537   foreach i [after info] { after cancel$i } after 10; update; # On Mac make sure update won't take long } -body { after 100 {set x x-done} after 200 {set y y-done} after 300 {set z z-done} after idle {set q q-done} set x before set y before set z before set q before list [vwait y] $x$y $z$q } -cleanup {   |  523 524 525 526 527 528 529 530 531 532 533 534 535 536 537   foreach i [after info] { after cancel $i } after 10; update; # On Mac make sure update won't take long } -body { after 100 {set x x-done} after 200 {set y y-done} after 400 {set z z-done} after idle {set q q-done} set x before set y before set z before set q before list [vwait y]$x $y$z $q } -cleanup {  Changes to tests/fCmd.test.  61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 .... 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319   if {[catch {makeDirectory tcl[pid] /tmp} tmpspace] == 0} { testConstraint xdev [expr {([dev .] != [dev$tmpspace])}] } } # Also used in winFCmd... if {[testConstraint win]} { set major [string index $tcl_platform(osVersion) 0] if {[testConstraint nt] &&$major > 4} { if {$major > 5} { testConstraint winVista 1 } elseif {$major == 5} { testConstraint win2000orXP 1 } } } testConstraint darwin9 [expr { [testConstraint unix] && $tcl_platform(os) eq "Darwin" && [package vsatisfies 1.$tcl_platform(osVersion) 1.9] }] testConstraint notDarwin9 [expr {![testConstraint darwin9]}] testConstraint fileSharing 0 testConstraint notFileSharing 1 testConstraint linkFile 1 testConstraint linkDirectory 1 ................................................................................ file attributes foo.tmp {*}[lrange $attrs 0 3] } -cleanup { file delete -force -- foo.tmp } -result {} if { [testConstraint win] && ([string index$tcl_platform(osVersion) 0] < 5 || [lindex [file system [temporaryDirectory]] 1] ne "NTFS") } then { testConstraint linkDirectory 0 testConstraint linkFile 0 } test fCmd-28.1 {file link} -returnCodes error -body {   < | < > | | |  61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 .... 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318   if {[catch {makeDirectory tcl[pid] /tmp} tmpspace] == 0} { testConstraint xdev [expr {([dev .] != [dev $tmpspace])}] } } # Also used in winFCmd... if {[testConstraint win]} { if {[testConstraint nt] &&$::tcl_platform(osVersion) >= 5.0} { if {$::tcl_platform(osVersion) >= 6.0} { testConstraint winVista 1 } else { testConstraint win2000orXP 1 } } } testConstraint darwin9 [expr { [testConstraint unix] &&$tcl_platform(os) eq "Darwin" && [package vsatisfies 1.$::tcl_platform(osVersion) 1.9] }] testConstraint notDarwin9 [expr {![testConstraint darwin9]}] testConstraint fileSharing 0 testConstraint notFileSharing 1 testConstraint linkFile 1 testConstraint linkDirectory 1 ................................................................................ file attributes foo.tmp {*}[lrange$attrs 0 3] } -cleanup { file delete -force -- foo.tmp } -result {} if { [testConstraint win] && ($::tcl_platform(osVersion) < 5.0 || [lindex [file system [temporaryDirectory]] 1] ne "NTFS") } then { testConstraint linkDirectory 0 testConstraint linkFile 0 } test fCmd-28.1 {file link} -returnCodes error -body {  Changes to tests/fileName.test.  19 20 21 22 23 24 25 26 27 28 29 30 31 32 33  catch [list package require -exact Tcltest [info patchlevel]] testConstraint testsetplatform [llength [info commands testsetplatform]] testConstraint testtranslatefilename [llength [info commands testtranslatefilename]] testConstraint linkDirectory 1 testConstraint symbolicLinkFile 1 if {[testConstraint win]} { if {[string index$tcl_platform(osVersion) 0] < 5 \ || [lindex [file system [temporaryDirectory]] 1] ne "NTFS"} { testConstraint linkDirectory 0 } testConstraint symbolicLinkFile 0 testConstraint sharedCdrive [expr {![catch {cd //[info hostname]/c}]}] } # This match compares the first two words of the result. If the wanted result   |  19 20 21 22 23 24 25 26 27 28 29 30 31 32 33  catch [list package require -exact Tcltest [info patchlevel]] testConstraint testsetplatform [llength [info commands testsetplatform]] testConstraint testtranslatefilename [llength [info commands testtranslatefilename]] testConstraint linkDirectory 1 testConstraint symbolicLinkFile 1 if {[testConstraint win]} { if {$::tcl_platform(osVersion) < 5.0 \ || [lindex [file system [temporaryDirectory]] 1] ne "NTFS"} { testConstraint linkDirectory 0 } testConstraint symbolicLinkFile 0 testConstraint sharedCdrive [expr {![catch {cd //[info hostname]/c}]}] } # This match compares the first two words of the result. If the wanted result  Changes to tests/format.test.  580 581 582 583 584 585 586 587 588 589 590 591 592 593  } -match regexp -result {-2414724693 f*701239ab} test format-19.2 {Bug 1867855} { format %llx 0 } 0 test format-19.3 {Bug 2830354} { string length [format %340f 0] } 340 # Note that this test may fail in future versions test format-20.1 {Bug 2932421: plain %s caused intrep change of args} -body { set x [dict create a b c d] format %s$x # After this, obj in $x should be a dict # We are testing to make sure it has not been shimmered to a   > > > > > > > > > > > > > >  580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607  } -match regexp -result {-2414724693 f*701239ab} test format-19.2 {Bug 1867855} { format %llx 0 } 0 test format-19.3 {Bug 2830354} { string length [format %340f 0] } 340 test format-19.4.1 {Bug d498578df4: width overflow should cause limit exceeded} \ -constraints {longIs32bit} -body { # in case of overflow into negative, it produces width -2 (and limit exceeded), # in case of width will be unsigned, it will be outside limit (2GB for 32bit)... # and it don't throw an error in case the bug is not fixed (and probably no segfault). format %[expr {0xffffffff - 1}]g 0 } -returnCodes error -result "max size for a Tcl value exceeded" test format-19.4.2 {Bug d498578df4: width overflow should cause limit exceeded} -body { # limit should exceeds in any case, # and it don't throw an error in case the bug is not fixed (and probably no segfault). format %[expr {0xffffffffffffffff - 1}]g 0 } -returnCodes error -result "max size for a Tcl value exceeded" # Note that this test may fail in future versions test format-20.1 {Bug 2932421: plain %s caused intrep change of args} -body { set x [dict create a b c d] format %s$x # After this, obj in $x should be a dict # We are testing to make sure it has not been shimmered to a  Changes to tests/http.test.  82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 .. 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114   set port [lindex [fconfigure$listen -sockname] 2] } } test http-1.1 {http::config} { http::config -useragent UserAgent http::config } [list -accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -urlencoding utf-8 -useragent "UserAgent"] test http-1.2 {http::config} { http::config -proxyfilter } http::ProxyRequired test http-1.3 {http::config} { catch {http::config -junk} } 1 test http-1.4 {http::config} { ................................................................................ set savedconf [http::config] http::config -proxyhost nowhere.come -proxyport 8080 \ -proxyfilter myFilter -useragent "Tcl Test Suite" \ -urlencoding iso8859-1 set x [http::config] http::config {*}$savedconf set x } {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -urlencoding iso8859-1 -useragent {Tcl Test Suite}} 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} test http-1.6 {http::config} -setup { set oldenc [http::config -urlencoding] } -body { set enc [list [http::config -urlencoding]] http::config -urlencoding iso8859-1 lappend enc [http::config -urlencoding] } -cleanup {   | | |  82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 .. 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114   set port [lindex [fconfigure$listen -sockname] 2] } } test http-1.1 {http::config} { http::config -useragent UserAgent http::config } [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 test http-1.3 {http::config} { catch {http::config -junk} } 1 test http-1.4 {http::config} { ................................................................................ set savedconf [http::config] http::config -proxyhost nowhere.come -proxyport 8080 \ -proxyfilter myFilter -useragent "Tcl Test Suite" \ -urlencoding iso8859-1 set x [http::config] http::config {*}$savedconf set x } {-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, -pipeline, -postfresh, -proxyfilter, -proxyhost, -proxyport, -repost, -urlencoding, -useragent, -zip} test http-1.6 {http::config} -setup { set oldenc [http::config -urlencoding] } -body { set enc [list [http::config -urlencoding]] http::config -urlencoding iso8859-1 lappend enc [http::config -urlencoding] } -cleanup {  Changes to tests/http11.test.  511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528  # returns in 3.2 and 3.3 and HTTP/1.1 in all but test 3.1 proc handler {var sock token} { upvar #0$var data 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 {} } } test http11-3.0 "-handler,close,identity" -setup { variable httpd [create_httpd] set testdata "" } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \   | < < <  511 512 513 514 515 516 517 518 519 520 521 522 523 524 525  # returns in 3.2 and 3.3 and HTTP/1.1 in all but test 3.1 proc handler {var sock token} { upvar #0 $var data set chunk [read$sock] append data $chunk #::http::Log "handler read [string length$chunk] ([chan configure $sock -buffersize])" return [string length$chunk] } test http11-3.0 "-handler,close,identity" -setup { variable httpd [create_httpd] set testdata "" } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \  Added tests/httpPipeline.test.      > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > >  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866  # httpPipeline.test # # Test HTTP/1.1 concurrent requests including # queueing, pipelining and retries. # # Copyright (C) 2018 Keith Nash # # 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  Added tests/httpTest.tcl.      > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > >  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505  # httpTest.tcl # # Test HTTP/1.1 concurrent requests including # queueing, pipelining and retries. # # Copyright (C) 2018 Keith Nash # # 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 } 

     > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > >  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509  # httpTestScript.tcl # # Test HTTP/1.1 concurrent requests including # queueing, pipelining and retries. # # Copyright (C) 2018 Keith Nash # # 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 } 

Changes to tests/io.test.

 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 .... 8266 8267 8268 8269 8270 8271 8272 8273 8274 8275 8276 8277 8278 8279   variable f variable i variable n variable v variable msg variable expected loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] package require tcltests testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testchannel [llength [info commands testchannel]] testConstraint openpipe 1 testConstraint testfevent [llength [info commands testfevent]] testConstraint testchannelevent [llength [info commands testchannelevent]] ................................................................................ string equal $result [testmainthread] } {1} test io-60.1 {writing illegal utf sequences} {openpipe fileevent testbytestring} { # This test will hang in older revisions of the core. set out [open$path(script) w] puts $out { puts [testbytestring \xe2] exit 1 } proc readit {pipe} { variable x variable result   > | | > > >  25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 .... 8269 8270 8271 8272 8273 8274 8275 8276 8277 8278 8279 8280 8281 8282 8283   variable f variable i variable n variable v variable msg variable expected catch { ::tcltest::loadTestedCommands package require -exact Tcltest [info patchlevel] set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1] } package require tcltests testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testchannel [llength [info commands testchannel]] testConstraint openpipe 1 testConstraint testfevent [llength [info commands testfevent]] testConstraint testchannelevent [llength [info commands testchannelevent]] ................................................................................ string equal$result [testmainthread] } {1} test io-60.1 {writing illegal utf sequences} {openpipe fileevent testbytestring} { # This test will hang in older revisions of the core. set out [open $path(script) w] puts$out "catch {load $::tcltestlib Tcltest}" puts$out { puts [testbytestring \xe2] exit 1 } proc readit {pipe} { variable x variable result 

Changes to tests/ioTrans.test.

 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251   # Wait a bit, give the main thread the time to start its event loop to # wait for the response from B after 50 catch { puts $chan shoo } res set res }] } -cleanup { tempdone interp delete$idb } -result {Owner lost} test iortrans-11.2 {delete interp of reflected transform} -setup { interp create slave # Magic to get the test* commands into the slave load {} Tcltest slave } -constraints {testchannel} -body { # Get base channel into the slave   < >  1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251   # Wait a bit, give the main thread the time to start its event loop to # wait for the response from B after 50 catch { puts $chan shoo } res set res }] } -cleanup { interp delete$idb tempdone } -result {Owner lost} test iortrans-11.2 {delete interp of reflected transform} -setup { interp create slave # Magic to get the test* commands into the slave load {} Tcltest slave } -constraints {testchannel} -body { # Get base channel into the slave 

Changes to tests/list.test.

 124 125 126 127 128 129 130 131 132 133 134  test list-3.1 {SetListFromAny and lrange/concat results} { slowsort {fred julie alex carol bill annie} } {alex annie bill carol fred julie} test list-4.1 {Bug 3173086} { string is list "{[list \\\\\}]}" } 1 # cleanup ::tcltest::cleanupTests return   > > > > > > > > > > > > > > > > > >  124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152  test list-3.1 {SetListFromAny and lrange/concat results} { slowsort {fred julie alex carol bill annie} } {alex annie bill carol fred julie} test list-4.1 {Bug 3173086} { string is list "{[list \\\\\}]}" } 1 test list-4.2 {Bug 35a8f1c04a, check correct str-rep} { set result {} foreach i { {#"} {#"""} {#"""""""""""""""} "#\"{" "#\"\"\"{" "#\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\{" "#\"}" "#\"\"\"}" "#\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\}" } { set list [list $i] set list [string trim "$list "] if {[llength $list] > 1 ||$i ne [lindex $list 0]} { lappend result "wrong string-representation of list by '$i', length: [llength $list], list: '$list'" } } set result [join $result \n] } {} test list-4.3 {Bug 35a8f1c04a, check correct string length} { string length [list #""] } 5 # cleanup ::tcltest::cleanupTests return  Changes to tests/lrange.test.  103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118   test lrange-3.5 {compiled with calculated indices, start out of range (negative)} { list [lrange {a b c} -1 1] [lrange {a b c} -1+0 end-1] [lrange {a b c} -2 1] [lrange {a b c} -2+0 0+1] } [lrepeat 4 {a b}] test lrange-3.6 {compiled with calculated indices, end out of range (after end)} { list [lrange {a b c} 1 end+1] [lrange {a b c} 1+0 2+1] [lrange {a b c} 1 end+1] [lrange {a b c} end-1 3+1] } [lrepeat 4 {b c}] # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End:   > > > > > > > > > >  103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128   test lrange-3.5 {compiled with calculated indices, start out of range (negative)} { list [lrange {a b c} -1 1] [lrange {a b c} -1+0 end-1] [lrange {a b c} -2 1] [lrange {a b c} -2+0 0+1] } [lrepeat 4 {a b}] test lrange-3.6 {compiled with calculated indices, end out of range (after end)} { list [lrange {a b c} 1 end+1] [lrange {a b c} 1+0 2+1] [lrange {a b c} 1 end+1] [lrange {a b c} end-1 3+1] } [lrepeat 4 {b c}] test lrange-3.7a {compiled on empty not canonical list (with static and dynamic indices), regression test, bug [cc1e91552c]} { list [lrange { } 0 1] [lrange [format %c 32] 0 1] [lrange [set a { }] 0 1] \ [lrange { } 0-1 end+1] [lrange [format %c 32] 0-1 end+1] [lrange$a 0-1 end+1] } [lrepeat 6 {}] test lrange-3.7b {not compiled on empty not canonical list (with static and dynamic indices), regression test, bug [cc1e91552c]} { set cmd lrange list [$cmd { } 0 1] [$cmd [format %c 32] 0 1] [$cmd [set a { }] 0 1] \ [$cmd { } 0-1 end+1] [$cmd [format %c 32] 0-1 end+1] [$cmd $a 0-1 end+1] } [lrepeat 6 {}] # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End:  Changes to tests/lreplace.test.  96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 ... 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141   set foo {a b} list [set foo [lreplace$foo end end]] \ [set foo [lreplace $foo end end]] \ [set foo [lreplace$foo end end]] } {a {} {}} test lreplace-1.27 {lreplace command} -body { lreplace x 1 1 } -returnCodes 1 -result {list doesn't contain element 1} test lreplace-1.28 {lreplace command} -body { lreplace x 1 1 y } -returnCodes 1 -result {list doesn't contain element 1} test lreplace-1.29 {lreplace command} -body { lreplace x 1 1 [error foo] } -returnCodes 1 -result {foo} test lreplace-1.30 {lreplace command} -body { lreplace {not {}alist} 0 0 [error foo] } -returnCodes 1 -result {foo} ................................................................................ list [catch {lreplace x 10 x} msg] $msg } {1 {bad index "x": must be integer?[+-]integer? or end?[+-]integer?}} test lreplace-2.5 {lreplace errors} { list [catch {lreplace x 10 1x} msg]$msg } {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}} test lreplace-2.7 {lreplace errors} { list [catch {lreplace x 2 2} msg]$msg } {1 {list doesn't contain element 2}} test lreplace-3.1 {lreplace won't modify shared argument objects} { proc p {} { lreplace "a b c" 1 1 "x y" return "a b c" } p   | | | |  96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 ... 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141   set foo {a b} list [set foo [lreplace $foo end end]] \ [set foo [lreplace$foo end end]] \ [set foo [lreplace $foo end end]] } {a {} {}} test lreplace-1.27 {lreplace command} -body { lreplace x 1 1 } -result x test lreplace-1.28 {lreplace command} -body { lreplace x 1 1 y } -result {x y} test lreplace-1.29 {lreplace command} -body { lreplace x 1 1 [error foo] } -returnCodes 1 -result {foo} test lreplace-1.30 {lreplace command} -body { lreplace {not {}alist} 0 0 [error foo] } -returnCodes 1 -result {foo} ................................................................................ list [catch {lreplace x 10 x} msg]$msg } {1 {bad index "x": must be integer?[+-]integer? or end?[+-]integer?}} test lreplace-2.5 {lreplace errors} { list [catch {lreplace x 10 1x} msg] $msg } {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 } {0 x} test lreplace-2.7 {lreplace errors} { list [catch {lreplace x 2 2} msg] $msg } {0 x} test lreplace-3.1 {lreplace won't modify shared argument objects} { proc p {} { lreplace "a b c" 1 1 "x y" return "a b c" } p  Changes to tests/macOSXFCmd.test.  95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 ... 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170  test macOSXFCmd-2.6 {MacOSXSetFileAttribute - hidden} {macosxFileAttr notRoot} { catch {file delete -force -- foo.test} close [open foo.test w] list [catch {file attributes foo.test -hidden 1} msg]$msg \ [catch {file attributes foo.test -hidden} msg] $msg \ [file delete -force -- foo.test] } {0 {} 0 1 {}} test macOSXFCmd-2.7 {MacOSXSetFileAttribute - rsrclength} {macosxFileAttr notRoot} { catch {file delete -force -- foo.test} close [open foo.test w] catch { set f [open foo.test/..namedfork/rsrc w] fconfigure$f -translation lf -eofchar {} puts -nonewline $f "foo" close$f ................................................................................ file attributes baz.test -creator FOOC -type FOOT file attributes foo.test -creator FOOC file attributes inv.test -hidden 1 file attributes inw.test -hidden 1 -type FOOT 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 \ ] cd .. file delete -force globtest set res } [list \ 0 {bar.test baz.test dir.test foo.test inv.test inw.test reg.test} \ 0 {bar.test baz.test inw.test} 0 {bar.test baz.test inw.test} \   | | | | | | | | | | |  95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 ... 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170  test macOSXFCmd-2.6 {MacOSXSetFileAttribute - hidden} {macosxFileAttr notRoot} { catch {file delete -force -- foo.test} close [open foo.test w] list [catch {file attributes foo.test -hidden 1} msg] $msg \ [catch {file attributes foo.test -hidden} msg]$msg \ [file delete -force -- foo.test] } {0 {} 0 1 {}} test macOSXFCmd-2.7 {MacOSXSetFileAttribute - rsrclength} {macosxFileAttr notRoot nonPortable} { catch {file delete -force -- foo.test} close [open foo.test w] catch { set f [open foo.test/..namedfork/rsrc w] fconfigure $f -translation lf -eofchar {} puts -nonewline$f "foo" close $f ................................................................................ file attributes baz.test -creator FOOC -type FOOT file attributes foo.test -creator FOOC file attributes inv.test -hidden 1 file attributes inw.test -hidden 1 -type FOOT file attributes dir.test -hidden 1 } set res [list \ [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 set res } [list \ 0 {bar.test baz.test dir.test foo.test inv.test inw.test reg.test} \ 0 {bar.test baz.test inw.test} 0 {bar.test baz.test inw.test} \  Changes to tests/oo.test.  1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813   } oo::class create bar [foo new] m } -cleanup { foo destroy bar destroy } -result {::foo ::foo ::foo ::bar} # todo: changing a class subtype (metaclass) to another class subtype test oo-14.1 {OO: mixins} { oo::class create Aclass oo::define Aclass method bar {} {lappend ::result "[self object] in bar"} oo::class create Bclass oo::define Bclass method boo {} {lappend ::result "[self object] in boo"}   > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > >  1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913   } oo::class create bar [foo new] m } -cleanup { 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} { oo::class create Aclass oo::define Aclass method bar {} {lappend ::result "[self object] in bar"} oo::class create Bclass oo::define Bclass method boo {} {lappend ::result "[self object] in boo"}  Changes to tests/proc.test.  106 107 108 109 110 111 112 113 114 115 116 117 118 119 ... 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396  } -result {formal parameter "a(1)" is an array element} test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple names} -setup { catch {rename p ""} } -body { proc p {b:a b::a} { } } -returnCodes error -result {formal parameter "b::a" is not a simple name} test proc-2.1 {TclFindProc, simple proc name and proc not in namespace} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} } -body { proc p {} {return "p in [namespace current]"} info body p ................................................................................ set lambda x lappend lambda {set a 1} interp create slave slave eval [list apply$lambda foo] interp delete slave unset lambda } {} # cleanup catch {rename p ""} catch {rename t ""} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End:   > > > > > > > > > > > > > > > >  106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 ... 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412  } -result {formal parameter "a(1)" is an array element} test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple names} -setup { catch {rename p ""} } -body { 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_*]} catch {rename p ""} } -body { proc p {} {return "p in [namespace current]"} info body p ................................................................................ set lambda x lappend lambda {set a 1} interp create slave slave eval [list apply $lambda foo] 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 ""} catch {rename t ""} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: 

Changes to tests/registry.test.

 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 ... 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 ... 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 ... 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 ... 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614   namespace import -force ::tcltest::* } testConstraint reg 0 if {[testConstraint win]} { if {![catch { ::tcltest::loadTestedCommands set ::regver [package require registry 1.3.2] }]} { testConstraint reg 1 } } # determine the current locale testConstraint english [expr { [llength [info commands testlocale]] && [string match "English*" [testlocale all ""]] }] test registry-1.0 {check if we are testing the right dll} {win reg} { set ::regver } {1.3.2} 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 ...?"}} test registry-1.1a {argument parsing for registry command} {win reg} { list [catch {registry -32bit} msg]$msg } {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}} test registry-1.1b {argument parsing for registry command} {win reg} { ................................................................................ registry set HKEY_CURRENT_USER\\TclFoobar\\baz\u00c7bar registry set HKEY_CURRENT_USER\\TclFoobar\\blat registry set HKEY_CURRENT_USER\\TclFoobar\\foo set result [lsort [registry keys HKEY_CURRENT_USER\\TclFoobar b*]] registry delete HKEY_CURRENT_USER\\TclFoobar set result } "baz\u00c7bar blat" test registry-4.8 {GetKeyNames: Unicode} {win reg nt} { registry delete HKEY_CURRENT_USER\\TclFoobar registry set HKEY_CURRENT_USER\\TclFoobar\\baz\u30b7bar registry set HKEY_CURRENT_USER\\TclFoobar\\blat registry set HKEY_CURRENT_USER\\TclFoobar\\foo set result [lsort [registry keys HKEY_CURRENT_USER\\TclFoobar b*]] registry delete HKEY_CURRENT_USER\\TclFoobar set result ................................................................................ } 1 test registry-6.17 {GetValue: Unicode value names} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val\u00c71 foobar multi_sz set result [registry get HKEY_CURRENT_USER\\TclFoobar val\u00c71] registry delete HKEY_CURRENT_USER\\TclFoobar set result } foobar test registry-6.18 {GetValue: values with Unicode strings} {win reg nt} { 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 set result } "foo ba\u30b7r baz" test registry-6.19 {GetValue: values with Unicode strings} {win reg english} { registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u00c7r baz} multi_sz ................................................................................ } "foo ba\u00c7r baz" test registry-6.20 {GetValue: values with Unicode strings with embedded nulls} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u0000r baz} multi_sz set result [registry get HKEY_CURRENT_USER\\TclFoobar val1] 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} { 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 set result } [string repeat x 16383] test registry-7.1 {GetValueNames: bad key} -constraints {win reg english} -setup { ................................................................................ } -returnCodes error -result {bad key "\foobar": must start with a valid root} test registry-9.3 {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.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 { 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 { registry values \\\\gaspode } -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.7 {ParseKeyName: bad keys} -constraints {win reg} -body { registry values foobar   | | | | | |  15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 ... 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 ... 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 ... 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 ... 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614   namespace import -force ::tcltest::* } testConstraint reg 0 if {[testConstraint win]} { if {![catch { ::tcltest::loadTestedCommands set ::regver [package require registry 1.3.3] }]} { testConstraint reg 1 } } # determine the current locale testConstraint english [expr { [llength [info commands testlocale]] && [string match "English*" [testlocale all ""]] }] test registry-1.0 {check if we are testing the right dll} {win reg} { set ::regver } {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 ...?"}} test registry-1.1a {argument parsing for registry command} {win reg} { list [catch {registry -32bit} msg]$msg } {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}} test registry-1.1b {argument parsing for registry command} {win reg} { ................................................................................ registry set HKEY_CURRENT_USER\\TclFoobar\\baz\u00c7bar registry set HKEY_CURRENT_USER\\TclFoobar\\blat registry set HKEY_CURRENT_USER\\TclFoobar\\foo set result [lsort [registry keys HKEY_CURRENT_USER\\TclFoobar b*]] registry delete HKEY_CURRENT_USER\\TclFoobar set result } "baz\u00c7bar blat" 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 registry set HKEY_CURRENT_USER\\TclFoobar\\foo set result [lsort [registry keys HKEY_CURRENT_USER\\TclFoobar b*]] registry delete HKEY_CURRENT_USER\\TclFoobar set result ................................................................................ } 1 test registry-6.17 {GetValue: Unicode value names} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val\u00c71 foobar multi_sz set result [registry get HKEY_CURRENT_USER\\TclFoobar val\u00c71] registry delete HKEY_CURRENT_USER\\TclFoobar set result } foobar 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 set result } "foo ba\u30b7r baz" test registry-6.19 {GetValue: values with Unicode strings} {win reg english} { registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u00c7r baz} multi_sz ................................................................................ } "foo ba\u00c7r baz" test registry-6.20 {GetValue: values with Unicode strings with embedded nulls} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u0000r baz} multi_sz set result [registry get HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar set result } "foo ba r baz" 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 set result } [string repeat x 16383] test registry-7.1 {GetValueNames: bad key} -constraints {win reg english} -setup { ................................................................................ } -returnCodes error -result {bad key "\foobar": must start with a valid root} test registry-9.3 {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.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} -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 { registry values \\\\gaspode } -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.7 {ParseKeyName: bad keys} -constraints {win reg} -body { registry values foobar 

Changes to tests/socket.test.

 268 269 270 271 272 273 274 275 276 277 278 279 280 281 .... 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 .... 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428   } } proc getPort sock { lindex [fconfigure $sock -sockname] 2 } # ---------------------------------------------------------------------- test socket_$af-1.1 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -server } -returnCodes error -result {no argument given for -server option} test socket_$af-1.2 {arg parsing for socket command} -constraints [list socket supported_$af] -body { ................................................................................ if {$remoteProcChan ne ""} { catch {sendCommand exit} } catch {close $commandSocket} catch {close$remoteProcChan} } unset ::tcl::unsupported::socketAF test socket-14.0.0 {[socket -async] when server only listens on IPv4} \ -constraints {socket supported_inet localhost_v4} \ -setup { proc accept {s a p} { global x puts $s bye close$s set x ok } set server [socket -server accept -myaddr 127.0.0.1 0] set port [lindex [fconfigure $server -sockname] 2] } -body { set client [socket -async localhost$port] set after [after $latency {set x [fconfigure$client -error]}] vwait x set x } -cleanup { after cancel $after close$server close $client unset x } -result ok test socket-14.0.1 {[socket -async] when server only listens on IPv6} \ -constraints {socket supported_inet6 localhost_v6} \ -setup { proc accept {s a p} { global x puts$s bye close $s set x ok } set server [socket -server accept -myaddr ::1 0] set port [lindex [fconfigure$server -sockname] 2] } -body { set client [socket -async localhost $port] set after [after$latency {set x [fconfigure $client -error]}] vwait x set x } -cleanup { after cancel$after close $server close$client unset x } -result ok test socket-14.1 {[socket -async] fileevent while still connecting} \ -constraints {socket} \ -setup { proc accept {s a p} { global x puts $s bye close$s lappend x ok } set server [socket -server accept -myaddr localhost 0] set port [lindex [fconfigure $server -sockname] 2] set x "" } -body { set client [socket -async localhost$port] fileevent $client writable { lappend x [fconfigure$client -error] fileevent $client writable {} } set after [after$latency {lappend x timeout}] while {[llength $x] < 2 && "timeout" ni$x} { vwait x } lsort $x; # we only want to see both events, the order doesn't matter } -cleanup { after cancel$after close $server close$client unset x } -result {{} ok} test socket-14.2 {[socket -async] fileevent connection refused} \ -constraints {socket} \ -body { set client [socket -async localhost [randport]] fileevent $client writable {set x ok} set after [after$latency {set x timeout}] vwait x after cancel $after lappend x [fconfigure$client -error] } -cleanup { after cancel $after close$client unset x after client } -result {ok {connection refused}} test socket-14.3 {[socket -async] when server only listens on IPv6} \ -constraints {socket supported_inet6 localhost_v6} \ -setup { proc accept {s a p} { global x puts $s bye close$s set x ok } set server [socket -server accept -myaddr ::1 0] set port [lindex [fconfigure $server -sockname] 2] } -body { set client [socket -async localhost$port] set after [after $latency {set x [fconfigure$client -error]}] vwait x set x } -cleanup { after cancel $after close$server close $client unset x } -result ok test socket-14.4 {[socket -async] and both, readdable and writable fileevents} \ -constraints {socket} \ -setup { proc accept {s a p} { puts$s bye close $s } set server [socket -server accept -myaddr localhost 0] set port [lindex [fconfigure$server -sockname] 2] set x "" } -body { set client [socket -async localhost $port] fileevent$client writable { lappend x [fconfigure $client -error] fileevent$client writable {} } fileevent $client readable {lappend x [gets$client]} set after [after $latency {lappend x timeout}] while {[llength$x] < 2 && "timeout" ni $x} { vwait x } lsort$x } -cleanup { after cancel $after close$client close $server unset x } -result {{} bye} # FIXME: we should also have an IPv6 counterpart of this test socket-14.5 {[socket -async] which fails before any connect() can be made} \ -constraints {socket supported_inet} \ -body { # address from rfc5737 socket -async -myaddr 192.0.2.42 127.0.0.1 [randport] } \ -returnCodes 1 \ -result {couldn't open socket: cannot assign requested address} test socket-14.6.0 {[socket -async] with no event loop and server listening on IPv4} \ -constraints {socket supported_inet localhost_v4} \ -setup { proc accept {s a p} { global x puts$s bye close $s set x ok } set server [socket -server accept -myaddr 127.0.0.1 0] set port [lindex [fconfigure$server -sockname] 2] set x "" } \ -body { set client [socket -async localhost $port] for {set i 0} {$i < 50} {incr i } { update if {$x ne ""} { lappend x [gets$client] break } after 100 } set x } \ -cleanup { close $server close$client unset x } \ -result {ok bye} test socket-14.6.1 {[socket -async] with no event loop and server listening on IPv6} \ -constraints {socket supported_inet6 localhost_v6} \ -setup { proc accept {s a p} { global x puts $s bye close$s set x ok } set server [socket -server accept -myaddr ::1 0] set port [lindex [fconfigure $server -sockname] 2] set x "" } \ -body { set client [socket -async localhost$port] for {set i 0} {$i < 50} {incr i } { update if {$x ne ""} { lappend x [gets $client] break } after 100 } set x } \ -cleanup { close$server close $client unset x } \ -result {ok bye} test socket-14.7.0 {pending [socket -async] and blocking [gets], server is IPv4} \ -constraints {socket supported_inet localhost_v4} \ -setup { makeFile { fileevent stdin readable exit set server [socket -server accept -myaddr 127.0.0.1 0] proc accept {s h p} {puts$s ok; close $s; set ::x 1} puts [lindex [fconfigure$server -sockname] 2] flush stdout vwait x } script set fd [open |[list [interpreter] script] RDWR] set port [gets $fd] } -body { set sock [socket -async localhost$port] list [fconfigure $sock -error] [gets$sock] [fconfigure $sock -error] } -cleanup { close$fd close $sock removeFile script } -result {{} ok {}} test socket-14.7.1 {pending [socket -async] and blocking [gets], server is IPv6} \ -constraints {socket supported_inet6 localhost_v6} \ -setup { makeFile { fileevent stdin readable exit set server [socket -server accept -myaddr ::1 0] proc accept {s h p} {puts$s ok; close $s; set ::x 1} puts [lindex [fconfigure$server -sockname] 2] flush stdout vwait x } script set fd [open |[list [interpreter] script] RDWR] set port [gets $fd] } -body { set sock [socket -async localhost$port] list [fconfigure $sock -error] [gets$sock] [fconfigure $sock -error] } -cleanup { close$fd close $sock removeFile script } -result {{} ok {}} test socket-14.7.2 {pending [socket -async] and blocking [gets], no listener} \ -constraints {socket} \ -body { set sock [socket -async localhost [randport]] catch {gets$sock} x list $x [fconfigure$sock -error] [fconfigure $sock -error] } -cleanup { close$sock } -match glob -result {{error reading "sock*": socket is not connected} {connection refused} {}} test socket-14.8.0 {pending [socket -async] and nonblocking [gets], server is IPv4} \ -constraints {socket supported_inet localhost_v4} \ -setup { makeFile { fileevent stdin readable exit set server [socket -server accept -myaddr 127.0.0.1 0] proc accept {s h p} {puts $s ok; close$s; set ::x 1} puts [lindex [fconfigure $server -sockname] 2] flush stdout vwait x } script set fd [open |[list [interpreter] script] RDWR] set port [gets$fd] } -body { set sock [socket -async localhost $port] fconfigure$sock -blocking 0 for {set i 0} {$i < 50} {incr i } { if {[catch {gets$sock} x] || $x ne "" || ![fblocked$sock]} break after 200 } set x } -cleanup { close $fd close$sock removeFile script } -result {ok} test socket-14.8.1 {pending [socket -async] and nonblocking [gets], server is IPv6} \ -constraints {socket supported_inet6 localhost_v6} \ -setup { makeFile { fileevent stdin readable exit set server [socket -server accept -myaddr ::1 0] proc accept {s h p} {puts $s ok; close$s; set ::x 1} puts [lindex [fconfigure $server -sockname] 2] flush stdout vwait x } script set fd [open |[list [interpreter] script] RDWR] set port [gets$fd] } -body { set sock [socket -async localhost $port] fconfigure$sock -blocking 0 for {set i 0} {$i < 50} {incr i } { if {[catch {gets$sock} x] || $x ne "" || ![fblocked$sock]} break after 200 } set x } -cleanup { close $fd close$sock removeFile script } -result {ok} test socket-14.8.2 {pending [socket -async] and nonblocking [gets], no listener} \ -constraints {socket} \ -body { set sock [socket -async localhost [randport]] fconfigure $sock -blocking 0 for {set i 0} {$i < 50} {incr i } { if {[catch {gets $sock} x] ||$x ne "" || ![fblocked $sock]} break after 200 } list$x [fconfigure $sock -error] [fconfigure$sock -error] } -cleanup { close $sock } -match glob -result {{error reading "sock*": socket is not connected} {connection refused} {}} test socket-14.9.0 {pending [socket -async] and blocking [puts], server is IPv4} \ -constraints {socket supported_inet localhost_v4} \ -setup { makeFile { fileevent stdin readable exit set server [socket -server accept -myaddr 127.0.0.1 0] proc accept {s h p} {set ::x$s} puts [lindex [fconfigure $server -sockname] 2] flush stdout vwait x puts [gets$x] } script set fd [open |[list [interpreter] script] RDWR] set port [gets $fd] } -body { set sock [socket -async localhost$port] puts $sock ok flush$sock list [fconfigure $sock -error] [gets$fd] } -cleanup { close $fd close$sock removeFile script } -result {{} ok} test socket-14.9.1 {pending [socket -async] and blocking [puts], server is IPv6} \ -constraints {socket supported_inet6 localhost_v6} \ -setup { makeFile { fileevent stdin readable exit set server [socket -server accept -myaddr ::1 0] proc accept {s h p} {set ::x $s} puts [lindex [fconfigure$server -sockname] 2] flush stdout vwait x puts [gets $x] } script set fd [open |[list [interpreter] script] RDWR] set port [gets$fd] } -body { set sock [socket -async localhost $port] puts$sock ok flush $sock list [fconfigure$sock -error] [gets $fd] } -cleanup { close$fd close $sock removeFile script } -result {{} ok} test socket-14.10.0 {pending [socket -async] and nonblocking [puts], server is IPv4} \ -constraints {socket supported_inet localhost_v4} \ -setup { makeFile { fileevent stdin readable exit set server [socket -server accept -myaddr 127.0.0.1 0] proc accept {s h p} {set ::x$s} puts [lindex [fconfigure $server -sockname] 2] flush stdout vwait x puts [gets$x] } script set fd [open |[list [interpreter] script] RDWR] set port [gets $fd] } -body { set sock [socket -async localhost$port] fconfigure $sock -blocking 0 puts$sock ok flush $sock fileevent$fd readable {set x 1} vwait x list [fconfigure $sock -error] [gets$fd] } -cleanup { close $fd close$sock removeFile script } -result {{} ok} test socket-14.10.1 {pending [socket -async] and nonblocking [puts], server is IPv6} \ -constraints {socket supported_inet6 localhost_v6} \ -setup { makeFile { fileevent stdin readable exit set server [socket -server accept -myaddr ::1 0] proc accept {s h p} {set ::x $s} puts [lindex [fconfigure$server -sockname] 2] flush stdout vwait x puts [gets $x] } script set fd [open |[list [interpreter] script] RDWR] set port [gets$fd] } -body { set sock [socket -async localhost $port] fconfigure$sock -blocking 0 puts $sock ok flush$sock fileevent $fd readable {set x 1} vwait x list [fconfigure$sock -error] [gets $fd] } -cleanup { close$fd close $sock removeFile script } -result {{} ok} test socket-14.11.0 {pending [socket -async] and nonblocking [puts], no listener, no flush} \ -constraints {socket} \ -body { set sock [socket -async localhost [randport]] fconfigure$sock -blocking 0 puts $sock ok fileevent$sock writable {set x 1} vwait x close $sock } -cleanup { catch {close$sock} unset x } -result {socket is not connected} -returnCodes 1 test socket-14.11.1 {pending [socket -async] and nonblocking [puts], no listener, flush} \ -constraints {socket nonPortable} \ -body { set sock [socket -async localhost [randport]] fconfigure $sock -blocking 0 puts$sock ok flush $sock fileevent$sock writable {set x 1} vwait x close $sock } -cleanup { catch {close$sock} catch {unset x} } -result {socket is not connected} -returnCodes 1 test socket-14.12 {[socket -async] background progress triggered by [fconfigure -error]} \ -constraints {socket} \ -body { set s [socket -async localhost [randport]] for {set i 0} {$i < 50} {incr i} { set x [fconfigure$s -error] if {$x != ""} break after 200 } set x } -cleanup { close$s unset x s } -result {connection refused} test socket-14.13 {testing writable event when quick failure} \ -constraints {socket win supported_inet} \ -body { # Test for bug 336441ed59 where a quick background fail was ignored # Test only for windows as socket -async 255.255.255.255 fails # directly on unix # The following connect should fail very quickly set a1 [after 2000 {set x timeout}] set s [socket -async 255.255.255.255 43434] fileevent $s writable {set x writable} vwait x set x } -cleanup { catch {close$s} after cancel $a1 } -result writable test socket-14.14 {testing fileevent readable on failed async socket connect} \ -constraints {socket} -body { # Test for bug 581937ab1e set a1 [after 5000 {set x timeout}] # This connect should fail set s [socket -async localhost [randport]] fileevent$s readable {set x readable} vwait x set x } -cleanup { catch {close $s} after cancel$a1 } -result readable test socket-14.15 {blocking read on async socket should not trigger event handlers} \ -constraints socket -body { set s [socket -async localhost [randport]] set x ok fileevent $s writable {set x fail} catch {read$s} close $s set x } -result ok # v4 and v6 is required to prevent that the async connect does not terminate # before the fconfigure command. There is always an additional ip to try. test socket-14.16 {empty -peername while [socket -async] connecting} \ -constraints {socket localhost_v4 localhost_v6} \ -body { set client [socket -async localhost [randport]] fconfigure$client -peername } -cleanup { catch {close $client} } -result {} # v4 and v6 is required to prevent that the async connect does not terminate # before the fconfigure command. There is always an additional ip to try. test socket-14.17 {empty -sockname while [socket -async] connecting} \ -constraints {socket localhost_v4 localhost_v6} \ -body { set client [socket -async localhost [randport]] fconfigure$client -sockname } -cleanup { catch {close $client} } -result {} # test for bug c6ed4acfd8: running async socket connect with other connect # established will block tcl as it goes in an infinite loop in vwait test socket-14.18 {bug c6ed4acfd8: running async socket connect made other connect block} \ -constraints {socket} \ -body { proc accept {channel address port} {} set port [randport] set ssock [socket -server accept$port] set csock1 [socket -async localhost [randport]] set csock2 [socket localhost $port] after 1000 {set done ok} vwait done } -cleanup { catch {close$ssock} catch {close $csock1} catch {close$csock2} } -result {} set num 0 set x {localhost {socket} 127.0.0.1 {supported_inet} ::1 {supported_inet6}} set resultok {-result "sock*" -match glob} set resulterr { -result {couldn't open socket: connection refused} -returnCodes 1 } foreach {servip sc} $x { foreach {cliip cc}$x { set constraints socket lappend constraints $sc$cc set result $resulterr switch -- [lsort -unique [list$servip $cliip]] { localhost - 127.0.0.1 - ::1 { set result$resultok } {127.0.0.1 localhost} { if {[testConstraint localhost_v4]} { ................................................................................ } {::1 localhost} { if {[testConstraint localhost_v6]} { set result $resultok } } } test socket-15.1.$num "Connect to $servip from$cliip" \ -constraints $constraints -setup { set server [socket -server accept -myaddr$servip 0] proc accept {s h p} { close $s } set port [lindex [fconfigure$server -sockname] 2] } -body { set s [socket $cliip$port] } -cleanup { close $server catch {close$s} } {*}$result incr num } } ::tcltest::cleanupTests flush stdout return # Local Variables: # mode: tcl # fill-column: 78 # End:   > > > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < | < < | | < | > > | > | | | | > > > > > | < > > > > > | > > > | < < | | < > | | < | < < | | < > | | < | < < | | | | | | | | | | | | | < | < | | | < > | | | | |  268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 .... 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 .... 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394   } } proc getPort sock { lindex [fconfigure$sock -sockname] 2 } # Some tests in this file are known to hang *occasionally* on OSX; stop the # worst offenders. testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}] # ---------------------------------------------------------------------- test socket_$af-1.1 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -server } -returnCodes error -result {no argument given for -server option} test socket_$af-1.2 {arg parsing for socket command} -constraints [list socket supported_$af] -body { ................................................................................ if {$remoteProcChan ne ""} { catch {sendCommand exit} } catch {close $commandSocket} catch {close$remoteProcChan} } unset ::tcl::unsupported::socketAF test socket-14.0.0 {[socket -async] when server only listens on IPv4} -setup { proc accept {s a p} { global x puts $s bye close$s set x ok } set server [socket -server accept -myaddr 127.0.0.1 0] set port [lindex [fconfigure $server -sockname] 2] } -constraints {socket supported_inet localhost_v4} -body { set client [socket -async localhost$port] set after [after $latency {set x [fconfigure$client -error]}] vwait x set x } -cleanup { catch {after cancel $after} catch {close$server} catch {close $client} unset -nocomplain x } -result ok test socket-14.0.1 {[socket -async] when server only listens on IPv6} -setup { proc accept {s a p} { global x puts$s bye close $s set x ok } set server [socket -server accept -myaddr ::1 0] set port [lindex [fconfigure$server -sockname] 2] } -constraints {socket supported_inet6 localhost_v6} -body { set client [socket -async localhost $port] set after [after$latency {set x [fconfigure $client -error]}] vwait x set x } -cleanup { catch {after cancel$after} catch {close $server} catch {close$client} unset -nocomplain x } -result ok test socket-14.1 {[socket -async] fileevent while still connecting} -setup { proc accept {s a p} { global x puts $s bye close$s lappend x ok } set server [socket -server accept -myaddr localhost 0] set port [lindex [fconfigure $server -sockname] 2] set x "" } -constraints socket -body { set client [socket -async localhost$port] fileevent $client writable { lappend x [fconfigure$client -error] fileevent $client writable {} } set after [after$latency {lappend x timeout}] while {[llength $x] < 2 && "timeout" ni$x} { vwait x } lsort $x; # we only want to see both events, the order doesn't matter } -cleanup { catch {after cancel$after} catch {close $server} catch {close$client} unset -nocomplain x } -result {{} ok} test socket-14.2 {[socket -async] fileevent connection refused} -setup { set after [after $latency set x timeout] } -body { set client [socket -async localhost [randport]] fileevent$client writable {set x ok} vwait x lappend x [fconfigure $client -error] } -constraints socket -cleanup { catch {after cancel$after} catch {close $client} unset -nocomplain x after client } -result {ok {connection refused}} test socket-14.3 {[socket -async] when server only listens on IPv6} -setup { proc accept {s a p} { global x puts$s bye close $s set x ok } set server [socket -server accept -myaddr ::1 0] set port [lindex [fconfigure$server -sockname] 2] } -constraints {socket supported_inet6 localhost_v6} -body { set client [socket -async localhost $port] set after [after$latency {set x [fconfigure $client -error]}] vwait x set x } -cleanup { catch {after cancel$after} catch {close $server} catch {close$client} unset -nocomplain x } -result ok test socket-14.4 {[socket -async] and both, readdable and writable fileevents} -setup { proc accept {s a p} { puts $s bye close$s } set server [socket -server accept -myaddr localhost 0] set port [lindex [fconfigure $server -sockname] 2] set x "" } -constraints socket -body { set client [socket -async localhost$port] fileevent $client writable { lappend x [fconfigure$client -error] fileevent $client writable {} } fileevent$client readable {lappend x [gets $client]} set after [after$latency {lappend x timeout}] while {[llength $x] < 2 && "timeout" ni$x} { vwait x } lsort $x } -cleanup { catch {after cancel$after} catch {close $client} catch {close$server} unset -nocomplain x } -result {{} bye} # FIXME: we should also have an IPv6 counterpart of this test socket-14.5 {[socket -async] which fails before any connect() can be made} -body { # address from rfc5737 socket -async -myaddr 192.0.2.42 127.0.0.1 [randport] } -constraints {socket supported_inet notOSX} -returnCodes 1 \ -result {couldn't open socket: cannot assign requested address} test socket-14.6.0 {[socket -async] with no event loop and server listening on IPv4} -setup { proc accept {s a p} { global x puts $s bye close$s set x ok } set server [socket -server accept -myaddr 127.0.0.1 0] set port [lindex [fconfigure $server -sockname] 2] set x "" } -constraints {socket supported_inet localhost_v4} -body { set client [socket -async localhost$port] for {set i 0} {$i < 50} {incr i } { update if {$x ne ""} { lappend x [gets $client] break } after 100 } set x } -cleanup { catch {close$server} catch {close $client} unset -nocomplain x } -result {ok bye} test socket-14.6.1 {[socket -async] with no event loop and server listening on IPv6} -setup { proc accept {s a p} { global x puts$s bye close $s set x ok } set server [socket -server accept -myaddr ::1 0] set port [lindex [fconfigure$server -sockname] 2] set x "" } -constraints {socket supported_inet6 localhost_v6} -body { set client [socket -async localhost $port] for {set i 0} {$i < 50} {incr i } { update if {$x ne ""} { lappend x [gets$client] break } after 100 } set x } -cleanup { catch {close $server} catch {close$client} unset -nocomplain x } -result {ok bye} test socket-14.7.0 {pending [socket -async] and blocking [gets], server is IPv4} -setup { makeFile { fileevent stdin readable exit set server [socket -server accept -myaddr 127.0.0.1 0] proc accept {s h p} {puts $s ok; close$s; set ::x 1} puts [lindex [fconfigure $server -sockname] 2] flush stdout vwait x } script set fd [open |[list [interpreter] script] RDWR] set port [gets$fd] } -constraints {socket supported_inet localhost_v4 notOSX} -body { set sock [socket -async localhost $port] list [fconfigure$sock -error] [gets $sock] [fconfigure$sock -error] } -cleanup { catch {close $fd} catch {close$sock} removeFile script } -result {{} ok {}} test socket-14.7.1 {pending [socket -async] and blocking [gets], server is IPv6} -setup { makeFile { fileevent stdin readable exit set server [socket -server accept -myaddr ::1 0] proc accept {s h p} {puts $s ok; close$s; set ::x 1} puts [lindex [fconfigure $server -sockname] 2] flush stdout vwait x } script set fd [open |[list [interpreter] script] RDWR] set port [gets$fd] } -constraints {socket supported_inet6 localhost_v6 notOSX} -body { set sock [socket -async localhost $port] list [fconfigure$sock -error] [gets $sock] [fconfigure$sock -error] } -cleanup { catch {close $fd} catch {close$sock} removeFile script } -result {{} ok {}} test socket-14.7.2 {pending [socket -async] and blocking [gets], no listener} -setup { set sock [socket -server error 0] set unusedPort [lindex [fconfigure $sock -sockname] 2] close$sock } -body { set sock [socket -async localhost $unusedPort] catch {gets$sock} x list $x [fconfigure$sock -error] [fconfigure $sock -error] } -constraints {socket notOSX} -cleanup { catch {close$sock} } -match glob -result {{error reading "sock*": socket is not connected} {connection refused} {}} test socket-14.8.0 {pending [socket -async] and nonblocking [gets], server is IPv4} -setup { makeFile { fileevent stdin readable exit set server [socket -server accept -myaddr 127.0.0.1 0] proc accept {s h p} {puts $s ok; close$s; set ::x 1} puts [lindex [fconfigure $server -sockname] 2] flush stdout vwait x } script set fd [open |[list [interpreter] script] RDWR] set port [gets$fd] } -constraints {socket supported_inet localhost_v4} -body { set sock [socket -async localhost $port] fconfigure$sock -blocking 0 for {set i 0} {$i < 50} {incr i } { if {[catch {gets$sock} x] || $x ne "" || ![fblocked$sock]} break after 200 } set x } -cleanup { catch {close $fd} catch {close$sock} removeFile script } -result {ok} test socket-14.8.1 {pending [socket -async] and nonblocking [gets], server is IPv6} -setup { makeFile { fileevent stdin readable exit set server [socket -server accept -myaddr ::1 0] proc accept {s h p} {puts $s ok; close$s; set ::x 1} puts [lindex [fconfigure $server -sockname] 2] flush stdout vwait x } script set fd [open |[list [interpreter] script] RDWR] set port [gets$fd] } -constraints {socket supported_inet6 localhost_v6} -body { set sock [socket -async localhost $port] fconfigure$sock -blocking 0 for {set i 0} {$i < 50} {incr i } { if {[catch {gets$sock} x] || $x ne "" || ![fblocked$sock]} break after 200 } set x } -cleanup { catch {close $fd} catch {close$sock} removeFile script } -result {ok} test socket-14.8.2 {pending [socket -async] and nonblocking [gets], no listener} -body { set sock [socket -async localhost [randport]] fconfigure $sock -blocking 0 for {set i 0} {$i < 50} {incr i } { if {[catch {gets $sock} x] ||$x ne "" || ![fblocked $sock]} break after 200 } list$x [fconfigure $sock -error] [fconfigure$sock -error] } -constraints socket -cleanup { catch {close $sock} } -match glob -result {{error reading "sock*": socket is not connected} {connection refused} {}} test socket-14.9.0 {pending [socket -async] and blocking [puts], server is IPv4} -setup { makeFile { fileevent stdin readable exit after 10000 exit set server [socket -server accept -myaddr 127.0.0.1 0] proc accept {s h p} {set ::x$s} puts [lindex [fconfigure $server -sockname] 2] flush stdout vwait x puts [gets$x] } script set fd [open |[list [interpreter] script] RDWR] set port [gets $fd] } -constraints {socket supported_inet localhost_v4 notOSX} -body { set sock [socket -async localhost$port] puts $sock ok flush$sock list [fconfigure $sock -error] [gets$fd] } -cleanup { catch {close $fd} catch {close$sock} removeFile script } -result {{} ok} test socket-14.9.1 {pending [socket -async] and blocking [puts], server is IPv6} -setup { makeFile { fileevent stdin readable exit after 10000 exit set server [socket -server accept -myaddr ::1 0] proc accept {s h p} {set ::x $s} puts [lindex [fconfigure$server -sockname] 2] flush stdout vwait x puts [gets $x] } script set fd [open |[list [interpreter] script] RDWR] set port [gets$fd] } -constraints {socket supported_inet6 localhost_v6 notOSX} -body { set sock [socket -async localhost $port] puts$sock ok flush $sock list [fconfigure$sock -error] [gets $fd] } -cleanup { catch {close$fd} catch {close $sock} removeFile script } -result {{} ok} test socket-14.10.0 {pending [socket -async] and nonblocking [puts], server is IPv4} -setup { makeFile { fileevent stdin readable exit set server [socket -server accept -myaddr 127.0.0.1 0] proc accept {s h p} {set ::x$s} puts [lindex [fconfigure $server -sockname] 2] flush stdout vwait x puts [gets$x] } script set fd [open |[list [interpreter] script] RDWR] set port [gets $fd] set after [after$latency set x timeout] } -constraints {socket supported_inet localhost_v4} -body { set sock [socket -async localhost $port] fconfigure$sock -blocking 0 puts $sock ok flush$sock fileevent $fd readable {set x 1} vwait x list [fconfigure$sock -error] [gets $fd] } -cleanup { after cancel$after catch {close $fd} catch {close$sock} removeFile script } -result {{} ok} test socket-14.10.1 {pending [socket -async] and nonblocking [puts], server is IPv6} -setup { makeFile { fileevent stdin readable exit set server [socket -server accept -myaddr ::1 0] proc accept {s h p} {set ::x $s} puts [lindex [fconfigure$server -sockname] 2] flush stdout vwait x puts [gets $x] } script set fd [open |[list [interpreter] script] RDWR] set port [gets$fd] set after [after $latency set x timeout] } -constraints {socket supported_inet6 localhost_v6} -body { set sock [socket -async localhost$port] fconfigure $sock -blocking 0 puts$sock ok flush $sock fileevent$fd readable {set x 1} vwait x list [fconfigure $sock -error] [gets$fd] } -cleanup { after cancel $after catch {close$fd} catch {close $sock} removeFile script } -result {{} ok} test socket-14.11.0 {pending [socket -async] and nonblocking [puts], no listener, no flush} -setup { set after [after$latency set x timeout] } -body { set sock [socket -async localhost [randport]] fconfigure $sock -blocking 0 puts$sock ok fileevent $sock writable {set x 1} vwait x close$sock } -constraints socket -cleanup { after cancel $after catch {close$sock} unset -nocomplain x } -result {socket is not connected} -returnCodes 1 test socket-14.11.1 {pending [socket -async] and nonblocking [puts], no listener, flush} -setup { set after [after $latency set x timeout] } -body { set sock [socket -async localhost [randport]] fconfigure$sock -blocking 0 puts $sock ok flush$sock fileevent $sock writable {set x 1} vwait x close$sock } -constraints {socket nonPortable} -cleanup { after cancel $timeout catch {close$sock} unset -nocomplain x } -result {socket is not connected} -returnCodes 1 test socket-14.12 {[socket -async] background progress triggered by [fconfigure -error]} -body { set s [socket -async localhost [randport]] for {set i 0} {$i < 50} {incr i} { set x [fconfigure$s -error] if {$x != ""} break after 200 } set x } -constraints socket -cleanup { catch {close$s} unset -nocomplain x s } -result {connection refused} test socket-14.13 {testing writable event when quick failure} -body { # Test for bug 336441ed59 where a quick background fail was ignored # # Test only for windows as socket -async 255.255.255.255 fails # directly on unix # # The following connect should fail very quickly set a1 [after $latency {set x timeout}] set s [socket -async 255.255.255.255 43434] fileevent$s writable {set x writable} vwait x set x } -constraints {socket win supported_inet} -cleanup { catch {close $s} after cancel$a1 } -result writable test socket-14.14 {testing fileevent readable on failed async socket connect} -body { # Test for bug 581937ab1e set a1 [after $latency {set x timeout}] # This connect should fail set s [socket -async localhost [randport]] fileevent$s readable {set x readable} vwait x set x } -constraints socket -cleanup { catch {close $s} after cancel$a1 } -result readable test socket-14.15 {blocking read on async socket should not trigger event handlers} -setup { set subprocess [open "|[list [interpreter]]" r+] fconfigure $subprocess -blocking 0 -buffering none } -constraints socket -body { puts$subprocess { set s [socket -async localhost [randport]] set x ok fileevent $s writable {set x fail} catch {read$s} close $s puts$x exit } set after [after $latency set x timeout] fileevent$subprocess readable [list gets $subprocess x] vwait x return$x } -cleanup { catch {after cancel $after} if {![testConstraint win]} { catch {exec kill [pid$subprocess]} } catch {close $subprocess} unset -nocomplain x } -result ok # v4 and v6 is required to prevent that the async connect does not terminate # before the fconfigure command. There is always an additional ip to try. test socket-14.16 {empty -peername while [socket -async] connecting} -body { set client [socket -async localhost [randport]] fconfigure$client -peername } -constraints {socket localhost_v4 localhost_v6 notOSX} -cleanup { catch {close $client} } -result {} # v4 and v6 is required to prevent that the async connect does not terminate # before the fconfigure command. There is always an additional ip to try. test socket-14.17 {empty -sockname while [socket -async] connecting} -body { set client [socket -async localhost [randport]] fconfigure$client -sockname } -constraints {socket localhost_v4 localhost_v6 notOSX} -cleanup { catch {close $client} } -result {} # test for bug c6ed4acfd8: running async socket connect with other connect # established will block tcl as it goes in an infinite loop in vwait test socket-14.18 {bug c6ed4acfd8: running async socket connect made other connect block} -body { proc accept {channel address port} {} set port [randport] set ssock [socket -server accept$port] set csock1 [socket -async localhost [randport]] set csock2 [socket localhost $port] after 1000 {set done ok} vwait done } -constraints {socket notOSX} -cleanup { catch {close$ssock} catch {close $csock1} catch {close$csock2} } -result {} set num 0 set x {localhost {socket} 127.0.0.1 {supported_inet} ::1 {supported_inet6}} set resultok {-result "sock*" -match glob} set resulterr { -result {couldn't open socket: connection refused} -returnCodes 1 } foreach {servip sc} $x { foreach {cliip cc}$x { set constraints [list socket $sc$cc] set result $resulterr switch -- [lsort -unique [list$servip $cliip]] { localhost - 127.0.0.1 - ::1 { set result$resultok } {127.0.0.1 localhost} { if {[testConstraint localhost_v4]} { ................................................................................ } {::1 localhost} { if {[testConstraint localhost_v6]} { set result $resultok } } } test socket-15.1.$num "Connect to $servip from$cliip" -setup { set server [socket -server accept -myaddr $servip 0] proc accept {s h p} { close$s } set port [lindex [fconfigure $server -sockname] 2] } -constraints$constraints -body { set s [socket $cliip$port] } -cleanup { close $server catch {close$s} } {*}$result incr num } } ::tcltest::cleanupTests flush stdout return # Local Variables: # mode: tcl # fill-column: 78 # End:  Changes to tests/string.test.  221 222 223 224 225 226 227 228 229 230 231 232 233 234 .... 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028  test string-4.15 {string first, ability to two-byte encoded utf-8 chars} { # Test for a bug in Tcl 8.3 where test for all-single-byte-encoded # strings was incorrect, leading to an index returned by [string first] # which pointed past the end of the string. set uchar \u057e ;# character with two-byte encoding in utf-8 string first % %#$uchar$uchar#$uchar$uchar#% 3 } 8 test string-5.1 {string index} { list [catch {string index} msg]$msg } {1 {wrong # args: should be "string index string charIndex"}} test string-5.2 {string index} { list [catch {string index a b c} msg] $msg } {1 {wrong # args: should be "string index string charIndex"}} ................................................................................ set vv [string repeat {$x} $n] set vvs [string repeat {$x } $n] set r1 [string compare$xx [subst $vv]] set r2 [string compare$xx [eval "string cat $vvs"]] list$r1 $r2 } {0 0} # cleanup rename MemStress {} catch {rename foo {}} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End:   > > > > > > > > > > > > > > > > > > > > > > > >  221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 .... 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052  test string-4.15 {string first, ability to two-byte encoded utf-8 chars} { # Test for a bug in Tcl 8.3 where test for all-single-byte-encoded # strings was incorrect, leading to an index returned by [string first] # which pointed past the end of the string. set uchar \u057e ;# character with two-byte encoding in utf-8 string first % %#$uchar$uchar#$uchar$uchar#% 3 } 8 test string-4.17 {string first, corner case} { string first a aaa 4294967295 } {0} test string-4.18 {string first, corner case} { string first a aaa -1 } {0} test string-4.19 {string first, corner case} { string first a aaa end-5 } {0} test string-4.20 {string last, corner case} { string last a aaa 4294967295 } {-1} test string-4.21 {string last, corner case} { string last a aaa -1 } {-1} test string-4.22 {string last, corner case} { string last a aaa end-5 } {-1} test string-5.1 {string index} { list [catch {string index} msg]$msg } {1 {wrong # args: should be "string index string charIndex"}} test string-5.2 {string index} { list [catch {string index a b c} msg] $msg } {1 {wrong # args: should be "string index string charIndex"}} ................................................................................ set vv [string repeat {$x} $n] set vvs [string repeat {$x } $n] set r1 [string compare$xx [subst $vv]] set r2 [string compare$xx [eval "string cat $vvs"]] list$r1 $r2 } {0 0} test string-30.1.1 {[Bug ba921a8d98]: string cat} { string cat [set data [binary format a* hello]] [encoding convertto$data] [unset data] } hellohello test string-30.1.2 {[Bug ba921a8d98]: inplace cat by subst (compiled to "strcat" instruction)} { set x "[set data [binary format a* hello]][encoding convertto $data][unset data]" } hellohello # cleanup rename MemStress {} catch {rename foo {}} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End:  Changes to tests/tcltest.test.  904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 ... 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 .... 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 .... 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 .... 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330   set ::tcltest::loadFile$oldf } } removeFile load.tcl # [interpreter] test tcltest-13.1 {interpreter} { -constraints notValgrind -setup { #to do: Why is $::tcltest::tcltest being saved and restored here? set old$::tcltest::tcltest set ::tcltest::tcltest tcltest } -body { set f1 [interpreter] ................................................................................ } -result {tcltest tclsh tclsh} -cleanup { # writing ::tcltest::tcltest triggers a trace that sets up the stdio # 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. set ::tcltest::tcltest $old } } # -singleproc, [singleProcess] set spd [makeDirectory singleprocdir] makeFile { ................................................................................ test tcltest-21.2 {force a test command failure} { -body { test tcltest-21.2.0 { return 2 } {1} } -returnCodes 1 -result {bad option "1": must be -body, -cleanup, -constraints, -errorOutput, -match, -output, -result, -returnCodes, or -setup} } test tcltest-21.3 {test command with setup} { -setup { set foo 1 } -body { ................................................................................ -cleanup {set ::tcltest::currentFailure$fail} -body { test tcltest-21.7.0 {foo-4} { -foobar {} } } -returnCodes 1 -result {bad option "-foobar": must be -body, -cleanup, -constraints, -errorOutput, -match, -output, -result, -returnCodes, or -setup} } # alternate test command format (these are the same as 21.1-21.6, with the # exception of being in the all-inline format) test tcltest-21.7a {expect with glob} \ -body {list a b c d e} \ ................................................................................ -body { test tcltest-21.8.0 { return 2 } {1} } \ -returnCodes 1 \ -cleanup {set ::tcltest::currentFailure \$fail} \ -result {bad option "1": must be -body, -cleanup, -constraints, -errorOutput, -match, -output, -result, -returnCodes, or -setup} test tcltest-21.9 {test command with setup} \ -setup {set foo 1} \ -body {set foo} \ -cleanup {unset foo} \ -result {1}   |