diff options
49 files changed, 503 insertions, 449 deletions
diff --git a/generic/tcl.h b/generic/tcl.h index e921ec5..0738d09 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2405,19 +2405,8 @@ EXTERN void Tcl_GetMemoryInfo _ANSI_ARGS_((Tcl_DString *dsPtr)); #ifndef TCL_NO_DEPRECATED /* - * Deprecated Tcl functions: - */ - -# undef Tcl_EvalObj -# define Tcl_EvalObj(interp,objPtr) \ - Tcl_EvalObjEx((interp),(objPtr),0) -# undef Tcl_GlobalEvalObj -# define Tcl_GlobalEvalObj(interp,objPtr) \ - Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL) - - /* * These function have been renamed. The old names are deprecated, but we - * define these macros for backwards compatibilty. + * define these macros for backwards compatibility. */ # define Tcl_Ckalloc Tcl_Alloc diff --git a/generic/tclBasic.c b/generic/tclBasic.c index cfb5c43..a4ac861 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -782,8 +782,8 @@ Tcl_CreateInterp(void) */ order.s = 1; - Tcl_SetVar2(interp, "tcl_platform", "byteOrder", - ((order.c[0] == 1) ? "littleEndian" : "bigEndian"), + Tcl_SetVar2Ex(interp, "tcl_platform", "byteOrder", + Tcl_NewStringObj((order.c[0] == 1) ? "littleEndian" : "bigEndian", -1), TCL_GLOBAL_ONLY); Tcl_SetVar2Ex(interp, "tcl_platform", "wordSize", @@ -797,24 +797,13 @@ Tcl_CreateInterp(void) * Set up other variables such as tcl_version and tcl_library */ - Tcl_SetVar(interp, "tcl_patchLevel", TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY); - Tcl_SetVar(interp, "tcl_version", TCL_VERSION, TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(interp, "tcl_patchLevel", NULL, Tcl_NewStringObj(TCL_PATCH_LEVEL, -1), TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(interp, "tcl_version", NULL, Tcl_NewStringObj(TCL_VERSION, -1), TCL_GLOBAL_ONLY); Tcl_TraceVar2(interp, "tcl_precision", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, TclPrecTraceProc, NULL); TclpSetVariables(interp); -#ifdef TCL_THREADS - /* - * The existence of the "threaded" element of the tcl_platform array - * indicates that this particular Tcl shell has been compiled with threads - * turned on. Using "info exists tcl_platform(threaded)" a Tcl script can - * introspect on the interpreter level of thread safety. - */ - - Tcl_SetVar2(interp, "tcl_platform", "threaded", "1", TCL_GLOBAL_ONLY); -#endif - /* * Register Tcl's version number. * TIP #268: Full patchlevel instead of just major.minor @@ -822,9 +811,7 @@ Tcl_CreateInterp(void) Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs); -#ifdef Tcl_InitStubs #undef Tcl_InitStubs -#endif Tcl_InitStubs(interp, TCL_VERSION, 1); if (TclTommath_Init(interp) != TCL_OK) { @@ -4955,6 +4942,7 @@ TclArgumentGet(interp,obj,cfPtrPtr,wordPtr) *---------------------------------------------------------------------- */ +#undef Tcl_Eval int Tcl_Eval( Tcl_Interp *interp, /* Token for command interpreter (returned by @@ -5988,6 +5976,7 @@ Tcl_VarEval( *---------------------------------------------------------------------- */ +#undef Tcl_GlobalEval int Tcl_GlobalEval( Tcl_Interp *interp, /* Interpreter in which to evaluate command. */ diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 9ba06ee..f3b8bc6 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -598,8 +598,8 @@ Tcl_BinaryObjCmd( return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], options, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tclClock.c b/generic/tclClock.c index 5b95ae6..082a7e5 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -548,8 +548,8 @@ ClockGetjuliandayfromerayearmonthdayObjCmd ( } dict = objv[1]; if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK - || Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT, - &era) != TCL_OK + || Tcl_GetIndexFromObjStruct(interp, fieldPtr, eras, sizeof(char *), + "era", TCL_EXACT, &era) != TCL_OK || Tcl_DictObjGet(interp, dict, literals[LIT_YEAR], &fieldPtr) != TCL_OK || TclGetIntFromObj(interp, fieldPtr, &(fields.year)) != TCL_OK @@ -639,8 +639,8 @@ ClockGetjuliandayfromerayearweekdayObjCmd ( } dict = objv[1]; if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK - || Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT, - &era) != TCL_OK + || Tcl_GetIndexFromObjStruct(interp, fieldPtr, eras, sizeof(char *), + "era", TCL_EXACT, &era) != TCL_OK || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601YEAR], &fieldPtr) != TCL_OK || TclGetIntFromObj(interp, fieldPtr, @@ -1708,8 +1708,8 @@ ClockClicksObjCmd( case 1: break; case 2: - if (Tcl_GetIndexFromObj(interp, objv[1], clicksSwitches, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], clicksSwitches, sizeof(char *), + "option", 0, &index) != TCL_OK) { return TCL_ERROR; } break; @@ -1884,8 +1884,8 @@ ClockParseformatargsObjCmd( localeObj = litPtr[LIT_C]; timezoneObj = litPtr[LIT__NIL]; for (i = 2; i < objc; i+=2) { - if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", 0, - &optionIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], options, + sizeof(char *), "switch", 0, &optionIndex) != TCL_OK) { Tcl_SetErrorCode(interp, "CLOCK", "badSwitch", Tcl_GetString(objv[i]), NULL); return TCL_ERROR; diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 8e32389..948d257 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -445,8 +445,8 @@ Tcl_EncodingObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -855,8 +855,8 @@ Tcl_FileObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], fileOptions, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], fileOptions, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -1045,8 +1045,8 @@ Tcl_FileObjCmd( static const char *linkTypes[] = { "-symbolic", "-hard", NULL }; - if (Tcl_GetIndexFromObj(interp, objv[2], linkTypes, "switch", - 0, &linkAction) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[2], linkTypes, + sizeof(char *), "switch", 0, &linkAction) != TCL_OK) { return TCL_ERROR; } if (linkAction == 0) { diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 152e61d..441cf42 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -1518,16 +1518,16 @@ InfoLibraryCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - const char *libDirName; + Tcl_Obj *libDirName; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } - libDirName = Tcl_GetVar(interp, "tcl_library", TCL_GLOBAL_ONLY); + libDirName = Tcl_GetVar2Ex(interp, "tcl_library", NULL, TCL_GLOBAL_ONLY); if (libDirName != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(libDirName, -1)); + Tcl_SetObjResult(interp, libDirName); return TCL_OK; } Tcl_SetResult(interp, "no library has been specified for Tcl",TCL_STATIC); @@ -1641,17 +1641,17 @@ InfoPatchLevelCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - const char *patchlevel; + Tcl_Obj *patchlevel; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } - patchlevel = Tcl_GetVar(interp, "tcl_patchLevel", + patchlevel = Tcl_GetVar2Ex(interp, "tcl_patchLevel", NULL, (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG)); if (patchlevel != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(patchlevel, -1)); + Tcl_SetObjResult(interp, patchlevel); return TCL_OK; } return TCL_ERROR; @@ -2766,8 +2766,8 @@ Tcl_LsearchObjCmd( } for (i = 1; i < objc-2; i++) { - if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index) - != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], options, + sizeof(char *), "option", 0, &index) != TCL_OK) { if (startPtr != NULL) { Tcl_DecrRefCount(startPtr); } @@ -3501,8 +3501,8 @@ Tcl_LsortObjCmd( cmdPtr = NULL; indices = 0; for (i = 1; i < objc-1; i++) { - if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], switches, + sizeof(char *), "option", 0, &index) != TCL_OK) { if (sortInfo.indexc > 1) { ckfree((char *) sortInfo.indexv); } diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 0ad77aa..5bc6fd0 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -118,8 +118,8 @@ Tcl_RegexpObjCmd( if (name[0] != '-') { break; } - if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], options, + sizeof(char *), "switch", TCL_EXACT, &index) != TCL_OK) { goto optionError; } switch ((enum options) index) { @@ -478,8 +478,8 @@ Tcl_RegsubObjCmd( if (name[0] != '-') { break; } - if (Tcl_GetIndexFromObj(interp, objv[idx], options, "switch", - TCL_EXACT, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[idx], options, + sizeof(char *), "switch", TCL_EXACT, &index) != TCL_OK) { goto optionError; } switch ((enum options) index) { @@ -955,8 +955,8 @@ Tcl_SourceObjCmd( }; int index; - if (TCL_ERROR == Tcl_GetIndexFromObj(interp, objv[1], options, - "option", TCL_EXACT, &index)) { + if (TCL_ERROR == Tcl_GetIndexFromObjStruct(interp, objv[1], options, + sizeof(char *), "option", TCL_EXACT, &index)) { return TCL_ERROR; } encodingName = TclGetString(objv[2]); @@ -1437,8 +1437,8 @@ StringIsCmd( "class ?-strict? ?-failindex var? str"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], isClasses, "class", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], isClasses, + sizeof(char *), "class", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -1446,8 +1446,8 @@ StringIsCmd( for (i = 2; i < objc-1; i++) { int idx2; - if (Tcl_GetIndexFromObj(interp, objv[i], isOptions, "option", 0, - &idx2) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], isOptions, + sizeof(char *), "option", 0, &idx2) != TCL_OK) { return TCL_ERROR; } switch ((enum isOptions) idx2) { @@ -3323,8 +3323,8 @@ Tcl_SubstObjCmd( for (i = 1; i < (objc-1); i++) { int optionIndex; - if (Tcl_GetIndexFromObj(interp, objv[i], substOptions, "switch", 0, - &optionIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], substOptions, + sizeof(char *), "switch", 0, &optionIndex) != TCL_OK) { return TCL_ERROR; } switch (optionIndex) { @@ -3423,8 +3423,8 @@ Tcl_SwitchObjCmd( if (TclGetString(objv[i])[0] != '-') { break; } - if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], options, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum options) index) { diff --git a/generic/tclConfig.c b/generic/tclConfig.c index 28549ed..99a04f6 100644 --- a/generic/tclConfig.c +++ b/generic/tclConfig.c @@ -224,8 +224,8 @@ QueryConfigObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?argument?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], subcmdStrings, "subcommand", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], subcmdStrings, + sizeof(char *), "subcommand", 0, &index) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 4225c96..8e897b4 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -6385,5 +6385,61 @@ extern TclStubs *tclStubsPtr; #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT +/* + * Deprecated Tcl functions: + */ + +#undef Tcl_PkgProvide +#define Tcl_PkgProvide(interp, name, version) \ + Tcl_PkgProvideEx((interp), (name), (version), NULL) +#undef Tcl_PkgRequire +#define Tcl_PkgRequire(interp, name, version, exact) \ + Tcl_PkgRequireEx((interp), (name), (version), (exact), NULL) +#undef Tcl_PkgPresent +#define Tcl_PkgPresent(interp, name, version, exact) \ + Tcl_PkgPresentEx((interp), (name), (version), (exact), NULL) +#undef Tcl_Eval +#define Tcl_Eval(interp,command) \ + Tcl_EvalEx((interp),(command),-1,0) +#undef Tcl_GlobalEval +#define Tcl_GlobalEval(interp,command) \ + Tcl_EvalEx((interp),(command),-1,TCL_EVAL_GLOBAL) +#undef Tcl_EvalObj +#define Tcl_EvalObj(interp,objPtr) \ + Tcl_EvalObjEx((interp),(objPtr),0) +#undef Tcl_GlobalEvalObj +#define Tcl_GlobalEvalObj(interp,objPtr) \ + Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL) +#undef Tcl_VarTraceInfo +#define Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData) \ + Tcl_VarTraceInfo2((interp), (varName), NULL, (flags), (proc), (prevClientData)) +#undef Tcl_GetVar +#define Tcl_GetVar(interp, varName, flags) \ + Tcl_GetVar2((interp), (varName), (NULL), (flags)) +#undef Tcl_SetVar +#define Tcl_SetVar(interp, varName, newValue, flags) \ + Tcl_SetVar2((interp), (varName), NULL, (newValue), (flags)) +#undef Tcl_GetChannelNames +#define Tcl_GetChannelNames(interp) \ + Tcl_GetChannelNamesEx((interp), NULL) +#undef Tcl_FSEvalFile +#define Tcl_FSEvalFile(interp, pathPtr) \ + Tcl_FSEvalFileEx((interp), (pathPtr), NULL) +#undef Tcl_TraceVar +#define Tcl_TraceVar(interp, varName, flags, proc, clientData) \ + Tcl_TraceVar2((interp), (varName), NULL, (flags), (proc), (clientData)) +#undef Tcl_UnsetVar +#define Tcl_UnsetVar(interp, varName, flags) \ + Tcl_UnsetVar2((interp), (varName), NULL, (flags)) +#undef Tcl_UntraceVar +#define Tcl_UntraceVar(interp, varName, flags, proc, clientData) \ + Tcl_UntraceVar2((interp), (varName), NULL, (flags), (proc), (clientData)) +#undef Tcl_UpVar +#define Tcl_UpVar(interp, frameName, varName, localName, flags) \ + Tcl_UpVar2((interp), (frameName), (varName), NULL, (localName), (flags)) +#undef Tcl_GetIndexFromObj +#define Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr) \ + Tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), \ + sizeof(char *), (msg), (flags), (indexPtr)) #endif /* _TCLDECLS */ diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index b066d46..4612e81 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -2604,8 +2604,8 @@ DictFilterCmd( Tcl_WrongNumArgs(interp, 1, objv, "dictionary filterType ..."); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[2], filters, "filterType", - 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[2], filters, + sizeof(char *), "filterType", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -2873,7 +2873,7 @@ DictUpdateCmd( } if (objPtr == NULL) { /* ??? */ - Tcl_UnsetVar(interp, Tcl_GetString(objv[i+1]), 0); + Tcl_UnsetVar2(interp, Tcl_GetString(objv[i+1]), NULL, 0); } else if (Tcl_ObjSetVar2(interp, objv[i+1], NULL, objPtr, TCL_LEAVE_ERR_MSG) == NULL) { TclDecrRefCount(dictPtr); diff --git a/generic/tclEnv.c b/generic/tclEnv.c index f2395e6..6d25d59 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -119,7 +119,7 @@ TclSetupEnv( } p2++; p2[-1] = '\0'; - Tcl_SetVar2(interp, "env", p1, p2, TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(interp, "env", p1, Tcl_NewStringObj(p2, -1), TCL_GLOBAL_ONLY); Tcl_DStringFree(&envString); } Tcl_MutexUnlock(&envMutex); @@ -548,10 +548,10 @@ EnvTraceProc( */ if (flags & TCL_TRACE_WRITES) { - const char *value; + Tcl_Obj *value; - value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY); - TclSetEnv(name2, value); + value = Tcl_GetVar2Ex(interp, "env", name2, TCL_GLOBAL_ONLY); + TclSetEnv(name2, Tcl_GetString(value)); } /* @@ -565,7 +565,7 @@ EnvTraceProc( if (value == NULL) { return "no such variable"; } - Tcl_SetVar2(interp, name1, name2, value, 0); + Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewStringObj(value, -1), 0); Tcl_DStringFree(&valueString); } diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 7daa7bb..48e6a99 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -1337,7 +1337,7 @@ Tcl_VwaitObjCmd( return TCL_ERROR; } nameString = Tcl_GetString(objv[1]); - if (Tcl_TraceVar(interp, nameString, + if (Tcl_TraceVar2(interp, nameString, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VwaitVarProc, (ClientData) &done) != TCL_OK) { return TCL_ERROR; @@ -1350,7 +1350,7 @@ Tcl_VwaitObjCmd( break; } } - Tcl_UntraceVar(interp, nameString, + Tcl_UntraceVar2(interp, nameString, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VwaitVarProc, (ClientData) &done); @@ -1420,8 +1420,8 @@ Tcl_UpdateObjCmd( if (objc == 1) { flags = TCL_ALL_EVENTS|TCL_DONT_WAIT; } else if (objc == 2) { - if (Tcl_GetIndexFromObj(interp, objv[1], updateOptions, - "option", 0, &optionIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], updateOptions, + sizeof(char *), "option", 0, &optionIndex) != TCL_OK) { return TCL_ERROR; } switch ((enum updateOptions) optionIndex) { diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index c57a4ff..83f8e5b 100644 --- a/generic/tclFCmd.c +++ b/generic/tclFCmd.c @@ -1073,8 +1073,8 @@ TclFileAttrsCmd( goto end; } - if (Tcl_GetIndexFromObj(interp, objv[0], attributeStrings, - "option", 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[0], attributeStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { goto end; } if (didAlloc) { @@ -1101,8 +1101,8 @@ TclFileAttrsCmd( } for (i = 0; i < objc ; i += 2) { - if (Tcl_GetIndexFromObj(interp, objv[i], attributeStrings, - "option", 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], attributeStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { goto end; } if (didAlloc) { diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 07757d9..cdfaec8 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -1242,8 +1242,8 @@ Tcl_GlobObjCmd( dir = PATH_NONE; typePtr = NULL; for (i = 1; i < objc; i++) { - if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], options, + sizeof(char *), "option", 0, &index) != TCL_OK) { string = Tcl_GetStringFromObj(objv[i], &length); if (string[0] == '-') { /* diff --git a/generic/tclIO.c b/generic/tclIO.c index e2415d8..db47243 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -8413,8 +8413,8 @@ Tcl_FileEventObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[2], modeOptions, "event name", 0, - &modeIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[2], modeOptions, + sizeof(char *), "event name", 0, &modeIndex) != TCL_OK) { return TCL_ERROR; } mask = maskArray[modeIndex]; @@ -9703,6 +9703,7 @@ SetBlockMode( *---------------------------------------------------------------------- */ +#undef Tcl_GetChannelNames int Tcl_GetChannelNames( Tcl_Interp *interp) /* Interp for error reporting. */ diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 21dcd71..45d19df 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -532,8 +532,8 @@ Tcl_SeekObjCmd( } mode = SEEK_SET; if (objc == 4) { - if (Tcl_GetIndexFromObj(interp, objv[3], originOptions, "origin", 0, - &optionIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[3], originOptions, + sizeof(char *), "origin", 0, &optionIndex) != TCL_OK) { return TCL_ERROR; } mode = modeArray[optionIndex]; @@ -853,8 +853,8 @@ Tcl_ExecObjCmd( if (string[0] != '-') { break; } - if (Tcl_GetIndexFromObj(interp, objv[skip], options, "switch", - TCL_EXACT, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[skip], options, + sizeof(char *), "switch", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } if (index == EXEC_KEEPNEWLINE) { @@ -1432,8 +1432,8 @@ Tcl_SocketObjCmd( if (arg[0] != '-') { break; } - if (Tcl_GetIndexFromObj(interp, objv[a], socketOptions, "option", - TCL_EXACT, &optionIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[a], socketOptions, + sizeof(char*), "option", TCL_EXACT, &optionIndex) != TCL_OK) { return TCL_ERROR; } switch ((enum socketOptions) optionIndex) { @@ -1628,8 +1628,8 @@ Tcl_FcopyObjCmd( toRead = -1; cmdPtr = NULL; for (i = 3; i < objc; i += 2) { - if (Tcl_GetIndexFromObj(interp, objv[i], switches, "switch", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], switches, + sizeof(char *), "switch", 0, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { @@ -1693,8 +1693,8 @@ ChanPendingObjCmd( return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], options, "mode", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], options, + sizeof(char *), "mode", 0, &index) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index ca3ab4b..a18a79e 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -612,8 +612,8 @@ TclChanCreateObjCmd( methods = 0; while (listc > 0) { - if (Tcl_GetIndexFromObj(interp, listv[listc-1], methodNames, - "method", TCL_EXACT, &methIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, listv[listc-1], methodNames, + sizeof(char *), "method", TCL_EXACT, &methIndex) != TCL_OK) { TclNewLiteralStringObj(err, "chan handler \""); Tcl_AppendObjToObj(err, cmdObj); Tcl_AppendToObj(err, " initialize\" returned ", -1); @@ -1932,8 +1932,8 @@ EncodeEventMask( events = 0; while (listc > 0) { - if (Tcl_GetIndexFromObj(interp, listv[listc-1], eventOptions, - objName, 0, &evIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, listv[listc-1], eventOptions, + sizeof(char *), objName, 0, &evIndex) != TCL_OK) { return TCL_ERROR; } switch (evIndex) { diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index f90bf0d..51a5211 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -261,7 +261,7 @@ Tcl_EvalFile( int ret; Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1); Tcl_IncrRefCount(pathPtr); - ret = Tcl_FSEvalFile(interp, pathPtr); + ret = Tcl_FSEvalFileEx(interp, pathPtr, NULL); Tcl_DecrRefCount(pathPtr); return ret; } @@ -1734,6 +1734,7 @@ TclGetOpenModeEx( * Tcl_FSEvalFile is Tcl_FSEvalFileEx without encoding argument. */ +#undef Tcl_FSEvalFile int Tcl_FSEvalFile( Tcl_Interp *interp, /* Interpreter in which to process file. */ @@ -2517,8 +2518,8 @@ TclFSFileAttrIndex( Tcl_Obj *tmpObj = Tcl_NewStringObj(attributeName, -1); int result; - result = Tcl_GetIndexFromObj(NULL, tmpObj, attrTable, NULL, TCL_EXACT, - indexPtr); + result = Tcl_GetIndexFromObjStruct(NULL, tmpObj, attrTable, + sizeof(char *), NULL, TCL_EXACT, indexPtr); TclDecrRefCount(tmpObj); if (listObj != NULL) { TclDecrRefCount(listObj); diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 944fb8e..63e10f1 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -85,6 +85,7 @@ typedef struct { *---------------------------------------------------------------------- */ +#undef Tcl_GetIndexFromObj int Tcl_GetIndexFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ @@ -170,6 +171,11 @@ Tcl_GetIndexFromObjStruct( Tcl_Obj *resultPtr; IndexRep *indexRep; + /* Protect against invalid offset value, such as -1 or 0. */ + if (offset < sizeof(char *)) { + offset = sizeof(char *); + } + /* * See if there is a valid cached result from a previous lookup. */ diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 058714f..7613630 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -296,7 +296,7 @@ Tcl_Init( Tcl_Interp *interp) /* Interpreter to initialize. */ { if (tclPreInitScript != NULL) { - if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) { + if (Tcl_EvalEx(interp, tclPreInitScript, -1, 0) == TCL_ERROR) { return (TCL_ERROR); }; } @@ -342,7 +342,7 @@ Tcl_Init( * alternate tclInit command before calling Tcl_Init(). */ - return Tcl_Eval(interp, + return Tcl_EvalEx(interp, "if {[namespace which -command tclInit] eq \"\"} {\n" " proc tclInit {} {\n" " global tcl_libPath tcl_library env tclDefaultLibrary\n" @@ -404,7 +404,7 @@ Tcl_Init( " error $msg\n" " }\n" "}\n" -"tclInit"); +"tclInit", -1, 0); } /* @@ -577,8 +577,8 @@ Tcl_InterpObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], options, sizeof(char *), + "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum option) index) { @@ -660,8 +660,8 @@ Tcl_InterpObjCmd( last = 0; for (i = 2; i < objc; i++) { if ((last == 0) && (Tcl_GetString(objv[i])[0] == '-')) { - if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], options, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } if (index == OPT_SAFE) { @@ -834,8 +834,8 @@ Tcl_InterpObjCmd( if (TclGetString(objv[i])[0] != '-') { break; } - if (Tcl_GetIndexFromObj(interp, objv[i], hiddenOptions, "option", - 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], hiddenOptions, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } if (index == OPT_GLOBAL) { @@ -881,8 +881,8 @@ Tcl_InterpObjCmd( if (slaveInterp == NULL) { return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[3], limitTypes, "limit type", 0, - &limitType) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[3], limitTypes, + sizeof(char *), "limit type", 0, &limitType) != TCL_OK) { return TCL_ERROR; } switch ((enum LimitTypes) limitType) { @@ -2157,7 +2157,7 @@ SlaveCreate( SlaveObjCmd, slaveInterp, SlaveObjCmdDeleteProc); Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS); Tcl_SetHashValue(hPtr, slavePtr); - Tcl_SetVar(slaveInterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(slaveInterp, "tcl_interactive", NULL, Tcl_NewIntObj(0), TCL_GLOBAL_ONLY); /* * Inherit the recursion limit. @@ -2264,8 +2264,8 @@ SlaveObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], options, sizeof(char *), + "option", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -2354,8 +2354,8 @@ SlaveObjCmd( if (TclGetString(objv[i])[0] != '-') { break; } - if (Tcl_GetIndexFromObj(interp, objv[i], hiddenOptions, "option", - 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], hiddenOptions, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } if (index == OPT_GLOBAL) { @@ -2392,8 +2392,8 @@ SlaveObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "limitType ?options?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[2], limitTypes, "limit type", 0, - &limitType) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[2], limitTypes, + sizeof(char *), "limit type", 0, &limitType) != TCL_OK) { return TCL_ERROR; } switch ((enum LimitTypes) limitType) { @@ -2511,8 +2511,8 @@ SlaveDebugCmd( Tcl_NewBooleanObj(iPtr->flags & INTERP_DEBUG_FRAME)); Tcl_SetObjResult(interp, resultPtr); } else { - if (Tcl_GetIndexFromObj(interp, objv[0], debugTypes, - "debug option", 0, &debugType) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[0], debugTypes, + sizeof(char *), "debug option", 0, &debugType) != TCL_OK) { return TCL_ERROR; } if (debugType == DEBUG_TYPE_FRAME) { @@ -2926,8 +2926,8 @@ Tcl_MakeSafe( * Assume these functions all work. [Bug 2895741] */ - (void) Tcl_Eval(interp, - "namespace eval ::tcl {namespace eval mathfunc {}}"); + (void) Tcl_EvalEx(interp, + "namespace eval ::tcl {namespace eval mathfunc {}}", -1, 0); (void) Tcl_CreateAlias(interp, "::tcl::mathfunc::min", master, "::tcl::mathfunc::min", 0, NULL); (void) Tcl_CreateAlias(interp, "::tcl::mathfunc::max", master, @@ -2945,7 +2945,7 @@ Tcl_MakeSafe( * No env array in a safe slave. */ - Tcl_UnsetVar(interp, "env", TCL_GLOBAL_ONLY); + Tcl_UnsetVar2(interp, "env", NULL, TCL_GLOBAL_ONLY); /* * Remove unsafe parts of tcl_platform @@ -2961,9 +2961,9 @@ Tcl_MakeSafe( * nameofexecutable]) */ - Tcl_UnsetVar(interp, "tclDefaultLibrary", TCL_GLOBAL_ONLY); - Tcl_UnsetVar(interp, "tcl_library", TCL_GLOBAL_ONLY); - Tcl_UnsetVar(interp, "tcl_pkgPath", TCL_GLOBAL_ONLY); + Tcl_UnsetVar2(interp, "tclDefaultLibrary", NULL, TCL_GLOBAL_ONLY); + Tcl_UnsetVar2(interp, "tcl_library", NULL, TCL_GLOBAL_ONLY); + Tcl_UnsetVar2(interp, "tcl_pkgPath", NULL, TCL_GLOBAL_ONLY); /* * Remove the standard channels from the interpreter; safe interpreters do @@ -4186,8 +4186,8 @@ SlaveCommandLimitCmd( Tcl_SetObjResult(interp, dictPtr); return TCL_OK; } else if (objc == consumedObjc+1) { - if (Tcl_GetIndexFromObj(interp, objv[consumedObjc], options, "option", - 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[consumedObjc], options, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum Options) index) { @@ -4224,8 +4224,8 @@ SlaveCommandLimitCmd( int gran = 0, limit = 0; for (i=consumedObjc ; i<objc ; i+=2) { - if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], options, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum Options) index) { @@ -4376,8 +4376,8 @@ SlaveTimeLimitCmd( Tcl_SetObjResult(interp, dictPtr); return TCL_OK; } else if (objc == consumedObjc+1) { - if (Tcl_GetIndexFromObj(interp, objv[consumedObjc], options, "option", - 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[consumedObjc], options, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum Options) index) { @@ -4429,8 +4429,8 @@ SlaveTimeLimitCmd( Tcl_LimitGetTime(slaveInterp, &limitMoment); for (i=consumedObjc ; i<objc ; i+=2) { - if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], options, sizeof(char *), + "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum Options) index) { diff --git a/generic/tclLink.c b/generic/tclLink.c index f7911a4..c1bdaea 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -112,8 +112,8 @@ Tcl_LinkVar( Link *linkPtr; int code; - linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY, - LinkTraceProc, (ClientData) NULL); + linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL, + TCL_GLOBAL_ONLY, LinkTraceProc, (ClientData) NULL); if (linkPtr != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "variable '%s' is already linked", varName)); @@ -138,9 +138,9 @@ Tcl_LinkVar( ckfree((char *) linkPtr); return TCL_ERROR; } - code = Tcl_TraceVar(interp, varName, TCL_GLOBAL_ONLY|TCL_TRACE_READS - |TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc, - (ClientData) linkPtr); + code = Tcl_TraceVar2(interp, varName, NULL, + TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + LinkTraceProc, (ClientData) linkPtr); if (code != TCL_OK) { Tcl_DecrRefCount(linkPtr->varName); ckfree((char *) linkPtr); @@ -173,12 +173,12 @@ Tcl_UnlinkVar( { Link *linkPtr; - linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY, - LinkTraceProc, (ClientData) NULL); + linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL, + TCL_GLOBAL_ONLY, LinkTraceProc, (ClientData) NULL); if (linkPtr == NULL) { return; } - Tcl_UntraceVar(interp, varName, + Tcl_UntraceVar2(interp, varName, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc, (ClientData) linkPtr); Tcl_DecrRefCount(linkPtr->varName); @@ -212,8 +212,8 @@ Tcl_UpdateLinkedVar( Link *linkPtr; int savedFlag; - linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY, - LinkTraceProc, (ClientData) NULL); + linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL, + TCL_GLOBAL_ONLY, LinkTraceProc, (ClientData) NULL); if (linkPtr == NULL) { return; } @@ -224,8 +224,8 @@ Tcl_UpdateLinkedVar( /* * Callback may have unlinked the variable. [Bug 1740631] */ - linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY, - LinkTraceProc, (ClientData) NULL); + linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL, + TCL_GLOBAL_ONLY, LinkTraceProc, (ClientData) NULL); if (linkPtr != NULL) { linkPtr->flags = (linkPtr->flags & ~LINK_BEING_UPDATED) | savedFlag; } @@ -281,7 +281,7 @@ LinkTraceProc( } else if (flags & TCL_TRACE_DESTROYED) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - Tcl_TraceVar(interp, Tcl_GetString(linkPtr->varName), + Tcl_TraceVar2(interp, Tcl_GetString(linkPtr->varName), NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES |TCL_TRACE_UNSETS, LinkTraceProc, (ClientData) linkPtr); } diff --git a/generic/tclLoad.c b/generic/tclLoad.c index ac863b9..eaf6a70 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -521,8 +521,8 @@ Tcl_UnloadObjCmd( }; for (i = 1; i < objc; i++) { - if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], options, + sizeof(char *), "option", 0, &index) != TCL_OK) { fullFileName = Tcl_GetString(objv[i]); if (fullFileName[0] == '-') { /* diff --git a/generic/tclMain.c b/generic/tclMain.c index 7a19a38..5a380ff 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -13,9 +13,6 @@ #include "tclInt.h" -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - /* * The default prompt used when the user has not overridden it. */ @@ -270,16 +267,16 @@ Tcl_SourceRCFile( Tcl_Interp *interp) /* Interpreter to source rc file into. */ { Tcl_DString temp; - CONST char *fileName; - Tcl_Channel errChannel; + Tcl_Obj *fileName; + Tcl_Channel chan; - fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY); + fileName = Tcl_GetVar2Ex(interp, "tcl_rcFileName", NULL, TCL_GLOBAL_ONLY); if (fileName != NULL) { Tcl_Channel c; CONST char *fullName; Tcl_DStringInit(&temp); - fullName = Tcl_TranslateFileName(interp, fileName, &temp); + fullName = Tcl_TranslateFileName(interp, Tcl_GetString(fileName), &temp); if (fullName == NULL) { /* * Couldn't translate the file name (e.g. it referred to a bogus @@ -291,17 +288,21 @@ Tcl_SourceRCFile( * Test for the existence of the rc file before trying to read it. */ - c = Tcl_OpenFileChannel(NULL, fullName, "r", 0); + Tcl_Obj *fullNameObj = Tcl_NewStringObj(fullName, -1); + Tcl_IncrRefCount(fullNameObj); + c = Tcl_FSOpenFileChannel(NULL, fullNameObj, "r", 0); if (c != (Tcl_Channel) NULL) { + Tcl_Close(NULL, c); - if (Tcl_EvalFile(interp, fullName) != TCL_OK) { - errChannel = Tcl_GetStdChannel(TCL_STDERR); - if (errChannel) { - Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); - Tcl_WriteChars(errChannel, "\n", 1); - } - } - } + if (Tcl_FSEvalFileEx(interp, fullNameObj, NULL) != TCL_OK) { + chan = Tcl_GetStdChannel(TCL_STDERR); + if (chan) { + Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); + Tcl_WriteChars(chan, "\n", 1); + } + } + Tcl_DecrRefCount(fullNameObj); + } } Tcl_DStringFree(&temp); } @@ -383,7 +384,7 @@ Tcl_Main( path = Tcl_NewStringObj(Tcl_DStringValue(&appName), -1); Tcl_SetStartupScript(path, encodingName); } - Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&appName), TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(interp, "argv0", NULL, Tcl_NewStringObj(Tcl_DStringValue(&appName), -1), TCL_GLOBAL_ONLY); Tcl_DStringFree(&appName); argc--; argv++; @@ -405,7 +406,7 @@ Tcl_Main( */ tty = isatty(0); - Tcl_SetVar(interp, "tcl_interactive", ((path == NULL) && tty) ? "1" : "0", + Tcl_SetVar2Ex(interp, "tcl_interactive", NULL, Tcl_NewIntObj((path == NULL) && tty), TCL_GLOBAL_ONLY); /* diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 5dbffc6..ea955b0 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -569,10 +569,10 @@ EstablishErrorCodeTraces( const char *name2, int flags) { - Tcl_TraceVar(interp, "errorCode", TCL_GLOBAL_ONLY | TCL_TRACE_READS, - ErrorCodeRead, NULL); - Tcl_TraceVar(interp, "errorCode", TCL_GLOBAL_ONLY | TCL_TRACE_UNSETS, - EstablishErrorCodeTraces, NULL); + Tcl_TraceVar2(interp, "errorCode", NULL, + TCL_GLOBAL_ONLY | TCL_TRACE_READS, ErrorCodeRead, NULL); + Tcl_TraceVar2(interp, "errorCode", NULL, + TCL_GLOBAL_ONLY | TCL_TRACE_UNSETS, EstablishErrorCodeTraces, NULL); return NULL; } @@ -643,10 +643,10 @@ EstablishErrorInfoTraces( const char *name2, int flags) { - Tcl_TraceVar(interp, "errorInfo", TCL_GLOBAL_ONLY | TCL_TRACE_READS, - ErrorInfoRead, NULL); - Tcl_TraceVar(interp, "errorInfo", TCL_GLOBAL_ONLY | TCL_TRACE_UNSETS, - EstablishErrorInfoTraces, NULL); + Tcl_TraceVar2(interp, "errorInfo", NULL, + TCL_GLOBAL_ONLY | TCL_TRACE_READS, ErrorInfoRead, NULL); + Tcl_TraceVar2(interp, "errorInfo", NULL, + TCL_GLOBAL_ONLY | TCL_TRACE_UNSETS, EstablishErrorInfoTraces, NULL); return NULL; } @@ -2794,8 +2794,8 @@ Tcl_NamespaceObjCmd( * Return an index reflecting the particular subcommand. */ - result = Tcl_GetIndexFromObj((Tcl_Interp *) interp, objv[1], subCmds, - "option", /*flags*/ 0, (int *) &index); + result = Tcl_GetIndexFromObjStruct((Tcl_Interp *) interp, objv[1], + subCmds, sizeof(char *), "option", /*flags*/ 0, (int *) &index); if (result != TCL_OK) { return result; } @@ -4531,8 +4531,8 @@ NamespaceWhichCmd( * Look for a flag controlling the lookup. */ - if (Tcl_GetIndexFromObj(interp, objv[2], opts, "option", 0, - &lookupType) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[2], opts, sizeof(char *), + "option", 0, &lookupType) != TCL_OK) { /* * Preserve old style of error message! */ @@ -4790,8 +4790,8 @@ NamespaceEnsembleCmd( Tcl_WrongNumArgs(interp, 2, objv, "subcommand ?arg ...?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[2], subcommands, "subcommand", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[2], subcommands, + sizeof(char *), "subcommand", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -4828,8 +4828,8 @@ NamespaceEnsembleCmd( */ for (; objc>1 ; objc-=2,objv+=2 ) { - if (Tcl_GetIndexFromObj(interp, objv[0], createOptions, "option", - 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[0], createOptions, + sizeof(char *), "option", 0, &index) != TCL_OK) { if (allocatedMapFlag) { Tcl_DecrRefCount(mapObj); } @@ -4988,8 +4988,8 @@ NamespaceEnsembleCmd( if (objc == 5) { Tcl_Obj *resultObj = NULL; /* silence gcc 4 warning */ - if (Tcl_GetIndexFromObj(interp, objv[4], configOptions, "option", - 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[4], configOptions, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum EnsConfigOpts) index) { @@ -5104,8 +5104,8 @@ NamespaceEnsembleCmd( */ for (; objc>0 ; objc-=2,objv+=2 ) { - if (Tcl_GetIndexFromObj(interp, objv[0], configOptions, - "option", 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[0], configOptions, + sizeof(char *), "option", 0, &index) != TCL_OK) { if (allocatedMapFlag) { Tcl_DecrRefCount(mapObj); } diff --git a/generic/tclPkg.c b/generic/tclPkg.c index aed80c0..1a8a021 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -106,6 +106,7 @@ static const char * PkgRequireCore(Tcl_Interp *interp, const char *name, *---------------------------------------------------------------------- */ +#undef Tcl_PkgProvide int Tcl_PkgProvide( Tcl_Interp *interp, /* Interpreter in which package is now @@ -186,6 +187,7 @@ Tcl_PkgProvideEx( *---------------------------------------------------------------------- */ +#undef Tcl_PkgRequire const char * Tcl_PkgRequire( Tcl_Interp *interp, /* Interpreter in which package is now @@ -651,6 +653,7 @@ PkgRequireCore( *---------------------------------------------------------------------- */ +#undef Tcl_PkgPresent const char * Tcl_PkgPresent( Tcl_Interp *interp, /* Interpreter in which package is now @@ -765,8 +768,8 @@ Tcl_PackageObjCmd( return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], pkgOptions, "option", 0, - &optionIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], pkgOptions, + sizeof(char *), "option", 0, &optionIndex) != TCL_OK) { return TCL_ERROR; } switch ((enum pkgOptions) optionIndex) { @@ -941,7 +944,7 @@ Tcl_PackageObjCmd( if (CheckVersionAndConvert(interp, argv3, NULL, NULL) != TCL_OK) { return TCL_ERROR; } - return Tcl_PkgProvide(interp, argv2, argv3); + return Tcl_PkgProvideEx(interp, argv2, argv3, NULL); case PKG_REQUIRE: require: if (objc < 3) { @@ -1031,8 +1034,8 @@ Tcl_PackageObjCmd( int newPref; - if (Tcl_GetIndexFromObj(interp, objv[2], pkgPreferOptions, - "preference", 0, &newPref) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[2], pkgPreferOptions, + sizeof(char *), "preference", 0, &newPref) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tclProc.c b/generic/tclProc.c index 2c6d300..699f927 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -2815,7 +2815,8 @@ Tcl_DisassembleObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "type procName|lambdaTerm|script"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], types, "type", 0, &idx)!=TCL_OK){ + if (Tcl_GetIndexFromObjStruct(interp, objv[1], types, sizeof(char *), + "type", 0, &idx) != TCL_OK){ return TCL_ERROR; } diff --git a/generic/tclResult.c b/generic/tclResult.c index 7b58d44..778170f 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -1339,8 +1339,8 @@ TclMergeReturnOptions( "ok", "error", "return", "break", "continue", NULL }; - if (TCL_ERROR == Tcl_GetIndexFromObj(NULL, valuePtr, returnCodes, - NULL, TCL_EXACT, &code)) { + if (TCL_ERROR == Tcl_GetIndexFromObjStruct(NULL, valuePtr, returnCodes, + sizeof(char *), NULL, TCL_EXACT, &code)) { /* * Value is not a legal return code. */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index d06e174..3211af6 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -33,6 +33,19 @@ #undef Tcl_CreateHashEntry #undef TclpGetPid #undef TclSockMinimumBuffers +#undef Tcl_VarTraceInfo +#undef Tcl_PkgProvide +#undef Tcl_PkgRequire +#undef Tcl_PkgPresent +#undef Tcl_GetVar +#undef Tcl_SetVar +#undef Tcl_GetChannelNames +#undef Tcl_FSEvalFile +#undef Tcl_TraceVar +#undef Tcl_UnsetVar +#undef Tcl_UntraceVar +#undef Tcl_UpVar +#undef Tcl_GetIndexFromObj /* * Keep a record of the original Notifier procedures, created in the diff --git a/generic/tclTest.c b/generic/tclTest.c index 3c39a40..7df3325 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -532,14 +532,8 @@ static Tcl_Filesystem simpleFilesystem = { }; -/* - * External (platform specific) initialization routine, these declarations - * explicitly don't use EXTERN since this code does not get compiled into the - * library: - */ - -extern int TclplatformtestInit(Tcl_Interp *interp); -extern int TclThread_Init(Tcl_Interp *interp); +MODULE_SCOPE int TclplatformtestInit(Tcl_Interp *interp); +MODULE_SCOPE int TclThread_Init(Tcl_Interp *interp); /* *---------------------------------------------------------------------- @@ -576,7 +570,7 @@ Tcltest_Init( /* TIP #268: Full patchlevel instead of just major.minor */ - if (Tcl_PkgProvide(interp, "Tcltest", TCL_PATCH_LEVEL) == TCL_ERROR) { + if (Tcl_PkgProvideEx(interp, "Tcltest", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) { return TCL_ERROR; } @@ -736,8 +730,8 @@ Tcltest_Init( if (Tcl_ListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) { return TCL_ERROR; } - if (objc && (Tcl_GetIndexFromObj(NULL, objv[0], specialOptions, NULL, - TCL_EXACT, &index) == TCL_OK)) { + if (objc && (Tcl_GetIndexFromObjStruct(NULL, objv[0], specialOptions, + sizeof(char *), NULL, TCL_EXACT, &index) == TCL_OK)) { switch (index) { case 0: return TCL_ERROR; @@ -944,7 +938,7 @@ AsyncHandlerProc( listArgv[3] = NULL; cmd = Tcl_Merge(3, listArgv); if (interp != NULL) { - code = Tcl_Eval(interp, cmd); + code = Tcl_EvalEx(interp, cmd, -1, 0); } else { /* * this should not happen, but by definition of how async handlers are @@ -1228,7 +1222,7 @@ TestcmdtraceCmd( Tcl_DStringInit(&buffer); cmdTrace = Tcl_CreateTrace(interp, 50000, (Tcl_CmdTraceProc *) CmdTraceProc, (ClientData) &buffer); - result = Tcl_Eval(interp, argv[2]); + result = Tcl_EvalEx(interp, argv[2], -1, 0); if (result == TCL_OK) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL); @@ -1245,13 +1239,13 @@ TestcmdtraceCmd( cmdTrace = Tcl_CreateTrace(interp, 50000, (Tcl_CmdTraceProc *) CmdTraceDeleteProc, (ClientData) NULL); - Tcl_Eval(interp, argv[2]); + Tcl_EvalEx(interp, argv[2], -1, 0); } else if (strcmp(argv[1], "leveltest") == 0) { Interp *iPtr = (Interp *) interp; Tcl_DStringInit(&buffer); cmdTrace = Tcl_CreateTrace(interp, iPtr->numLevels + 4, (Tcl_CmdTraceProc *) CmdTraceProc, (ClientData) &buffer); - result = Tcl_Eval(interp, argv[2]); + result = Tcl_EvalEx(interp, argv[2], -1, 0); if (result == TCL_OK) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL); @@ -1269,7 +1263,7 @@ TestcmdtraceCmd( cmdTrace = Tcl_CreateObjTrace(interp, 50000, TCL_ALLOW_INLINE_COMPILATION, ObjTraceProc, (ClientData) &deleteCalled, ObjTraceDeleteProc); - result = Tcl_Eval(interp, argv[2]); + result = Tcl_EvalEx(interp, argv[2], -1, 0); Tcl_DeleteTrace(interp, cmdTrace); if (!deleteCalled) { Tcl_SetResult(interp, "Delete wasn't called", TCL_STATIC); @@ -1285,7 +1279,7 @@ TestcmdtraceCmd( (Tcl_CmdTraceProc *) CmdTraceProc, (ClientData) &buffer); t2 = Tcl_CreateTrace(interp, 50000, (Tcl_CmdTraceProc *) CmdTraceProc, (ClientData) &buffer); - result = Tcl_Eval(interp, argv[2]); + result = Tcl_EvalEx(interp, argv[2], -1, 0); if (result == TCL_OK) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL); @@ -1614,7 +1608,7 @@ DelDeleteProc( { DelCmd *dPtr = (DelCmd *) clientData; - Tcl_Eval(dPtr->interp, dPtr->deleteCmd); + Tcl_EvalEx(dPtr->interp, dPtr->deleteCmd, -1, 0); Tcl_ResetResult(dPtr->interp); ckfree(dPtr->deleteCmd); ckfree((char *) dPtr); @@ -1726,8 +1720,8 @@ TestdoubledigitsObjCmd(ClientData unused, } if (status != TCL_OK || Tcl_GetIntFromObj(interp, objv[2], &ndigits) != TCL_OK - || Tcl_GetIndexFromObj(interp, objv[3], options, "conversion type", - TCL_EXACT, &type) != TCL_OK) { + || Tcl_GetIndexFromObjStruct(interp, objv[3], options, + sizeof(char *), "conversion type", TCL_EXACT, &type) != TCL_OK) { fprintf(stderr, "bad value? %g\n", d); return TCL_ERROR; } @@ -1915,8 +1909,8 @@ TestencodingObjCmd( ENC_CREATE, ENC_DELETE }; - if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -1979,7 +1973,7 @@ EncodingToUtfProc( TclEncoding *encodingPtr; encodingPtr = (TclEncoding *) clientData; - Tcl_GlobalEval(encodingPtr->interp, encodingPtr->toUtfCmd); + Tcl_EvalEx(encodingPtr->interp, encodingPtr->toUtfCmd, -1, TCL_EVAL_GLOBAL); len = strlen(Tcl_GetStringResult(encodingPtr->interp)); if (len > dstLen) { @@ -2011,7 +2005,7 @@ EncodingFromUtfProc( TclEncoding *encodingPtr; encodingPtr = (TclEncoding *) clientData; - Tcl_GlobalEval(encodingPtr->interp, encodingPtr->fromUtfCmd); + Tcl_EvalEx(encodingPtr->interp, encodingPtr->fromUtfCmd, -1, TCL_EVAL_GLOBAL); len = strlen(Tcl_GetStringResult(encodingPtr->interp)); if (len > dstLen) { @@ -2176,8 +2170,8 @@ TesteventObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "subcommand", - TCL_EXACT, &subCmdIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], subcommands, + sizeof(char *), "subcommand", TCL_EXACT, &subCmdIndex) != TCL_OK) { return TCL_ERROR; } switch (subCmdIndex) { @@ -2186,8 +2180,8 @@ TesteventObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "name position script"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[3], positions, - "position specifier", TCL_EXACT, &posIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[3], positions, + sizeof(char *), "position specifier", TCL_EXACT, &posIndex) != TCL_OK) { return TCL_ERROR; } ev = (TestEvent *) ckalloc(sizeof(TestEvent)); @@ -3290,8 +3284,8 @@ TestlocaleCmd( return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -3836,8 +3830,8 @@ TestregexpObjCmd( if (name[0] != '-') { break; } - if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], options, + sizeof(char *), "switch", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum options) index) { @@ -3915,14 +3909,14 @@ TestregexpObjCmd( Tcl_SetIntObj(Tcl_GetObjResult(interp), 0); if (objc > 2 && (cflags®_EXPECT) && indices) { char *varName; - const char *value; + Tcl_Obj *value; int start, end; char resinfo[TCL_INTEGER_SPACE * 2]; varName = Tcl_GetString(objv[2]); TclRegExpRangeUniChar(regExpr, -1, &start, &end); sprintf(resinfo, "%d %d", start, end-1); - value = Tcl_SetVar(interp, varName, resinfo, 0); + value = Tcl_SetVar2Ex(interp, varName, NULL, Tcl_NewStringObj(resinfo, -1), 0); if (value == NULL) { Tcl_AppendResult(interp, "couldn't set variable \"", varName, "\"", NULL); @@ -3930,13 +3924,13 @@ TestregexpObjCmd( } } else if (cflags & TCL_REG_CANMATCH) { char *varName; - const char *value; + Tcl_Obj *value; char resinfo[TCL_INTEGER_SPACE * 2]; Tcl_RegExpGetInfo(regExpr, &info); varName = Tcl_GetString(objv[2]); sprintf(resinfo, "%ld", info.extendStart); - value = Tcl_SetVar(interp, varName, resinfo, 0); + value = Tcl_SetVar2Ex(interp, varName, NULL, Tcl_NewStringObj(resinfo, -1), 0); if (value == NULL) { Tcl_AppendResult(interp, "couldn't set variable \"", varName, "\"", NULL); @@ -4281,7 +4275,7 @@ StaticInitProc( Tcl_Interp *interp) /* Interpreter in which package is supposedly * being loaded. */ { - Tcl_SetVar(interp, "x", "loaded", TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(interp, "x", NULL, Tcl_NewStringObj("loaded", -1), TCL_GLOBAL_ONLY); return TCL_OK; } @@ -4365,7 +4359,7 @@ TestupvarCmd( } else if (strcmp(argv[4], "namespace") == 0) { flags = TCL_NAMESPACE_ONLY; } - return Tcl_UpVar(interp, argv[1], argv[2], argv[3], flags); + return Tcl_UpVar2(interp, argv[1], argv[2], NULL, argv[3], flags); } else { if (strcmp(argv[5], "global") == 0) { flags = TCL_GLOBAL_ONLY; @@ -4484,7 +4478,7 @@ TestfeventCmd( return TCL_ERROR; } if (interp2 != NULL) { - code = Tcl_GlobalEval(interp2, argv[2]); + code = Tcl_EvalEx(interp2, argv[2], -1, TCL_EVAL_GLOBAL); Tcl_SetObjResult(interp, Tcl_GetObjResult(interp2)); return code; } else { @@ -4726,7 +4720,7 @@ GetTimesCmd( double timePer; Tcl_Time start, stop; Tcl_Obj *objPtr, **objv; - const char *s; + Tcl_Obj *s; char newString[TCL_INTEGER_SPACE]; /* alloc & free 100000 times */ @@ -4848,7 +4842,7 @@ GetTimesCmd( fprintf(stderr, "Tcl_SetVar of \"12345\" 100000 times\n"); Tcl_GetTime(&start); for (i = 0; i < 100000; i++) { - s = Tcl_SetVar(interp, "a", "12345", TCL_LEAVE_ERR_MSG); + s = Tcl_SetVar2Ex(interp, "a", NULL, Tcl_NewStringObj("12345", -1), TCL_LEAVE_ERR_MSG); if (s == NULL) { return TCL_ERROR; } @@ -4862,7 +4856,7 @@ GetTimesCmd( fprintf(stderr, "Tcl_GetVar of a==\"12345\" 100000 times\n"); Tcl_GetTime(&start); for (i = 0; i < 100000; i++) { - s = Tcl_GetVar(interp, "a", TCL_LEAVE_ERR_MSG); + s = Tcl_GetVar2Ex(interp, "a", NULL, TCL_LEAVE_ERR_MSG); if (s == NULL) { return TCL_ERROR; } @@ -4956,23 +4950,23 @@ TestsetCmd( const char **argv) /* Argument strings. */ { int flags = PTR2INT(data); - const char *value; + Tcl_Obj *value; if (argc == 2) { Tcl_SetResult(interp, "before get", TCL_STATIC); - value = Tcl_GetVar2(interp, argv[1], NULL, flags); + value = Tcl_GetVar2Ex(interp, argv[1], NULL, flags); if (value == NULL) { return TCL_ERROR; } - Tcl_AppendElement(interp, value); + Tcl_AppendElement(interp, Tcl_GetString(value)); return TCL_OK; } else if (argc == 3) { Tcl_SetResult(interp, "before set", TCL_STATIC); - value = Tcl_SetVar2(interp, argv[1], NULL, argv[2], flags); + value = Tcl_SetVar2Ex(interp, argv[1], NULL, Tcl_NewStringObj(argv[2], -1), flags); if (value == NULL) { return TCL_ERROR; } - Tcl_AppendElement(interp, value); + Tcl_AppendElement(interp, Tcl_GetString(value)); return TCL_OK; } else { Tcl_AppendResult(interp, "wrong # args: should be \"", @@ -4988,23 +4982,23 @@ Testset2Cmd( const char **argv) /* Argument strings. */ { int flags = PTR2INT(data); - const char *value; + Tcl_Obj *value; if (argc == 3) { Tcl_SetResult(interp, "before get", TCL_STATIC); - value = Tcl_GetVar2(interp, argv[1], argv[2], flags); + value = Tcl_GetVar2Ex(interp, argv[1], argv[2], flags); if (value == NULL) { return TCL_ERROR; } - Tcl_AppendElement(interp, value); + Tcl_AppendElement(interp, Tcl_GetString(value)); return TCL_OK; } else if (argc == 4) { Tcl_SetResult(interp, "before set", TCL_STATIC); - value = Tcl_SetVar2(interp, argv[1], argv[2], argv[3], flags); + value = Tcl_SetVar2Ex(interp, argv[1], argv[2], Tcl_NewStringObj(argv[3], -1), flags); if (value == NULL) { return TCL_ERROR; } - Tcl_AppendElement(interp, value); + Tcl_AppendElement(interp, Tcl_GetString(value)); return TCL_OK; } else { Tcl_AppendResult(interp, "wrong # args: should be \"", @@ -5056,8 +5050,8 @@ TestsaveresultCmd( Tcl_WrongNumArgs(interp, 1, objv, "type script discard"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBooleanFromObj(interp, objv[3], &discard) != TCL_OK) { @@ -5094,7 +5088,7 @@ TestsaveresultCmd( if (((enum options) index) == RESULT_OBJECT) { result = Tcl_EvalObjEx(interp, objv[2], 0); } else { - result = Tcl_Eval(interp, Tcl_GetString(objv[2])); + result = Tcl_EvalEx(interp, Tcl_GetString(objv[2]), -1, 0); } if (discard) { @@ -6692,7 +6686,7 @@ TestReport( } Tcl_DStringEndSublist(&ds); Tcl_SaveResult(interp, &savedResult); - Tcl_Eval(interp, Tcl_DStringValue(&ds)); + Tcl_EvalEx(interp, Tcl_DStringValue(&ds), -1, 0); Tcl_DStringFree(&ds); Tcl_RestoreResult(interp, &savedResult); } diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index 37286e3..7ecbe6c 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -146,8 +146,8 @@ TestbignumobjCmd( Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?..."); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], subcmds, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } string = Tcl_GetString(objv[2]); @@ -521,11 +521,11 @@ TestindexobjCmd( return TCL_ERROR; } - Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index); + Tcl_GetIndexFromObjStruct(NULL, objv[1], tablePtr, sizeof(char *), "token", 0, &index); indexRep = (struct IndexRep *) objv[1]->internalRep.otherValuePtr; indexRep->index = index2; - result = Tcl_GetIndexFromObj(NULL, objv[1], - tablePtr, "token", 0, &index); + result = Tcl_GetIndexFromObjStruct(NULL, objv[1], + tablePtr, sizeof(char *), "token", 0, &index); if (result == TCL_OK) { Tcl_SetIntObj(Tcl_GetObjResult(interp), index); } @@ -566,8 +566,8 @@ TestindexobjCmd( } } - result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3], - argv, "token", (allowAbbrev? 0 : TCL_EXACT), &index); + result = Tcl_GetIndexFromObjStruct((setError? interp : NULL), objv[3], + argv, sizeof(char *), "token", (allowAbbrev? 0 : TCL_EXACT), &index); ckfree((char *) argv); if (result == TCL_OK) { Tcl_SetIntObj(Tcl_GetObjResult(interp), index); @@ -828,8 +828,8 @@ TestlistobjCmd( if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) { return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "command", - 0, &cmdIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], subcommands, + sizeof(char *), "command", 0, &cmdIndex) != TCL_OK) { return TCL_ERROR; } switch(cmdIndex) { @@ -1112,8 +1112,8 @@ TeststringobjCmd( return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &option) - != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], options, + sizeof(char *), "option", 0, &option) != TCL_OK) { return TCL_ERROR; } switch (option) { diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c index 644179b..61ae3ba 100644 --- a/generic/tclTestProcBodyObj.c +++ b/generic/tclTestProcBodyObj.c @@ -141,7 +141,7 @@ static int RegisterCommand(interp, namespace, cmdTablePtr) if (cmdTablePtr->exportIt) { sprintf(buf, "namespace eval %s { namespace export %s }", namespace, cmdTablePtr->cmdName); - if (Tcl_Eval(interp, buf) != TCL_OK) + if (Tcl_EvalEx(interp, buf, -1, 0) != TCL_OK) return TCL_ERROR; } @@ -183,7 +183,7 @@ ProcBodyTestInitInternal( } } - return Tcl_PkgProvide(interp, packageName, packageVersion); + return Tcl_PkgProvideEx(interp, packageName, packageVersion, NULL); } /* diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index 960c7dc..b4bb0e1 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -113,22 +113,16 @@ static char *errorProcString; TCL_DECLARE_MUTEX(threadMutex) -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - -EXTERN int TclThread_Init(Tcl_Interp *interp); -EXTERN int Tcl_ThreadObjCmd(ClientData clientData, +DLLEXPORT int TclThread_Init(Tcl_Interp *interp); +DLLEXPORT int Tcl_ThreadObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -EXTERN int TclCreateThread(Tcl_Interp *interp, char *script, +DLLEXPORT int TclCreateThread(Tcl_Interp *interp, char *script, int joinable); -EXTERN int TclThreadList(Tcl_Interp *interp); -EXTERN int TclThreadSend(Tcl_Interp *interp, Tcl_ThreadId id, +DLLEXPORT int TclThreadList(Tcl_Interp *interp); +DLLEXPORT int TclThreadSend(Tcl_Interp *interp, Tcl_ThreadId id, char *script, int wait); -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLIMPORT - Tcl_ThreadCreateType NewTestThread(ClientData clientData); static void ListRemove(ThreadSpecificData *tsdPtr); static void ListUpdateInner(ThreadSpecificData *tsdPtr); @@ -215,8 +209,8 @@ Tcl_ThreadObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "option ?args?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], threadOptions, "option", 0, - &option) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], threadOptions, + sizeof(char *), "option", 0, &option) != TCL_OK) { return TCL_ERROR; } @@ -520,7 +514,7 @@ NewTestThread( */ Tcl_Preserve((ClientData) tsdPtr->interp); - result = Tcl_Eval(tsdPtr->interp, threadEvalScript); + result = Tcl_EvalEx(tsdPtr->interp, threadEvalScript, -1, 0); if (result != TCL_OK) { ThreadErrorProc(tsdPtr->interp); } @@ -563,7 +557,7 @@ ThreadErrorProc( char buf[TCL_DOUBLE_SPACE+1]; sprintf(buf, "%ld", (long) Tcl_GetCurrentThread()); - errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); + errorInfo = Tcl_GetVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY); if (errorProcString == NULL) { errChannel = Tcl_GetStdChannel(TCL_STDERR); Tcl_WriteChars(errChannel, "Error from thread ", -1); @@ -739,7 +733,7 @@ TclThreadSend( if (threadId == Tcl_GetCurrentThread()) { Tcl_MutexUnlock(&threadMutex); - return Tcl_GlobalEval(interp, script); + return Tcl_EvalEx(interp, script, -1, TCL_EVAL_GLOBAL); } /* @@ -878,12 +872,12 @@ ThreadEventProc( Tcl_ResetResult(interp); Tcl_CreateThreadExitHandler(ThreadFreeProc, (ClientData) threadEventPtr->script); - code = Tcl_GlobalEval(interp, threadEventPtr->script); + code = Tcl_EvalEx(interp, threadEventPtr->script, -1, TCL_EVAL_GLOBAL); Tcl_DeleteThreadExitHandler(ThreadFreeProc, (ClientData) threadEventPtr->script); if (code != TCL_OK) { - errorCode = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY); - errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); + errorCode = Tcl_GetVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY); + errorInfo = Tcl_GetVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY); } else { errorCode = errorInfo = NULL; } diff --git a/generic/tclTimer.c b/generic/tclTimer.c index 33838ec..84967f1 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -810,8 +810,8 @@ Tcl_AfterObjCmd( || objv[1]->typePtr == &tclWideIntType #endif || objv[1]->typePtr == &tclBignumType - || ( Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, - &index) != TCL_OK )) { + || ( Tcl_GetIndexFromObjStruct(NULL, objv[1], afterSubCmds, + sizeof(char *), NULL, 0, &index) != TCL_OK )) { index = -1; if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) { Tcl_AppendResult(interp, "bad argument \"", diff --git a/generic/tclTrace.c b/generic/tclTrace.c index fa29160..4ecb7da 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -198,8 +198,8 @@ Tcl_TraceObjCmd( return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], traceOptions, - "option", 0, &optionIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], traceOptions, + sizeof(char *), "option", 0, &optionIndex) != TCL_OK) { return TCL_ERROR; } switch ((enum traceOptions) optionIndex) { @@ -217,8 +217,8 @@ Tcl_TraceObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "type ?arg arg ...?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[2], traceTypeOptions, "option", - 0, &typeIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[2], traceTypeOptions, + sizeof(char *), "option", 0, &typeIndex) != TCL_OK) { return TCL_ERROR; } return (traceSubCmds[typeIndex])(interp, optionIndex, objc, objv); @@ -240,8 +240,8 @@ Tcl_TraceObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "type name"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[2], traceTypeOptions, "option", - 0, &typeIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[2], traceTypeOptions, + sizeof(char *), "option", 0, &typeIndex) != TCL_OK) { return TCL_ERROR; } return (traceSubCmds[typeIndex])(interp, optionIndex, objc, objv); @@ -307,7 +307,7 @@ Tcl_TraceObjCmd( resultListPtr = Tcl_NewObj(); clientData = 0; name = Tcl_GetString(objv[2]); - while ((clientData = Tcl_VarTraceInfo(interp, name, 0, + while ((clientData = Tcl_VarTraceInfo2(interp, name, NULL, 0, TraceVarProc, clientData)) != 0) { TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData; @@ -426,8 +426,8 @@ TraceExecutionObjCmd( return TCL_ERROR; } for (i = 0; i < listLen; i++) { - if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings, - "operation", TCL_EXACT, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, elemPtrs[i], opStrings, + sizeof(char *), "operation", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum operations) index) { @@ -673,8 +673,8 @@ TraceCommandObjCmd( } for (i = 0; i < listLen; i++) { - if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings, - "operation", TCL_EXACT, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, elemPtrs[i], opStrings, + sizeof(char *), "operation", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum operations) index) { @@ -874,8 +874,8 @@ TraceVariableObjCmd( return TCL_ERROR; } for (i = 0; i < listLen ; i++) { - if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings, - "operation", TCL_EXACT, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, elemPtrs[i], opStrings, + sizeof(char *), "operation", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum operations) index) { @@ -927,7 +927,7 @@ TraceVariableObjCmd( TraceVarInfo *tvarPtr; ClientData clientData = 0; name = Tcl_GetString(objv[3]); - while ((clientData = Tcl_VarTraceInfo(interp, name, 0, + while ((clientData = Tcl_VarTraceInfo2(interp, name, NULL, 0, TraceVarProc, clientData)) != 0) { tvarPtr = (TraceVarInfo *) clientData; if ((tvarPtr->length == length) @@ -955,8 +955,8 @@ TraceVariableObjCmd( resultListPtr = Tcl_NewObj(); clientData = 0; name = Tcl_GetString(objv[3]); - while ((clientData = Tcl_VarTraceInfo(interp, name, 0, TraceVarProc, - clientData)) != 0) { + while ((clientData = Tcl_VarTraceInfo2(interp, name, NULL, 0, + TraceVarProc, clientData)) != 0) { Tcl_Obj *opObj; TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData; @@ -1883,7 +1883,7 @@ TraceExecutionProc( * interpreter. */ - traceCode = Tcl_Eval(interp, Tcl_DStringValue(&cmd)); + traceCode = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd), -1, 0); tcmdPtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS; /* @@ -2797,6 +2797,7 @@ DisposeTraceResult( *---------------------------------------------------------------------- */ +#undef Tcl_UntraceVar void Tcl_UntraceVar( Tcl_Interp *interp, /* Interpreter containing variable. */ @@ -2966,6 +2967,8 @@ Tcl_UntraceVar2( *---------------------------------------------------------------------- */ +#undef Tcl_VarTraceInfo + ClientData Tcl_VarTraceInfo( Tcl_Interp *interp, /* Interpreter containing variable. */ @@ -3076,6 +3079,7 @@ Tcl_VarTraceInfo2( *---------------------------------------------------------------------- */ +#undef Tcl_TraceVar int Tcl_TraceVar( Tcl_Interp *interp, /* Interpreter in which variable is to be diff --git a/generic/tclVar.c b/generic/tclVar.c index aaf1cb9..6d6daed 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -1187,6 +1187,7 @@ TclLookupArrayElement( *---------------------------------------------------------------------- */ +#undef Tcl_GetVar const char * Tcl_GetVar( Tcl_Interp *interp, /* Command interpreter in which varName is to @@ -1511,6 +1512,7 @@ Tcl_SetObjCmd( *---------------------------------------------------------------------- */ +#undef Tcl_SetVar const char * Tcl_SetVar( Tcl_Interp *interp, /* Command interpreter in which varName is to @@ -2097,6 +2099,7 @@ TclPtrIncrObjVar( *---------------------------------------------------------------------- */ +#undef Tcl_UnsetVar int Tcl_UnsetVar( Tcl_Interp *interp, /* Command interpreter in which varName is to @@ -2763,8 +2766,8 @@ Tcl_ArrayObjCmd( return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], arrayOptions, "option", - 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], arrayOptions, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -3094,8 +3097,8 @@ Tcl_ArrayObjCmd( } else if (objc == 5) { patternPtr = objv[4]; pattern = TclGetString(patternPtr); - if (Tcl_GetIndexFromObj(interp, objv[3], options, "option", 0, - &mode) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[3], options, + sizeof(char *), "option", 0, &mode) != TCL_OK) { return TCL_ERROR; } } else { @@ -3736,6 +3739,7 @@ TclPtrObjMakeUpvar( *---------------------------------------------------------------------- */ +#undef Tcl_UpVar int Tcl_UpVar( Tcl_Interp *interp, /* Command interpreter in which varName is to diff --git a/unix/dltest/pkga.c b/unix/dltest/pkga.c index f001cdf..e686680 100644 --- a/unix/dltest/pkga.c +++ b/unix/dltest/pkga.c @@ -125,7 +125,7 @@ Pkga_Init( if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { return TCL_ERROR; } - code = Tcl_PkgProvide(interp, "Pkga", "1.0"); + code = Tcl_PkgProvideEx(interp, "Pkga", "1.0", NULL); if (code != TCL_OK) { return code; } diff --git a/unix/dltest/pkgc.c b/unix/dltest/pkgc.c index 6ad5ab4..26b11ab 100644 --- a/unix/dltest/pkgc.c +++ b/unix/dltest/pkgc.c @@ -115,7 +115,7 @@ Pkgc_Init( if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { return TCL_ERROR; } - code = Tcl_PkgProvide(interp, "Pkgc", "1.7.2"); + code = Tcl_PkgProvideEx(interp, "Pkgc", "1.7.2", NULL); if (code != TCL_OK) { return code; } @@ -153,7 +153,7 @@ Pkgc_SafeInit( if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { return TCL_ERROR; } - code = Tcl_PkgProvide(interp, "Pkgc", "1.7.2"); + code = Tcl_PkgProvideEx(interp, "Pkgc", "1.7.2", NULL); if (code != TCL_OK) { return code; } diff --git a/unix/dltest/pkgd.c b/unix/dltest/pkgd.c index 7fe7c49..27ac323 100644 --- a/unix/dltest/pkgd.c +++ b/unix/dltest/pkgd.c @@ -115,7 +115,7 @@ Pkgd_Init( if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { return TCL_ERROR; } - code = Tcl_PkgProvide(interp, "Pkgd", "7.3"); + code = Tcl_PkgProvideEx(interp, "Pkgd", "7.3", NULL); if (code != TCL_OK) { return code; } @@ -153,7 +153,7 @@ Pkgd_SafeInit( if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { return TCL_ERROR; } - code = Tcl_PkgProvide(interp, "Pkgd", "7.3"); + code = Tcl_PkgProvideEx(interp, "Pkgd", "7.3", NULL); if (code != TCL_OK) { return code; } diff --git a/unix/dltest/pkge.c b/unix/dltest/pkge.c index abd2359..e1e5d41 100644 --- a/unix/dltest/pkge.c +++ b/unix/dltest/pkge.c @@ -41,5 +41,5 @@ Pkge_Init( if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { return TCL_ERROR; } - return Tcl_Eval(interp, script); + return Tcl_EvalEx(interp, script, -1, 0); } diff --git a/unix/dltest/pkgua.c b/unix/dltest/pkgua.c index 9c36e88..e5a03c1 100644 --- a/unix/dltest/pkgua.c +++ b/unix/dltest/pkgua.c @@ -210,12 +210,12 @@ Pkgua_Init( PkguaInitTokensHashTable(); - code = Tcl_PkgProvide(interp, "Pkgua", "1.0"); + code = Tcl_PkgProvideEx(interp, "Pkgua", "1.0", NULL); if (code != TCL_OK) { return code; } - Tcl_SetVar(interp, "::pkgua_loaded", ".", TCL_APPEND_VALUE); + Tcl_SetVar2Ex(interp, "::pkgua_loaded", NULL, Tcl_NewStringObj(".", -1), TCL_APPEND_VALUE); cmdTokens = PkguaInterpToTokens(interp); cmdTokens[cmdIndex++] = @@ -290,7 +290,7 @@ Pkgua_Unload( PkguaDeleteTokens(interp); - Tcl_SetVar(interp, "::pkgua_detached", ".", TCL_APPEND_VALUE); + Tcl_SetVar2Ex(interp, "::pkgua_detached", NULL, Tcl_NewStringObj(".", -1), TCL_APPEND_VALUE); if (flags == TCL_UNLOAD_DETACH_FROM_PROCESS) { /* @@ -300,7 +300,7 @@ Pkgua_Unload( */ PkguaFreeTokensHashTable(); - Tcl_SetVar(interp, "::pkgua_unloaded", ".", TCL_APPEND_VALUE); + Tcl_SetVar2Ex(interp, "::pkgua_unloaded", NULL, Tcl_NewStringObj(".", -1), TCL_APPEND_VALUE); } return TCL_OK; } diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c index dac782b..7bed424 100644 --- a/unix/tclAppInit.c +++ b/unix/tclAppInit.c @@ -160,9 +160,9 @@ Tcl_AppInit( */ #ifdef DJGPP - Tcl_SetVar(interp, "tcl_rcFileName", "~/tclsh.rc", TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(interp, "tcl_rcFileName", NULL, Tcl_NewStringObj("~/tclsh.rc", -1), TCL_GLOBAL_ONLY); #else - Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(interp, "tcl_rcFileName", NULL, Tcl_NewStringObj("~/.tclshrc", -1), TCL_GLOBAL_ONLY); #endif return TCL_OK; diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index f9015b7..b211d3a 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -840,7 +840,7 @@ TclpSetVariables( if (!Tcl_CreateNamespace(interp, "::tcl::mac", NULL, NULL)) { Tcl_ResetResult(interp); } - Tcl_SetVar(interp, "::tcl::mac::locale", loc, TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(interp, "::tcl::mac::locale", NULL, Tcl_NewStringObj(loc, -1), TCL_GLOBAL_ONLY); } } CFRelease(localeRef); @@ -851,9 +851,9 @@ TclpSetVariables( CONST char *str; CFBundleRef bundleRef; - Tcl_SetVar(interp, "tclDefaultLibrary", tclLibPath, TCL_GLOBAL_ONLY); - Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, TCL_GLOBAL_ONLY); - Tcl_SetVar(interp, "tcl_pkgPath", " ", + Tcl_SetVar2Ex(interp, "tclDefaultLibrary", NULL, Tcl_NewStringObj(tclLibPath, -1), TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(interp, "tcl_pkgPath", NULL, Tcl_NewStringObj(tclLibPath, -1), TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(interp, "tcl_pkgPath", NULL, Tcl_NewStringObj(" ", -1), TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); str = TclGetEnv("DYLD_FRAMEWORK_PATH", &ds); @@ -869,9 +869,9 @@ TclpSetVariables( *p = ' '; } } while (*p++); - Tcl_SetVar(interp, "tcl_pkgPath", Tcl_DStringValue(&ds), + Tcl_SetVar2Ex(interp, "tcl_pkgPath", NULL, Tcl_NewStringObj(Tcl_DStringValue(&ds), -1), TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); - Tcl_SetVar(interp, "tcl_pkgPath", " ", + Tcl_SetVar2Ex(interp, "tcl_pkgPath", NULL, Tcl_NewStringObj(" ", -1), TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); Tcl_DStringFree(&ds); } @@ -912,13 +912,13 @@ TclpSetVariables( } else #endif /* HAVE_COREFOUNDATION */ { - Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(interp, "tcl_pkgPath", NULL, Tcl_NewStringObj(pkgPath, -1), TCL_GLOBAL_ONLY); } #ifdef DJGPP - Tcl_SetVar2(interp, "tcl_platform", "platform", "dos", TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(interp, "tcl_platform", "platform", Tcl_NewStringObj("dos", -1), TCL_GLOBAL_ONLY); #else - Tcl_SetVar2(interp, "tcl_platform", "platform", "unix", TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(interp, "tcl_platform", "platform", Tcl_NewStringObj("unix", -1), TCL_GLOBAL_ONLY); #endif unameOK = 0; @@ -929,8 +929,8 @@ TclpSetVariables( GetSystemInfo(&sysInfo); if (osInfo.dwPlatformId < NUMPLATFORMS) { - Tcl_SetVar2(interp, "tcl_platform", "os", - platforms[osInfo.dwPlatformId], TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(interp, "tcl_platform", "os", + Tcl_NewStringObj(platforms[osInfo.dwPlatformId], -1), TCL_GLOBAL_ONLY); } sprintf(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion); Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY); diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index b6529c2..6ffc5e4 100644 --- a/unix/tclUnixTest.c +++ b/unix/tclUnixTest.c @@ -35,8 +35,8 @@ */ typedef struct Pipe { - TclFile readFile; /* File handle for reading from the pipe. - * NULL means pipe doesn't exist yet. */ + TclFile readFile; /* File handle for reading from the pipe. NULL + * means pipe doesn't exist yet. */ TclFile writeFile; /* File handle for writing from the pipe. */ int readCount; /* Number of times the file handler for this * file has triggered and the file was @@ -53,33 +53,24 @@ static Pipe testPipes[MAX_PIPES]; * The stuff below is used by the testalarm and testgotsig ommands. */ -static char *gotsig = "0"; +static CONST char *gotsig = "0"; /* * Forward declarations of functions defined later in this file: */ -static void TestFileHandlerProc(ClientData clientData, int mask); -static int TestfilehandlerCmd(ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv); -static int TestfilewaitCmd(ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv); -static int TestfindexecutableCmd(ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv); -static int TestgetopenfileCmd(ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv); -static int TestgetdefencdirCmd(ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv); -static int TestsetdefencdirCmd(ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv); +static Tcl_CmdProc TestalarmCmd; +static Tcl_CmdProc TestchmodCmd; +static Tcl_CmdProc TestfilehandlerCmd; +static Tcl_CmdProc TestfilewaitCmd; +static Tcl_CmdProc TestfindexecutableCmd; +static Tcl_ObjCmdProc TestgetdefencdirCmd; +static Tcl_CmdProc TestgetopenfileCmd; +static Tcl_CmdProc TestgotsigCmd; +static Tcl_ObjCmdProc TestsetdefencdirCmd; int TclplatformtestInit(Tcl_Interp *interp); -static int TestalarmCmd(ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv); -static int TestgotsigCmd(ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv); -static void AlarmHandler(int signum); -static int TestchmodCmd(ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv); +static Tcl_FileProc TestFileHandlerProc; +static void AlarmHandler(int signum); /* *---------------------------------------------------------------------- @@ -112,9 +103,9 @@ TclplatformtestInit( (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd, (ClientData) 0, NULL); - Tcl_CreateCommand(interp, "testgetdefenc", TestgetdefencdirCmd, + Tcl_CreateObjCommand(interp, "testgetdefenc", TestgetdefencdirCmd, (ClientData) 0, NULL); - Tcl_CreateCommand(interp, "testsetdefenc", TestsetdefencdirCmd, + Tcl_CreateObjCommand(interp, "testsetdefenc", TestsetdefencdirCmd, (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testalarm", TestalarmCmd, (ClientData) 0, NULL); @@ -167,7 +158,7 @@ TestfilehandlerCmd( if (argc < 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - " option ... \"", NULL); + " option ... \"", NULL); return TCL_ERROR; } pipePtr = NULL; @@ -194,7 +185,7 @@ TestfilehandlerCmd( } else if (strcmp(argv[1], "clear") == 0) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " clear index\"", NULL); + argv[0], " clear index\"", NULL); return TCL_ERROR; } pipePtr->readCount = pipePtr->writeCount = 0; @@ -203,7 +194,7 @@ TestfilehandlerCmd( if (argc != 3) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " counts index\"", NULL); + argv[0], " counts index\"", NULL); return TCL_ERROR; } sprintf(buf, "%d %d", pipePtr->readCount, pipePtr->writeCount); @@ -211,7 +202,7 @@ TestfilehandlerCmd( } else if (strcmp(argv[1], "create") == 0) { if (argc != 5) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " create index readMode writeMode\"", NULL); + argv[0], " create index readMode writeMode\"", NULL); return TCL_ERROR; } if (pipePtr->readFile == NULL) { @@ -259,30 +250,30 @@ TestfilehandlerCmd( } else if (strcmp(argv[1], "empty") == 0) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " empty index\"", NULL); + argv[0], " empty index\"", NULL); return TCL_ERROR; } while (read(GetFd(pipePtr->readFile), buffer, 4000) > 0) { - /* Empty loop body. */ + /* Empty loop body. */ } } else if (strcmp(argv[1], "fill") == 0) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " fill index\"", NULL); + argv[0], " fill index\"", NULL); return TCL_ERROR; } memset(buffer, 'a', 4000); while (write(GetFd(pipePtr->writeFile), buffer, 4000) > 0) { - /* Empty loop body. */ + /* Empty loop body. */ } } else if (strcmp(argv[1], "fillpartial") == 0) { char buf[TCL_INTEGER_SPACE]; if (argc != 3) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " fillpartial index\"", NULL); + argv[0], " fillpartial index\"", NULL); return TCL_ERROR; } @@ -294,7 +285,7 @@ TestfilehandlerCmd( } else if (strcmp(argv[1], "wait") == 0) { if (argc != 5) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " wait index readable|writable timeout\"", NULL); + argv[0], " wait index readable|writable timeout\"", NULL); return TCL_ERROR; } if (pipePtr->readFile == NULL) { @@ -485,16 +476,16 @@ TestgetopenfileCmd( if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " channelName forWriting\"", NULL); + " channelName forWriting\"", NULL); return TCL_ERROR; } if (Tcl_GetOpenFile(interp, argv[1], atoi(argv[2]), 1, &filePtr) - == TCL_ERROR) { + == TCL_ERROR) { return TCL_ERROR; } if (filePtr == (ClientData) NULL) { Tcl_AppendResult(interp, - "Tcl_GetOpenFile succeeded but FILE * NULL!", NULL); + "Tcl_GetOpenFile succeeded but FILE * NULL!", NULL); return TCL_ERROR; } return TCL_OK; @@ -521,16 +512,22 @@ static int TestsetdefencdirCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - CONST char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST *objv) /* Argument strings. */ { - if (argc != 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " defaultDir\"", NULL); + Tcl_Obj *searchPath; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "defaultDir"); return TCL_ERROR; } - Tcl_SetDefaultEncodingDir(argv[1]); + searchPath = Tcl_GetEncodingSearchPath(); + + searchPath = Tcl_DuplicateObj(searchPath); + Tcl_ListObjReplace(NULL, searchPath, 0, 0, 1, &objv[1]); + Tcl_SetEncodingSearchPath(searchPath); + return TCL_OK; } @@ -555,15 +552,25 @@ static int TestgetdefencdirCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - CONST char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST *objv) /* Argument strings. */ { - if (argc != 1) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], NULL); - return TCL_ERROR; + int numDirs; + Tcl_Obj *first, *searchPath; + + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, NULL); + return TCL_ERROR; + } + + searchPath = Tcl_GetEncodingSearchPath(); + Tcl_ListObjLength(interp, searchPath, &numDirs); + if (numDirs == 0) { + return TCL_ERROR; } + Tcl_ListObjIndex(NULL, searchPath, 0, &first); - Tcl_AppendResult(interp, Tcl_GetDefaultEncodingDir(), NULL); + Tcl_SetObjResult(interp, first); return TCL_OK; } @@ -706,7 +713,7 @@ TestchmodCmd( char *rest; if (argc < 2) { - usage: + usage: Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " mode file ?file ...?", NULL); return TCL_ERROR; @@ -734,3 +741,12 @@ TestchmodCmd( } return TCL_OK; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * tab-width: 8 + * End: + */ diff --git a/win/tclAppInit.c b/win/tclAppInit.c index 0edd2c3..158c37e 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -185,7 +185,8 @@ Tcl_AppInit( * user-specific startup file will be run under any conditions. */ - Tcl_SetVar(interp, "tcl_rcFileName", "~/tclshrc.tcl", TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(interp, "tcl_rcFileName", NULL, + Tcl_NewStringObj("~/tclshrc.tcl", -1), TCL_GLOBAL_ONLY); return TCL_OK; } diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 5543732..4e66d3b 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -15,16 +15,6 @@ #include <ddeml.h> /* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the Dde_Init - * declaration is in the source file itself, which is only accessed when we - * are building a library. DO NOT MOVE BEFORE ANY #include LINES. ONLY USE - * EXTERN TO INDICATE EXPORTED FUNCTIONS FROM NOW ON. - */ - -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - -/* * The following structure is used to keep track of the interpreters * registered by this process. */ @@ -116,8 +106,8 @@ static int DdeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -EXTERN int Dde_Init(Tcl_Interp *interp); -EXTERN int Dde_SafeInit(Tcl_Interp *interp); +DLLEXPORT int Dde_Init(Tcl_Interp *interp); +DLLEXPORT int Dde_SafeInit(Tcl_Interp *interp); /* *---------------------------------------------------------------------- @@ -145,7 +135,7 @@ Dde_Init( Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL); Tcl_CreateExitHandler(DdeExitProc, NULL); - return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION); + return Tcl_PkgProvideEx(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION, NULL); } /* @@ -1205,16 +1195,16 @@ DdeObjCmd( return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], ddeCommands, "command", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], ddeCommands, sizeof(char *), + "command", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum DdeSubcommands) index) { case DDE_SERVERNAME: for (i = 2; i < objc; i++) { - if (Tcl_GetIndexFromObj(interp, objv[i], ddeSrvOptions, - "option", 0, &argIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], ddeSrvOptions, + sizeof(char *), "option", 0, &argIndex) != TCL_OK) { /* * If it is the last argument, it might be a server name * instead of a bad argument. @@ -1260,8 +1250,8 @@ DdeObjCmd( firstArg = 2; break; } else if (objc == 6) { - if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", 0, - &argIndex) == TCL_OK) { + if (Tcl_GetIndexFromObjStruct(NULL, objv[2], ddeExecOptions, + sizeof(char *), "option", 0, &argIndex) == TCL_OK) { flags |= DDE_FLAG_ASYNC; firstArg = 3; break; @@ -1285,8 +1275,8 @@ DdeObjCmd( break; } else if (objc == 6) { int dummy; - if (Tcl_GetIndexFromObj(NULL, objv[2], ddeReqOptions, "option", 0, - &dummy) == TCL_OK) { + if (Tcl_GetIndexFromObjStruct(NULL, objv[2], ddeReqOptions, + sizeof(char *), "option", 0, &dummy) == TCL_OK) { flags |= DDE_FLAG_BINARY; firstArg = 3; break; @@ -1314,8 +1304,8 @@ DdeObjCmd( return TCL_ERROR; } else { firstArg = 2; - if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", - 0, &argIndex) == TCL_OK) { + if (Tcl_GetIndexFromObjStruct(NULL, objv[2], ddeExecOptions, + sizeof(char *), "option", 0, &argIndex) == TCL_OK) { if (objc < 5) { goto wrongDdeEvalArgs; } diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 5baf020..7d3d77f 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -557,7 +557,7 @@ void TclpSetVariables( Tcl_Interp *interp) /* Interp to initialize. */ { - CONST char *ptr; + Tcl_Obj *ptr; char buffer[TCL_INTEGER_SPACE * 2]; union { SYSTEM_INFO info; @@ -580,17 +580,17 @@ TclpSetVariables( * Define the tcl_platform array. */ - Tcl_SetVar2(interp, "tcl_platform", "platform", "windows", + Tcl_SetVar2Ex(interp, "tcl_platform", "platform", Tcl_NewStringObj("windows", -1), TCL_GLOBAL_ONLY); if (osInfo.dwPlatformId < NUMPLATFORMS) { - Tcl_SetVar2(interp, "tcl_platform", "os", - platforms[osInfo.dwPlatformId], TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(interp, "tcl_platform", "os", + Tcl_NewStringObj(platforms[osInfo.dwPlatformId], -1), TCL_GLOBAL_ONLY); } wsprintfA(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion); - Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(interp, "tcl_platform", "osVersion", Tcl_NewStringObj(buffer, -1), TCL_GLOBAL_ONLY); if (sys.oemId.wProcessorArchitecture < NUMPROCESSORS) { - Tcl_SetVar2(interp, "tcl_platform", "machine", - processors[sys.oemId.wProcessorArchitecture], + Tcl_SetVar2Ex(interp, "tcl_platform", "machine", + Tcl_NewStringObj(processors[sys.oemId.wProcessorArchitecture], -1), TCL_GLOBAL_ONLY); } @@ -603,7 +603,7 @@ TclpSetVariables( * command. */ - Tcl_SetVar2(interp, "tcl_platform", "debug", "1", + Tcl_SetVar2Ex(interp, "tcl_platform", "debug", Tcl_NewIntObj(1), TCL_GLOBAL_ONLY); #endif @@ -613,21 +613,21 @@ TclpSetVariables( */ Tcl_DStringInit(&ds); - ptr = Tcl_GetVar2(interp, "env", "HOME", TCL_GLOBAL_ONLY); + ptr = Tcl_GetVar2Ex(interp, "env", "HOME", TCL_GLOBAL_ONLY); if (ptr == NULL) { - ptr = Tcl_GetVar2(interp, "env", "HOMEDRIVE", TCL_GLOBAL_ONLY); + ptr = Tcl_GetVar2Ex(interp, "env", "HOMEDRIVE", TCL_GLOBAL_ONLY); if (ptr != NULL) { - Tcl_DStringAppend(&ds, ptr, -1); + Tcl_DStringAppend(&ds, Tcl_GetString(ptr), -1); } - ptr = Tcl_GetVar2(interp, "env", "HOMEPATH", TCL_GLOBAL_ONLY); + ptr = Tcl_GetVar2Ex(interp, "env", "HOMEPATH", TCL_GLOBAL_ONLY); if (ptr != NULL) { - Tcl_DStringAppend(&ds, ptr, -1); + Tcl_DStringAppend(&ds, Tcl_GetString(ptr), -1); } if (Tcl_DStringLength(&ds) > 0) { - Tcl_SetVar2(interp, "env", "HOME", Tcl_DStringValue(&ds), + Tcl_SetVar2Ex(interp, "env", "HOME", Tcl_NewStringObj(Tcl_DStringValue(&ds), -1), TCL_GLOBAL_ONLY); } else { - Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(interp, "env", "HOME", Tcl_NewStringObj("c:\\", -1), TCL_GLOBAL_ONLY); } } @@ -645,7 +645,7 @@ TclpSetVariables( Tcl_WinTCharToUtf((LPTSTR)szUserName, cbUserNameLen, &ds); } } - Tcl_SetVar2(interp, "tcl_platform", "user", Tcl_DStringValue(&ds), + Tcl_SetVar2Ex(interp, "tcl_platform", "user", Tcl_NewStringObj(Tcl_DStringValue(&ds), -1), TCL_GLOBAL_ONLY); Tcl_DStringFree(&ds); } diff --git a/win/tclWinPort.h b/win/tclWinPort.h index f58014c..74f8483 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -378,7 +378,7 @@ typedef DWORD_PTR * PDWORD_PTR; /* - * MSVC 8.0 started to mark many standard C library functions depreciated + * MSVC 8.0 started to mark many standard C library functions deprecated * including the *printf family and others. Tell it to shut up. * (_MSC_VER is 1200 for VC6, 1300 or 1310 for vc7.net, 1400 for 8.0) */ diff --git a/win/tclWinReg.c b/win/tclWinReg.c index a6ce2ce..e0f588c 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -20,15 +20,6 @@ #include <stdlib.h> /* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the - * Registry_Init declaration is in the source file itself, which is only - * accessed when we are building a library. - */ - -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - -/* * The maximum length of a sub-key name. */ @@ -193,8 +184,8 @@ static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj, Tcl_Obj *dataObj, Tcl_Obj *typeObj); -EXTERN int Registry_Init(Tcl_Interp *interp); -EXTERN int Registry_Unload(Tcl_Interp *interp, int flags); +DLLEXPORT int Registry_Init(Tcl_Interp *interp); +DLLEXPORT int Registry_Unload(Tcl_Interp *interp, int flags); /* *---------------------------------------------------------------------- @@ -236,7 +227,7 @@ Registry_Init( cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, (ClientData)interp, DeleteCmd); Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, (ClientData)cmd); - return Tcl_PkgProvide(interp, "registry", "1.2.2"); + return Tcl_PkgProvideEx(interp, "registry", "1.2.2", NULL); } /* @@ -347,8 +338,8 @@ RegistryObjCmd( return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "option", 0, &index) - != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], subcommands, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -1151,8 +1142,8 @@ ParseKeyName( */ rootObj = Tcl_NewStringObj(rootName, -1); - result = Tcl_GetIndexFromObj(interp, rootObj, rootKeyNames, "root name", - TCL_EXACT, &index); + result = Tcl_GetIndexFromObjStruct(interp, rootObj, rootKeyNames, + sizeof(char *), "root name", TCL_EXACT, &index); Tcl_DecrRefCount(rootObj); if (result != TCL_OK) { return TCL_ERROR; @@ -1262,8 +1253,8 @@ SetValue( if (typeObj == NULL) { type = REG_SZ; - } else if (Tcl_GetIndexFromObj(interp, typeObj, typeNames, "type", - 0, (int *) &type) != TCL_OK) { + } else if (Tcl_GetIndexFromObjStruct(interp, typeObj, typeNames, + sizeof(char *), "type", 0, (int *) &type) != TCL_OK) { if (Tcl_GetIntFromObj(NULL, typeObj, (int*) &type) != TCL_OK) { return TCL_ERROR; } diff --git a/win/tclWinTest.c b/win/tclWinTest.c index e493fbf..0148c57 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -366,8 +366,8 @@ TestExceptionCmd( Tcl_WrongNumArgs(interp, 0, objv, "<type-of-exception>"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], cmds, "command", 0, - &cmd) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], cmds, + sizeof(char *), "command", 0, &cmd) != TCL_OK) { return TCL_ERROR; } |