Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch z_modifier Excluding Merge-Ins
This is equivalent to a diff from 49e104fa48 to 1a4479ca01
2018-02-14
| ||
20:22 | Merge TIP #476 check-in: 38ffcc50f4 user: jan.nijtmans tags: core-8-branch | |
15:33 | merge 8.7 Closed-Leaf check-in: 1a4479ca01 user: dgp tags: z_modifier | |
14:38 | Fix regression in [expr {0%$bignum}]. check-in: 85e6dc0a02 user: dgp tags: core-8-branch | |
2018-01-29
| ||
13:18 | merge 8.7 check-in: dc36231357 user: dgp tags: z_modifier | |
2017-11-13
| ||
08:59 | merge tcl-9-cleanup (and also a minor bug-fix from core-8-branch). check-in: b03c4194f0 user: jan.nijtmans tags: trunk | |
2017-11-09
| ||
15:47 | Rebase branch to trunk. check-in: f714eca8f2 user: dgp tags: dgp-refactor | |
14:44 | merge trunk check-in: d27981d722 user: dgp tags: no-wideint | |
14:40 | merge trunk Closed-Leaf check-in: 844ae11ba0 user: dgp tags: tcl-9-cleanup | |
13:46 | merge trunk check-in: a10fc87c05 user: dgp tags: dgp-properbytearray | |
12:52 | merge trunk check-in: 54f289e311 user: jan.nijtmans tags: novem | |
12:51 | merge core-8-branch check-in: 49e104fa48 user: jan.nijtmans tags: trunk | |
12:50 | merge core-8-6-branch check-in: ef4cc04bc1 user: jan.nijtmans tags: core-8-branch | |
2017-11-08
| ||
09:38 | merge core-8-branch check-in: 3885b08997 user: jan.nijtmans tags: trunk | |
Changes to .fossil-settings/crlf-glob.
︙ | |||
8 9 10 11 12 13 14 15 16 17 | 8 9 10 11 12 13 14 15 16 17 18 19 | + + | libtommath/*.vcproj tools/tcl.hpj.in tools/tcl.wse.in win/buildall.vc.bat win/coffbase.txt win/makefile.vc win/rules.vc win/rules-ext.vc win/targets.vc win/tcl.dsp win/tcl.dsw win/tcl.hpj.in |
Changes to .fossil-settings/crnl-glob.
︙ | |||
8 9 10 11 12 13 14 15 16 17 | 8 9 10 11 12 13 14 15 16 17 18 19 | + + | libtommath/*.vcproj tools/tcl.hpj.in tools/tcl.wse.in win/buildall.vc.bat win/coffbase.txt win/makefile.vc win/rules.vc win/rules-ext.vc win/targets.vc win/tcl.dsp win/tcl.dsw win/tcl.hpj.in |
Changes to .fossil-settings/ignore-glob.
︙ | |||
40 41 42 43 44 45 46 47 48 | 40 41 42 43 44 45 46 47 48 49 | + | unix/dltest.marker unix/tcl.pc unix/tclIndex unix/pkgs/* win/Debug* win/Release* win/pkgs/* win/coffbase.txt win/tcl.hpj win/nmhlp-out.txt |
Changes to .project.
1 2 | 1 2 3 4 5 6 7 8 9 10 | - + | <?xml version="1.0" encoding="UTF-8"?> <projectDescription> |
︙ |
Changes to README.
1 | 1 2 3 4 5 6 7 8 9 | - + | README: Tcl |
︙ |
Changes to changes.
︙ | |||
8230 8231 8232 8233 8234 8235 8236 | 8230 8231 8232 8233 8234 8235 8236 8237 8238 8239 8240 8241 8242 8243 8244 | - + | 2013-05-06 (platform support) Cygwin64 (nijtmans) 2013-05-15 (enhancement) Improved [list {*}...] compile (fellows) 2013-05-16 (platform support) mingw-4.0 (nijtmans) |
︙ | |||
8653 8654 8655 8656 8657 8658 8659 | 8653 8654 8655 8656 8657 8658 8659 8660 8661 8662 8663 8664 8665 8666 8667 | - + | 2016-05-13 (bug)[3154ea] Mem corruption in assembler exceptions (tkob,kenny) 2016-05-13 (bug) registry package support any Unicode env (nijtmans) => registry 1.3.2 2016-05-21 (bug)[f7d4e] [namespace delete] performance (fellows) |
︙ | |||
8792 8793 8794 8795 8796 8797 8798 8799 8800 8801 8802 8803 8804 8805 | 8792 8793 8794 8795 8796 8797 8798 8799 8800 8801 8802 8803 8804 8805 8806 8807 8808 8809 8810 8811 8812 8813 8814 8815 8816 8817 8818 8819 8820 8821 8822 8823 8824 8825 8826 8827 8828 8829 8830 8831 8832 8833 8834 8835 8836 8837 8838 8839 8840 8841 8842 8843 8844 | + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | 2017-07-06 (bug)[adb198] Plug memleak in TclJoinPath (sebres,porter) 2017-07-17 (bug)[fb2208] Repeatable tclIndex generation (wiedemann,nijtmans) --- Released 8.6.7, August 9, 2017 --- http://core.tcl.tk/tcl/ for details 2017-08-10 [array names -regexp] supports backrefs (goth) 2017-08-10 Fix gcc build failures due to #pragma placement (cassoff,fellows) 2017-08-29 (bug)[b50fb2] exec redir append stdout and stderr to file (coulter) 2017-08-31 (bug)[2a9465] http state 100 continue handling broken (oehlmann) => http 2.8.12 2017-09-02 (bug)[0e4d88] replace command, delete trace kills namespace (porter) 2017-10-19 (bug)[1a5655] [info * methods] includes mixins (fellows) 2017-10-23 tzdata updated to Olson's tzdata2017c (jima) 2017-10-24 (bug)[fc1409] segfault in method cloning, oo-15.15 (coulter,fellows) 2017-11-03 (bug)[6f2f83] More robust [load] for ReactOS (werner) 2017-11-08 (bug)[3298012] Stop crash when hash tables overflow 32 bits (porter) 2017-11-14 (bug)[5d6de6] Close failing case of [package prefer stable] (kupries) 2017-11-17 (bug)[fab924] Fix misleading [load] message on Windows (oehlmann) 2017-12-05 (bug)[4f6a1e] Crash when ensemble map and list are same (sebres) 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 Changes to 8.7a1 include all changes to the 8.6 line through 8.6.7, plus the following, which focuses on the high-level feature changes in this changeset (new minor version) rather than bug fixes: 2016-03-17 (bug)[0b8c38] socket accept callbacks always in global ns (porter) *** POTENTIAL INCOMPATIBILITY *** 2016-07-01 Hack accommodations for legacy Itcl 3 disabled (porter) 2016-07-12 Make TCL_HASH_TYPE build-time configurable (nijtmans) |
︙ | |||
8832 8833 8834 8835 8836 8837 8838 | 8871 8872 8873 8874 8875 8876 8877 8878 8879 8880 8881 | - | 2017-06-22 (TIP 470) Tcl_GetDefineContextObject();[oo::define [self]] (fellows) => TclOO 1.2.0 2017-06-23 (TIP 472) Support 0d as prefix of decimal numbers (iyer,griffin) 2017-08-31 (bug)[2a9465] http state 100 continue handling broken (oehlmann) |
Deleted compat/float.h.
| - - - - - - - - - - - - - - |
|
Changes to doc/Encoding.3.
︙ | |||
256 257 258 259 260 261 262 | 256 257 258 259 260 261 262 263 264 265 266 267 268 269 | - - - - | \fBTcl_ExternalToUtf\fR. .PP \fBTcl_WinUtfToTChar\fR and \fBTcl_WinTCharToUtf\fR are Windows-only convenience functions for converting between UTF-8 and Windows strings based on the TCHAR type which is by convention a Unicode character on Windows NT. |
︙ |
Changes to doc/Eval.3.
︙ | |||
172 173 174 175 176 177 178 | 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 | - + - - - + + + | \fBTCL_EVAL_DIRECT\fR flag is useful in situations where the contents of a value are going to change immediately, so the bytecodes will not be reused in a future execution. In this case, it is faster to execute the script directly. .TP 23 \fBTCL_EVAL_GLOBAL\fR . |
︙ |
Changes to doc/GetInt.3.
︙ | |||
60 61 62 63 64 65 66 67 | 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 | + + + - - + + | .QW \fB0d\fR then \fIsrc\fR is expected to be in decimal form; otherwise, if the first such characters are .QW \fB0o\fR then \fIsrc\fR is expected to be in octal form; otherwise, if the first such characters are .QW \fB0b\fR then \fIsrc\fR is expected to be in binary form; otherwise, if the first such character is .QW \fB0\fR then \fIsrc\fR |
︙ |
Changes to doc/IntObj.3.
︙ | |||
93 94 95 96 97 98 99 | 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 | - + | with which values might be exchanged. The C integral types for which Tcl provides value exchange routines are \fBint\fR, \fBlong int\fR, \fBTcl_WideInt\fR, and \fBmp_int\fR. The \fBint\fR and \fBlong int\fR types are provided by the C language standard. The \fBTcl_WideInt\fR type is a typedef defined to be whatever signed integral type covers at least the 64-bit integer range (-9223372036854775808 to 9223372036854775807). Depending on the platform and the C compiler, the actual type might be |
︙ |
Changes to doc/Interp.3.
︙ | |||
29 30 31 32 33 34 35 36 37 38 39 40 41 42 | 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 | + + + + + + + + + + + + + | structure. Callers of \fBTcl_CreateInterp\fR should use this pointer as an opaque token, suitable for nothing other than passing back to other routines in the Tcl interface. Accessing fields directly through the pointer as described below is no longer supported. The supported public routines \fBTcl_SetResult\fR, \fBTcl_GetResult\fR, \fBTcl_SetErrorLine\fR, \fBTcl_GetErrorLine\fR must be used instead. .PP For legacy programs and extensions no longer being maintained, compiles against the Tcl 8.6 header files are only possible with the compiler directives .CS #define USE_INTERP_RESULT .CE and/or .CS #define USE_INTERP_ERRORLINE .CE depending on which fields of the \fBTcl_Interp\fR struct are accessed. These directives may be embedded in code or supplied via compiler options. .PP The \fIresult\fR and \fIfreeProc\fR fields are used to return results or error messages from commands. This information is returned by command procedures back to \fBTcl_Eval\fR, and by \fBTcl_Eval\fR back to its callers. The \fIresult\fR field points to the string that represents the result or error message, and the \fIfreeProc\fR field tells how to dispose of the storage for the string when it is not needed anymore. |
︙ | |||
84 85 86 87 88 89 90 | 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 | - + | As part of processing each command, \fBTcl_Eval\fR initializes \fIinterp->result\fR and \fIinterp->freeProc\fR just before calling the command procedure for the command. The \fIfreeProc\fR field will be initialized to zero, and \fIinterp->result\fR will point to an empty string. Commands that do not return any value can simply leave the fields alone. Furthermore, the empty string pointed to by \fIresult\fR is actually |
︙ |
Changes to doc/NRE.3.
1 2 3 4 5 6 7 8 9 | 1 2 3 4 5 6 7 8 9 10 | + | .\" .\" Copyright (c) 2008 by Kevin B. Kenny. .\" Copyright (c) 2018 by Nathan Coulter. .\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH NRE 3 8.6 Tcl "Tcl Library Procedures" .so man.macros .BS |
︙ | |||
34 35 36 37 38 39 40 | 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 | - + - + - - + + + + - - + - - + + - - + + - - + - - + - + + - + - - - - - + + - - + + - + - - - - - + + + + + + + + + - - + + - - - - - - - - + - - - - - - + - - - - - + + + - - - + - - - - - - - - - - - - - - - - - - - - + + + + + + - - - - - - - - - - + + - + - - - + - - - + + - - - + - - - - + + - - - - - + + - - - + + - + - - - - + - - - - + - - - - + - - - - + - - - - + - + | .sp void \fBTcl_NRAddCallback\fR(\fIinterp, postProcPtr, data0, data1, data2, data3\fR) .fi .SH ARGUMENTS .AS Tcl_CmdDeleteProc *interp in .AP Tcl_Interp *interp in |
︙ | |||
224 225 226 227 228 229 230 | 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 | - - + + - - - - + + + - - + + - - - - - - - - - - - + - - - | return result; } \fBTcl_CreateObjCommand\fR(interp, "theCommand", \fITheCmdOldObjProc\fR, clientData, TheCmdDeleteProc); .CE .PP |
︙ | |||
280 281 282 283 284 285 286 | 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 | - - - - + - - - - + - - - - - - - - - - - - + + | /* \fIdata0 .. data3\fR are up to four one-word items to * pass to the postprocessing procedure */ return \fBTcl_NREvalObj\fR(interp, objPtr, 0); } .CE .PP |
Changes to doc/Object.3.
︙ | |||
253 254 255 256 257 258 259 | 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 | - + | \fBincr x\fR .CE .PP The \fBincr\fR command first gets an integer from \fIx\fR's value by calling \fBTcl_GetIntFromObj\fR. This procedure checks whether the value is already an integer value. Since it is not, it converts the value |
︙ |
Changes to doc/SetResult.3.
︙ | |||
193 194 195 196 197 198 199 200 201 202 203 204 205 206 | 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 | + + + + + + + + + + + + + | \fBTcl_FreeResult\fR performs part of the work of \fBTcl_ResetResult\fR. It frees up the memory associated with \fIinterp\fR's result. It also sets \fIinterp->freeProc\fR to zero, but does not change \fIinterp->result\fR or clear error state. \fBTcl_FreeResult\fR is most commonly used when a procedure is about to replace one result value with another. .SS "DIRECT ACCESS TO INTERP->RESULT" .PP It used to be legal for programs to directly read and write \fIinterp->result\fR to manipulate the interpreter result. The Tcl headers no longer permit this access by default, and C code still doing this must be updated to use supported routines \fBTcl_GetObjResult\fR, \fBTcl_GetStringResult\fR, \fBTcl_SetObjResult\fR, and \fBTcl_SetResult\fR. As a migration aid, access can be restored with the compiler directive .CS #define USE_INTERP_RESULT .CE but this is meant only to offer life support to otherwise dead code. .SH "THE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT" .PP \fBTcl_SetResult\fR's \fIfreeProc\fR argument specifies how the Tcl system is to manage the storage for the \fIresult\fR argument. If \fBTcl_SetResult\fR or \fBTcl_SetObjResult\fR are called at a time when \fIinterp\fR holds a string result, they do whatever is necessary to dispose of the old string result |
︙ |
Changes to doc/ToUpper.3.
︙ | |||
29 30 31 32 33 34 35 | 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 | - + | \fBTcl_UtfToLower\fR(\fIstr\fR) .sp int \fBTcl_UtfToTitle\fR(\fIstr\fR) .SH ARGUMENTS .AS char *str in/out .AP int ch in |
︙ |
Changes to doc/UniCharIsAlpha.3.
︙ | |||
44 45 46 47 48 49 50 | 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 | - + - + - - - | \fBTcl_UniCharIsUpper\fR(\fIch\fR) .sp int \fBTcl_UniCharIsWordChar\fR(\fIch\fR) .SH ARGUMENTS .AS int ch .AP int ch in |
︙ |
Changes to doc/Utf.3.
︙ | |||
73 74 75 76 77 78 79 | 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 | - + | \fBTcl_UtfBackslash\fR(\fIsrc, readPtr, dst\fR) .SH ARGUMENTS .AS "const Tcl_UniChar" *uniPattern in/out .AP char *buf out Buffer in which the UTF-8 representation of the Tcl_UniChar is stored. At most \fBTCL_UTF_MAX\fR bytes are stored in the buffer. .AP int ch in |
︙ |
Changes to doc/expr.n.
︙ | |||
46 47 48 49 50 51 52 | 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 | - + + + | An expression consists of a combination of operands, operators, parentheses and commas, possibly with whitespace between any of these elements, which is ignored. An integer operand may be specified in decimal (the normal case, the optional first two characters are \fB0d\fR), binary (the first two characters are \fB0b\fR), octal (the first two characters are \fB0o\fR), or hexadecimal |
︙ |
Changes to doc/format.n.
︙ | |||
79 80 81 82 83 84 85 | 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 | - - - + + + - - + + + | number if the first character is not a sign. .TP 10 \fB0\fR Specifies that the number should be padded on the left with zeroes instead of spaces. .TP 10 \fB#\fR |
︙ | |||
128 129 130 131 132 133 134 | 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 | - + + + - + | printed; if the string is longer than this then the trailing characters will be dropped. If the precision is specified with \fB*\fR rather than a number then the next argument to the \fBformat\fR command determines the precision; it must be a numeric string. .SS "OPTIONAL SIZE MODIFIER" .PP The fifth part of a conversion specifier is a size modifier, |
︙ | |||
167 168 169 170 171 172 173 | 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 | - + | Convert integer to unsigned hexadecimal string, using digits .QW 0123456789abcdef for \fBx\fR and .QW 0123456789ABCDEF for \fBX\fR). .TP 10 \fBb\fR |
︙ | |||
196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 | 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 | + + + + + + + + + + + - + - | \fBg\fR or \fBG\fR If the exponent is less than \-4 or greater than or equal to the precision, then convert number as for \fB%e\fR or \fB%E\fR. Otherwise convert as for \fB%f\fR. Trailing zeroes and a trailing decimal point are omitted. .TP 10 \fBa\fR or \fBA\fR Convert double to hexadecimal notation in the form \fI0x1.yyy\fBp\(+-\fIzz\fR, where the number of \fIy\fR's is determined by the precision (default: 13). If the \fBA\fR form is used then the hex characters are printed in uppercase. .TP 10 \fB%\fR No conversion: just insert \fB%\fR. .TP 10 \fBp\fR Shorthand form for \fB0x%zx\fR, so it outputs the integer in hexadecimal form with \fB0x\fR prefix. .SH "DIFFERENCES FROM ANSI SPRINTF" .PP The behavior of the format command is the same as the ANSI C \fBsprintf\fR procedure except for the following differences: .IP [1] Tcl guarantees that it will be working with UNICODE characters. .IP [2] |
︙ |
Changes to doc/scan.n.
︙ | |||
220 221 222 223 224 225 226 | 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 | - + + + - + | hexadecimal conversions with substring sizes: .PP .CS set string "#08D03F" \fBscan\fR $string "#%2x%2x%2x" r g b .CE .PP |
︙ |
Changes to generic/tcl.decls.
︙ | |||
28 29 30 31 32 33 34 | 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 | - + | # to preserve backwards compatibility. declare 0 { int Tcl_PkgProvideEx(Tcl_Interp *interp, const char *name, const char *version, const void *clientData) } declare 1 { |
︙ | |||
150 151 152 153 154 155 156 | 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 | - + | } declare 35 { int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr) } declare 36 { int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, |
︙ | |||
281 282 283 284 285 286 287 | 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 | - + - + - + | } declare 75 { int Tcl_AsyncReady(void) } declare 76 { void Tcl_BackgroundError(Tcl_Interp *interp) } |
︙ | |||
348 349 350 351 352 353 354 | 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 | - + | } declare 93 { void Tcl_CreateExitHandler(Tcl_ExitProc *proc, ClientData clientData) } declare 94 { Tcl_Interp *Tcl_CreateInterp(void) } |
︙ | |||
457 458 459 460 461 462 463 | 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 | - + - + - | declare 125 { void Tcl_DStringStartSublist(Tcl_DString *dsPtr) } declare 126 { int Tcl_Eof(Tcl_Channel chan) } declare 127 { |
︙ | |||
525 526 527 528 529 530 531 | 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 | - - + + - + | int Tcl_Flush(Tcl_Channel chan) } declare 147 { void Tcl_FreeResult(Tcl_Interp *interp) } declare 148 { int Tcl_GetAlias(Tcl_Interp *interp, const char *slaveCmd, |
︙ | |||
555 556 557 558 559 560 561 | 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 | - + - + - + | declare 154 { ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan) } declare 155 { int Tcl_GetChannelMode(Tcl_Channel chan) } declare 156 { |
︙ | |||
619 620 621 622 623 624 625 | 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 | - + - + - + | declare 172 { Tcl_Interp *Tcl_GetSlave(Tcl_Interp *interp, const char *slaveName) } declare 173 { Tcl_Channel Tcl_GetStdChannel(int type) } declare 174 { |
︙ | |||
659 660 661 662 663 664 665 | 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 | - + | int Tcl_InterpDeleted(Tcl_Interp *interp) } declare 185 { int Tcl_IsSafe(Tcl_Interp *interp) } # Obsolete, use Tcl_FSJoinPath declare 186 { |
︙ | |||
682 683 684 685 686 687 688 | 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 | - + - + | declare 190 { int Tcl_MakeSafe(Tcl_Interp *interp) } declare 191 { Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket) } declare 192 { |
︙ | |||
726 727 728 729 730 731 732 | 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 | - + | declare 202 { void Tcl_PrintDouble(Tcl_Interp *interp, double value, char *dst) } declare 203 { int Tcl_PutEnv(const char *assignment) } declare 204 { |
︙ | |||
762 763 764 765 766 767 768 | 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 | - + - - + | } declare 214 { int Tcl_RegExpMatch(Tcl_Interp *interp, const char *text, const char *pattern) } declare 215 { void Tcl_RegExpRange(Tcl_RegExp regexp, int index, |
︙ | |||
833 834 835 836 837 838 839 | 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 867 868 869 870 871 872 873 874 875 876 | - + - + - + - + - + - + - - + | declare 235 { void Tcl_SetObjResult(Tcl_Interp *interp, Tcl_Obj *resultObjPtr) } declare 236 { void Tcl_SetStdChannel(Tcl_Channel channel, int type) } declare 237 { |
︙ | |||
941 942 943 944 945 946 947 | 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 | - + - + - - + + - + - + - + - + - + - + | } declare 265 { int Tcl_DumpActiveMemory(const char *fileName) } declare 266 { void Tcl_ValidateAllMemory(const char *file, int line) } |
︙ | |||
1083 1084 1085 1086 1087 1088 1089 | 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 | - + | declare 300 { Tcl_ThreadId Tcl_GetCurrentThread(void) } declare 301 { Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name) } declare 302 { |
︙ | |||
1159 1160 1161 1162 1163 1164 1165 | 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 | - + - + - + - + - + | declare 323 { Tcl_UniChar Tcl_UniCharToUpper(int ch) } declare 324 { int Tcl_UniCharToUtf(int ch, char *buf) } declare 325 { |
︙ | |||
1210 1211 1212 1213 1214 1215 1216 | 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 | - - + + - + | } declare 339 { int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr) } declare 340 { char *Tcl_GetString(Tcl_Obj *objPtr) } |
︙ | |||
1262 1263 1264 1265 1266 1267 1268 | 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 | - + - + - + | Tcl_UniChar *Tcl_UtfToUniCharDString(const char *src, int length, Tcl_DString *dsPtr) } declare 356 { Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj, int flags) } |
︙ | |||
1404 1405 1406 1407 1408 1409 1410 | 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 | - + | declare 396 { Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan) } declare 397 { int Tcl_ChannelBuffered(Tcl_Channel chan) } declare 398 { |
︙ | |||
1544 1545 1546 1547 1548 1549 1550 | 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 | - + - + | # introduced in 8.4a3 declare 434 { Tcl_UniChar *Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr) } # TIP#15 (math function introspection) dkf |
︙ |
Changes to generic/tcl.h.
︙ | |||
48 49 50 51 52 53 54 | 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 | - - + + - + - - + + | * 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) */ |
︙ | |||
133 134 135 136 137 138 139 | 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 | - + | * written for older versions of Tcl where the macros permitted * support for the varargs.h system as well as stdarg.h . * * New code should just directly be written to use stdarg.h conventions. */ #include <stdarg.h> |
︙ | |||
250 251 252 253 254 255 256 | 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 | - + - - - - - - - - - - - - - - - - - - - - - - - + + + + - + | * The following _ANSI_ARGS_ macro is to support old extensions * written for older versions of Tcl where it permitted support * for compilers written in the pre-prototype era of C. * * New code should use prototypes. */ |
︙ | |||
314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 | 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 | + - - + - - - + - - + - - - | /* *---------------------------------------------------------------------------- * The following code is copied from winnt.h. If we don't replicate it here, * then <windows.h> can't be included after tcl.h, since tcl.h also defines * VOID. This block is skipped under Cygwin and Mingw. */ #if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 #if defined(_WIN32) && !defined(HAVE_WINNT_IGNORE_VOID) #ifndef VOID #define VOID void typedef char CHAR; typedef short SHORT; typedef long LONG; #endif #endif /* _WIN32 && !HAVE_WINNT_IGNORE_VOID */ /* * Macro to use instead of "void" for arguments that must have type "void *" * in ANSI C; maps them to type "char *" in non-ANSI systems. */ #ifndef __VXWORKS__ |
︙ | |||
392 393 394 395 396 397 398 399 | 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 | + + + - - + - + - - - - - - + + + + - - - - - + + + + - - + - - - - - - + + + + + - | * sprintf(...,"%" TCL_LL_MODIFIER "d",...). */ #if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG) # if defined(_WIN32) # define TCL_WIDE_INT_TYPE __int64 # define TCL_LL_MODIFIER "I64" # if defined(_WIN64) # define TCL_Z_MODIFIER "I" # endif # elif defined(__GNUC__) |
︙ | |||
488 489 490 491 492 493 494 | 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 | - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | * "real" definition in tclInt.h. * * Note: Tcl_ObjCmdProc functions do not directly set result and freeProc. * Instead, they set a Tcl_Obj member in the "real" structure that can be * accessed with Tcl_GetObjResult() and Tcl_SetObjResult(). */ |
︙ | |||
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 | 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 | + + + + + + + + + - + - + | #define TCL_OK 0 #define TCL_ERROR 1 #define TCL_RETURN 2 #define TCL_BREAK 3 #define TCL_CONTINUE 4 #if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 #define TCL_RESULT_SIZE 200 #endif /* *---------------------------------------------------------------------------- * Flags to control what substitutions are performed by Tcl_SubstObj(): */ #define TCL_SUBST_COMMANDS 001 #define TCL_SUBST_VARIABLES 002 #define TCL_SUBST_BACKSLASHES 004 #define TCL_SUBST_ALL 007 /* * Argument descriptors for math function callbacks in expressions: */ #if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 typedef enum { TCL_INT, TCL_DOUBLE, TCL_EITHER, TCL_WIDE_INT } Tcl_ValueType; typedef struct Tcl_Value { Tcl_ValueType type; /* Indicates intValue or doubleValue is valid, * or both. */ long intValue; /* Integer value. */ double doubleValue; /* Double-precision floating value. */ Tcl_WideInt wideValue; /* Wide (min. 64-bit) integer value. */ } Tcl_Value; #else #define Tcl_ValueType void /* Just enough to prevent compilation error in Tcl */ #define Tcl_Value void /* Just enough to prevent compilation error in Tcl */ #endif /* * Forward declaration of Tcl_Obj to prevent an error when the forward * reference to Tcl_Obj is encountered in the function types declared below. */ struct Tcl_Obj; /* *---------------------------------------------------------------------------- * Function types defined by Tcl: */ typedef int (Tcl_AppInitProc) (Tcl_Interp *interp); typedef int (Tcl_AsyncProc) (ClientData clientData, Tcl_Interp *interp, int code); typedef void (Tcl_ChannelProc) (ClientData clientData, int mask); typedef void (Tcl_CloseProc) (ClientData data); typedef void (Tcl_CmdDeleteProc) (ClientData clientData); typedef int (Tcl_CmdProc) (ClientData clientData, Tcl_Interp *interp, |
︙ | |||
722 723 724 725 726 727 728 | 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 | - + | typedef void (Tcl_PanicProc) (const char *format, ...); typedef void (Tcl_TcpAcceptProc) (ClientData callbackData, Tcl_Channel chan, char *address, int port); typedef void (Tcl_TimerProc) (ClientData clientData); typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr); typedef void (Tcl_UpdateStringProc) (struct Tcl_Obj *objPtr); typedef char * (Tcl_VarTraceProc) (ClientData clientData, Tcl_Interp *interp, |
︙ | |||
821 822 823 824 825 826 827 | 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 | - - + + + + + + + + + + + - + | void Tcl_IncrRefCount(Tcl_Obj *objPtr); void Tcl_DecrRefCount(Tcl_Obj *objPtr); int Tcl_IsShared(Tcl_Obj *objPtr); /* *---------------------------------------------------------------------------- |
︙ | |||
950 951 952 953 954 955 956 | 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 | - + | char staticSpace[TCL_DSTRING_STATIC_SIZE]; /* Space to use in common case where string is * small. */ } Tcl_DString; #define Tcl_DStringLength(dsPtr) ((dsPtr)->length) #define Tcl_DStringValue(dsPtr) ((dsPtr)->string) |
︙ | |||
1078 1079 1080 1081 1082 1083 1084 | 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 | - + | /* * The TCL_PARSE_PART1 flag is deprecated and has no effect. The part1 is now * always parsed whenever the part2 is NULL. (This is to avoid a common error * when converting code to use the new object based APIs and forgetting to * give the flag) */ |
︙ | |||
1431 1432 1433 1434 1435 1436 1437 | 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 | - + - + | typedef int (Tcl_DriverCloseProc) (ClientData instanceData, Tcl_Interp *interp); typedef int (Tcl_DriverClose2Proc) (ClientData instanceData, Tcl_Interp *interp, int flags); typedef int (Tcl_DriverInputProc) (ClientData instanceData, char *buf, int toRead, int *errorCodePtr); typedef int (Tcl_DriverOutputProc) (ClientData instanceData, |
︙ | |||
1931 1932 1933 1934 1935 1936 1937 | 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 | - + | * is described by a TCL_TOKEN_SUB_EXPR token * followed by the TCL_TOKEN_OPERATOR token for * the operator, then TCL_TOKEN_SUB_EXPR tokens * for the left then the right operands. * TCL_TOKEN_OPERATOR - The token describes one expression operator. * An operator might be the name of a math * function such as "abs". A TCL_TOKEN_OPERATOR |
︙ | |||
2510 2511 2512 2513 2514 2515 2516 | 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 | - - - - - - | Tcl_DbNewLongObj((val)!=0, __FILE__, __LINE__) # undef Tcl_NewByteArrayObj # define Tcl_NewByteArrayObj(bytes, len) \ Tcl_DbNewByteArrayObj(bytes, len, __FILE__, __LINE__) # undef Tcl_NewDoubleObj # define Tcl_NewDoubleObj(val) \ Tcl_DbNewDoubleObj(val, __FILE__, __LINE__) |
︙ | |||
2581 2582 2583 2584 2585 2586 2587 | 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 | - + - + | #endif /* TCL_THREADS */ /* *---------------------------------------------------------------------------- * Deprecated Tcl functions: */ |
︙ |
Changes to generic/tclAlloc.c.
︙ | |||
657 658 659 660 661 662 663 | 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 | - + - - - - + + + + | fprintf(stderr, " %u", j); } totalFree += ((size_t)j) * (1 << (i + 3)); } fprintf(stderr, "\nused:\t"); for (i = 0; i < NBUCKETS; i++) { |
︙ |
Changes to generic/tclAssembly.c.
︙ | |||
4262 4263 4264 4265 4266 4267 4268 | 4262 4263 4264 4265 4266 4267 4268 4269 4270 4271 4272 4273 4274 4275 4276 | - + | Tcl_AddErrorInfo(interp, "\n in assembly code between lines "); lineNo = Tcl_NewIntObj(bbPtr->startLine); Tcl_IncrRefCount(lineNo); Tcl_AppendObjToErrorInfo(interp, lineNo); Tcl_AddErrorInfo(interp, " and "); if (bbPtr->successor1 != NULL) { |
︙ |
Changes to generic/tclBasic.c.
︙ | |||
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 | 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 | + + + + | static Tcl_ObjCmdProc ExprBoolFunc; static Tcl_ObjCmdProc ExprCeilFunc; static Tcl_ObjCmdProc ExprDoubleFunc; static Tcl_ObjCmdProc ExprEntierFunc; static Tcl_ObjCmdProc ExprFloorFunc; static Tcl_ObjCmdProc ExprIntFunc; static Tcl_ObjCmdProc ExprIsqrtFunc; static Tcl_ObjCmdProc ExprMaxFunc; static Tcl_ObjCmdProc ExprMinFunc; static Tcl_ObjCmdProc ExprRandFunc; static Tcl_ObjCmdProc ExprRoundFunc; static Tcl_ObjCmdProc ExprSqrtFunc; static Tcl_ObjCmdProc ExprSrandFunc; static Tcl_ObjCmdProc ExprUnaryFunc; static Tcl_ObjCmdProc ExprWideFunc; static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected, int actual, Tcl_Obj *const *objv); static Tcl_NRPostProc NRCoroutineCallerCallback; static Tcl_NRPostProc NRCoroutineExitCallback; static Tcl_NRPostProc NRCommand; #if !defined(TCL_NO_DEPRECATED) static Tcl_ObjCmdProc OldMathFuncProc; static void OldMathFuncDeleteProc(ClientData clientData); #endif /* !defined(TCL_NO_DEPRECATED) */ static void ProcessUnexpectedResult(Tcl_Interp *interp, int returnCode); static int RewindCoroutine(CoroutineData *corPtr, int result); static void TEOV_SwitchVarFrame(Tcl_Interp *interp); static void TEOV_PushExceptionHandlers(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); static inline Command * TEOV_LookupCmdFromObj(Tcl_Interp *interp, |
︙ | |||
199 200 201 202 203 204 205 | 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 | - + | /* * Commands in the generic core. */ {"append", Tcl_AppendObjCmd, TclCompileAppendCmd, NULL, CMD_IS_SAFE}, {"apply", Tcl_ApplyObjCmd, NULL, TclNRApplyObjCmd, CMD_IS_SAFE}, {"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, CMD_IS_SAFE}, |
︙ | |||
230 231 232 233 234 235 236 | 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 | - + | {"lrange", Tcl_LrangeObjCmd, TclCompileLrangeCmd, NULL, CMD_IS_SAFE}, {"lrepeat", Tcl_LrepeatObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lreplace", Tcl_LreplaceObjCmd, TclCompileLreplaceCmd, NULL, CMD_IS_SAFE}, {"lreverse", Tcl_LreverseObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lsearch", Tcl_LsearchObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, CMD_IS_SAFE}, {"lsort", Tcl_LsortObjCmd, NULL, NULL, CMD_IS_SAFE}, |
︙ | |||
317 318 319 320 321 322 323 324 325 326 327 328 329 330 | 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 | + + | { "floor", ExprFloorFunc, NULL }, { "fmod", ExprBinaryFunc, (ClientData) fmod }, { "hypot", ExprBinaryFunc, (ClientData) hypot }, { "int", ExprIntFunc, NULL }, { "isqrt", ExprIsqrtFunc, NULL }, { "log", ExprUnaryFunc, (ClientData) log }, { "log10", ExprUnaryFunc, (ClientData) log10 }, { "max", ExprMaxFunc, NULL }, { "min", ExprMinFunc, NULL }, { "pow", ExprBinaryFunc, (ClientData) pow }, { "rand", ExprRandFunc, NULL }, { "round", ExprRoundFunc, NULL }, { "sin", ExprUnaryFunc, (ClientData) sin }, { "sinh", ExprUnaryFunc, (ClientData) sinh }, { "sqrt", ExprSqrtFunc, NULL }, { "srand", ExprSrandFunc, NULL }, |
︙ | |||
506 507 508 509 510 511 512 | 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 | + - - + + + - - + + - | * (whose name is ""; an alias is "::"). This also initializes the Tcl * object type table and other object management code. */ iPtr = ckalloc(sizeof(Interp)); interp = (Tcl_Interp *) iPtr; #ifdef TCL_NO_DEPRECATED |
︙ | |||
568 569 570 571 572 573 574 575 576 577 578 579 580 581 | 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 | + + + + + + | TclNewLiteralStringObj(iPtr->ecVar, "::errorCode"); Tcl_IncrRefCount(iPtr->ecVar); iPtr->returnLevel = 1; iPtr->returnCode = TCL_OK; iPtr->rootFramePtr = NULL; /* Initialise as soon as :: is available */ iPtr->lookupNsPtr = NULL; #ifndef TCL_NO_DEPRECATED iPtr->appendResult = NULL; iPtr->appendAvl = 0; iPtr->appendUsed = 0; #endif Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS); iPtr->packageUnknown = NULL; /* TIP #268 */ #if (TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE) if (getenv("TCL_PKG_PREFER_LATEST") == NULL) { |
︙ | |||
597 598 599 600 601 602 603 604 605 606 607 608 609 610 | 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 | + + + | iPtr->activeCmdTracePtr = NULL; iPtr->activeInterpTracePtr = NULL; iPtr->assocData = NULL; iPtr->execEnvPtr = NULL; /* Set after namespaces initialized. */ iPtr->emptyObjPtr = Tcl_NewObj(); /* Another empty object. */ Tcl_IncrRefCount(iPtr->emptyObjPtr); #ifndef TCL_NO_DEPRECATED iPtr->resultSpace[0] = 0; #endif iPtr->threadId = Tcl_GetCurrentThread(); /* TIP #378 */ #ifdef TCL_INTERP_DEBUG_FRAME iPtr->flags |= INTERP_DEBUG_FRAME; #else if (getenv("TCL_INTERP_DEBUG_FRAME") != NULL) { |
︙ | |||
706 707 708 709 710 711 712 713 714 715 716 717 718 719 | 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 | + + + + + + | statsPtr->numLiteralsCreated = 0; statsPtr->totalLitStringBytes = 0.0; statsPtr->currentLitStringBytes = 0.0; memset(statsPtr->literalCount, 0, sizeof(statsPtr->literalCount)); #endif /* TCL_COMPILE_STATS */ /* * Initialise the stub table pointer. */ iPtr->stubTable = &tclStubs; /* * Initialize the ensemble error message rewriting support. */ TclResetRewriteEnsemble(interp, 1); /* |
︙ | |||
930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 | 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 | + + | /* * Set up other variables such as tcl_version and tcl_library */ Tcl_SetVar2(interp, "tcl_patchLevel", NULL, TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "tcl_version", NULL, TCL_VERSION, TCL_GLOBAL_ONLY); #if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 Tcl_TraceVar2(interp, "tcl_precision", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, TclPrecTraceProc, NULL); #endif /* !TCL_NO_DEPRECATED */ TclpSetVariables(interp); #ifdef TCL_THREADS /* * The existence of the "threaded" element of the tcl_platform array * indicates that this particular Tcl shell has been compiled with threads * turned on. Using "info exists tcl_platform(threaded)" a Tcl script can |
︙ | |||
1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 | 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 | + | /* * Free up the result *after* deleting variables, since variable deletion * could have transferred ownership of the result string to Tcl. */ Tcl_FreeResult(interp); iPtr->result = NULL; Tcl_DecrRefCount(iPtr->objResultPtr); iPtr->objResultPtr = NULL; Tcl_DecrRefCount(iPtr->ecVar); if (iPtr->errorCode) { Tcl_DecrRefCount(iPtr->errorCode); iPtr->errorCode = NULL; } |
︙ | |||
1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 | 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 | + + + + + + | Tcl_DecrRefCount(iPtr->upLiteral); Tcl_DecrRefCount(iPtr->callLiteral); Tcl_DecrRefCount(iPtr->innerLiteral); Tcl_DecrRefCount(iPtr->innerContext); if (iPtr->returnOpts) { Tcl_DecrRefCount(iPtr->returnOpts); } #ifndef TCL_NO_DEPRECATED if (iPtr->appendResult != NULL) { ckfree(iPtr->appendResult); iPtr->appendResult = NULL; } #endif TclFreePackageInfo(iPtr); while (iPtr->tracePtr != NULL) { Tcl_DeleteTrace((Tcl_Interp *) iPtr, (Tcl_Trace) iPtr->tracePtr); } if (iPtr->execEnvPtr != NULL) { TclDeleteExecEnv(iPtr->execEnvPtr); } |
︙ | |||
2071 2072 2073 2074 2075 2076 2077 | 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 | - + - + | } else { nsPtr = iPtr->globalNsPtr; tail = cmdName; } hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew); |
︙ | |||
2218 2219 2220 2221 2222 2223 2224 | 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 | - + + - - - - - + - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - + - + - + + | * qualifiers, the new command is put in the * specified namespace; otherwise it is put in * the global namespace. */ Tcl_ObjCmdProc *proc, /* Object-based function to associate with * name. */ ClientData clientData, /* Arbitrary value to pass to object * function. */ |
︙ | |||
2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 | 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 | + + + + + + - | * intact. */ cmdPtr->refCount++; if (cmdPtr->importRefPtr) { cmdPtr->flags |= CMD_REDEF_IN_PROGRESS; } /* Make sure namespace doesn't get deallocated. */ cmdPtr->nsPtr->refCount++; Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr); nsPtr = (Namespace *) TclEnsureNamespace(interp, (Tcl_Namespace *)cmdPtr->nsPtr); TclNsDecrRefCount(cmdPtr->nsPtr); if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) { oldRefPtr = cmdPtr->importRefPtr; cmdPtr->importRefPtr = NULL; } TclCleanupCommandMacro(cmdPtr); deleted = 1; } |
︙ | |||
2340 2341 2342 2343 2344 2345 2346 | 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 | - + | * being registered with the namespace's command table. During BC * compilation, the so-resolved command turns into a CmdName literal. * Without invalidating a possible CmdName literal here explicitly, * such literals keep being reused while pointing to overhauled * commands. */ |
︙ | |||
2455 2456 2457 2458 2459 2460 2461 | 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 | - + | * "Wrapper" Tcl_CmdProc used to call an existing object-based * Tcl_ObjCmdProc if no string-based function exists for a command. A * pointer to this function is stored as the Tcl_CmdProc in a Command * structure. It simply turns around and calls the object Tcl_ObjCmdProc * in the Command structure. * * Results: |
︙ | |||
2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 | 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 | + + + + + + + | if (cmdPtr->objProc != NULL) { result = cmdPtr->objProc(cmdPtr->objClientData, interp, argc, objv); } else { result = Tcl_NRCallObjProc(interp, cmdPtr->nreProc, cmdPtr->objClientData, argc, objv); } /* * Move the interpreter's object result to the string result, then reset * the object result. */ (void) Tcl_GetStringResult(interp); /* * Decrement the ref counts for the argument objects created above, then * free the objv array if malloc'ed storage was used. */ for (i = 0; i < argc; i++) { objPtr = objv[i]; |
︙ | |||
2563 2564 2565 2566 2567 2568 2569 | 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 | - - - - - + - + + + + + | Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't %s \"%s\": command doesn't exist", ((newName == NULL)||(*newName == '\0'))? "delete":"rename", oldName)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, NULL); return TCL_ERROR; } |
︙ | |||
3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 | 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 | + + | cmdPtr->flags |= CMD_IS_DELETED; /* * Call trace functions for the command being deleted. Then delete its * traces. */ cmdPtr->nsPtr->refCount++; if (cmdPtr->tracePtr != NULL) { CommandTrace *tracePtr; CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE); /* * Now delete these traces. |
︙ | |||
3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 | 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 | + | /* * The list of command exported from the namespace might have changed. * However, we do not need to recompute this just yet; next time we need * the info will be soon enough. */ TclInvalidateNsCmdLookup(cmdPtr->nsPtr); TclNsDecrRefCount(cmdPtr->nsPtr); /* * If the command being deleted has a compile function, increment the * interpreter's compileEpoch to invalidate its compiled code. This makes * sure that we don't later try to execute old code compiled with * command-specific (i.e., inline) bytecodes for the now-deleted command. * This field is checked in Tcl_EvalObj and ObjInterpProc, and code whose |
︙ | |||
3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 3465 3466 3467 | 3518 3519 3520 3521 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 | + | * an instruction specific to the replaced function. In addition, * redefioning a non-builtin function will force existing code to be * invalidated if the number of arguments has changed. * *---------------------------------------------------------------------- */ #if !defined(TCL_NO_DEPRECATED) void Tcl_CreateMathFunc( Tcl_Interp *interp, /* Interpreter in which function is to be * available. */ const char *name, /* Name of function (e.g. "sin"). */ int numArgs, /* Nnumber of arguments required by * function. */ |
︙ | |||
3504 3505 3506 3507 3508 3509 3510 | 3569 3570 3571 3572 3573 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 | - + | * Whatever the math function does. * *---------------------------------------------------------------------- */ static int OldMathFuncProc( |
︙ | |||
3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 | 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 | + | /* * We have a non-numeric argument. */ Tcl_SetObjResult(interp, Tcl_NewStringObj( "argument to math function didn't have numeric value", -1)); TclCheckBadOctal(interp, TclGetString(valuePtr)); ckfree(args); return TCL_ERROR; } /* * Copy the object's numeric value to the argument record, converting * it if necessary. |
︙ | |||
3616 3617 3618 3619 3620 3621 3622 | 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 | - + | } /* * Return the result of the call. */ if (funcResult.type == TCL_INT) { |
︙ | |||
3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 | 3850 3851 3852 3853 3854 3855 3856 3857 3858 3859 3860 3861 3862 3863 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 | + - + - - + + | result = Tcl_NewObj(); } Tcl_DecrRefCount(script); Tcl_RestoreInterpState(interp, state); return result; } #endif /* !defined(TCL_NO_DEPRECATED) */ /* *---------------------------------------------------------------------- * * TclInterpReady -- * * Check if an interpreter is ready to eval commands or scripts, i.e., if * it was not deleted and if the nesting level is not too high. * * Results: * The return value is TCL_OK if it the interpreter is ready, TCL_ERROR * otherwise. * * Side effects: |
︙ | |||
4391 4392 4393 4394 4395 4396 4397 4398 4399 4400 4401 4402 4403 4404 4405 4406 4407 | 4458 4459 4460 4461 4462 4463 4464 4465 4466 4467 4468 4469 4470 4471 4472 4473 4474 4475 4476 4477 4478 4479 4480 4481 4482 4483 4484 4485 4486 4487 4488 4489 4490 4491 | + + + + + + + + + + + + + + + + + | TclNRRunCallbacks( Tcl_Interp *interp, int result, struct NRE_callback *rootPtr) /* All callbacks down to rootPtr not inclusive * are to be run. */ { Interp *iPtr = (Interp *) interp; NRE_callback *callbackPtr; Tcl_NRPostProc *procPtr; /* * If the interpreter has a non-empty string result, the result object is * either empty or stale because some function set interp->result * directly. If so, move the string result to the result object, then * reset the string result. * * This only needs to be done for the first item in the list: all other * are for NR function calls, and those are Tcl_Obj based. */ if (*(iPtr->result) != 0) { (void) Tcl_GetObjResult(interp); } /* This is the trampoline. */ while (TOP_CB(interp) != rootPtr) { callbackPtr = TOP_CB(interp); procPtr = callbackPtr->procPtr; TOP_CB(interp) = callbackPtr->nextPtr; result = procPtr(callbackPtr->data, interp, result); TCLNR_FREE(interp, callbackPtr); } |
︙ | |||
4527 4528 4529 4530 4531 4532 4533 | 4611 4612 4613 4614 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 4625 | - + | Interp *iPtr = (Interp *) interp; int allowExceptions = (PTR2INT(data[0]) & TCL_ALLOW_EXCEPTIONS); if (result != TCL_OK) { if (result == TCL_RETURN) { result = TclUpdateReturnInfo(iPtr); } |
︙ | |||
4708 4709 4710 4711 4712 4713 4714 | 4792 4793 4794 4795 4796 4797 4798 4799 4800 4801 4802 4803 4804 4805 4806 | - + | Command **cmdPtrPtr, Tcl_Obj *commandPtr, int objc, Tcl_Obj *const objv[]) { Interp *iPtr = (Interp *) interp; Command *cmdPtr = *cmdPtrPtr; |
︙ | |||
4851 4852 4853 4854 4855 4856 4857 4858 4859 4860 4861 4862 4863 4864 | 4935 4936 4937 4938 4939 4940 4941 4942 4943 4944 4945 4946 4947 4948 4949 | + | int count) /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ { return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1, NULL, NULL); } #if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 /* *---------------------------------------------------------------------- * * Tcl_EvalTokens -- * * Given an array of tokens parsed from a Tcl command (e.g., the tokens * that make up a word or the index for an array variable) this function |
︙ | |||
4898 4899 4900 4901 4902 4903 4904 4905 4906 4907 4908 4909 4910 4911 | 4983 4984 4985 4986 4987 4988 4989 4990 4991 4992 4993 4994 4995 4996 4997 | + | return NULL; } resPtr = Tcl_GetObjResult(interp); Tcl_IncrRefCount(resPtr); Tcl_ResetResult(interp); return resPtr; } #endif /* !TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- * * Tcl_EvalEx, TclEvalEx -- * * This function evaluates a Tcl script without using the compiler or |
︙ | |||
5861 5862 5863 5864 5865 5866 5867 | 5947 5948 5949 5950 5951 5952 5953 5954 5955 5956 5957 5958 5959 5960 5961 5962 5963 5964 5965 5966 5967 5968 5969 5970 | - + + + + + + + + + + | #undef Tcl_Eval int Tcl_Eval( Tcl_Interp *interp, /* Token for command interpreter (returned by * previous call to Tcl_CreateInterp). */ const char *script) /* Pointer to TCL command to execute. */ { |
︙ | |||
6284 6285 6286 6287 6288 6289 6290 6291 6292 6293 6294 6295 6296 6297 | 6379 6380 6381 6382 6383 6384 6385 6386 6387 6388 6389 6390 6391 6392 6393 6394 6395 | + + + | *ptr = 0; } else { exprPtr = Tcl_NewStringObj(exprstring, -1); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprLongObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); if (result != TCL_OK) { (void) Tcl_GetStringResult(interp); } } return result; } int Tcl_ExprDouble( Tcl_Interp *interp, /* Context in which to evaluate the |
︙ | |||
6310 6311 6312 6313 6314 6315 6316 6317 6318 6319 6320 6321 6322 6323 | 6408 6409 6410 6411 6412 6413 6414 6415 6416 6417 6418 6419 6420 6421 6422 6423 6424 | + + + | *ptr = 0.0; } else { exprPtr = Tcl_NewStringObj(exprstring, -1); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprDoubleObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); /* Discard the expression object. */ if (result != TCL_OK) { (void) Tcl_GetStringResult(interp); } } return result; } int Tcl_ExprBoolean( Tcl_Interp *interp, /* Context in which to evaluate the |
︙ | |||
6335 6336 6337 6338 6339 6340 6341 6342 6343 6344 6345 6346 6347 6348 | 6436 6437 6438 6439 6440 6441 6442 6443 6444 6445 6446 6447 6448 6449 6450 6451 6452 6453 6454 6455 6456 6457 | + + + + + + + + | } else { int result; Tcl_Obj *exprPtr = Tcl_NewStringObj(exprstring, -1); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprBooleanObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); if (result != TCL_OK) { /* * Move the interpreter's object result to the string result, then * reset the object result. */ (void) Tcl_GetStringResult(interp); } return result; } } /* *-------------------------------------------------------------- * |
︙ | |||
6393 6394 6395 6396 6397 6398 6399 | 6502 6503 6504 6505 6506 6507 6508 6509 6510 6511 6512 6513 6514 6515 | - | Tcl_DecrRefCount(resultPtr); if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) { return TCL_ERROR; } resultPtr = Tcl_NewBignumObj(&big); /* FALLTHROUGH */ } |
︙ | |||
6649 6650 6651 6652 6653 6654 6655 6656 6657 6658 6659 6660 6661 6662 | 6757 6758 6759 6760 6761 6762 6763 6764 6765 6766 6767 6768 6769 6770 6771 6772 6773 6774 6775 6776 | + + + + + + | code = Tcl_ExprObj(interp, exprObj, &resultPtr); Tcl_DecrRefCount(exprObj); if (code == TCL_OK) { Tcl_SetObjResult(interp, resultPtr); Tcl_DecrRefCount(resultPtr); } } /* * Force the string rep of the interp result. */ (void) Tcl_GetStringResult(interp); return code; } /* *---------------------------------------------------------------------- * * Tcl_AppendObjToErrorInfo -- |
︙ | |||
6755 6756 6757 6758 6759 6760 6761 | 6869 6870 6871 6872 6873 6874 6875 6876 6877 6878 6879 6880 6881 6882 6883 6884 6885 6886 6887 6888 6889 6890 6891 6892 6893 6894 6895 | + + + + + + + + + + + - + + | /* * If we are just starting to log an error, errorInfo is initialized from * the error message in the interpreter's result. */ iPtr->flags |= ERR_LEGACY_COPY; if (iPtr->errorInfo == NULL) { if (iPtr->result[0] != 0) { /* * The interp's string result is set, apparently by some extension * making a deprecated direct write to it. That extension may * expect interp->result to continue to be set, so we'll take * special pains to avoid clearing it, until we drop support for * interp->result completely. */ iPtr->errorInfo = Tcl_NewStringObj(iPtr->result, -1); } else { |
︙ | |||
6833 6834 6835 6836 6837 6838 6839 | 6959 6960 6961 6962 6963 6964 6965 6966 6967 6968 6969 6970 6971 6972 6973 | - + | * Tcl_VarEval -- * * Given a variable number of string arguments, concatenate them all * together and execute the result as a Tcl command. * * Results: * A standard Tcl return result. An error message or other result may be |
︙ | |||
7351 7352 7353 7354 7355 7356 7357 | 7477 7478 7479 7480 7481 7482 7483 7484 7485 7486 7487 7488 7489 7490 7491 7492 7493 7494 7495 7496 7497 7498 7499 7500 7501 7502 7503 7504 7505 7506 7507 7508 7509 7510 7511 7512 | - - + + - + - + - - + + - + | return TCL_ERROR; } if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { return TCL_ERROR; } |
︙ | |||
7396 7397 7398 7399 7400 7401 7402 | 7522 7523 7524 7525 7526 7527 7528 7529 7530 7531 7532 7533 7534 7535 | - - - - - - - - - - - - - - - - | } else if (d > -0.0) { goto unChanged; } Tcl_SetObjResult(interp, Tcl_NewDoubleObj(-d)); return TCL_OK; } |
︙ | |||
7607 7608 7609 7610 7611 7612 7613 7614 7615 7616 7617 7618 7619 7620 | 7717 7718 7719 7720 7721 7722 7723 7724 7725 7726 7727 7728 7729 7730 7731 7732 7733 7734 7735 7736 7737 7738 7739 7740 7741 7742 7743 7744 7745 7746 7747 7748 7749 7750 7751 7752 7753 7754 7755 7756 7757 7758 7759 7760 7761 7762 7763 7764 7765 7766 7767 7768 7769 7770 7771 7772 7773 7774 7775 7776 7777 7778 7779 7780 7781 7782 7783 7784 7785 7786 7787 7788 7789 7790 7791 7792 7793 7794 7795 | + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | Tcl_IncrRefCount(objPtr); TclGetWideIntFromObj(NULL, objPtr, &wResult); Tcl_DecrRefCount(objPtr); } Tcl_SetObjResult(interp, Tcl_NewWideIntObj(wResult)); return TCL_OK; } /* * Common implmentation of max() and min(). */ static int ExprMaxMinFunc( ClientData clientData, /* Ignored. */ Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv, /* Actual parameter vector. */ int op) /* Comparison direction */ { Tcl_Obj *res; double d; int type, i; ClientData ptr; if (objc < 2) { MathFuncWrongNumArgs(interp, 2, objc, objv); return TCL_ERROR; } res = objv[1]; for (i = 1; i < objc; i++) { if (TclGetNumberFromObj(interp, objv[i], &ptr, &type) != TCL_OK) { return TCL_ERROR; } if (type == TCL_NUMBER_NAN) { /* * Get the error message for NaN. */ Tcl_GetDoubleFromObj(interp, objv[i], &d); return TCL_ERROR; } if (TclCompareTwoNumbers(objv[i], res) == op) { res = objv[i]; } } Tcl_SetObjResult(interp, res); return TCL_OK; } static int ExprMaxFunc( ClientData clientData, /* Ignored. */ Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Actual parameter vector. */ { return ExprMaxMinFunc(clientData, interp, objc, objv, MP_GT); } static int ExprMinFunc( ClientData clientData, /* Ignored. */ Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Actual parameter vector. */ { return ExprMaxMinFunc(clientData, interp, objc, objv, MP_LT); } static int ExprRandFunc( ClientData clientData, /* Ignored. */ Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ |
︙ | |||
7631 7632 7633 7634 7635 7636 7637 | 7806 7807 7808 7809 7810 7811 7812 7813 7814 7815 7816 7817 7818 7819 7820 | - + | return TCL_ERROR; } if (!(iPtr->flags & RAND_SEED_INITIALIZED)) { iPtr->flags |= RAND_SEED_INITIALIZED; /* |
︙ | |||
8093 8094 8095 8096 8097 8098 8099 8100 8101 8102 8103 8104 8105 8106 | 8268 8269 8270 8271 8272 8273 8274 8275 8276 8277 8278 8279 8280 8281 8282 8283 8284 8285 8286 8287 8288 8289 8290 8291 8292 8293 8294 8295 8296 8297 | + + + + + + + + + + + + + + + + | Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ { Command *cmdPtr = (Command *) Tcl_CreateObjCommand(interp,cmdName,proc,clientData,deleteProc); cmdPtr->nreProc = nreProc; return (Tcl_Command) cmdPtr; } Tcl_Command TclNRCreateCommandInNs ( Tcl_Interp *interp, const char *cmdName, Tcl_Namespace *nsPtr, Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc) { Command *cmdPtr = (Command *) TclCreateObjCommandInNs(interp,cmdName,nsPtr,proc,clientData,deleteProc); cmdPtr->nreProc = nreProc; return (Tcl_Command) cmdPtr; } /**************************************************************************** * Stuff for the public api ****************************************************************************/ |
︙ | |||
8881 8882 8883 8884 8885 8886 8887 | 9072 9073 9074 9075 9076 9077 9078 9079 9080 9081 9082 9083 9084 9085 9086 9087 9088 9089 9090 9091 9092 9093 9094 9095 9096 9097 9098 9099 9100 9101 9102 9103 9104 9105 9106 9107 9108 9109 9110 9111 9112 9113 9114 9115 9116 9117 9118 9119 9120 9121 9122 9123 9124 | - - - + + + - - - - - - - - + + + - + - + - + - - - - - - - - - - - - - - - - - + + - + | ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Command *cmdPtr; CoroutineData *corPtr; |
︙ |
Changes to generic/tclCkalloc.c.
︙ | |||
183 184 185 186 187 188 189 | 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 | - + - + - + - + | if (clientData == NULL) { return 0; } sprintf(buf, "total mallocs %10u\n" "total frees %10u\n" "current packets allocated %10u\n" |
︙ | |||
250 251 252 253 254 255 256 | 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 | - + | } } if (guard_failed) { TclDumpMemoryInfo((ClientData) stderr, 0); fprintf(stderr, "low guard failed at %p, %s %d\n", memHeaderP->body, file, line); fflush(stderr); /* In case name pointer is bad. */ |
︙ | |||
272 273 274 275 276 277 278 | 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 | - - + + | } if (guard_failed) { TclDumpMemoryInfo((ClientData) stderr, 0); fprintf(stderr, "high guard failed at %p, %s %d\n", memHeaderP->body, file, line); fflush(stderr); /* In case name pointer is bad. */ |
︙ | |||
355 356 357 358 359 360 361 | 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 | - + - + | return TCL_ERROR; } } Tcl_MutexLock(ckallocMutexPtr); for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) { address = &memScanP->body[0]; |
︙ | |||
607 608 609 610 611 612 613 | 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 | - - + + | * such as Crays (will subtract only bytes, even though BODY_OFFSET is in * words on these machines). */ memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET); if (alloc_tracing) { |
︙ | |||
855 856 857 858 859 860 861 | 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 | - + - + - + | return TCL_ERROR; } break_on_malloc = (unsigned int) value; return TCL_OK; } if (strcmp(argv[1],"info") == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( |
︙ |
Changes to generic/tclCmdAH.c.
︙ | |||
160 161 162 163 164 165 166 | 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 | - + | * A standard Tcl object result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ |
︙ |
Changes to generic/tclCmdIL.c.
︙ | |||
2156 2157 2158 2159 2160 2161 2162 | 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 | - + | int Tcl_JoinObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { |
︙ | |||
2187 2188 2189 2190 2191 2192 2193 | 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 | + - - + + - | Tcl_SetObjResult(interp, elemPtrs[0]); return TCL_OK; } joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2]; Tcl_IncrRefCount(joinObjPtr); (void) Tcl_GetStringFromObj(joinObjPtr, &length); |
︙ | |||
2941 2942 2943 2944 2945 2946 2947 | 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 | - + | int i, match, index, result, listc, length, elemLen, bisect; int dataType, isIncreasing, lower, upper, offset; Tcl_WideInt patWide, objWide; int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase; double patDouble, objDouble; SortInfo sortInfo; Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr; |
︙ | |||
4259 4260 4261 4262 4263 4264 4265 | 4259 4260 4261 4262 4263 4264 4265 4266 4267 4268 4269 4270 4271 4272 4273 | - + | /* Values to be compared. */ SortInfo *infoPtr) /* Information passed from the top-level * "lsort" command. */ { int order = 0; if (infoPtr->sortMode == SORTMODE_ASCII) { |
︙ |
Changes to generic/tclCmdMZ.c.
︙ | |||
305 306 307 308 309 310 311 | 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 | - + | * start of the string unless the previous character is a newline. */ if (offset == 0) { eflags = 0; } else if (offset > stringLength) { eflags = TCL_REG_NOTBOL; |
︙ | |||
1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 | 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 | + + + + + + + + + - + | * 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; } #endif /* * Assume Tcl_UniChar is an integral type... */ |
︙ | |||
1322 1323 1324 1325 1326 1327 1328 | 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 | - + - - - - - + - - - - | if (objc == 4) { int size = Tcl_GetCharLength(objv[2]); if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &start)) { return TCL_ERROR; } |
︙ | |||
1375 1376 1377 1378 1379 1380 1381 | 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 | - - - - - - - - | if (objc == 4) { int size = Tcl_GetCharLength(objv[2]); if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &last)) { return TCL_ERROR; } |
︙ | |||
1592 1593 1594 1595 1596 1597 1598 | 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 | - - - | case STR_IS_DIGIT: chcomp = Tcl_UniCharIsDigit; break; case STR_IS_DOUBLE: { /* TODO */ if ((objPtr->typePtr == &tclDoubleType) || (objPtr->typePtr == &tclIntType) || |
︙ | |||
1629 1630 1631 1632 1633 1634 1635 | 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 | - - - | case STR_IS_INT: if (TCL_OK == TclGetIntFromObj(NULL, objPtr, &i)) { break; } goto failedIntParse; case STR_IS_ENTIER: if ((objPtr->typePtr == &tclIntType) || |
︙ | |||
1810 1811 1812 1813 1814 1815 1816 1817 | 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 | + + + + + + + + - + | if (strict) { result = 0; } goto str_is_done; } end = string1 + length1; for (; string1 < end; string1 += length2, failat++) { int fullchar; length2 = TclUtfToUniChar(string1, &ch); fullchar = ch; #if TCL_UTF_MAX == 4 if (!length2) { length2 = TclUtfToUniChar(string1, &ch); fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000; } #endif |
︙ | |||
2273 2274 2275 2276 2277 2278 2279 | 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 | - - + + + + - - + | if (count == 1) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } else if (count < 1) { return TCL_OK; } |
︙ | |||
2376 2377 2378 2379 2380 2381 2382 | 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 | - + | Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "string"); return TCL_ERROR; } |
︙ | |||
2825 2826 2827 2828 2829 2830 2831 | 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 | - - - - - - - - + + - - + - - - + - | static int StringCatCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { |
︙ | |||
3526 3527 3528 3529 3530 3531 3532 | 3512 3513 3514 3515 3516 3517 3518 3519 3520 3521 3522 3523 3524 3525 3526 | - + | "--", NULL }; enum options { OPT_EXACT, OPT_GLOB, OPT_INDEXV, OPT_MATCHV, OPT_NOCASE, OPT_REGEXP, OPT_LAST }; typedef int (*strCmpFn_t)(const char *, const char *); |
︙ | |||
4289 4290 4291 4292 4293 4294 4295 | 4275 4276 4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 | - + | commonHandler: if (Tcl_ListObjLength(interp, objv[i+2], &dummy) != TCL_OK) { Tcl_DecrRefCount(handlersObj); return TCL_ERROR; } info[0] = objv[i]; /* type */ |
︙ |
Changes to generic/tclCompile.h.
︙ | |||
421 422 423 424 425 426 427 | 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 | - + - + | * ByteCode was compiled. Used to invalidate * code when, e.g., commands with compile * procs are redefined. */ Namespace *nsPtr; /* Namespace context in which this code was * compiled. If the code is executed if a * different namespace, it must be * recompiled. */ |
︙ |
Changes to generic/tclDecls.h.
︙ | |||
49 50 51 52 53 54 55 | 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 | - + | */ /* 0 */ EXTERN int Tcl_PkgProvideEx(Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 1 */ |
︙ | |||
155 156 157 158 159 160 161 | 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 | - + - | EXTERN int Tcl_GetDouble(Tcl_Interp *interp, const char *src, double *doublePtr); /* 35 */ EXTERN int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 36 */ EXTERN int Tcl_GetIndexFromObj(Tcl_Interp *interp, |
︙ | |||
259 260 261 262 263 264 265 | 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 | + - + - + - + | /* 74 */ EXTERN void Tcl_AsyncMark(Tcl_AsyncHandler async); /* 75 */ EXTERN int Tcl_AsyncReady(void); /* 76 */ EXTERN void Tcl_BackgroundError(Tcl_Interp *interp); /* 77 */ TCL_DEPRECATED("Use Tcl_UtfBackslash") |
︙ | |||
318 319 320 321 322 323 324 | 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 | + - + | ClientData clientData); /* 93 */ EXTERN void Tcl_CreateExitHandler(Tcl_ExitProc *proc, ClientData clientData); /* 94 */ EXTERN Tcl_Interp * Tcl_CreateInterp(void); /* 95 */ TCL_DEPRECATED("") |
︙ | |||
408 409 410 411 412 413 414 | 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 | - + - + | /* 124 */ EXTERN void Tcl_DStringSetLength(Tcl_DString *dsPtr, int length); /* 125 */ EXTERN void Tcl_DStringStartSublist(Tcl_DString *dsPtr); /* 126 */ EXTERN int Tcl_Eof(Tcl_Channel chan); /* 127 */ |
︙ | |||
465 466 467 468 469 470 471 | 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 | - - + + - + - + - + - + | EXTERN int Tcl_Flush(Tcl_Channel chan); /* 147 */ EXTERN void Tcl_FreeResult(Tcl_Interp *interp); /* 148 */ EXTERN int Tcl_GetAlias(Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, |
︙ | |||
542 543 544 545 546 547 548 | 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 | - + - - + + - - + + - | EXTERN int Tcl_GetServiceMode(void); /* 172 */ EXTERN Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp, const char *slaveName); /* 173 */ EXTERN Tcl_Channel Tcl_GetStdChannel(int type); /* 174 */ |
︙ | |||
574 575 576 577 578 579 580 | 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 | - + - + - + | /* 183 */ EXTERN int Tcl_InputBuffered(Tcl_Channel chan); /* 184 */ EXTERN int Tcl_InterpDeleted(Tcl_Interp *interp); /* 185 */ EXTERN int Tcl_IsSafe(Tcl_Interp *interp); /* 186 */ |
︙ | |||
623 624 625 626 627 628 629 | 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 | - + | EXTERN void Tcl_Preserve(ClientData data); /* 202 */ EXTERN void Tcl_PrintDouble(Tcl_Interp *interp, double value, char *dst); /* 203 */ EXTERN int Tcl_PutEnv(const char *assignment); /* 204 */ |
︙ | |||
653 654 655 656 657 658 659 | 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 | - + - + - + | EXTERN int Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp, const char *text, const char *start); /* 214 */ EXTERN int Tcl_RegExpMatch(Tcl_Interp *interp, const char *text, const char *pattern); /* 215 */ EXTERN void Tcl_RegExpRange(Tcl_RegExp regexp, int index, |
︙ | |||
709 710 711 712 713 714 715 | 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 | - - + + - - - - + + + - + - + - + - + + - + | Tcl_Obj *errorObjPtr); /* 235 */ EXTERN void Tcl_SetObjResult(Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 236 */ EXTERN void Tcl_SetStdChannel(Tcl_Channel channel, int type); /* 237 */ |
︙ | |||
808 809 810 811 812 813 814 | 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 | + - + + - + - - + + - - + + - - + - - + + - + - + + - + + - + | EXTERN void Tcl_WrongNumArgs(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 265 */ EXTERN int Tcl_DumpActiveMemory(const char *fileName); /* 266 */ EXTERN void Tcl_ValidateAllMemory(const char *file, int line); /* 267 */ TCL_DEPRECATED("see TIP #422") |
︙ | |||
906 907 908 909 910 911 912 | 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 | - + | /* 299 */ EXTERN void Tcl_FreeEncoding(Tcl_Encoding encoding); /* 300 */ EXTERN Tcl_ThreadId Tcl_GetCurrentThread(void); /* 301 */ EXTERN Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name); /* 302 */ |
︙ | |||
965 966 967 968 969 970 971 | 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 | - + - + - + - + - + | /* 322 */ EXTERN Tcl_UniChar Tcl_UniCharToTitle(int ch); /* 323 */ EXTERN Tcl_UniChar Tcl_UniCharToUpper(int ch); /* 324 */ EXTERN int Tcl_UniCharToUtf(int ch, char *buf); /* 325 */ |
︙ | |||
1006 1007 1008 1009 1010 1011 1012 | 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 | + - + + - + | EXTERN int Tcl_WriteChars(Tcl_Channel chan, const char *src, int srcLen); /* 339 */ EXTERN int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr); /* 340 */ EXTERN char * Tcl_GetString(Tcl_Obj *objPtr); /* 341 */ TCL_DEPRECATED("Use Tcl_GetEncodingSearchPath") |
︙ | |||
1043 1044 1045 1046 1047 1048 1049 | 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 | + - + - + - + | /* 355 */ EXTERN Tcl_UniChar * Tcl_UtfToUniCharDString(const char *src, int length, Tcl_DString *dsPtr); /* 356 */ EXTERN Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 357 */ TCL_DEPRECATED("Use Tcl_EvalTokensStandard") |
︙ | |||
1157 1158 1159 1160 1161 1162 1163 | 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 | - - + | EXTERN int Tcl_WriteRaw(Tcl_Channel chan, const char *src, int srcLen); /* 396 */ EXTERN Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan); /* 397 */ EXTERN int Tcl_ChannelBuffered(Tcl_Channel chan); /* 398 */ |
︙ | |||
1264 1265 1266 1267 1268 1269 1270 | 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 | + - + + - + | EXTERN int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length); /* 433 */ EXTERN Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel); /* 434 */ EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr); /* 435 */ TCL_DEPRECATED("") |
︙ | |||
1839 1840 1841 1842 1843 1844 1845 | 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 | - + | } TclStubHooks; typedef struct TclStubs { int magic; const TclStubHooks *hooks; int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */ |
︙ | |||
1890 1891 1892 1893 1894 1895 1896 | 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 | - + | Tcl_Obj * (*tcl_DuplicateObj) (Tcl_Obj *objPtr); /* 29 */ void (*tclFreeObj) (Tcl_Obj *objPtr); /* 30 */ int (*tcl_GetBoolean) (Tcl_Interp *interp, const char *src, int *boolPtr); /* 31 */ int (*tcl_GetBooleanFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr); /* 32 */ unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 33 */ int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */ int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */ |
︙ | |||
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 | - + - + - + - + | void (*tcl_AppendResult) (Tcl_Interp *interp, ...); /* 70 */ Tcl_AsyncHandler (*tcl_AsyncCreate) (Tcl_AsyncProc *proc, ClientData clientData); /* 71 */ void (*tcl_AsyncDelete) (Tcl_AsyncHandler async); /* 72 */ int (*tcl_AsyncInvoke) (Tcl_Interp *interp, int code); /* 73 */ void (*tcl_AsyncMark) (Tcl_AsyncHandler async); /* 74 */ int (*tcl_AsyncReady) (void); /* 75 */ void (*tcl_BackgroundError) (Tcl_Interp *interp); /* 76 */ |
︙ | |||
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 | - - + + - - + + - + - + - + - - - + + + - + - + - + - + - + - + - - - - + + + + - - + + - + - - + + - - - + + + - - - + + + - + | void (*tcl_DStringFree) (Tcl_DString *dsPtr); /* 120 */ void (*tcl_DStringGetResult) (Tcl_Interp *interp, Tcl_DString *dsPtr); /* 121 */ void (*tcl_DStringInit) (Tcl_DString *dsPtr); /* 122 */ void (*tcl_DStringResult) (Tcl_Interp *interp, Tcl_DString *dsPtr); /* 123 */ void (*tcl_DStringSetLength) (Tcl_DString *dsPtr, int length); /* 124 */ void (*tcl_DStringStartSublist) (Tcl_DString *dsPtr); /* 125 */ int (*tcl_Eof) (Tcl_Channel chan); /* 126 */ |
︙ | |||
2164 2165 2166 2167 2168 2169 2170 | 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 | - + | int (*tcl_ExternalToUtf) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 295 */ char * (*tcl_ExternalToUtfDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 296 */ void (*tcl_FinalizeThread) (void); /* 297 */ void (*tcl_FinalizeNotifier) (ClientData clientData); /* 298 */ void (*tcl_FreeEncoding) (Tcl_Encoding encoding); /* 299 */ Tcl_ThreadId (*tcl_GetCurrentThread) (void); /* 300 */ Tcl_Encoding (*tcl_GetEncoding) (Tcl_Interp *interp, const char *name); /* 301 */ |
︙ | |||
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 | - + - - - - + + + + - - + + - + - + - + | void (*tcl_ThreadAlert) (Tcl_ThreadId threadId); /* 318 */ void (*tcl_ThreadQueueEvent) (Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position); /* 319 */ Tcl_UniChar (*tcl_UniCharAtIndex) (const char *src, int index); /* 320 */ Tcl_UniChar (*tcl_UniCharToLower) (int ch); /* 321 */ Tcl_UniChar (*tcl_UniCharToTitle) (int ch); /* 322 */ Tcl_UniChar (*tcl_UniCharToUpper) (int ch); /* 323 */ int (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */ |
︙ | |||
2260 2261 2262 2263 2264 2265 2266 | 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 | - + | void (*tcl_ConditionFinalize) (Tcl_Condition *condPtr); /* 391 */ void (*tcl_MutexFinalize) (Tcl_Mutex *mutex); /* 392 */ int (*tcl_CreateThread) (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, ClientData clientData, int stackSize, int flags); /* 393 */ int (*tcl_ReadRaw) (Tcl_Channel chan, char *dst, int bytesToRead); /* 394 */ int (*tcl_WriteRaw) (Tcl_Channel chan, const char *src, int srcLen); /* 395 */ Tcl_Channel (*tcl_GetTopChannel) (Tcl_Channel chan); /* 396 */ int (*tcl_ChannelBuffered) (Tcl_Channel chan); /* 397 */ |
︙ | |||
2297 2298 2299 2300 2301 2302 2303 | 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 | - - + + | char * (*tcl_AttemptAlloc) (unsigned int size); /* 428 */ char * (*tcl_AttemptDbCkalloc) (unsigned int size, const char *file, int line); /* 429 */ char * (*tcl_AttemptRealloc) (char *ptr, unsigned int size); /* 430 */ char * (*tcl_AttemptDbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 431 */ int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, int length); /* 432 */ Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */ Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */ |
︙ | |||
3884 3885 3886 3887 3888 3889 3890 | 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 | - - + + - - + + - + | Tcl_EvalEx(interp, objPtr, -1, 0) #undef Tcl_GlobalEval #define Tcl_GlobalEval(interp, objPtr) \ Tcl_EvalEx(interp, objPtr, -1, TCL_EVAL_GLOBAL) #undef Tcl_SaveResult #define Tcl_SaveResult(interp, statePtr) \ do { \ |
︙ | |||
3923 3924 3925 3926 3927 3928 3929 | 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 | - - - - - - | /* 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. Cygwin64 stubbed extensions cannot use those stub * entries any more, they should use the 64-bit alternatives where * possible. Tcl 9 must find a better solution, but that cannot be done * without introducing a binary incompatibility. */ |
︙ | |||
3962 3963 3964 3965 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975 3976 3977 3978 3979 3980 | 3963 3964 3965 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975 3976 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 | + + + + + + + + + + + | # define Tcl_UtfNcasecmp(s1,s2,n) \ ((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcasecmp)(s1,s2,(unsigned int)(n)) # define Tcl_UniCharNcasecmp(ucs,uct,n) \ ((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))tclStubsPtr->tcl_UniCharNcasecmp)(ucs,uct,(unsigned int)(n)) # endif #endif #undef Tcl_NewLongObj #define Tcl_NewLongObj(value) Tcl_NewWideIntObj((long)(value)) #undef Tcl_NewIntObj #define Tcl_NewIntObj(value) Tcl_NewWideIntObj((int)(value)) #undef Tcl_DbNewLongObj #define Tcl_DbNewLongObj(value, file, line) Tcl_DbNewWideIntObj((long)(value), file, line) #undef Tcl_SetIntObj #define Tcl_SetIntObj(objPtr, value) Tcl_SetWideIntObj(objPtr, (int)(value)) #undef Tcl_SetLongObj #define Tcl_SetLongObj(objPtr, value) Tcl_SetWideIntObj(objPtr, (long)(value)) /* * Deprecated Tcl procedures: */ #undef Tcl_EvalObj #define Tcl_EvalObj(interp, objPtr) \ Tcl_EvalObjEx(interp, objPtr, 0) #undef Tcl_GlobalEvalObj #define Tcl_GlobalEvalObj(interp, objPtr) \ Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL) #endif /* _TCLDECLS */ |
Changes to generic/tclDictObj.c.
︙ | |||
483 484 485 486 487 488 489 | 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 | - - + + - | *---------------------------------------------------------------------- */ static void UpdateStringOfDict( Tcl_Obj *dictPtr) { |
︙ | |||
513 514 515 516 517 518 519 | 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 | - - - + | /* * Pass 1: estimate space, gather flags. */ if (numElems <= LOCAL_SIZE) { flagPtr = localFlags; |
︙ | |||
2308 2309 2310 2311 2312 2313 2314 | 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 | - - - + + + + + + | Tcl_Obj *appendObjPtr = NULL; if (objc > 3) { /* Something to append */ if (objc == 4) { appendObjPtr = objv[3]; |
︙ |
Changes to generic/tclDisassemble.c.
︙ | |||
250 251 252 253 254 255 256 | 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 | - + | unsigned char *codeDeltaNext, *codeLengthNext; unsigned char *srcDeltaNext, *srcLengthNext; int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i, line; Interp *iPtr = (Interp *) *codePtr->interpHandle; Tcl_Obj *bufferObj, *fileObj; TclNewObj(bufferObj); |
︙ | |||
308 309 310 311 312 313 314 | 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 | - + | */ if (codePtr->procPtr != NULL) { Proc *procPtr = codePtr->procPtr; int numCompiledLocals = procPtr->numCompiledLocals; Tcl_AppendPrintfToObj(bufferObj, |
︙ | |||
793 794 795 796 797 798 799 | 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 | - + - + - + | Tcl_Obj * TclNewInstNameObj( unsigned char inst) { Tcl_Obj *objPtr = Tcl_NewObj(); objPtr->typePtr = &tclInstNameType; |
︙ |
Changes to generic/tclEncoding.c.
︙ | |||
14 15 16 17 18 19 20 | 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 | - + | typedef size_t (LengthProc)(const char *src); /* * The following data structure represents an encoding, which describes how to * convert between various character sets and UTF-8. */ |
︙ | |||
53 54 55 56 57 58 59 | 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 | - + | /* * The following structure is the clientData for a dynamically-loaded, * table-driven encoding created by LoadTableEncoding(). It maps between * Unicode and a single-byte, double-byte, or multibyte (1 or 2 bytes only) * encoding. */ |
︙ | |||
87 88 89 90 91 92 93 | 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 | - + - + | * escape-driven encoding that is itself comprised of other simpler encodings. * An example is "iso-2022-jp", which uses escape sequences to switch between * ascii, jis0208, jis0212, gb2312, and ksc5601. Note that "escape-driven" * does not necessarily mean that the ESCAPE character is the character used * for switching character sets. */ |
︙ | |||
689 690 691 692 693 694 695 696 697 698 699 700 701 702 | 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 | + | * * Side effects: * None. * *------------------------------------------------------------------------- */ #if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 const char * Tcl_GetDefaultEncodingDir(void) { int numDirs; Tcl_Obj *first, *searchPath = Tcl_GetEncodingSearchPath(); Tcl_ListObjLength(NULL, searchPath, &numDirs); |
︙ | |||
732 733 734 735 736 737 738 739 740 741 742 743 744 745 | 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 | + | Tcl_Obj *searchPath = Tcl_GetEncodingSearchPath(); Tcl_Obj *directory = Tcl_NewStringObj(path, -1); searchPath = Tcl_DuplicateObj(searchPath); Tcl_ListObjReplace(NULL, searchPath, 0, 0, 1, &directory); Tcl_SetEncodingSearchPath(searchPath); } #endif /* *------------------------------------------------------------------------- * * Tcl_GetEncoding -- * * Given the name of a encoding, find the corresponding Tcl_Encoding |
︙ | |||
3605 3606 3607 3608 3609 3610 3611 | 3607 3608 3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 | - + | * *------------------------------------------------------------------------- */ static void InitializeEncodingSearchPath( char **valuePtr, |
︙ |
Changes to generic/tclEnsemble.c.
︙ | |||
88 89 90 91 92 93 94 | 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 | - + | /* * The internal rep for caching ensemble subcommand lookups and * spell corrections. */ typedef struct { |
︙ | |||
142 143 144 145 146 147 148 | 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 | - + + + | TclNamespaceEnsembleCmd( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Namespace *namespacePtr; |
︙ | |||
191 192 193 194 195 196 197 | 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 | - - - - - - - + + + | if (objc & 1) { Tcl_WrongNumArgs(interp, 2, objv, "?option value ...?"); return TCL_ERROR; } objv += 2; objc -= 2; |
︙ | |||
333 334 335 336 337 338 339 340 341 342 343 344 345 346 | 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 | + + + + - - + + + | return TCL_ERROR; } unknownObj = (len > 0 ? objv[1] : NULL); continue; } } TclGetNamespaceForQualName(interp, name, cxtPtr, TCL_CREATE_NS_IF_UNKNOWN, &foundNsPtr, &altFoundNsPtr, &actualCxtPtr, &simpleName); /* * Create the ensemble. Note that this might delete another ensemble * linked to the same namespace, so we must be careful. However, we * should be OK because we only link the namespace into the list once * we've created it (and after any deletions have occurred.) */ |
︙ | |||
632 633 634 635 636 637 638 | 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 | - + - + - - - + - - - - + + - - - + + + + + + + + - - + + - - + - - - - + + - - - - - + - - - + + + - - - + + - - - - + - - + - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | } return TCL_OK; } /* *---------------------------------------------------------------------- * |
︙ | |||
1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 | 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 | + | /* * Hand off to the target command. */ TclSkipTailcall(interp); Tcl_ListObjGetElements(NULL, copyPtr, ©Objc, ©Objv); ((Interp *)interp)->lookupNsPtr = ensemblePtr->nsPtr; return TclNREvalObjv(interp, copyObjc, copyObjv, TCL_EVAL_INVOKE, NULL); } unknownOrAmbiguousSubcommand: /* * Have not been able to match the subcommand asked for with a real * subcommand that we export. See whether a handler has been registered |
︙ | |||
2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 | 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 | + + + + + + + + + + + + + + + + + + + + - - | * None. * * Side effects: * Memory is (eventually) deallocated. * *---------------------------------------------------------------------- */ static void ClearTable( EnsembleConfig *ensemblePtr) { Tcl_HashTable *hash = &ensemblePtr->subcommandTable; if (hash->numEntries != 0) { Tcl_HashSearch search; Tcl_HashEntry *hPtr = Tcl_FirstHashEntry(hash, &search); while (hPtr != NULL) { Tcl_Obj *prefixObj = Tcl_GetHashValue(hPtr); Tcl_DecrRefCount(prefixObj); hPtr = Tcl_NextHashEntry(&search); } ckfree((char *) ensemblePtr->subcommandArrayPtr); } Tcl_DeleteHashTable(hash); } static void DeleteEnsembleConfig( ClientData clientData) { EnsembleConfig *ensemblePtr = clientData; Namespace *nsPtr = ensemblePtr->nsPtr; |
︙ | |||
2435 2436 2437 2438 2439 2440 2441 | 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 | - - + - - - - - - - - - | ensemblePtr->flags |= ENSEMBLE_DEAD; /* * Kill the pointer-containing fields. */ |
︙ | |||
2501 2502 2503 2504 2505 2506 2507 2508 | 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 | + + + + - - - - + + + + + + + + + + + + + + + + + - - - - + + + + + - - + - - - - - - + + + + + + + + + + + + - - - - - - + - - - + + - - - - + + - - + - - - - - - - - + + + - - + - - + - - + - - - - - - - + + + + + + - - - - - - + + + + + + + - - - - - - - - - - - - - - - - + + + + + + + + + + + - - - + + + - - - - + + + + - - - - - + + + + + | { Tcl_HashSearch search; /* Used for scanning the set of commands in * the namespace that backs up this * ensemble. */ int i, j, isNew; Tcl_HashTable *hash = &ensemblePtr->subcommandTable; Tcl_HashEntry *hPtr; Tcl_Obj *mapDict = ensemblePtr->subcommandDict; Tcl_Obj *subList = ensemblePtr->subcmdList; ClearTable(ensemblePtr); Tcl_InitHashTable(hash, TCL_STRING_KEYS); |
︙ | |||
2630 2631 2632 2633 2634 2635 2636 | 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 | - - - - - + | * substituted part of the command (as a list) as their * content! */ if (isNew) { Tcl_Obj *cmdObj, *cmdPrefixObj; |
︙ |
Changes to generic/tclEvent.c.
︙ | |||
1053 1054 1055 1056 1057 1058 1059 | 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 | - | TclpInitPlatform(); /* Creates signal handler(s) */ TclInitDoubleConversion(); /* Initializes constants for * converting to/from double. */ TclInitObjSubsystem(); /* Register obj types, create * mutexes. */ TclInitIOSubsystem(); /* Inits a tsd key (noop). */ TclInitEncodingSubsystem(); /* Process wide encoding init. */ |
︙ |
Changes to generic/tclExecute.c.
︙ | |||
321 322 323 324 325 326 327 | 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 | - + - + - + - + | NEXT_INST_F(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \ case INST_JUMP_FALSE4: \ NEXT_INST_F(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \ case INST_JUMP_TRUE4: \ NEXT_INST_F(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \ default: \ if ((condition) < 0) { \ |
︙ | |||
494 495 496 497 498 499 500 | 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 | - - - - - - - - - - - - - - - - - - - - - - - + + + | * Macro used in this file to save a function call for common uses of * TclGetNumberFromObj(). The ANSI C "prototype" is: * * MODULE_SCOPE int GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, * ClientData *ptrPtr, int *tPtr); */ |
︙ | |||
572 573 574 575 576 577 578 | 552 553 554 555 556 557 558 559 560 561 562 563 564 565 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | #define IsErroringNaNType(type) 0 #endif /* * Auxiliary tables used to compute powers of small integers. */ |
︙ | |||
709 710 711 712 713 714 715 | 655 656 657 658 659 660 661 662 663 664 665 666 667 668 | - | (Tcl_WideInt)100000*100000*100000*10*10*10, (Tcl_WideInt)161051*161051*161051*11*11, (Tcl_WideInt)161051*161051*161051*11*11*11, (Tcl_WideInt)248832*248832*248832*12*12, (Tcl_WideInt)371293*371293*371293*13*13 }; static const size_t Exp64ValueSize = sizeof(Exp64Value) / sizeof(Tcl_WideInt); |
︙ | |||
740 741 742 743 744 745 746 | 685 686 687 688 689 690 691 692 693 694 695 696 697 698 | - - | const unsigned char *pc, int stackTop, int checkStack); #endif /* TCL_COMPILE_DEBUG */ static ByteCode * CompileExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr); static void DeleteExecStack(ExecStack *esPtr); static void DupExprCodeInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); |
︙ | |||
904 905 906 907 908 909 910 | 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 | - + - + | * [sizeof(Tcl_Obj*)] */ { ExecEnv *eePtr = ckalloc(sizeof(ExecEnv)); ExecStack *esPtr = ckalloc(sizeof(ExecStack) + (size_t) (size-1) * sizeof(Tcl_Obj *)); eePtr->execStackPtr = esPtr; |
︙ | |||
1873 1874 1875 1876 1877 1878 1879 | 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 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - | */ TclGetIntFromObj(interp, incrPtr, &type1); Tcl_AddErrorInfo(interp, "\n (reading increment)"); return TCL_ERROR; } |
︙ | |||
2680 2681 2682 2683 2684 2685 2686 | 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 | - - - + + + | TRACE(("%u => OK\n", opnd)); NEXT_INST_F(5, 0, 0); } case INST_STR_CONCAT1: opnd = TclGetUInt1AtPtr(pc+1); |
︙ | |||
3622 3623 3624 3625 3626 3627 3628 | 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 | - - | * common execution code. */ /*TODO: Consider more untangling here; merge with LOAD and STORE ? */ { Tcl_Obj *incrPtr; |
︙ | |||
3723 3724 3725 3726 3727 3728 3729 | 3631 3632 3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 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 | - - - + + + - + - + - - + - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - + | if (TclIsVarDirectModifyable(varPtr)) { ClientData ptr; int type; objPtr = varPtr->value.objPtr; if (GetNumberFromObj(NULL, objPtr, &ptr, &type) == TCL_OK) { |
︙ | |||
4522 4523 4524 4525 4526 4527 4528 | 4395 4396 4397 4398 4399 4400 4401 4402 4403 4404 4405 4406 4407 4408 4409 | - + | Tcl_GetCommandFullName(interp, (Tcl_Command) corPtr->cmdPtr, objResultPtr); } TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); } case INST_INFO_LEVEL_NUM: |
︙ | |||
4891 4892 4893 4894 4895 4896 4897 | 4764 4765 4766 4767 4768 4769 4770 4771 4772 4773 4774 4775 4776 4777 4778 | - + | case INST_LIST_LENGTH: TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS))); if (TclListObjLength(interp, OBJ_AT_TOS, &length) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } |
︙ | |||
5362 5363 5364 5365 5366 5367 5368 | 5235 5236 5237 5238 5239 5240 5241 5242 5243 5244 5245 5246 5247 5248 5249 | - + | TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr), (match < 0 ? -1 : match > 0 ? 1 : 0))); JUMP_PEEPHOLE_F(match, 1, 2); case INST_STR_LEN: valuePtr = OBJ_AT_TOS; length = Tcl_GetCharLength(valuePtr); |
︙ | |||
5713 5714 5715 5716 5717 5718 5719 | 5586 5587 5588 5589 5590 5591 5592 5593 5594 5595 5596 5597 5598 5599 5600 5601 5602 5603 5604 5605 5606 5607 5608 5609 5610 5611 5612 | - + - + - + | } doneStringMap: TRACE_WITH_OBJ(("%.20s %.20s %.20s => ", O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr); NEXT_INST_V(1, 3, 1); case INST_STR_FIND: |
︙ | |||
5898 5899 5900 5901 5902 5903 5904 | 5771 5772 5773 5774 5775 5776 5777 5778 5779 5780 5781 5782 5783 5784 5785 5786 5787 5788 5789 5790 5791 5792 5793 5794 5795 5796 5797 5798 5799 5800 5801 5802 5803 5804 5805 5806 5807 5808 | - + - - + + - - - - - - - - + - - + | * ----------------------------------------------------------------- * Start of numeric operator instructions. */ { ClientData ptr1, ptr2; int type1, type2; |
︙ | |||
5964 5965 5966 5967 5968 5969 5970 | 5829 5830 5831 5832 5833 5834 5835 5836 5837 5838 5839 5840 5841 5842 5843 5844 5845 5846 | - - - - + + + + | iResult = (*pc == INST_NEQ); goto foundResult; } if (valuePtr == value2Ptr) { compare = MP_EQ; goto convertComparison; } |
︙ | |||
6043 6044 6045 6046 6047 6048 6049 | 5908 5909 5910 5911 5912 5913 5914 5915 5916 5917 5918 5919 5920 5921 5922 5923 5924 5925 5926 5927 5928 5929 5930 5931 5932 5933 5934 5935 5936 5937 5938 5939 5940 5941 5942 5943 5944 5945 5946 5947 5948 5949 5950 5951 5952 5953 5954 5955 5956 5957 5958 5959 5960 5961 5962 5963 5964 5965 5966 5967 5968 5969 5970 5971 5972 5973 5974 5975 5976 5977 5978 5979 5980 5981 5982 5983 5984 5985 5986 5987 5988 5989 5990 5991 5992 5993 5994 5995 5996 5997 5998 5999 6000 6001 6002 6003 6004 6005 6006 6007 6008 6009 6010 6011 6012 6013 6014 6015 6016 6017 6018 6019 6020 6021 6022 6023 6024 6025 6026 6027 6028 6029 6030 6031 6032 6033 6034 6035 6036 6037 6038 6039 6040 6041 6042 6043 6044 6045 6046 6047 6048 6049 6050 6051 6052 6053 6054 6055 6056 6057 6058 6059 6060 6061 6062 6063 6064 6065 6066 6067 6068 6069 6070 6071 6072 6073 6074 6075 6076 6077 6078 6079 | - - - + + + - + - + - + - + - - - - + + + + - - + + - + - + - + - + - + - - + + - + - + - + - + - - + + - - + + - - + + - - + + - - + + - - - - - - - - - | goto gotError; } /* * Check for common, simple case. */ |
︙ | |||
6292 6293 6294 6295 6296 6297 6298 | 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 6180 6181 6182 6183 6184 6185 6186 6187 6188 6189 6190 6191 6192 6193 6194 6195 6196 6197 6198 6199 6200 6201 6202 6203 6204 6205 6206 6207 6208 6209 6210 6211 6212 6213 6214 6215 6216 6217 6218 6219 6220 6221 6222 6223 6224 6225 6226 6227 6228 6229 6230 6231 6232 6233 6234 6235 6236 6237 6238 | - + - - - - + + - - - - - - - - - + - + - + - + - + - - - - + + + + - + - - + + - - - - + + + + | #endif /* * Handle (long,long) arithmetic as best we can without going out to * an external function. */ |
︙ | |||
6445 6446 6447 6448 6449 6450 6451 | 6291 6292 6293 6294 6295 6296 6297 6298 6299 6300 6301 6302 6303 6304 6305 6306 6307 6308 6309 6310 6311 6312 | - - + + - + - + | TRACE_APPEND(("ERROR: illegal type %s\n", (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); CACHE_STACK_INFO(); goto gotError; } |
︙ | |||
6482 6483 6484 6485 6486 6487 6488 | 6328 6329 6330 6331 6332 6333 6334 6335 6336 6337 6338 6339 6340 6341 6342 6343 6344 6345 6346 6347 6348 6349 6350 | - - - + + + - + - + | goto gotError; } switch (type1) { case TCL_NUMBER_NAN: /* -NaN => NaN */ TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); |
︙ | |||
6651 6652 6653 6654 6655 6656 6657 | 6497 6498 6499 6500 6501 6502 6503 6504 6505 6506 6507 6508 6509 6510 6511 6512 6513 6514 | - + - + | opnd = TclGetUInt4AtPtr(pc+1); infoPtr = codePtr->auxDataArrayPtr[opnd].clientData; iterTmpIndex = infoPtr->loopCtTemp; iterVarPtr = LOCAL(iterTmpIndex); oldValuePtr = iterVarPtr->value.objPtr; if (oldValuePtr == NULL) { |
︙ | |||
6688 6689 6690 6691 6692 6693 6694 | 6534 6535 6536 6537 6538 6539 6540 6541 6542 6543 6544 6545 6546 6547 6548 6549 | - - + + | /* * Increment the temp holding the loop iteration number. */ iterVarPtr = LOCAL(infoPtr->loopCtTemp); valuePtr = iterVarPtr->value.objPtr; |
︙ | |||
7022 7023 7024 7025 7026 7027 7028 | 6868 6869 6870 6871 6872 6873 6874 6875 6876 6877 6878 6879 6880 6881 6882 | - + | TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); iPtr->objResultPtr = objPtr; NEXT_INST_F(1, 0, -1); case INST_PUSH_RETURN_CODE: |
︙ | |||
7688 7689 7690 7691 7692 7693 7694 | 7534 7535 7536 7537 7538 7539 7540 7541 7542 7543 7544 7545 7546 7547 | - | case 3: /* seconds */ Tcl_GetTime(&now); wval = (Tcl_WideInt) now.sec; break; default: Tcl_Panic("clockRead instruction with unknown clock#"); } |
︙ | |||
8120 8121 8122 8123 8124 8125 8126 | 7965 7966 7967 7968 7969 7970 7971 7972 7973 7974 7975 7976 7977 7978 7979 7980 7981 7982 7983 | - - - - - - - - - + | ExecuteExtendedBinaryMathOp( Tcl_Interp *interp, /* Where to report errors. */ int opcode, /* What operation to perform. */ Tcl_Obj **constants, /* The execution environment's constants. */ Tcl_Obj *valuePtr, /* The first operand on the stack. */ Tcl_Obj *value2Ptr) /* The second operand on the stack. */ { |
︙ | |||
8154 8155 8156 8157 8158 8159 8160 | 7991 7992 7993 7994 7995 7996 7997 7998 7999 8000 8001 8002 8003 8004 8005 8006 8007 8008 8009 8010 8011 8012 8013 8014 8015 8016 8017 8018 8019 8020 8021 8022 8023 8024 8025 8026 8027 8028 8029 8030 8031 8032 8033 8034 8035 8036 8037 8038 8039 8040 8041 | - - - - - + + + + - + - + + + + + + + + | Tcl_SetDoubleObj(valuePtr, (d)); \ return NULL; \ } int type1, type2; ClientData ptr1, ptr2; double d1, d2, dResult; |
︙ | |||
8227 8228 8229 8230 8231 8232 8233 | 8070 8071 8072 8073 8074 8075 8076 8077 8078 8079 8080 8081 8082 8083 | - | /* * Arguments are same sign; remainder is first operand. */ mp_clear(&big2); return NULL; } |
︙ | |||
8254 8255 8256 8257 8258 8259 8260 | 8096 8097 8098 8099 8100 8101 8102 8103 8104 8105 8106 8107 8108 8109 8110 8111 8112 8113 8114 8115 8116 8117 8118 8119 8120 8121 8122 8123 8124 8125 8126 8127 8128 8129 8130 8131 8132 8133 8134 8135 8136 8137 8138 8139 8140 8141 8142 8143 8144 8145 8146 8147 8148 8149 8150 8151 8152 8153 8154 8155 8156 8157 8158 8159 8160 8161 8162 8163 8164 8165 8166 8167 8168 8169 8170 8171 8172 8173 8174 8175 8176 8177 8178 8179 8180 8181 8182 8183 8184 8185 8186 8187 8188 8189 8190 8191 8192 8193 8194 8195 8196 8197 8198 8199 8200 8201 8202 8203 8204 8205 8206 8207 8208 8209 8210 8211 8212 8213 8214 8215 8216 8217 8218 8219 8220 8221 | - - - - - - + - - + + - + - - + + - - - - - - + - + - - + - | case INST_LSHIFT: case INST_RSHIFT: { /* * Reject negative shift argument. */ switch (type2) { |
︙ | |||
8545 8546 8547 8548 8549 8550 8551 | 8375 8376 8377 8378 8379 8380 8381 8382 8383 8384 8385 8386 8387 8388 8389 8390 8391 8392 8393 8394 8395 8396 8397 8398 8399 8400 8401 8402 8403 8404 8405 8406 8407 8408 8409 8410 8411 8412 8413 8414 8415 8416 8417 8418 8419 8420 8421 8422 8423 8424 8425 8426 8427 8428 8429 8430 8431 8432 8433 8434 8435 8436 8437 8438 8439 8440 8441 8442 8443 8444 8445 8446 8447 8448 8449 8450 8451 8452 8453 8454 8455 8456 8457 8458 8459 8460 8461 8462 8463 8464 8465 8466 8467 8468 8469 8470 8471 8472 8473 8474 8475 8476 8477 8478 8479 8480 8481 8482 8483 8484 8485 8486 8487 8488 8489 8490 8491 8492 8493 8494 8495 8496 8497 8498 8499 8500 8501 8502 8503 8504 8505 8506 8507 8508 8509 8510 8511 8512 8513 8514 8515 8516 8517 8518 8519 8520 8521 8522 8523 8524 8525 8526 8527 8528 8529 8530 8531 8532 8533 8534 8535 8536 8537 8538 8539 8540 8541 8542 8543 8544 8545 8546 8547 8548 8549 8550 8551 8552 8553 8554 8555 8556 8557 8558 8559 8560 8561 8562 8563 8564 8565 8566 8567 8568 8569 8570 8571 8572 8573 8574 8575 8576 8577 8578 8579 8580 8581 8582 8583 8584 8585 8586 8587 | - - - - + + - + - + - + - + - + - - - - + + + + - + - - - - - - - - + + - - + + - + - - + + - + - + - + - - + + - - - - - - + + - - + - - - - - - + + - - - - - - - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - - - - - - - + + + - + - + | } mp_clear(&big1); mp_clear(&big2); BIG_RESULT(&bigResult); } |
︙ | |||
8911 8912 8913 8914 8915 8916 8917 | 8650 8651 8652 8653 8654 8655 8656 8657 8658 8659 8660 8661 8662 8663 8664 8665 8666 8667 8668 8669 8670 8671 8672 8673 8674 8675 8676 8677 8678 8679 8680 8681 8682 8683 8684 8685 8686 8687 8688 8689 8690 | - + - + - + - + - | /* * Handle cases of powers > 16 that still fit in a 64-bit word by * doing table lookup. */ if (w1 - 3 >= 0 && w1 - 2 < (long)Exp64IndexSize |
︙ | |||
9018 9019 9020 9021 9022 9023 9024 | 8756 8757 8758 8759 8760 8761 8762 8763 8764 8765 8766 8767 8768 8769 8770 8771 8772 8773 8774 8775 8776 8777 8778 8779 8780 8781 8782 8783 8784 8785 8786 8787 8788 8789 8790 8791 8792 8793 8794 8795 8796 8797 8798 8799 8800 8801 8802 8803 8804 | - - - - - + - | if ((type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) { TclGetWideIntFromObj(NULL, valuePtr, &w1); TclGetWideIntFromObj(NULL, value2Ptr, &w2); switch (opcode) { case INST_ADD: wResult = w1 + w2; |
︙ | |||
9160 9161 9162 9163 9164 9165 9166 | 8893 8894 8895 8896 8897 8898 8899 8900 8901 8902 8903 8904 8905 8906 8907 8908 8909 8910 8911 8912 8913 8914 8915 8916 8917 8918 8919 8920 8921 8922 8923 8924 8925 8926 8927 8928 8929 8930 8931 8932 8933 8934 8935 8936 | - - - - - - - - - - - - | mp_int big; Tcl_Obj *objResultPtr; (void) GetNumberFromObj(NULL, valuePtr, &ptr, &type); switch (opcode) { case INST_BITNOT: |
︙ | |||
9233 9234 9235 9236 9237 9238 9239 | 8954 8955 8956 8957 8958 8959 8960 8961 8962 8963 8964 8965 8966 8967 8968 8969 8970 8971 8972 8973 8974 8975 8976 8977 8978 8979 8980 8981 8982 8983 8984 8985 8986 8987 8988 8989 8990 8991 | - - - - - + + - - - - - - - + - + - + - + | Tcl_Obj *valuePtr, Tcl_Obj *value2Ptr) { int type1 = TCL_NUMBER_NAN, type2 = TCL_NUMBER_NAN, compare; ClientData ptr1, ptr2; mp_int big1, big2; double d1, d2, tmp; |
︙ | |||
9288 9289 9290 9291 9292 9293 9294 | 9000 9001 9002 9003 9004 9005 9006 9007 9008 9009 9010 9011 9012 9013 9014 9015 9016 9017 9018 9019 9020 9021 9022 9023 9024 9025 9026 9027 9028 9029 9030 9031 9032 9033 9034 9035 9036 9037 9038 9039 9040 9041 9042 9043 9044 9045 9046 9047 9048 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | if (d2 < (double)LONG_MIN) { return MP_GT; } if (d2 > (double)LONG_MAX) { return MP_LT; } |
︙ | |||
9406 9407 9408 9409 9410 9411 9412 | 9062 9063 9064 9065 9066 9067 9068 9069 9070 9071 9072 9073 9074 9075 9076 | - - - | Tcl_InitBignumFromDouble(NULL, d1, &big1); goto bigCompare; } case TCL_NUMBER_BIG: Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); switch (type2) { |
︙ | |||
9474 9475 9476 9477 9478 9479 9480 | 9127 9128 9129 9130 9131 9132 9133 9134 9135 9136 9137 9138 9139 9140 9141 9142 9143 | - - - + + + | PrintByteCodeInfo( register ByteCode *codePtr) /* The bytecode whose summary is printed to * stdout. */ { Proc *procPtr = codePtr->procPtr; Interp *iPtr = (Interp *) *codePtr->interpHandle; |
︙ | |||
9622 9623 9624 9625 9626 9627 9628 | 9275 9276 9277 9278 9279 9280 9281 9282 9283 9284 9285 9286 9287 9288 9289 9290 9291 9292 9293 9294 9295 9296 9297 9298 9299 9300 9301 9302 9303 9304 9305 9306 9307 9308 9309 | + + + + + + + + - + + - + - | if (opcode == INST_EXPON) { operator = "**"; } else if (opcode <= INST_LNOT) { operator = operatorStrings[opcode - INST_LOR]; } if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) { int numBytes; const char *bytes = TclGetStringFromObj(opndPtr, &numBytes); if (numBytes == 0) { description = "empty string"; } else if (TclCheckBadOctal(NULL, bytes)) { description = "invalid octal number"; } else { |
︙ |
Changes to generic/tclGet.c.
︙ | |||
138 139 140 141 142 143 144 | 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 | - + | obj.typePtr = NULL; code = TclSetBooleanFromAny(interp, &obj); if (obj.refCount > 1) { Tcl_Panic("invalid sharing of Tcl_Obj on C stack"); } if (code == TCL_OK) { |
︙ |
Changes to generic/tclHistory.c.
︙ | |||
69 70 71 72 73 74 75 76 77 78 79 80 81 82 | 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 | + + + + + + + | * Call Tcl_RecordAndEvalObj to do the actual work. */ cmdPtr = Tcl_NewStringObj(cmd, -1); Tcl_IncrRefCount(cmdPtr); result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags); /* * Move the interpreter's object result to the string result, then * reset the object result. */ (void) Tcl_GetStringResult(interp); /* * Discard the Tcl object created to hold the command. */ Tcl_DecrRefCount(cmdPtr); } else { /* |
︙ |
Changes to generic/tclIO.c.
︙ | |||
9028 9029 9030 9031 9032 9033 9034 9035 9036 9037 9038 9039 9040 9041 9042 9043 9044 9045 9046 9047 9048 9049 9050 9051 9052 | 9028 9029 9030 9031 9032 9033 9034 9035 9036 9037 9038 9039 9040 9041 9042 9043 9044 9045 9046 9047 9048 9049 9050 9051 9052 9053 9054 | + + | * Side effects: * May schedule a background copy operation that causes both channels to * be marked busy. * *---------------------------------------------------------------------- */ #if !defined(TCL_NO_DEPRECATED) int TclCopyChannelOld( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Channel inChan, /* Channel to read from. */ Tcl_Channel outChan, /* Channel to write to. */ int toRead, /* Amount of data to copy, or -1 for all. */ Tcl_Obj *cmdPtr) /* Pointer to script to execute or NULL. */ { return TclCopyChannel(interp, inChan, outChan, (Tcl_WideInt) toRead, cmdPtr); } #endif int TclCopyChannel( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Channel inChan, /* Channel to read from. */ Tcl_Channel outChan, /* Channel to write to. */ Tcl_WideInt toRead, /* Amount of data to copy, or -1 for all. */ |
︙ |
Changes to generic/tclIOCmd.c.
︙ | |||
133 134 135 136 137 138 139 | 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 | - + | case 4: /* [puts -nonewline $chan $x] or * [puts $chan $x nonewline] */ newline = 0; if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) { chanObjPtr = objv[2]; string = objv[3]; break; |
︙ | |||
435 436 437 438 439 440 441 | 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 | - + - + | * Compute how many bytes to read. */ toRead = -1; if (i < objc) { if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK) || (toRead < 0)) { |
︙ |
Changes to generic/tclIORTrans.c.
︙ | |||
83 84 85 86 87 88 89 | 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 | - + | }; /* * Structure of the buffer to hold transform results to be consumed by higher * layers upon reading from the channel, plus the functions to manage such. */ |
︙ | |||
249 250 251 252 253 254 255 | 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 | - + | * command handler thread (CT), and the thread managing the channel (MT), * executed in CT. Tcl_Obj's are not allowed to cross thread boundaries. So we * forward an operation code, the argument details, and reference to results. * The command is assembled in the CT and belongs fully to that thread. No * sharing problems. */ |
︙ | |||
294 295 296 297 298 299 300 | 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 | - + | typedef struct ForwardingResult ForwardingResult; /* * General event structure, with reference to operation specific data. */ |
︙ |
Changes to generic/tclIOUtil.c.
︙ | |||
241 242 243 244 245 246 247 | 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 | - + | * a file system by way of making a temporary copy of the file on the native * filesystem. We need to store both the actual unloadProc/clientData * combination which was used, and the original and modified filenames, so * that we can correctly undo the entire operation when we want to unload the * code. */ |
︙ | |||
408 409 410 411 412 413 414 | 408 409 410 411 412 413 414 415 416 417 418 419 420 421 | - | } Tcl_DStringInit(cwdPtr); TclDStringAppendObj(cwdPtr, cwd); Tcl_DecrRefCount(cwd); return Tcl_DStringValue(cwdPtr); } |
︙ | |||
827 828 829 830 831 832 833 | 826 827 828 829 830 831 832 833 834 835 836 837 838 839 | - - - - - - - - - | void TclResetFilesystem(void) { filesystemList = &nativeFilesystemRecord; if (++theFilesystemEpoch == 0) { ++theFilesystemEpoch; } |
︙ |
Changes to generic/tclIndexObj.c.
︙ | |||
872 873 874 875 876 877 878 | 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 | - + + | Tcl_Obj *const objv[], /* Initial argument objects, which should be * included in the error message. */ const char *message) /* Error message to print after the leading * objects in objv. The message may be * NULL. */ { Tcl_Obj *objPtr; |
︙ |
Changes to generic/tclInt.decls.
︙ | |||
46 47 48 49 50 51 52 | 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 | - + | } declare 6 { void TclCleanupCommand(Command *cmdPtr) } declare 7 { int TclCopyAndCollapse(int count, const char *src, char *dst) } |
︙ | |||
69 70 71 72 73 74 75 | 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 | - + - + | } declare 11 { void TclDeleteCompiledLocalVars(Interp *iPtr, CallFrame *framePtr) } declare 12 { void TclDeleteVars(Interp *iPtr, TclVarHashTable *tablePtr) } |
︙ | |||
110 111 112 113 114 115 116 | 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 | - + - + | int *sizePtr, int *bracePtr) } declare 23 { Proc *TclFindProc(Interp *iPtr, const char *procName) } # Replaced with macro (see tclInt.h) in Tcl 8.5.0, restored in 8.5.10 declare 24 { |
︙ | |||
143 144 145 146 147 148 149 | 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 | - + - + | declare 31 { const char *TclGetExtension(const char *name) } declare 32 { int TclGetFrame(Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr) } |
︙ | |||
181 182 183 184 185 186 187 | 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 | - + - + | } declare 41 { Tcl_Command TclGetOriginalCommand(Tcl_Command command) } declare 42 { CONST86 char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr) } |
︙ | |||
216 217 218 219 220 221 222 | 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 | - + - + - + | declare 50 { void TclInitCompiledLocals(Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr) } declare 51 { int TclInterpInit(Tcl_Interp *interp) } |
︙ | |||
269 270 271 272 273 274 275 | 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 | - + | int TclObjInterpProc(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) } declare 64 { int TclObjInvoke(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags) } |
︙ | |||
309 310 311 312 313 314 315 | 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 | - - - + | } declare 75 { unsigned long TclpGetClicks(void) } declare 76 { unsigned long TclpGetSeconds(void) } |
︙ | |||
353 354 355 356 357 358 359 | 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 | - + | # declare 86 { # int TclParseQuotes(Tcl_Interp *interp, char *str, int termChar, # int flags, char **termPtr, ParseValue *pvPtr) # } # declare 87 { # void TclPlatformInit(Tcl_Interp *interp) # } |
︙ | |||
376 377 378 379 380 381 382 | 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 | - + | int TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, const char *description, const char *procName) } declare 93 { void TclProcDeleteProc(ClientData clientData) } |
︙ | |||
415 416 417 418 419 420 421 | 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 | - + | declare 102 { void TclSetupEnv(Tcl_Interp *interp) } declare 103 { int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto, int *portPtr) } |
︙ | |||
451 452 453 454 455 456 457 | 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 | - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + | declare 111 { void Tcl_AddInterpResolvers(Tcl_Interp *interp, const char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc) } declare 112 { |
︙ | |||
621 622 623 624 625 626 627 | 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 | - - + - - + | declare 156 { void TclRegError(Tcl_Interp *interp, const char *msg, int status) } declare 157 { Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName) } |
︙ | |||
672 673 674 675 676 677 678 | 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 | - - - + - - + | # New function due to TIP #33 declare 166 { int TclListObjSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr) } |
︙ | |||
726 727 728 729 730 731 732 | 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 | - - + - + - - - + - + | declare 176 { void TclCleanupVar(Var *varPtr, Var *arrayPtr) } declare 177 { void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason) } |
︙ | |||
933 934 935 936 937 938 939 | 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 | - - - - + | declare 234 { Var *TclVarHashCreateVar(TclVarHashTable *tablePtr, const char *key, int *newPtr) } declare 235 { void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr) } |
︙ | |||
1086 1087 1088 1089 1090 1091 1092 | 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 | - + | declare 9 win { int TclWinGetPlatformId(void) } # new for 8.4.20+/8.5.12+ Cygwin only declare 10 win { Tcl_DirEntry *TclpReaddir(DIR *dir) } |
︙ | |||
1136 1137 1138 1139 1140 1141 1142 | 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 | - | } declare 19 win { TclFile TclpOpenFile(const char *fname, int mode) } declare 20 win { void TclWinAddProcess(HANDLE hProcess, DWORD id) } |
︙ |
Changes to generic/tclInt.h.
︙ | |||
156 157 158 159 160 161 162 | 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 | - + - + - + | typedef struct Tcl_ResolvedVarInfo { Tcl_ResolveRuntimeVarProc *fetchProc; Tcl_ResolveVarDeleteProc *deleteProc; } Tcl_ResolvedVarInfo; typedef int (Tcl_ResolveCompiledVarProc)(Tcl_Interp *interp, |
︙ | |||
261 262 263 264 265 266 267 | 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 | - + - + | * strings; values have type (Namespace *). */ #else Tcl_HashTable *childTablePtr; /* Contains any child namespaces. Indexed by * strings; values have type (Namespace *). If * NULL, there are no children. */ #endif |
︙ | |||
295 296 297 298 299 300 301 | 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 | - + - + | * commands; however, no namespace qualifiers * are allowed. NULL if no export patterns are * registered. */ int numExportPatterns; /* Number of export patterns currently * registered using "namespace export". */ int maxExportPatterns; /* Mumber of export patterns for which space * is currently allocated. */ |
︙ | |||
327 328 329 330 331 332 333 | 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 | - + | Tcl_ResolveCompiledVarProc *compiledVarResProc; /* If non-null, this procedure overrides the * usual variable resolution mechanism in Tcl. * This procedure is invoked within * LookupCompiledLocal to resolve variable * references within the namespace at compile * time. */ |
︙ | |||
422 423 424 425 426 427 428 | 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 | - + - + | * commands that are actually exported by the namespace, and an epoch counter * that, combined with the exportLookupEpoch field of the namespace structure, * defines whether the table contains valid data or will need to be recomputed * next time the ensemble command is called. */ typedef struct EnsembleConfig { |
︙ | |||
541 542 543 544 545 546 547 | 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 | - + | ClientData clientData; /* Argument to pass to proc. */ int flags; /* What events the trace procedure is * interested in: OR-ed combination of * TCL_TRACE_RENAME, TCL_TRACE_DELETE. */ struct CommandTrace *nextPtr; /* Next in list of traces associated with a * particular command. */ |
︙ | |||
614 615 616 617 618 619 620 | 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 | - + | * "upvar", this field points to the * referenced variable's Var struct. */ } value; } Var; typedef struct VarInHash { Var var; |
︙ | |||
946 947 948 949 950 951 952 | 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 | - + | * collection of Tcl commands plus information about arguments and other local * variables recognized at compile time. */ typedef struct Proc { struct Interp *iPtr; /* Interpreter for which this command is * defined. */ |
︙ | |||
1063 1064 1065 1066 1067 1068 1069 | 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 | - + | /* * Will be grown to contain: pointers to the varnames (allocated at the end), * plus the init values for each variable (suitable to be memcopied on init) */ typedef struct LocalCache { |
︙ | |||
1225 1226 1227 1228 1229 1230 1231 | 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 | - + | * TclArgumentBCEnter(). These will be removed * by TclArgumentBCRelease. */ } CmdFrame; typedef struct CFWord { CmdFrame *framePtr; /* CmdFrame to access. */ int word; /* Index of the word in the command. */ |
︙ | |||
1488 1489 1490 1491 1492 1493 1494 | 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 | - + - + - + | typedef struct LiteralEntry { struct LiteralEntry *nextPtr; /* Points to next entry in this hash bucket or * NULL if end of chain. */ Tcl_Obj *objPtr; /* Points to Tcl object that holds the * literal's bytes and length. */ |
︙ | |||
1630 1631 1632 1633 1634 1635 1636 | 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 | - + - + | * from its Tcl_Command handle. NULL means * that the hash table entry has been removed * already (this can happen if deleteProc * causes the command to be deleted or * recreated). */ Namespace *nsPtr; /* Points to the namespace containing this * command. */ |
︙ | |||
1769 1770 1771 1772 1773 1774 1775 | 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 | - - - + + + - - - - - + + + + + + + + + + - - + + + + + + + + + + - - - - + + + + - - + - - + - - + | * variable storage. Primary responsibility for this data structure is in * tclBasic.c, but almost every Tcl source file uses something in here. *---------------------------------------------------------------- */ typedef struct Interp { /* |
︙ | |||
1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 | 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 | + + + + + + + + + + + + + + + + + + + | * or NULL if no active traces. */ int returnCode; /* [return -code] parameter. */ CallFrame *rootFramePtr; /* Global frame pointer for this * interpreter. */ Namespace *lookupNsPtr; /* Namespace to use ONLY on the next * TCL_EVAL_INVOKE call to Tcl_EvalObjv. */ /* * Information used by Tcl_AppendResult to keep track of partial results. * See Tcl_AppendResult code for details. */ #if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 char *appendResult; /* Storage space for results generated by * Tcl_AppendResult. Ckalloc-ed. NULL means * not yet allocated. */ int appendAvl; /* Total amount of space available at * partialResult. */ int appendUsed; /* Number of non-null bytes currently stored * at partialResult. */ #else char *appendResultDontUse; int appendAvlDontUse; int appendUsedDontUse; #endif /* * Information about packages. Used only in tclPkg.c. */ Tcl_HashTable packageTable; /* Describes all of the packages loaded in or * available to this interpreter. Keys are * package names, values are (Package *) |
︙ | |||
1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 | 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 | + | int cmdCount; /* Total number of times a command procedure * has been called for this interpreter. */ int evalFlags; /* Flags to control next call to Tcl_Eval. * Normally zero, but may be set before * calling Tcl_Eval. See below for valid * values. */ int unused1; /* No longer used (was termOffset) */ LiteralTable literalTable; /* Contains LiteralEntry's describing all Tcl * objects holding literals of scripts * compiled by the interpreter. Indexed by the * string representations of literals. Used to * avoid creating duplicate objects. */ unsigned int compileEpoch; /* Holds the current "compilation epoch" for * this interpreter. This is incremented to |
︙ | |||
1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 | 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 | + + + + + + + + | struct ExecEnv *execEnvPtr; /* Execution environment for Tcl bytecode * execution. Contains a pointer to the Tcl * evaluation stack. */ Tcl_Obj *emptyObjPtr; /* Points to an object holding an empty * string. Returned by Tcl_ObjSetVar2 when * variable traces change a variable in a * gross way. */ #if TCL_MAJOR_VERSION < 9 # if !defined(TCL_NO_DEPRECATED) char resultSpace[TCL_DSTRING_STATIC_SIZE+1]; /* Static space holding small results. */ # else char resultSpaceDontUse[TCL_DSTRING_STATIC_SIZE+1]; # endif #endif Tcl_Obj *objResultPtr; /* If the last command returned an object * result, this points to it. Should not be * accessed directly; see comment above. */ Tcl_ThreadId threadId; /* ID of thread that owns the interpreter. */ ActiveCommandTrace *activeCmdTracePtr; /* First in list of active command traces for |
︙ | |||
2211 2212 2213 2214 2215 2216 2217 | 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 | - + | * instructions. This is set 1, for example, when command * traces are requested. * RAND_SEED_INITIALIZED: Non-zero means that the randSeed value of the interp * has not be initialized. This is set 1 when we first * use the rand() or srand() functions. * SAFE_INTERP: Non zero means that the current interp is a safe * interp (i.e. it has only the safe commands installed, |
︙ | |||
2344 2345 2346 2347 2348 2349 2350 | 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 | - + - + | * struct is grown (reallocated and copied) as necessary to hold all the * list's element pointers. The struct might contain more slots than currently * used to hold all element pointers. This is done to make append operations * faster. */ typedef struct List { |
︙ | |||
2411 2412 2413 2414 2415 2416 2417 2418 2419 | 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 | + - + - + - - - - + + + - - - - - - + + + + + - - - + + + - - - + + + - - - - - - - - + - - - - - + - + | /* * Macros providing a faster path to integers: Tcl_GetLongFromObj, * Tcl_GetIntFromObj and TclGetIntForIndex. * * WARNING: these macros eval their args more than once. */ #ifdef TCL_WIDE_INT_IS_LONG #define TclGetLongFromObj(interp, objPtr, longPtr) \ (((objPtr)->typePtr == &tclIntType) \ |
︙ | |||
2586 2587 2588 2589 2590 2591 2592 | 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 | - + - + - + | /* *---------------------------------------------------------------- * Data structures for process-global values. *---------------------------------------------------------------- */ |
︙ | |||
2688 2689 2690 2691 2692 2693 2694 | 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 2727 | - - - | MODULE_SCOPE const Tcl_ObjType tclEndOffsetType; MODULE_SCOPE const Tcl_ObjType tclIntType; MODULE_SCOPE const Tcl_ObjType tclListType; MODULE_SCOPE const Tcl_ObjType tclDictType; MODULE_SCOPE const Tcl_ObjType tclProcBodyType; MODULE_SCOPE const Tcl_ObjType tclStringType; MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType; |
︙ | |||
2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 | 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 | + | MODULE_SCOPE Tcl_ObjCmdProc TclNREvalObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRCatchObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRExprObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRForObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRForeachCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRIfObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRLmapCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRPackageObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRSourceObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRSubstObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRSwitchObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRTryObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRUplevelObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRWhileObjCmd; |
︙ | |||
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 | 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 | + + + + + + + + + + + + + + + + + - + | MODULE_SCOPE double TclBignumToDouble(const mp_int *bignum); MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string, int strLen, const unsigned char *pattern, int ptnLen, int flags); MODULE_SCOPE double TclCeil(const mp_int *a); MODULE_SCOPE void TclChannelPreserve(Tcl_Channel chan); MODULE_SCOPE void TclChannelRelease(Tcl_Channel chan); MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp, const char *value); MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp, Tcl_Channel chan); MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd; MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble; MODULE_SCOPE int TclCompareTwoNumbers(Tcl_Obj *valuePtr, Tcl_Obj *value2Ptr); MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, int num, int *loc); MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj *objPtr, int start, int *clNext); MODULE_SCOPE ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr); MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr, Tcl_Obj *originObjPtr); MODULE_SCOPE int TclConvertElement(const char *src, int length, char *dst, int flags); MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs ( Tcl_Interp *interp, const char *cmdName, Tcl_Namespace *nsPtr, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs( Tcl_Interp *interp, const char *name, Tcl_Namespace *nameNamespacePtr, Tcl_Namespace *ensembleNamespacePtr, int flags); MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr); MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp, const char *dict, int dictLength, const char **elementPtr, const char **nextPtr, int *sizePtr, int *literalPtr); |
︙ | |||
2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 | 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 | + + | 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 TclFinalizeEnvironment(void); MODULE_SCOPE void TclFinalizeEvaluation(void); MODULE_SCOPE void TclFinalizeExecution(void); |
︙ | |||
2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 | 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 | + + + + + + + + + | MODULE_SCOPE void TclFinalizeThreadAllocThread(void); MODULE_SCOPE void TclFinalizeThreadData(int quick); MODULE_SCOPE void TclFinalizeThreadObjects(void); MODULE_SCOPE double TclFloor(const mp_int *a); MODULE_SCOPE void TclFormatNaN(double value, char *buffer); MODULE_SCOPE int TclFSFileAttrIndex(Tcl_Obj *pathPtr, const char *attributeName, int *indexPtr); MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs ( Tcl_Interp *interp, const char *cmdName, Tcl_Namespace *nsPtr, Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); MODULE_SCOPE int TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *encodingName); MODULE_SCOPE void TclFSUnloadTempFile(Tcl_LoadHandle loadHandle); MODULE_SCOPE int * TclGetAsyncReadyPtr(void); MODULE_SCOPE Tcl_Obj * TclGetBgErrorHandler(Tcl_Interp *interp); MODULE_SCOPE int TclGetChannelFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Channel *chanPtr, |
︙ | |||
3055 3056 3057 3058 3059 3060 3061 | 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 | - + | const char *host, int port, int willBind, const char **errorMsgPtr); MODULE_SCOPE int TclpThreadCreate(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, ClientData clientData, int stackSize, int flags); MODULE_SCOPE int TclpFindVariable(const char *name, int *lengthPtr); MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr, |
︙ | |||
3089 3090 3091 3092 3093 3094 3095 | 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 | - - + - - - - - - - - - - + | Tcl_Obj *resultingNameObj); MODULE_SCOPE void TclPkgFileSeen(Tcl_Interp *interp, const char *fileName); MODULE_SCOPE void *TclInitPkgFiles(Tcl_Interp *interp); MODULE_SCOPE Tcl_Obj * TclPathPart(Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_PathPart portion); MODULE_SCOPE char * TclpReadlink(const char *fileName, Tcl_DString *linkPtr); |
︙ | |||
3198 3199 3200 3201 3202 3203 3204 | 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 | - + | Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitArrayCmd(Tcl_Interp *interp); MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp); MODULE_SCOPE int Tcl_BreakObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); |
︙ | |||
3937 3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 | 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 3997 3998 3999 4000 4001 4002 4003 4004 4005 4006 4007 4008 4009 4010 4011 4012 | + + + + + + + + + + + + + + + + + + + + | Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileAssembleCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); /* * Routines that provide the [string] ensemble functionality. Possible * candidates for public interface. */ MODULE_SCOPE Tcl_Obj * TclStringCat(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); MODULE_SCOPE int TclStringFirst(Tcl_Obj *needle, Tcl_Obj *haystack, int start); MODULE_SCOPE int TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack, int last); MODULE_SCOPE Tcl_Obj * TclStringRepeat(Tcl_Interp *interp, Tcl_Obj *objPtr, int count, int flags); MODULE_SCOPE Tcl_Obj * TclStringReverse(Tcl_Obj *objPtr, int flags); /* Flag values for the [string] ensemble functions. */ #define TCL_STRING_MATCH_NOCASE TCL_MATCH_NOCASE /* (1<<0) in tcl.h */ #define TCL_STRING_IN_PLACE (1<<1) /* * Functions defined in generic/tclVar.c and currently exported only for use * by the bytecode compiler and engine. Some of these could later be placed in * the public interface. */ MODULE_SCOPE Var * TclObjLookupVarEx(Tcl_Interp * interp, |
︙ | |||
4376 4377 4378 4379 4380 4381 4382 | 4438 4439 4440 4441 4442 4443 4444 4445 4446 4447 4448 4449 4450 4451 4452 | - + | * the result of Tcl_UtfToUniChar. The ANSI C "prototype" for this macro is: * * MODULE_SCOPE int TclUtfToUniChar(const char *string, Tcl_UniChar *ch); *---------------------------------------------------------------- */ #define TclUtfToUniChar(str, chPtr) \ |
︙ | |||
4501 4502 4503 4504 4505 4506 4507 | 4563 4564 4565 4566 4567 4568 4569 4570 4571 4572 4573 4574 4575 4576 4577 4578 4579 4580 4581 4582 4583 4584 4585 4586 4587 4588 4589 4590 4591 4592 4593 4594 4595 4596 4597 4598 4599 4600 4601 4602 4603 4604 4605 4606 4607 4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 4618 4619 | - - + - + - + - - - - - - - - - - - - + - + - + | /* *---------------------------------------------------------------- * Macros used by the Tcl core to set a Tcl_Obj's numeric representation * avoiding the corresponding function calls in time critical parts of the * core. They should only be called on unshared objects. The ANSI C * "prototypes" for these macros are: * |
︙ | |||
4582 4583 4584 4585 4586 4587 4588 | 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 | - - + + | (objPtr)->refCount = 0; \ TclInitStringRep((objPtr), (s), (len)); \ (objPtr)->typePtr = NULL; \ TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) #else /* TCL_MEM_DEBUG */ |
︙ |
Changes to generic/tclIntDecls.h.
︙ | |||
24 25 26 27 28 29 30 | 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 | - - - - - - - - - - - - - + + + + + + + + + + + + + + - - + | # ifdef USE_TCL_STUBS # define TCL_STORAGE_CLASS # else # define TCL_STORAGE_CLASS DLLIMPORT # endif #endif |
︙ | |||
71 72 73 74 75 76 77 | 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 | + - + | Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 6 */ EXTERN void TclCleanupCommand(Command *cmdPtr); /* 7 */ EXTERN int TclCopyAndCollapse(int count, const char *src, char *dst); /* 8 */ TCL_DEPRECATED("") |
︙ | |||
109 110 111 112 113 114 115 | 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 | - + | const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, int *sizePtr, int *bracePtr); /* 23 */ EXTERN Proc * TclFindProc(Interp *iPtr, const char *procName); /* 24 */ |
︙ | |||
169 170 171 172 173 174 175 | 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 | - + | CallFrame *framePtr, Namespace *nsPtr); /* 51 */ EXTERN int TclInterpInit(Tcl_Interp *interp); /* Slot 52 is reserved */ /* 53 */ EXTERN int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp, int argc, |
︙ | |||
214 215 216 217 218 219 220 | 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 | + - + + - + | /* 74 */ EXTERN void TclpFree(char *ptr); /* 75 */ EXTERN unsigned long TclpGetClicks(void); /* 76 */ EXTERN unsigned long TclpGetSeconds(void); /* 77 */ TCL_DEPRECATED("") |
︙ | |||
263 264 265 266 267 268 269 | 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 | + - + - + - + - + - + - + - + - + - + - + - + - + - + + - + - - + - - + | EXTERN CONST86 char * TclSetPreInitScript(const char *string); /* 102 */ EXTERN void TclSetupEnv(Tcl_Interp *interp); /* 103 */ EXTERN int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* 104 */ TCL_DEPRECATED("") |
︙ | |||
397 398 399 400 401 402 403 | 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 | + - + + - + + - + + - + | /* 156 */ EXTERN void TclRegError(Tcl_Interp *interp, const char *msg, int status); /* 157 */ EXTERN Var * TclVarTraceExists(Tcl_Interp *interp, const char *varName); /* 158 */ TCL_DEPRECATED("use public Tcl_SetStartupScript()") |
︙ | |||
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 | - + - + + - + + - + | /* 176 */ EXTERN void TclCleanupVar(Var *varPtr, Var *arrayPtr); /* 177 */ EXTERN void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); /* 178 */ |
︙ | |||
566 567 568 569 570 571 572 | 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 | + - + | /* 234 */ EXTERN Var * TclVarHashCreateVar(TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 235 */ EXTERN void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr); /* 236 */ TCL_DEPRECATED("use Tcl_BackgroundException") |
︙ | |||
648 649 650 651 652 653 654 | 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 | - + - + | void (*reserved1)(void); void (*reserved2)(void); void (*tclAllocateFreeObjects) (void); /* 3 */ void (*reserved4)(void); int (*tclCleanupChildren) (Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 5 */ void (*tclCleanupCommand) (Command *cmdPtr); /* 6 */ int (*tclCopyAndCollapse) (int count, const char *src, char *dst); /* 7 */ |
︙ | |||
693 694 695 696 697 698 699 | 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 | - + | int (*tclInExit) (void); /* 46 */ void (*reserved47)(void); void (*reserved48)(void); void (*reserved49)(void); void (*tclInitCompiledLocals) (Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr); /* 50 */ int (*tclInterpInit) (Tcl_Interp *interp); /* 51 */ void (*reserved52)(void); |
︙ | |||
717 718 719 720 721 722 723 | 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 | - + - + - + - - - - - - + + + + + + - - - - - + + + + + - + - + - + - + - - + + - - + + - - + + - - + + | void (*reserved70)(void); void (*reserved71)(void); void (*reserved72)(void); void (*reserved73)(void); void (*tclpFree) (char *ptr); /* 74 */ unsigned long (*tclpGetClicks) (void); /* 75 */ unsigned long (*tclpGetSeconds) (void); /* 76 */ |
︙ | |||
876 877 878 879 880 881 882 | 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 | - + | int (*tclPtrMakeUpvar) (Tcl_Interp *interp, Var *otherP1Ptr, const char *myName, int myFlags, int index); /* 229 */ Var * (*tclObjLookupVar) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, const char *part2, int flags, const char *msg, const int createPart1, const int createPart2, Var **arrayPtrPtr); /* 230 */ int (*tclGetNamespaceFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); /* 231 */ int (*tclEvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 232 */ void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */ Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */ void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */ |
︙ | |||
1084 1085 1086 1087 1088 1089 1090 | 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 | - - - - - - - - - - - - + + + + + + + + + + + + - - - - - - - - - - + + + + + + + + + + - - + + | (tclIntStubsPtr->tclTeardownNamespace) /* 108 */ #define TclUpdateReturnInfo \ (tclIntStubsPtr->tclUpdateReturnInfo) /* 109 */ #define TclSockMinimumBuffers \ (tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */ #define Tcl_AddInterpResolvers \ (tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */ |
︙ | |||
1206 1207 1208 1209 1210 1211 1212 | 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 | - - - - + + + + | /* Slot 174 is reserved */ #define TclCallVarTraces \ (tclIntStubsPtr->tclCallVarTraces) /* 175 */ #define TclCleanupVar \ (tclIntStubsPtr->tclCleanupVar) /* 176 */ #define TclVarErrMsg \ (tclIntStubsPtr->tclVarErrMsg) /* 177 */ |
︙ | |||
1346 1347 1348 1349 1350 1351 1352 | 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 | + - - - - - + + + + + - - - + - - - + - - - + - - - + - - - - - - + - - - + - - - + - - - - + + - - + - - - - - - + - - - - - - - + + + + + - - - - | #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT #if defined(USE_TCL_STUBS) |
Changes to generic/tclIntPlatDecls.h.
︙ | |||
551 552 553 554 555 556 557 | 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 | + + + + - - - - + + + + + + + + | #define TclpInetNtoa inet_ntoa #if defined(_WIN32) # undef TclWinNToHS # undef TclWinGetServByName # undef TclWinGetSockOpt # undef TclWinSetSockOpt # undef TclWinGetPlatformId # undef TclWinResetInterfaces # undef TclWinSetInterfaces # if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 |
Changes to generic/tclInterp.c.
︙ | |||
3204 3205 3206 3207 3208 3209 3210 | 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 | - - - - | * master; the overall implementations are safe, but they're normally * defined by init.tcl which is not sourced by safe interpreters. * Assume these functions all work. [Bug 2895741] */ (void) Tcl_EvalEx(interp, "namespace eval ::tcl {namespace eval mathfunc {}}", -1, 0); |
︙ |
Changes to generic/tclLink.c.
︙ | |||
650 651 652 653 654 655 656 | 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 | - + | static int SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static Tcl_ObjType invalidRealType = { "invalidReal", /* name */ NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ NULL, /* updateStringProc */ |
︙ |
Changes to generic/tclListObj.c.
︙ | |||
51 52 53 54 55 56 57 | 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 | - - - - + + + + - + - - - - + + + - + - - - + + | #endif /* *---------------------------------------------------------------------- * * NewListIntRep -- * |
︙ | |||
130 131 132 133 134 135 136 | 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 | - + + + + + + + + - - + + + + + + + | } return listRepPtr; } /* *---------------------------------------------------------------------- * |
︙ | |||
165 166 167 168 169 170 171 | 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 | + - + - + + - + + + - - - - + + + + - + - - - + + | } /* *---------------------------------------------------------------------- * * Tcl_NewListObj -- * * This function is normally called when not debugging: i.e., when |
︙ | |||
229 230 231 232 233 234 235 | 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 | - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + | return listPtr; } #endif /* if TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- * |
︙ | |||
297 298 299 300 301 302 303 | 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 | - - + + + + + + + + + + + + + | #endif /* TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- * * Tcl_SetListObj -- * |
︙ | |||
342 343 344 345 346 347 348 | 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 | - - - + + + - - - - - + + + + + - - - + + - | } /* *---------------------------------------------------------------------- * * TclListObjCopy -- * |
︙ | |||
385 386 387 388 389 390 391 | 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 | - - + + - - - - - + + + + + + + - - - - - - + + + + + + - - - - - - + - - + + | } /* *---------------------------------------------------------------------- * * Tcl_ListObjGetElements -- * |
︙ | |||
449 450 451 452 453 454 455 | 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 | - + + - + - - + - - - - + - - - + - + - - - - - - + + + + + - | } /* *---------------------------------------------------------------------- * * Tcl_ListObjAppendList -- * |
︙ | |||
508 509 510 511 512 513 514 | 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 | - + + + + - + - - + - - + - - - - - - + + + - + - - - - - - + + + + + | } /* *---------------------------------------------------------------------- * * Tcl_ListObjAppendElement -- * |
︙ | |||
679 680 681 682 683 684 685 | 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 | - - - - + + + + + - + - - - - - - + + + + + - - + - - - + - + - - + | } /* *---------------------------------------------------------------------- * * Tcl_ListObjIndex -- * |
︙ | |||
741 742 743 744 745 746 747 | 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 | - + + + - + - - + - - - + + + + - - - - + + - | } /* *---------------------------------------------------------------------- * * Tcl_ListObjLength -- * |
︙ | |||
790 791 792 793 794 795 796 | 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 | - + + + + - - - + + + - - - + + + - - - - - - + + + + + + - + - - - + + - + - - - + - - + - - - + + + | } /* *---------------------------------------------------------------------- * * Tcl_ListObjReplace -- * |
︙ | |||
1077 1078 1079 1080 1081 1082 1083 | 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 | - + - - - - + + + + - - + + - - - + + + + + + | } /* *---------------------------------------------------------------------- * * TclLindexList -- * |
︙ | |||
1161 1162 1163 1164 1165 1166 1167 | 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 | - + - - + + - + + + + - - - + + + + + + - - + + - | Tcl_DecrRefCount(indexListCopy); return listPtr; } /* *---------------------------------------------------------------------- * |
︙ | |||
1250 1251 1252 1253 1254 1255 1256 | 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 | - + - - + + + + - + + - - + + + + + + | } /* *---------------------------------------------------------------------- * * TclLsetList -- * |
︙ | |||
1321 1322 1323 1324 1325 1326 1327 | 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 | - - - + + + + - - - - + + + + + - - - + - - - - - - - + + + + + - - - - + - - - - - + + + + + + + - - + + - + | /* *---------------------------------------------------------------------- * * TclLsetFlat -- * * Core engine of the 'lset' command. * |
︙ | |||
1568 1569 1570 1571 1572 1573 1574 | 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 | - + - - - - + - - + - - - - - - - + + - - - - - - - - + + + + - + - - - + + - - - + + + + + | } /* *---------------------------------------------------------------------- * * TclListObjSetElement -- * |
︙ | |||
1717 1718 1719 1720 1721 1722 1723 | 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 | - - + + - + + + - - - + + + | } /* *---------------------------------------------------------------------- * * FreeListInternalRep -- * |
︙ | |||
1753 1754 1755 1756 1757 1758 1759 | 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 | - + - + + + - + - + - + - - + - - + - + - + - - + - - + | } /* *---------------------------------------------------------------------- * * DupListInternalRep -- * |
︙ | |||
1916 1917 1918 1919 1920 1921 1922 | 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 | - + - - - + + - + + - - - + + + + + - - + + | } /* *---------------------------------------------------------------------- * * UpdateStringOfList -- * |
︙ | |||
1972 1973 1974 1975 1976 1977 1978 | 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 | - + | if (numElems <= LOCAL_SIZE) { flagPtr = localFlags; } else { /* * We know numElems <= LIST_MAX, so this is safe. */ |
︙ |
Changes to generic/tclLiteral.c.
︙ | |||
182 183 184 185 186 187 188 | 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 | - + | int *newPtr, Namespace *nsPtr, int flags, LiteralEntry **globalPtrPtr) { LiteralTable *globalTablePtr = &iPtr->literalTable; LiteralEntry *globalPtr; |
︙ | |||
389 390 391 392 393 394 395 | 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 | + - + | { CompileEnv *envPtr = ePtr; Interp *iPtr = envPtr->iPtr; LiteralTable *localTablePtr = &envPtr->localLitTable; LiteralEntry *globalPtr, *localPtr; Tcl_Obj *objPtr; unsigned hash; unsigned int localHash; |
︙ | |||
533 534 535 536 537 538 539 | 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 | - + + - + | register CompileEnv *envPtr,/* Points to CompileEnv whose literal array * contains the entry being hidden. */ int index) /* The index of the entry in the literal * array. */ { LiteralEntry **nextPtrPtr, *entryPtr, *lPtr; LiteralTable *localTablePtr = &envPtr->localLitTable; |
︙ | |||
608 609 610 611 612 613 614 | 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 | - + | } objIndex = envPtr->literalArrayNext; envPtr->literalArrayNext++; lPtr = &envPtr->literalArrayPtr[objIndex]; lPtr->objPtr = objPtr; Tcl_IncrRefCount(objPtr); |
︙ | |||
805 806 807 808 809 810 811 | 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 | - + + - - - + | * previously created by a call to * TclRegisterLiteral. */ { Interp *iPtr = (Interp *) interp; LiteralTable *globalTablePtr; register LiteralEntry *entryPtr, *prevPtr; const char *bytes; |
︙ | |||
950 951 952 953 954 955 956 | 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 | - - + + | /* Local or global table to enlarge. */ { LiteralEntry **oldBuckets; register LiteralEntry **oldChainPtr, **newChainPtr; register LiteralEntry *entryPtr; LiteralEntry **bucketPtr; const char *bytes; |
︙ |
Changes to generic/tclLoad.c.
︙ | |||
466 467 468 469 470 471 472 | 466 467 468 469 470 471 472 473 474 475 476 477 478 479 | - - - - - - - - - - - | /* * Test for whether the initialization failed. If so, transfer the error * from the target interpreter to the originating one. */ if (code != TCL_OK) { |
︙ |
Changes to generic/tclMain.c.
︙ | |||
262 263 264 265 266 267 268 | 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 | - - - - + - | } else { /* * Test for the existence of the rc file before trying to read it. */ c = Tcl_OpenFileChannel(NULL, fullName, "r", 0); if (c != NULL) { |
︙ |
Changes to generic/tclNamesp.c.
︙ | |||
28 29 30 31 32 33 34 | 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 | - + | /* * Thread-local storage used to avoid having a global lock on data that is not * limited to a single interpreter. */ typedef struct { |
︙ | |||
398 399 400 401 402 403 404 | 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 | - + | if (framePtr->varTablePtr != NULL) { TclDeleteVars(iPtr, framePtr->varTablePtr); ckfree(framePtr->varTablePtr); framePtr->varTablePtr = NULL; } if (framePtr->numCompiledLocals > 0) { TclDeleteCompiledLocalVars(iPtr, framePtr); |
︙ | |||
911 912 913 914 915 916 917 918 919 920 921 922 923 924 | 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 | + + + + + | Interp *iPtr = (Interp *) nsPtr->interp; Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace((Tcl_Interp *) iPtr); Tcl_HashEntry *entryPtr; Tcl_HashSearch search; Command *cmdPtr; /* * Ensure that this namespace doesn't get deallocated in the meantime. */ nsPtr->refCount++; /* * Give anyone interested - notably TclOO - a chance to use this namespace * normally despite the fact that the namespace is going to go. Allows the * calling of destructors. Will only be called once (unless re-established * by the called function). [Bug 2950259] * * Note that setting this field requires access to the internal definition |
︙ | |||
1043 1044 1045 1046 1047 1048 1049 | 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 | - - - - - - - - - + - + | if (nsPtr->childTablePtr != NULL) { Tcl_DeleteHashTable(nsPtr->childTablePtr); ckfree(nsPtr->childTablePtr); } #endif Tcl_DeleteHashTable(&nsPtr->cmdTable); |
︙ | |||
2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 | 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 | + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | Tcl_DStringFree(&buffer); return TCL_OK; } /* *---------------------------------------------------------------------- * * TclEnsureNamespace -- * * Provide a namespace that is not deleted. * * Value * * namespacePtr, if it is not scheduled for deletion, or a pointer to a * new namespace with the same name otherwise. * * Effect * None. * *---------------------------------------------------------------------- */ Tcl_Namespace * TclEnsureNamespace( Tcl_Interp *interp, Tcl_Namespace *namespacePtr) { Namespace *nsPtr = (Namespace *) namespacePtr; if (!(nsPtr->flags & NS_DYING)) { return namespacePtr; } return Tcl_CreateNamespace(interp, nsPtr->fullName, NULL, NULL); } /* *---------------------------------------------------------------------- * * Tcl_FindNamespace -- * * Searches for a namespace. * * Results: * Returns a pointer to the namespace if it is found. Otherwise, returns * NULL and leaves an error message in the interpreter's result object if |
︙ | |||
2634 2635 2636 2637 2638 2639 2640 | 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 | - + | } } } } else { Namespace *nsPtr[2]; register int search; |
︙ |
Changes to generic/tclOO.c.
1 2 3 4 5 6 7 8 9 10 11 12 13 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | + | /* * tclOO.c -- * * This file contains the object-system core (NB: not Tcl_Obj, but ::oo) * * Copyright (c) 2005-2012 by Donal K. Fellows * Copyright (c) 2017 by Nathan Coulter * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifdef HAVE_CONFIG_H #include "config.h" |
︙ | |||
54 55 56 57 58 59 60 | 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 | - + - - + + + + + + - | /* * 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, |
︙ | |||
224 225 226 227 228 229 230 | 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 | - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | * * The ocPtr parameter (only in these macros) is assumed to work fine with * either an oPtr or a classPtr. Note that the roots oo::object and oo::class * have _both_ their object and class flags tagged with ROOT_OBJECT and * ROOT_CLASS respectively. */ |
︙ | |||
371 372 373 374 375 376 377 | 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 | - + - - - - - + - - - - - - - - - - - - - - | objdefCmds[i].objProc, INT2PTR(objdefCmds[i].flag), NULL); Tcl_DStringFree(&buffer); } Tcl_CallWhenDeleted(interp, KillFoundation, NULL); /* |
︙ | |||
459 460 461 462 463 464 465 466 467 468 469 470 471 472 | 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 | + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | */ if (TclOODefineSlots(fPtr) != TCL_OK) { return TCL_ERROR; } return Tcl_EvalEx(interp, slotScript, -1, 0); } /* * ---------------------------------------------------------------------- * * InitClassSystemRoots -- * * Creates the objects at the core of the object system. These need to be * spliced manually. * * ---------------------------------------------------------------------- */ static void InitClassSystemRoots( Tcl_Interp *interp, Foundation *fPtr) { Class fakeCls; Object fakeObject; /* * 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)); fPtr->classCls = AllocClass(interp, AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL)); /* * Rewire bootstrapped objects. */ fPtr->objectCls->thisPtr->selfCls = fPtr->classCls; fPtr->classCls->thisPtr->selfCls = fPtr->classCls; AddRef(fPtr->objectCls->thisPtr); AddRef(fPtr->classCls->thisPtr); AddRef(fPtr->classCls->thisPtr->selfCls->thisPtr); AddRef(fPtr->objectCls->thisPtr->selfCls->thisPtr); /* * Special initialization for the primordial objects. */ fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT; fPtr->objectCls->flags |= ROOT_OBJECT; /* * This is why it is unnecessary in this routine to make up for the * incremented reference count of fPtr->objectCls that was sallwed by * fakeObject. */ fPtr->objectCls->superclasses.num = 0; ckfree(fPtr->objectCls->superclasses.list); fPtr->objectCls->superclasses.list = NULL; fPtr->classCls->thisPtr->flags |= ROOT_CLASS; fPtr->classCls->flags |= ROOT_CLASS; /* * Standard initialization for new Objects. */ TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls); TclOOAddToInstances(fPtr->classCls->thisPtr, fPtr->classCls); TclOOAddToSubclasses(fPtr->classCls, fPtr->objectCls); /* * THIS IS THE ONLY FUNCTION THAT DOES NON-STANDARD CLASS SPLICING. * Everything else is careful to prohibit looping. */ } /* * ---------------------------------------------------------------------- * * DeletedDefineNamespace, DeletedObjdefNamespace, DeletedHelpersNamespace -- * * Simple helpers used to clear fields of the foundation when they no |
︙ | |||
518 519 520 521 522 523 524 | 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 | - - - - + + + + + + + - + - + - - + - | ClientData clientData, /* Pointer to the OO system foundation * structure. */ Tcl_Interp *interp) /* The interpreter containing the OO system * foundation. */ { Foundation *fPtr = GetFoundation(interp); |
︙ | |||
630 631 632 633 634 635 636 | 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 | - + - + + + + + + + - + - - - - + + + + - - - - - + + - - - - - - - + + - - - - - + - - - - - - - - - - - - + - - - | /* * Set up a callback to get notification of the deletion of a namespace * when enough of the namespace still remains to execute commands and * access variables in it. [Bug 2950259] */ |
︙ | |||
751 752 753 754 755 756 757 | 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 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 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 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - + - + - - - - - - - + - - - - - - - - - - - - - - - - - - - - - - - - + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | oPtr->myCommand = NULL; } /* * ---------------------------------------------------------------------- * |
︙ | |||
1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 | 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 | + + + + + + + + + + + + + + + + + + + + + + + + + | FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) { metadataTypePtr->deleteProc(value); } Tcl_DeleteHashTable(clsPtr->metadataPtr); ckfree(clsPtr->metadataPtr); clsPtr->metadataPtr = NULL; } FOREACH(tmpClsPtr, clsPtr->mixins) { TclOORemoveFromMixinSubs(clsPtr, tmpClsPtr); } FOREACH(tmpClsPtr, clsPtr->superclasses) { TclOORemoveFromSubclasses(clsPtr, tmpClsPtr); } FOREACH_HASH_VALUE(mPtr, &clsPtr->classMethods) { TclOODelMethodRef(mPtr); } Tcl_DeleteHashTable(&clsPtr->classMethods); TclOODelMethodRef(clsPtr->constructorPtr); TclOODelMethodRef(clsPtr->destructorPtr); FOREACH(variableObj, clsPtr->variables) { TclDecrRefCount(variableObj); } if (i) { ckfree(clsPtr->variables.list); } if (IsRootClass(oPtr) && !Deleted(fPtr->objectCls->thisPtr)) { Tcl_DeleteCommandFromToken(interp, fPtr->objectCls->thisPtr->command); } } /* * ---------------------------------------------------------------------- * * ObjectNamespaceDeleted -- * |
︙ | |||
1171 1172 1173 1174 1175 1176 1177 1178 | 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 | + - + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - + + + - - - - + + + + - - - + - - + + + + + + + + + - - - + + + - - - + - | static void ObjectNamespaceDeleted( ClientData clientData) /* Pointer to the class whose namespace is * being deleted. */ { Object *oPtr = clientData; Foundation *fPtr = oPtr->fPtr; FOREACH_HASH_DECLS; |
︙ | |||
1259 1260 1261 1262 1263 1264 1265 | 1223 1224 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 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 1320 1321 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 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 | - + - - + - - + - - + - - - - - - - - - + - - - - - - - - + - - - - + + + - - - - - - - - - - - - - - - - + - - - - + + + - - - + - - - + - - - - - + + + - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - + - + - - - - - - + + - - - - - - + + - - - - + + + + - + - + - - - + - + - + - + - + + + + + - + + + - + - - - - - - - - - - | } Tcl_DeleteHashTable(oPtr->metadataPtr); ckfree(oPtr->metadataPtr); oPtr->metadataPtr = NULL; } /* |
︙ | |||
1471 1472 1473 1474 1475 1476 1477 | 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 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 | - + + - + - + - + + + + + - + + + + - + - - - - - - - - - - | { if (Deleted(superPtr->thisPtr)) { return; } if (superPtr->subclasses.num >= superPtr->subclasses.size) { superPtr->subclasses.size += ALLOC_CHUNK; if (superPtr->subclasses.size == ALLOC_CHUNK) { |
︙ | |||
1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 | 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 | + - + - - - - + + + + - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + - - + - + + - - - - + - - - - - - - + - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + - + - - - - - - - + + - - - - - + + + - + - - - - - - - - - - - - - - | superPtr->mixinSubs.list = ckalloc(sizeof(Class *) * ALLOC_CHUNK); } else { superPtr->mixinSubs.list = ckrealloc(superPtr->mixinSubs.list, sizeof(Class *) * superPtr->mixinSubs.size); } } superPtr->mixinSubs.list[superPtr->mixinSubs.num++] = subPtr; AddRef(subPtr->thisPtr); } /* * ---------------------------------------------------------------------- * * AllocClass -- * |
︙ | |||
1785 1786 1787 1788 1789 1790 1791 | 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 | - - - - - - + - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + - - - + + + + + + - + + + + + + | Tcl_Obj *const *objv, /* Argument list. */ int skip, /* Number of arguments to _not_ pass to the * constructor. */ Tcl_Object *objectPtr) /* Place to write the object reference upon * successful allocation. */ { register Class *classPtr = (Class *) cls; |
︙ | |||
2019 2020 2021 2022 2023 2024 2025 | 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 | - | * kept object-local. The duplicate is never deleted at this point, nor is * it the root of the object system or in the midst of processing a filter * call. */ o2Ptr->flags = oPtr->flags & ~( OBJECT_DELETED | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING); |
︙ | |||
3031 3032 3033 3034 3035 3036 3037 | 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 | - + | return (Tcl_Class) ((Object *)object)->classPtr; } int Tcl_ObjectDeleted( Tcl_Object object) { |
︙ |
Changes to generic/tclOOBasic.c.
︙ | |||
1202 1203 1204 1205 1206 1207 1208 | 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 | - - - - - - - - - - - - | * [oo::define] command. */ if (objc == 2) { o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, NULL, NULL); } else { const char *name, *namespaceName; |
︙ | |||
1239 1240 1241 1242 1243 1244 1245 | 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 | - | Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s refers to an existing namespace", namespaceName)); return TCL_ERROR; } } o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, name, namespaceName); |
︙ |
Changes to generic/tclOOCall.c.
︙ | |||
106 107 108 109 110 111 112 | 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 | + + + + + - + | CallContext *contextPtr) { register Object *oPtr = contextPtr->oPtr; TclOODeleteChain(contextPtr->callPtr); if (oPtr != NULL) { TclStackFree(oPtr->fPtr->interp, contextPtr); /* * Corresponding AddRef() in TclOO.c/TclOOObjectCmdCore */ |
︙ | |||
896 897 898 899 900 901 902 903 904 905 906 907 908 909 | 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 | + | callPtr->chain = callPtr->staticChain; } /* * ---------------------------------------------------------------------- * * IsStillValid -- * * Calculates whether the given call chain can be used for executing a * method for the given object. The condition on a chain from a cached * location being reusable is: * - Refers to the same object (same creation epoch), and * - Still across the same class structure (same global epoch), and * - Still across the same object strucutre (same local epoch), and * - No public/private/filter magic leakage (same flags, modulo the fact |
︙ | |||
1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 | 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 | + + + + + | oPtr->selfCls->destructorChainPtr = callPtr; callPtr->refCount++; } returnContext: contextPtr = TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext)); contextPtr->oPtr = oPtr; /* * Corresponding TclOODecrRefCount() in TclOODeleteContext */ AddRef(oPtr); contextPtr->callPtr = callPtr; contextPtr->skip = 2; contextPtr->index = 0; return contextPtr; } |
︙ |
Changes to generic/tclOODefineCmds.c.
︙ | |||
119 120 121 122 123 124 125 126 127 128 129 130 131 132 | 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 | + | {NULL, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}} }; /* * ---------------------------------------------------------------------- * * BumpGlobalEpoch -- * * Utility that ensures that call chains that are invalid will get thrown * away at an appropriate time. Note that exactly which epoch gets * advanced will depend on exactly what the class is tangled up in; in * the worst case, the simplest option is to advance the global epoch, * causing *everything* to be thrown away on next usage. * * ---------------------------------------------------------------------- |
︙ | |||
163 164 165 166 167 168 169 170 171 172 173 174 175 176 | 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 | + | TclOOGetFoundation(interp)->epoch++; } /* * ---------------------------------------------------------------------- * * RecomputeClassCacheFlag -- * * Determine whether the object is prototypical of its class, and hence * able to use the class's method chain cache. * * ---------------------------------------------------------------------- */ static inline void |
︙ | |||
185 186 187 188 189 190 191 192 193 194 195 196 197 198 | 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 | + | } } /* * ---------------------------------------------------------------------- * * TclOOObjectSetFilters -- * * Install a list of filter method names into an object. * * ---------------------------------------------------------------------- */ void TclOOObjectSetFilters( |
︙ | |||
243 244 245 246 247 248 249 250 251 252 253 254 255 256 | 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 | + | oPtr->epoch++; /* Only this object can be affected. */ } /* * ---------------------------------------------------------------------- * * TclOOClassSetFilters -- * * Install a list of filter method names into a class. * * ---------------------------------------------------------------------- */ void TclOOClassSetFilters( |
︙ | |||
305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 | 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 | + - - + - | BumpGlobalEpoch(interp, classPtr); } /* * ---------------------------------------------------------------------- * * TclOOObjectSetMixins -- * * Install a list of mixin classes into an object. * * ---------------------------------------------------------------------- */ void TclOOObjectSetMixins( Object *oPtr, int numMixins, Class *const *mixins) { Class *mixinPtr; int i; if (numMixins == 0) { if (oPtr->mixins.num != 0) { FOREACH(mixinPtr, oPtr->mixins) { |
︙ | |||
348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 | 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 | + + + + + + + + | oPtr->flags &= ~USE_CLASS_CACHE; } oPtr->mixins.num = numMixins; memcpy(oPtr->mixins.list, mixins, sizeof(Class *) * numMixins); FOREACH(mixinPtr, oPtr->mixins) { if (mixinPtr != oPtr->selfCls) { TclOOAddToInstances(oPtr, mixinPtr); /* * Corresponding TclOODecrRefCount() is in the caller of this * function. */ TclOODecrRefCount(mixinPtr->thisPtr); } } } oPtr->epoch++; } /* * ---------------------------------------------------------------------- * * TclOOClassSetMixins -- * * Install a list of mixin classes into a class. * * ---------------------------------------------------------------------- */ void TclOOClassSetMixins( |
︙ | |||
395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 | 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 | + + + + + + + + | } else { classPtr->mixins.list = ckalloc(sizeof(Class *) * numMixins); } classPtr->mixins.num = numMixins; memcpy(classPtr->mixins.list, mixins, sizeof(Class *) * numMixins); FOREACH(mixinPtr, classPtr->mixins) { TclOOAddToMixinSubs(classPtr, mixinPtr); /* * Corresponding TclOODecrRefCount() is in the caller of this * function. */ TclOODecrRefCount(mixinPtr->thisPtr); } } BumpGlobalEpoch(interp, classPtr); } /* * ---------------------------------------------------------------------- * * RenameDeleteMethod -- * * Core of the code to rename and delete methods. * * ---------------------------------------------------------------------- */ static int RenameDeleteMethod( |
︙ | |||
493 494 495 496 497 498 499 500 501 502 503 504 505 506 | 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 | + | return TCL_OK; } /* * ---------------------------------------------------------------------- * * TclOOUnknownDefinition -- * * Handles what happens when an unknown command is encountered during the * processing of a definition script. Works by finding a command in the * operating definition namespace that the requested command is a unique * prefix of. * * ---------------------------------------------------------------------- */ |
︙ | |||
571 572 573 574 575 576 577 578 579 580 581 582 583 584 | 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 | + | return TCL_ERROR; } /* * ---------------------------------------------------------------------- * * FindCommand -- * * Specialized version of Tcl_FindCommand that handles command prefixes * and disallows namespace magic. * * ---------------------------------------------------------------------- */ static Tcl_Command |
︙ | |||
631 632 633 634 635 636 637 638 639 640 641 642 643 644 | 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 | + | return cmd; } /* * ---------------------------------------------------------------------- * * InitDefineContext -- * * Does the magic incantations necessary to push the special stack frame * used when processing object definitions. It is up to the caller to * dispose of the frame (with TclPopStackFrame) when finished. * * ---------------------------------------------------------------------- */ |
︙ | |||
656 657 658 659 660 661 662 | 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 | + - + + + | Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot process definitions; support namespace deleted", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } /* |
︙ | |||
707 708 709 710 711 712 713 714 715 716 717 718 719 720 | 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 | + | return object; } /* * ---------------------------------------------------------------------- * * GetClassInOuterContext -- * * Wrapper round Tcl_GetObjectFromObj to perform the lookup in the * context that called oo::define (or equivalent). Note that this may * have to go up multiple levels to get the level that we started doing * definitions at. * * ---------------------------------------------------------------------- */ |
︙ | |||
749 750 751 752 753 754 755 756 757 758 759 760 761 762 | 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 | + | return oPtr->classPtr; } /* * ---------------------------------------------------------------------- * * GenerateErrorInfo -- * * Factored out code to generate part of the error trace messages. * * ---------------------------------------------------------------------- */ static inline void GenerateErrorInfo( |
︙ | |||
787 788 789 790 791 792 793 794 795 796 797 798 799 800 | 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 | + | (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } /* * ---------------------------------------------------------------------- * * MagicDefinitionInvoke -- * * Part of the implementation of the "oo::define" and "oo::objdefine" * commands that is used to implement the more-than-one-argument case, * applying ensemble-like tricks with dispatch so that error messages are * clearer. Doesn't handle the management of the stack frame. * * ---------------------------------------------------------------------- */ |
︙ | |||
850 851 852 853 854 855 856 857 858 859 860 861 862 863 | 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 | + | return result; } /* * ---------------------------------------------------------------------- * * TclOODefineObjCmd -- * * Implementation of the "oo::define" command. Works by effectively doing * the same as 'namespace eval', but with extra magic applied so that the * object to be modified is known to the commands in the target * namespace. Also does ensemble-like tricks with dispatch so that error * messages are clearer. * * ---------------------------------------------------------------------- |
︙ | |||
910 911 912 913 914 915 916 | 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 | - + + | if (result == TCL_ERROR) { GenerateErrorInfo(interp, oPtr, objNameObj, "class"); } TclDecrRefCount(objNameObj); } else { result = MagicDefinitionInvoke(interp, fPtr->defineNs, 2, objc, objv); } |
︙ | |||
977 978 979 980 981 982 983 | 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 | - + + | if (result == TCL_ERROR) { GenerateErrorInfo(interp, oPtr, objNameObj, "object"); } TclDecrRefCount(objNameObj); } else { result = MagicDefinitionInvoke(interp, fPtr->objdefNs, 2, objc, objv); } |
︙ | |||
1044 1045 1046 1047 1048 1049 1050 | 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 | - + + | if (result == TCL_ERROR) { GenerateErrorInfo(interp, oPtr, objNameObj, "class object"); } TclDecrRefCount(objNameObj); } else { result = MagicDefinitionInvoke(interp, fPtr->objdefNs, 1, objc, objv); } |
︙ | |||
1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 | 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 | + - | return TCL_OK; } /* * ---------------------------------------------------------------------- * * TclOODefineClassObjCmd -- * * Implementation of the "class" subcommand of the "oo::objdefine" * command. * * ---------------------------------------------------------------------- */ int TclOODefineClassObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Object *oPtr; Class *clsPtr; |
︙ | |||
1143 1144 1145 1146 1147 1148 1149 | 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 | - - - - - - - - - - - - - - + + + + + - - - - + + + | } clsPtr = GetClassInOuterContext(interp, objv[1], "the class of an object must be a class"); if (clsPtr == NULL) { return TCL_ERROR; } |
︙ | |||
1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 | 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 | + | return TCL_OK; } /* * ---------------------------------------------------------------------- * * TclOODefineDeleteMethodObjCmd -- * * Implementation of the "deletemethod" subcommand of the "oo::define" * and "oo::objdefine" commands. * * ---------------------------------------------------------------------- */ int |
︙ | |||
1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 | 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 | + | return TCL_OK; } /* * ---------------------------------------------------------------------- * * TclOODefineDestructorObjCmd -- * * Implementation of the "destructor" subcommand of the "oo::define" * command. * * ---------------------------------------------------------------------- */ int |
︙ | |||
1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 | 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 | + | return TCL_OK; } /* * ---------------------------------------------------------------------- * * TclOODefineExportObjCmd -- * * Implementation of the "export" subcommand of the "oo::define" and * "oo::objdefine" commands. * * ---------------------------------------------------------------------- */ int |
︙ | |||
1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 | 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 | + | return TCL_OK; } /* * ---------------------------------------------------------------------- * * TclOODefineForwardObjCmd -- * * Implementation of the "forward" subcommand of the "oo::define" and * "oo::objdefine" commands. * * ---------------------------------------------------------------------- */ int |
︙ | |||
1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 | 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 | + | return TCL_OK; } /* * ---------------------------------------------------------------------- * * TclOODefineMethodObjCmd -- * * Implementation of the "method" subcommand of the "oo::define" and * "oo::objdefine" commands. * * ---------------------------------------------------------------------- */ int |
︙ | |||
1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 | 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 | + | return TCL_OK; } /* * ---------------------------------------------------------------------- * * TclOODefineMixinObjCmd -- * * Implementation of the "mixin" subcommand of the "oo::define" and * "oo::objdefine" commands. * * ---------------------------------------------------------------------- */ int |
︙ | |||
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 | 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 | + + + + + + + + + + + | if (!isInstanceMixin && TclOOIsReachable(oPtr->classPtr, 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; /* * Corresponding TclOODecrRefCount() is in TclOOObjectSetMixins, * TclOOClassSetMixinsk, or just below if this function fails. */ AddRef(mixins[i-1]->thisPtr); } if (isInstanceMixin) { TclOOObjectSetMixins(oPtr, objc-1, mixins); } else { TclOOClassSetMixins(interp, oPtr->classPtr, objc-1, mixins); } TclStackFree(interp, mixins); return TCL_OK; freeAndError: while (--i > 0) { TclOODecrRefCount(mixins[i]->thisPtr); } TclStackFree(interp, mixins); return TCL_ERROR; } /* * ---------------------------------------------------------------------- * * TclOODefineRenameMethodObjCmd -- * * Implementation of the "renamemethod" subcommand of the "oo::define" * and "oo::objdefine" commands. * * ---------------------------------------------------------------------- */ int |
︙ | |||
1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 | 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 | + | return TCL_OK; } /* * ---------------------------------------------------------------------- * * TclOODefineUnexportObjCmd -- * * Implementation of the "unexport" subcommand of the "oo::define" and * "oo::objdefine" commands. * * ---------------------------------------------------------------------- */ int |
︙ | |||
1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 | 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 | + | return TCL_OK; } /* * ---------------------------------------------------------------------- * * Tcl_ClassSetConstructor, Tcl_ClassSetDestructor -- * * How to install a constructor or destructor into a class; API to call * from C. * * ---------------------------------------------------------------------- */ void |
︙ | |||
1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 | 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 | + | } } /* * ---------------------------------------------------------------------- * * TclOODefineSlots -- * * Create the "::oo::Slot" class and its standard instances. Class * definition is empty at the stage (added by scripting). * * ---------------------------------------------------------------------- */ int |
︙ | |||
1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 | 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 | + | return TCL_OK; } /* * ---------------------------------------------------------------------- * * ClassFilterGet, ClassFilterSet -- * * Implementation of the "filter" slot accessors of the "oo::define" * command. * * ---------------------------------------------------------------------- */ static int |
︙ | |||
1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 | 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 | + | return TCL_OK; } /* * ---------------------------------------------------------------------- * * ClassMixinGet, ClassMixinSet -- * * Implementation of the "mixin" slot accessors of the "oo::define" * command. * * ---------------------------------------------------------------------- */ static int |
︙ | |||
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 | 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 | + + + + + + + + + + + + | mixins = TclStackAlloc(interp, sizeof(Class *) * mixinc); for (i=0 ; i<mixinc ; i++) { mixins[i] = GetClassInOuterContext(interp, mixinv[i], "may only mix in classes"); if (mixins[i] == NULL) { i--; goto freeAndError; } if (TclOOIsReachable(oPtr->classPtr, mixins[i])) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "may not mix a class into itself", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", NULL); goto freeAndError; } /* * Corresponding TclOODecrRefCount() is in TclOOClassSetMixins, or * just below if this function fails. */ AddRef(mixins[i]->thisPtr); } TclOOClassSetMixins(interp, oPtr->classPtr, mixinc, mixins); TclStackFree(interp, mixins); return TCL_OK; freeAndError: while (i-- > 0) { TclOODecrRefCount(mixins[i]->thisPtr); } TclStackFree(interp, mixins); return TCL_ERROR; } /* * ---------------------------------------------------------------------- * * ClassSuperGet, ClassSuperSet -- * * Implementation of the "superclass" slot accessors of the "oo::define" * command. * * ---------------------------------------------------------------------- */ static int |
︙ | |||
2168 2169 2170 2171 2172 2173 2174 | 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 | + + + - + + - + - - + + + + + + + + + + + + + + + + + + + + + + + | * * Note that zero classes is special, as it is equivalent to just the * class of objects. [Bug 9d61624b3d] */ if (superc == 0) { superclasses = ckrealloc(superclasses, sizeof(Class *)); if (TclOOIsReachable(oPtr->fPtr->classCls, oPtr->classPtr)) { superclasses[0] = oPtr->fPtr->classCls; } else { |
︙ | |||
2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 | 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 | + | return TCL_OK; } /* * ---------------------------------------------------------------------- * * ObjectFilterGet, ObjectFilterSet -- * * Implementation of the "filter" slot accessors of the "oo::objdefine" * command. * * ---------------------------------------------------------------------- */ static int |
︙ | |||
2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 | 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 | + | return TCL_OK; } /* * ---------------------------------------------------------------------- * * ObjectMixinGet, ObjectMixinSet -- * * Implementation of the "mixin" slot accessors of the "oo::objdefine" * command. * * ---------------------------------------------------------------------- */ static int |
︙ | |||
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 | 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 | + + + + + + + + + + + | mixins = TclStackAlloc(interp, sizeof(Class *) * mixinc); for (i=0 ; i<mixinc ; i++) { mixins[i] = GetClassInOuterContext(interp, mixinv[i], "may only mix in classes"); if (mixins[i] == NULL) { while (i-- > 0) { TclOODecrRefCount(mixins[i]->thisPtr); } TclStackFree(interp, mixins); return TCL_ERROR; } /* * Corresponding TclOODecrRefCount() is in TclOOObjectSetMixins() or * just above if this function fails. */ AddRef(mixins[i]->thisPtr); } TclOOObjectSetMixins(oPtr, mixinc, mixins); TclStackFree(interp, mixins); return TCL_OK; } /* * ---------------------------------------------------------------------- * * ObjectVarsGet, ObjectVarsSet -- * * Implementation of the "variable" slot accessors of the "oo::objdefine" * command. * * ---------------------------------------------------------------------- */ static int |
︙ |
Changes to generic/tclOOInt.h.
︙ | |||
189 190 191 192 193 194 195 | 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 | - - - + + + + | LIST_STATIC(Tcl_Obj *) variables; } Object; #define OBJECT_DELETED 1 /* Flag to say that an object has been * destroyed. */ #define DESTRUCTOR_CALLED 2 /* Flag to say that the destructor has been * called. */ |
︙ | |||
218 219 220 221 222 223 224 | 219 220 221 222 223 224 225 226 227 228 229 230 231 232 | - - - - | * And the definition of a class. Note that every class also has an associated * object, through which it is manipulated. */ typedef struct Class { Object *thisPtr; /* Reference to the object associated with * this class. */ |
︙ | |||
491 492 493 494 495 496 497 498 499 500 501 502 503 504 | 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 | + + + + + | 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, |
︙ | |||
520 521 522 523 524 525 526 | 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 | - - + + - + + + + + + + - + - - - - - + + - + | 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); |
︙ | |||
582 583 584 585 586 587 588 | 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 | - - - - - - - - - - - | do { \ register unsigned len = sizeof(type) * ((target).num=(source).num);\ if (len != 0) { \ memcpy(((target).list=(type*)ckalloc(len)), (source).list, len); \ } else { \ (target).list = NULL; \ } \ |
Changes to generic/tclObj.c.
︙ | |||
206 207 208 209 210 211 212 | 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 | - - + + - | */ static int ParseBoolean(Tcl_Obj *objPtr); static int SetDoubleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static int SetIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfDouble(Tcl_Obj *objPtr); static void UpdateStringOfInt(Tcl_Obj *objPtr); |
︙ | |||
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 | 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 | + + + + + + - - - + + + - - + + | /* * The structures below defines the Tcl object types defined in this file by * means of functions that can be invoked by generic object code. See also * tclStringObj.c, tclListObj.c, tclByteCode.c for other type manager * implementations. */ #if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 static const Tcl_ObjType oldBooleanType = { "boolean", /* name */ NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ NULL, /* updateStringProc */ TclSetBooleanFromAny /* setFromAnyProc */ }; #endif const Tcl_ObjType tclBooleanType = { "booleanString", /* name */ NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ NULL, /* updateStringProc */ TclSetBooleanFromAny /* setFromAnyProc */ }; const Tcl_ObjType tclDoubleType = { "double", /* name */ NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ UpdateStringOfDouble, /* updateStringProc */ SetDoubleFromAny /* setFromAnyProc */ }; const Tcl_ObjType tclIntType = { #if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 || defined(TCL_WIDE_INT_IS_LONG) "int", /* name */ #else "wideInt", /* name, keeping maximum compatibility with Tcl 8.6 on 32-bit platforms*/ #endif NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ UpdateStringOfInt, /* updateStringProc */ SetIntFromAny /* setFromAnyProc */ }; |
︙ | |||
340 341 342 343 344 345 346 | 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 | - + - + - + | typedef struct ResolvedCmdName { Command *cmdPtr; /* A cached Command pointer. */ Namespace *refNsPtr; /* Points to the namespace containing the * reference (not the namespace that contains * the referenced command). NULL if the name * is fully qualified.*/ |
︙ | |||
392 393 394 395 396 397 398 | 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 | - + - - - + + + + + | typeTableInitialized = 1; Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS); Tcl_MutexUnlock(&tableMutex); Tcl_RegisterObjType(&tclByteArrayType); Tcl_RegisterObjType(&tclDoubleType); Tcl_RegisterObjType(&tclEndOffsetType); |
︙ | |||
1758 1759 1760 1761 1762 1763 1764 | 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 | - + | Tcl_Obj * Tcl_NewBooleanObj( register int boolValue) /* Boolean used to initialize new object. */ { register Tcl_Obj *objPtr; |
︙ | |||
1806 1807 1808 1809 1810 1811 1812 | 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 | - + | * debugging. */ { register Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); objPtr->bytes = NULL; |
︙ | |||
1853 1854 1855 1856 1857 1858 1859 | 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 | - + | register Tcl_Obj *objPtr, /* Object whose internal rep to init. */ register int boolValue) /* Boolean used to set object's value. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj"); } |
︙ | |||
1884 1885 1886 1887 1888 1889 1890 | 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 | - + | Tcl_GetBooleanFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ register Tcl_Obj *objPtr, /* The object from which to get boolean. */ register int *boolPtr) /* Place to store resulting boolean. */ { do { if (objPtr->typePtr == &tclIntType) { |
︙ | |||
1912 1913 1914 1915 1916 1917 1918 | 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 | - - - - - - | *boolPtr = (d != 0.0); return TCL_OK; } if (objPtr->typePtr == &tclBignumType) { *boolPtr = 1; return TCL_OK; } |
︙ | |||
1956 1957 1958 1959 1960 1961 1962 | 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 | - + - - - - - - | * For some "pure" numeric Tcl_ObjTypes (no string rep), we can determine * whether a boolean conversion is possible without generating the string * rep. */ if (objPtr->bytes == NULL) { if (objPtr->typePtr == &tclIntType) { |
︙ | |||
2109 2110 2111 2112 2113 2114 2115 | 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 | - + | TclFreeIntRep(objPtr); objPtr->internalRep.longValue = newBool; objPtr->typePtr = &tclBooleanType; return TCL_OK; numericBoolean: TclFreeIntRep(objPtr); |
︙ | |||
2290 2291 2292 2293 2294 2295 2296 | 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 | - + - - - - - - | } return TCL_ERROR; } *dblPtr = (double) objPtr->internalRep.doubleValue; return TCL_OK; } if (objPtr->typePtr == &tclIntType) { |
︙ | |||
2423 2424 2425 2426 2427 2428 2429 | 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 | - + | Tcl_Obj * Tcl_NewIntObj( register int intValue) /* Int used to initialize the new object. */ { register Tcl_Obj *objPtr; |
︙ | |||
2456 2457 2458 2459 2460 2461 2462 | 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 | - + - + + + + - - + + - - - + - - - + + - - - + + - + - - - - + + | register Tcl_Obj *objPtr, /* Object whose internal rep to init. */ register int intValue) /* Integer used to set object's value. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetIntObj"); } |
︙ | |||
2537 2538 2539 2540 2541 2542 2543 | 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 | - - - + + | */ static int SetIntFromAny( Tcl_Interp *interp, /* Tcl interpreter */ Tcl_Obj *objPtr) /* Pointer to the object to convert */ { |
︙ | |||
2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 | 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 | + + + + + + + + + + + + + + + + | static void UpdateStringOfInt( register Tcl_Obj *objPtr) /* Int object whose string rep to update. */ { char buffer[TCL_INTEGER_SPACE]; register int len; len = TclFormatInt(buffer, objPtr->internalRep.wideValue); objPtr->bytes = ckalloc(len + 1); memcpy(objPtr->bytes, buffer, (unsigned) len + 1); objPtr->length = len; } #if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG) static void UpdateStringOfOldInt( register Tcl_Obj *objPtr) /* Int object whose string rep to update. */ { char buffer[TCL_INTEGER_SPACE]; register int len; len = TclFormatInt(buffer, objPtr->internalRep.longValue); objPtr->bytes = ckalloc(len + 1); memcpy(objPtr->bytes, buffer, (unsigned) len + 1); objPtr->length = len; } #endif /* *---------------------------------------------------------------------- * * Tcl_NewLongObj -- * * If a client is compiled with TCL_MEM_DEBUG defined, calls to |
︙ | |||
2605 2606 2607 2608 2609 2610 2611 | 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 | - + - + | * * Side effects: * None. * *---------------------------------------------------------------------- */ |
︙ | |||
2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 | 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 | + - + | * * Side effects: * Allocates memory. * *---------------------------------------------------------------------- */ #undef Tcl_DbNewLongObj #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewLongObj( register long longValue, /* Long integer used to initialize the new * object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { register Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); objPtr->bytes = NULL; |
︙ | |||
2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 | 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 | + - + | * Side effects: * The object's old string rep, if any, is freed. Also, any old internal * rep is freed. * *---------------------------------------------------------------------- */ #undef Tcl_SetLongObj void Tcl_SetLongObj( register Tcl_Obj *objPtr, /* Object whose internal rep to init. */ register long longValue) /* Long integer used to initialize the * object's value. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetLongObj"); } |
︙ | |||
2757 2758 2759 2760 2761 2762 2763 2764 | 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 | + - + - - + + | int Tcl_GetLongFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ register Tcl_Obj *objPtr, /* The object from which to get a long. */ register long *longPtr) /* Place to store resulting long. */ { do { #ifdef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclIntType) { |
︙ | |||
2835 2836 2837 2838 2839 2840 2841 | 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | } return TCL_ERROR; } } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL, TCL_PARSE_INTEGER_ONLY)==TCL_OK); return TCL_ERROR; } |
︙ | |||
2927 2928 2929 2930 2931 2932 2933 | 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 | - + | register Tcl_WideInt wideValue) /* Wide integer used to initialize the new * object. */ { register Tcl_Obj *objPtr; TclNewObj(objPtr); |
︙ | |||
2979 2980 2981 2982 2983 2984 2985 | 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 | - + | * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { register Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); |
︙ | |||
3028 3029 3030 3031 3032 3033 3034 | 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 | - - - - - - + - - - - - - - | /* Wide integer used to initialize the * object's value. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetWideIntObj"); } |
︙ | |||
3072 3073 3074 3075 3076 3077 3078 | 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 | - - + - - - - - | Tcl_GetWideIntFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ register Tcl_Obj *objPtr, /* Object from which to get a wide int. */ register Tcl_WideInt *wideIntPtr) /* Place to store resulting long. */ { do { |
︙ | |||
3132 3133 3134 3135 3136 3137 3138 | 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 | - - - - - - - - - - - - - - - - - - - - - - - - - - - | } return TCL_ERROR; } } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL, TCL_PARSE_INTEGER_ONLY)==TCL_OK); return TCL_ERROR; } |
︙ | |||
3401 3402 3403 3404 3405 3406 3407 | 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 | - - - - - - | if (objPtr->bytes == NULL) { TclInitStringRep(objPtr, &tclEmptyString, 0); } } return TCL_OK; } if (objPtr->typePtr == &tclIntType) { |
︙ | |||
3520 3521 3522 3523 3524 3525 3526 | 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 3465 3466 3467 | - - - - - - - - - - - - - - - - - - - - - - - - - - + - - - + + + - + - + - | Tcl_Obj *objPtr, /* Object to set */ mp_int *bignumValue) /* Value to store */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetBignumObj"); } if ((size_t) bignumValue->used |
︙ | |||
3651 3652 3653 3654 3655 3656 3657 | 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 3547 3548 3549 3550 3551 3552 | - - - - - - - | } else { *typePtr = TCL_NUMBER_DOUBLE; } *clientDataPtr = &objPtr->internalRep.doubleValue; return TCL_OK; } if (objPtr->typePtr == &tclIntType) { |
︙ |
Changes to generic/tclPathObj.c.
︙ | |||
1805 1806 1807 1808 1809 1810 1811 | 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 | - | Tcl_IncrRefCount(copy); /* * We now own a reference on both 'dir' and 'copy' */ (void) TclGetStringFromObj(dir, &cwdLen); |
︙ | |||
1827 1828 1829 1830 1831 1832 1833 | 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 | - + - + | copy = newCopy; } else { /* * ... but in most cases where we join a trouble free tail to a * normalized head, we can more efficiently normalize the combined * path by passing over only the unnormalized tail portion. When * this is sufficient, prior developers claim this should be much |
︙ |
Changes to generic/tclPkg.c.
︙ | |||
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 | 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 | + + + + + + + + + + + + - - - + + + + + + + + + | * (malloc'ed). NULL means the package doesn't * exist in this interpreter yet. */ PkgAvail *availPtr; /* First in list of all available versions of * this package. */ const void *clientData; /* Client data. */ } Package; typedef struct Require { void * clientDataPtr; const char *name; Package *pkgPtr; char *versionToProvide; } Require; typedef struct RequireProcArgs { const char *name; void *clientDataPtr; } RequireProcArgs; /* * Prototypes for functions defined in this file: */ static int CheckVersionAndConvert(Tcl_Interp *interp, const char *string, char **internal, int *stable); static int CompareVersions(char *v1i, char *v2i, int *isMajorPtr); static int CheckRequirement(Tcl_Interp *interp, const char *string); static int CheckAllRequirements(Tcl_Interp *interp, int reqc, Tcl_Obj *const reqv[]); static int RequirementSatisfied(char *havei, const char *req); static int SomeRequirementSatisfied(char *havei, int reqc, Tcl_Obj *const reqv[]); static void AddRequirementsToResult(Tcl_Interp *interp, int reqc, Tcl_Obj *const reqv[]); static void AddRequirementsToDString(Tcl_DString *dstring, int reqc, Tcl_Obj *const reqv[]); static Package * FindPackage(Tcl_Interp *interp, const char *name); |
︙ | |||
361 362 363 364 365 366 367 | 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 | - + + + + - - - - + + + + + + + - - - + + + + - - - - + + + + + + + + + - - + + - - - - + + + - - - - - - + + + + + + + + + + + + + + + + + + + + - - - - + - - - + - - - - + - - - - - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - - - - - - + - - - - - - + - - - + - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - - - - - - - - - - - - - - - - - - - - - - + - - - - - - - - - - + - - - - - - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - - + - + - + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | } /* * Translate between old and new API, and defer to the new function. */ if (version == NULL) { |
︙ | |||
830 831 832 833 834 835 836 837 838 839 | 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 | + + + + + + + + + - + - + + | * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_PackageObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return Tcl_NRCallObjProc(interp, TclNRPackageObjCmd, NULL, objc, objv); } /* ARGSUSED */ int |
︙ | |||
917 918 919 920 921 922 923 924 925 926 927 928 929 930 | 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 | + | while (pkgPtr->availPtr != NULL) { availPtr = pkgPtr->availPtr; pkgPtr->availPtr = availPtr->nextPtr; Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC); Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC); if (availPtr->pkgIndex) { Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC); availPtr->pkgIndex = NULL; } ckfree(availPtr); } ckfree(pkgPtr); } break; } |
︙ | |||
970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 | 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 | + - + | Tcl_SetObjResult(interp, Tcl_NewStringObj(availPtr->script, -1)); return TCL_OK; } Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC); if (availPtr->pkgIndex) { Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC); availPtr->pkgIndex = NULL; } break; } } ckfree(argv3i); if (objc == 4) { return TCL_OK; } if (availPtr == NULL) { availPtr = ckalloc(sizeof(PkgAvail)); |
︙ | |||
1102 1103 1104 1105 1106 1107 1108 | 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 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 | - + + + - - - - + + + + + + + + + + + + + + + + + - + + + + + + + | } version = NULL; argv2 = TclGetString(objv[2]); if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) { Tcl_Obj *ov; |
︙ | |||
1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 | 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 | + + + + + + + | break; } default: Tcl_Panic("Tcl_PackageObjCmd: bad option index to pkgOptions"); } return TCL_OK; } static int TclNRPackageObjCmdCleanup(ClientData data[], Tcl_Interp *interp, int result) { TclDecrRefCount((Tcl_Obj *)data[0]); TclDecrRefCount((Tcl_Obj *)data[1]); return result; } /* *---------------------------------------------------------------------- * * FindPackage -- * * This function finds the Package record for a particular package in a |
︙ | |||
1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 | 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 | + | while (pkgPtr->availPtr != NULL) { availPtr = pkgPtr->availPtr; pkgPtr->availPtr = availPtr->nextPtr; Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC); Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC); if (availPtr->pkgIndex) { Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC); availPtr->pkgIndex = NULL; } ckfree(availPtr); } ckfree(pkgPtr); } Tcl_DeleteHashTable(&iPtr->packageTable); if (iPtr->packageUnknown != NULL) { |
︙ |
Changes to generic/tclProc.c.
︙ | |||
120 121 122 123 124 125 126 | 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 | - - + + - - - - + + + - + - + - + - - - - - - - - - + - + - - - - - - - + - - - - - - - - - + - | ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { register Interp *iPtr = (Interp *) interp; Proc *procPtr; |
︙ | |||
810 811 812 813 814 815 816 | 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 | - + - + | if (objPtr == NULL) { /* Do nothing */ } else if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &level) && (level >= 0)) { level = curLevel - level; result = 1; } else if (objPtr->typePtr == &levelReferenceType) { |
︙ | |||
2400 2401 2402 2403 2404 2405 2406 | 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 | - + | FreeLambdaInternalRep( register Tcl_Obj *objPtr) /* CmdName object with internal representation * to free. */ { Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1; Tcl_Obj *nsObjPtr = objPtr->internalRep.twoPtrValue.ptr2; |
︙ |
Changes to generic/tclResult.c.
︙ | |||
23 24 25 26 27 28 29 30 31 32 33 34 35 36 | 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 | + + + | /* * Function prototypes for local functions in this file: */ static Tcl_Obj ** GetKeys(void); static void ReleaseKeys(ClientData clientData); static void ResetObjResult(Interp *iPtr); #ifndef TCL_NO_DEPRECATED static void SetupAppendBuffer(Interp *iPtr, int newSpace); #endif /* !TCL_NO_DEPRECATED */ /* * This structure is used to take a snapshot of the interpreter state in * Tcl_SaveInterpState. You can snapshot the state, execute a command, and * then back up to the result or the error that was previously in progress. */ |
︙ | |||
240 241 242 243 244 245 246 | 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 | - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | /* * Move the result object into the save state. Note that we don't need to * change its refcount because we're moving it, not adding a new * reference. Put an empty object into the interpreter. */ |
︙ | |||
272 273 274 275 276 277 278 279 280 281 282 283 284 | 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 | + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + | Tcl_RestoreResult( Tcl_Interp *interp, /* Interpreter being restored. */ Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */ { Interp *iPtr = (Interp *) interp; Tcl_ResetResult(interp); /* * Restore the string result. */ iPtr->freeProc = statePtr->freeProc; if (statePtr->result == statePtr->resultSpace) { /* * Copy the static string data into the interp buffer. */ iPtr->result = iPtr->resultSpace; strcpy(iPtr->result, statePtr->result); } else if (statePtr->result == statePtr->appendResult) { /* * Move the append buffer back into the interp. */ if (iPtr->appendResult != NULL) { ckfree(iPtr->appendResult); } iPtr->appendResult = statePtr->appendResult; iPtr->appendAvl = statePtr->appendAvl; iPtr->appendUsed = statePtr->appendUsed; iPtr->result = iPtr->appendResult; } else { /* * Move the dynamic or static string back into the interpreter. */ iPtr->result = statePtr->result; } /* * Restore the object result. */ Tcl_DecrRefCount(iPtr->objResultPtr); |
︙ | |||
304 305 306 307 308 309 310 | 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 | - + + + + + + + + + | */ #undef Tcl_DiscardResult void Tcl_DiscardResult( Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */ { |
︙ | |||
334 335 336 337 338 339 340 | 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 | + + + - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | * return value. */ register char *result, /* Value to be returned. If NULL, the result * is set to an empty string. */ Tcl_FreeProc *freeProc) /* Gives information about the string: * TCL_STATIC, TCL_VOLATILE, or the address of * a Tcl_FreeProc such as free. */ { Interp *iPtr = (Interp *) interp; register Tcl_FreeProc *oldFreeProc = iPtr->freeProc; char *oldResult = iPtr->result; |
︙ | |||
368 369 370 371 372 373 374 | 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 | - + + + + + + + + + + + + + | */ const char * Tcl_GetStringResult( register Tcl_Interp *interp)/* Interpreter whose result to return. */ { Interp *iPtr = (Interp *) interp; |
︙ | |||
410 411 412 413 414 415 416 417 418 419 420 421 422 423 | 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 | + + + + + + + + + + + + + + + + + | /* * We wait until the end to release the old object result, in case we are * setting the result to itself. */ TclDecrRefCount(oldObjResult); #ifndef TCL_NO_DEPRECATED /* * Reset the string result since we just set the result object. */ if (iPtr->freeProc != NULL) { if (iPtr->freeProc == TCL_DYNAMIC) { ckfree(iPtr->result); } else { iPtr->freeProc(iPtr->result); } iPtr->freeProc = 0; } iPtr->result = iPtr->resultSpace; iPtr->resultSpace[0] = 0; #endif } /* *---------------------------------------------------------------------- * * Tcl_GetObjResult -- * |
︙ | |||
438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 | 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 | + + + + + + + + + + + + + + + + + + + + + + + + + + + | */ Tcl_Obj * Tcl_GetObjResult( Tcl_Interp *interp) /* Interpreter whose result to return. */ { register Interp *iPtr = (Interp *) interp; #ifndef TCL_NO_DEPRECATED Tcl_Obj *objResultPtr; int length; /* * If the string result is non-empty, move the string result to the object * result, then reset the string result. */ if (iPtr->result[0] != 0) { ResetObjResult(iPtr); objResultPtr = iPtr->objResultPtr; length = strlen(iPtr->result); TclInitStringRep(objResultPtr, iPtr->result, length); if (iPtr->freeProc != NULL) { if (iPtr->freeProc == TCL_DYNAMIC) { ckfree(iPtr->result); } else { iPtr->freeProc(iPtr->result); } iPtr->freeProc = 0; } iPtr->result = iPtr->resultSpace; iPtr->result[0] = 0; } #endif /* !TCL_NO_DEPRECATED */ return iPtr->objResultPtr; } /* *---------------------------------------------------------------------- * * Tcl_AppendResultVA -- |
︙ | |||
475 476 477 478 479 480 481 482 483 484 485 486 487 488 | 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 | + + + + + + + + + + + + + + + + + | Tcl_Obj *objPtr = Tcl_GetObjResult(interp); if (Tcl_IsShared(objPtr)) { objPtr = Tcl_DuplicateObj(objPtr); } Tcl_AppendStringsToObjVA(objPtr, argList); Tcl_SetObjResult(interp, objPtr); /* * Strictly we should call Tcl_GetStringResult(interp) here to make sure * that interp->result is correct according to the old contract, but that * makes the performance of much code (e.g. in Tk) absolutely awful. So we * leave it out; code that really wants interp->result can just insert the * calls to Tcl_GetStringResult() itself. [Patch 1041072 discussion] */ #ifdef USE_INTERP_RESULT /* * Ensure that the interp->result is legal so old Tcl 7.* code still * works. There's still embarrasingly much of it about... */ (void) Tcl_GetStringResult(interp); #endif /* USE_INTERP_RESULT */ } /* *---------------------------------------------------------------------- * * Tcl_AppendResult -- * |
︙ | |||
540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 | 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 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 | + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - + + + - - - + + + + + + + + + + + + + + + | Tcl_AppendElement( Tcl_Interp *interp, /* Interpreter whose result is to be * extended. */ const char *element) /* String to convert to list element and add * to result. */ { Interp *iPtr = (Interp *) interp; #ifdef TCL_NO_DEPRECATED Tcl_Obj *elementPtr = Tcl_NewStringObj(element, -1); Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr); const char *bytes; if (Tcl_IsShared(iPtr->objResultPtr)) { Tcl_SetObjResult(interp, Tcl_DuplicateObj(iPtr->objResultPtr)); } bytes = TclGetString(iPtr->objResultPtr); if (TclNeedSpace(bytes, bytes+iPtr->objResultPtr->length)) { Tcl_AppendToObj(iPtr->objResultPtr, " ", 1); } Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr); Tcl_DecrRefCount(listPtr); #else char *dst; int size; int flags; |
︙ | |||
611 612 613 614 615 616 617 618 619 620 621 622 623 624 | 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 | + + + + + + + + + + + + | void Tcl_ResetResult( register Tcl_Interp *interp)/* Interpreter for which to clear result. */ { register Interp *iPtr = (Interp *) interp; ResetObjResult(iPtr); #ifndef TCL_NO_DEPRECATED if (iPtr->freeProc != NULL) { if (iPtr->freeProc == TCL_DYNAMIC) { ckfree(iPtr->result); } else { iPtr->freeProc(iPtr->result); } iPtr->freeProc = 0; } iPtr->result = iPtr->resultSpace; iPtr->resultSpace[0] = 0; #endif /* !TCL_NO_DEPRECATED */ if (iPtr->errorCode) { /* Legacy support */ if (iPtr->flags & ERR_LEGACY_COPY) { Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL, iPtr->errorCode, TCL_GLOBAL_ONLY); } Tcl_DecrRefCount(iPtr->errorCode); |
︙ |
Changes to generic/tclScan.c.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | + | /* * tclScan.c -- * * This file contains the implementation of the "scan" command. * * Copyright (c) 1998 by Scriptics Corporation. * * 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" /* * Flag values used by Tcl_ScanObjCmd. */ #define SCAN_NOSKIP 0x1 /* Don't skip blanks. */ #define SCAN_SUPPRESS 0x2 /* Suppress assignment. */ |
︙ | |||
411 412 413 414 415 416 417 | 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 | - - - - - - - | case 'g': case 'G': case 'i': case 'o': case 'x': case 'X': case 'b': |
︙ | |||
885 886 887 888 889 890 891 | 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 | - + | * Scan a single Unicode character. */ offset = TclUtfToUniChar(string, &sch); i = (int)sch; #if TCL_UTF_MAX == 4 if (!offset) { |
︙ | |||
938 939 940 941 942 943 944 | 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 | - + - + + + + + + + + + + + + - + | } } if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) { sprintf(buf, "%" TCL_LL_MODIFIER "u", (Tcl_WideUInt)wideValue); Tcl_SetStringObj(objPtr, buf, -1); } else { |
︙ |
Changes to generic/tclStrToD.c.
︙ | |||
479 480 481 482 483 484 485 | 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 | - + | const char **endPtrPtr, /* Place to store pointer to the character * that terminated the scan. */ int flags) /* Flags governing the parse. */ { enum State { INITIAL, SIGNUM, ZERO, ZERO_X, ZERO_O, ZERO_B, ZERO_D, BINARY, |
︙ | |||
524 525 526 527 528 529 530 531 532 533 534 535 536 537 | 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 | + | * an acceptable number. */ size_t acceptLen; /* Number of characters following that * point. */ int status = TCL_OK; /* Status to return to caller. */ char d = 0; /* Last hexadecimal digit scanned; initialized * to avoid a compiler warning. */ int shift = 0; /* Amount to shift when accumulating binary */ int explicitOctal = 0; #define ALL_BITS (~(Tcl_WideUInt)0) #define MOST_BITS (ALL_BITS >> 1) /* * Initialize bytes to start of the object's string rep if the caller * didn't pass anything else. |
︙ | |||
655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 | 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 | + + + + | state = ZERO_B; break; } if (flags & TCL_PARSE_BINARY_ONLY) { goto zerob; } if (c == 'o' || c == 'O') { explicitOctal = 1; state = ZERO_O; break; } if (c == 'd' || c == 'D') { state = ZERO_D; break; } #ifdef TCL_NO_DEPRECATED goto decimal; #endif /* FALLTHROUGH */ case OCTAL: /* * Scanned an optional + or -, followed by a string of octal * digits. Acceptable inputs are more digits, period, or E. If 8 * or 9 is encountered, commit to floating point. */ |
︙ | |||
725 726 727 728 729 730 731 732 733 734 735 736 737 738 | 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 | + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | } else { numSigDigs = 1; } numTrailZeros = 0; state = OCTAL; break; } /* FALLTHROUGH */ case BAD_OCTAL: if (explicitOctal) { /* * No forgiveness for bad digits in explicitly octal numbers. */ goto endgame; } if (flags & TCL_PARSE_INTEGER_ONLY) { /* * No seeking floating point when parsing only integer. */ goto endgame; } #ifndef TCL_NO_DEPRECATED /* * Scanned a number with a leading zero that contains an 8, 9, * radix point or E. This is an invalid octal number, but might * still be floating point. */ if (c == '0') { numTrailZeros++; state = BAD_OCTAL; break; } else if (isdigit(UCHAR(c))) { if (objPtr != NULL) { significandOverflow = AccumulateDecimalDigit( (unsigned)(c-'0'), numTrailZeros, &significandWide, &significandBig, significandOverflow); } if (numSigDigs != 0) { numSigDigs += (numTrailZeros + 1); } else { numSigDigs = 1; } numTrailZeros = 0; state = BAD_OCTAL; break; } else if (c == '.') { state = FRACTION; break; } else if (c == 'E' || c == 'e') { state = EXPONENT_START; break; } #endif goto endgame; /* * Scanned 0x. If state is HEXADECIMAL, scanned at least one * character following the 0x. The only acceptable inputs are * hexadecimal digits. */ |
︙ | |||
839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 | 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 | + + | case DECIMAL: /* * Scanned an optional + or - followed by a string of decimal * digits. */ #ifdef TCL_NO_DEPRECATED decimal: #endif acceptState = state; acceptPoint = p; acceptLen = len; if (c == '0') { numTrailZeros++; state = DECIMAL; break; |
︙ | |||
1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 | 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 | + | * Generate and store the appropriate internal rep. */ if (status == TCL_OK && objPtr != NULL) { TclFreeIntRep(objPtr); switch (acceptState) { case SIGNUM: case BAD_OCTAL: case ZERO_X: case ZERO_O: case ZERO_B: case ZERO_D: case LEADING_RADIX_POINT: case EXPONENT_START: case EXPONENT_SIGNUM: |
︙ | |||
1204 1205 1206 1207 1208 1209 1210 | 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 | - + - - - - - - - - - - - - - - - - + + - - + + | octalSignificandWide <<= shift; } else { mp_mul_2d(&octalSignificandBig, shift, &octalSignificandBig); } } if (!octalSignificandOverflow) { |
︙ | |||
1251 1252 1253 1254 1255 1256 1257 | 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 | - + - - - - - - - - - - - - - - - - + + - - + + | &significandWide, &significandBig, significandOverflow); if (!significandOverflow && (significandWide > MOST_BITS+signum)){ significandOverflow = 1; TclInitBignumFromWideUInt(&significandBig, significandWide); } returnInteger: if (!significandOverflow) { |
︙ | |||
1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 | 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 | + + + | if (status != TCL_OK) { if (interp != NULL) { Tcl_Obj *msg = Tcl_ObjPrintf("expected %s but got \"", expected); Tcl_AppendLimitedToObj(msg, bytes, numBytes, 50, ""); Tcl_AppendToObj(msg, "\"", -1); if (state == BAD_OCTAL) { Tcl_AppendToObj(msg, " (looks like invalid octal number)", -1); } Tcl_SetObjResult(interp, msg); Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL); } } /* * Free memory. |
︙ |
Changes to generic/tclStringObj.c.
︙ | |||
136 137 138 139 140 141 142 | 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 | + - + - | char *ptr = NULL; int attempt; if (objPtr->bytes == &tclEmptyString) { objPtr->bytes = NULL; } if (flag == 0 || stringPtr->allocated > 0) { if (needed <= INT_MAX / 2) { |
︙ | |||
186 187 188 189 190 191 192 | 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 | + - + - | int attempt; if (stringPtr->maxChars > 0) { /* * Subsequent appends - apply the growth algorithm. */ if (needed <= STRING_MAXCHARS / 2) { |
︙ | |||
414 415 416 417 418 419 420 | 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 | - - - + + + + + + + + | if ((objPtr->bytes) && (objPtr->length < 2)) { /* 0 bytes -> 0 chars; 1 byte -> 1 char */ return objPtr->length; } /* |
︙ | |||
513 514 515 516 517 518 519 | 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 | - + | /* *---------------------------------------------------------------------- * * Tcl_GetUnicode -- * * Get the Unicode form of the String object. If the object is not * already a String object, it will be converted to one. If the String |
︙ | |||
647 648 649 650 651 652 653 654 655 656 657 658 659 660 | 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 | + + + + + + + + + + + | stringPtr->numChars = newObjPtr->length; return newObjPtr; } FillUnicodeRep(objPtr); stringPtr = GET_STRING(objPtr); } #if TCL_UTF_MAX == 4 /* See: bug [11ae2be95dac9417] */ if ((first>0) && ((stringPtr->unicode[first]&0xFC00) == 0xDC00) && ((stringPtr->unicode[first-1]&0xFC00) == 0xD800)) { ++first; } if ((last+1<stringPtr->numChars) && ((stringPtr->unicode[last+1]&0xFC00) == 0xDC00) && ((stringPtr->unicode[last]&0xFC00) == 0xD800)) { ++last; } #endif return Tcl_NewUnicodeObj(stringPtr->unicode + first, last-first+1); } /* *---------------------------------------------------------------------- * * Tcl_SetStringObj -- |
︙ | |||
1865 1866 1867 1868 1869 1870 1871 | 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 | - + - + - + - + - + - - - + - - - - - - - - | } else { useWide = 1; #endif } } else if (ch == 'I') { if ((format[1] == '6') && (format[2] == '4')) { format += (step + 2); |
︙ | |||
1935 1936 1937 1938 1939 1940 1941 | 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 | - - - - - + - + + + + + + + + + + + + - + - + + - + + + + + - + - - - - - + + + - - + + + + | segment = Tcl_NewStringObj(buf, length); Tcl_IncrRefCount(segment); allocSegment = 1; break; } case 'u': |
︙ | |||
2179 2180 2181 2182 2183 2184 2185 | 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 | - + | } } /* * Need to be sure zero becomes "0", not "". */ |
︙ | |||
2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 | 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 | + + | break; } } break; } case 'a': case 'A': case 'e': case 'E': case 'f': case 'g': case 'G': { #define MAX_FLOAT_SIZE 320 char spec[2*TCL_INTEGER_SPACE + 9], *p = spec; |
︙ | |||
2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 | 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 | + + + + + + | goto errorMsg; } bytes = TclGetString(segment); if (!Tcl_AttemptSetObjLength(segment, sprintf(bytes, spec, d))) { msg = overflow; errCode = "OVERFLOW"; goto errorMsg; } if (ch == 'A') { char *p = TclGetString(segment) + 1; *p = 'x'; p = strchr(p, 'P'); if (p) *p = 'p'; } break; } default: if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad field specifier \"%c\"", ch)); |
︙ | |||
2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 | 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 | + + + + + + + + + + - + + - | Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj( va_arg(argList, long))); break; case 2: Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj( va_arg(argList, Tcl_WideInt))); break; case 3: Tcl_ListObjAppendElement(NULL, list, Tcl_NewBignumObj( va_arg(argList, mp_int *))); break; } break; case 'a': case 'A': case 'e': case 'E': case 'f': case 'g': case 'G': if (size > 0) { Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj( (double)va_arg(argList, long double))); } else { Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj( |
︙ | |||
2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 | 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 | + + + + | size = 2; } else if (p[1]=='3' && p[2]=='2') { p += 2; } else if (sizeof(size_t) == sizeof(Tcl_WideInt)) { size = 2; } p++; break; case 'L': size = 3; p++; break; case 'h': size = -1; default: p++; } } while (seekingConversion); |
︙ | |||
2688 2689 2690 2691 2692 2693 2694 | 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 | + - + - - + - + - + + | *--------------------------------------------------------------------------- * * TclStringRepeat -- * * Performs the [string repeat] function. * * Results: * A (Tcl_Obj *) pointing to the result value, or NULL in case of an |
︙ | |||
2739 2740 2741 2742 2743 2744 2745 | 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 | - - + - + - - + + - + - - + + - + - + - + - + - - + + - + - - + - - + + - - + + - + - | } else { /* Result will be concat of string reps. Pre-size it. */ Tcl_GetStringFromObj(objPtr, &length); } if (length == 0) { /* Any repeats of empty is empty. */ |
︙ | |||
3034 3035 3036 3037 3038 3039 3040 | 3072 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 | - + - | --oc; } } if (last <= first /*|| length == 0 */) { /* Only one non-empty value or zero length; return first */ /* NOTE: (length == 0) implies (last <= first) */ |
︙ | |||
3085 3086 3087 3088 3089 3090 3091 | 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 | - - + + - + - - + + - + | /* Ugly interface! Force resize of the unicode array. */ Tcl_GetUnicodeFromObj(objResultPtr, &start); Tcl_InvalidateStringRep(objResultPtr); if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "concatenation failed: unable to alloc %" |
︙ | |||
3137 3138 3139 3140 3141 3142 3143 | 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 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 | - + - + - + - - + - + - + + + + - - + - - - + + - + + + + + + - + - + + + + - - - - - - - + + + + + + + - - + - - - - + + - - + - - - - - - - - - - | if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "concatenation failed: unable to alloc %u bytes", length)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } |
︙ | |||
3312 3313 3314 3315 3316 3317 3318 | 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 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 | - + + + + + - + + - + - - - - - - - - - - - - + - - - - - - - - - - - - - - - - - - - - - + - - - + - - - + + + | int lh, ln = Tcl_GetCharLength(needle); if (ln == 0) { /* * We don't find empty substrings. Bizarre! * * TODO: When we one day make this a true substring |
︙ | |||
3426 3427 3428 3429 3430 3431 3432 | 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 3465 3466 3467 3468 3469 | - - + + + + - + - + | while (--src >= from) { *to++ = *src; } } } Tcl_Obj * |
︙ | |||
3479 3480 3481 3482 3483 3484 3485 | 3484 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 | - + | } if (objPtr->bytes) { int numChars = stringPtr->numChars; int numBytes = objPtr->length; char *to, *from = objPtr->bytes; |
︙ |
Changes to generic/tclStubInit.c.
︙ | |||
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 | 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 | + + - + - + + + + + + + + + + + + + | #undef Tcl_Realloc #undef Tcl_NewBooleanObj #undef Tcl_NewByteArrayObj #undef Tcl_NewDoubleObj #undef Tcl_NewIntObj #undef Tcl_NewListObj #undef Tcl_NewLongObj #undef Tcl_DbNewLongObj #undef Tcl_NewObj #undef Tcl_NewStringObj #undef Tcl_DumpActiveMemory #undef Tcl_ValidateAllMemory #undef Tcl_FindHashEntry #undef Tcl_CreateHashEntry #undef Tcl_Panic #undef Tcl_FindExecutable #undef TclpGetPid #undef TclSockMinimumBuffers #undef Tcl_SetIntObj #undef Tcl_SetLongObj #undef TclpInetNtoa #undef TclWinGetServByName #undef TclWinGetSockOpt #undef TclWinSetSockOpt #undef TclWinNToHS /* See bug 510001: TclSockMinimumBuffers needs plat imp */ |
︙ | |||
94 95 96 97 98 99 100 | 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 | - + + + + + + + + + + + + + + + + + + - + + + + + - - - - - - - - - - - - - + - + | { Tcl_Obj *path = Tcl_GetStartupScript(NULL); if (path == NULL) { return NULL; } return Tcl_GetString(path); } |
︙ | |||
190 191 192 193 194 195 196 | 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 | - - - - - - - - - - - + + + + + + + + + + + - - + + + + + + - - + + + + + + + + - + | int TclpGetPid(Tcl_Pid pid) { return (int) (size_t) pid; } |
︙ | |||
307 308 309 310 311 312 313 | 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 | - + | } #define TclFormatInt (int(*)(char *, long))formatInt #endif /* TCL_WIDE_INT_IS_LONG */ #endif /* __CYGWIN__ */ |
︙ | |||
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 | 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 | + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | # undef Tcl_EvalObj # define Tcl_EvalObj 0 # undef Tcl_GlobalEvalObj # define Tcl_GlobalEvalObj 0 # define TclBackgroundException 0 # undef TclpReaddir # define TclpReaddir 0 # define TclSetStartupScript 0 # define TclGetStartupScript 0 # define TclCreateNamespace 0 # define TclDeleteNamespace 0 # define TclAppendExportList 0 # define TclExport 0 # define TclImport 0 # define TclForgetImport 0 # define TclGetCurrentNamespace_ 0 # define TclGetGlobalNamespace_ 0 # define TclFindNamespace 0 # define TclFindCommand 0 # define TclGetCommandFromObj 0 # define TclGetCommandFullName 0 # define TclCopyChannelOld 0 # define Tcl_AppendResultVA 0 # define Tcl_AppendStringsToObjVA 0 # define Tcl_SetErrorCodeVA 0 # define Tcl_PanicVA 0 # define Tcl_VarEvalVA 0 # undef TclpGetDate # define TclpGetDate 0 # undef TclpLocaltime # define TclpLocaltime 0 # undef TclpGmtime # define TclpGmtime 0 # define TclpLocaltime_unix 0 # define TclpGmtime_unix 0 #else /* TCL_NO_DEPRECATED */ # define Tcl_SeekOld seekOld # define Tcl_TellOld tellOld # define TclBackgroundException Tcl_BackgroundException # define TclSetStartupScript Tcl_SetStartupScript # define TclGetStartupScript Tcl_GetStartupScript # define TclCreateNamespace Tcl_CreateNamespace # define TclDeleteNamespace Tcl_DeleteNamespace # define TclAppendExportList Tcl_AppendExportList # define TclExport Tcl_Export # define TclImport Tcl_Import # define TclForgetImport Tcl_ForgetImport # define TclGetCurrentNamespace_ Tcl_GetCurrentNamespace # define TclGetGlobalNamespace_ Tcl_GetGlobalNamespace # define TclFindNamespace Tcl_FindNamespace # define TclFindCommand Tcl_FindCommand # define TclGetCommandFromObj Tcl_GetCommandFromObj # define TclGetCommandFullName Tcl_GetCommandFullName # define TclpLocaltime_unix TclpLocaltime # define TclpGmtime_unix TclpGmtime static int seekOld( Tcl_Channel chan, /* The channel on which to seek. */ int offset, /* Offset to seek to. */ |
︙ | |||
526 527 528 529 530 531 532 | 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 | - - - - - - + + + + + + - - - - - + + + + + - + | 0, /* 105 */ 0, /* 106 */ 0, /* 107 */ TclTeardownNamespace, /* 108 */ TclUpdateReturnInfo, /* 109 */ TclSockMinimumBuffers, /* 110 */ Tcl_AddInterpResolvers, /* 111 */ |
︙ | |||
592 593 594 595 596 597 598 | 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 | - - + + | TclCheckExecutionTraces, /* 171 */ TclInThreadExit, /* 172 */ TclUniCharMatch, /* 173 */ 0, /* 174 */ TclCallVarTraces, /* 175 */ TclCleanupVar, /* 176 */ TclVarErrMsg, /* 177 */ |
︙ |
Changes to generic/tclStubLib.c.
︙ | |||
62 63 64 65 66 67 68 | 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 | - - + + | /* * We can't optimize this check by caching tclStubsPtr because that * prevents apps from being able to load/unload Tcl dynamically multiple * times. [Bug 615304] */ if (!stubsPtr || (stubsPtr->magic != (((exact&0xff00) >= 0x900) ? magic : TCL_STUB_MAGIC))) { |
︙ |
Changes to generic/tclTest.c.
︙ | |||
301 302 303 304 305 306 307 | 301 302 303 304 305 306 307 308 309 310 311 312 313 314 | - - - - - - - - | static int TestinterpdeleteCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestlinkCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestlocaleCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); |
︙ | |||
419 420 421 422 423 424 425 426 427 428 429 430 431 432 | 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 | + + + + + + | static Tcl_FSOpenFileChannelProc SimpleOpenFileChannel; static Tcl_FSListVolumesProc SimpleListVolumes; static Tcl_FSPathInFilesystemProc SimplePathInFilesystem; static Tcl_Obj * SimpleRedirect(Tcl_Obj *pathPtr); static Tcl_FSMatchInDirectoryProc SimpleMatchInDirectory; static int TestNumUtfCharsCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestFindFirstCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestFindLastCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestHashSystemHashCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static Tcl_NRPostProc NREUnwind_callback; static int TestNREUnwind(ClientData clientData, |
︙ | |||
545 546 547 548 549 550 551 | 543 544 545 546 547 548 549 550 551 552 553 554 555 556 | - - - - | *---------------------------------------------------------------------- */ int Tcltest_Init( Tcl_Interp *interp) /* Interpreter for application. */ { |
︙ | |||
688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 | 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 | + + + + - - - - - - - - - - - | (ClientData) TCL_LEAVE_ERR_MSG, NULL); Tcl_CreateCommand(interp, "testseterrorcode", TestseterrorcodeCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testsetobjerrorcode", TestsetobjerrorcodeCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testnumutfchars", TestNumUtfCharsCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfindfirst", TestFindFirstCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfindlast", TestFindLastCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsocket", TestSocketCmd, NULL, NULL); Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd, NULL, NULL); Tcl_CreateCommand(interp, "testtranslatefilename", TesttranslatefilenameCmd, NULL, NULL); Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, NULL, NULL); |
︙ | |||
3343 3344 3345 3346 3347 3348 3349 | 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | } return TCL_OK; } /* *---------------------------------------------------------------------- * |
︙ | |||
5224 5225 5226 5227 5228 5229 5230 5231 5232 5233 5234 5235 5236 5237 | 5071 5072 5073 5074 5075 5076 5077 5078 5079 5080 5081 5082 5083 5084 5085 | + | static int TestsaveresultCmd( ClientData dummy, /* Not used. */ register Tcl_Interp *interp,/* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { Interp* iPtr = (Interp*) interp; int discard, result, index; Tcl_SavedResult state; Tcl_Obj *objPtr; static const char *const optionStrings[] = { "append", "dynamic", "free", "object", "small", NULL }; enum options { |
︙ | |||
5291 5292 5293 5294 5295 5296 5297 | 5139 5140 5141 5142 5143 5144 5145 5146 5147 5148 5149 5150 5151 5152 5153 5154 5155 5156 5157 5158 | - - + + + + + | Tcl_DiscardResult(&state); } else { Tcl_RestoreResult(interp, &state); result = TCL_OK; } switch ((enum options) index) { |
︙ | |||
6876 6877 6878 6879 6880 6881 6882 6883 6884 6885 6886 6887 6888 6889 | 6727 6728 6729 6730 6731 6732 6733 6734 6735 6736 6737 6738 6739 6740 6741 6742 6743 6744 6745 6746 6747 6748 6749 6750 6751 6752 6753 6754 6755 6756 6757 6758 6759 6760 6761 6762 6763 6764 6765 6766 6767 6768 6769 6770 6771 6772 6773 6774 6775 6776 6777 6778 6779 6780 6781 6782 6783 6784 | + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | (void) Tcl_GetIntFromObj(interp, objv[2], &len); } len = Tcl_NumUtfChars(Tcl_GetString(objv[1]), len); Tcl_SetObjResult(interp, Tcl_NewIntObj(len)); } return TCL_OK; } /* * Used to check correct operation of Tcl_UtfFindFirst */ static int TestFindFirstCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { if (objc > 1) { int len = -1; if (objc > 2) { (void) Tcl_GetIntFromObj(interp, objv[2], &len); } Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindFirst(Tcl_GetString(objv[1]), len), -1)); } return TCL_OK; } /* * Used to check correct operation of Tcl_UtfFindLast */ static int TestFindLastCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { if (objc > 1) { int len = -1; if (objc > 2) { (void) Tcl_GetIntFromObj(interp, objv[2], &len); } Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindLast(Tcl_GetString(objv[1]), len), -1)); } return TCL_OK; } #if defined(HAVE_CPUID) || defined(_WIN32) /* *---------------------------------------------------------------------- * * TestcpuidCmd -- * |
︙ |
Changes to generic/tclTestObj.c.
︙ | |||
1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 | 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 | + + + | if (objc != 3) { goto wrongNumArgs; } if (objv[2]->typePtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1)); } else { typeName = objv[2]->typePtr->name; #ifndef TCL_WIDE_INT_IS_LONG if (!strcmp(typeName, "wideInt")) typeName = "int"; #endif Tcl_SetObjResult(interp, Tcl_NewStringObj(typeName, -1)); } } else if (strcmp(subCmd, "refcount") == 0) { if (objc != 3) { goto wrongNumArgs; } index = Tcl_GetString(objv[2]); |
︙ | |||
1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 | 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 | + + + + + | return TCL_ERROR; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } if (varPtr[varIndex]->typePtr == NULL) { /* a string! */ Tcl_AppendToObj(Tcl_GetObjResult(interp), "string", -1); #ifndef TCL_WIDE_INT_IS_LONG } else if (!strcmp(varPtr[varIndex]->typePtr->name, "wideInt")) { Tcl_AppendToObj(Tcl_GetObjResult(interp), "int", -1); #endif } else { Tcl_AppendToObj(Tcl_GetObjResult(interp), varPtr[varIndex]->typePtr->name, -1); } } else if (strcmp(subCmd, "types") == 0) { if (objc != 2) { goto wrongNumArgs; |
︙ |
Changes to generic/tclTimer.c.
︙ | |||
815 816 817 818 819 820 821 | 815 816 817 818 819 820 821 822 823 824 825 826 827 828 | - - - | } /* * First lets see if the command was passed a number as the first argument. */ if (objv[1]->typePtr == &tclIntType |
︙ | |||
1041 1042 1043 1044 1045 1046 1047 | 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 | - - - - - - - - + + + - - - - + + + + - - + + - - - - - - + - + | if (Tcl_LimitCheck(interp) != TCL_OK) { return TCL_ERROR; } } if (iPtr->limit.timeEvent == NULL || TCL_TIME_BEFORE(endTime, iPtr->limit.time)) { diff = TCL_TIME_DIFF_MS_CEILING(endTime, now); |
︙ |
Changes to generic/tclUtf.c.
︙ | |||
64 65 66 67 68 69 70 | 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 | - - - - | 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, |
︙ | |||
90 91 92 93 94 95 96 | 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 | - + | * None. * *--------------------------------------------------------------------------- */ int TclUtfCount( |
︙ | |||
324 325 326 327 328 329 330 | 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 | - - + + + + + + + + + + + | } /* * A three-byte-character lead-byte not followed by two trail-bytes * represents itself. */ } |
︙ | |||
361 362 363 364 365 366 367 | 366 367 368 369 370 371 372 373 374 375 376 377 378 379 | - | } /* * A four-byte-character lead-byte not followed by two trail-bytes * represents itself. */ } |
︙ | |||
394 395 396 397 398 399 400 | 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 | - + | const char *src, /* UTF-8 string to convert to Unicode. */ int length, /* Length of UTF-8 string in bytes, or -1 for * strlen(). */ Tcl_DString *dsPtr) /* Unicode representation of string is * appended to this previously initialized * DString. */ { |
︙ | |||
495 496 497 498 499 500 501 | 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 | - + - + - - + + - - + + - + - + + + + + + + + - + - - + + - + - + - + + + + + + + + - + | if (length < 0) { while (*src != '\0') { src += TclUtfToUniChar(src, &ch); i++; } if (i < 0) i = INT_MAX; /* Bug [2738427] */ } else { |
︙ | |||
659 660 661 662 663 664 665 | 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 | - + | const char *start) /* Pointer to the beginning of the string, to * avoid going backwards too far. */ { const char *look; int i, byte; look = --src; |
︙ | |||
683 684 685 686 687 688 689 | 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 | - + - + - | } /* *--------------------------------------------------------------------------- * * Tcl_UniCharAtIndex -- * |
︙ | |||
733 734 735 736 737 738 739 | 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 | - + - | const char * Tcl_UtfAtIndex( register const char *src, /* The UTF-8 string. */ register int index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; |
︙ | |||
1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 | 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 | + + + + + + + + + + | * only when both strings are of at least n chars long (no need for \0 * check) */ cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); if (ch1 != ch2) { #if TCL_UTF_MAX == 4 /* Surrogates always report higher than non-surrogates */ if (((ch1 & 0xFC00) == 0xD800)) { if ((ch2 & 0xFC00) != 0xD800) { return ch1; } } else if ((ch2 & 0xFC00) == 0xD800) { return -ch2; } #endif return (ch1 - ch2); } } return 0; } /* |
︙ | |||
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 | 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 | + + + + + + + + + + + - + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + + + + + + + + + + + | int Tcl_UtfNcasecmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ unsigned long numChars) /* Number of UTF chars to compare. */ { Tcl_UniChar ch1 = 0, ch2 = 0; while (numChars-- > 0) { /* * n must be interpreted as chars, not bytes. * This should be called only when both strings are of * at least n chars long (no need for \0 check) */ cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); if (ch1 != ch2) { #if TCL_UTF_MAX == 4 /* Surrogates always report higher than non-surrogates */ if (((ch1 & 0xFC00) == 0xD800)) { if ((ch2 & 0xFC00) != 0xD800) { return ch1; } } else if ((ch2 & 0xFC00) == 0xD800) { return -ch2; } #endif ch1 = Tcl_UniCharToLower(ch1); ch2 = Tcl_UniCharToLower(ch2); if (ch1 != ch2) { return (ch1 - ch2); } } } return 0; } |
︙ |
Changes to generic/tclUtil.c.
︙ | |||
970 971 972 973 974 975 976 | 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 | - + | int Tcl_ScanCountedElement( const char *src, /* String to convert to Tcl list element. */ int length, /* Number of bytes in src, or -1. */ int *flagPtr) /* Where to store information to guide * Tcl_ConvertElement. */ { |
︙ | |||
1011 1012 1013 1014 1015 1016 1017 | 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 | - + | *---------------------------------------------------------------------- */ int TclScanElement( const char *src, /* String to convert to Tcl list element. */ int length, /* Number of bytes in src, or -1. */ |
︙ | |||
1543 1544 1545 1546 1547 1548 1549 | 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 | - - + + - - - - - - - - - - - - - - - - + | */ char * Tcl_Merge( int argc, /* How many strings to merge. */ const char *const *argv) /* Array of string values. */ { |
︙ | |||
1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 | 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 | + | if (flagPtr != localFlags) { ckfree(flagPtr); } return result; } #if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 /* *---------------------------------------------------------------------- * * Tcl_Backslash -- * * Figure out how to handle a backslash sequence. * |
︙ | |||
1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 | 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 | + | char buf[TCL_UTF_MAX]; Tcl_UniChar ch = 0; Tcl_UtfBackslash(src, readPtr, buf); TclUtfToUniChar(buf, &ch); return (char) ch; } #endif /* !TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- * * TclTrimRight -- * * Takes two counted strings in the Tcl encoding which must both be null |
︙ | |||
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 | 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 | + - - | const char *bytes, /* String to be trimmed... */ int numBytes, /* ...and its length in bytes */ const char *trim, /* String of trim characters... */ int numTrim) /* ...and its length in bytes */ { const char *p = bytes + numBytes; int pInc; Tcl_UniChar ch1 = 0, ch2 = 0; if ((bytes[numBytes] != '\0') || (trim[numTrim] != '\0')) { Tcl_Panic("TclTrimRight works only on null-terminated strings"); } /* * Empty strings -> nothing to do. */ if ((numBytes == 0) || (numTrim == 0)) { return 0; } /* * Outer loop: iterate over string to be trimmed. */ do { |
︙ | |||
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 | 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 | + - - | TclTrimLeft( const char *bytes, /* String to be trimmed... */ int numBytes, /* ...and its length in bytes */ const char *trim, /* String of trim characters... */ int numTrim) /* ...and its length in bytes */ { const char *p = bytes; Tcl_UniChar ch1 = 0, ch2 = 0; if ((bytes[numBytes] != '\0') || (trim[numTrim] != '\0')) { Tcl_Panic("TclTrimLeft works only on null-terminated strings"); } /* * Empty strings -> nothing to do. */ if ((numBytes == 0) || (numTrim == 0)) { return 0; } /* * Outer loop: iterate over string to be trimmed. */ do { |
︙ | |||
2118 2119 2120 2121 2122 2123 2124 | 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 | - + | const char *str, /* String. */ const char *pattern, /* Pattern, which may contain special * characters. */ int nocase) /* 0 for case sensitive, 1 for insensitive */ { int p, charLen; const char *pstart = pattern; |
︙ | |||
2228 2229 2230 2231 2232 2233 2234 | 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 | - + | /* * Check for a "[" as the next pattern character. It is followed by a * list of characters that are acceptable, or by a range (two * characters separated by "-"). */ if (p == '[') { |
︙ | |||
2713 2714 2715 2716 2717 2718 2719 | 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 | - + | Tcl_DStringAppendElement( Tcl_DString *dsPtr, /* Structure describing dynamic string. */ const char *element) /* String to append. Must be * null-terminated. */ { char *dst = dsPtr->string + dsPtr->length; int needSpace = TclNeedSpace(dsPtr->string, dst); |
︙ | |||
2919 2920 2921 2922 2923 2924 2925 | 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 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 | + - - + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | void Tcl_DStringGetResult( Tcl_Interp *interp, /* Interpreter whose result is to be reset. */ Tcl_DString *dsPtr) /* Dynamic string that is to become the result * of interp. */ { #ifdef TCL_NO_DEPRECATED |
︙ | |||
3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 | 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 | + | * If the new value doesn't make sense then this function undoes the * effect of the variable modification. Otherwise it modifies the format * string that's used by Tcl_PrintDouble. * *---------------------------------------------------------------------- */ #if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 /* ARGSUSED */ char * TclPrecTraceProc( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Interpreter containing variable. */ const char *name1, /* Name of variable. */ const char *name2, /* Second part of variable name. */ |
︙ | |||
3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 | 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 | + | || Tcl_GetIntFromObj(NULL, value, &prec) != TCL_OK || prec < 0 || prec > TCL_MAX_PREC) { return (char *) "improper value for precision"; } *precisionPtr = prec; return NULL; } #endif /* !TCL_NO_DEPRECATED)*/ /* *---------------------------------------------------------------------- * * TclNeedSpace -- * * This function checks to see whether it is appropriate to add a space |
︙ | |||
3411 3412 3413 3414 3415 3416 3417 | 3472 3473 3474 3475 3476 3477 3478 3479 3480 3481 3482 3483 3484 3485 3486 3487 3488 | - + - + | *---------------------------------------------------------------------- */ int TclFormatInt( char *buffer, /* Points to the storage into which the * formatted characters are written. */ |
︙ | |||
3436 3437 3438 3439 3440 3441 3442 | 3497 3498 3499 3500 3501 3502 3503 3504 3505 3506 3507 3508 3509 3510 3511 | - + | * Check whether "n" is the maximum negative value. This is -2^(m-1) for * an m-bit word, and has no positive equivalent; negating it produces the * same value. */ intVal = -n; /* [Bug 3390638] Workaround for*/ if (n == -n || intVal == n) { /* broken compiler optimizers. */ |
︙ | |||
3475 3476 3477 3478 3479 3480 3481 | 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 | - - - + + + - - + + - - - + + - - - - - + + + - - - + + - - - - + + + | } /* *---------------------------------------------------------------------- * * TclGetIntForIndex -- * |
︙ | |||
3525 3526 3527 3528 3529 3530 3531 | 3581 3582 3583 3584 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 | - + | if (SetEndOffsetFromAny(NULL, objPtr) == TCL_OK) { /* * If the object is already an offset from the end of the list, or can * be converted to one, use it. */ |
︙ | |||
3582 3583 3584 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 | 3638 3639 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 | + | bytes = TclGetString(objPtr); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad index \"%s\": must be integer?[+-]integer? or" " end?[+-]integer?", bytes)); if (!strncmp(bytes, "end-", 4)) { bytes += 4; } TclCheckBadOctal(interp, bytes); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL); } return TCL_ERROR; } /* |
︙ | |||
3616 3617 3618 3619 3620 3621 3622 | 3673 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 | - + - + | UpdateStringOfEndOffset( register Tcl_Obj *objPtr) { char buffer[TCL_INTEGER_SPACE + 5]; register int len = 3; memcpy(buffer, "end", 4); |
︙ | |||
3648 3649 3650 3651 3652 3653 3654 | 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 3716 3717 3718 3719 | - + | */ static int SetEndOffsetFromAny( Tcl_Interp *interp, /* Tcl interpreter or NULL */ Tcl_Obj *objPtr) /* Pointer to the object to parse */ { |
︙ | |||
3684 3685 3686 3687 3688 3689 3690 | 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 | - + + - + + + + + | */ if (length <= 3) { offset = 0; } else if ((length > 4) && ((bytes[3] == '-') || (bytes[3] == '+'))) { /* * This is our limited string expression evaluator. Pass everything |
︙ | |||
3716 3717 3718 3719 3720 3721 3722 | 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 3845 3846 3847 3848 3849 3850 3851 3852 3853 3854 3855 3856 3857 3858 3859 3860 3861 3862 3863 | - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | /* * The conversion succeeded. Free the old internal rep and set the new * one. */ TclFreeIntRep(objPtr); |
︙ | |||
3886 3887 3888 3889 3890 3891 3892 | 4015 4016 4017 4018 4019 4020 4021 4022 4023 4024 4025 4026 4027 4028 4029 | - + | * loss of the intrep. Increment newValue refCount early to handle case * where we set a PGV to itself. */ Tcl_IncrRefCount(newValue); cacheMap = GetThreadHash(&pgvPtr->key); ClearHash(cacheMap); |
︙ | |||
3912 3913 3914 3915 3916 3917 3918 | 4041 4042 4043 4044 4045 4046 4047 4048 4049 4050 4051 4052 4053 4054 4055 | - + | Tcl_Obj * TclGetProcessGlobalValue( ProcessGlobalValue *pgvPtr) { Tcl_Obj *value = NULL; Tcl_HashTable *cacheMap; Tcl_HashEntry *hPtr; |
︙ | |||
3946 3947 3948 3949 3950 3951 3952 | 4075 4076 4077 4078 4079 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 | - + | pgvPtr->encoding = current; Tcl_MutexUnlock(&pgvPtr->mutex); } else { Tcl_FreeEncoding(current); } } cacheMap = GetThreadHash(&pgvPtr->key); |
︙ | |||
3979 3980 3981 3982 3983 3984 3985 | 4108 4109 4110 4111 4112 4113 4114 4115 4116 4117 4118 4119 4120 4121 4122 | - + | /* * Store a copy of the shared value in our epoch-indexed cache. */ value = Tcl_NewStringObj(pgvPtr->value, pgvPtr->numBytes); hPtr = Tcl_CreateHashEntry(cacheMap, |
︙ |
Changes to generic/tclVar.c.
︙ | |||
276 277 278 279 280 281 282 | 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 | - + - + | Var *varPtr, /* Pointer to variable that may be a candidate * for being expunged. */ Var *arrayPtr) /* Array that contains the variable, or NULL * if this variable isn't an array element. */ { if (TclIsVarUndefined(varPtr) && TclIsVarInHash(varPtr) && !TclIsVarTraced(varPtr) |
︙ | |||
812 813 814 815 816 817 818 | 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 | + - - + + + + + | || (cxtNsPtr == iPtr->globalNsPtr) || ((*varName == ':') && (*(varName+1) == ':')); if (lookGlobal) { *indexPtr = -1; flags = (flags | TCL_GLOBAL_ONLY) & ~TCL_NAMESPACE_ONLY; } else { if (flags & TCL_AVOID_RESOLVERS) { |
︙ | |||
5701 5702 5703 5704 5705 5706 5707 | 5705 5706 5707 5708 5709 5710 5711 5712 5713 5714 5715 5716 5717 5718 | - - - - | } } /* * Find the namespace(s) that contain the variable. */ |
︙ |
Changes to generic/tclZlib.c.
︙ | |||
369 370 371 372 373 374 375 | 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 | - + | /* * Catch-all. Should be unreachable because all cases are already * listed above. */ default: TclNewLiteralStringObj(objv[2], "UNKNOWN"); |
︙ |
Deleted library/http1.0/http.tcl.
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
|
Deleted library/http1.0/pkgIndex.tcl.
| - - - - - - - - - - - |
|
Changes to library/init.tcl.
︙ | |||
12 13 14 15 16 17 18 | 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]" } |
︙ | |||
69 70 71 72 73 74 75 | 69 70 71 72 73 74 75 76 77 78 79 80 81 82 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | variable Path [encoding dirs] set Dir [file join $::tcl_library encoding] if {$Dir ni $Path} { lappend Path $Dir encoding dirs $Path } } |
︙ | |||
652 653 654 655 656 657 658 | 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 | - + - | if {[info exists auto_execs($name)]} { return $auto_execs($name) } set auto_execs($name) "" set shellBuiltins [list assoc cls copy date del dir echo erase ftype \ |
︙ | |||
687 688 689 690 691 692 693 | 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 | - - + - - | } set path "[file dirname [info nameof]];.;" if {[info exists env(WINDIR)]} { set windir $env(WINDIR) } if {[info exists windir]} { |
︙ |
Changes to library/safe.tcl.
︙ | |||
109 110 111 112 113 114 115 | 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 | - + | # -> TODO (the app should share or access easily the program/value stored # by opt) # This is even more complicated by the boolean flags with no values that # we had the bad idea to support for the sake of user simplicity in # create/init but which makes life hard in configure... # So this will be hopefully written and some integrated with opt1.0 |
︙ |
Changes to library/tzdata/Africa/Sao_Tome.
1 | 1 2 3 4 5 6 7 8 | - - - - + + + + + + + | # created by tools/tclZIC.tcl - do not edit |
Changes to library/tzdata/America/Campo_Grande.
︙ | |||
87 88 89 90 91 92 93 | 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 | - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + | {1424574000 -14400 0 -04} {1445140800 -10800 1 -03} {1456023600 -14400 0 -04} {1476590400 -10800 1 -03} {1487473200 -14400 0 -04} {1508040000 -10800 1 -03} {1518922800 -14400 0 -04} |
Changes to library/tzdata/America/Cuiaba.
︙ | |||
87 88 89 90 91 92 93 | 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 | - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + | {1424574000 -14400 0 -04} {1445140800 -10800 1 -03} {1456023600 -14400 0 -04} {1476590400 -10800 1 -03} {1487473200 -14400 0 -04} {1508040000 -10800 1 -03} {1518922800 -14400 0 -04} |
Changes to library/tzdata/America/La_Paz.
1 2 3 4 5 | 1 2 3 4 5 6 7 8 | - + | # created by tools/tclZIC.tcl - do not edit set TZData(:America/La_Paz) { {-9223372036854775808 -16356 0 LMT} {-2524505244 -16356 0 CMT} |
Changes to library/tzdata/America/Sao_Paulo.
︙ | |||
88 89 90 91 92 93 94 | 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 | - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + | {1424570400 -10800 0 -03} {1445137200 -7200 1 -02} {1456020000 -10800 0 -03} {1476586800 -7200 1 -02} {1487469600 -10800 0 -03} {1508036400 -7200 1 -02} {1518919200 -10800 0 -03} |
Changes to library/tzdata/Asia/Tokyo.
1 2 3 4 5 | 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} |
Changes to macosx/README.
︙ | |||
109 110 111 112 113 114 115 | 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 | - + | ReleaseUniversal10.5SDK: build against the 10.5 SDK (with 10.5 deployment target). Note that the non-SDK configurations have their deployment target set to 10.5 (Tcl.xcode) resp. 10.6 (Tcl.xcodeproj). The Xcode projects refer to the toplevel tcl source directory via the TCL_SRCROOT user build setting, by default this is set to the project-relative path '../../tcl', if your tcl source directory is named differently, e.g. |
︙ | |||
137 138 139 140 141 142 143 | 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 | - + - + | Detailed Instructions for building with macosx/GNUmakefile ---------------------------------------------------------- - Unpack the Tcl source release archive. - The following instructions assume the Tcl source tree is named "tcl${ver}", |
︙ |
Changes to macosx/Tcl-Common.xcconfig.
︙ | |||
30 31 32 33 34 35 36 | 30 31 32 33 34 35 36 37 | - + | PER_ARCH_CFLAGS_ppc = -mcpu=G3 -mtune=G4 $(PER_ARCH_CFLAGS_ppc) PER_ARCH_CFLAGS_ppc64 = -mcpu=G5 -mpowerpc64 $(PER_ARCH_CFLAGS_ppc64) PREFIX = /usr/local TCL_CONFIGURE_ARGS = --enable-threads --enable-dtrace TCL_LIBRARY = $(LIBDIR)/tcl$(VERSION) TCL_PACKAGE_PATH = "$(LIBDIR)" TCL_DEFS = HAVE_TCL_CONFIG_H |
Changes to tests/assemble.test.
︙ | |||
777 778 779 780 781 782 783 | 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 | - + | test assemble-7.43 {uplus} { -body { assemble { push NaN; uplus } } -returnCodes error |
︙ |
Changes to tests/basic.test.
︙ | |||
979 980 981 982 983 984 985 986 987 988 989 990 991 992 | 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 | + + + + + + + + + + | namespace eval ns { variable x namespace testevalex {set ::context $x} global } namespace delete ns set ::context } {global} test basic-50.1 {[586e71dce4] EvalObjv level #0 exception handling} -setup { interp create slave interp alias {} foo slave return } -body { list [catch foo m] $m } -cleanup { unset -nocomplain m interp delete slave } -result {0 {}} # Clean up after expand tests unset noComp l1 l2 constraints rename l3 {} rename run {} #cleanup |
︙ |
Changes to tests/chanio.test.
︙ | |||
5341 5342 5343 5344 5345 5346 5347 | 5341 5342 5343 5344 5345 5346 5347 5348 5349 5350 5351 5352 5353 5354 5355 5356 5357 5358 5359 5360 5361 5362 5363 | - + - + | set x [format "%#o" [expr $stats(mode)&0o777]] chan puts $f "line 1" chan close $f set f [open $path(test3) r] lappend x [chan gets $f] } -cleanup { chan close $f |
︙ | |||
5862 5863 5864 5865 5866 5867 5868 5869 5870 5871 5872 5873 5874 5875 | 5862 5863 5864 5865 5866 5867 5868 5869 5870 5871 5872 5873 5874 5875 5876 5877 | + + | chan event $f readable {script 2} chan event $f readable {} list [testfevent cmd "chan event $f readable"] [chan event $f readable] } -constraints {testfevent fileevent} -cleanup { testfevent delete chan close $f } -result {{script 1} {}} unset path(foo) removeFile foo set path(bar) [makeFile {} bar] test chan-io-48.1 {testing readability conditions} {fileevent} { set f [open $path(bar) w] chan puts $f abcdefg chan puts $f abcdefg |
︙ | |||
5957 5958 5959 5960 5961 5962 5963 5964 5965 5966 5967 5968 5969 5970 | 5959 5960 5961 5962 5963 5964 5965 5966 5967 5968 5969 5970 5971 5972 5973 5974 5975 | + + + | chan puts $f {copy_slowly $f} chan puts $f {exit} vwait [namespace which -variable x] list $x $l } -cleanup { chan close $f } -result {done {0 1 0 1 0 1 0 1 0 1 0 1 0 0}} unset path(bar) removeFile bar test chan-io-48.4 {lf write, testing readability, ^Z termination, auto read mode} -setup { file delete $path(test1) set c 0 set l "" } -constraints {fileevent} -body { set f [open $path(test1) w] chan configure $f -translation lf |
︙ | |||
6786 6787 6788 6789 6790 6791 6792 | 6791 6792 6793 6794 6795 6796 6797 6798 6799 6800 6801 6802 6803 6804 | - - | # -translation binary is also -encoding binary chan configure $in -translation binary chan configure $out -encoding koi8-r -translation lf chan copy $in $out chan close $in chan close $out file size $path(kyrillic.txt) |
︙ |
Changes to tests/cmdIL.test.
︙ | |||
15 16 17 18 19 20 21 22 23 24 25 26 27 28 | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | + | ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] # Used for constraining memory leak tests testConstraint memory [llength [info commands memory]] testConstraint testobj [llength [info commands testobj]] testConstraint fullutf [expr {[format %c 0x010000] != "\ufffd"}] test cmdIL-1.1 {Tcl_LsortObjCmd procedure} -returnCodes error -body { lsort } -result {wrong # args: should be "lsort ?-option value ...? list"} test cmdIL-1.2 {Tcl_LsortObjCmd procedure} -returnCodes error -body { lsort -foo {1 3 2 5} } -result {bad option "-foo": must be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -indices, -integer, -nocase, -real, -stride, or -unique} |
︙ | |||
143 144 145 146 147 148 149 150 151 152 153 154 155 156 | 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 | + + + + + + + + + + + + | } -result {when used with "-stride", the leading "-index" value must be within the group} test cmdIL-1.36 {lsort -stride and -index: Bug 2918962} { lsort -stride 2 -index {0 1} { {{c o d e} 54321} {{b l a h} 94729} {{b i g} 12345} {{d e m o} 34512} } } {{{b i g} 12345} {{d e m o} 34512} {{c o d e} 54321} {{b l a h} 94729}} test cmdIL-1.37 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} { lsort -ascii [list \0 \x7f \x80 \uffff] } [list \0 \x7f \x80 \uffff] test cmdIL-1.38 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} { lsort -ascii -nocase [list \0 \x7f \x80 \uffff] } [list \0 \x7f \x80 \uffff] test cmdIL-1.39 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} fullutf { lsort -ascii [list \0 \x7f \x80 \U01ffff \uffff] } [list \0 \x7f \x80 \uffff \U01ffff] test cmdIL-1.40 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} fullutf { lsort -ascii -nocase [list \0 \x7f \x80 \U01ffff \uffff] } [list \0 \x7f \x80 \uffff \U01ffff] # Can't think of any good tests for the MergeSort and MergeLists procedures, # except a bunch of random lists to sort. test cmdIL-2.1 {MergeSort and MergeLists procedures} -setup { set result {} set r 1435753299 |
︙ |
Changes to tests/compExpr-old.test.
︙ | |||
16 17 18 19 20 21 22 | 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | - - - - - - | package require tcltest 2 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] |
︙ | |||
281 282 283 284 285 286 287 | 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 | - + - + - + - + | expr 2***3|6 } -returnCodes error -match glob -result * test compExpr-old-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body { expr 2^x } -returnCodes error -match glob -result * test compExpr-old-6.9 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {24.0^3}} msg] $msg |
︙ | |||
373 374 375 376 377 378 379 | 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 | - + - + - + - + | expr 2***3>>6 } -returnCodes error -match glob -result * test compExpr-old-10.9 {CompileShiftExpr: error compiling shift arm} -body { expr 2<<x } -returnCodes error -match glob -result * test compExpr-old-10.10 {CompileShiftExpr: runtime error} { list [catch {expr {24.0>>43}} msg] $msg |
︙ | |||
426 427 428 429 430 431 432 | 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 | - + - + - + - + | expr 2*3%%6 } -returnCodes error -match glob -result * test compExpr-old-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body { expr 2*x } -returnCodes error -match glob -result * test compExpr-old-12.10 {CompileMultiplyExpr: runtime error} { list [catch {expr {24.0*"xx"}} msg] $msg |
︙ | |||
598 599 600 601 602 603 604 | 592 593 594 595 596 597 598 599 600 601 602 603 604 605 | - - - - - - - - - - - - - - - - | set ::errorInfo } -match glob -result {too few arguments for math function* while *ing "expr pow(1)"} test compExpr-old-15.6 {CompileMathFuncCall: missing ')'} -body { expr sin(1 } -returnCodes error -match glob -result * |
︙ |
Changes to tests/compExpr.test.
︙ | |||
12 13 14 15 16 17 18 | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | - - - - - - | package require tcltest 2 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] |
︙ | |||
315 316 317 318 319 320 321 | 309 310 311 312 313 314 315 316 317 318 319 320 321 322 | - - - - - - | test compExpr-5.1 {CompileMathFuncCall procedure, math function found} { format %.6g [expr atan2(1.0, 2.0)] } 0.463648 test compExpr-5.2 {CompileMathFuncCall procedure, math function not found} -body { expr {do_it()} } -returnCodes error -match glob -result {* "*do_it"} |
︙ |
Changes to tests/compile.test.
︙ | |||
319 320 321 322 323 324 325 | 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 | - + | }} } -returnCodes error -result {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?} test compile-11.2 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { set r [list foobar] ; string index a bogus }} } -returnCodes error -result {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?} test compile-11.3 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { set r [list foobar] ; string index a 0o9 }} |
︙ |
Changes to tests/exec.test.
︙ | |||
296 297 298 299 300 301 302 | 296 297 298 299 300 301 302 303 304 305 306 307 308 309 | - | exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2" \ |& [interpreter] $path(sh) -c "\"$path(echo)\" second msg 1>&2 ; \"$path(cat)\"" |& [interpreter] $path(cat) } "second msg\nfoo bar" # I/O redirection: combinations. set path(gorp.file2) [makeFile {} gorp.file2] |
︙ |
Changes to tests/execute.test.
︙ | |||
170 171 172 173 174 175 176 | 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 | - + | test execute-3.5 {TclExecuteByteCode, INST_ADD, op1 is string double} {testobj} { set x [teststringobj set 0 1.0] expr {$x + 1} } 2.0 test execute-3.6 {TclExecuteByteCode, INST_ADD, op1 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {$x + 1}} msg] $msg |
︙ | |||
195 196 197 198 199 200 201 | 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 | - + | test execute-3.11 {TclExecuteByteCode, INST_ADD, op2 is string double} {testobj} { set x [teststringobj set 0 1.0] expr {1 + $x} } 2.0 test execute-3.12 {TclExecuteByteCode, INST_ADD, op2 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {1 + $x}} msg] $msg |
︙ | |||
222 223 224 225 226 227 228 | 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 | - + | test execute-3.17 {TclExecuteByteCode, INST_SUB, op1 is string double} {testobj} { set x [teststringobj set 0 1.0] expr {$x - 1} } 0.0 test execute-3.18 {TclExecuteByteCode, INST_SUB, op1 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {$x - 1}} msg] $msg |
︙ | |||
247 248 249 250 251 252 253 | 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 | - + | test execute-3.23 {TclExecuteByteCode, INST_SUB, op2 is string double} {testobj} { set x [teststringobj set 0 1.0] expr {1 - $x} } 0.0 test execute-3.24 {TclExecuteByteCode, INST_SUB, op2 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {1 - $x}} msg] $msg |
︙ | |||
274 275 276 277 278 279 280 | 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 | - + | test execute-3.29 {TclExecuteByteCode, INST_MULT, op1 is string double} {testobj} { set x [teststringobj set 1 1.0] expr {$x * 1} } 1.0 test execute-3.30 {TclExecuteByteCode, INST_MULT, op1 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {$x * 1}} msg] $msg |
︙ | |||
299 300 301 302 303 304 305 | 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 | - + | test execute-3.35 {TclExecuteByteCode, INST_MULT, op2 is string double} {testobj} { set x [teststringobj set 1 1.0] expr {1 * $x} } 1.0 test execute-3.36 {TclExecuteByteCode, INST_MULT, op2 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {1 * $x}} msg] $msg |
︙ | |||
326 327 328 329 330 331 332 | 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 | - + | test execute-3.41 {TclExecuteByteCode, INST_DIV, op1 is string double} {testobj} { set x [teststringobj set 1 1.0] expr {$x / 1} } 1.0 test execute-3.42 {TclExecuteByteCode, INST_DIV, op1 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {$x / 1}} msg] $msg |
︙ | |||
351 352 353 354 355 356 357 | 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 | - + | test execute-3.47 {TclExecuteByteCode, INST_DIV, op2 is string double} {testobj} { set x [teststringobj set 1 1.0] expr {2 / $x} } 2.0 test execute-3.48 {TclExecuteByteCode, INST_DIV, op2 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {1 / $x}} msg] $msg |
︙ | |||
378 379 380 381 382 383 384 | 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 | - + | test execute-3.53 {TclExecuteByteCode, INST_UPLUS, op is string double} {testobj} { set x [teststringobj set 1 1.0] expr {+ $x} } 1.0 test execute-3.54 {TclExecuteByteCode, INST_UPLUS, op is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {+ $x}} msg] $msg |
︙ | |||
405 406 407 408 409 410 411 | 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 | - + | test execute-3.59 {TclExecuteByteCode, INST_UMINUS, op is string double} {testobj} { set x [teststringobj set 1 1.0] expr {- $x} } -1.0 test execute-3.60 {TclExecuteByteCode, INST_UMINUS, op is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {- $x}} msg] $msg |
︙ | |||
453 454 455 456 457 458 459 | 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 | - + | test execute-3.70 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} { set x [teststringobj set 1 0.0] expr {! $x} } 1 test execute-3.71 {TclExecuteByteCode, INST_LNOT, op is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {! $x}} msg] $msg |
︙ |
Changes to tests/expr-old.test.
︙ | |||
20 21 22 23 24 25 26 | 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | - - - - - - | catch [list package require -exact Tcltest [info patchlevel]] testConstraint testexprlong [llength [info commands testexprlong]] testConstraint testexprdouble [llength [info commands testexprdouble]] testConstraint testexprstring [llength [info commands testexprstring]] testConstraint longIs32bit [expr {int(0x80000000) < 0}] |
︙ | |||
193 194 195 196 197 198 199 | 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 | - + - + - + - + - + - + - + - + - + - + | list [catch {expr 028.1 + 09.2} msg] $msg } {0 37.3} # Operators that aren't legal on floating-point numbers test expr-old-3.1 {illegal floating-point operations} { list [catch {expr ~4.0} msg] $msg |
︙ | |||
261 262 263 264 265 266 267 | 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 | - + - + - + - + - + - + - + - + - + - + - + - + - + - + | test expr-old-4.31 {string operators} {expr {1?"foo":"bar"}} foo test expr-old-4.32 {string operators} {expr {0?"foo":"bar"}} bar # Operators that aren't legal on string operands. test expr-old-5.1 {illegal string operations} { list [catch {expr {-"a"}} msg] $msg |
︙ | |||
489 490 491 492 493 494 495 | 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 | - + - + - + | test expr-old-25.19 {type conversions} {expr 2.0e15} 2000000000000000.0 test expr-old-25.20 {type conversions} {expr 10.0} 10.0 # Various error conditions. test expr-old-26.1 {error conditions} { list [catch {expr 2+"a"} msg] $msg |
︙ | |||
530 531 532 533 534 535 536 | 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 | - + | expr 2# } -returnCodes error -match glob -result * test expr-old-26.12 {error conditions} -body { expr a.b } -returnCodes error -match glob -result * test expr-old-26.13 {error conditions} { list [catch {expr {"a"/"b"}} msg] $msg |
︙ | |||
843 844 845 846 847 848 849 | 837 838 839 840 841 842 843 844 845 846 847 848 849 850 | - - - - - - | } -999999999999999949387135297074018866963645011013410073083904 test expr-old-32.41 {math functions in expressions} { list [catch {expr pow(1.0 + 3.0 - 2, .8 * 5)} msg] $msg } {0 16.0} test expr-old-32.42 {math functions in expressions} { list [catch {expr hypot(5*.8,3)} msg] $msg } {0 5.0} |
︙ | |||
948 949 950 951 952 953 954 | 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 | - - - - - - + | } -5076964154930102272 test expr-old-34.15 {errors in math functions} { expr round(1.0e30) } 1000000000000000019884624838656 test expr-old-34.16 {errors in math functions} { expr round(-1.0e30) } -1000000000000000019884624838656 |
︙ | |||
999 1000 1001 1002 1003 1004 1005 | 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 | - + - + - + | expr {$x+1} } 665802003400000000000001 # tests for [Bug #587140] test expr-old-36.12 {ExprLooksLikeInt procedure} { set x "10;" list [catch {expr {$x+1}} msg] $msg |
︙ | |||
1155 1156 1157 1158 1159 1160 1161 | 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 | - - + + + + + + + + - - + + + + + + + + | test expr-old-40.1 {min math function} -body { expr {min(0)} } -result 0 test expr-old-40.2 {min math function} -body { expr {min(0.0)} } -result 0.0 test expr-old-40.3 {min math function} -body { |
︙ |
Changes to tests/expr.test.
︙ | |||
14 15 16 17 18 19 20 | 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | - - - - | package require tcltest 2.1 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] |
︙ | |||
253 254 255 256 257 258 259 | 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 | - + | test expr-4.9 {CompileLorExpr: long lor arm} { set a "abcdefghijkl" set i 7 expr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]} } 1 test expr-4.10 {CompileLorExpr: error compiling ! operand} { list [catch {expr {!"a"}} msg] $msg |
︙ | |||
300 301 302 303 304 305 306 | 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 | - + - + - + - + | expr 2***3|6 } -returnCodes error -match glob -result * test expr-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body { expr 2^x } -returnCodes error -match glob -result * test expr-6.9 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {24.0^3}} msg] $msg |
︙ | |||
452 453 454 455 456 457 458 | 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 | - + - + - + - + | expr 2***3>>6 } -returnCodes error -match glob -result * test expr-10.9 {CompileShiftExpr: error compiling shift arm} -body { expr 2<<x } -returnCodes error -match glob -result * test expr-10.10 {CompileShiftExpr: runtime error} { list [catch {expr {24.0>>43}} msg] $msg |
︙ | |||
505 506 507 508 509 510 511 | 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 | - + - + - + - + | expr 2*3%%6 } -returnCodes error -match glob -result * test expr-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body { expr 2*x } -returnCodes error -match glob -result * test expr-12.10 {CompileMultiplyExpr: runtime error} { list [catch {expr {24.0*"xx"}} msg] $msg |
︙ | |||
681 682 683 684 685 686 687 | 677 678 679 680 681 682 683 684 685 686 687 688 689 690 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | set ::errorInfo } -match glob -result {too few arguments for math function* while *ing "expr pow(1)"} test expr-15.6 {CompileMathFuncCall: missing ')'} -body { expr sin(1 } -returnCodes error -match glob -result * |
︙ | |||
840 841 842 843 844 845 846 | 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 867 868 869 870 871 872 | - + - + - + - + - + - + - + - + | test expr-21.11 {non-numeric boolean literals} {expr !no } 1 test expr-21.12 {non-numeric boolean literals} {expr !yes } 0 test expr-21.13 {non-numeric boolean literals} -body { expr !truef } -returnCodes error -match glob -result * test expr-21.14 {non-numeric boolean literals} { list [catch {expr !"truef"} err] $err |
︙ | |||
933 934 935 936 937 938 939 | 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 | - + - + | expr (-3-)**6 } -returnCodes error -match glob -result * test expr-23.8 {CompileExponentialExpr: error compiling expo arm} -body { expr 2**x } -returnCodes error -match glob -result * test expr-23.9 {CompileExponentialExpr: runtime error} { list [catch {expr {24.0**"xx"}} msg] $msg |
︙ | |||
5834 5835 5836 5837 5838 5839 5840 5841 5842 5843 5844 5845 5846 5847 | 5795 5796 5797 5798 5799 5800 5801 5802 5803 5804 5805 5806 5807 5808 5809 5810 5811 5812 5813 5814 5815 5816 5817 | + + + + + + + + + | } [expr (1<<63)-1] test expr-32.5 {Bug 1585704} { expr (1<<32)%(1<<63) } [expr 1<<32] test expr-32.6 {Bug 1585704} { expr -(1<<32)%(1<<63) } [expr (1<<63)-(1<<32)] test expr-32.7 {bignum regression} { expr {0%(1<<63)} } 0 test expr-32.8 {bignum regression} { expr {0%-(1<<63)} } 0 test expr-32.9 {bignum regression} { expr {0%-(1+(1<<63))} } 0 test expr-33.1 {parse largest long value} longIs32bit { set max_long_str 2147483647 set max_long_hex "0x7FFFFFFF " # Convert to integer (long, not wide) internal rep set max_long 2147483647 |
︙ |
Changes to tests/fileSystem.test.
︙ | |||
373 374 375 376 377 378 379 380 381 382 383 384 385 386 | 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 | + + + + + + + + + + + + + + + + | file join $x bar } -result /foo/bar test filesystem-1.52.1 {bug f9f390d0fa: file join where strep is not canonical} -body { set x //foo file normalize $x file join $x } -result /foo test filesystem-1.53 {[Bug 3559678] - normalize when tail is empty} { string match */ [file normalize [lindex [glob -dir [pwd] {{}}] 0]] } 0 test filesystem-1.54 {[Bug ce3a211dcb] - normalize when tail is empty} -setup { set save [pwd] cd [set home [makeDirectory ce3a211dcb]] makeDirectory A $home cd [lindex [glob */] 0] } -body { string match */A [pwd] } -cleanup { cd $home removeDirectory A $home cd $save removeDirectory ce3a211dcb } -result 1 test filesystem-2.0 {new native path} {unix} { foreach f [lsort [glob -nocomplain /usr/bin/c*]] { catch {file readlink $f} } # If we reach here we've succeeded. We used to crash above. return ok |
︙ |
Changes to tests/format.test.
︙ | |||
24 25 26 27 28 29 30 | 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 | - + | testConstraint pointerIs64bit [expr {$tcl_platform(pointerSize) >= 8}] test format-1.1 {integer formatting} { format "%*d %d %d %d" 6 34 16923 -12 -1 } { 34 16923 -12 -1} test format-1.2 {integer formatting} { format "%4d %4d %4d %4d %d %#x %#X" 6 34 16923 -12 -1 14 12 |
︙ | |||
50 51 52 53 54 55 56 | 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 | - + - + - + - + - + - + - + - + - + - - + + - - + + - - + + | format "%4x %4x %4x %4x" 6 34 16923 -12 -1 } { 6 22 421b fffffff4} test format-1.7.1 {integer formatting} longIs64bit { format "%4x %4x %4x %4x" 6 34 16923 -12 -1 } { 6 22 421b fffffffffffffff4} test format-1.8 {integer formatting} longIs32bit { format "%#x %#x %#X %#X %#x" 0 6 34 16923 -12 -1 |
︙ | |||
557 558 559 560 561 562 563 | 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 | - + | format %ld 42 } 42 test format-17.4 {testing %l with non-integer} { format %lf 1 } 1.000000 test format-17.5 {testing %llu with positive bignum} -body { format %llu 0xabcdef0123456789abcdef |
︙ |
Changes to tests/get.test.
︙ | |||
94 95 96 97 98 99 100 | 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 | - + - + - + - + | foreach num $numbers { lappend result [catch {format %g $num} msg] $msg } set result } {0 1 0 1 1 {expected floating-point number but got "++1.0"} 1 {expected floating-point number but got "+-1.0"} 1 {expected floating-point number but got "-+1.0"} 0 -1 1 {expected floating-point number but got "--1.0"} 1 {expected floating-point number but got "- +1.0"}} # Bug 7114ac6141 test get-3.3 {tcl_GetInt with iffy numbers} testgetint { |
︙ |
Deleted tests/httpold.test.
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
|
Changes to tests/info.test.
︙ | |||
2394 2395 2396 2397 2398 2399 2400 | 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 | - + | } -cleanup { namespace delete foo } -result {type source line 2389 file info.test cmd {info frame 0} proc ::foo::bar level 0} # ------------------------------------------------------------------------- unset -nocomplain res |
︙ |
Changes to tests/interp.test.
︙ | |||
1843 1844 1845 1846 1847 1848 1849 | 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 | - + | lappend l [lsort [interp aliases a]] [lsort [interp hidden a]] a hide bar lappend l [lsort [interp aliases a]] [lsort [interp hidden a]] a alias bar {} lappend l [lsort [interp aliases a]] [lsort [interp hidden a]] } -cleanup { interp delete a |
︙ |
Changes to tests/io.test.
︙ | |||
5634 5635 5636 5637 5638 5639 5640 | 5634 5635 5636 5637 5638 5639 5640 5641 5642 5643 5644 5645 5646 5647 5648 5649 5650 5651 5652 5653 5654 5655 5656 5657 5658 5659 5660 5661 5662 5663 | - + - + | close $f set x } {zzy abzzy} test io-40.2 {POSIX open access modes: CREAT} {unix} { file delete $path(test3) set f [open $path(test3) {WRONLY CREAT} 0o600] file stat $path(test3) stats |
︙ | |||
6159 6160 6161 6162 6163 6164 6165 6166 6167 6168 6169 6170 6171 6172 | 6159 6160 6161 6162 6163 6164 6165 6166 6167 6168 6169 6170 6171 6172 6173 6174 | + + | fileevent $f readable {} set x [list [testfevent cmd "fileevent $f readable"] \ [fileevent $f readable]] testfevent delete close $f set x } {{script 1} {}} unset path(foo) removeFile foo set path(bar) [makeFile {} bar] test io-48.1 {testing readability conditions} {fileevent} { set f [open $path(bar) w] puts $f abcdefg puts $f abcdefg |
︙ | |||
6261 6262 6263 6264 6265 6266 6267 6268 6269 6270 6271 6272 6273 6274 | 6263 6264 6265 6266 6267 6268 6269 6270 6271 6272 6273 6274 6275 6276 6277 6278 6279 | + + + | puts $f "set f \[[list open $path(bar) r]]" puts $f {copy_slowly $f} puts $f {exit} vwait [namespace which -variable x] close $f list $x $l } {done {0 1 0 1 0 1 0 1 0 1 0 1 0 0}} unset path(bar) removeFile bar test io-48.4 {lf write, testing readability, ^Z termination, auto read mode} {fileevent} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf variable c [format "abc\ndef\n%c" 26] puts -nonewline $f $c close $f |
︙ |
Changes to tests/ioCmd.test.
︙ | |||
380 381 382 383 384 385 386 | 380 381 382 383 384 385 386 387 388 389 390 391 392 393 | - | test iocmd-10.5 {fblocked command} { fblocked stdin } 0 set path(test4) [makeFile {} test4] set path(test5) [makeFile {} test5] |
︙ | |||
3832 3833 3834 3835 3836 3837 3838 | 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 | - - + - | rename track {} # cleanup foreach file [list test1 test2 test3 test4] { removeFile $file } # delay long enough for background processes to finish after 500 |
Changes to tests/join.test.
︙ | |||
41 42 43 44 45 46 47 48 49 50 51 52 53 54 | 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 | + + + + + | test join-3.1 {joinString is binary ok} { string length [join {a b c} a\0b] } 9 test join-3.2 {join is binary ok} { string length [join "a\0b a\0b a\0b"] } 11 test join-4.1 {shimmer segfault prevention} { set l {0 0} join $l $l } {00 00} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl |
︙ |
Changes to tests/lindex.test.
︙ | |||
66 67 68 69 70 71 72 | 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 | - + - + | test lindex-3.4 {integer 3} testevalex { set x [string range 33 0 0] list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}] } {{} {}} test lindex-3.5 {bad octal} -constraints testevalex -body { set x 0o8 list [catch { testevalex {lindex {a b c} $x} } result] $result |
︙ | |||
101 102 103 104 105 106 107 | 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 | - + - + | test lindex-4.5 {index = end-3} testevalex { set x end-3 list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}] } {{} {}} test lindex-4.6 {bad octal} -constraints testevalex -body { set x end-0o8 list [catch { testevalex {lindex {a b c} $x} } result] $result |
︙ | |||
257 258 259 260 261 262 263 | 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 | - + - + | list [lindex {a b c} $x] [lindex {a b c} $x] } result set result } {{} {}} test lindex-11.5 {bad octal} -body { set x 0o8 list [catch { lindex {a b c} $x } result] $result |
︙ | |||
303 304 305 306 307 308 309 | 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 | - + - + | list [lindex {a b c} $x] [lindex {a b c} $x] } result set result } {{} {}} test lindex-12.6 {bad octal} -body { set x end-0o8 list [catch { lindex {a b c} $x } result] $result |
︙ |
Changes to tests/mathop.test.
︙ | |||
110 111 112 113 114 115 116 | 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 | - + - + - + - + - + - + | test mathop-1.6 {compiled +} { + 1 2 3.0 } 6.0 test mathop-1.7 {compiled +} { + 100000000000 2 3 } 100000000005 test mathop-1.8 {compiled +} { + 1 2 300000000000 } 300000000003 test mathop-1.9 {compiled +} { + 1000000000000000000000 2 3 } 1000000000000000000005 test mathop-1.10 {compiled +} { + 1 2 3000000000000000000000 } 3000000000000000000003 test mathop-1.11 {compiled +: errors} -returnCodes error -body { + x 0 |
︙ | |||
148 149 150 151 152 153 154 | 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 | - + - + - + - + - + - + | test mathop-1.24 {interpreted +} { $op 1 2 3.0 } 6.0 test mathop-1.25 {interpreted +} { $op 100000000000 2 3 } 100000000005 test mathop-1.26 {interpreted +} { $op 1 2 300000000000 } 300000000003 test mathop-1.27 {interpreted +} { $op 1000000000000000000000 2 3 } 1000000000000000000005 test mathop-1.28 {interpreted +} { $op 1 2 3000000000000000000000 } 3000000000000000000003 test mathop-1.29 {interpreted +: errors} -returnCodes error -body { $op x 0 |
︙ | |||
185 186 187 188 189 190 191 | 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 | - + - + - + - + - + - + | test mathop-2.6 {compiled *} { * 1 2 3.0 } 6.0 test mathop-2.7 {compiled *} { * 100000000000 2 3 } 600000000000 test mathop-2.8 {compiled *} { * 1 2 300000000000 } 600000000000 test mathop-2.9 {compiled *} { * 1000000000000000000000 2 3 } 6000000000000000000000 test mathop-2.10 {compiled *} { * 1 2 3000000000000000000000 } 6000000000000000000000 test mathop-2.11 {compiled *: errors} -returnCodes error -body { * x 0 |
︙ | |||
223 224 225 226 227 228 229 | 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 | - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + | test mathop-2.24 {interpreted *} { $op 1 2 3.0 } 6.0 test mathop-2.25 {interpreted *} { $op 100000000000 2 3 } 600000000000 test mathop-2.26 {interpreted *} { $op 1 2 300000000000 } 600000000000 test mathop-2.27 {interpreted *} { $op 1000000000000000000000 2 3 } 6000000000000000000000 test mathop-2.28 {interpreted *} { $op 1 2 3000000000000000000000 } 6000000000000000000000 test mathop-2.29 {interpreted *: errors} -returnCodes error -body { $op x 0 |
︙ | |||
373 374 375 376 377 378 379 | 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 | - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + | test mathop-6.1 {compiled &} { & } -1 test mathop-6.2 {compiled &} { & 1 } 1 test mathop-6.3 {compiled &} { & 1 2 } 0 test mathop-6.4 {compiled &} { & 3 7 6 } 2 test mathop-6.5 {compiled &} -returnCodes error -body { & 1.0 2 3 |
︙ | |||
483 484 485 486 487 488 489 | 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 | - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + | test mathop-7.1 {compiled |} { | } 0 test mathop-7.2 {compiled |} { | 1 } 1 test mathop-7.3 {compiled |} { | 1 2 } 3 test mathop-7.4 {compiled |} { | 3 7 6 } 7 test mathop-7.5 {compiled |} -returnCodes error -body { | 1.0 2 3 |
︙ | |||
593 594 595 596 597 598 599 | 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 | - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + | test mathop-8.1 {compiled ^} { ^ } 0 test mathop-8.2 {compiled ^} { ^ 1 } 1 test mathop-8.3 {compiled ^} { ^ 1 2 } 3 test mathop-8.4 {compiled ^} { ^ 3 7 6 } 2 test mathop-8.5 {compiled ^} -returnCodes error -body { ^ 1.0 2 3 |
︙ | |||
771 772 773 774 775 776 777 | 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 | - + - + | test mathop-20.6 { one arg, error } { set res {} set exp {} foreach vals {x {1 x} {1 1 x} {1 x 1}} { # skipping - for now, knownbug... foreach op {+ * / & | ^ **} { lappend res [TestOp $op {*}$vals] |
︙ | |||
846 847 848 849 850 851 852 | 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 | - + - + - + - + - + | set res } [list 1.0 0.2 0.17857142857142858 -0.125 \ 2.8196218755553604e-15 8.10000006561e-27] test mathop-21.5 { unary ops, bad values } { set res {} set exp {} lappend res [TestOp / x] |
︙ | |||
961 962 963 964 965 966 967 | 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 | - + - + | 70720 \ ] test mathop-22.4 { unary ops, bad values } { set res {} set exp {} foreach op {& | ^} { lappend res [TestOp $op x 5] |
︙ | |||
1076 1077 1078 1079 1080 1081 1082 | 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 | - + - + - + - + | 0 \ ] test mathop-24.3 { binary ops, bad values } { set res {} set exp {} foreach op {% << >>} { lappend res [TestOp $op x 1] |
︙ | |||
1236 1237 1238 1239 1240 1241 1242 | 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 | - + - + | lappend res [TestOp ** $small $wide] lappend exp "exponent too large NONE" lappend res [TestOp ** 2 $big] lappend exp "exponent too large NONE" lappend res [TestOp ** $huge 2.1] lappend exp "Inf" lappend res [TestOp ** 2 foo] |
︙ |
Changes to tests/namespace-old.test.
︙ | |||
289 290 291 292 293 294 295 | 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 | - - + - + - + | proc test_ns_show {} {return "[namespace current]: 2"} namespace eval test_ns_hier3a {} namespace eval test_ns_hier3b {} } namespace eval test_ns_hier2a {} namespace eval test_ns_hier2b {} } |
︙ | |||
465 466 467 468 469 470 471 | 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 | - - - + + - - - + + - - - - + + + | } test namespace-old-6.11 {commands affect all parent namespaces} { proc test_ns_cache1::test_ns_cache2::test_ns_cache_cmd {} { return "cache2 version" } list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger] } {{cache2 version} {cache2 version}} |
︙ |
Changes to tests/namespace.test.
︙ | |||
42 43 44 45 46 47 48 | 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 | - + - + | list [namespace current] [namespace eval {} {namespace current}] \ [namespace eval {} {namespace current}] } {:: :: ::} test namespace-2.2 {Tcl_GetCurrentNamespace} { set l {} lappend l [namespace current] namespace eval test_ns_1 { |
︙ | |||
191 192 193 194 195 196 197 198 199 200 201 202 203 204 | 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 | + + + + + + + + + + + + + | } } -body { slave eval foo slave invokehidden infocommands } -cleanup { interp delete slave } -result {} test namespace-7.8 {Bug ba1419303b4c} -setup { namespace eval ns1 { namespace ensemble create } trace add command ns1 delete { namespace delete ns1 } } -body { # No segmentation fault given --enable-symbols=mem. namespace delete ns1 } -result {} test namespace-8.1 {TclTeardownNamespace, delete global namespace} { catch {interp delete test_interp} interp create test_interp interp eval test_interp { namespace eval test_ns_1 { namespace export p |
︙ | |||
629 630 631 632 633 634 635 | 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 | - - - + - - + - | } } -body { namespace eval test_ns_1 { list [catch {set ::test_ns_777::v} msg] $msg \ [catch {namespace children test_ns_777} msg] $msg } } -result {1 {can't read "::test_ns_777::v": no such variable} 1 {namespace "test_ns_777" not found in "::test_ns_1"}} |
︙ | |||
707 708 709 710 711 712 713 | 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 | - - - + - - + + | catch {rename test_ns_1::test_ns_2:: {}} set l {} } -body { lappend l [catch {test_ns_1::test_ns_2:: hello} msg] $msg proc test_ns_1::test_ns_2:: {args} {return "\{\}: $args"} lappend l [test_ns_1::test_ns_2:: hello] } -result {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}} |
︙ | |||
890 891 892 893 894 895 896 | 897 898 899 900 901 902 903 904 905 906 907 908 909 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 | - - - + - + - - - + | variable x 777 } } -body { namespace eval test_ns_1 { set x } } -result {777} |
︙ | |||
1546 1547 1548 1549 1550 1551 1552 | 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 | - - - + - + | namespace eval test_ns_3 { list [namespace which foreach] \ [namespace which p] \ [namespace which cmd1] \ [namespace which ::test_ns_2::cmd2] } } -result {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2} |
︙ | |||
1792 1793 1794 1795 1796 1797 1798 | 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 | - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | proc x2 {} {format 2} proc x3 {} {format 3} namespace ensemble create } list [ns x0 z] [ns x1] [ns x2] [ns x3] } -cleanup { namespace delete ns |
︙ | |||
1928 1929 1930 1931 1932 1933 1934 | 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 | - + | } {1 {ensemble subcommand implementations must be non-empty lists}} test namespace-44.5 {ensemble: errors} -setup { namespace ensemble create -command foobar -subcommands {foobarcget foobarconfigure} } -body { foobar foobarcon } -cleanup { rename foobar {} |
︙ | |||
2092 2093 2094 2095 2096 2097 2098 | 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 | - + | set result {} lappend result [catch {ns a b c} msg] $msg lappend result [catch {ns a b c} msg] $msg lappend result [catch {ns b c d} msg] $msg lappend result [catch {ns c d e} msg] $msg lappend result [catch {ns Magic foo bar spong wibble} msg] $msg list $result [lsort [info commands ::ns::*]] $log [namespace delete ns] |
︙ | |||
3191 3192 3193 3194 3195 3196 3197 | 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 | - + | } -cleanup { namespace delete ns } -result\ {0 0\ 1 {wrong # args: should be "ns z1 x a1"}\ 1 {wrong # args: should be "ns z2 x a1 a2"}\ 1 {wrong # args: should be "ns z2 x a1 a2"}\ |
︙ | |||
3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 | 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 | + + + + + + + + + + + + | try { return [lsort $gone] } finally { namespace delete ::testing } } } {::testing::abc::def ::testing::abc::ghi} test namespace-56.4 {bug 16fe1b5807: names starting with ":"} { namespace eval : { namespace ensemble create namespace export * proc p1 {} { return 16fe1b5807 } } : p1 } 16fe1b5807 # cleanup catch {rename cmd1 {}} catch {unset l} catch {unset msg} catch {unset trigger} namespace delete {*}[namespace children :: test_ns_*] ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: |
Changes to tests/oo.test.
︙ | |||
43 44 45 46 47 48 49 | 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 | - + | package require TclOO namespace delete :: } interp delete $i } {} test oo-0.3 {basic test of OO's ability to clean up its initial state} -body { leaktest { |
︙ | |||
124 125 126 127 128 129 130 131 132 133 134 135 136 137 | 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 | + + + + + + + | set errorInfo } "wrong # args: should be \"oo::define oo::object method name args body\" while executing \"oo::define oo::object method missingArgs\"" test oo-1.4 {basic test of OO functionality} -body { oo::object create {} } -returnCodes 1 -result {object name must not be empty} test oo-1.4.1 {fully-qualified nested name} -body { oo::object create ::one::two::three } -result {::one::two::three} test oo-1.4.2 {automatic command name has same name as namespace} -body { set obj [oo::object new] expr {[info object namespace $obj] == $obj} } -result 1 test oo-1.5 {basic test of OO functionality} -body { oo::object doesnotexist } -returnCodes 1 -result {unknown method "doesnotexist": must be create, destroy or new} test oo-1.5.1 {basic test of OO functionality} -setup { oo::object create aninstance } -returnCodes error -body { aninstance |
︙ | |||
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 | - + - + - + + + | # No segmentation fault return done } done test oo-11.6 { OO: cleanup ReleaseClassContents() where class is mixed into one of its instances |
︙ | |||
1694 1695 1696 1697 1698 1699 1700 | 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 | - + - + | return $result } {::foo {in A ::foo} {in B ::foo} foo} test oo-13.2 {OO: changing an object's class} -body { oo::object create foo oo::objdefine foo class oo::class } -cleanup { foo destroy |
︙ | |||
3860 3861 3862 3863 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 | 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 | + + + + + + + + + + + + + + + + + + + + + + | method e {} {} } E create e1 list [lsort [info class methods E -all]] [lsort [info object methods e1 -all]] } -cleanup { base destroy } -result {{c d e} {c d e}} test oo-35.6 { Bug : teardown of an object that is a class that is an instance of itself } -setup { oo::class create obj oo::copy obj obj1 obj1 oo::objdefine obj1 { mixin obj1 obj } oo::copy obj1 obj2 oo::objdefine obj2 { mixin obj2 obj1 } } -body { rename obj2 {} rename obj1 {} # doesn't crash return done } -cleanup { rename obj {} } -result done test oo-36.1 {TIP #470: introspection within oo::define} { oo::define oo::object self } ::oo::object test oo-36.2 {TIP #470: introspection within oo::define} -setup { oo::class create Cls } -body { oo::define Cls self |
︙ |
Changes to tests/package.test.
︙ | |||
16 17 18 19 20 21 22 | 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 | - - + - + + + | package require tcltest 2.3.3 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] |
︙ | |||
135 136 137 138 139 140 141 | 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 | - + - + - + - + - + | package forget t set x xxx } -body { foreach i {1.4 3.4 2.3 2.4 2.2} { package ifneeded t $i "set x $i; package provide t $i" } package require t |
︙ | |||
234 235 236 237 238 239 240 | 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 | - + - + | } -match glob -result {1 * invoked} test package-3.12 {Tcl_PkgRequire procedure, self-deleting script} -setup { package forget t set x xxx } -body { package ifneeded t 1.2 "package forget t; set x 1.2; package provide t 1.2" package require t 1.2 |
︙ | |||
279 280 281 282 283 284 285 | 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 | - + | } -body { proc pkgUnknown args { global x set x $args package provide [lindex $args 0] 2.0 } package require {a b} |
︙ | |||
571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 | 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 | + + + + + - + + + + - + - + + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + - - + + + + + + + + - + + + + + + + + + + + + + + + + + - + + + + + + + - + + + - + + + + + + + + - + + + + + + + + - + + + + + + - + + + + + - + + + + + + + + + + | package provide demo 1.2.3 } -body { package require -exact demo 1.2 } -returnCodes error -cleanup { package forget demo } -result {version conflict for package "demo": have 1.2.3, need exactly 1.2} test package-3.50 {Tcl_PkgRequire procedure, picking best stable version} -constraints testpreferstable -setup { interp create child load {} Tcltest child child eval { testpreferstable package forget t set x xxx } } -body { child eval { foreach i {1.4 3.4 4.0a1 2.3 2.4 2.2} { package ifneeded t $i "set x $i; package provide t $i" } package require t |
︙ | |||
1235 1236 1237 1238 1239 1240 1241 | 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 | - + - - - + - + - + - + - - + + + - - + + + | } return $res } finally { interp delete $ip } } |
︙ |
Changes to tests/parse.test.
︙ | |||
372 373 374 375 376 377 378 | 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 | - - + + - + | variable ::aresult variable ::acode set aresult $result set acode $code return "new result" } set handler1 [testasync create async1] |
︙ |
Changes to tests/result.test.
︙ | |||
27 28 29 30 31 32 33 | 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 | - + - + | testsaveresult small {set x 42} 0 } {small result} test result-1.2 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult append {set x 42} 0 } {append result} test result-1.3 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult dynamic {set x 42} 0 |
︙ |
Changes to tests/safe.test.
︙ | |||
70 71 72 73 74 75 76 | 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 | - + | test safe-2.3 {creating safe interpreters, should have no unexpected aliases} -setup { catch {safe::interpDelete a} } -body { interp create a -safe lsort [a aliases] } -cleanup { interp delete a |
︙ | |||
176 177 178 179 180 181 182 | 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 | - + - + - + - + | lsort $r } {byteOrder engine pathSeparator platform pointerSize wordSize} # More test should be added to check that hostname, nameofexecutable, aren't # leaking infos, but they still do... # high level general test |
︙ |
Changes to tests/scan.test.
︙ | |||
549 550 551 552 553 554 555 | 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 | - + - - + + | } -result {3 207698809136909011942886895 207698809136909011942886895 207698809136909011942886895} test scan-5.18 {bigint scanning underflow} -setup { set a {}; } -body { list [scan "-207698809136909011942886895" \ %llu a] $a } -returnCodes 1 -result {unsigned bignum scans are invalid} |
︙ |
Changes to tests/split.test.
︙ | |||
66 67 68 69 70 71 72 73 74 75 76 77 78 79 | 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 | + + + | } {{} ab cd {} ef {}} test split-1.13 {basic split commands} { split "12,34,56," {,} } {12 34 56 {}} test split-1.14 {basic split commands} { split ",12,,,34,56," {,} } {{} 12 {} {} 34 56 {}} test split-1.15 {basic split commands} -body { split "a\U01f4a9b" {} } -result "a \U01f4a9 b" test split-2.1 {split errors} { list [catch split msg] $msg $errorCode } {1 {wrong # args: should be "split string ?splitChars?"} {TCL WRONGARGS}} test split-2.2 {split errors} { list [catch {split a b c} msg] $msg $errorCode } {1 {wrong # args: should be "split string ?splitChars?"} {TCL WRONGARGS}} |
︙ |
Changes to tests/string.test.
︙ | |||
20 21 22 23 24 25 26 27 28 29 30 31 32 33 | 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | + | ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] # Some tests require the testobj command testConstraint testobj [expr {[info commands testobj] != {}}] testConstraint testindexobj [expr {[info commands testindexobj] != {}}] testConstraint fullutf [expr {[format %c 0x010000] != "\ufffd"}] # Used for constraining memory leak tests testConstraint memory [llength [info commands memory]] proc representationpoke s { set r [::tcl::unsupported::representation $s] list [lindex $r 3] [string match {*, string representation "*"} $r] |
︙ | |||
288 289 290 291 292 293 294 | 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 | - + - + | test string-5.16 {string index, bytearray object with string obj shimmering} { set str "0123456789\x00 abcdedfghi" binary scan $str H* dump string compare [string index $str 10] \x00 } 0 test string-5.17 {string index, bad integer} -body { list [catch {string index "abc" 0o8} msg] $msg |
︙ | |||
1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 | 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 | + + + | list $input_hex $rxBuffer_hex $rxCRC_hex } {000341 000341 0341} test string-12.22 {string range, shimmering binary/index} { set s 0000000001 binary scan $s a* x string range $s $s end } 000000001 test string-12.23 {string range, surrogates, bug [11ae2be95dac9417]} fullutf { list [string range a\U100000b 1 1] [string range a\U100000b 2 2] [string range a\U100000b 3 3] } [list \U100000 {} b] test string-13.1 {string repeat} { list [catch {string repeat} msg] $msg } {1 {wrong # args: should be "string repeat string count"}} test string-13.2 {string repeat} { list [catch {string repeat abc 10 oops} msg] $msg } {1 {wrong # args: should be "string repeat string count"}} |
︙ |
Changes to tests/stringComp.test.
︙ | |||
351 352 353 354 355 356 357 | 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 | - + - + | string compare [string index $str 10] \x00 } foo } 0 test stringComp-5.17 {string index, bad integer} -body { proc foo {} {string index "abc" 0o8} list [catch {foo} msg] $msg |
︙ |
Changes to tests/tcltest.test.
︙ | |||
540 541 542 543 544 545 546 | 540 541 542 543 544 545 546 547 548 549 550 551 552 553 | - | -match glob } # Test non-writeable directories, non-readable directories with directory flags set notReadableDir [file join [temporaryDirectory] notreadable] set notWriteableDir [file join [temporaryDirectory] notwriteable] makeDirectory notreadable makeDirectory notwriteable |
︙ |
Changes to tests/unixFCmd.test.
︙ | |||
217 218 219 220 221 222 223 | 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 | - + - + | } -cleanup { cleanup } -result {fifo fifo} test unixFCmd-2.5 {TclpCopyFile: copy attributes} -setup { cleanup } -constraints {unix notRoot} -body { close [open tf1 a] |
︙ | |||
371 372 373 374 375 376 377 | 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 | - - - - - + + + + + | foreach permstr $permList { file attributes foo.test -permissions $permstr lappend result [file attributes foo.test -permissions] } set result } $expected } |
︙ |
Changes to tests/utf.test.
︙ | |||
82 83 84 85 86 87 88 89 90 91 92 93 94 95 | 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 | + + + | string length [testbytestring "\xF8\xA2\xA2\xA2\xA2"] } {5} test utf-3.1 {Tcl_UtfCharComplete} { } {} testConstraint testnumutfchars [llength [info commands testnumutfchars]] testConstraint testfindfirst [llength [info commands testfindfirst]] testConstraint testfindlast [llength [info commands testfindlast]] test utf-4.1 {Tcl_NumUtfChars: zero length} testnumutfchars { testnumutfchars "" } {0} test utf-4.2 {Tcl_NumUtfChars: length 1} {testnumutfchars testbytestring} { testnumutfchars [testbytestring "\xC2\xA2"] } {1} test utf-4.3 {Tcl_NumUtfChars: long string} {testnumutfchars testbytestring} { |
︙ | |||
114 115 116 117 118 119 120 | 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 | - - + + + + + + | test utf-4.9 {Tcl_NumUtfChars: #u20AC, calc len, incomplete} {testnumutfchars testbytestring} { testnumutfchars [testbytestring "\xE2\x82\xAC"] 2 } {2} test utf-4.10 {Tcl_NumUtfChars: #u0000, calc len, overcomplete} {testnumutfchars testbytestring} { testnumutfchars [testbytestring "\x00"] 2 } {2} |
︙ |
Changes to tests/var.test.
︙ | |||
243 244 245 246 247 248 249 | 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 | - + - | catch {unset a} } -constraints testupvar -body { set a 456 namespace eval test_ns_var { catch {unset ::test_ns_var::vv} proc p {} { # create namespace var vv linked to global a |
︙ | |||
439 440 441 442 443 444 445 | 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 | - + | catch {unset six} } -body { set a "" set five 555 set six 666 namespace eval test_ns_var { variable five 5 six |
︙ | |||
466 467 468 469 470 471 472 | 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 | - + - + | variable sev:::en 7 } } -result {can't define "sev:::en": parent namespace doesn't exist} test var-7.8 {Tcl_VariableObjCmd, if var already exists and no value is given, leave value unchanged} { set a "" namespace eval test_ns_var { variable eight 8 |
︙ |
Changes to tests/while-old.test.
︙ | |||
88 89 90 91 92 93 94 | 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 | - + | test while-old-4.3 {errors in while loops} { set err [catch {while 1 2 3} msg] list $err $msg } {1 {wrong # args: should be "while test command"}} test while-old-4.4 {errors in while loops} { set err [catch {while {"a"+"b"} {error "loop aborted"}} msg] list $err $msg |
︙ |
Changes to tests/while.test.
︙ | |||
28 29 30 31 32 33 34 | 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 | - + | catch {while {$i<} break} return $::errorInfo } -cleanup { unset i } -match glob -result {*"while {$i<} break"} test while-1.3 {TclCompileWhileCmd: error in test expression} -body { while {"a"+"b"} {error "loop aborted"} |
︙ | |||
339 340 341 342 343 344 345 | 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 | - + | return $::errorInfo } -match glob -cleanup { unset i z } -result {*"$z {$i<} {set x 1}"} test while-4.4 {while (not compiled): error in test expression} -body { set z while $z {"a"+"b"} {error "loop aborted"} |
︙ |
Changes to tools/README.
︙ | |||
8 9 10 11 12 13 14 | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | - + | uniClass.tcl -- Script for generating regexp class tables from the Tcl "string is" classes Generating HTML files. The tcl-tk-man-html.tcl script from Robert Critchlow generates a nice set of HTML with good cross references. Use it like |
︙ |
Changes to tools/checkLibraryDoc.tcl.
1 2 3 4 5 | 1 2 3 4 5 6 7 8 9 10 11 12 13 | - + | # checkLibraryDoc.tcl -- # # This script attempts to determine what APIs exist in the source base that # have not been documented. By grepping through all of the doc/*.3 man # pages, looking for "Pkg_*" (e.g., Tcl_ or Tk_), and comparing this list |
︙ | |||
102 103 104 105 106 107 108 | 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 | - + | global argv0 global argv set len [llength $argv] if {($len != 2) && ($len != 3)} { puts "usage: $argv0 pkgName pkgDir \[outFile\]" puts " pkgName == Tcl,Tk" |
︙ |
Changes to tools/configure.
︙ | |||
1677 1678 1679 1680 1681 1682 1683 | 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 | - + | # Recover information that Tcl computed with its configure script. #-------------------------------------------------------------------- # See if there was a command-line option for where Tcl is; if # not, assume that its top-level directory is a sibling of ours. #-------------------------------------------------------------------- |
︙ |
Changes to tools/configure.ac.
1 2 3 4 5 6 7 8 9 10 11 12 13 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | - + | dnl This file is an input file used by the GNU "autoconf" program to dnl generate the file "configure", which is run to configure the dnl Makefile in this directory. AC_INIT(man2tcl.c) AC_PREREQ(2.69) # Recover information that Tcl computed with its configure script. #-------------------------------------------------------------------- # See if there was a command-line option for where Tcl is; if # not, assume that its top-level directory is a sibling of ours. #-------------------------------------------------------------------- |
︙ |
Changes to tools/tcl.hpj.in.
1 2 3 4 5 6 7 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | - + - + | ; This file is maintained by HCW. Do not modify this file directly. [OPTIONS] HCW=0 LCID=0x409 0x0 0x0 ;English (United States) REPORT=Yes TITLE=Tcl/Tk Reference Manual |
︙ |
Changes to tools/tcltk-man2html.tcl.
1 2 3 4 5 6 | 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 | - + - + | #!/usr/bin/env tclsh if {[catch {package require Tcl 8.6-} msg]} { puts stderr "ERROR: $msg" puts stderr "If running this script from 'make html', set the\ NATIVE_TCLSH environment\nvariable to point to an installed\ |
︙ |
Changes to unix/Makefile.in.
︙ | |||
825 826 827 828 829 830 831 | 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 867 868 | - + - - - - - - + - + - + - + - + | do \ if [ ! -d "$$i" ] ; then \ echo "Making directory $$i"; \ $(INSTALL_DATA_DIR) "$$i"; \ else true; \ fi; \ done; |
︙ | |||
2006 2007 2008 2009 2010 2011 2012 | 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 | - + | cp -p $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic cp -p $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README \ $(TOP_DIR)/ChangeLog.[12]??? $(TOP_DIR)/license.terms \ $(DISTDIR) @mkdir $(DISTDIR)/library cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \ $(TOP_DIR)/library/tclIndex $(DISTDIR)/library |
︙ | |||
2046 2047 2048 2049 2050 2051 2052 | 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 | - - + - | $(TOP_DIR)/win/tclConfig.sh.in $(TOP_DIR)/win/tclooConfig.sh \ $(TOP_DIR)/win/tcl.m4 $(TOP_DIR)/win/aclocal.m4 \ $(TOP_DIR)/win/tclsh.exe.manifest.in \ $(DISTDIR)/win cp -p $(TOP_DIR)/win/*.[ch] $(TOP_DIR)/win/*.ico $(TOP_DIR)/win/*.rc \ $(DISTDIR)/win cp -p $(TOP_DIR)/win/*.bat $(DISTDIR)/win |
︙ | |||
2093 2094 2095 2096 2097 2098 2099 | 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 | - + | rm -f $(DISTROOT)/$(DISTNAME)-src.tar.gz $(DISTROOT)/$(ZIPNAME) cd $(DISTROOT); tar cf $(DISTNAME)-src.tar $(DISTNAME); \ gzip -9 $(DISTNAME)-src.tar; zip -qr8 $(ZIPNAME) $(DISTNAME) #-------------------------------------------------------------------------- # This target creates the HTML folder for Tcl & Tk and places it in # DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool |
︙ |
Changes to unix/configure.
1 2 | 1 2 3 4 5 6 7 8 9 10 | - + | #! /bin/sh # Guess values for system-dependent variables and create Makefiles. |
︙ | |||
573 574 575 576 577 578 579 | 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 | - - + + | subdirs= MFLAGS= MAKEFLAGS= # Identity of this package. PACKAGE_NAME='tcl' PACKAGE_TARNAME='tcl' |
︙ | |||
1315 1316 1317 1318 1319 1320 1321 | 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 | - + | # # Report the --help message. # if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF |
︙ | |||
1376 1377 1378 1379 1380 1381 1382 | 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 | - + | cat <<\_ACEOF _ACEOF fi if test -n "$ac_init_help"; then case $ac_init_help in |
︙ | |||
1490 1491 1492 1493 1494 1495 1496 | 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 | - + | cd "$ac_pwd" || { ac_status=$?; break; } done fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF |
︙ | |||
1966 1967 1968 1969 1970 1971 1972 | 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 | - + | eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_member cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. |
︙ | |||
2318 2319 2320 2321 2322 2323 2324 | 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 | - - - - + + + + | ac_compiler_gnu=$ac_cv_c_compiler_gnu |
︙ | |||
3728 3729 3730 3731 3732 3733 3734 | 3728 3729 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 | - - - - - - - - - - - - - - - - - - - - | $as_echo "$tcl_cv_dirent_h" >&6; } if test $tcl_cv_dirent_h = no; then $as_echo "#define NO_DIRENT_H 1" >>confdefs.h fi |
︙ | |||
5315 5316 5317 5318 5319 5320 5321 | 5295 5296 5297 5298 5299 5300 5301 5302 5303 5304 5305 5306 5307 5308 5309 | - + | CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; Haiku*) LDFLAGS="$LDFLAGS -Wl,--export-dynamic" SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" |
︙ | |||
5637 5638 5639 5640 5641 5642 5643 | 5617 5618 5619 5620 5621 5622 5623 5624 5625 5626 5627 5628 5629 5630 5631 | - + | CFLAGS_OPTIMIZE="-O2" # egcs-2.91.66 on Redhat Linux 6.0 generates lots of warnings # when you inline the string and math operations. Turn this off to # get rid of the warnings. #CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D__NO_STRING_INLINES -D__NO_MATH_INLINES" |
︙ | |||
5724 5725 5726 5727 5728 5729 5730 | 5704 5705 5706 5707 5708 5709 5710 5711 5712 5713 5714 5715 5716 5717 5718 | - + | alpha|sparc64) SHLIB_CFLAGS="-fPIC" ;; *) SHLIB_CFLAGS="-fpic" ;; esac |
︙ | |||
5751 5752 5753 5754 5755 5756 5757 | 5731 5732 5733 5734 5735 5736 5737 5738 5739 5740 5741 5742 5743 5744 5745 | - + | # OpenBSD doesn't do version numbers with dots. UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' TCL_LIB_VERSIONS_OK=nodots ;; NetBSD-*) # NetBSD has ELF and can use 'cc -shared' to build shared libs SHLIB_CFLAGS="-fPIC" |
︙ | |||
6924 6925 6926 6927 6928 6929 6930 | 6904 6905 6906 6907 6908 6909 6910 6911 6912 6913 6914 6915 6916 6917 6918 | - + | _ACEOF if ac_fn_c_try_compile "$LINENO"; then : tcl_type_64bit=__int64 else tcl_type_64bit="long long" fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext |
︙ | |||
6950 6951 6952 6953 6954 6955 6956 | 6930 6931 6932 6933 6934 6935 6936 6937 6938 6939 6940 6941 6942 6943 6944 6945 | - - + + | rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi if test "${tcl_cv_type_64bit}" = none ; then $as_echo "#define TCL_WIDE_INT_IS_LONG 1" >>confdefs.h |
︙ | |||
10962 10963 10964 10965 10966 10967 10968 | 10942 10943 10944 10945 10946 10947 10948 10949 10950 10951 10952 10953 10954 10955 10956 | - + | test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # Save the log message, to keep $0 and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" |
︙ | |||
11019 11020 11021 11022 11023 11024 11025 | 10999 11000 11001 11002 11003 11004 11005 11006 11007 11008 11009 11010 11011 11012 11013 | - + | Report bugs to the package provider." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ |
︙ |
Changes to unix/configure.ac.
1 2 3 4 5 | 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 | - + - - - - + + + + | #! /bin/bash -norc dnl This file is an input file used by the GNU "autoconf" program to dnl generate the file "configure", which is run during Tcl installation dnl to configure the system for the local environment. |
︙ |
Changes to unix/tcl.m4.
︙ | |||
1246 1247 1248 1249 1250 1251 1252 | 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 | - + | CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" ;; Haiku*) LDFLAGS="$LDFLAGS -Wl,--export-dynamic" SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" |
︙ | |||
1390 1391 1392 1393 1394 1395 1396 | 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 | - + | CFLAGS_OPTIMIZE="-O2" # egcs-2.91.66 on Redhat Linux 6.0 generates lots of warnings # when you inline the string and math operations. Turn this off to # get rid of the warnings. #CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D__NO_STRING_INLINES -D__NO_MATH_INLINES" |
︙ | |||
1440 1441 1442 1443 1444 1445 1446 | 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 | - + | alpha|sparc64) SHLIB_CFLAGS="-fPIC" ;; *) SHLIB_CFLAGS="-fpic" ;; esac |
︙ | |||
1463 1464 1465 1466 1467 1468 1469 | 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 | - + | # OpenBSD doesn't do version numbers with dots. UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' TCL_LIB_VERSIONS_OK=nodots ;; NetBSD-*) # NetBSD has ELF and can use 'cc -shared' to build shared libs SHLIB_CFLAGS="-fPIC" |
︙ | |||
2036 2037 2038 2039 2040 2041 2042 | 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 | - | # Arguments: # none # # Results: # # Defines some of the following vars: # NO_DIRENT_H |
︙ | |||
2074 2075 2076 2077 2078 2079 2080 | 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 | - - | closedir(d); ], tcl_cv_dirent_h=yes, tcl_cv_dirent_h=no)]) if test $tcl_cv_dirent_h = no; then AC_DEFINE(NO_DIRENT_H, 1, [Do we have <dirent.h>?]) fi |
︙ | |||
2491 2492 2493 2494 2495 2496 2497 | 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 | - + - - + + | AC_DEFUN([SC_TCL_64BIT_FLAGS], [ AC_MSG_CHECKING([for 64-bit integer type]) AC_CACHE_VAL(tcl_cv_type_64bit,[ tcl_cv_type_64bit=none # See if the compiler knows natively about __int64 AC_TRY_COMPILE(,[__int64 value = (__int64) 0;], tcl_type_64bit=__int64, tcl_type_64bit="long long") |
︙ |
Changes to unix/tcl.spec.
1 2 3 4 5 6 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | - + | # This file is the basis for a binary Tcl RPM for Linux. %{!?directory:%define directory /usr/local} Name: tcl Summary: Tcl scripting language development environment |
︙ |
Changes to unix/tclConfig.h.in.
︙ | |||
291 292 293 294 295 296 297 | 291 292 293 294 295 296 297 298 299 300 301 302 303 304 | - - - | /* Do we have <dlfcn.h>? */ #undef NO_DLFCN_H /* Do we have fd_set? */ #undef NO_FD_SET |
︙ | |||
330 331 332 333 334 335 336 | 327 328 329 330 331 332 333 334 335 336 337 338 339 340 | - - - | /* Do we have uname() */ #undef NO_UNAME /* Do we have a usable 'union wait'? */ #undef NO_UNION_WAIT |
︙ | |||
396 397 398 399 400 401 402 | 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 | - + | /* Do we allow unloading of shared libraries? */ #undef TCL_UNLOAD_DLLS /* Does this platform have wide high-resolution clicks? */ #undef TCL_WIDE_CLICKS |
︙ |
Changes to unix/tclUnixInit.c.
︙ | |||
35 36 37 38 39 40 41 | 35 36 37 38 39 40 41 42 43 44 45 46 47 48 | - - - - - | #ifdef __CYGWIN__ DLLIMPORT extern __stdcall unsigned char GetVersionExW(void *); DLLIMPORT extern __stdcall void *GetModuleHandleW(const void *); DLLIMPORT extern __stdcall void FreeLibrary(void *); DLLIMPORT extern __stdcall void *GetProcAddress(void *, const char *); DLLIMPORT extern __stdcall void GetSystemInfo(void *); |
︙ | |||
449 450 451 452 453 454 455 | 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 | - + | * *------------------------------------------------------------------------- */ void TclpInitLibraryPath( char **valuePtr, |
︙ | |||
578 579 580 581 582 583 584 | 573 574 575 576 577 578 579 580 581 582 583 584 585 586 | - - - - - - | { Tcl_DString encodingName; Tcl_SetSystemEncoding(NULL, Tcl_GetEncodingNameFromEnvironment(&encodingName)); Tcl_DStringFree(&encodingName); } |
︙ | |||
886 887 888 889 890 891 892 | 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 | - - + - - | GetVersionExW(&osInfo); } osInfoInitialized = 1; } GetSystemInfo(&sysInfo); |
︙ |
Changes to unix/tclUnixNotfy.c.
︙ | |||
528 529 530 531 532 533 534 | 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 | - + - + - + | if (timeoutPtr->tv_usec) { pollTimeout += ((int)timeoutPtr->tv_usec / 1000); } } numFound = poll(pollFds, 1, pollTimeout); if (numFound == 1) { result = 0; |
︙ |
Changes to unix/tclUnixPort.h.
︙ | |||
83 84 85 86 87 88 89 | 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 | - - + + | # define HANDLE void * # define HINSTANCE void * # define SOCKET unsigned int # define WSAEWOULDBLOCK 10035 typedef unsigned short WCHAR; __declspec(dllimport) extern __stdcall int GetModuleHandleExW(unsigned int, const char *, void *); __declspec(dllimport) extern __stdcall int GetModuleFileNameW(void *, const char *, int); |
︙ | |||
177 178 179 180 181 182 183 | 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 | - - + - - - - - | *--------------------------------------------------------------------------- * Some platforms (e.g. SunOS) don't define FLT_MAX and FLT_MIN, so we look * for an alternative definition. If no other alternative is available we use * a reasonable guess. *--------------------------------------------------------------------------- */ |
︙ |
Changes to unix/tclUnixSock.c.
︙ | |||
213 214 215 216 217 218 219 | 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 | - + | * * ---------------------------------------------------------------------- */ static void InitializeHostName( char **valuePtr, |
︙ |
Changes to unix/tclUnixThrd.c.
︙ | |||
11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | + + | * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #ifdef TCL_THREADS #ifndef TCL_NO_DEPRECATED typedef struct { char nabuf[16]; } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; #endif /* * masterLock is used to serialize creation of mutexes, condition variables, * and thread local storage. This is the only place that can count on the * ability to statically initialize the mutex. */ |
︙ |
Changes to win/Makefile.in.
︙ | |||
626 627 628 629 630 631 632 | 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 | - + | do \ if [ ! -d $$i ] ; then \ echo "Making directory $$i"; \ $(MKDIR) $$i; \ else true; \ fi; \ done; |
︙ | |||
648 649 650 651 652 653 654 | 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 | - - - - - - + - + - + - + - + | $(COPY) "$$i" "$(INCLUDE_INSTALL_DIR)"; \ done; @echo "Installing library files to $(SCRIPT_INSTALL_DIR)"; @for i in $(ROOT_DIR)/library/*.tcl $(ROOT_DIR)/library/tclIndex; \ do \ $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \ done; |
︙ | |||
854 855 856 857 858 859 860 | 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 | - + | $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \ "$(GENERIC_DIR_NATIVE)" \ "$(GENERIC_DIR_NATIVE)/tclOO.decls" # # This target creates the HTML folder for Tcl & Tk and places it in # DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool |
︙ |
Changes to win/README.
| 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 | - + - + |
|
︙ | |||
75 76 77 78 79 80 81 | 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 | - + - + | and Msys, you can download a suitable win32 or win64 compiler from [https://sourceforge.net/projects/mingw-w64/files/] Use the Makefile "install" target to install Tcl. It will install it according to the prefix options you provided in the correct directory structure. |
︙ |
Deleted win/coffbase.txt.
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
|
Changes to win/configure.
︙ | |||
702 703 704 705 706 707 708 | 702 703 704 705 706 707 708 709 710 711 712 713 714 715 | - | ZLIB_OBJS ZLIB_LIBS ZLIB_DLL_FILE CFLAGS_WARNING CFLAGS_OPTIMIZE CFLAGS_DEBUG DL_LIBS |
︙ | |||
764 765 766 767 768 769 770 | 763 764 765 766 767 768 769 770 771 772 773 774 775 776 | - - | ac_subst_files='' ac_user_opts=' enable_option_checking enable_threads with_encoding enable_shared enable_64bit |
︙ | |||
1388 1389 1390 1391 1392 1393 1394 | 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 | - - | Optional Features: --disable-option-checking ignore unrecognized --enable/--with options --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --enable-threads build with threads (default: on) --enable-shared build and link with shared libraries (default: on) --enable-64bit enable 64bit support (where applicable) |
︙ | |||
2095 2096 2097 2098 2099 2100 2101 | 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 | - - - - + + + + | # The following define is needed when building with Cygwin since newer # versions of autoconf incorrectly set SHELL to /bin/bash instead of # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh |
︙ | |||
3807 3808 3809 3810 3811 3812 3813 | 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 | - - - - - - - - - - - - - - - - - - - - - - - - - - - | else do64bit=no fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $do64bit" >&5 $as_echo "$do64bit" >&6; } |
︙ | |||
4332 4333 4334 4335 4336 4337 4338 | 4300 4301 4302 4303 4304 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - | CFLAGS_DEBUG="-nologo -Z7 -Od -WX ${runtime}d" # -O2 - create fast code (/Og /Oi /Ot /Oy /Ob2 /Gs /GF /Gy) CFLAGS_OPTIMIZE="-nologo -O2 ${runtime}" lflags="${lflags} -nologo" LINKBIN="link" fi |
︙ | |||
4463 4464 4465 4466 4467 4468 4469 | 4331 4332 4333 4334 4335 4336 4337 4338 4339 4340 4341 4342 4343 4344 4345 | - + | # Specify the CC output file names based on the target name CC_OBJNAME="-Fo\$@" CC_EXENAME="-Fe\"\$(shell \$(CYGPATH) '\$@')\"" # Specify linker flags depending on the type of app being # built -- Console vs. Window. |
︙ |
Changes to win/configure.ac.
1 2 3 4 5 6 7 8 9 10 11 12 13 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | - - - - + + + + | #! /bin/bash -norc # This file is an input file used by the GNU "autoconf" program to # generate the file "configure", which is run during Tcl installation # to configure the system for the local environment. AC_INIT(../generic/tcl.h) AC_PREREQ(2.69) # The following define is needed when building with Cygwin since newer # versions of autoconf incorrectly set SHELL to /bin/bash instead of # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh |
︙ |
Changes to win/makefile.vc.
| 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 | - + - - + + - - - - - - - - - - + + - - - - - - - - - - - - - - - + + - - + - - - - + + + - + - - - - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + - - + - - - - + - - - + - - + + + + - - - - - - - + - - - - - - - + - - + - - - - - - - - - - - - - - - - + + - - - - - + - - + + + - - - - - + + - - - - - - + - - - - + - - + - - - - - + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
|
︙ | |||
456 457 458 459 460 461 462 | 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 | - - + + - - - - - - - - + - - - - - - - - - - - - - - - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - + + - - - - - + - - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS) TCLSTUBOBJS = \ $(TMP_DIR)\tclStubLib.obj \ $(TMP_DIR)\tclTomMathStubLib.obj \ $(TMP_DIR)\tclOOStubLib.obj |
︙ | |||
591 592 593 594 595 596 597 598 599 600 601 | 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 | + - - - - - - - - - - - - - - + - - - - + + - - + + + + + - + + - + - + - + - + - - + - + - - + | release: setup $(TCLSH) $(TCLSTUBLIB) dlls pkgs core: setup $(TCLLIB) $(TCLSTUBLIB) shell: setup $(TCLSH) dlls: setup $(TCLREGLIB) $(TCLDDELIB) all: setup $(TCLSH) $(TCLSTUBLIB) dlls $(CAT32) pkgs tcltest: setup $(TCLTEST) dlls $(CAT32) install: install-binaries install-libraries install-docs install-pkgs setup: default-setup test: test-core test-pkgs test-core: setup $(TCLTEST) dlls $(CAT32) set TCL_LIBRARY=$(ROOT:\=/)/library |
︙ | |||
702 703 704 705 706 707 708 | 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 | - - + + - | @if exist "%~fd\win\makefile.vc" ( \ pushd "%~fd\win" & \ $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) clean &\ popd \ ) $(CAT32): $(WINDIR)\cat.c |
︙ | |||
742 743 744 745 746 747 748 | 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 | - - - + + + + + + - + - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + - + - + - + | > "$(GENERICDIR)\tclTomMath.h" !endif #--------------------------------------------------------------------- # Build the Windows HTML help file. #--------------------------------------------------------------------- |
︙ | |||
934 935 936 937 938 939 940 | 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 | - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + | $(GENERICDIR)/tclGetDate.y #--------------------------------------------------------------------- # Special case object file targets #--------------------------------------------------------------------- $(TMP_DIR)\testMain.obj: $(WINDIR)\tclAppInit.c |
︙ | |||
1046 1047 1048 1049 1050 1051 1052 | 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 | + - + - - - - - - + - - - - - - - - - - - + - - - - - - - - + - - - - - - - + + - - - - - - + + + + + + + + + + + + | !endif ### add a spacer in the output !message #--------------------------------------------------------------------- # Implicit rules that are not covered by the common ones defined in |
︙ | |||
1141 1142 1143 1144 1145 1146 1147 | 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 | - - - + + + + - + - + - + - + - + | @$(CPY) "$(ROOT)\library\safe.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\tclIndex" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\package.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(OUT_DIR)\tclConfig.sh" "$(LIB_INSTALL_DIR)\" @$(CPY) "$(WINDIR)\tclooConfig.sh" "$(LIB_INSTALL_DIR)\" |
︙ | |||
1185 1186 1187 1188 1189 1190 1191 | 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 | - + - | @$(CPY) "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\" @$(CPY) "$(ROOT)\library\reg\pkgIndex.tcl" \ "$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\" !endif @echo Installing encodings @$(CPY) "$(ROOT)\library\encoding\*.enc" \ "$(SCRIPT_INSTALL_DIR)\encoding\" |
︙ | |||
1220 1221 1222 1223 1224 1225 1226 | 931 932 933 934 935 936 937 938 939 940 941 942 943 944 | - + - - - - - - - - - - - - - - - - - + - - - - | @echo Removing $(TCLTEST) ... @if exist $(TCLTEST) del $(TCLTEST) @echo Removing $(TCLDDELIB) ... @if exist $(TCLDDELIB) del $(TCLDDELIB) @echo Removing $(TCLREGLIB) ... @if exist $(TCLREGLIB) del $(TCLREGLIB) |
Changes to win/nmakehlp.c.
︙ | |||
10 11 12 13 14 15 16 | 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 | - - - - - - + | * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * ---------------------------------------------------------------------------- */ #define _CRT_SECURE_NO_DEPRECATE #include <windows.h> |
︙ | |||
70 71 72 73 74 75 76 | 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 | - + | main( int argc, char *argv[]) { char msg[300]; DWORD dwWritten; int chars; |
︙ | |||
168 169 170 171 172 173 174 175 176 177 178 179 180 181 | 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 | + + + + + + + + + + + + | "Emit the fully qualified path\n" "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); return 2; } return QualifyPath(argv[2]); case 'L': if (argc != 3) { chars = snprintf(msg, sizeof(msg) - 1, "usage: %s -L keypath\n" "Emit the fully qualified path of directory containing keypath\n" "exitcodes: 0 == success, 1 == not found, 2 == error\n", argv[0]); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); return 2; } return LocateDependency(argv[2]); } } chars = snprintf(msg, sizeof(msg) - 1, "usage: %s -c|-f|-l|-Q|-s|-V ...\n" "This is a little helper app to equalize shell differences between WinNT and\n" "Win9x and get nmake.exe to accomplish its job.\n", argv[0]); |
︙ | |||
672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 | 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 | + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | list_free(&substPtr); } fclose(fp); return 0; } BOOL FileExists(LPCTSTR szPath) { #ifndef INVALID_FILE_ATTRIBUTES #define INVALID_FILE_ATTRIBUTES ((DWORD)-1) #endif DWORD pathAttr = GetFileAttributes(szPath); return (pathAttr != INVALID_FILE_ATTRIBUTES && !(pathAttr & FILE_ATTRIBUTE_DIRECTORY)); } /* * QualifyPath -- * * This composes the current working directory with a provided path * and returns the fully qualified and normalized path. * Mostly needed to setup paths for testing. */ static int QualifyPath( const char *szPath) { char szCwd[MAX_PATH + 1]; GetFullPathName(szPath, sizeof(szCwd)-1, szCwd, NULL); printf("%s\n", szCwd); return 0; } /* * Implements LocateDependency for a single directory. See that command * for an explanation. * Returns 0 if found after printing the directory. * Returns 1 if not found but no errors. * Returns 2 on any kind of error * Basically, these are used as exit codes for the process. */ static int LocateDependencyHelper(const char *dir, const char *keypath) { HANDLE hSearch; |
Added win/rules-ext.vc.