From 6eb16ed6ae6ad7ca151a65f021563aa2ad56d611 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 4 Apr 2024 20:43:08 +0000 Subject: Fix [7cb7409e05] by backporting tclIndexObj.c from [c3b23bf0c7] --- generic/tclIndexObj.c | 119 +++++++++++++++++++++++++------------------------- tests/indexObj.test | 6 +-- 2 files changed, 63 insertions(+), 62 deletions(-) diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index c024b60..5738bbf 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -25,15 +25,9 @@ static int GetIndexFromObjList(Tcl_Interp *interp, static void UpdateStringOfIndex(Tcl_Obj *objPtr); static void DupIndex(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr); static void FreeIndex(Tcl_Obj *objPtr); -static int PrefixAllObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int PrefixLongestObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int PrefixMatchObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); +static Tcl_ObjCmdProc PrefixAllObjCmd; +static Tcl_ObjCmdProc PrefixLongestObjCmd; +static Tcl_ObjCmdProc PrefixMatchObjCmd; static void PrintUsage(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable); @@ -172,10 +166,11 @@ GetIndexFromObjList( const char *msg, /* Identifying word to use in error * messages. */ int flags, /* 0 or TCL_EXACT */ - int *indexPtr) /* Place to store resulting integer index. */ + int *indexPtr) /* Place to store resulting index. */ { - int objc, result, t; + int objc, t; + int result; Tcl_Obj **objv; const char **tablePtr; @@ -205,7 +200,7 @@ GetIndexFromObjList( return TCL_OK; } - tablePtr[t] = Tcl_GetString(objv[t]); + tablePtr[t] = TclGetString(objv[t]); } tablePtr[objc] = NULL; @@ -373,26 +368,26 @@ Tcl_GetIndexFromObjStruct( } Tcl_AppendStringsToObj(resultPtr, (numAbbrev>1 && !(flags & TCL_EXACT) ? "ambiguous " : "bad "), - msg, " \"", key, NULL); + msg, " \"", key, (char *)NULL); if (*entryPtr == NULL) { - Tcl_AppendStringsToObj(resultPtr, "\": no valid options", NULL); + Tcl_AppendStringsToObj(resultPtr, "\": no valid options", (char *)NULL); } else { Tcl_AppendStringsToObj(resultPtr, "\": must be ", - *entryPtr, NULL); + *entryPtr, (char *)NULL); entryPtr = NEXT_ENTRY(entryPtr, offset); while (*entryPtr != NULL) { if (*NEXT_ENTRY(entryPtr, offset) == NULL) { Tcl_AppendStringsToObj(resultPtr, (count > 0 ? "," : ""), - " or ", *entryPtr, NULL); + " or ", *entryPtr, (char *)NULL); } else if (**entryPtr) { - Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr, NULL); + Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr, (char *)NULL); count++; } entryPtr = NEXT_ENTRY(entryPtr, offset); } } Tcl_SetObjResult(interp, resultPtr); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", msg, key, NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", msg, key, (char *)NULL); } return TCL_ERROR; } @@ -545,7 +540,7 @@ PrefixMatchObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { int flags = 0, result, index; - int dummyLength, i, errorLength; + int dummyLength, errorLength, i; Tcl_Obj *errorPtr = NULL; const char *message = "option"; Tcl_Obj *tablePtr, *objPtr, *resultPtr; @@ -562,8 +557,8 @@ PrefixMatchObjCmd( } for (i = 1; i < (objc - 2); i++) { - if (Tcl_GetIndexFromObj(interp, objv[i], matchOptions, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], matchOptions, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum matchOptionsEnum) index) { @@ -574,17 +569,17 @@ PrefixMatchObjCmd( if (i > objc-4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "missing value for -message", -1)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", (char *)NULL); return TCL_ERROR; } i++; - message = Tcl_GetString(objv[i]); + message = TclGetString(objv[i]); break; case PRFMATCH_ERROR: if (i > objc-4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "missing value for -error", -1)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", (char *)NULL); return TCL_ERROR; } i++; @@ -596,7 +591,7 @@ PrefixMatchObjCmd( Tcl_SetObjResult(interp, Tcl_NewStringObj( "error options must have an even number of elements", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", (char *)NULL); return TCL_ERROR; } errorPtr = objv[i]; @@ -668,7 +663,8 @@ PrefixAllObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int tableObjc, result, t, length, elemLength; + int result; + int length, elemLength, tableObjc, t; const char *string, *elemString; Tcl_Obj **tableObjv, *resultPtr; @@ -682,10 +678,10 @@ PrefixAllObjCmd( return result; } resultPtr = Tcl_NewListObj(0, NULL); - string = Tcl_GetStringFromObj(objv[2], &length); + string = TclGetStringFromObj(objv[2], &length); for (t = 0; t < tableObjc; t++) { - elemString = Tcl_GetStringFromObj(tableObjv[t], &elemLength); + elemString = TclGetStringFromObj(tableObjv[t], &elemLength); /* * A prefix cannot match if it is longest. @@ -725,7 +721,8 @@ PrefixLongestObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int tableObjc, result, i, t, length, elemLength, resultLength; + int result; + int i, length, elemLength, resultLength, tableObjc, t; const char *string, *elemString, *resultString; Tcl_Obj **tableObjv; @@ -738,13 +735,13 @@ PrefixLongestObjCmd( if (result != TCL_OK) { return result; } - string = Tcl_GetStringFromObj(objv[2], &length); + string = TclGetStringFromObj(objv[2], &length); resultString = NULL; resultLength = 0; for (t = 0; t < tableObjc; t++) { - elemString = Tcl_GetStringFromObj(tableObjv[t], &elemLength); + elemString = TclGetStringFromObj(tableObjv[t], &elemLength); /* * First check if the prefix string matches the element. A prefix @@ -850,7 +847,7 @@ Tcl_WrongNumArgs( Tcl_Obj *objPtr; int i, len, elemLen; char flags; - Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *)interp; const char *elementStr; /* @@ -914,7 +911,7 @@ Tcl_WrongNumArgs( objc -= toSkip; /* - * We assume no object is of index type. + * Assume no object is of index type. */ for (i=0 ; itypePtr == &indexType) { IndexRep *indexRep = - origObjv[i]->internalRep.twoPtrValue.ptr1; + (IndexRep *)origObjv[i]->internalRep.twoPtrValue.ptr1; elementStr = EXPAND_OF(indexRep); elemLen = strlen(elementStr); @@ -952,8 +949,8 @@ Tcl_WrongNumArgs( * moderately complex condition here). */ - if (itypePtr == &indexType) { - IndexRep *indexRep = objv[i]->internalRep.twoPtrValue.ptr1; + IndexRep *indexRep = (IndexRep *)objv[i]->internalRep.twoPtrValue.ptr1; - Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL); + Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), (char *)NULL); } else { /* * Quote the argument if it contains spaces (Bug 942757). @@ -1003,8 +1000,8 @@ Tcl_WrongNumArgs( * (either another element from objv, or the message string). */ - if (i 0) { c = str[1]; } else { @@ -1117,7 +1115,7 @@ Tcl_ParseArgsObjv( } /* - * Loop throught the argument descriptors searching for one with the + * Loop through the argument descriptors searching for one with the * matching key string. If found, leave a pointer to it in matchPtr. */ @@ -1177,7 +1175,7 @@ Tcl_ParseArgsObjv( (int *) infoPtr->dstPtr) == TCL_ERROR) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected integer argument for \"%s\" but got \"%s\"", - infoPtr->keyStr, Tcl_GetString(objv[srcIndex]))); + infoPtr->keyStr, TclGetString(objv[srcIndex]))); goto error; } srcIndex++; @@ -1188,7 +1186,7 @@ Tcl_ParseArgsObjv( goto missingArg; } *((const char **) infoPtr->dstPtr) = - Tcl_GetString(objv[srcIndex]); + TclGetString(objv[srcIndex]); srcIndex++; objc--; break; @@ -1210,7 +1208,7 @@ Tcl_ParseArgsObjv( (double *) infoPtr->dstPtr) == TCL_ERROR) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected floating-point argument for \"%s\" but got \"%s\"", - infoPtr->keyStr, Tcl_GetString(objv[srcIndex]))); + infoPtr->keyStr, TclGetString(objv[srcIndex]))); goto error; } srcIndex++; @@ -1236,10 +1234,13 @@ Tcl_ParseArgsObjv( Tcl_ArgvGenFuncProc *handlerProc = (Tcl_ArgvGenFuncProc *) infoPtr->srcPtr; - objc = handlerProc(infoPtr->clientData, interp, objc, + gf_ret = handlerProc(infoPtr->clientData, interp, objc, &objv[srcIndex], infoPtr->dstPtr); - if (objc < 0) { + if (gf_ret < 0) { goto error; + } else { + srcIndex += gf_ret; + objc -= gf_ret; } break; } @@ -1420,8 +1421,8 @@ TclGetCompletionCodeFromObj( && TclGetIntFromObj(NULL, value, codePtr) == TCL_OK) { return TCL_OK; } - if (Tcl_GetIndexFromObj(NULL, value, returnCodes, NULL, TCL_EXACT, - codePtr) == TCL_OK) { + if (Tcl_GetIndexFromObjStruct(NULL, value, returnCodes, + sizeof(char *), NULL, TCL_EXACT, codePtr) == TCL_OK) { return TCL_OK; } @@ -1434,7 +1435,7 @@ TclGetCompletionCodeFromObj( "bad completion code \"%s\": must be" " ok, error, return, break, continue, or an integer", TclGetString(value))); - Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_CODE", NULL); + Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_CODE", (char *)NULL); } return TCL_ERROR; } diff --git a/tests/indexObj.test b/tests/indexObj.test index 4ff1a6f..bf9a434 100644 --- a/tests/indexObj.test +++ b/tests/indexObj.test @@ -169,13 +169,13 @@ test indexObj-7.7 {Tcl_ParseArgsObjv memory management} testparseargs { test indexObj-7.8 {Tcl_ParseArgsObjv} testparseargs { testparseargs -color Nothing } {0 1 testparseargs Nothing NULL} -test indexObj-7.9 {Tcl_ParseArgsObjv} {testparseargs knownBug} { +test indexObj-7.9 {Tcl_ParseArgsObjv} testparseargs { testparseargs -media A4 } {0 1 testparseargs NULL {Paper size is ISO A4}} -test indexObj-7.10 {Tcl_ParseArgsObjv} {testparseargs knownBug} { +test indexObj-7.10 {Tcl_ParseArgsObjv} testparseargs { testparseargs -media A4 -color Somecolor } {0 1 testparseargs Somecolor {Paper size is ISO A4}} -test indexObj-7.11 {Tcl_ParseArgsObjv} {testparseargs knownBug} { +test indexObj-7.11 {Tcl_ParseArgsObjv} testparseargs { testparseargs -color othercolor -media Letter } {0 1 testparseargs othercolor {Paper size is US Letter}} test indexObj-7.12 {Tcl_ParseArgsObjv} -constraints testparseargs -body { -- cgit v0.12