merged tcl 8.1 branch back into the main trunk

1 files changed, 103 insertions, 90 deletions

diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index 3f7f349..d604c5b 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -6,12 +6,12 @@
  *	types. These commands are not normally included in Tcl
  *	applications; they're only used for testing.
  *
- * Copyright (c) 1995, 1996 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1998 Sun Microsystems, Inc.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclTestObj.c,v 1.2 1998/09/14 18:40:02 stanton Exp $
+ * RCS: @(#) $Id: tclTestObj.c,v 1.3 1999/04/16 00:46:54 stanton Exp $
  */
 
 #include "tclInt.h"
@@ -68,7 +68,7 @@ static int		TeststringobjCmd _ANSI_ARGS_((ClientData dummy,
  *
  * Results:
  *	Returns a standard Tcl completion code, and leaves an error
- *	message in interp->result if an error occurs.
+ *	message in the interp's result if an error occurs.
  *
  * Side effects:
  *	Creates and registers several new testing commands.
@@ -128,7 +128,7 @@ TestbooleanobjCmd(clientData, interp, objc, objv)
     int objc;			/* Number of arguments. */
     Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
-    int varIndex, boolValue, length;
+    int varIndex, boolValue;
     char *index, *subCmd;
 
     if (objc < 3) {
@@ -137,16 +137,12 @@ TestbooleanobjCmd(clientData, interp, objc, objv)
 	return TCL_ERROR;
     }
 
-    /*
-     * THIS FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
-     */
-
-    index = Tcl_GetStringFromObj(objv[2], &length);
+    index = Tcl_GetString(objv[2]);
     if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
 	return TCL_ERROR;
     }
 
-    subCmd = Tcl_GetStringFromObj(objv[1], &length);
+    subCmd = Tcl_GetString(objv[1]);
     if (strcmp(subCmd, "set") == 0) {
 	if (objc != 4) {
 	    goto wrongNumArgs;
@@ -196,7 +192,7 @@ TestbooleanobjCmd(clientData, interp, objc, objv)
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
     } else {
 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		"bad option \"", Tcl_GetStringFromObj(objv[1], (int *) NULL),
+		"bad option \"", Tcl_GetString(objv[1]),
 		"\": must be set, get, or not", (char *) NULL);
 	return TCL_ERROR;
     }
@@ -227,7 +223,6 @@ TestconvertobjCmd(clientData, interp, objc, objv)
     int objc;			/* Number of arguments. */
     Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
-    int length;
     char *subCmd;
     char buf[20];
 
@@ -237,11 +232,7 @@ TestconvertobjCmd(clientData, interp, objc, objv)
 	return TCL_ERROR;
     }
 
-    /*
-     * THIS FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
-     */
-
-    subCmd = Tcl_GetStringFromObj(objv[1], &length);
+    subCmd = Tcl_GetString(objv[1]);
     if (strcmp(subCmd, "double") == 0) {
 	double d;
 
@@ -255,7 +246,7 @@ TestconvertobjCmd(clientData, interp, objc, objv)
         Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
     } else {
 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		"bad option \"", Tcl_GetStringFromObj(objv[1], (int *) NULL),
+		"bad option \"", Tcl_GetString(objv[1]),
 		"\": must be double", (char *) NULL);
 	return TCL_ERROR;
     }
@@ -288,7 +279,7 @@ TestdoubleobjCmd(clientData, interp, objc, objv)
     int objc;			/* Number of arguments. */
     Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
-    int varIndex, length;
+    int varIndex;
     double doubleValue;
     char *index, *subCmd, *string;
 	
@@ -298,21 +289,17 @@ TestdoubleobjCmd(clientData, interp, objc, objv)
 	return TCL_ERROR;
     }
 
-    /*
-     * THIS FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
-     */
-
-    index = Tcl_GetStringFromObj(objv[2], &length);
+    index = Tcl_GetString(objv[2]);
     if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
 	return TCL_ERROR;
     }
 
-    subCmd = Tcl_GetStringFromObj(objv[1], &length);
+    subCmd = Tcl_GetString(objv[1]);
     if (strcmp(subCmd, "set") == 0) {
 	if (objc != 4) {
 	    goto wrongNumArgs;
 	}
-	string = Tcl_GetStringFromObj(objv[3], &length);
+	string = Tcl_GetString(objv[3]);
 	if (Tcl_GetDouble(interp, string, &doubleValue) != TCL_OK) {
 	    return TCL_ERROR;
 	}
@@ -375,7 +362,7 @@ TestdoubleobjCmd(clientData, interp, objc, objv)
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
     } else {
 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		"bad option \"", Tcl_GetStringFromObj(objv[1], (int *) NULL),
+		"bad option \"", Tcl_GetString(objv[1]),
 		"\": must be set, get, mult10, or div10", (char *) NULL);
 	return TCL_ERROR;
     }
@@ -407,11 +394,11 @@ TestindexobjCmd(clientData, interp, objc, objv)
     int objc;			/* Number of arguments. */
     Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
-    int allowAbbrev, index, index2, setError, i, dummy, result;
+    int allowAbbrev, index, index2, setError, i, result;
     char **argv;
     static char *tablePtr[] = {"a", "b", "check", (char *) NULL};
 
-    if ((objc == 3) && (strcmp(Tcl_GetStringFromObj(objv[1], &dummy),
+    if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]),
 	    "check") == 0)) {
 	/*
 	 * This code checks to be sure that the results of
@@ -444,13 +431,27 @@ TestindexobjCmd(clientData, interp, objc, objv)
     if (Tcl_GetBooleanFromObj(interp, objv[2], &allowAbbrev) != TCL_OK) {
 	return TCL_ERROR;
     }
+
     argv = (char **) ckalloc((unsigned) ((objc-3) * sizeof(char *)));
     for (i = 4; i < objc; i++) {
-	argv[i-4] = Tcl_GetStringFromObj(objv[i], &dummy);
+	argv[i-4] = Tcl_GetString(objv[i]);
     }
     argv[objc-4] = NULL;
-    result = Tcl_GetIndexFromObj(setError ? interp : NULL, objv[3],
-	    argv, "token", allowAbbrev ? 0 : TCL_EXACT, &index);
+    
+    /*
+     * Tcl_GetIndexFromObj assumes that the table is statically-allocated
+     * so that its address is different for each index object. If we
+     * accidently allocate a table at the same address as that cached in
+     * the index object, clear out the object's cached state.
+     */
+
+    if ((objv[3]->typePtr == Tcl_GetObjType("index"))
+	    && (objv[3]->internalRep.twoPtrValue.ptr1 == (VOID *) argv)) {
+	objv[3]->typePtr = NULL;
+    }
+
+    result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],
+	    argv, "token", (allowAbbrev? 0 : TCL_EXACT), &index);
     ckfree((char *) argv);
     if (result == TCL_OK) {
 	Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
@@ -483,7 +484,7 @@ TestintobjCmd(clientData, interp, objc, objv)
     int objc;			/* Number of arguments. */
     Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
-    int intValue, varIndex, length, i;
+    int intValue, varIndex, i;
     long longValue;
     char *index, *subCmd, *string;
 	
@@ -493,21 +494,17 @@ TestintobjCmd(clientData, interp, objc, objv)
 	return TCL_ERROR;
     }
 
-    /*
-     * THIS FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
-     */
-
-    index = Tcl_GetStringFromObj(objv[2], &length);
+    index = Tcl_GetString(objv[2]);
     if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
 	return TCL_ERROR;
     }
 
-    subCmd = Tcl_GetStringFromObj(objv[1], &length);
+    subCmd = Tcl_GetString(objv[1]);
     if (strcmp(subCmd, "set") == 0) {
 	if (objc != 4) {
 	    goto wrongNumArgs;
 	}
-	string = Tcl_GetStringFromObj(objv[3], &length);
+	string = Tcl_GetString(objv[3]);
 	if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
 	    return TCL_ERROR;
 	}
@@ -531,7 +528,7 @@ TestintobjCmd(clientData, interp, objc, objv)
 	if (objc != 4) {
 	    goto wrongNumArgs;
 	}
-	string = Tcl_GetStringFromObj(objv[3], &length);
+	string = Tcl_GetString(objv[3]);
 	if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
 	    return TCL_ERROR;
 	}
@@ -545,7 +542,7 @@ TestintobjCmd(clientData, interp, objc, objv)
 	if (objc != 4) {
 	    goto wrongNumArgs;
 	}
-	string = Tcl_GetStringFromObj(objv[3], &length);
+	string = Tcl_GetString(objv[3]);
 	if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
 	    return TCL_ERROR;
 	}
@@ -586,6 +583,15 @@ TestintobjCmd(clientData, interp, objc, objv)
 	    return TCL_ERROR;
 	}
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
+    } else if (strcmp(subCmd, "get2") == 0) {
+	if (objc != 3) {
+	    goto wrongNumArgs;
+	}
+	if (CheckIfVarUnset(interp, varIndex)) {
+	    return TCL_ERROR;
+	}
+	string = Tcl_GetString(varPtr[varIndex]);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp), string, -1);
     } else if (strcmp(subCmd, "inttoobigtest") == 0) {
 	/*
 	 * If long ints have more bits than ints on this platform, verify
@@ -594,26 +600,24 @@ TestintobjCmd(clientData, interp, objc, objv)
 	 * to fit in an int.
 	 */
 	
-	long maxLong = LONG_MAX;
-	
 	if (objc != 3) {
 	    goto wrongNumArgs;
 	}
-	if (INT_MAX == LONG_MAX) { /* int is same size as long int */
-	    Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1);
+#if (INT_MAX == LONG_MAX)   /* int is same size as long int */
+	Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1);
+#else 
+	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
+	    Tcl_SetLongObj(varPtr[varIndex], LONG_MAX);
 	} else {
-	    if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
-		Tcl_SetLongObj(varPtr[varIndex], maxLong);
-	    } else {
-		SetVarToObj(varIndex, Tcl_NewLongObj(maxLong));
-	    }
-	    if (Tcl_GetIntFromObj(interp, varPtr[varIndex], &i) != TCL_OK) {
-		Tcl_ResetResult(interp);
-		Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1);
-		return TCL_OK;
-	    }
-	    Tcl_AppendToObj(Tcl_GetObjResult(interp), "0", -1);
+	    SetVarToObj(varIndex, Tcl_NewLongObj(LONG_MAX));
 	}
+	if (Tcl_GetIntFromObj(interp, varPtr[varIndex], &i) != TCL_OK) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1);
+	    return TCL_OK;
+	}
+	Tcl_AppendToObj(Tcl_GetObjResult(interp), "0", -1);
+#endif
     } else if (strcmp(subCmd, "mult10") == 0) {
 	if (objc != 3) {
 	    goto wrongNumArgs;
@@ -650,8 +654,9 @@ TestintobjCmd(clientData, interp, objc, objv)
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
     } else {
 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		"bad option \"", Tcl_GetStringFromObj(objv[1], (int *) NULL),
-		"\": must be set, get, mult10, or div10", (char *) NULL);
+		"bad option \"", Tcl_GetString(objv[1]),
+		"\": must be set, get, get2, mult10, or div10",
+		(char *) NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -684,8 +689,6 @@ TestobjCmd(clientData, interp, objc, objv)
     int varIndex, destIndex, i;
     char *index, *subCmd, *string;
     Tcl_ObjType *targetType;
-    char buf[20];
-    int length;
 	
     if (objc < 2) {
 	wrongNumArgs:
@@ -693,23 +696,19 @@ TestobjCmd(clientData, interp, objc, objv)
 	return TCL_ERROR;
     }
 
-    /*
-     * THIS FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
-     */
-
-    subCmd = Tcl_GetStringFromObj(objv[1], &length);
+    subCmd = Tcl_GetString(objv[1]);
     if (strcmp(subCmd, "assign") == 0) {
         if (objc != 4) {
             goto wrongNumArgs;
         }
-        index = Tcl_GetStringFromObj(objv[2], &length);
+        index = Tcl_GetString(objv[2]);
         if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
             return TCL_ERROR;
         }
         if (CheckIfVarUnset(interp, varIndex)) {
 	    return TCL_ERROR;
 	}
-	string = Tcl_GetStringFromObj(objv[3], &length);
+	string = Tcl_GetString(objv[3]);
         if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
             return TCL_ERROR;
         }
@@ -720,14 +719,14 @@ TestobjCmd(clientData, interp, objc, objv)
         if (objc != 4) {
             goto wrongNumArgs;
         }
-        index = Tcl_GetStringFromObj(objv[2], &length);
+        index = Tcl_GetString(objv[2]);
         if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
             return TCL_ERROR;
         }
         if (CheckIfVarUnset(interp, varIndex)) {
 	    return TCL_ERROR;
 	}
-        typeName = Tcl_GetStringFromObj(objv[3], &length);
+        typeName = Tcl_GetString(objv[3]);
         if ((targetType = Tcl_GetObjType(typeName)) == NULL) {
 	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
 		    "no type ", typeName, " found", (char *) NULL);
@@ -742,14 +741,14 @@ TestobjCmd(clientData, interp, objc, objv)
         if (objc != 4) {
             goto wrongNumArgs;
         }
-        index = Tcl_GetStringFromObj(objv[2], &length);
+        index = Tcl_GetString(objv[2]);
         if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
             return TCL_ERROR;
         }
         if (CheckIfVarUnset(interp, varIndex)) {
 	    return TCL_ERROR;
 	}
-	string = Tcl_GetStringFromObj(objv[3], &length);
+	string = Tcl_GetString(objv[3]);
         if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
             return TCL_ERROR;
         }
@@ -769,30 +768,32 @@ TestobjCmd(clientData, interp, objc, objv)
         if (objc != 3) {
             goto wrongNumArgs;
         }
-        index = Tcl_GetStringFromObj(objv[2], &length);
+        index = Tcl_GetString(objv[2]);
         if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
             return TCL_ERROR;
         }
         SetVarToObj(varIndex, Tcl_NewObj());
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
     } else if (strcmp(subCmd, "refcount") == 0) {
+	char buf[TCL_INTEGER_SPACE];
+
         if (objc != 3) {
             goto wrongNumArgs;
         }
-        index = Tcl_GetStringFromObj(objv[2], &length);
+        index = Tcl_GetString(objv[2]);
         if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
             return TCL_ERROR;
         }
         if (CheckIfVarUnset(interp, varIndex)) {
 	    return TCL_ERROR;
 	}
-        sprintf(buf, "%d", varPtr[varIndex]->refCount);
-        Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
+	TclFormatInt(buf, varPtr[varIndex]->refCount);
+        Tcl_SetResult(interp, buf, TCL_VOLATILE);
     } else if (strcmp(subCmd, "type") == 0) {
         if (objc != 3) {
             goto wrongNumArgs;
         }
-        index = Tcl_GetStringFromObj(objv[2], &length);
+        index = Tcl_GetString(objv[2]);
         if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
             return TCL_ERROR;
         }
@@ -815,7 +816,7 @@ TestobjCmd(clientData, interp, objc, objv)
     } else {
 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
 		"bad option \"",
-		Tcl_GetStringFromObj(objv[1], (int *) NULL),
+		Tcl_GetString(objv[1]),
 		"\": must be assign, convert, duplicate, freeallvars, ",
 		"newobj, objcount, refcount, type, or types",
 		(char *) NULL);
@@ -850,10 +851,10 @@ TeststringobjCmd(clientData, interp, objc, objv)
     Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
     int varIndex, option, i, length;
-#define MAX_STRINGS 10
+#define MAX_STRINGS 11
     char *index, *string, *strings[MAX_STRINGS+1];
     static char *options[] = {
-	"append", "appendstrings", "get", "length", "length2",
+	"append", "appendstrings", "get", "get2", "length", "length2",
 	"set", "set2", "setlength", (char *) NULL
     };
 
@@ -863,7 +864,7 @@ TeststringobjCmd(clientData, interp, objc, objv)
 	return TCL_ERROR;
     }
 
-    index = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    index = Tcl_GetString(objv[2]);
     if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
 	return TCL_ERROR;
     }
@@ -892,7 +893,7 @@ TeststringobjCmd(clientData, interp, objc, objv)
 	    if (Tcl_IsShared(varPtr[varIndex])) {
 		SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
 	    }
-	    string = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+	    string = Tcl_GetString(objv[3]);
 	    Tcl_AppendToObj(varPtr[varIndex], string, length);
 	    Tcl_SetObjResult(interp, varPtr[varIndex]);
 	    break;
@@ -913,9 +914,11 @@ TeststringobjCmd(clientData, interp, objc, objv)
 		SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
 	    }
 	    for (i = 3;  i < objc;  i++) {
-		strings[i-3] = Tcl_GetStringFromObj(objv[i], (int *) NULL);
+		strings[i-3] = Tcl_GetString(objv[i]);
+	    }
+	    for ( ; i < 12 + 3; i++) {
+		strings[i - 3] = NULL;
 	    }
-	    strings[objc-3] = NULL;
 	    Tcl_AppendStringsToObj(varPtr[varIndex], strings[0], strings[1],
 		    strings[2], strings[3], strings[4], strings[5],
 		    strings[6], strings[7], strings[8], strings[9],
@@ -931,21 +934,31 @@ TeststringobjCmd(clientData, interp, objc, objv)
 	    }
 	    Tcl_SetObjResult(interp, varPtr[varIndex]);
 	    break;
-	case 3:				/* length */
+	case 3:				/* get2 */
+	    if (objc != 3) {
+		goto wrongNumArgs;
+	    }
+	    if (CheckIfVarUnset(interp, varIndex)) {
+		return TCL_ERROR;
+	    }
+	    string = Tcl_GetString(varPtr[varIndex]);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp), string, -1);
+	    break;
+	case 4:				/* length */
 	    if (objc != 3) {
 		goto wrongNumArgs;
 	    }
 	    Tcl_SetIntObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL)
 		    ? varPtr[varIndex]->length : -1);
 	    break;
-	case 4:				/* length2 */
+	case 5:				/* length2 */
 	    if (objc != 3) {
 		goto wrongNumArgs;
 	    }
 	    Tcl_SetIntObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL)
 		    ? (int) varPtr[varIndex]->internalRep.longValue : -1);
 	    break;
-	case 5:				/* set */
+	case 6:				/* set */
 	    if (objc != 4) {
 		goto wrongNumArgs;
 	    }
@@ -968,13 +981,13 @@ TeststringobjCmd(clientData, interp, objc, objv)
 	    }
 	    Tcl_SetObjResult(interp, varPtr[varIndex]);
 	    break;
-	case 6:				/* set2 */
+	case 7:				/* set2 */
 	    if (objc != 4) {
 		goto wrongNumArgs;
 	    }
 	    SetVarToObj(varIndex, objv[3]);
 	    break;
-	case 7:				/* setlength */
+	case 8:				/* setlength */
 	    if (objc != 4) {
 		goto wrongNumArgs;
 	    }
@@ -1086,7 +1099,7 @@ CheckIfVarUnset(interp, varIndex)
     int varIndex;		/* Index of the test variable to check. */
 {
     if (varPtr[varIndex] == NULL) {
-	char buf[100];
+	char buf[32 + TCL_INTEGER_SPACE];
 	
 	sprintf(buf, "variable %d is unset (NULL)", varIndex);
 	Tcl_ResetResult(interp);