Compare commits
7
Commits
enum
...
bug-3418547
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
43c3acb51b | ||
|
|
49d8a1a3f0 | ||
|
|
b3f6ca0a4a | ||
|
|
e4a034a5d4 | ||
|
|
f7c72f2c05 | ||
|
|
2060e47cb8 | ||
|
|
3406121331 |
@@ -1942,17 +1942,6 @@ Tcl_ExposeCommand(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Command resolvers (per-interp, per-namespace) might have resolved to a
|
||||
* command for the given namespace scope with this command not 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.
|
||||
*/
|
||||
|
||||
TclInvalidateCmdLiteral(interp, cmdName, nsPtr);
|
||||
|
||||
/*
|
||||
* 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
|
||||
@@ -2109,17 +2098,6 @@ Tcl_CreateCommand(
|
||||
ckfree(Tcl_GetHashValue(hPtr));
|
||||
}
|
||||
} else {
|
||||
/*
|
||||
* Command resolvers (per-interp, per-namespace) might have resolved
|
||||
* to a command for the given namespace scope with this command not
|
||||
* 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.
|
||||
*/
|
||||
|
||||
TclInvalidateCmdLiteral(interp, tail, nsPtr);
|
||||
|
||||
/*
|
||||
* The list of command exported from the namespace might have changed.
|
||||
@@ -2305,17 +2283,6 @@ Tcl_CreateObjCommand(
|
||||
ckfree(Tcl_GetHashValue(hPtr));
|
||||
}
|
||||
} else {
|
||||
/*
|
||||
* Command resolvers (per-interp, per-namespace) might have resolved
|
||||
* to a command for the given namespace scope with this command not
|
||||
* 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.
|
||||
*/
|
||||
|
||||
TclInvalidateCmdLiteral(interp, tail, nsPtr);
|
||||
|
||||
/*
|
||||
* The list of command exported from the namespace might have changed.
|
||||
@@ -2627,17 +2594,6 @@ TclRenameCommand(
|
||||
TclInvalidateNsCmdLookup(cmdNsPtr);
|
||||
TclInvalidateNsCmdLookup(cmdPtr->nsPtr);
|
||||
|
||||
/*
|
||||
* Command resolvers (per-interp, per-namespace) might have resolved to a
|
||||
* command for the given namespace scope with this command not 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.
|
||||
*/
|
||||
|
||||
TclInvalidateCmdLiteral(interp, newTail, cmdPtr->nsPtr);
|
||||
|
||||
/*
|
||||
* Script for rename traces can delete the command "oldName". Therefore
|
||||
* increment the reference count for cmdPtr so that it's Command structure
|
||||
|
||||
@@ -1160,8 +1160,6 @@ MODULE_SCOPE void TclPushVarName(Tcl_Interp *interp,
|
||||
MODULE_SCOPE void TclPreserveByteCode(ByteCode *codePtr);
|
||||
MODULE_SCOPE void TclReleaseByteCode(ByteCode *codePtr);
|
||||
MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
|
||||
MODULE_SCOPE void TclInvalidateCmdLiteral(Tcl_Interp *interp,
|
||||
const char *name, Namespace *nsPtr);
|
||||
MODULE_SCOPE int TclSingleOpCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
|
||||
@@ -1004,51 +1004,6 @@ RebuildLiteralTable(
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclInvalidateCmdLiteral --
|
||||
*
|
||||
* Invalidate a command literal entry, if present in the literal hash
|
||||
* tables, by resetting its internal representation. This invalidation
|
||||
* leaves it in the literal tables and in existing literal arrays. As a
|
||||
* result, existing references continue to work but we force a fresh
|
||||
* command look-up upon the next use (see, in particular,
|
||||
* TclSetCmdNameObj()).
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* Resets the internal representation of the CmdName Tcl_Obj
|
||||
* using TclFreeIntRep().
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
void
|
||||
TclInvalidateCmdLiteral(
|
||||
Tcl_Interp *interp, /* Interpreter for which to invalidate a
|
||||
* command literal. */
|
||||
const char *name, /* Points to the start of the cmd literal
|
||||
* name. */
|
||||
Namespace *nsPtr) /* The namespace for which to lookup and
|
||||
* invalidate a cmd literal. */
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
Tcl_Obj *literalObjPtr = TclCreateLiteral(iPtr, name,
|
||||
strlen(name), -1, NULL, nsPtr, 0, NULL);
|
||||
|
||||
if (literalObjPtr != NULL) {
|
||||
if (literalObjPtr->typePtr == &tclCmdNameType) {
|
||||
TclFreeIntRep(literalObjPtr);
|
||||
}
|
||||
/* Balance the refcount effects of TclCreateLiteral() above */
|
||||
Tcl_IncrRefCount(literalObjPtr);
|
||||
TclReleaseLiteral(interp, literalObjPtr);
|
||||
}
|
||||
}
|
||||
|
||||
#ifdef TCL_COMPILE_STATS
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
|
||||
+9
-4
@@ -4130,6 +4130,7 @@ Tcl_GetCommandFromObj(
|
||||
* global namespace. */
|
||||
{
|
||||
register ResolvedCmdName *resPtr;
|
||||
Tcl_Command result = NULL;
|
||||
|
||||
/*
|
||||
* Get the internal representation, converting to a command type if
|
||||
@@ -4175,11 +4176,14 @@ Tcl_GetCommandFromObj(
|
||||
*/
|
||||
|
||||
/* See [07d13d99b0a9] why we cannot call SetCmdNameFromAny() directly here. */
|
||||
if (tclCmdNameType.setFromAnyProc(interp, objPtr) != TCL_OK) {
|
||||
return NULL;
|
||||
if (tclCmdNameType.setFromAnyProc(interp, objPtr) == TCL_OK) {
|
||||
resPtr = objPtr->internalRep.twoPtrValue.ptr1;
|
||||
if (resPtr) {
|
||||
result = (Tcl_Command) resPtr->cmdPtr;
|
||||
}
|
||||
TclFreeIntRep(objPtr);
|
||||
}
|
||||
resPtr = objPtr->internalRep.twoPtrValue.ptr1;
|
||||
return (Tcl_Command) (resPtr ? resPtr->cmdPtr : NULL);
|
||||
return result;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -4272,6 +4276,7 @@ TclSetCmdNameObj(
|
||||
return;
|
||||
}
|
||||
}
|
||||
return;
|
||||
|
||||
SetCmdNameObj(interp, objPtr, cmdPtr, NULL);
|
||||
}
|
||||
|
||||
+29
-18
@@ -41,7 +41,8 @@ test resolver-1.1 {cmdNameObj sharing vs. cmd resolver: namespace import} -setup
|
||||
# 2) After having requested cmd resolution above, we can now use the
|
||||
# globally shared CmdName Tcl_Obj "z", now bound to cmd ::y. This is
|
||||
# certainly questionable, but defensible
|
||||
set r1 [z]; # --> The result of [z] is "Y"
|
||||
set r1 untouched
|
||||
catch {set r1 [z]}; # --> The result of [z] is "Y"
|
||||
# 3) We import from the namespace ns1 another z. [namespace import] takes
|
||||
# care "shadowed" cmd references, however, till now cmd literals have not
|
||||
# been touched. This is, however, necessary since the BC compiler (used in
|
||||
@@ -52,13 +53,14 @@ test resolver-1.1 {cmdNameObj sharing vs. cmd resolver: namespace import} -setup
|
||||
namespace import ::ns1::z
|
||||
set r2 [z]
|
||||
}
|
||||
list $r0 $r1 $::r2
|
||||
set r3 [x]
|
||||
list $r0 $r1 $::r2 $r3
|
||||
} -cleanup {
|
||||
testinterpresolver down
|
||||
rename ::x ""
|
||||
rename ::y ""
|
||||
namespace delete ::ns1
|
||||
} -result {Y Y Z}
|
||||
} -result {Y untouched Z Y}
|
||||
test resolver-1.2 {cmdNameObj sharing vs. cmd resolver: proc creation} -setup {
|
||||
testinterpresolver up
|
||||
proc ::y {} { return Y }
|
||||
@@ -67,19 +69,20 @@ test resolver-1.2 {cmdNameObj sharing vs. cmd resolver: proc creation} -setup {
|
||||
}
|
||||
} -constraints testinterpresolver -body {
|
||||
set r0 [x]
|
||||
set r1 [z]
|
||||
set r1 untouched
|
||||
catch {set r1 [z]}
|
||||
proc ::foo {} {
|
||||
proc ::z {} { return Z }
|
||||
return [z]
|
||||
}
|
||||
list $r0 $r1 [::foo]
|
||||
list $r0 $r1 [::foo] [x]
|
||||
} -cleanup {
|
||||
testinterpresolver down
|
||||
rename ::x ""
|
||||
rename ::y ""
|
||||
rename ::foo ""
|
||||
rename ::z ""
|
||||
} -result {Y Y Z}
|
||||
} -result {Y untouched Z Y}
|
||||
test resolver-1.3 {cmdNameObj sharing vs. cmd resolver: rename} -setup {
|
||||
testinterpresolver up
|
||||
proc ::Z {} { return Z }
|
||||
@@ -89,18 +92,20 @@ test resolver-1.3 {cmdNameObj sharing vs. cmd resolver: rename} -setup {
|
||||
}
|
||||
} -constraints testinterpresolver -body {
|
||||
set r0 [x]
|
||||
set r1 [z]
|
||||
set r1 untouched
|
||||
catch {set r1 [z]}
|
||||
namespace eval :: {
|
||||
rename ::Z ::z
|
||||
set r2 [z]
|
||||
}
|
||||
list $r0 $r1 $r2
|
||||
set r3 [x]
|
||||
list $r0 $r1 $r2 $r3
|
||||
} -cleanup {
|
||||
testinterpresolver down
|
||||
rename ::x ""
|
||||
rename ::y ""
|
||||
rename ::z ""
|
||||
} -result {Y Y Z}
|
||||
} -result {Y untouched Z Y}
|
||||
test resolver-1.4 {cmdNameObj sharing vs. cmd resolver: interp expose} -setup {
|
||||
testinterpresolver up
|
||||
proc ::Z {} { return Z }
|
||||
@@ -111,18 +116,20 @@ test resolver-1.4 {cmdNameObj sharing vs. cmd resolver: interp expose} -setup {
|
||||
}
|
||||
} -constraints testinterpresolver -body {
|
||||
set r0 [x]
|
||||
set r1 [z]
|
||||
set r1 untouched
|
||||
catch {set r1 [z]}
|
||||
interp expose {} Z z
|
||||
namespace eval :: {
|
||||
set r2 [z]
|
||||
}
|
||||
list $r0 $r1 $r2
|
||||
set r0 [x]
|
||||
list $r0 $r1 $r2 $r3
|
||||
} -cleanup {
|
||||
testinterpresolver down
|
||||
rename ::x ""
|
||||
rename ::y ""
|
||||
rename ::z ""
|
||||
} -result {Y Y Z}
|
||||
} -result {Y untouched Z Y}
|
||||
test resolver-1.5 {cmdNameObj sharing vs. cmd resolver: other than global NS} -setup {
|
||||
testinterpresolver up
|
||||
namespace eval ::ns1 {
|
||||
@@ -140,17 +147,19 @@ test resolver-1.5 {cmdNameObj sharing vs. cmd resolver: other than global NS} -s
|
||||
}
|
||||
} -constraints testinterpresolver -body {
|
||||
set r0 [namespace eval ::ns2 {x}]
|
||||
set r1 [namespace eval ::ns2 {z}]
|
||||
set r1 untouched
|
||||
catch {set r1 [namespace eval ::ns2 {z}]}
|
||||
namespace eval ::ns2 {
|
||||
namespace import ::ns1::z
|
||||
set r2 [z]
|
||||
}
|
||||
list $r0 $r1 $r2
|
||||
set r3 [namespace eval ::ns2 {x}]
|
||||
list $r0 $r1 $r2 $r3
|
||||
} -cleanup {
|
||||
testinterpresolver down
|
||||
namespace delete ::ns2
|
||||
namespace delete ::ns1
|
||||
} -result {Y Y Z}
|
||||
} -result {Y untouched Z Y}
|
||||
test resolver-1.6 {cmdNameObj sharing vs. cmd resolver: interp alias} -setup {
|
||||
testinterpresolver up
|
||||
proc ::Z {} { return Z }
|
||||
@@ -160,18 +169,20 @@ test resolver-1.6 {cmdNameObj sharing vs. cmd resolver: interp alias} -setup {
|
||||
}
|
||||
} -constraints testinterpresolver -body {
|
||||
set r0 [x]
|
||||
set r1 [z]
|
||||
set r1 untouched
|
||||
catch {set r1 [z]}
|
||||
namespace eval :: {
|
||||
interp alias {} ::z {} ::Z
|
||||
set r2 [z]
|
||||
}
|
||||
list $r0 $r1 $r2
|
||||
set r3 [x]
|
||||
list $r0 $r1 $r2 $r3
|
||||
} -cleanup {
|
||||
testinterpresolver down
|
||||
rename ::x ""
|
||||
rename ::y ""
|
||||
rename ::Z ""
|
||||
} -result {Y Y Z}
|
||||
} -result {Y untouched Z Y}
|
||||
|
||||
test resolver-2.1 {compiled var resolver: Bug #3383616} -setup {
|
||||
testinterpresolver up
|
||||
|
||||
Reference in New Issue
Block a user