Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | merge trunk |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | novem |
| Files: | files | file ages | folders |
| SHA1: |
5d20ee0f168fa6688105b83876971da4 |
| User & Date: | dgp 2016-04-07 14:57:43 |
Context
|
2016-04-08
| ||
| 12:29 | merge trunk check-in: d001fa087b user: jan.nijtmans tags: novem | |
|
2016-04-07
| ||
| 14:58 | merge novem check-in: 0714f6bbe0 user: dgp tags: dgp-refactor | |
| 14:57 | merge trunk check-in: 5d20ee0f16 user: dgp tags: novem | |
| 14:56 | merge 8.6 check-in: a7a8861836 user: dgp tags: trunk | |
|
2016-04-06
| ||
| 10:38 | Update all Unicode tables to version 9.0 beta check-in: ef93047d9f user: jan.nijtmans tags: novem | |
Changes
Changes to generic/tclProc.c.
65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 ... 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 ... 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 |
* Tcl_GetStringFromObj should panic
* instead. */
NULL /* SetFromAny function; Tcl_ConvertToType
* should panic instead. */
};
/*
* The [upvar]/[uplevel] level reference type. Uses the twoPtrValue field,
* encoding the type of level reference in ptr and the actual parsed out
* offset in ptr2.
*
* Uses the default behaviour throughout, and never disposes of the string
* rep; it's just a cache type.
*/
static const Tcl_ObjType levelReferenceType = {
"levelReference",
................................................................................
* Given a description of a procedure frame, such as the first argument
* to an "uplevel" or "upvar" command, locate the call frame for the
* appropriate level of procedure.
*
* Results:
* The return value is -1 if an error occurred in finding the frame (in
* this case an error message is left in the interp's result). 1 is
* returned if objPtr was either a number or a number preceded by "#" and
* it specified a valid frame. 0 is returned if objPtr isn't one of the
* two things above (in this case, the lookup acts as if objPtr were
* "1"). The variable pointed to by framePtrPtr is filled in with the
* address of the desired frame (unless an error occurs, in which case it
* isn't modified).
*
* Side effects:
................................................................................
Tcl_Interp *interp, /* Interpreter in which to find frame. */
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;
CallFrame *framePtr;
const char *name;
/*
* Parse object to figure out which level number to go to.
*/
result = 1;
curLevel = iPtr->varFramePtr->level;
if (objPtr == NULL) {
name = "1";
goto haveLevel1;
}
name = TclGetString(objPtr);
if (objPtr->typePtr == &levelReferenceType) {
if (objPtr->internalRep.twoPtrValue.ptr1) {
level = curLevel - PTR2INT(objPtr->internalRep.twoPtrValue.ptr2);
} else {
level = PTR2INT(objPtr->internalRep.twoPtrValue.ptr2);
}
if (level < 0) {
goto levelError;
}
/* TODO: Consider skipping the typePtr checks */
} else if (objPtr->typePtr == &tclIntType
#ifndef TCL_WIDE_INT_IS_LONG
|| objPtr->typePtr == &tclWideIntType
#endif
) {
if (TclGetIntFromObj(NULL, objPtr, &level) != TCL_OK || level < 0) {
goto levelError;
}
level = curLevel - level;
} else if (*name == '#') {
if (Tcl_GetInt(interp, name+1, &level) != TCL_OK || level < 0) {
goto levelError;
}
/*
* Cache for future reference.
*/
TclFreeIntRep(objPtr);
objPtr->typePtr = &levelReferenceType;
objPtr->internalRep.twoPtrValue.ptr1 = (void *) 0;
objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(level);
} else if (isdigit(UCHAR(*name))) { /* INTL: digit */
if (Tcl_GetInt(interp, name, &level) != TCL_OK) {
return -1;
}
/*
* Cache for future reference.
*/
TclFreeIntRep(objPtr);
objPtr->typePtr = &levelReferenceType;
objPtr->internalRep.twoPtrValue.ptr1 = (void *) 1;
objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(level);
level = curLevel - level;
} else {
/*
* Don't cache as the object *isn't* a level reference (might even be
* NULL...)
*/
haveLevel1:
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;
}
/*
*----------------------------------------------------------------------
|
| | < | < | | < < < | > > > > < > > > > > > | | < > | < < < < < < | < < < < < < < < | < < < < < < < < > | | | < < < < > > > | < > | < > > | > | < < < < < < < < < < | < > > < > < < < < < > > > | | | < > > | | > | < > | < < | < > |
65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 ... 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 ... 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 |
* Tcl_GetStringFromObj should panic
* instead. */
NULL /* SetFromAny function; Tcl_ConvertToType
* should panic instead. */
};
/*
* The [upvar]/[uplevel] level reference type. Uses the longValue field
* to remember the integer value of a parsed #<integer> format.
*
* Uses the default behaviour throughout, and never disposes of the string
* rep; it's just a cache type.
*/
static const Tcl_ObjType levelReferenceType = {
"levelReference",
................................................................................
* Given a description of a procedure frame, such as the first argument
* to an "uplevel" or "upvar" command, locate the call frame for the
* appropriate level of procedure.
*
* Results:
* The return value is -1 if an error occurred in finding the frame (in
* this case an error message is left in the interp's result). 1 is
* returned if objPtr was either an int or an int preceded by "#" and
* it specified a valid frame. 0 is returned if objPtr isn't one of the
* two things above (in this case, the lookup acts as if objPtr were
* "1"). The variable pointed to by framePtrPtr is filled in with the
* address of the desired frame (unless an error occurs, in which case it
* isn't modified).
*
* Side effects:
................................................................................
Tcl_Interp *interp, /* Interpreter in which to find frame. */
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.longValue;
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.longValue = 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", "VALUE", "STACKLEVEL", NULL);
return -1;
}
/*
*----------------------------------------------------------------------
|
Changes to tests/uplevel.test.
97 98 99 100 101 102 103 104 105 106 107 108 109 110 |
uplevel
} -result {wrong # args: should be "uplevel ?level? command ?arg ...?"}
test uplevel-4.4 {error: not enough args} -returnCodes error -body {
apply {{} {
uplevel 1
}}
} -result {wrong # args: should be "uplevel ?level? command ?arg ...?"}
proc a2 {} {
uplevel a3
}
proc a3 {} {
global x y
set x [info level]
|
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > |
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 |
uplevel
} -result {wrong # args: should be "uplevel ?level? command ?arg ...?"}
test uplevel-4.4 {error: not enough args} -returnCodes error -body {
apply {{} {
uplevel 1
}}
} -result {wrong # args: should be "uplevel ?level? command ?arg ...?"}
test uplevel-4.5 {level parsing} {
apply {{} {uplevel 0 {}}}
} {}
test uplevel-4.6 {level parsing} {
apply {{} {uplevel #0 {}}}
} {}
test uplevel-4.7 {level parsing} {
apply {{} {uplevel [expr 0] {}}}
} {}
test uplevel-4.8 {level parsing} {
apply {{} {uplevel #[expr 0] {}}}
} {}
test uplevel-4.9 {level parsing} {
apply {{} {uplevel -0 {}}}
} {}
test uplevel-4.10 {level parsing} {
apply {{} {uplevel #-0 {}}}
} {}
test uplevel-4.11 {level parsing} {
apply {{} {uplevel [expr -0] {}}}
} {}
test uplevel-4.12 {level parsing} {
apply {{} {uplevel #[expr -0] {}}}
} {}
test uplevel-4.13 {level parsing} {
apply {{} {uplevel 1 {}}}
} {}
test uplevel-4.14 {level parsing} {
apply {{} {uplevel #1 {}}}
} {}
test uplevel-4.15 {level parsing} {
apply {{} {uplevel [expr 1] {}}}
} {}
test uplevel-4.16 {level parsing} {
apply {{} {uplevel #[expr 1] {}}}
} {}
test uplevel-4.17 {level parsing} {
apply {{} {uplevel -0xffffffff {}}}
} {}
test uplevel-4.18 {level parsing} {
apply {{} {uplevel #-0xffffffff {}}}
} {}
test uplevel-4.19 {level parsing} {
apply {{} {uplevel [expr -0xffffffff] {}}}
} {}
test uplevel-4.20 {level parsing} {
apply {{} {uplevel #[expr -0xffffffff] {}}}
} {}
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 #0xffffffff {}}}
} -returnCodes error -result {bad level "#0xffffffff"}
test uplevel-4.27 {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"}
proc a2 {} {
uplevel a3
}
proc a3 {} {
global x y
set x [info level]
|