summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2011-04-21 13:47:48 (GMT)
committerdgp <dgp@users.sourceforge.net>2011-04-21 13:47:48 (GMT)
commit6998aa298515d30c3b2e0cee78e2af476fd2ed91 (patch)
tree6159f577b200fa32f4575a1ead43307fa7ff8f7f
parent4779fe18796c2f1adad2712560bc0cfe35e844be (diff)
parent7814414e5c501546b9abc27e7d5016acb7a9ff03 (diff)
downloadtcl-6998aa298515d30c3b2e0cee78e2af476fd2ed91.zip
tcl-6998aa298515d30c3b2e0cee78e2af476fd2ed91.tar.gz
tcl-6998aa298515d30c3b2e0cee78e2af476fd2ed91.tar.bz2
Make sure SetFooFromAny routines react reasonably when passed a NULL interp.
-rw-r--r--ChangeLog11
-rw-r--r--generic/tclCompile.c8
-rw-r--r--generic/tclIO.c3
-rw-r--r--generic/tclIndexObj.c2
-rw-r--r--generic/tclListObj.c18
-rw-r--r--generic/tclNamesp.c7
-rw-r--r--generic/tclObj.c4
-rw-r--r--generic/tclProc.c6
-rw-r--r--macosx/tclMacOSXFCmd.c8
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;