diff options
author | pooryorick <com.digitalsmarties@pooryorick.com> | 2017-11-19 00:06:51 (GMT) |
---|---|---|
committer | pooryorick <com.digitalsmarties@pooryorick.com> | 2017-11-19 00:06:51 (GMT) |
commit | 75924256c128fb94dc0cfbddf6d56fc89aeb10e7 (patch) | |
tree | 5bdacef0009d730244d257cadfe654aac31c6b40 /generic/tclBasic.c | |
parent | 42c80667fd7da57b65d92fee77d2b954fba95970 (diff) | |
download | tcl-75924256c128fb94dc0cfbddf6d56fc89aeb10e7.zip tcl-75924256c128fb94dc0cfbddf6d56fc89aeb10e7.tar.gz tcl-75924256c128fb94dc0cfbddf6d56fc89aeb10e7.tar.bz2 |
Fix segmentation fault in TclOO that was noted in [16fe1b5807]. Update
coroutine and TclOO object creation routines to use TclCreateObjCommandInNs.
Diffstat (limited to 'generic/tclBasic.c')
-rw-r--r-- | generic/tclBasic.c | 46 |
1 files changed, 17 insertions, 29 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index a51578c..2acd2e7 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -2281,11 +2281,11 @@ Tcl_CreateObjCommand( tail = cmdName; } - return tclCreateObjCommandInNs(interp, tail, (Tcl_Namespace *) nsPtr, + return TclCreateObjCommandInNs(interp, tail, (Tcl_Namespace *) nsPtr, proc, clientData, deleteProc); } -Tcl_Command tclCreateObjCommandInNs ( +Tcl_Command TclCreateObjCommandInNs ( Tcl_Interp *interp, const char *cmdName, /* Name of command, without any namespace components */ Tcl_Namespace *namespace, /* The namespace to create the command in */ @@ -8210,7 +8210,7 @@ Tcl_NRCreateCommand( return (Tcl_Command) cmdPtr; } -Tcl_Command tclNRCreateCommandInNs ( +Tcl_Command TclNRCreateCommandInNs ( Tcl_Interp *interp, const char *cmdName, Tcl_Namespace *nsPtr, @@ -8219,7 +8219,7 @@ Tcl_Command tclNRCreateCommandInNs ( ClientData clientData, Tcl_CmdDeleteProc *deleteProc) { Command *cmdPtr = (Command *) - tclCreateObjCommandInNs(interp,cmdName,nsPtr,proc,clientData,deleteProc); + TclCreateObjCommandInNs(interp,cmdName,nsPtr,proc,clientData,deleteProc); cmdPtr->nreProc = nreProc; return (Tcl_Command) cmdPtr; @@ -9009,9 +9009,9 @@ TclNRCoroutineObjCmd( { Command *cmdPtr; CoroutineData *corPtr; - const char *fullName, *procName; - Namespace *nsPtr, *altNsPtr, *cxtNsPtr; - Tcl_DString ds; + const char *procName, *simpleName; + Namespace *nsPtr, *altNsPtr, *cxtNsPtr, + *inNsPtr = (Namespace *)TclGetCurrentNamespace(interp); Namespace *lookupNsPtr = iPtr->varFramePtr->nsPtr; if (objc < 3) { @@ -9019,27 +9019,22 @@ TclNRCoroutineObjCmd( return TCL_ERROR; } - /* - * FIXME: this is copy/pasted from Tcl_ProcObjCommand. Should have - * something in tclUtil.c to find the FQ name. - */ - - fullName = TclGetString(objv[1]); - TclGetNamespaceForQualName(interp, fullName, NULL, 0, - &nsPtr, &altNsPtr, &cxtNsPtr, &procName); + procName = TclGetString(objv[1]); + TclGetNamespaceForQualName(interp, procName, inNsPtr, 0, + &nsPtr, &altNsPtr, &cxtNsPtr, &simpleName); if (nsPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't create procedure \"%s\": unknown namespace", - fullName)); + procName)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", NULL); return TCL_ERROR; } - if (procName == NULL) { + if (simpleName == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't create procedure \"%s\": bad procedure name", - fullName)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", fullName, NULL); + procName)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, NULL); return TCL_ERROR; } @@ -9050,16 +9045,9 @@ TclNRCoroutineObjCmd( corPtr = ckalloc(sizeof(CoroutineData)); - Tcl_DStringInit(&ds); - if (nsPtr != iPtr->globalNsPtr) { - Tcl_DStringAppend(&ds, nsPtr->fullName, -1); - TclDStringAppendLiteral(&ds, "::"); - } - Tcl_DStringAppend(&ds, procName, -1); - - cmdPtr = (Command *) Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds), - /*objProc*/ NULL, TclNRInterpCoroutine, corPtr, DeleteCoroutine); - Tcl_DStringFree(&ds); + cmdPtr = (Command *) TclNRCreateCommandInNs(interp, simpleName, + (Tcl_Namespace *)nsPtr, /*objProc*/ NULL, TclNRInterpCoroutine, + corPtr, DeleteCoroutine); corPtr->cmdPtr = cmdPtr; cmdPtr->refCount++; |