Index: .github/workflows/linux-build.yml ================================================================== --- .github/workflows/linux-build.yml +++ .github/workflows/linux-build.yml @@ -4,10 +4,11 @@ branches: - "main" - "core-9-1-branch" tags: - "core-*" + workflow_dispatch: permissions: contents: read jobs: plan: runs-on: ubuntu-26.04 Index: .github/workflows/mac-build.yml ================================================================== --- .github/workflows/mac-build.yml +++ .github/workflows/mac-build.yml @@ -4,10 +4,11 @@ branches: - "main" - "core-9-1-branch" tags: - "core-*" + workflow_dispatch: permissions: contents: read jobs: plan: runs-on: ubuntu-26.04 Index: .github/workflows/onefiledist.yml ================================================================== --- .github/workflows/onefiledist.yml +++ .github/workflows/onefiledist.yml @@ -4,10 +4,11 @@ branches: - "main" - "core-9-1-branch" tags: - "core-*" + workflow_dispatch: permissions: contents: read jobs: linux: name: Linux Index: .github/workflows/win-build.yml ================================================================== --- .github/workflows/win-build.yml +++ .github/workflows/win-build.yml @@ -4,10 +4,11 @@ branches: - "main" - "core-9-1-branch" tags: - "core-*" + workflow_dispatch: permissions: contents: read jobs: plan: runs-on: ubuntu-26.04 @@ -17,11 +18,11 @@ steps: - name: Select build matrix based on branch name id: matrix run: | ( - echo msvc=$(jq -nc '{config: (if env.IsMatched == "true" then env.MSVC_FULL else env.MSVC_PARTIAL end) | fromjson }' ) + echo msvc=$(jq -nc '{arch: ["x64"], config: (if env.IsMatched == "true" then env.MSVC_FULL else env.MSVC_PARTIAL end) | fromjson }' ) echo gcc=$(jq -nc '{config: (if env.IsMatched == "true" then env.GCC_FULL else env.GCC_PARTIAL end) | fromjson }' ) ) | tee -a $GITHUB_OUTPUT env: IsMatched: ${{ github.ref_name == 'main' || github.ref_name == 'core-9-1-branch' }} # DO NOT CHANGE THESE MATRIX SPECS; IT AFFECTS OUR COST CONTROLS @@ -68,12 +69,15 @@ steps: - name: Checkout uses: actions/checkout@v7 timeout-minutes: 5 - name: Init MSVC - uses: ilammy/msvc-dev-cmd@v1 - timeout-minutes: 5 + shell: cmd + run: | + for /f "usebackq tokens=*" %%i in (`vswhere -latest -property installationPath`) do set "VS_PATH=%%i" + call "%VS_PATH%\VC\Auxiliary\Build\vcvarsall.bat" ${{ matrix.arch }} + set | findstr /i "^VC ^VCTools ^Windows ^Universal ^INCLUDE ^LIB ^PATH ^DevEnv" >> %GITHUB_ENV% - name: Build ${{ matrix.config }} run: | &nmake -f makefile.vc ${{ matrix.config }} all if ($lastexitcode -ne 0) { throw "nmake exit code: $lastexitcode" Index: generic/tclBasic.c ================================================================== --- generic/tclBasic.c +++ generic/tclBasic.c @@ -439,11 +439,11 @@ {"::tcl::process", tclProcessImplMap, TclSetUpProcessCmd, CMD_IS_SAFE}, {"timer", tclTimerImplMap, NULL, CMD_IS_SAFE}, {"unicode", tclUnicodeImplMap, NULL, CMD_IS_SAFE}, {"zipfs", tclZipfsImplMap, NULL, 0}, {"zlib", tclZlibImplMap, NULL, CMD_IS_SAFE}, - {"::tcl::unsupported::grapheme", tclGraphemeImplMap, NULL, 0}, + {"::tcl::unsupported::grapheme", tclGraphemeImplMap, NULL, CMD_IS_SAFE}, {NULL, NULL, NULL, 0} }; /* * Math functions. All are safe. Index: generic/tclCmdIL.c ================================================================== --- generic/tclCmdIL.c +++ generic/tclCmdIL.c @@ -1359,26 +1359,31 @@ /* * 'proc'. Common to all frame types. Conditional on having an associated * Procedure CallFrame. */ - if (procPtr != NULL) { - Tcl_HashEntry *namePtr = procPtr->cmdPtr->hPtr; + if (procPtr != NULL && procPtr->cmdPtr) { + Command *cmdPtr = procPtr->cmdPtr; + Tcl_HashEntry *namePtr = cmdPtr->hPtr; if (namePtr) { Tcl_Obj *procNameObj; /* * This is a regular command. */ TclNewObj(procNameObj); - Tcl_GetCommandFullName(interp, (Tcl_Command) procPtr->cmdPtr, + Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, procNameObj); ADD_PAIR("proc", procNameObj); - } else if (procPtr->cmdPtr->clientData) { - ExtraFrameInfo *efiPtr = (ExtraFrameInfo *)procPtr->cmdPtr->clientData; + } else if ((procPtr->flags && PROC_CMD_OWNED) && !cmdPtr->objProc2 && + cmdPtr->objClientData2 + ) { + ADD_PAIR("lambda", (Tcl_Obj *)cmdPtr->objClientData2); + } else if (cmdPtr->clientData) { + ExtraFrameInfo *efiPtr = (ExtraFrameInfo *)cmdPtr->clientData; Tcl_Size i; /* * This is a non-standard command. Luckily, it's told us how to * render extra information about its frame. Index: generic/tclDisassemble.c ================================================================== --- generic/tclDisassemble.c +++ generic/tclDisassemble.c @@ -1384,13 +1384,11 @@ return TCL_ERROR; } switch (idx) { case DISAS_LAMBDA: { - Command cmd; Tcl_Obj *nsObjPtr; - Tcl_Namespace *nsPtr; /* * Compile (if uncompiled) and disassemble a lambda term. */ @@ -1402,17 +1400,10 @@ procPtr = TclGetLambdaFromObj(interp, objv[2], &nsObjPtr); if (procPtr == NULL) { return TCL_ERROR; } - memset(&cmd, 0, sizeof(Command)); - result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr); - if (result != TCL_OK) { - return result; - } - cmd.nsPtr = (Namespace *) nsPtr; - procPtr->cmdPtr = &cmd; result = TclPushProcCallFrame(procPtr, interp, objc, objv, 1); if (result != TCL_OK) { return result; } TclPopStackFrame(interp); Index: generic/tclGrapheme.c ================================================================== --- generic/tclGrapheme.c +++ generic/tclGrapheme.c @@ -86,19 +86,19 @@ * Note the list is read-only, so writing will cause shimmer to a native list. */ typedef struct GraphemeListRep { Tcl_Obj *objPtr; /* The target string */ Tcl_Size refCount; /* Shared amongst Tcl_Obj's */ - Tcl_Size graphemeIndex; /* Cached grapheme index */ + Tcl_Size graphemeIndex; /* Cached grapheme index */ Tcl_Size graphemeOffset; /* Corresponding Tcl_UniChar offset */ } GraphemeListRep; static Tcl_DupInternalRepProc GraphemeListDupProc; static Tcl_FreeInternalRepProc GraphemeListFreeProc; static Tcl_ObjTypeLengthProc GraphemeListLengthProc; static Tcl_ObjTypeIndexProc GraphemeListIndexProc; -const Tcl_ObjType tclGraphemeListType = { +static const Tcl_ObjType tclGraphemeListType = { "graphemeList", GraphemeListFreeProc, GraphemeListDupProc, TclAbstractListUpdateString, NULL, /* SetFromAny */ @@ -129,11 +129,11 @@ * None. * *------------------------------------------------------------------------ */ static inline bool -IsPossibleContinuation ( +IsPossibleContinuation( Tcl_UniChar cp) /* Unicode code point */ { /* * https://www.unicode.org/reports/tr29/tr29-47.html */ @@ -172,15 +172,15 @@ * None. * *------------------------------------------------------------------------ */ static inline bool -IsPossiblePrefix ( +IsPossiblePrefix( Tcl_UniChar cp) /* Unicode code point */ { - const utf8proc_property_t *propPtr; - propPtr = utf8proc_get_property(cp); + const utf8proc_property_t *propPtr = utf8proc_get_property(cp); + return propPtr->boundclass == UTF8PROC_BOUNDCLASS_PREPEND || propPtr->boundclass == UTF8PROC_BOUNDCLASS_ZWJ || propPtr->boundclass == UTF8PROC_BOUNDCLASS_REGIONAL_INDICATOR || propPtr->category == UTF8PROC_CATEGORY_MN || propPtr->category == UTF8PROC_CATEGORY_MC @@ -251,12 +251,13 @@ * forward again to skip over the extra scan. */ const Tcl_UniChar *uniStartPtr = uniEndPtr - uniLen; const Tcl_UniChar *uniPtr = uniEndPtr - 1; while (uniPtr > uniStartPtr - && ((*uniPtr == '\n' && uniPtr[-1] == '\r') || - IsPossibleContinuation(*uniPtr) || IsPossiblePrefix(uniPtr[-1]))) { + && ((*uniPtr == '\n' && uniPtr[-1] == '\r') + || IsPossibleContinuation(*uniPtr) + || IsPossiblePrefix(uniPtr[-1]))) { uniPtr--; } /* Now scan forward. Note uniPtr may be < uniStartPtr if uniLen was 0 */ const Tcl_UniChar *grPtr; @@ -279,11 +280,11 @@ * Number of graphemes in the string. * *------------------------------------------------------------------------ */ static Tcl_Size -GraphemeLength ( +GraphemeLength( const Tcl_UniChar *uniPtr, /* Tcl_UniChar string */ Tcl_Size uniLen) /* Number of Tcl_UniChar's in string. -1 if * nul terminated */ { if (uniLen < 0) { @@ -362,18 +363,18 @@ * Modifies interpreter result and variable passed in objv[2]. * *------------------------------------------------------------------------ */ static int -GraphemeNextCmd ( +GraphemeNextCmd( TCL_UNUSED(void *), - Tcl_Interp *interp, /* Current interpreter. */ + Tcl_Interp *interp, /* Current interpreter. */ Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc != 3) { - Tcl_WrongNumArgs(interp, 1, objv, "string strIndex"); + Tcl_WrongNumArgs(interp, 1, objv, "string indexVar"); return TCL_ERROR; } Tcl_Size strIndex = 0; Tcl_Size uniLen; @@ -418,18 +419,18 @@ * Modifies interpreter result and variable passed in objv[2]. * *------------------------------------------------------------------------ */ static int -GraphemePrevCmd ( +GraphemePrevCmd( TCL_UNUSED(void *), - Tcl_Interp *interp, /* Current interpreter. */ + Tcl_Interp *interp, /* Current interpreter. */ Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc != 3) { - Tcl_WrongNumArgs(interp, 1, objv, "string strIndex"); + Tcl_WrongNumArgs(interp, 1, objv, "string indexVar"); return TCL_ERROR; } Tcl_Size uniLen; const Tcl_UniChar *uniStartPtr = Tcl_GetUnicodeFromObj(objv[1], &uniLen); @@ -460,12 +461,13 @@ /* Scan backward to a safe starting point for the forward scan */ const Tcl_UniChar *uniEndPtr = uniStartPtr + strIndex; const Tcl_UniChar *uniPtr = uniEndPtr - 1; while (uniPtr > uniStartPtr - && ((*uniPtr == '\n' && uniPtr[-1] == '\r') || - IsPossibleContinuation(*uniPtr) || IsPossiblePrefix(uniPtr[-1]))) { + && ((*uniPtr == '\n' && uniPtr[-1] == '\r') + || IsPossibleContinuation(*uniPtr) + || IsPossiblePrefix(uniPtr[-1]))) { uniPtr--; } /* Now scan forward. Note uniPtr may be < uniStartPtr if uniLen was 0 */ Tcl_Size grLen = 0; @@ -499,13 +501,13 @@ * Modifies interpreter result. * *------------------------------------------------------------------------ */ static int -GraphemeLengthCmd ( +GraphemeLengthCmd( TCL_UNUSED(void *), - Tcl_Interp *interp, /* Current interpreter. */ + Tcl_Interp *interp, /* Current interpreter. */ Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "string"); @@ -533,11 +535,11 @@ * Modifies interpreter result. * *------------------------------------------------------------------------ */ static int -GraphemeIndexCmd ( +GraphemeIndexCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { @@ -579,11 +581,11 @@ * Modifies interpreter result. * *------------------------------------------------------------------------ */ static int -GraphemeOffsetCmd ( +GraphemeOffsetCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { @@ -626,13 +628,13 @@ * Modifies interpreter result. * *------------------------------------------------------------------------ */ static int -GraphemeRangeCmd ( +GraphemeRangeCmd( TCL_UNUSED(void *), - Tcl_Interp *interp, /* Current interpreter. */ + Tcl_Interp *interp, /* Current interpreter. */ Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "string grFirst grLast"); @@ -666,11 +668,11 @@ rangeLastPtr = GraphemeIndex(rangeFirstPtr, uniLen - (rangeFirstPtr - uniPtr), grLast - grFirst, &lastWidth); assert(rangeLastPtr); resultObj = Tcl_NewUnicodeObj(rangeFirstPtr, - rangeLastPtr - rangeFirstPtr + lastWidth); + rangeLastPtr - rangeFirstPtr + lastWidth); Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* @@ -688,13 +690,13 @@ * Modifies interpreter result. * *------------------------------------------------------------------------ */ static int -GraphemeReverseCmd ( +GraphemeReverseCmd( TCL_UNUSED(void *), - Tcl_Interp *interp, /* Current interpreter. */ + Tcl_Interp *interp, /* Current interpreter. */ Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "string"); @@ -714,17 +716,16 @@ const Tcl_UniChar *uniPtr = Tcl_GetUnicodeFromObj(objv[1], &uniLen); if (uniLen == 0) { return TCL_OK; } const Tcl_UniChar *uniEndPtr = uniPtr + uniLen; - Tcl_UniChar *tempBufPtr - = (Tcl_UniChar *)Tcl_Alloc(uniLen * sizeof(*tempBufPtr)); + Tcl_UniChar *tempBufPtr = (Tcl_UniChar *) + Tcl_Alloc(uniLen * sizeof(*tempBufPtr)); Tcl_UniChar *tempPtr = tempBufPtr + uniLen; for (const Tcl_UniChar *grPtr = uniPtr; uniPtr < uniEndPtr; ) { - Tcl_Size grWidth; uniPtr = GraphemeNext(uniPtr, uniEndPtr - uniPtr); - grWidth = uniPtr - grPtr; + Tcl_Size grWidth = uniPtr - grPtr; tempPtr -= grWidth; assert(tempPtr >= tempBufPtr); memcpy(tempPtr, grPtr, sizeof(Tcl_UniChar) * grWidth); grPtr = uniPtr; } @@ -773,11 +774,12 @@ * None. * *------------------------------------------------------------------------ */ static inline void -GraphemeListRepDecrRefs(GraphemeListRep *glrPtr) +GraphemeListRepDecrRefs( + GraphemeListRep *glrPtr) { if (glrPtr->refCount <= 1) { if (glrPtr->objPtr != NULL) { Tcl_DecrRefCount(glrPtr->objPtr); } @@ -788,27 +790,68 @@ } /* *---------------------------------------------------------------------- * + * GetGraphemeListRep -- + * + * Get the internal representation of a grapheme list from a Tcl_Obj. + * Assumes that the object is of the right type already. + * + * Results: + * The internal representation. + * + *---------------------------------------------------------------------- + */ +static inline GraphemeListRep * +GetGraphemeListRep( + Tcl_Obj *objPtr) +{ + return (GraphemeListRep *) objPtr->internalRep.otherValuePtr; +} + +/* + *---------------------------------------------------------------------- + * + * SetGraphemeListRep -- + * + * Set the type and internal representation of a Tcl_Obj to a grapheme + * list. Doesn't manipulate the reference count of the internal rep or + * clear any old internal representation from the Tcl_Obj. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ +static inline void +SetGraphemeListRep( + Tcl_Obj *objPtr, + GraphemeListRep *glrPtr) +{ + objPtr->internalRep.otherValuePtr = glrPtr; + objPtr->typePtr = &tclGraphemeListType; +} + +/* + *---------------------------------------------------------------------- + * * GraphemeListFreeProc -- * - * Frees resources associated with a GraphemeList object's - * internal representation. + * Frees resources associated with a GraphemeList object's + * internal representation. * * Results: * None * *---------------------------------------------------------------------- */ - static void GraphemeListFreeProc( Tcl_Obj *objPtr) { - GraphemeListRepDecrRefs( - (GraphemeListRep *)objPtr->internalRep.otherValuePtr); + GraphemeListRepDecrRefs(GetGraphemeListRep(objPtr)); } /* *---------------------------------------------------------------------- * @@ -831,15 +874,14 @@ Tcl_Obj *srcPtr, /* Object with internal rep to copy. Must have * an internal rep of type "graphemeList". */ Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not * currently have an internal rep.*/ { - copyPtr->internalRep.otherValuePtr = srcPtr->internalRep.otherValuePtr; - ((GraphemeListRep *)srcPtr->internalRep.otherValuePtr)->refCount++; - copyPtr->typePtr = srcPtr->typePtr; + SetGraphemeListRep(copyPtr, GetGraphemeListRep(srcPtr)); + GetGraphemeListRep(srcPtr)->refCount++; } - + /* *------------------------------------------------------------------------ * * GraphemeListLengthProc -- * @@ -852,15 +894,14 @@ * None. * *------------------------------------------------------------------------ */ Tcl_Size -GraphemeListLengthProc ( - Tcl_Obj *objPtr -) +GraphemeListLengthProc( + Tcl_Obj *objPtr) { - GraphemeListRep *glrPtr = (GraphemeListRep *) objPtr->internalRep.otherValuePtr; + GraphemeListRep *glrPtr = GetGraphemeListRep(objPtr); Tcl_Size uniLen; Tcl_UniChar *uniPtr = Tcl_GetUnicodeFromObj(glrPtr->objPtr, &uniLen); return GraphemeLength(uniPtr, uniLen); } @@ -878,17 +919,17 @@ * None. * *------------------------------------------------------------------------ */ int -GraphemeListIndexProc ( +GraphemeListIndexProc( TCL_UNUSED(Tcl_Interp *), Tcl_Obj *objPtr, /* Source list */ Tcl_Size index, /* Element index */ Tcl_Obj **elemPtrPtr) /* Returned element */ { - GraphemeListRep *glrPtr = (GraphemeListRep *) objPtr->internalRep.otherValuePtr; + GraphemeListRep *glrPtr = GetGraphemeListRep(objPtr); Tcl_Size uniLen; const Tcl_UniChar *uniStartPtr = Tcl_GetUnicodeFromObj(glrPtr->objPtr, &uniLen); const Tcl_UniChar *grPtr = NULL; Tcl_Size grWidth = 0; @@ -957,11 +998,11 @@ * Interpreter result holds result or error message. * *------------------------------------------------------------------------ */ int -GraphemeSplitCmd ( +GraphemeSplitCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { @@ -970,21 +1011,20 @@ return TCL_ERROR; } Tcl_Obj *objPtr; TclNewObj(objPtr); - objPtr->typePtr = &tclGraphemeListType; GraphemeListRep *glrPtr = GraphemeListRepNew(objv[1]); glrPtr->refCount = 1; - objPtr->internalRep.otherValuePtr = glrPtr; + SetGraphemeListRep(objPtr, glrPtr); Tcl_InvalidateStringRep(objPtr); Tcl_SetObjResult(interp, objPtr); return TCL_OK; } - + /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ Index: generic/tclInt.h ================================================================== --- generic/tclInt.h +++ generic/tclInt.h @@ -1047,11 +1047,15 @@ * list describe the procedure's formal * arguments. */ CompiledLocal *lastLocalPtr;/* Pointer to the last allocated local * variable or NULL if none. This has frame * index (numCompiledLocals-1). */ + int flags; /* Miscellaneous bits of proc. */ } Proc; + +#define PROC_CMD_OWNED 0x80 + /* * The type of functions called to process errors found during the execution * of a procedure (or lambda term or ...). */ Index: generic/tclProc.c ================================================================== --- generic/tclProc.c +++ generic/tclProc.c @@ -13,20 +13,11 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" - -/* - * Variables that are part of the [apply] command implementation and which - * have to be passed to the other side of the NRE call. - */ - -typedef struct { - Command cmd; - ExtraFrameInfo efi; -} ApplyExtraData; +#include /* * Prototypes for static functions in this file */ @@ -45,11 +36,10 @@ Tcl_Obj *procNameObj); static void MakeLambdaError(Tcl_Interp *interp, Tcl_Obj *procNameObj); static int SetLambdaFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); -static Tcl_NRPostProc ApplyNR2; static Tcl_NRPostProc InterpProcNR2; /* * The ProcBodyObjType type */ @@ -480,10 +470,11 @@ procPtr->bodyPtr = bodyPtr; procPtr->numArgs = 0; /* Actual argument count is set below. */ procPtr->numCompiledLocals = 0; procPtr->firstLocalPtr = NULL; procPtr->lastLocalPtr = NULL; + procPtr->flags = 0; } /* * Break up the argument list into argument specifiers, then process each * argument specifier. If the body is precompiled, processing is limited @@ -2193,10 +2184,20 @@ Tcl_DecrRefCount(defPtr); } Tcl_Free(localPtr); localPtr = nextPtr; } + + if ( procPtr->cmdPtr && (procPtr->flags & PROC_CMD_OWNED) + && procPtr->cmdPtr->refCount-- <= 1 + ) { + /* cmdPtr owned by procPtr (lambda) */ + if (procPtr->cmdPtr->nsPtr) { + TclNsDecrRefCount(procPtr->cmdPtr->nsPtr); + } + Tcl_Free(procPtr->cmdPtr); + } Tcl_Free(procPtr); /* * TIP #280: Release the location data associated with this Proc * structure, if any. The interpreter may not exist (For example for @@ -2462,10 +2463,12 @@ Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv; int result; Tcl_Size objc; CmdFrame *cfPtr = NULL; Proc *procPtr; + Tcl_Namespace *nsPtr; + Command *cmdPtr; if (interp == NULL) { return TCL_ERROR; } @@ -2488,34 +2491,68 @@ "can't interpret \"%s\" as a lambda expression", TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", (char *)NULL); return TCL_ERROR; } + + /* + * Set the namespace for this lambda: given by objv[2] understood as a + * global reference, or else global per default. + */ + + if (objc == 2) { + TclNewLiteralStringObj(nsObjPtr, "::"); + } else { + const char *nsName = TclGetString(objv[2]); + + if ((*nsName != ':') || (*(nsName+1) != ':')) { + TclNewLiteralStringObj(nsObjPtr, "::"); + Tcl_AppendObjToObj(nsObjPtr, objv[2]); + } else { + nsObjPtr = objv[2]; + } + } + Tcl_IncrRefCount(nsObjPtr); + /* Find the namespace where this lambda should run. */ + result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr); + if (result != TCL_OK) { + Tcl_DecrRefCount(nsObjPtr); + return TCL_ERROR; + } argsPtr = objv[0]; bodyPtr = objv[1]; /* - * Create and initialize the Proc struct. The cmdPtr field is set to NULL - * to signal that this is an anonymous function. + * Create and initialize the Proc struct. The cmdPtr field is set to + * artificial command owned by the procPtr with few info, e. g. used + * in TclInfoFrame. */ name = TclGetString(objPtr); if (TclCreateProc(interp, /*ignored nsPtr*/ NULL, name, argsPtr, bodyPtr, &procPtr) != TCL_OK) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (parsing lambda expression \"%s\")", name)); + Tcl_DecrRefCount(nsObjPtr); return TCL_ERROR; } /* * CAREFUL: TclCreateProc returns refCount==1! [Bug 1578454] * procPtr->refCount = 1; */ - procPtr->cmdPtr = NULL; + cmdPtr = (Command *)Tcl_Alloc(sizeof(Command)); + memset(cmdPtr, 0, sizeof(*cmdPtr)); + cmdPtr->nsPtr = (Namespace *) nsPtr; + ((Namespace *)nsPtr)->refCount++; + cmdPtr->objClientData2 = objPtr; + cmdPtr->refCount++; + procPtr->cmdPtr = cmdPtr; + procPtr->flags = PROC_CMD_OWNED; /* * TIP #280: Remember the line the apply body is starting on. In a Byte * code context we ask the engine to provide us with the necessary * information. This is for the initialization of the byte code compiler @@ -2599,35 +2636,18 @@ TclStackFree(interp, contextPtr); } Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr, procPtr, NULL), cfPtr); - /* - * Set the namespace for this lambda: given by objv[2] understood as a - * global reference, or else global per default. - */ - - if (objc == 2) { - TclNewLiteralStringObj(nsObjPtr, "::"); - } else { - const char *nsName = TclGetString(objv[2]); - - if ((nsName[0] != ':') || (nsName[1] != ':')) { - TclNewLiteralStringObj(nsObjPtr, "::"); - Tcl_AppendObjToObj(nsObjPtr, objv[2]); - } else { - nsObjPtr = objv[2]; - } - } - /* * Free the list internalrep of objPtr - this will free argsPtr, but * bodyPtr retains a reference from the Proc structure. Then finish the * conversion to lambdaType. */ LambdaSetInternalRep(objPtr, procPtr, nsObjPtr); + Tcl_DecrRefCount(nsObjPtr); return TCL_OK; } Proc * TclGetLambdaFromObj( @@ -2646,12 +2666,25 @@ } LambdaGetInternalRep(objPtr, procPtr, nsObjPtr); } assert(procPtr != NULL); - if (procPtr->iPtr != (Interp *)interp) { - return NULL; + assert(procPtr->cmdPtr != NULL); + + if (!procPtr->cmdPtr->nsPtr || procPtr->cmdPtr->nsPtr->flags & NS_DEAD) { + Command *cmdPtr = procPtr->cmdPtr; + Tcl_Namespace *nsPtr; + if (cmdPtr->nsPtr) { + TclNsDecrRefCount(cmdPtr->nsPtr); + cmdPtr->nsPtr = NULL; + } + /* Retry to obtain namespace again... */ + if (TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr) != TCL_OK) { + return NULL; + } + cmdPtr->nsPtr = (Namespace *) nsPtr; + ((Namespace *)nsPtr)->refCount++; } *nsObjPtrPtr = nsObjPtr; return procPtr; } @@ -2691,12 +2724,10 @@ Tcl_Obj *const *objv) /* Argument objects. */ { Proc *procPtr = NULL; Tcl_Obj *lambdaPtr, *nsObjPtr; int result; - Tcl_Namespace *nsPtr; - ApplyExtraData *extraPtr; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "lambdaExpr ?arg ...?"); return TCL_ERROR; } @@ -2712,59 +2743,19 @@ if (procPtr == NULL) { return TCL_ERROR; } /* - * Push a call frame for the lambda namespace. - * Note that TclObjInterpProc2() will pop it. - */ - - result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr); - if (result != TCL_OK) { - return TCL_ERROR; - } - - extraPtr = (ApplyExtraData *)TclStackAlloc(interp, sizeof(ApplyExtraData)); - memset(&extraPtr->cmd, 0, sizeof(Command)); - procPtr->cmdPtr = &extraPtr->cmd; - extraPtr->cmd.nsPtr = (Namespace *) nsPtr; - - /* - * TIP#280 (semi-)HACK! - * - * Using cmd.clientData to tell [info frame] how to render the lambdaPtr. - * The InfoFrameCmd will detect this case by testing cmd.hPtr for NULL. - * This condition holds here because of the memset() above, and nowhere - * else (in the core). Regular commands always have a valid hPtr, and - * lambda's never. - */ - - extraPtr->efi.length = 1; - extraPtr->efi.fields[0].name = "lambda"; - extraPtr->efi.fields[0].proc = NULL; - extraPtr->efi.fields[0].clientData = lambdaPtr; - extraPtr->cmd.clientData = &extraPtr->efi; - + * Push a call frame for that procPtr. Note that TclNRInterpProcCore() + * will pop it (NRE-based). + */ result = TclPushProcCallFrame(procPtr, interp, objc, objv, 1); if (result == TCL_OK) { - TclNRAddCallback(interp, ApplyNR2, extraPtr, NULL, NULL, NULL); result = TclNRInterpProcCore(interp, objv[1], 2, &MakeLambdaError); } return result; } - -static int -ApplyNR2( - void *data[], - Tcl_Interp *interp, - int result) -{ - ApplyExtraData *extraPtr = (ApplyExtraData *)data[0]; - - TclStackFree(interp, extraPtr); - return result; -} /* *---------------------------------------------------------------------- * * MakeLambdaError -- @@ -2917,10 +2908,11 @@ newProc->bodyPtr = bodyPtr; newProc->numArgs = origProc->numArgs; newProc->numCompiledLocals = origProc->numArgs; newProc->firstLocalPtr = NULL; newProc->lastLocalPtr = NULL; + newProc->flags = 0; // Work through the original arguments, duplicating them. const CompiledLocal *origLocal = origProc->firstLocalPtr; for (Tcl_Size i = 0; i < newProc->numArgs; i++) { if (DuplicateArgument(newProc, origLocal, i) != TCL_OK) { Index: tests/apply.test ================================================================== --- tests/apply.test +++ tests/apply.test @@ -82,10 +82,23 @@ set lambda [list x {set x 1} ::NONEXIST::FOR::SURE] apply $lambda x namespace delete ::NONEXIST apply $lambda x } -returnCodes error -result {namespace "::NONEXIST::FOR::SURE" not found} +test apply-3.2.2 {non-existing namespace (recreated between apply-calls)} -body { + set res {} + namespace eval ::NONEXIST::FOR::SURE {} + set lambda {{step} {variable x; lappend x $step} ::NONEXIST::FOR::SURE} + lappend res [catch { apply $lambda A} x] $x + namespace delete ::NONEXIST + lappend res [catch { apply $lambda B} x] $x + namespace eval ::NONEXIST::FOR::SURE {} + lappend res [catch { apply $lambda C} x] $x + set res +} -cleanup { + namespace delete ::NONEXIST +} -result {0 A 1 {namespace "::NONEXIST::FOR::SURE" not found} 0 C} test apply-3.3 {non-existing namespace} -body { apply [list x {set x 1} NONEXIST::FOR::SURE] x } -returnCodes error -result {namespace "::NONEXIST::FOR::SURE" not found} test apply-3.4 {non-existing namespace} -body { namespace eval ::NONEXIST::FOR::SURE {} @@ -307,10 +320,19 @@ set leakedBytes [expr {$end - $tmp}] } -cleanup { rename getbytes {} unset -nocomplain end i x tmp leakedBytes } -result 0 +test apply-9.4 {lambda representation may shimmer during invocation} -setup { + set ::t {apply {n { + expr {[llength [lindex $::t 1 1 1]] + $n} + }} _} +} -body { + {*}[lset ::t end 123] +} -cleanup { + unset -nocomplain ::t +} -result {131} # Tests for specific bugs test apply-10.1 {Test for precompiled bytecode body} -constraints { applylambda } -body { Index: tests/grapheme.test ================================================================== --- tests/grapheme.test +++ tests/grapheme.test @@ -32,11 +32,11 @@ # Database. The test numbering is based on the corresponding line from # the GraphemeBreakTest.txt file and may therefore be unstable. ### grapheme next - tcltests::testnumargs "grapheme next" "string strIndex" "" + tcltests::testnumargs "grapheme next" "string indexVar" "" foreach testCase [list [list 0 "empty string" ""] {*}[getGraphemeData]] { lassign $testCase testNum comment graphemes test grapheme-next-ucd-$testNum.0 $comment -body { set text [join $graphemes ""] @@ -49,11 +49,11 @@ } -result $graphemes } ### grapheme prev - tcltests::testnumargs "grapheme prev" "string strIndex" "" + tcltests::testnumargs "grapheme prev" "string indexVar" "" foreach testCase [list [list 0 "empty string" ""] {*}[getGraphemeData]] { lassign $testCase testNum comment graphemes test grapheme-prev-ucd-$testNum.0 $comment -body { set text [join $graphemes ""] Index: tests/info.test ================================================================== --- tests/info.test +++ tests/info.test @@ -2604,10 +2604,23 @@ unset -nocomplain body rename demo {} rename probe {} } -result 3 +test info-39.3 {Bug [e533296a92d89044]: no segfault, nested lambda invocation doesn't remove info from stack} -setup { + set ::res {} + proc probe {s} { + lappend ::res [dict filter [info frame -1] key {[cl]*m*d*}] + catch {apply {{s} {eval $s}} $s} + } +} -body { + probe {catch {probe {error X}}; probe {}} + set ::res +} -cleanup { + unset -nocomplain ::res +} -result {{cmd {probe {catch {probe {error X}}; probe {}}}} {cmd {probe {error X}} lambda {{s} {eval $s}}} {cmd {probe {}} lambda {{s} {eval $s}}}} + test info-41.0 {Bug 0de6c1d79c crash} -setup { interp create child child hide info } -body { list [child invokehidden info frame] \