diff options
Diffstat (limited to 'generic/tclTestObj.c')
| -rw-r--r-- | generic/tclTestObj.c | 193 |
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); |