diff options
| -rw-r--r-- | ChangeLog | 11 | ||||
| -rw-r--r-- | generic/tclCompile.c | 8 | ||||
| -rw-r--r-- | generic/tclIO.c | 3 | ||||
| -rw-r--r-- | generic/tclIndexObj.c | 2 | ||||
| -rw-r--r-- | generic/tclListObj.c | 18 | ||||
| -rw-r--r-- | generic/tclNamesp.c | 7 | ||||
| -rw-r--r-- | generic/tclObj.c | 4 | ||||
| -rw-r--r-- | generic/tclProc.c | 6 | ||||
| -rw-r--r-- | macosx/tclMacOSXFCmd.c | 8 |
9 files changed, 53 insertions, 14 deletions
@@ -1,3 +1,14 @@ +2011-04-21 Don Porter <dgp@users.sourceforge.net> + + * generic/tclCompile.c: Make sure SetFooFromAny routines react + * generic/tclIO.c: reasonably when passed a NULL interp. + * generic/tclIndexObj.c: + * generic/tclListObj.c: + * generic/tclNamesp.c: + * generic/tclObj.c: + * generic/tclProc.c: + * macosx/tclMacOSXFCmd.c: + 2011-04-21 Jan Nijtmans <nijtmans@users.sf.net> * generic/tcl.h: fix for [Bug 3288345]: Wrong Tcl_StatBuf diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 3330315..2194ae1 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -509,12 +509,13 @@ static const Tcl_ObjType tclInstNameType = { * generate an byte code internal form for the Tcl object "objPtr" by * compiling its string representation. This function also takes a hook * procedure that will be invoked to perform any needed post processing - * on the compilation results before generating byte codes. + * on the compilation results before generating byte codes. interp is + * compilation context and may not be NULL. * * Results: * The return value is a standard Tcl object result. If an error occurs * during compilation, an error message is left in the interpreter's - * result unless "interp" is NULL. + * result. * * Side effects: * Frees the old internal representation. If no error occurs, then the @@ -672,6 +673,9 @@ SetByteCodeFromAny( * compiled. Must not be NULL. */ Tcl_Obj *objPtr) /* The object to make a ByteCode object. */ { + if (interp == NULL) { + return TCL_ERROR; + } TclSetByteCodeFromAny(interp, objPtr, NULL, NULL); return TCL_OK; } diff --git a/generic/tclIO.c b/generic/tclIO.c index 8f76b26..c7fab6c 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -11196,6 +11196,9 @@ SetChannelFromAny( ChannelState *statePtr; Interp *interpPtr; + if (interp == NULL) { + return TCL_ERROR; + } if (objPtr->typePtr == &tclChannelType) { /* * The channel is valid until any call to DetachChannel occurs. diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index d98842e..99bd61f 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -410,9 +410,11 @@ SetIndexFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ register Tcl_Obj *objPtr) /* The object to convert. */ { + if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't convert value to index except via Tcl_GetIndexFromObj API", -1)); + } return TCL_ERROR; } diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 8a0f89a..d4f7da9 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -1718,10 +1718,12 @@ SetListFromAny( Tcl_DictObjSize(NULL, objPtr, &size); listRepPtr = NewListIntRep(size > 0 ? 2*size : 1, NULL); if (!listRepPtr) { - Tcl_SetResult(interp, - "insufficient memory to allocate list working space", - TCL_STATIC); - Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); + if (interp) { + Tcl_SetResult(interp, + "insufficient memory to allocate list working space", + TCL_STATIC); + Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); + } return TCL_ERROR; } listRepPtr->elemCount = 2 * size; @@ -1779,9 +1781,11 @@ SetListFromAny( listRepPtr = NewListIntRep(estCount, NULL); if (!listRepPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "Not enough memory to allocate the list internal rep", -1)); - Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); + if (interp) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Not enough memory to allocate the list internal rep", -1)); + Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); + } return TCL_ERROR; } elemPtrs = &listRepPtr->elements; diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 45b9f6d..7a09490 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -4715,8 +4715,13 @@ SetNsNameFromAny( const char *dummy; Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr; register ResolvedNsName *resNamePtr; - const char *name = TclGetString(objPtr); + const char *name; + + if (interp == NULL) { + return TCL_ERROR; + } + name = TclGetString(objPtr); TclGetNamespaceForQualName(interp, name, NULL, TCL_FIND_ONLY_NS, &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy); diff --git a/generic/tclObj.c b/generic/tclObj.c index 630226f..129d80d 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -4379,6 +4379,10 @@ SetCmdNameFromAny( Namespace *currNsPtr; register ResolvedCmdName *resPtr; + if (interp == NULL) { + return TCL_ERROR; + } + /* * Find the Command structure, if any, that describes the command called * "name". Build a ResolvedCmdName that holds a cached pointer to this diff --git a/generic/tclProc.c b/generic/tclProc.c index 9f4ba29..1260f4f 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -2478,12 +2478,16 @@ SetLambdaFromAny( int objc, result; Proc *procPtr; + if (interp == NULL) { + return TCL_ERROR; + } + /* * Convert objPtr to list type first; if it cannot be converted, or if its * length is not 2, then it cannot be converted to lambdaType. */ - result = TclListObjGetElements(interp, objPtr, &objc, &objv); + result = TclListObjGetElements(NULL, objPtr, &objc, &objv); if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) { TclNewLiteralStringObj(errPtr, "can't interpret \""); Tcl_AppendObjToObj(errPtr, objPtr); diff --git a/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c index 64cbbea..9193c1a 100644 --- a/macosx/tclMacOSXFCmd.c +++ b/macosx/tclMacOSXFCmd.c @@ -639,9 +639,11 @@ SetOSTypeFromAny( Tcl_UtfToExternalDString(encoding, string, length, &ds); if (Tcl_DStringLength(&ds) > 4) { - Tcl_AppendResult(interp, "expected Macintosh OS type but got \"", - string, "\": ", NULL); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "MAC_OSTYPE", NULL); + if (interp) { + Tcl_AppendResult(interp, "expected Macintosh OS type but got \"", + string, "\": ", NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "MAC_OSTYPE", NULL); + } result = TCL_ERROR; } else { OSType osType; |