summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tclEnsemble.c24
-rw-r--r--tests/namespace.test4
2 files changed, 21 insertions, 7 deletions
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 9bb7a0c..022dafa 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -2751,13 +2751,6 @@ TclCompileEnsemble(
const char *word;
Tcl_IncrRefCount(replaced);
-
- /*
- * This is where we return to if we are parsing multiple nested compiled
- * ensembles. [info object] is such a beast.
- */
-
- checkNextWord:
if (parsePtr->numWords < depth + 1) {
goto failed;
}
@@ -2769,6 +2762,12 @@ TclCompileEnsemble(
goto failed;
}
+ /*
+ * This is where we return to if we are parsing multiple nested compiled
+ * ensembles. [info object] is such a beast.
+ */
+
+ checkNextWord:
word = tokenPtr[1].start;
numBytes = tokenPtr[1].size;
@@ -2979,6 +2978,17 @@ TclCompileEnsemble(
if (cmdPtr->compileProc == TclCompileEnsemble) {
tokenPtr = TokenAfter(tokenPtr);
+ if (parsePtr->numWords < depth + 1
+ || tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ /*
+ * Too hard because the user has done something unpleasant like
+ * omitting the sub-ensemble's command name or used a non-constant
+ * name for a sub-ensemble's command name; we respond by bailing
+ * out completely (this is a rare case). [Bug 6d2f249a01]
+ */
+
+ goto cleanup;
+ }
ensemble = (Tcl_Command) cmdPtr;
goto checkNextWord;
}
diff --git a/tests/namespace.test b/tests/namespace.test
index fab0040..cded1f4 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -2949,6 +2949,10 @@ test namespace-54.1 {leak on namespace deletion} -constraints {memory} \
rename getbytes {}
unset i ns start end
} -result 0
+
+test namespace-55.1 {compiled ensembles inside compiled ensembles: Bug 6d2f249a01} {
+ info class [format %s constructor] oo::object
+} ""
# cleanup
catch {rename cmd1 {}}