From 1438a1b7f7a2fa985d02d45337bd9e98c901ee11 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 12 May 2016 19:44:41 +0000
Subject: Remove the nsPtr field from the EnsembleCmdRep struct. Cannot see any
justification for keeping it (can get via token), and test suite doesn't
care.
---
generic/tclEnsemble.c | 9 +--------
generic/tclInt.h | 2 --
2 files changed, 1 insertion(+), 10 deletions(-)
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 986a553..ecf10ff 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -1707,8 +1707,7 @@ NsEnsembleImplementationCmdNR(
EnsembleCmdRep *ensembleCmd = objv[1+ensemblePtr->numParameters]
->internalRep.twoPtrValue.ptr1;
- if (ensembleCmd->nsPtr == ensemblePtr->nsPtr &&
- ensembleCmd->epoch == ensemblePtr->epoch &&
+ if (ensembleCmd->epoch == ensemblePtr->epoch &&
ensembleCmd->token == ensemblePtr->token) {
prefixObj = ensembleCmd->realPrefixObj;
Tcl_IncrRefCount(prefixObj);
@@ -2227,7 +2226,6 @@ MakeCachedEnsembleCommand(
if (objPtr->typePtr == &tclEnsembleCmdType) {
ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
Tcl_DecrRefCount(ensembleCmd->realPrefixObj);
- TclNsDecrRefCount(ensembleCmd->nsPtr);
ckfree(ensembleCmd->fullSubcmdName);
} else {
/*
@@ -2245,10 +2243,8 @@ MakeCachedEnsembleCommand(
* Populate the internal rep.
*/
- ensembleCmd->nsPtr = ensemblePtr->nsPtr;
ensembleCmd->epoch = ensemblePtr->epoch;
ensembleCmd->token = ensemblePtr->token;
- ensemblePtr->nsPtr->refCount++;
ensembleCmd->realPrefixObj = prefixObjPtr;
length = strlen(subcommandName)+1;
ensembleCmd->fullSubcmdName = ckalloc(length);
@@ -2636,7 +2632,6 @@ FreeEnsembleCmdRep(
Tcl_DecrRefCount(ensembleCmd->realPrefixObj);
ckfree(ensembleCmd->fullSubcmdName);
- TclNsDecrRefCount(ensembleCmd->nsPtr);
ckfree(ensembleCmd);
objPtr->typePtr = NULL;
}
@@ -2670,10 +2665,8 @@ DupEnsembleCmdRep(
copyPtr->typePtr = &tclEnsembleCmdType;
copyPtr->internalRep.twoPtrValue.ptr1 = ensembleCopy;
- ensembleCopy->nsPtr = ensembleCmd->nsPtr;
ensembleCopy->epoch = ensembleCmd->epoch;
ensembleCopy->token = ensembleCmd->token;
- ensembleCopy->nsPtr->refCount++;
ensembleCopy->realPrefixObj = ensembleCmd->realPrefixObj;
Tcl_IncrRefCount(ensembleCopy->realPrefixObj);
ensembleCopy->fullSubcmdName = ckalloc(length + 1);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 42c13dd..e00c392 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -395,8 +395,6 @@ struct NamespacePathEntry {
*/
typedef struct {
- Namespace *nsPtr; /* The namespace backing the ensemble which
- * this is a subcommand of. */
int epoch; /* Used to confirm when the data in this
* really structure matches up with the
* ensemble. */
--
cgit v0.12
From 76f6131b819bc1430e3465195a6ed90b78c71dad Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 12 May 2016 19:49:06 +0000
Subject: The "ensembleCommand" Tcl_ObjType has no need for an UpdateString
routine. It is entirely a caching type. No "pure" value can exist.
---
generic/tclEnsemble.c | 32 +-------------------------------
1 file changed, 1 insertion(+), 31 deletions(-)
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index ecf10ff..ead96a3 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -34,7 +34,6 @@ static void MakeCachedEnsembleCommand(Tcl_Obj *objPtr,
const char *subcmdName, Tcl_Obj *prefixObjPtr);
static void FreeEnsembleCmdRep(Tcl_Obj *objPtr);
static void DupEnsembleCmdRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
-static void StringOfEnsembleCmdRep(Tcl_Obj *objPtr);
static void CompileToInvokedCommand(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Tcl_Obj *replacements,
Command *cmdPtr, CompileEnv *envPtr);
@@ -81,7 +80,7 @@ const Tcl_ObjType tclEnsembleCmdType = {
"ensembleCommand", /* the type's name */
FreeEnsembleCmdRep, /* freeIntRepProc */
DupEnsembleCmdRep, /* dupIntRepProc */
- StringOfEnsembleCmdRep, /* updateStringProc */
+ NULL, /* updateStringProc */
NULL /* setFromAnyProc */
};
@@ -2677,35 +2676,6 @@ DupEnsembleCmdRep(
/*
*----------------------------------------------------------------------
*
- * StringOfEnsembleCmdRep --
- *
- * Creates a string representation of a Tcl_Obj that holds a subcommand
- * of an ensemble.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The object gains a string (UTF-8) representation.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-StringOfEnsembleCmdRep(
- Tcl_Obj *objPtr)
-{
- EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
- int length = strlen(ensembleCmd->fullSubcmdName);
-
- objPtr->length = length;
- objPtr->bytes = ckalloc(length + 1);
- memcpy(objPtr->bytes, ensembleCmd->fullSubcmdName, (unsigned) length+1);
-}
-
-/*
- *----------------------------------------------------------------------
- *
* TclCompileEnsemble --
*
* Procedure called to compile an ensemble command. Note that most
--
cgit v0.12
From 76d0eb32fc60d020bd820d306a71680d4830d7ea Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 12 May 2016 20:23:23 +0000
Subject: Don't see why the intrep should make and keep copies of things
already stored in the hash table.
---
generic/tclEnsemble.c | 37 ++++++++++---------------------------
generic/tclIndexObj.c | 6 ++++--
generic/tclInt.h | 8 +++-----
3 files changed, 17 insertions(+), 34 deletions(-)
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index ead96a3..986b7c1 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -30,8 +30,7 @@ static int NsEnsembleStringOrder(const void *strPtr1,
const void *strPtr2);
static void DeleteEnsembleConfig(ClientData clientData);
static void MakeCachedEnsembleCommand(Tcl_Obj *objPtr,
- EnsembleConfig *ensemblePtr,
- const char *subcmdName, Tcl_Obj *prefixObjPtr);
+ EnsembleConfig *ensemblePtr, Tcl_HashEntry *hPtr);
static void FreeEnsembleCmdRep(Tcl_Obj *objPtr);
static void DupEnsembleCmdRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
static void CompileToInvokedCommand(Tcl_Interp *interp,
@@ -1708,7 +1707,7 @@ NsEnsembleImplementationCmdNR(
if (ensembleCmd->epoch == ensemblePtr->epoch &&
ensembleCmd->token == ensemblePtr->token) {
- prefixObj = ensembleCmd->realPrefixObj;
+ prefixObj = Tcl_GetHashValue(ensembleCmd->hPtr);
Tcl_IncrRefCount(prefixObj);
goto runResultingSubcommand;
}
@@ -1726,16 +1725,13 @@ NsEnsembleImplementationCmdNR(
hPtr = Tcl_FindHashEntry(&ensemblePtr->subcommandTable,
TclGetString(objv[1 + ensemblePtr->numParameters]));
if (hPtr != NULL) {
- char *fullName = Tcl_GetHashKey(&ensemblePtr->subcommandTable, hPtr);
-
- prefixObj = Tcl_GetHashValue(hPtr);
/*
* Cache for later in the subcommand object.
*/
MakeCachedEnsembleCommand(objv[1 + ensemblePtr->numParameters],
- ensemblePtr, fullName, prefixObj);
+ ensemblePtr, hPtr);
} else if (!(ensemblePtr->flags & TCL_ENSEMBLE_PREFIX)) {
/*
* Could not map, no prefixing, go to unknown/error handling.
@@ -1797,16 +1793,16 @@ NsEnsembleImplementationCmdNR(
Tcl_Panic("full name %s not found in supposedly synchronized hash",
fullName);
}
- prefixObj = Tcl_GetHashValue(hPtr);
/*
* Cache for later in the subcommand object.
*/
MakeCachedEnsembleCommand(objv[1 + ensemblePtr->numParameters],
- ensemblePtr, fullName, prefixObj);
+ ensemblePtr, hPtr);
}
+ prefixObj = Tcl_GetHashValue(hPtr);
Tcl_IncrRefCount(prefixObj);
runResultingSubcommand:
@@ -2216,16 +2212,12 @@ static void
MakeCachedEnsembleCommand(
Tcl_Obj *objPtr,
EnsembleConfig *ensemblePtr,
- const char *subcommandName,
- Tcl_Obj *prefixObjPtr)
+ Tcl_HashEntry *hPtr)
{
register EnsembleCmdRep *ensembleCmd;
- int length;
if (objPtr->typePtr == &tclEnsembleCmdType) {
ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
- Tcl_DecrRefCount(ensembleCmd->realPrefixObj);
- ckfree(ensembleCmd->fullSubcmdName);
} else {
/*
* Kill the old internal rep, and replace it with a brand new one of
@@ -2244,11 +2236,8 @@ MakeCachedEnsembleCommand(
ensembleCmd->epoch = ensemblePtr->epoch;
ensembleCmd->token = ensemblePtr->token;
- ensembleCmd->realPrefixObj = prefixObjPtr;
- length = strlen(subcommandName)+1;
- ensembleCmd->fullSubcmdName = ckalloc(length);
- memcpy(ensembleCmd->fullSubcmdName, subcommandName, (unsigned) length);
- Tcl_IncrRefCount(ensembleCmd->realPrefixObj);
+ ensembleCmd->tablePtr = &ensemblePtr->subcommandTable;
+ ensembleCmd->hPtr = hPtr;
}
/*
@@ -2629,8 +2618,6 @@ FreeEnsembleCmdRep(
{
EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
- Tcl_DecrRefCount(ensembleCmd->realPrefixObj);
- ckfree(ensembleCmd->fullSubcmdName);
ckfree(ensembleCmd);
objPtr->typePtr = NULL;
}
@@ -2660,17 +2647,13 @@ DupEnsembleCmdRep(
{
EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
EnsembleCmdRep *ensembleCopy = ckalloc(sizeof(EnsembleCmdRep));
- int length = strlen(ensembleCmd->fullSubcmdName);
copyPtr->typePtr = &tclEnsembleCmdType;
copyPtr->internalRep.twoPtrValue.ptr1 = ensembleCopy;
ensembleCopy->epoch = ensembleCmd->epoch;
ensembleCopy->token = ensembleCmd->token;
- ensembleCopy->realPrefixObj = ensembleCmd->realPrefixObj;
- Tcl_IncrRefCount(ensembleCopy->realPrefixObj);
- ensembleCopy->fullSubcmdName = ckalloc(length + 1);
- memcpy(ensembleCopy->fullSubcmdName, ensembleCmd->fullSubcmdName,
- (unsigned) length+1);
+ ensembleCopy->tablePtr = ensembleCmd->tablePtr;
+ ensembleCopy->hPtr = ensembleCmd->hPtr;
}
/*
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index ce8b9fb..d01e685 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -961,7 +961,7 @@ Tcl_WrongNumArgs(
register EnsembleCmdRep *ecrPtr =
origObjv[i]->internalRep.twoPtrValue.ptr1;
- elementStr = ecrPtr->fullSubcmdName;
+ elementStr = Tcl_GetHashKey(ecrPtr->tablePtr, ecrPtr->hPtr);
elemLen = strlen(elementStr);
} else {
elementStr = TclGetStringFromObj(origObjv[i], &elemLen);
@@ -1014,8 +1014,10 @@ Tcl_WrongNumArgs(
} else if (objv[i]->typePtr == &tclEnsembleCmdType) {
register EnsembleCmdRep *ecrPtr =
objv[i]->internalRep.twoPtrValue.ptr1;
+ const char *fullSubcmdName
+ = Tcl_GetHashKey(ecrPtr->tablePtr, ecrPtr->hPtr);
- Tcl_AppendStringsToObj(objPtr, ecrPtr->fullSubcmdName, NULL);
+ Tcl_AppendStringsToObj(objPtr, fullSubcmdName, NULL);
} else {
/*
* Quote the argument if it contains spaces (Bug 942757).
diff --git a/generic/tclInt.h b/generic/tclInt.h
index e00c392..48eecce 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -400,11 +400,9 @@ typedef struct {
* ensemble. */
Tcl_Command token; /* Reference to the comamnd for which this
* structure is a cache of the resolution. */
- char *fullSubcmdName; /* The full (local) name of the subcommand,
- * allocated with ckalloc(). */
- Tcl_Obj *realPrefixObj; /* Object containing the prefix words of the
- * command that implements this ensemble
- * subcommand. */
+ Tcl_HashTable *tablePtr; /* The subcommand hash table. */
+ Tcl_HashEntry *hPtr; /* Direct link to entry in the subcommand
+ * hash table. */
} EnsembleCmdRep;
/*
--
cgit v0.12
From 286034431cf12b592ab2d79d9573006d4d8fd9bf Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 1 Jul 2016 12:21:15 +0000
Subject: Use the utility routines to eliminate the last bit of intrusion into
the ensembleRewrite area.
---
generic/tclProc.c | 12 +++++-------
1 file changed, 5 insertions(+), 7 deletions(-)
diff --git a/generic/tclProc.c b/generic/tclProc.c
index b663caf..ae9e7cd 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -1087,12 +1087,10 @@ ProcWrongNumArgs(
if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1);
} else {
- ((Interp *) interp)->ensembleRewrite.numInsertedObjs -= skip - 1;
-
#ifdef AVOID_HACKS_FOR_ITCL
desiredObjs[0] = framePtr->objv[skip-1];
#else
- desiredObjs[0] = Tcl_NewListObj(skip, framePtr->objv);
+ desiredObjs[0] = Tcl_NewListObj(1, framePtr->objv + skip - 1);
#endif /* AVOID_HACKS_FOR_ITCL */
}
Tcl_IncrRefCount(desiredObjs[0]);
@@ -1527,6 +1525,10 @@ InitArgsAndLocals(
*/
incorrectArgs:
+ if ((skip != 1) &&
+ TclInitRewriteEnsemble(interp, skip-1, 0, framePtr->objv)) {
+ TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
+ }
memset(varPtr, 0,
((framePtr->compiledLocals + localCt)-varPtr) * sizeof(Var));
return ProcWrongNumArgs(interp, skip);
@@ -2716,10 +2718,6 @@ TclNRApplyObjCmd(
extraPtr->efi.fields[0].clientData = lambdaPtr;
extraPtr->cmd.clientData = &extraPtr->efi;
- if (TclInitRewriteEnsemble(interp, 1, 0, objv)) {
- TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
- }
-
result = TclPushProcCallFrame(procPtr, interp, objc, objv, 1);
if (result == TCL_OK) {
TclNRAddCallback(interp, ApplyNR2, extraPtr, NULL, NULL, NULL);
--
cgit v0.12
From 680d1a1513ba885fd976e2ee52f6572fe9bf5b9f Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 1 Jul 2016 13:20:37 +0000
Subject: Disable special hacks for Itcl 3 ensemble error message generation.
Migration paths are in place to bring this to an end.
---
generic/tclInt.h | 13 +++++++++++++
tests/indexObj.test | 2 +-
2 files changed, 14 insertions(+), 1 deletion(-)
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 49a299c..85981d9 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -26,6 +26,19 @@
#undef ACCEPT_NAN
/*
+ * In Tcl 8.7, stop supporting special hacks for legacy Itcl 3.
+ * Itcl 4 doesn't need them. Itcl 3 can be updated to not need them
+ * using the Tcl(Init|Reset)RewriteEnsemble() routines in all Tcl 8.6+
+ * releases. Perhaps Tcl 8.7 will add even better public interfaces
+ * supporting all the re-invocation mechanisms extensions like Itcl 3
+ * need. As an absolute last resort, folks who must make Itcl 3 work
+ * unchanged with Tcl 8.7 can remove this line to regain the migration
+ * support. Tcl 9 will no longer offer even that option.
+ */
+
+#define AVOID_HACKS_FOR_ITCL 1
+
+/*
* Common include files needed by most of the Tcl source files are included
* here, so that system-dependent personalizations for the include files only
* have to be made in once place. This results in a few extra includes, but
diff --git a/tests/indexObj.test b/tests/indexObj.test
index 646cb02..126d062 100644
--- a/tests/indexObj.test
+++ b/tests/indexObj.test
@@ -109,7 +109,7 @@ test indexObj-5.6 {Tcl_WrongNumArgs} testindexobj {
} "wrong # args: should be \"mycmd foo\""
# Contrast this with test proc-3.6; they have to be like this because
# of [Bug 1066837] so Itcl won't break.
-test indexObj-5.7 {Tcl_WrongNumArgs} testindexobj {
+test indexObj-5.7 {Tcl_WrongNumArgs} {testindexobj obsolete} {
testwrongnumargs 2 "fee fi" "fo fum" foo bar
} "wrong # args: should be \"fo fum foo fee fi\""
--
cgit v0.12
From 38e85a2dbe88be11991f14a59ef71dcd65d5ad05 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 1 Jul 2016 13:32:19 +0000
Subject: Use same internal representation for unicode strings in test-cases
than in reality, in order to prevent surprises.
---
generic/tclTestObj.c | 10 ++--------
1 file changed, 2 insertions(+), 8 deletions(-)
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index f36b07f..a637498 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -19,6 +19,7 @@
#endif
#include "tclInt.h"
#include "tommath.h"
+#include "tclStringRep.h"
/*
@@ -46,13 +47,6 @@ static int TestobjCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int TeststringobjCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
-
-typedef struct TestString {
- int numChars;
- int allocated;
- int maxChars;
- Tcl_UniChar unicode[2];
-} TestString;
#define VARPTR_KEY "TCLOBJTEST_VARPTR"
#define NUMBER_OF_OBJECT_VARS 20
@@ -1141,7 +1135,7 @@ TeststringobjCmd(
int varIndex, option, i, length;
#define MAX_STRINGS 11
const char *index, *string, *strings[MAX_STRINGS+1];
- TestString *strPtr;
+ String *strPtr;
Tcl_Obj **varPtr;
static const char *const options[] = {
"append", "appendstrings", "get", "get2", "length", "length2",
--
cgit v0.12
From ced0d271ff9645626db1764b4de4739ef2b8bdc2 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 1 Jul 2016 14:08:22 +0000
Subject: Encapsulate the fetching of the ensemble rewrite root, used by
[namespace].
---
generic/tclEnsemble.c | 34 ++++++++++++++++++++++++++++++++++
generic/tclInt.h | 2 ++
generic/tclNamesp.c | 19 ++-----------------
3 files changed, 38 insertions(+), 17 deletions(-)
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index fd2fa67..4e06518 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -2030,6 +2030,40 @@ TclResetRewriteEnsemble(
iPtr->ensembleRewrite.numInsertedObjs = 0;
}
}
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFetchEnsembleRoot --
+ *
+ * Returns the root of ensemble rewriting, if any.
+ * If no root exists, returns objv instead.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *const *
+TclFetchEnsembleRoot(
+ Tcl_Interp *interp,
+ Tcl_Obj *const *objv,
+ int objc,
+ int *objcPtr)
+{
+ Interp *iPtr = (Interp *) interp;
+
+ if (iPtr->ensembleRewrite.sourceObjs) {
+ *objcPtr = objc + iPtr->ensembleRewrite.numRemovedObjs
+ - iPtr->ensembleRewrite.numInsertedObjs;
+ return iPtr->ensembleRewrite.sourceObjs;
+ }
+ *objcPtr = objc;
+ return objv;
+}
/*
* ----------------------------------------------------------------------
diff --git a/generic/tclInt.h b/generic/tclInt.h
index a985206..b3cfc00 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2905,6 +2905,8 @@ MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr,
MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr,
Tcl_DString *toAppendPtr);
MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr);
+MODULE_SCOPE Tcl_Obj *const * TclFetchEnsembleRoot(Tcl_Interp *interp,
+ Tcl_Obj *const *objv, int objc, int *objcPtr);
MODULE_SCOPE void TclFinalizeAllocSubsystem(void);
MODULE_SCOPE void TclFinalizeAsync(void);
MODULE_SCOPE void TclFinalizeDoubleConversion(void);
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 58a86d9..2c50a60 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -3354,14 +3354,7 @@ NRNamespaceEvalCmd(
(void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
namespacePtr, /*isProcCallFrame*/ 0);
- if (iPtr->ensembleRewrite.sourceObjs == NULL) {
- framePtr->objc = objc;
- framePtr->objv = objv;
- } else {
- framePtr->objc = objc + iPtr->ensembleRewrite.numRemovedObjs
- - iPtr->ensembleRewrite.numInsertedObjs;
- framePtr->objv = iPtr->ensembleRewrite.sourceObjs;
- }
+ framePtr->objv = TclFetchEnsembleRoot(interp, objv, objc, &framePtr->objc);
if (objc == 3) {
/*
@@ -3768,7 +3761,6 @@ NRNamespaceInscopeCmd(
{
Tcl_Namespace *namespacePtr;
CallFrame *framePtr, **framePtrPtr;
- register Interp *iPtr = (Interp *) interp;
int i;
Tcl_Obj *cmdObjPtr;
@@ -3794,14 +3786,7 @@ NRNamespaceInscopeCmd(
(void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
namespacePtr, /*isProcCallFrame*/ 0);
- if (iPtr->ensembleRewrite.sourceObjs == NULL) {
- framePtr->objc = objc;
- framePtr->objv = objv;
- } else {
- framePtr->objc = objc + iPtr->ensembleRewrite.numRemovedObjs
- - iPtr->ensembleRewrite.numInsertedObjs;
- framePtr->objv = iPtr->ensembleRewrite.sourceObjs;
- }
+ framePtr->objv = TclFetchEnsembleRoot(interp, objv, objc, &framePtr->objc);
/*
* Execute the command. If there is just one argument, just treat it as a
--
cgit v0.12
From a67b58390be01aa89a2ec3cb100ad5040fb6cdd1 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 1 Jul 2016 14:11:38 +0000
Subject: Make test-case "for.test" pass, regardless of end-of-line spacing
---
tests/for.test | 38 +++++++++++++++++++-------------------
1 file changed, 19 insertions(+), 19 deletions(-)
diff --git a/tests/for.test b/tests/for.test
index 8e701d6..c8a8187 100644
--- a/tests/for.test
+++ b/tests/for.test
@@ -451,7 +451,7 @@ proc formatMail {} {
set c [string length $line]
}
}
- set newline [string range $line 0 $c]
+ set newline [string trimright [string range $line 0 $c]]
if {! $continuation} {
append result $newline $NL
} else {
@@ -507,7 +507,7 @@ releases of the Tcl scripting language and the Tk toolk
it. The first beta versions of these
releases were released on August 30, 1996. These releas
es contain only minor changes,
-so we hope to have only a single beta release and to
+so we hope to have only a single beta release and to
go final in early October, 1996.
@@ -519,34 +519,34 @@ and changes files in the distributions for more complet
e information on what has
changed, including both feature changes and bug fixes.
- There are new options to the file command for
+ There are new options to the file command for
copying files (file copy),
- deleting files and directories (file delete),
+ deleting files and directories (file delete),
creating directories (file
mkdir), and renaming files (file rename).
The implementation of exec has been improved great
ly for Windows 95 and
Windows NT.
- There is a new memory allocator for the Macintosh
+ There is a new memory allocator for the Macintosh
version, which should be
more efficient than the old one.
- Tk's grid geometry manager has been completely
+ Tk's grid geometry manager has been completely
rewritten. The layout
algorithm produces much better layouts than before
, especially where rows or
columns were stretchable.
- There are new commands for creating common dialog
+ There are new commands for creating common dialog
boxes:
tk_chooseColor, tk_getOpenFile, tk_getSaveFile and
- tk_messageBox. These use native dialog boxes if
+ tk_messageBox. These use native dialog boxes if
they are available.
There is a new virtual event mechanism for handlin
g events in a more portable
- way. See the new command event. It also allows
+ way. See the new command event. It also allows
events (both physical and
virtual) to be generated dynamically.
-Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl
+Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl
7.5 and Tk 4.1 except for
changes in the C APIs for custom channel drivers. Scrip
ts written for earlier releases
@@ -556,27 +556,27 @@ Obtaining The Releases
Binary Releases
-Pre-compiled releases are available for the following
+Pre-compiled releases are available for the following
platforms:
Windows 3.1, Windows 95, and Windows NT: Fetch
- ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then
+ ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then
execute it. The file is a
- self-extracting executable. It will install the
+ self-extracting executable. It will install the
Tcl and Tk libraries, the wish and
tclsh programs, and documentation.
Macintosh (both 68K and PowerPC): Fetch
- ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx.
+ ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx.
The file is in binhex format,
- which is understood by Fetch, StuffIt, and many
+ which is understood by Fetch, StuffIt, and many
other Mac utilities. The
- unpacked file is a self-installing executable:
+ unpacked file is a self-installing executable:
double-click on it and it will create a
- folder containing all that you need to run Tcl
+ folder containing all that you need to run Tcl
and Tk.
- UNIX (Solaris 2.* and SunOS, other systems
+ UNIX (Solaris 2.* and SunOS, other systems
soon to follow). Easy to install
- binary packages are now for sale at the Sun Labs
+ binary packages are now for sale at the Sun Labs
Tcl/Tk Shop. Check it out!
}
--
cgit v0.12
From e95143affd22d28ce4a9e1edff4b6e5728605027 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 1 Jul 2016 18:54:36 +0000
Subject: [4402cfa58c] Rework the spell check machinery into something that
will not be foiled by value sharing.
---
generic/tclEnsemble.c | 186 ++++++++++++++++++++++++++++++++++++++++++++------
generic/tclIndexObj.c | 21 +++---
generic/tclInt.h | 5 +-
3 files changed, 177 insertions(+), 35 deletions(-)
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 4e06518..75c2747 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -30,7 +30,8 @@ static int NsEnsembleStringOrder(const void *strPtr1,
const void *strPtr2);
static void DeleteEnsembleConfig(ClientData clientData);
static void MakeCachedEnsembleCommand(Tcl_Obj *objPtr,
- EnsembleConfig *ensemblePtr, Tcl_HashEntry *hPtr);
+ EnsembleConfig *ensemblePtr, Tcl_HashEntry *hPtr,
+ Tcl_Obj *fix);
static void FreeEnsembleCmdRep(Tcl_Obj *objPtr);
static void DupEnsembleCmdRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
static void CompileToInvokedCommand(Tcl_Interp *interp,
@@ -1641,6 +1642,8 @@ NsEnsembleImplementationCmdNR(
* names. */
int reparseCount = 0; /* Number of reparses. */
Tcl_Obj *errorObj; /* Used for building error messages. */
+ Tcl_Obj *subObj;
+ int subIdx;
/*
* Must recheck objc, since numParameters might have changed. Cf. test
@@ -1648,7 +1651,8 @@ NsEnsembleImplementationCmdNR(
*/
restartEnsembleParse:
- if (objc < 2 + ensemblePtr->numParameters) {
+ subIdx = 1 + ensemblePtr->numParameters;
+ if (objc < subIdx + 1) {
/*
* We don't have a subcommand argument. Make error message.
*/
@@ -1693,6 +1697,8 @@ NsEnsembleImplementationCmdNR(
* up in there and go straight to dispatch.
*/
+ subObj = objv[subIdx];
+
if (ensemblePtr->epoch == ensemblePtr->nsPtr->exportLookupEpoch) {
/*
* Table of subcommands is still valid; therefore there might be a
@@ -1701,14 +1707,16 @@ NsEnsembleImplementationCmdNR(
* part where we do the invocation of the subcommand.
*/
- if (objv[1+ensemblePtr->numParameters]->typePtr==&tclEnsembleCmdType){
- EnsembleCmdRep *ensembleCmd = objv[1+ensemblePtr->numParameters]
- ->internalRep.twoPtrValue.ptr1;
+ if (subObj->typePtr==&tclEnsembleCmdType){
+ EnsembleCmdRep *ensembleCmd = subObj->internalRep.twoPtrValue.ptr1;
if (ensembleCmd->epoch == ensemblePtr->epoch &&
ensembleCmd->token == ensemblePtr->token) {
prefixObj = Tcl_GetHashValue(ensembleCmd->hPtr);
Tcl_IncrRefCount(prefixObj);
+ if (ensembleCmd->fix) {
+ TclSpellFix(interp, objv, objc, subIdx, subObj, ensembleCmd->fix);
+ }
goto runResultingSubcommand;
}
}
@@ -1723,15 +1731,14 @@ NsEnsembleImplementationCmdNR(
*/
hPtr = Tcl_FindHashEntry(&ensemblePtr->subcommandTable,
- TclGetString(objv[1 + ensemblePtr->numParameters]));
+ TclGetString(subObj));
if (hPtr != NULL) {
/*
* Cache for later in the subcommand object.
*/
- MakeCachedEnsembleCommand(objv[1 + ensemblePtr->numParameters],
- ensemblePtr, hPtr);
+ MakeCachedEnsembleCommand(subObj, ensemblePtr, hPtr, NULL);
} else if (!(ensemblePtr->flags & TCL_ENSEMBLE_PREFIX)) {
/*
* Could not map, no prefixing, go to unknown/error handling.
@@ -1751,9 +1758,9 @@ NsEnsembleImplementationCmdNR(
char *fullName = NULL; /* Full name of the subcommand. */
int stringLength, i;
int tableLength = ensemblePtr->subcommandTable.numEntries;
+ Tcl_Obj *fix;
- subcmdName = TclGetString(objv[1 + ensemblePtr->numParameters]);
- stringLength = objv[1 + ensemblePtr->numParameters]->length;
+ subcmdName = Tcl_GetStringFromObj(subObj, &stringLength);
for (i=0 ; i<tableLength ; i++) {
register int cmp = strncmp(subcmdName,
ensemblePtr->subcommandArrayPtr[i],
@@ -1795,11 +1802,17 @@ NsEnsembleImplementationCmdNR(
}
/*
+ * Record the spelling correction for usage message.
+ */
+
+ fix = Tcl_NewStringObj(fullName, -1);
+
+ /*
* Cache for later in the subcommand object.
*/
- MakeCachedEnsembleCommand(objv[1 + ensemblePtr->numParameters],
- ensemblePtr, hPtr);
+ MakeCachedEnsembleCommand(subObj, ensemblePtr, hPtr, fix);
+ TclSpellFix(interp, objv, objc, subIdx, subObj, fix);
}
prefixObj = Tcl_GetHashValue(hPtr);
@@ -1912,20 +1925,17 @@ NsEnsembleImplementationCmdNR(
Tcl_ResetResult(interp);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
- TclGetString(objv[1+ensemblePtr->numParameters]), NULL);
+ TclGetString(subObj), NULL);
if (ensemblePtr->subcommandTable.numEntries == 0) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"unknown subcommand \"%s\": namespace %s does not"
- " export any commands",
- TclGetString(objv[1+ensemblePtr->numParameters]),
+ " export any commands", TclGetString(subObj),
ensemblePtr->nsPtr->fullName));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
- TclGetString(objv[1+ensemblePtr->numParameters]), NULL);
return TCL_ERROR;
}
errorObj = Tcl_ObjPrintf("unknown%s subcommand \"%s\": must be ",
(ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? " or ambiguous" : ""),
- TclGetString(objv[1+ensemblePtr->numParameters]));
+ TclGetString(subObj));
if (ensemblePtr->subcommandTable.numEntries == 1) {
Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0], -1);
} else {
@@ -2030,6 +2040,127 @@ TclResetRewriteEnsemble(
iPtr->ensembleRewrite.numInsertedObjs = 0;
}
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSpellFix --
+ *
+ * Record a spelling correction that needs making in the
+ * generation of the WrongNumArgs usage message.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Can create an alternative ensemble rewrite structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FreeER(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Tcl_Obj **tmp = (Tcl_Obj **)data[0];
+
+ ckfree(tmp[2]);
+ ckfree(tmp);
+ return result;
+}
+
+static int
+FreeObj(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Tcl_Obj *objPtr = (Tcl_Obj *)data[0];
+
+ Tcl_DecrRefCount(objPtr);
+ return result;
+}
+
+void
+TclSpellFix(
+ Tcl_Interp *interp,
+ Tcl_Obj *const *objv,
+ int objc,
+ int badIdx,
+ Tcl_Obj *bad,
+ Tcl_Obj *fix)
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_Obj *const *search;
+ Tcl_Obj **store;
+ int idx;
+ int size;
+
+ if (iPtr->ensembleRewrite.sourceObjs == NULL) {
+ iPtr->ensembleRewrite.sourceObjs = objv;
+ iPtr->ensembleRewrite.numRemovedObjs = 0;
+ iPtr->ensembleRewrite.numInsertedObjs = 0;
+ }
+
+ /* Compute the valid length of the ensemble root */
+
+ size = iPtr->ensembleRewrite.numRemovedObjs + objc
+ - iPtr->ensembleRewrite.numInsertedObjs;
+
+ search = iPtr->ensembleRewrite.sourceObjs;
+ if (search[0] == NULL) {
+ /* Awful casting abuse here */
+ search = (Tcl_Obj *const *) search[1];
+ }
+
+ if (badIdx < iPtr->ensembleRewrite.numInsertedObjs) {
+ /*
+ * Misspelled value was inserted. We cannot directly jump
+ * to the bad value, but have to search.
+ */
+ idx = 1;
+ while (idx < size) {
+ if (search[idx] == bad) {
+ break;
+ }
+ idx++;
+ }
+ if (idx == size) {
+ return;
+ }
+ } else {
+ /* Jump to the misspelled value. */
+ idx = iPtr->ensembleRewrite.numRemovedObjs + badIdx
+ - iPtr->ensembleRewrite.numInsertedObjs;
+
+ /* Verify */
+ if (search[idx] != bad) {
+ Tcl_Panic("SpellFix: programming error");
+ }
+ }
+
+ search = iPtr->ensembleRewrite.sourceObjs;
+ if (search[0] == NULL) {
+ store = (Tcl_Obj **)search[2];
+ } else {
+ Tcl_Obj **tmp = ckalloc(3 * sizeof(Tcl_Obj *));
+ tmp[0] = NULL;
+ tmp[1] = (Tcl_Obj *)iPtr->ensembleRewrite.sourceObjs;
+ tmp[2] = (Tcl_Obj *)ckalloc(size * sizeof(Tcl_Obj *));
+ memcpy(tmp[2], tmp[1], size*sizeof(Tcl_Obj *));
+
+ iPtr->ensembleRewrite.sourceObjs = (Tcl_Obj *const *) tmp;
+ TclNRAddCallback(interp, FreeER, tmp, NULL, NULL, NULL);
+ store = (Tcl_Obj **)tmp[2];
+ }
+
+ store[idx] = fix;
+ Tcl_IncrRefCount(fix);
+ TclNRAddCallback(interp, FreeObj, fix, NULL, NULL, NULL);
+}
+
/*
*----------------------------------------------------------------------
*
@@ -2230,12 +2361,16 @@ static void
MakeCachedEnsembleCommand(
Tcl_Obj *objPtr,
EnsembleConfig *ensemblePtr,
- Tcl_HashEntry *hPtr)
+ Tcl_HashEntry *hPtr,
+ Tcl_Obj *fix)
{
register EnsembleCmdRep *ensembleCmd;
if (objPtr->typePtr == &tclEnsembleCmdType) {
ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
+ if (ensembleCmd->fix) {
+ Tcl_DecrRefCount(ensembleCmd->fix);
+ }
} else {
/*
* Kill the old internal rep, and replace it with a brand new one of
@@ -2254,7 +2389,10 @@ MakeCachedEnsembleCommand(
ensembleCmd->epoch = ensemblePtr->epoch;
ensembleCmd->token = ensemblePtr->token;
- ensembleCmd->tablePtr = &ensemblePtr->subcommandTable;
+ if (fix) {
+ Tcl_IncrRefCount(fix);
+ }
+ ensembleCmd->fix = fix;
ensembleCmd->hPtr = hPtr;
}
@@ -2636,6 +2774,9 @@ FreeEnsembleCmdRep(
{
EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
+ if (ensembleCmd->fix) {
+ Tcl_DecrRefCount(ensembleCmd->fix);
+ }
ckfree(ensembleCmd);
objPtr->typePtr = NULL;
}
@@ -2670,7 +2811,10 @@ DupEnsembleCmdRep(
copyPtr->internalRep.twoPtrValue.ptr1 = ensembleCopy;
ensembleCopy->epoch = ensembleCmd->epoch;
ensembleCopy->token = ensembleCmd->token;
- ensembleCopy->tablePtr = ensembleCmd->tablePtr;
+ ensembleCopy->fix = ensembleCmd->fix;
+ if (ensembleCopy->fix) {
+ Tcl_IncrRefCount(ensembleCopy->fix);
+ }
ensembleCopy->hPtr = ensembleCmd->hPtr;
}
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index d01e685..0e0ddc9 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -925,6 +925,14 @@ Tcl_WrongNumArgs(
Tcl_Obj *const *origObjv = iPtr->ensembleRewrite.sourceObjs;
/*
+ * Check for spelling fixes, and substitute the fixed values.
+ */
+
+ if (origObjv[0] == NULL) {
+ origObjv = (Tcl_Obj *const *)origObjv[2];
+ }
+
+ /*
* We only know how to do rewriting if all the replaced objects are
* actually arguments (in objv) to this function. Otherwise it just
* gets too complicated and we'd be better off just giving a slightly
@@ -957,12 +965,6 @@ Tcl_WrongNumArgs(
elementStr = EXPAND_OF(indexRep);
elemLen = strlen(elementStr);
- } else if (origObjv[i]->typePtr == &tclEnsembleCmdType) {
- register EnsembleCmdRep *ecrPtr =
- origObjv[i]->internalRep.twoPtrValue.ptr1;
-
- elementStr = Tcl_GetHashKey(ecrPtr->tablePtr, ecrPtr->hPtr);
- elemLen = strlen(elementStr);
} else {
elementStr = TclGetStringFromObj(origObjv[i], &elemLen);
}
@@ -1011,13 +1013,6 @@ Tcl_WrongNumArgs(
register IndexRep *indexRep = objv[i]->internalRep.twoPtrValue.ptr1;
Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL);
- } else if (objv[i]->typePtr == &tclEnsembleCmdType) {
- register EnsembleCmdRep *ecrPtr =
- objv[i]->internalRep.twoPtrValue.ptr1;
- const char *fullSubcmdName
- = Tcl_GetHashKey(ecrPtr->tablePtr, ecrPtr->hPtr);
-
- Tcl_AppendStringsToObj(objPtr, fullSubcmdName, NULL);
} else {
/*
* Quote the argument if it contains spaces (Bug 942757).
diff --git a/generic/tclInt.h b/generic/tclInt.h
index b3cfc00..03b648d 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -401,7 +401,7 @@ typedef struct {
* ensemble. */
Tcl_Command token; /* Reference to the comamnd for which this
* structure is a cache of the resolution. */
- Tcl_HashTable *tablePtr; /* The subcommand hash table. */
+ Tcl_Obj *fix; /* Corrected spelling, if needed. */
Tcl_HashEntry *hPtr; /* Direct link to entry in the subcommand
* hash table. */
} EnsembleCmdRep;
@@ -3109,6 +3109,9 @@ MODULE_SCOPE void TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr);
MODULE_SCOPE void TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr,
Tcl_Obj *newValue, Tcl_Encoding encoding);
MODULE_SCOPE void TclSignalExitThread(Tcl_ThreadId id, int result);
+MODULE_SCOPE void TclSpellFix(Tcl_Interp *interp,
+ Tcl_Obj *const *objv, int objc, int subIdx,
+ Tcl_Obj *bad, Tcl_Obj *fix);
MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr,
int numBytes);
MODULE_SCOPE int TclStringMatch(const char *str, int strLen,
--
cgit v0.12
From d5617720bbdc0bf0c9ac6ac04512a418c8029ad4 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 1 Jul 2016 19:16:56 +0000
Subject: Add some tests
---
tests/namespace.test | 46 ++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 46 insertions(+)
diff --git a/tests/namespace.test b/tests/namespace.test
index 2ba695a..c433241 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -2107,6 +2107,52 @@ test namespace-50.4 {chained ensembles affect error messages} -body {
rename a {}
rename c {}
}
+test namespace-50.5 {[4402cfa58c]} -setup {
+ proc bar {ev} {}
+ proc bingo {xx} {}
+ namespace ensemble create -command launch -map {foo bar event bingo}
+ set result {}
+} -body {
+ catch {launch foo} m; lappend result $m
+ catch {launch ev} m; lappend result $m
+ catch {launch foo} m; lappend result $m
+} -cleanup {
+ rename launch {}
+ rename bingo {}
+ rename bar {}
+} -result {{wrong # args: should be "launch foo ev"} {wrong # args: should be "launch event xx"} {wrong # args: should be "launch foo ev"}}
+test namespace-50.6 {[4402cfa58c]} -setup {
+ proc target {x y} {}
+ namespace ensemble create -command e2 -map {s2 target}
+ namespace ensemble create -command e1 -map {s1 e2}
+ set result {}
+} -body {
+ set s s
+ catch {e1 s1 s2 a} m; lappend result $m
+ catch {e1 $s s2 a} m; lappend result $m
+ catch {e1 s1 $s a} m; lappend result $m
+ catch {e1 $s $s a} m; lappend result $m
+} -cleanup {
+ rename e1 {}
+ rename e2 {}
+ rename target {}
+} -result {{wrong # args: should be "e1 s1 s2 x y"} {wrong # args: should be "e1 s1 s2 x y"} {wrong # args: should be "e1 s1 s2 x y"} {wrong # args: should be "e1 s1 s2 x y"}}
+test namespace-50.7 {[4402cfa58c]} -setup {
+ proc target {x y} {}
+ namespace ensemble create -command e2 -map {s2 target}
+ namespace ensemble create -command e1 -map {s1 e2} -parameters foo
+ set result {}
+} -body {
+ set s s
+ catch {e1 s2 s1 a} m; lappend result $m
+ catch {e1 $s s1 a} m; lappend result $m
+ catch {e1 s2 $s a} m; lappend result $m
+ catch {e1 $s $s a} m; lappend result $m
+} -cleanup {
+ rename e1 {}
+ rename e2 {}
+ rename target {}
+} -result {{wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"}}
test namespace-51.1 {name resolution path control} -body {
namespace eval ::test_ns_1 {
--
cgit v0.12
From 42c2792287c6b609265be758ddb3779e40aa350f Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 1 Jul 2016 19:42:38 +0000
Subject: The EnsembleCmdRep struct that is the internal rep for caching
ensemble dispatches and spelling corrections can now be file static.
---
generic/tclEnsemble.c | 26 +++++++++++++++++++++-----
generic/tclInt.h | 17 -----------------
2 files changed, 21 insertions(+), 22 deletions(-)
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 75c2747..5c47ce3 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -76,7 +76,7 @@ enum EnsConfigOpts {
* that implements it.
*/
-const Tcl_ObjType tclEnsembleCmdType = {
+static const Tcl_ObjType ensembleCmdType = {
"ensembleCommand", /* the type's name */
FreeEnsembleCmdRep, /* freeIntRepProc */
DupEnsembleCmdRep, /* dupIntRepProc */
@@ -84,6 +84,22 @@ const Tcl_ObjType tclEnsembleCmdType = {
NULL /* setFromAnyProc */
};
+/*
+ * The internal rep for caching ensemble subcommand lookups and
+ * spell corrections.
+ */
+
+typedef struct {
+ int epoch; /* Used to confirm when the data in this
+ * really structure matches up with the
+ * ensemble. */
+ Tcl_Command token; /* Reference to the comamnd for which this
+ * structure is a cache of the resolution. */
+ Tcl_Obj *fix; /* Corrected spelling, if needed. */
+ Tcl_HashEntry *hPtr; /* Direct link to entry in the subcommand
+ * hash table. */
+} EnsembleCmdRep;
+
static inline Tcl_Obj *
NewNsObj(
@@ -1707,7 +1723,7 @@ NsEnsembleImplementationCmdNR(
* part where we do the invocation of the subcommand.
*/
- if (subObj->typePtr==&tclEnsembleCmdType){
+ if (subObj->typePtr==&ensembleCmdType){
EnsembleCmdRep *ensembleCmd = subObj->internalRep.twoPtrValue.ptr1;
if (ensembleCmd->epoch == ensemblePtr->epoch &&
@@ -2366,7 +2382,7 @@ MakeCachedEnsembleCommand(
{
register EnsembleCmdRep *ensembleCmd;
- if (objPtr->typePtr == &tclEnsembleCmdType) {
+ if (objPtr->typePtr == &ensembleCmdType) {
ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
if (ensembleCmd->fix) {
Tcl_DecrRefCount(ensembleCmd->fix);
@@ -2380,7 +2396,7 @@ MakeCachedEnsembleCommand(
TclFreeIntRep(objPtr);
ensembleCmd = ckalloc(sizeof(EnsembleCmdRep));
objPtr->internalRep.twoPtrValue.ptr1 = ensembleCmd;
- objPtr->typePtr = &tclEnsembleCmdType;
+ objPtr->typePtr = &ensembleCmdType;
}
/*
@@ -2807,7 +2823,7 @@ DupEnsembleCmdRep(
EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
EnsembleCmdRep *ensembleCopy = ckalloc(sizeof(EnsembleCmdRep));
- copyPtr->typePtr = &tclEnsembleCmdType;
+ copyPtr->typePtr = &ensembleCmdType;
copyPtr->internalRep.twoPtrValue.ptr1 = ensembleCopy;
ensembleCopy->epoch = ensembleCmd->epoch;
ensembleCopy->token = ensembleCmd->token;
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 03b648d..fba4c7b 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -390,23 +390,6 @@ struct NamespacePathEntry {
#define TCL_FIND_ONLY_NS 0x1000
/*
- * The data cached in an ensemble subcommand's Tcl_Obj rep (reference in
- * twoPtrValue.ptr1 field). This structure is not shared between Tcl_Objs
- * referring to the same subcommand, even where one is a duplicate of another.
- */
-
-typedef struct {
- int epoch; /* Used to confirm when the data in this
- * really structure matches up with the
- * ensemble. */
- Tcl_Command token; /* Reference to the comamnd for which this
- * structure is a cache of the resolution. */
- Tcl_Obj *fix; /* Corrected spelling, if needed. */
- Tcl_HashEntry *hPtr; /* Direct link to entry in the subcommand
- * hash table. */
-} EnsembleCmdRep;
-
-/*
* The client data for an ensemble command. This consists of the table of
* commands that are actually exported by the namespace, and an epoch counter
* that, combined with the exportLookupEpoch field of the namespace structure,
--
cgit v0.12
From dd879c794d6af3bab4cfb8b36708db2fc70b5f46 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Sat, 2 Jul 2016 17:21:53 +0000
Subject: [f961d7d1dd] Repair usage message for ensemble parameters with
spaces.
---
generic/tclEnsemble.c | 13 +++----------
tests/namespace.test | 9 +++++++++
2 files changed, 12 insertions(+), 10 deletions(-)
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 5c47ce3..a86b5c4 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -1674,18 +1674,11 @@ NsEnsembleImplementationCmdNR(
*/
Tcl_DString buf; /* Message being built */
- Tcl_Obj **elemPtrs; /* Parameter names */
- int len; /* Number of parameters to append */
Tcl_DStringInit(&buf);
- if (ensemblePtr->parameterList == NULL) {
- len = 0;
- } else if (TclListObjGetElements(NULL, ensemblePtr->parameterList,
- &len, &elemPtrs) != TCL_OK) {
- Tcl_Panic("List of ensemble parameters is not a list");
- }
- for (; len>0; len--,elemPtrs++) {
- TclDStringAppendObj(&buf, *elemPtrs);
+ if (ensemblePtr->parameterList) {
+ Tcl_DStringAppend(&buf,
+ TclGetString(ensemblePtr->parameterList), -1);
TclDStringAppendLiteral(&buf, " ");
}
TclDStringAppendLiteral(&buf, "subcommand ?arg ...?");
diff --git a/tests/namespace.test b/tests/namespace.test
index c433241..dc1d3bf 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -2153,6 +2153,15 @@ test namespace-50.7 {[4402cfa58c]} -setup {
rename e2 {}
rename target {}
} -result {{wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"}}
+test namespace-50.8 {[f961d7d1dd]} -setup {
+ proc target {} {}
+ namespace ensemble create -command e -map {s target} -parameters {{a b}}
+} -body {
+ e
+} -returnCodes error -result {wrong # args: should be "e {a b} subcommand ?arg ...?"} -cleanup {
+ rename e {}
+ rename target {}
+}
test namespace-51.1 {name resolution path control} -body {
namespace eval ::test_ns_1 {
--
cgit v0.12
From 65bd912b775ebf56f5c549e4a7f8387768369d3b Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Sat, 2 Jul 2016 17:55:51 +0000
Subject: [09fabeb1fd] test subdirs in sorted order.
---
library/tcltest/tcltest.tcl | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index 169b7d4..f1ce970 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -2709,7 +2709,7 @@ proc tcltest::GetMatchingDirectories {rootdir} {
DebugPuts 1 "No test directories remain after applying match\
and skip patterns!"
}
- return $matchDirs
+ return [lsort $matchDirs]
}
# tcltest::runAllTests --
--
cgit v0.12
From 1694cf05a6ed1ecf937f9551f73cf21f26c2005e Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Sun, 3 Jul 2016 14:09:45 +0000
Subject: Use conventional list operations for ensemble dispatch.
---
generic/tclEnsemble.c | 57 +++++++++++++++++++++------------------------------
1 file changed, 23 insertions(+), 34 deletions(-)
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index a86b5c4..17ab35b 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -41,6 +41,9 @@ static int CompileBasicNArgCommand(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
CompileEnv *envPtr);
+static Tcl_NRPostProc FreeObj;
+static Tcl_NRPostProc FreeER;
+
/*
* The lists of subcommands and options for the [namespace ensemble] command.
*/
@@ -1843,45 +1846,31 @@ NsEnsembleImplementationCmdNR(
*/
{
- Tcl_Obj **prefixObjv; /* The list of objects to substitute in as the
- * target command prefix. */
Tcl_Obj *copyPtr; /* The actual list of words to dispatch to.
* Will be freed by the dispatch engine. */
- int prefixObjc, copyObjc;
+ int prefixObjc;
+
+ Tcl_ListObjLength(NULL, prefixObj, &prefixObjc);
+ if (0 && objc == 2) {
/*
- * Get the prefix that we're rewriting to. To do this we need to
- * ensure that the internal representation of the list does not change
- * so that we can safely keep the internal representations of the
- * elements in the list.
- *
- * TODO: Use conventional list operations to make this code sane!
+ * TODO: This branch is disabled because it botches or exposes
+ * something wrong with nested ensemble usage messages. See
+ * tests oo-16.1 and oo-17.1
*/
-
- TclListObjGetElements(NULL, prefixObj, &prefixObjc, &prefixObjv);
-
- copyObjc = objc - 2 + prefixObjc;
- copyPtr = Tcl_NewListObj(copyObjc, NULL);
- if (copyObjc > 0) {
- register Tcl_Obj **copyObjv;
- /* Space used to construct the list of
- * arguments to pass to the command that
- * implements the ensemble subcommand. */
- register List *listRepPtr = copyPtr->internalRep.twoPtrValue.ptr1;
- register int i;
-
- listRepPtr->elemCount = copyObjc;
- copyObjv = &listRepPtr->elements;
- memcpy(copyObjv, prefixObjv, sizeof(Tcl_Obj *) * prefixObjc);
- memcpy(copyObjv+prefixObjc, objv+1,
- sizeof(Tcl_Obj *) * ensemblePtr->numParameters);
- memcpy(copyObjv+prefixObjc+ensemblePtr->numParameters,
- objv+ensemblePtr->numParameters+2,
- sizeof(Tcl_Obj *) * (objc-ensemblePtr->numParameters-2));
-
- for (i=0; i < copyObjc; i++) {
- Tcl_IncrRefCount(copyObjv[i]);
- }
+ copyPtr = prefixObj;
+ Tcl_IncrRefCount(copyPtr);
+ TclNRAddCallback(interp, FreeObj, copyPtr, NULL, NULL, NULL);
+ } else {
+ int copyObjc = objc - 2 + prefixObjc;
+
+ copyPtr = Tcl_NewListObj(copyObjc, NULL);
+ Tcl_ListObjAppendList(NULL, copyPtr, prefixObj);
+ Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
+ ensemblePtr->numParameters, objv+1);
+ Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
+ objc - 2 - ensemblePtr->numParameters,
+ objv + 2 + ensemblePtr->numParameters);
}
TclDecrRefCount(prefixObj);
--
cgit v0.12
From 21124cf6abc8a0ac00190db611ac07f66432eafc Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Mon, 4 Jul 2016 08:18:53 +0000
Subject: Add ability to disassemble TclOO constructors and destructors
([1493a43044] motivates)
---
generic/tclDisassemble.c | 135 ++++++++++++++++++++++++++++++++++++++++++++++-
tests/compile.test | 99 +++++++++++++++++++++++++++++++++-
2 files changed, 232 insertions(+), 2 deletions(-)
diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c
index c85fe13..1d616fb 100644
--- a/generic/tclDisassemble.c
+++ b/generic/tclDisassemble.c
@@ -6,7 +6,7 @@
*
* Copyright (c) 1996-1998 Sun Microsystems, Inc.
* Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
- * Copyright (c) 2013 Donal K. Fellows.
+ * Copyright (c) 2013-2016 Donal K. Fellows.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -1279,9 +1279,11 @@ Tcl_DisassembleObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
static const char *const types[] = {
+ "constructor", "destructor",
"lambda", "method", "objmethod", "proc", "script", NULL
};
enum Types {
+ DISAS_CLASS_CONSTRUCTOR, DISAS_CLASS_DESTRUCTOR,
DISAS_LAMBDA, DISAS_CLASS_METHOD, DISAS_OBJECT_METHOD, DISAS_PROC,
DISAS_SCRIPT
};
@@ -1290,6 +1292,7 @@ Tcl_DisassembleObjCmd(
Proc *procPtr = NULL;
Tcl_HashEntry *hPtr;
Object *oPtr;
+ Method *methodPtr;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "type ...");
@@ -1384,6 +1387,136 @@ Tcl_DisassembleObjCmd(
codeObjPtr = objv[2];
break;
+ case DISAS_CLASS_CONSTRUCTOR:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "className");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Look up the body of a constructor.
+ */
+
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (oPtr->classPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" is not a class", TclGetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
+ TclGetString(objv[2]), NULL);
+ return TCL_ERROR;
+ }
+
+ methodPtr = oPtr->classPtr->constructorPtr;
+ if (methodPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" has no defined constructor",
+ TclGetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
+ "CONSRUCTOR", NULL);
+ return TCL_ERROR;
+ }
+ procPtr = TclOOGetProcFromMethod(methodPtr);
+ if (procPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "body not available for this kind of constructor", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
+ "METHODTYPE", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Compile if necessary.
+ */
+
+ if (procPtr->bodyPtr->typePtr != &tclByteCodeType) {
+ Command cmd;
+
+ /*
+ * Yes, this is ugly, but we need to pass the namespace in to the
+ * compiler in two places.
+ */
+
+ cmd.nsPtr = (Namespace *) oPtr->namespacePtr;
+ procPtr->cmdPtr = &cmd;
+ result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr,
+ (Namespace *) oPtr->namespacePtr, "body of constructor",
+ TclGetString(objv[2]));
+ procPtr->cmdPtr = NULL;
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+ codeObjPtr = procPtr->bodyPtr;
+ break;
+
+ case DISAS_CLASS_DESTRUCTOR:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "className");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Look up the body of a destructor.
+ */
+
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (oPtr->classPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" is not a class", TclGetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
+ TclGetString(objv[2]), NULL);
+ return TCL_ERROR;
+ }
+
+ methodPtr = oPtr->classPtr->destructorPtr;
+ if (methodPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" has no defined destructor",
+ TclGetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
+ "DESRUCTOR", NULL);
+ return TCL_ERROR;
+ }
+ procPtr = TclOOGetProcFromMethod(methodPtr);
+ if (procPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "body not available for this kind of destructor", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
+ "METHODTYPE", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Compile if necessary.
+ */
+
+ if (procPtr->bodyPtr->typePtr != &tclByteCodeType) {
+ Command cmd;
+
+ /*
+ * Yes, this is ugly, but we need to pass the namespace in to the
+ * compiler in two places.
+ */
+
+ cmd.nsPtr = (Namespace *) oPtr->namespacePtr;
+ procPtr->cmdPtr = &cmd;
+ result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr,
+ (Namespace *) oPtr->namespacePtr, "body of destructor",
+ TclGetString(objv[2]));
+ procPtr->cmdPtr = NULL;
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+ codeObjPtr = procPtr->bodyPtr;
+ break;
+
case DISAS_CLASS_METHOD:
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "className methodName");
diff --git a/tests/compile.test b/tests/compile.test
index bb12050..f021cf2 100644
--- a/tests/compile.test
+++ b/tests/compile.test
@@ -678,7 +678,7 @@ test compile-17.2 {Command interpretation binding for non-compiled code} -setup
# change without warning.
set disassemblables [linsert [join {
- lambda method objmethod proc script
+ constructor destructor lambda method objmethod proc script
} ", "] end-1 or]
test compile-18.1 {disassembler - basics} -returnCodes error -body {
tcl::unsupported::disassemble
@@ -872,6 +872,103 @@ test compile-18.39 {disassembler - basics} -setup {
} -cleanup {
foo destroy
} -result "$bytecodekeys initiallinenumber sourcefile"
+test compile-18.40 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble constructor
+} -match glob -result {wrong # args: should be "* constructor className"}
+test compile-18.41 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble constructor nosuchclass
+} -result {nosuchclass does not refer to an object}
+test compile-18.42 {disassembler - basics} -returnCodes error -setup {
+ oo::object create justanobject
+} -body {
+ tcl::unsupported::disassemble constructor justanobject
+} -cleanup {
+ justanobject destroy
+} -result {"justanobject" is not a class}
+test compile-18.43 {disassembler - basics} -returnCodes error -setup {
+ oo::class create constructorless
+} -body {
+ tcl::unsupported::disassemble constructor constructorless
+} -cleanup {
+ constructorless destroy
+} -result {"constructorless" has no defined constructor}
+test compile-18.44 {disassembler - basics} -setup {
+ oo::class create foo {constructor {} {set x 1}}
+} -body {
+ # Allow any string: the result format is not defined anywhere!
+ tcl::unsupported::disassemble constructor foo
+} -cleanup {
+ foo destroy
+} -match glob -result *
+test compile-18.45 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::getbytecode constructor
+} -match glob -result {wrong # args: should be "* constructor className"}
+test compile-18.46 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::getbytecode constructor nosuchobject
+} -result {nosuchobject does not refer to an object}
+test compile-18.47 {disassembler - basics} -returnCodes error -setup {
+ oo::class create constructorless
+} -body {
+ tcl::unsupported::getbytecode constructor constructorless
+} -cleanup {
+ constructorless destroy
+} -result {"constructorless" has no defined constructor}
+test compile-18.48 {disassembler - basics} -setup {
+ oo::class create foo {constructor {} {set x 1}}
+} -body {
+ dict keys [tcl::unsupported::getbytecode constructor foo]
+} -cleanup {
+ foo destroy
+} -result "$bytecodekeys"
+# There is no compile-18.49
+test compile-18.50 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble destructor
+} -match glob -result {wrong # args: should be "* destructor className"}
+test compile-18.51 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble destructor nosuchclass
+} -result {nosuchclass does not refer to an object}
+test compile-18.52 {disassembler - basics} -returnCodes error -setup {
+ oo::object create justanobject
+} -body {
+ tcl::unsupported::disassemble destructor justanobject
+} -cleanup {
+ justanobject destroy
+} -result {"justanobject" is not a class}
+test compile-18.53 {disassembler - basics} -returnCodes error -setup {
+ oo::class create constructorless
+} -body {
+ tcl::unsupported::disassemble destructor constructorless
+} -cleanup {
+ constructorless destroy
+} -result {"constructorless" has no defined destructor}
+test compile-18.54 {disassembler - basics} -setup {
+ oo::class create foo {destructor {set x 1}}
+} -body {
+ # Allow any string: the result format is not defined anywhere!
+ tcl::unsupported::disassemble destructor foo
+} -cleanup {
+ foo destroy
+} -match glob -result *
+test compile-18.55 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::getbytecode destructor
+} -match glob -result {wrong # args: should be "* destructor className"}
+test compile-18.56 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::getbytecode destructor nosuchobject
+} -result {nosuchobject does not refer to an object}
+test compile-18.57 {disassembler - basics} -returnCodes error -setup {
+ oo::class create constructorless
+} -body {
+ tcl::unsupported::getbytecode destructor constructorless
+} -cleanup {
+ constructorless destroy
+} -result {"constructorless" has no defined destructor}
+test compile-18.58 {disassembler - basics} -setup {
+ oo::class create foo {destructor {set x 1}}
+} -body {
+ dict keys [tcl::unsupported::getbytecode destructor foo]
+} -cleanup {
+ foo destroy
+} -result "$bytecodekeys"
test compile-19.0 {Bug 3614102: reset stack housekeeping} -body {
# This will panic in a --enable-symbols=compile build, unless bug is fixed.
--
cgit v0.12
From 23c3438aee355e038599c0df4a175bc53b658b27 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 4 Jul 2016 08:36:41 +0000
Subject: typo and end-of-line spacing
---
doc/SetResult.3 | 2 +-
generic/tclEnsemble.c | 10 +++++-----
2 files changed, 6 insertions(+), 6 deletions(-)
diff --git a/doc/SetResult.3 b/doc/SetResult.3
index dc8f487..e5b81d7 100644
--- a/doc/SetResult.3
+++ b/doc/SetResult.3
@@ -164,7 +164,7 @@ The source interpreter will have its result reset by this operation.
.SH "DEPRECATED INTERFACES"
.SS "OLD STRING PROCEDURES"
.PP
-Use of the following procedures (is deprecated
+Use of the following procedures is deprecated
since they manipulate the Tcl result as a string.
Procedures such as \fBTcl_SetObjResult\fR
that manipulate the result as a value
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 17ab35b..6489dea 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -1866,9 +1866,9 @@ NsEnsembleImplementationCmdNR(
copyPtr = Tcl_NewListObj(copyObjc, NULL);
Tcl_ListObjAppendList(NULL, copyPtr, prefixObj);
- Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
+ Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
ensemblePtr->numParameters, objv+1);
- Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
+ Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
objc - 2 - ensemblePtr->numParameters,
objv + 2 + ensemblePtr->numParameters);
}
@@ -2044,7 +2044,7 @@ TclResetRewriteEnsemble(
*
* TclSpellFix --
*
- * Record a spelling correction that needs making in the
+ * Record a spelling correction that needs making in the
* generation of the WrongNumArgs usage message.
*
* Results:
@@ -2104,7 +2104,7 @@ TclSpellFix(
/* Compute the valid length of the ensemble root */
- size = iPtr->ensembleRewrite.numRemovedObjs + objc
+ size = iPtr->ensembleRewrite.numRemovedObjs + objc
- iPtr->ensembleRewrite.numInsertedObjs;
search = iPtr->ensembleRewrite.sourceObjs;
@@ -2366,7 +2366,7 @@ MakeCachedEnsembleCommand(
if (objPtr->typePtr == &ensembleCmdType) {
ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
- if (ensembleCmd->fix) {
+ if (ensembleCmd->fix) {
Tcl_DecrRefCount(ensembleCmd->fix);
}
} else {
--
cgit v0.12
From bf33e5524befd15b5037709edb5f05d8e2f2b753 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 4 Jul 2016 20:39:43 +0000
Subject: Fixup the ensemble rewrite conversions.
---
generic/tclEnsemble.c | 7 +------
generic/tclExecute.c | 2 --
2 files changed, 1 insertion(+), 8 deletions(-)
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 17ab35b..11ec3fc 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -1852,12 +1852,7 @@ NsEnsembleImplementationCmdNR(
Tcl_ListObjLength(NULL, prefixObj, &prefixObjc);
- if (0 && objc == 2) {
- /*
- * TODO: This branch is disabled because it botches or exposes
- * something wrong with nested ensemble usage messages. See
- * tests oo-16.1 and oo-17.1
- */
+ if (objc == 2) {
copyPtr = prefixObj;
Tcl_IncrRefCount(copyPtr);
TclNRAddCallback(interp, FreeObj, copyPtr, NULL, NULL, NULL);
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 355b667..1389382 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2081,8 +2081,6 @@ TclNRExecuteByteCode(
* Push the callback for bytecode execution
*/
- TclResetRewriteEnsemble(interp, 1);
-
TclNRAddCallback(interp, TEBCresume, TD, /* pc */ NULL,
/* cleanup */ INT2PTR(0), NULL);
return TCL_OK;
--
cgit v0.12