Make sure SetFooFromAny routines react reasonably when passed a NULL interp.

9 files changed, 53 insertions, 14 deletions

diff --git a/ChangeLog b/ChangeLog
index e8f96e2..046b900 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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;