diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2017-06-05 23:20:36 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2017-06-05 23:20:36 (GMT) |
commit | f8223fa81718da26562fff851b4a56d18b58a62a (patch) | |
tree | 2c47bdd025eab065e5f559ade49795a3acaf938e /generic/tclProc.c | |
parent | e9d31a334b4cbd18716b3c1eacf7f516cbc7286d (diff) | |
parent | 0b178367ba3b9a10d44f89025c89292a4ea49b20 (diff) | |
download | tcl-dkf_expose_ptrgetvar.zip tcl-dkf_expose_ptrgetvar.tar.gz tcl-dkf_expose_ptrgetvar.tar.bz2 |
merge trunkdkf_expose_ptrgetvar
Diffstat (limited to 'generic/tclProc.c')
-rw-r--r-- | generic/tclProc.c | 45 |
1 files changed, 40 insertions, 5 deletions
diff --git a/generic/tclProc.c b/generic/tclProc.c index bed520a..96bdcf3 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -500,7 +500,8 @@ TclCreateProc( } for (i = 0; i < numArgs; i++) { - int fieldCount, nameLength, valueLength; + int fieldCount, nameLength; + size_t valueLength; const char **fieldValues; /* @@ -602,12 +603,11 @@ TclCreateProc( */ if (localPtr->defValuePtr != NULL) { - int tmpLength; - const char *tmpPtr = TclGetStringFromObj(localPtr->defValuePtr, - &tmpLength); + const char *tmpPtr = TclGetString(localPtr->defValuePtr); + size_t tmpLength = localPtr->defValuePtr->length; if ((valueLength != tmpLength) || - strncmp(fieldValues[1], tmpPtr, (size_t) tmpLength)) { + strncmp(fieldValues[1], tmpPtr, tmpLength)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "procedure \"%s\": formal parameter \"%s\" has " "default value inconsistent with precompiled body", @@ -2750,6 +2750,41 @@ MakeLambdaError( } /* + *---------------------------------------------------------------------- + * + * TclGetCmdFrameForProcedure -- + * + * How to get the CmdFrame information for a procedure. + * + * Results: + * A pointer to the CmdFrame (only guaranteed to be valid until the next + * Tcl command is processed or the interpreter's state is otherwise + * modified) or a NULL if the information is not available. + * + * Side effects: + * none. + * + *---------------------------------------------------------------------- + */ + +CmdFrame * +TclGetCmdFrameForProcedure( + Proc *procPtr) /* The procedure whose cmd-frame is to be + * looked up. */ +{ + Tcl_HashEntry *hePtr; + + if (procPtr == NULL || procPtr->iPtr == NULL) { + return NULL; + } + hePtr = Tcl_FindHashEntry(procPtr->iPtr->linePBodyPtr, procPtr); + if (hePtr == NULL) { + return NULL; + } + return (CmdFrame *) Tcl_GetHashValue(hePtr); +} + +/* * Local Variables: * mode: c * c-basic-offset: 4 |