summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclCompExpr.c2
-rw-r--r--generic/tclCompile.c4
-rw-r--r--generic/tclCompile.h4
-rw-r--r--generic/tclEnsemble.c2
-rw-r--r--generic/tclLiteral.c20
-rw-r--r--generic/tclTest.c18
-rw-r--r--tests/resolver.test26
7 files changed, 33 insertions, 43 deletions
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index ab5e8af..4390282 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -2272,7 +2272,7 @@ CompileExprTree(
Tcl_DStringAppend(&cmdName, p, length);
TclEmitPush(TclRegisterNewCmdLiteral(envPtr,
Tcl_DStringValue(&cmdName),
- Tcl_DStringLength(&cmdName), 0), envPtr);
+ Tcl_DStringLength(&cmdName)), envPtr);
Tcl_DStringFree(&cmdName);
/*
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 4e4ead6..ee36bff 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1793,8 +1793,8 @@ CompileCmdLiteral(
}
bytes = Tcl_GetStringFromObj(cmdObj, &numBytes);
- cmdLitIdx = TclRegisterNewCmdLiteral(envPtr, bytes, numBytes, extraLiteralFlags);
-
+ cmdLitIdx = TclRegisterLiteral(envPtr, (char *)bytes, numBytes, extraLiteralFlags|LITERAL_CMD_NAME);
+
if (cmdPtr) {
TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr);
}
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index fa76f83..ba6ad44 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1230,8 +1230,8 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData,
* int length);
*/
-#define TclRegisterNewCmdLiteral(envPtr, bytes, length, extraLiteralFlags) \
- TclRegisterLiteral(envPtr, (char *)(bytes), length, ((extraLiteralFlags)|LITERAL_CMD_NAME))
+#define TclRegisterNewCmdLiteral(envPtr, bytes, length) \
+ TclRegisterLiteral(envPtr, (char *)(bytes), length, LITERAL_CMD_NAME)
/*
* Macro used to manually adjust the stack requirements; used in cases where
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 22c475f..67ee65e 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -3354,7 +3354,7 @@ CompileToInvokedCommand(
extraLiteralFlags = LITERAL_UNSHARED;
}
}
- cmdLit = TclRegisterNewCmdLiteral(envPtr, bytes, length, extraLiteralFlags);
+ cmdLit = TclRegisterLiteral(envPtr, (char *)bytes, length, extraLiteralFlags|LITERAL_CMD_NAME);
TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLit), cmdPtr);
TclEmitPush(cmdLit, envPtr);
TclDecrRefCount(objPtr);
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c
index 864d050..484b86b 100644
--- a/generic/tclLiteral.c
+++ b/generic/tclLiteral.c
@@ -214,16 +214,15 @@ TclCreateLiteral(
if (globalPtrPtr) {
*globalPtrPtr = globalPtr;
}
- if ((flags & LITERAL_ON_HEAP)) {
+ if (flags & LITERAL_ON_HEAP) {
ckfree(bytes);
}
globalPtr->refCount++;
return objPtr;
}
}
-
if (!newPtr) {
- if ((flags & LITERAL_ON_HEAP)) {
+ if (flags & LITERAL_ON_HEAP) {
ckfree(bytes);
}
return NULL;
@@ -236,15 +235,15 @@ TclCreateLiteral(
TclNewObj(objPtr);
Tcl_IncrRefCount(objPtr);
- if ((flags & LITERAL_ON_HEAP)) {
+ if (flags & LITERAL_ON_HEAP) {
objPtr->bytes = bytes;
objPtr->length = length;
} else {
TclInitStringRep(objPtr, bytes, length);
}
- if ((flags & LITERAL_UNSHARED)) {
- /*
+ if (flags & LITERAL_UNSHARED) {
+ /*
* Make clear, that no global value is returned
*/
if (globalPtrPtr != NULL) {
@@ -429,7 +428,7 @@ TclRegisterLiteral(
* the namespace as the interp's global NS.
*/
- if ((flags & LITERAL_CMD_NAME)) {
+ if (flags & LITERAL_CMD_NAME) {
if ((length >= 2) && (bytes[0] == ':') && (bytes[1] == ':')) {
nsPtr = iPtr->globalNsPtr;
} else {
@@ -438,10 +437,11 @@ TclRegisterLiteral(
} else {
nsPtr = NULL;
}
-
+
/*
* Is it in the interpreter's global literal table? If not, create it.
*/
+
globalPtr = NULL;
objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &new, nsPtr, flags,
&globalPtr);
@@ -1167,10 +1167,6 @@ TclVerifyLocalLiteralTable(
if (LookupLiteralEntry((Tcl_Interp *) envPtr->iPtr,
localPtr->objPtr) == NULL) {
bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
- //Tcl_Panic("%s: local literal \"%.*s\" is not global",
- // "TclVerifyLocalLiteralTable",
- // (length>60? 60 : length), bytes);
- /*fprintf(stderr, "local literal \"%s\" is not global\n",bytes);*/
}
if (localPtr->objPtr->bytes == NULL) {
Tcl_Panic("%s: literal has NULL string rep",
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 522e966..1e595d6 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -7308,21 +7308,21 @@ InterpCmdResolver(
*/
if ( (name[0] == 'z') && (name[1] == '\0') ) {
Namespace *ns2NsPtr = (Namespace *) Tcl_FindNamespace(interp, "::ns2", NULL, 0);
-
+
if (procPtr != NULL
&& ((procPtr->cmdPtr->nsPtr == iPtr->globalNsPtr)
|| (ns2NsPtr != NULL && procPtr->cmdPtr->nsPtr == ns2NsPtr)
)
) {
/*
- * Case A)
+ * Case A)
*
* - The context, in which this resolver becomes active, is
* determined by the name of the caller proc, which has to be
* named "x".
*
* - To determine the name of the caller proc, the proc is taken
- * from the topmost stack frame.
+ * from the topmost stack frame.
*
* - Note that the context is NOT provided during byte-code
* compilation (e.g. in TclProcCompileProc)
@@ -7331,23 +7331,23 @@ InterpCmdResolver(
* passed-in cmd literal into a cmd "y", which is taken from the
* the global namespace (for simplicity).
*/
-
+
const char *callingCmdName =
Tcl_GetCommandName(interp, (Tcl_Command) procPtr->cmdPtr);
-
+
if ( callingCmdName[0] == 'x' && callingCmdName[1] == '\0' ) {
resolvedCmdPtr = Tcl_FindCommand(interp, "y", NULL, TCL_GLOBAL_ONLY);
}
} else if (callerNsPtr != NULL) {
/*
- * Case B)
+ * Case B)
*
* - The context, in which this resolver becomes active, is
* determined by the name of the parent namespace, which has
* to be named "ctx1" or "ctx2".
*
* - To determine the name of the parent namesace, it is taken
- * from the 2nd highest stack frame.
+ * from the 2nd highest stack frame.
*
* - Note that the context can be provided during byte-code
* compilation (e.g. in TclProcCompileProc)
@@ -7364,13 +7364,13 @@ InterpCmdResolver(
if (strcmp(context, "ctx1") == 0 && (name[0] == 'z') && (name[1] == '\0')) {
resolvedCmdPtr = Tcl_FindCommand(interp, "y", NULL, TCL_GLOBAL_ONLY);
/* fprintf(stderr, "... y ==> %p\n", resolvedCmdPtr);*/
-
+
} else if (strcmp(context, "ctx2") == 0 && (name[0] == 'z') && (name[1] == '\0')) {
resolvedCmdPtr = Tcl_FindCommand(interp, "Y", NULL, TCL_GLOBAL_ONLY);
/*fprintf(stderr, "... Y ==> %p\n", resolvedCmdPtr);*/
}
}
-
+
if (resolvedCmdPtr != NULL) {
*rPtr = resolvedCmdPtr;
return TCL_OK;
diff --git a/tests/resolver.test b/tests/resolver.test
index 01e2e0b..dc38ff0 100644
--- a/tests/resolver.test
+++ b/tests/resolver.test
@@ -38,12 +38,10 @@ test resolver-1.1 {cmdNameObj sharing vs. cmd resolver: namespace import} -setup
# is turned into a command literal shared for a given (here: the global)
# namespace.
set r0 [x]; # --> The result of [x] is "Y"
-
# 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"
-
# 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
@@ -61,12 +59,12 @@ test resolver-1.1 {cmdNameObj sharing vs. cmd resolver: namespace import} -setup
rename ::y ""
namespace delete ::ns1
} -result {Y Y Z}
-
-
test resolver-1.2 {cmdNameObj sharing vs. cmd resolver: proc creation} -setup {
testinterpresolver up
proc ::y {} { return Y }
- proc ::x {} { z }
+ proc ::x {} {
+ z
+ }
} -constraints testinterpresolver -body {
set r0 [x]
set r1 [z]
@@ -82,8 +80,6 @@ test resolver-1.2 {cmdNameObj sharing vs. cmd resolver: proc creation} -setup {
rename ::foo ""
rename ::z ""
} -result {Y Y Z}
-
-
test resolver-1.3 {cmdNameObj sharing vs. cmd resolver: rename} -setup {
testinterpresolver up
proc ::Z {} { return Z }
@@ -105,8 +101,6 @@ test resolver-1.3 {cmdNameObj sharing vs. cmd resolver: rename} -setup {
rename ::y ""
rename ::z ""
} -result {Y Y Z}
-
-
test resolver-1.4 {cmdNameObj sharing vs. cmd resolver: interp expose} -setup {
testinterpresolver up
proc ::Z {} { return Z }
@@ -129,8 +123,6 @@ test resolver-1.4 {cmdNameObj sharing vs. cmd resolver: interp expose} -setup {
rename ::y ""
rename ::z ""
} -result {Y Y Z}
-
-
test resolver-1.5 {cmdNameObj sharing vs. cmd resolver: other than global NS} -setup {
testinterpresolver up
namespace eval ::ns1 {
@@ -139,7 +131,9 @@ test resolver-1.5 {cmdNameObj sharing vs. cmd resolver: other than global NS} -s
}
proc ::y {} { return Y }
namespace eval ::ns2 {
- proc x {} { z }
+ proc x {} {
+ z
+ }
}
namespace eval :: {
variable r2 ""
@@ -157,13 +151,13 @@ test resolver-1.5 {cmdNameObj sharing vs. cmd resolver: other than global NS} -s
namespace delete ::ns2
namespace delete ::ns1
} -result {Y Y Z}
-
-
test resolver-1.6 {cmdNameObj sharing vs. cmd resolver: interp alias} -setup {
testinterpresolver up
proc ::Z {} { return Z }
proc ::y {} { return Y }
- proc ::x {} { z }
+ proc ::x {} {
+ z
+ }
} -constraints testinterpresolver -body {
set r0 [x]
set r1 [z]
@@ -193,7 +187,7 @@ test resolver-2.1 {compiled var resolver: Bug #3383616} -setup {
# During the compilation the compiled var resolver, the resolve-specific
# var info is allocated, during the execution of the body, the variable is
# fetched and cached.
- x
+ x;
# During later calls, the cached variable is reused.
x
# When the proc is freed, the resolver-specific resolver var info is
generated by cgit v0.12 at 2024-07-16 04:44:23 (GMT)