diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2023-08-31 11:17:23 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2023-08-31 11:17:23 (GMT) |
commit | f0ea214c57459a16eaa686227c785defd8e00ea8 (patch) | |
tree | 6efea9805da61373fd9b85dc007add36fb1959e9 /generic/tclTest.c | |
parent | 209b8d0bde085c41388ae13dbea251ba4dc81749 (diff) | |
download | tcl-f0ea214c57459a16eaa686227c785defd8e00ea8.zip tcl-f0ea214c57459a16eaa686227c785defd8e00ea8.tar.gz tcl-f0ea214c57459a16eaa686227c785defd8e00ea8.tar.bz2 |
Backport some test improvements from 9.0
Diffstat (limited to 'generic/tclTest.c')
-rw-r--r-- | generic/tclTest.c | 29 |
1 files changed, 17 insertions, 12 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c index ef9997a..83dad7d 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -236,10 +236,7 @@ static Tcl_ResolveCompiledVarProc InterpCompiledVarResolver; static void MainLoop(void); static Tcl_CmdProc NoopCmd; static Tcl_ObjCmdProc NoopObjCmd; -static int ObjTraceProc(void *clientData, - Tcl_Interp *interp, int level, const char *command, - Tcl_Command commandToken, int objc, - Tcl_Obj *const objv[]); +static Tcl_CmdObjTraceProc ObjTraceProc; static void ObjTraceDeleteProc(void *clientData); static void PrintParse(Tcl_Interp *interp, Tcl_Parse *parsePtr); static void SpecialFree(char *blockPtr); @@ -1170,6 +1167,8 @@ TestcmdinfoObjCmd( Tcl_AppendResult(interp, " stringProc", NULL); } else if (info.isNativeObjectProc == 1) { Tcl_AppendResult(interp, " nativeObjectProc", NULL); + } else if (info.isNativeObjectProc == 2) { + Tcl_AppendResult(interp, " nativeObjectProc2", NULL); } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf("Invalid isNativeObjectProc value %d", info.isNativeObjectProc)); @@ -1302,7 +1301,7 @@ TestcmdtokenCmd( return TCL_ERROR; } if (strcmp(argv[1], "create") == 0) { - refPtr = (TestCommandTokenRef *)Tcl_Alloc(sizeof(TestCommandTokenRef)); + refPtr = (TestCommandTokenRef *)ckalloc(sizeof(TestCommandTokenRef)); refPtr->token = Tcl_CreateCommand(interp, argv[2], CmdProc0, refPtr, CmdDelProc0); refPtr->id = nextCommandTokenRefId; @@ -1509,10 +1508,10 @@ static int ObjTraceProc( TCL_UNUSED(void *), Tcl_Interp *interp, /* Tcl interpreter */ - TCL_UNUSED(int) /*level*/, + TCL_UNUSED(int) /* level */, const char *command, TCL_UNUSED(Tcl_Command), - TCL_UNUSED(int) /*objc*/, + TCL_UNUSED(int) /* objc */, Tcl_Obj *const objv[]) /* Argument objects. */ { const char *word = Tcl_GetString(objv[0]); @@ -5727,7 +5726,10 @@ TestbytestringObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - Tcl_Size n = 0; + struct { + Tcl_Size n; + int m; /* This variable should not be overwritten */ + } x = {0, 1}; const char *p; if (objc != 2) { @@ -5735,11 +5737,15 @@ TestbytestringObjCmd( return TCL_ERROR; } - p = (const char *)Tcl_GetBytesFromObj(interp, objv[1], &n); + p = (const char *)Tcl_GetBytesFromObj(interp, objv[1], &x.n); if (p == NULL) { return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(p, n)); + if (x.m != 1) { + Tcl_AppendResult(interp, "Tcl_GetBytesFromObj() overwrites variable", NULL); + return TCL_ERROR; + } + Tcl_SetObjResult(interp, Tcl_NewStringObj(p, x.n)); return TCL_OK; } @@ -8656,7 +8662,7 @@ MyCompiledVarFetch( } hPtr = Tcl_CreateHashEntry((Tcl_HashTable *) &iPtr->globalNsPtr->varTable, - (char *) resVarInfo->nameObj, &isNewVar); + (char *)resVarInfo->nameObj, &isNewVar); if (hPtr) { var = (Tcl_Var) TclVarHashGetValue(hPtr); } else { @@ -8825,4 +8831,3 @@ int TestApplyLambdaObjCmd ( * indent-tabs-mode: nil * End: */ - |