Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Merge TIP-515 branch, so part of the corrections in the TIP-514 implementation branch now moved to the TIP-515 implementation. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | tip-514 |
Files: | files | file ages | folders |
SHA3-256: | 3e36e66ffe0d6dc8c2fb596b5417b5fd |
User & Date: | jan.nijtmans 2018-09-08 21:29:40 |
Context
2018-09-08
| ||
21:34 | Bring back test-cases closer to what they were check-in: 9979924a94 user: jan.nijtmans tags: tip-514 | |
21:29 | Merge TIP-515 branch, so part of the corrections in the TIP-514 implementation branch now moved to t... check-in: 3e36e66ffe user: jan.nijtmans tags: tip-514 | |
21:18 | Merge core-8-branch check-in: 4c53b5eb75 user: jan.nijtmans tags: tip-515 | |
2018-09-05
| ||
08:07 | Merge 8.7 check-in: 6423bd55ee user: jan.nijtmans tags: tip-514 | |
Changes
Changes to doc/uplevel.n.
20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 |
been passed to \fBconcat\fR; the result is then evaluated in the variable context indicated by \fIlevel\fR. \fBUplevel\fR returns the result of that evaluation. .PP If \fIlevel\fR is an integer then it gives a distance (up the procedure calling stack) to move before executing the command. If \fIlevel\fR consists of \fB#\fR followed by a number then the number gives an absolute level number. If \fIlevel\fR is omitted then it defaults to \fB1\fR. \fILevel\fR cannot be defaulted if the first \fIcommand\fR argument starts with a digit or \fB#\fR. .PP For example, suppose that procedure \fBa\fR was invoked from top-level, and that it called \fBb\fR, and that \fBb\fR called \fBc\fR. Suppose that \fBc\fR invokes the \fBuplevel\fR command. If \fIlevel\fR is \fB1\fR or \fB#2\fR or omitted, then the command will be executed in the variable context of \fBb\fR. If \fIlevel\fR is \fB2\fR or \fB#1\fR then the command will be executed in the variable context of \fBa\fR. |
| | |
20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 |
been passed to \fBconcat\fR; the result is then evaluated in the variable context indicated by \fIlevel\fR. \fBUplevel\fR returns the result of that evaluation. .PP If \fIlevel\fR is an integer then it gives a distance (up the procedure calling stack) to move before executing the command. If \fIlevel\fR consists of \fB#\fR followed by a integer then the level gives an absolute level. If \fIlevel\fR is omitted then it defaults to \fB1\fR. \fILevel\fR cannot be defaulted if the first \fIcommand\fR argument is an integer or starts with \fB#\fR. .PP For example, suppose that procedure \fBa\fR was invoked from top-level, and that it called \fBb\fR, and that \fBb\fR called \fBc\fR. Suppose that \fBc\fR invokes the \fBuplevel\fR command. If \fIlevel\fR is \fB1\fR or \fB#2\fR or omitted, then the command will be executed in the variable context of \fBb\fR. If \fIlevel\fR is \fB2\fR or \fB#1\fR then the command will be executed in the variable context of \fBa\fR. |
Changes to generic/tclBasic.c.
7783
7784
7785
7786
7787
7788
7789
7790
7791
7792
7793
7794
7795
7796
7797
....
7948
7949
7950
7951
7952
7953
7954
7955
7956
7957
7958
7959
7960
7961
7962
|
iPtr->randSeed = TclpGetClicks() + (PTR2INT(Tcl_GetCurrentThread())<<12); /* * Make sure 1 <= randSeed <= (2^31) - 2. See below. */ iPtr->randSeed &= (unsigned long) 0x7fffffff; if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) { iPtr->randSeed ^= 123459876; } } /* * Generate the random number using the linear congruential generator ................................................................................ /* * Reset the seed. Make sure 1 <= randSeed <= 2^31 - 2. See comments in * ExprRandFunc for more details. */ iPtr->flags |= RAND_SEED_INITIALIZED; iPtr->randSeed = w & (unsigned long) 0x7fffffff; if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) { iPtr->randSeed ^= 123459876; } /* * To avoid duplicating the random number generation code we simply clean * up our state and call the real random number function. That function |
|
|
|
7783
7784
7785
7786
7787
7788
7789
7790
7791
7792
7793
7794
7795
7796
7797
....
7948
7949
7950
7951
7952
7953
7954
7955
7956
7957
7958
7959
7960
7961
7962
|
iPtr->randSeed = TclpGetClicks() + (PTR2INT(Tcl_GetCurrentThread())<<12); /* * Make sure 1 <= randSeed <= (2^31) - 2. See below. */ iPtr->randSeed &= 0x7fffffff; if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) { iPtr->randSeed ^= 123459876; } } /* * Generate the random number using the linear congruential generator ................................................................................ /* * Reset the seed. Make sure 1 <= randSeed <= 2^31 - 2. See comments in * ExprRandFunc for more details. */ iPtr->flags |= RAND_SEED_INITIALIZED; iPtr->randSeed = (long) w & 0x7fffffff; if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) { iPtr->randSeed ^= 123459876; } /* * To avoid duplicating the random number generation code we simply clean * up our state and call the real random number function. That function |
Changes to generic/tclObj.c.
3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 |
*---------------------------------------------------------------------- * * TclGetWideBitsFromObj -- * * Attempt to return a wide integer from the Tcl object "objPtr". If the * object is not already a int, double or bignum, an attempt will be made * to convert it to one of these. Out-of-range values don't result in an * error, but only the least significant 64 bits will be returned. * * Results: * The return value is a standard Tcl object result. If an error occurs * during conversion, an error message is left in the interpreter's * result unless "interp" is NULL. * * Side effects: |
| |
3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 |
*----------------------------------------------------------------------
*
* TclGetWideBitsFromObj --
*
* Attempt to return a wide integer from the Tcl object "objPtr". If the
* object is not already a int, double or bignum, an attempt will be made
* to convert it to one of these. Out-of-range values don't result in an
* error, but only the least significant 64 bits will be returned.
*
* Results:
* The return value is a standard Tcl object result. If an error occurs
* during conversion, an error message is left in the interpreter's
* result unless "interp" is NULL.
*
* Side effects:
|
Changes to generic/tclProc.c.
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 ... 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 ... 766 767 768 769 770 771 772 773 774 775 776 777 778 779 ... 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 |
Tcl_SetObjResult(interp, Tcl_NewStringObj( "argument with no name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "FORMALARGUMENTFORMAT", NULL); goto procError; } nameLength = Tcl_NumUtfChars(Tcl_GetString(fieldValues[0]), fieldValues[0]->length); if (fieldCount == 2) { valueLength = Tcl_NumUtfChars(Tcl_GetString(fieldValues[1]), fieldValues[1]->length); } else { valueLength = 0; } /* * Check that the formal parameter name is a scalar. */ argname = Tcl_GetStringFromObj(fieldValues[0], &plen); argnamei = argname; argnamelast = argname[plen-1]; while (plen--) { if (argnamei[0] == '(') { if (argnamelast == ')') { /* We have an array element. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "formal parameter \"%s\" is an array element", ................................................................................ int TclGetFrame( Tcl_Interp *interp, /* Interpreter in which to find frame. */ const char *name, /* String describing frame. */ CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if * global frame indicated). */ { register Interp *iPtr = (Interp *) interp; int curLevel, level, result; CallFrame *framePtr; /* * Parse string to figure out which level number to go to. */ result = 1; curLevel = iPtr->varFramePtr->level; if (*name== '#') { if (Tcl_GetInt(interp, name+1, &level) != TCL_OK || level < 0) { goto levelError; } } else if (isdigit(UCHAR(*name))) { /* INTL: digit */ if (Tcl_GetInt(interp, name, &level) != TCL_OK) { goto levelError; } level = curLevel - level; } else { level = curLevel - 1; result = 0; } /* * Figure out which frame to use, and return it to the caller. */ for (framePtr = iPtr->varFramePtr; framePtr != NULL; framePtr = framePtr->callerVarPtr) { if (framePtr->level == level) { break; } } if (framePtr == NULL) { goto levelError; } *framePtrPtr = framePtr; return result; levelError: Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", NULL); return -1; } /* *---------------------------------------------------------------------- * * TclObjGetFrame -- * ................................................................................ Tcl_Obj *objPtr, /* Object describing frame. */ CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if * global frame indicated). */ { register Interp *iPtr = (Interp *) interp; int curLevel, level, result; const char *name = NULL; /* * Parse object to figure out which level number to go to. */ result = 0; curLevel = iPtr->varFramePtr->level; ................................................................................ /* * Check for integer first, since that has potential to spare us * a generation of a stringrep. */ 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) { level = (int) objPtr->internalRep.wideValue; result = 1; } else { name = TclGetString(objPtr); if (name[0] == '#') { if (TCL_OK == Tcl_GetInt(NULL, name+1, &level) && level >= 0) { TclFreeIntRep(objPtr); objPtr->typePtr = &levelReferenceType; objPtr->internalRep.wideValue = level; result = 1; } else { result = -1; } } else if (isdigit(UCHAR(name[0]))) { /* INTL: digit */ /* * If this were an integer, we'd have succeeded already. * Docs say we have to treat this as a 'bad level' error. */ result = -1; } } if (result == 0) { level = curLevel - 1; name = "1"; } if (result != -1) { if (level >= 0) { CallFrame *framePtr; for (framePtr = iPtr->varFramePtr; framePtr != NULL; framePtr = framePtr->callerVarPtr) { if (framePtr->level == level) { *framePtrPtr = framePtr; return result; } } } if (name == NULL) { name = TclGetString(objPtr); } } Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", name, NULL); return -1; } /* *---------------------------------------------------------------------- |
> | | | < < < < < < < < < | < < < < > | < < < < < < < < < < < < < < < < < < < < < < < < < > > > > > | < < < < < > | | > > > | | > | > > > | | | | > | < > > | | | < < |
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 ... 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 ... 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 ... 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 |
Tcl_SetObjResult(interp, Tcl_NewStringObj( "argument with no name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "FORMALARGUMENTFORMAT", NULL); goto procError; } argname = Tcl_GetStringFromObj(fieldValues[0], &plen); nameLength = Tcl_NumUtfChars(argname, plen); if (fieldCount == 2) { const char * value = TclGetString(fieldValues[1]); valueLength = Tcl_NumUtfChars(value, fieldValues[1]->length); } else { valueLength = 0; } /* * Check that the formal parameter name is a scalar. */ argnamei = argname; argnamelast = argname[plen-1]; while (plen--) { if (argnamei[0] == '(') { if (argnamelast == ')') { /* We have an array element. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "formal parameter \"%s\" is an array element", ................................................................................ int TclGetFrame( Tcl_Interp *interp, /* Interpreter in which to find frame. */ const char *name, /* String describing frame. */ CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if * global frame indicated). */ { int result; Tcl_Obj obj; obj.bytes = (char *) name; obj.length = strlen(name); obj.typePtr = NULL; result = TclObjGetFrame(interp, &obj, framePtrPtr); TclFreeIntRep(&obj); return result; } /* *---------------------------------------------------------------------- * * TclObjGetFrame -- * ................................................................................ Tcl_Obj *objPtr, /* Object describing frame. */ CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if * global frame indicated). */ { register Interp *iPtr = (Interp *) interp; int curLevel, level, result; const char *name = NULL; Tcl_WideInt w; /* * Parse object to figure out which level number to go to. */ result = 0; curLevel = iPtr->varFramePtr->level; ................................................................................ /* * Check for integer first, since that has potential to spare us * a generation of a stringrep. */ if (objPtr == NULL) { /* Do nothing */ } else if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &level)) { Tcl_GetWideIntFromObj(NULL, objPtr, &w); if (w < 0 || w > INT_MAX || curLevel > w + INT_MAX) { result = -1; } else { level = curLevel - level; result = 1; } } else if (objPtr->typePtr == &levelReferenceType) { level = (int) objPtr->internalRep.wideValue; result = 1; } else { name = TclGetString(objPtr); if (name[0] == '#') { if (TCL_OK == Tcl_GetInt(NULL, name+1, &level)) { if (level < 0 || (level > 0 && name[1] == '-')) { result = -1; } else { TclFreeIntRep(objPtr); objPtr->typePtr = &levelReferenceType; objPtr->internalRep.wideValue = level; result = 1; } } else { result = -1; } } else if (TclGetWideBitsFromObj(interp, objPtr, &w) == TCL_OK) { /* * If this were an integer, we'd have succeeded already. * Docs say we have to treat this as a 'bad level' error. */ result = -1; } } if (result == 0) { level = curLevel - 1; } if (result != -1) { if (level >= 0) { CallFrame *framePtr; for (framePtr = iPtr->varFramePtr; framePtr != NULL; framePtr = framePtr->callerVarPtr) { if (framePtr->level == level) { *framePtrPtr = framePtr; return result; } } } } if (name == NULL) { name = TclGetString(objPtr); } Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", name, NULL); return -1; } /* *---------------------------------------------------------------------- |
Changes to tests/proc.test.
106
107
108
109
110
111
112
113
114
115
116
117
118
119
...
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
|
} -result {formal parameter "a(1)" is an array element}
test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple names} -setup {
catch {rename p ""}
} -body {
proc p {b:a b::a} {
}
} -returnCodes error -result {formal parameter "b::a" is not a simple name}
test proc-2.1 {TclFindProc, simple proc name and proc not in namespace} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename p ""}
} -body {
proc p {} {return "p in [namespace current]"}
info body p
................................................................................
set lambda x
lappend lambda {set a 1}
interp create slave
slave eval [list apply $lambda foo]
interp delete slave
unset lambda
} {}
# cleanup
catch {rename p ""}
catch {rename t ""}
::tcltest::cleanupTests
return
# Local Variables:
# mode: tcl
# fill-column: 78
# End:
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
...
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
|
} -result {formal parameter "a(1)" is an array element} test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple names} -setup { catch {rename p ""} } -body { proc p {b:a b::a} { } } -returnCodes error -result {formal parameter "b::a" is not a simple name} test proc-1.9 {Tcl_ProcObjCmd, arguments via canonical list (string-representation bug [631b4c45df])} -body { set v 2 binary scan AB cc a b proc p [list [list a $a] [list b $b] [list v [expr {$v + 2}]]] {expr {$a + $b + $v}} p } -result [expr {65+66+4}] -cleanup { rename p {} } test proc-2.1 {TclFindProc, simple proc name and proc not in namespace} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} } -body { proc p {} {return "p in [namespace current]"} info body p ................................................................................ set lambda x lappend lambda {set a 1} interp create slave slave eval [list apply $lambda foo] interp delete slave unset lambda } {} test proc-7.5 {[631b4c45df] Crash in argument processing} { binary scan A c val proc foo [list [list from $val]] {} rename foo {} unset -nocomplain val } {} # cleanup catch {rename p ""} catch {rename t ""} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: |
Changes to tests/uplevel.test.
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
...
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
|
apply {{} {uplevel [expr 1] {}}} } {} test uplevel-4.16 {level parsing} { apply {{} {uplevel #[expr 1] {}}} } {} test uplevel-4.17 {level parsing} -returnCodes error -body { apply {{} {uplevel -0xffffffff {}}} } -result {invalid command name "-0xffffffff"} test uplevel-4.18 {level parsing} -returnCodes error -body { apply {{} {uplevel #-0xffffffff {}}} } -result {bad level "#-0xffffffff"} test uplevel-4.19 {level parsing} -returnCodes error -body { apply {{} {uplevel [expr -0xffffffff] {}}} } -result {invalid command name "-4294967295"} test uplevel-4.20 {level parsing} -returnCodes error -body { apply {{} {uplevel #[expr -0xffffffff] {}}} } -result {bad level "#-4294967295"} test uplevel-4.21 {level parsing} -body { apply {{} {uplevel -1 {}}} } -returnCodes error -result {invalid command name "-1"} test uplevel-4.22 {level parsing} -body { apply {{} {uplevel #-1 {}}} } -returnCodes error -result {bad level "#-1"} test uplevel-4.23 {level parsing} -body { apply {{} {uplevel [expr -1] {}}} } -returnCodes error -result {invalid command name "-1"} test uplevel-4.24 {level parsing} -body { apply {{} {uplevel #[expr -1] {}}} } -returnCodes error -result {bad level "#-1"} test uplevel-4.25 {level parsing} -body { apply {{} {uplevel 0xffffffff {}}} } -returnCodes error -result {bad level "0xffffffff"} test uplevel-4.26 {level parsing} -body { ................................................................................ apply {{} {uplevel [expr 0xffffffff] {}}} } -returnCodes error -result {bad level "4294967295"} test uplevel-4.28 {level parsing} -body { apply {{} {uplevel #[expr 0xffffffff] {}}} } -returnCodes error -result {bad level "#4294967295"} test uplevel-4.29 {level parsing} -body { apply {{} {uplevel 0.2 {}}} } -returnCodes error -result {bad level "0.2"} test uplevel-4.30 {level parsing} -body { apply {{} {uplevel #0.2 {}}} } -returnCodes error -result {bad level "#0.2"} test uplevel-4.31 {level parsing} -body { apply {{} {uplevel [expr 0.2] {}}} } -returnCodes error -result {bad level "0.2"} test uplevel-4.32 {level parsing} -body { apply {{} {uplevel #[expr 0.2] {}}} } -returnCodes error -result {bad level "#0.2"} test uplevel-4.33 {level parsing} -body { apply {{} {uplevel .2 {}}} } -returnCodes error -result {invalid command name ".2"} test uplevel-4.34 {level parsing} -body { apply {{} {uplevel #.2 {}}} } -returnCodes error -result {bad level "#.2"} test uplevel-4.35 {level parsing} -body { apply {{} {uplevel [expr .2] {}}} } -returnCodes error -result {bad level "0.2"} test uplevel-4.36 {level parsing} -body { apply {{} {uplevel #[expr .2] {}}} } -returnCodes error -result {bad level "#0.2"} |
|
|
|
|
|
|
|
|
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
...
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
|
apply {{} {uplevel [expr 1] {}}} } {} test uplevel-4.16 {level parsing} { apply {{} {uplevel #[expr 1] {}}} } {} test uplevel-4.17 {level parsing} -returnCodes error -body { apply {{} {uplevel -0xffffffff {}}} } -result {bad level "-0xffffffff"} test uplevel-4.18 {level parsing} -returnCodes error -body { apply {{} {uplevel #-0xffffffff {}}} } -result {bad level "#-0xffffffff"} test uplevel-4.19 {level parsing} -returnCodes error -body { apply {{} {uplevel [expr -0xffffffff] {}}} } -result {bad level "-4294967295"} test uplevel-4.20 {level parsing} -returnCodes error -body { apply {{} {uplevel #[expr -0xffffffff] {}}} } -result {bad level "#-4294967295"} test uplevel-4.21 {level parsing} -body { apply {{} {uplevel -1 {}}} } -returnCodes error -result {bad level "-1"} test uplevel-4.22 {level parsing} -body { apply {{} {uplevel #-1 {}}} } -returnCodes error -result {bad level "#-1"} test uplevel-4.23 {level parsing} -body { apply {{} {uplevel [expr -1] {}}} } -returnCodes error -result {bad level "-1"} test uplevel-4.24 {level parsing} -body { apply {{} {uplevel #[expr -1] {}}} } -returnCodes error -result {bad level "#-1"} test uplevel-4.25 {level parsing} -body { apply {{} {uplevel 0xffffffff {}}} } -returnCodes error -result {bad level "0xffffffff"} test uplevel-4.26 {level parsing} -body { ................................................................................ apply {{} {uplevel [expr 0xffffffff] {}}} } -returnCodes error -result {bad level "4294967295"} test uplevel-4.28 {level parsing} -body { apply {{} {uplevel #[expr 0xffffffff] {}}} } -returnCodes error -result {bad level "#4294967295"} test uplevel-4.29 {level parsing} -body { apply {{} {uplevel 0.2 {}}} } -returnCodes error -result {invalid command name "0.2"} test uplevel-4.30 {level parsing} -body { apply {{} {uplevel #0.2 {}}} } -returnCodes error -result {bad level "#0.2"} test uplevel-4.31 {level parsing} -body { apply {{} {uplevel [expr 0.2] {}}} } -returnCodes error -result {invalid command name "0.2"} test uplevel-4.32 {level parsing} -body { apply {{} {uplevel #[expr 0.2] {}}} } -returnCodes error -result {bad level "#0.2"} test uplevel-4.33 {level parsing} -body { apply {{} {uplevel .2 {}}} } -returnCodes error -result {invalid command name ".2"} test uplevel-4.34 {level parsing} -body { apply {{} {uplevel #.2 {}}} } -returnCodes error -result {bad level "#.2"} test uplevel-4.35 {level parsing} -body { apply {{} {uplevel [expr .2] {}}} } -returnCodes error -result {invalid command name "0.2"} test uplevel-4.36 {level parsing} -body { apply {{} {uplevel #[expr .2] {}}} } -returnCodes error -result {bad level "#0.2"} |
Changes to win/tclWinNotify.c.
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
...
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
|
DWORD thread; /* Identifier for thread associated with this * notifier. */ HANDLE event; /* Event object used to wake up the notifier * thread. */ int pending; /* Alert message pending, this field is locked * by the notifierMutex. */ HWND hwnd; /* Messaging window. */ int timeout; /* Current timeout value. */ int timerActive; /* 1 if interval timer is running. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * The following static indicates the number of threads that have initialized ................................................................................ */ timeout = timePtr->sec * 1000 + timePtr->usec / 1000; if (timeout == 0) { timeout = 1; } } tsdPtr->timeout = timeout; if (timeout != 0) { tsdPtr->timerActive = 1; SetTimer(tsdPtr->hwnd, INTERVAL_TIMER, (unsigned long) tsdPtr->timeout, NULL); } else { tsdPtr->timerActive = 0; KillTimer(tsdPtr->hwnd, INTERVAL_TIMER); } } } |
<
<
|
|
32
33
34
35
36
37
38
39
40
41
42
43
44
45
...
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
|
DWORD thread; /* Identifier for thread associated with this
* notifier. */
HANDLE event; /* Event object used to wake up the notifier
* thread. */
int pending; /* Alert message pending, this field is locked
* by the notifierMutex. */
HWND hwnd; /* Messaging window. */
int timerActive; /* 1 if interval timer is running. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
/*
* The following static indicates the number of threads that have initialized
................................................................................
*/
timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
if (timeout == 0) {
timeout = 1;
}
}
if (timeout != 0) {
tsdPtr->timerActive = 1;
SetTimer(tsdPtr->hwnd, INTERVAL_TIMER,
timeout, NULL);
} else {
tsdPtr->timerActive = 0;
KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
}
}
}
|
Changes to win/tclWinPipe.c.
865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 .... 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 .... 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 .... 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 .... 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 |
{ ProcInfo *infoPtr; PipeInit(); Tcl_MutexLock(&pipeMutex); for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->dwProcessId == (DWORD) pid) { Tcl_MutexUnlock(&pipeMutex); return infoPtr->dwProcessId; } } Tcl_MutexUnlock(&pipeMutex); return (unsigned long) -1; } ................................................................................ * CreateProcess() and CloseHandle(), the problem does not occur." PSS ID * Number: Q124121 */ WaitForInputIdle(procInfo.hProcess, 5000); CloseHandle(procInfo.hThread); *pidPtr = (Tcl_Pid) procInfo.dwProcessId; if (*pidPtr != 0) { TclWinAddProcess(procInfo.hProcess, procInfo.dwProcessId); } result = TCL_OK; end: Tcl_DStringFree(&cmdLine); ................................................................................ QuoteCmdLineBackslash(dsPtr, start, special, NULL); start = special; } else { /* rest before first backslash and backslashes into new quoted block */ QuoteCmdLineBackslash(dsPtr, start, *bspos, NULL); start = *bspos; } /* * escape all special chars enclosed in quotes like `"..."`, note that here we * don't must escape `\` (with `\`), because it's outside of the main quotes, * so `\` remains `\`, but important - not at end of part, because results as * before the quote, so `%\%\` should be escaped as `"%\%"\\`). */ TclDStringAppendLiteral(dsPtr, "\""); /* opening escape quote-char */ do { *bspos = NULL; special++; if (*special == '\\') { ................................................................................ continue; } /* other not special (and not meta) character */ bspos = NULL; /* reset last backslash possition (not interesting) */ special++; } /* rest of argument (and escape backslashes before closing main quote) */ QuoteCmdLineBackslash(&ds, start, special, (quote & CL_QUOTE) ? bspos : NULL); } if (quote & CL_QUOTE) { /* end of argument (main closing quote-char) */ TclDStringAppendLiteral(&ds, "\""); } } ................................................................................ * Find the process and cut it from the process list. */ Tcl_MutexLock(&pipeMutex); prevPtrPtr = &procList; for (infoPtr = procList; infoPtr != NULL; prevPtrPtr = &infoPtr->nextPtr, infoPtr = infoPtr->nextPtr) { if (infoPtr->dwProcessId == (DWORD) pid) { *prevPtrPtr = infoPtr->nextPtr; break; } } Tcl_MutexUnlock(&pipeMutex); /* |
| | | | | | | |
865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 .... 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 .... 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 .... 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 .... 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 |
{ ProcInfo *infoPtr; PipeInit(); Tcl_MutexLock(&pipeMutex); for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->dwProcessId == (DWORD) (size_t) pid) { Tcl_MutexUnlock(&pipeMutex); return infoPtr->dwProcessId; } } Tcl_MutexUnlock(&pipeMutex); return (unsigned long) -1; } ................................................................................ * CreateProcess() and CloseHandle(), the problem does not occur." PSS ID * Number: Q124121 */ WaitForInputIdle(procInfo.hProcess, 5000); CloseHandle(procInfo.hThread); *pidPtr = (Tcl_Pid) (size_t) procInfo.dwProcessId; if (*pidPtr != 0) { TclWinAddProcess(procInfo.hProcess, procInfo.dwProcessId); } result = TCL_OK; end: Tcl_DStringFree(&cmdLine); ................................................................................ QuoteCmdLineBackslash(dsPtr, start, special, NULL); start = special; } else { /* rest before first backslash and backslashes into new quoted block */ QuoteCmdLineBackslash(dsPtr, start, *bspos, NULL); start = *bspos; } /* * escape all special chars enclosed in quotes like `"..."`, note that here we * don't must escape `\` (with `\`), because it's outside of the main quotes, * so `\` remains `\`, but important - not at end of part, because results as * before the quote, so `%\%\` should be escaped as `"%\%"\\`). */ TclDStringAppendLiteral(dsPtr, "\""); /* opening escape quote-char */ do { *bspos = NULL; special++; if (*special == '\\') { ................................................................................ continue; } /* other not special (and not meta) character */ bspos = NULL; /* reset last backslash possition (not interesting) */ special++; } /* rest of argument (and escape backslashes before closing main quote) */ QuoteCmdLineBackslash(&ds, start, special, (quote & CL_QUOTE) ? bspos : NULL); } if (quote & CL_QUOTE) { /* end of argument (main closing quote-char) */ TclDStringAppendLiteral(&ds, "\""); } } ................................................................................ * Find the process and cut it from the process list. */ Tcl_MutexLock(&pipeMutex); prevPtrPtr = &procList; for (infoPtr = procList; infoPtr != NULL; prevPtrPtr = &infoPtr->nextPtr, infoPtr = infoPtr->nextPtr) { if (infoPtr->dwProcessId == (DWORD) (size_t) pid) { *prevPtrPtr = infoPtr->nextPtr; break; } } Tcl_MutexUnlock(&pipeMutex); /* |