summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2012-12-07 12:37:14 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2012-12-07 12:37:14 (GMT)
commit5dafe4ef8d8cdadb34bb45b7c3608c843bca623b (patch)
treeb34054e2d1c9a7f2e2ab2238d182984ec14ba933
parent252431a635b7659d22579fcd187264884472c72f (diff)
parent55328af8909d074b8715cb5c50453d0d6e0149e4 (diff)
downloadtcl-better_deprecation_85.zip
tcl-better_deprecation_85.tar.gz
tcl-better_deprecation_85.tar.bz2
merge core-8-5-branch.better_deprecation_85
eliminate more deprecated calls
Diffstat
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclStubLib.c2
-rw-r--r--generic/tclTest.c54
-rw-r--r--generic/tclTestObj.c22
-rw-r--r--generic/tclTestProcBodyObj.c2
-rw-r--r--generic/tclThreadTest.c16
-rw-r--r--unix/dltest/pkgb.c4
-rw-r--r--unix/dltest/pkge.c2
-rw-r--r--unix/tclUnixInit.c2
-rw-r--r--win/tclWinTest.c4
10 files changed, 60 insertions, 54 deletions
diff --git a/ChangeLog b/ChangeLog
index 9a4d5340..25691fa 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2012-12-07 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * unix/dltest/pkgb.c: Turn pkgb.so into a Tcl9 interoperability test
+ library: Whatever Tcl9 looks like, loading pkgb.so in Tcl 9 should
+ either result in an error-message, either succeed, but never crash.
+
2012-11-14 Donal K. Fellows <dkf@users.sf.net>
* unix/tclUnixPipe.c (DefaultTempDir): [Bug 2933003]: Allow overriding
diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c
index 871d7ea..9774731 100644
--- a/generic/tclStubLib.c
+++ b/generic/tclStubLib.c
@@ -118,7 +118,7 @@ Tcl_InitStubs(
while (*p && (*p == *q)) {
p++; q++;
}
- if (*p) {
+ if (*p || isDigit(*q)) {
/* Construct error message */
Tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
return NULL;
diff --git a/generic/tclTest.c b/generic/tclTest.c
index e9e4312..7df3325 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -938,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
@@ -1222,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);
@@ -1239,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);
@@ -1263,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);
@@ -1279,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);
@@ -1608,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);
@@ -1720,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;
}
@@ -1909,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;
}
@@ -1973,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) {
@@ -2005,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) {
@@ -2170,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) {
@@ -2180,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));
@@ -3284,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;
}
@@ -3830,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) {
@@ -4359,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;
@@ -4478,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 {
@@ -5050,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) {
@@ -5088,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) {
@@ -6686,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 0fc3bb2..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;
}
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index 0482822..b4bb0e1 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -209,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;
}
@@ -514,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);
}
@@ -557,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);
@@ -733,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);
}
/*
@@ -872,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/unix/dltest/pkgb.c b/unix/dltest/pkgb.c
index 6d0d2e2..489f66b 100644
--- a/unix/dltest/pkgb.c
+++ b/unix/dltest/pkgb.c
@@ -111,7 +111,7 @@ Pkgb_Init(
{
int code;
- if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.5-9.1", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL);
@@ -149,7 +149,7 @@ Pkgb_SafeInit(
{
int code;
- if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.5-9.1", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL);
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/tclUnixInit.c b/unix/tclUnixInit.c
index e2037d7..b211d3a 100644
--- a/unix/tclUnixInit.c
+++ b/unix/tclUnixInit.c
@@ -912,7 +912,7 @@ 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
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;
}
generated by cgit v0.12 at 2025-03-28 12:41:01 (GMT)