summaryrefslogtreecommitdiffstats
path: root/unix
diff options
context:
space:
mode:
Diffstat (limited to 'unix')
-rw-r--r--unix/dltest/pkga.c2
-rw-r--r--unix/dltest/pkgc.c4
-rw-r--r--unix/dltest/pkgd.c4
-rw-r--r--unix/dltest/pkge.c2
-rw-r--r--unix/dltest/pkgua.c8
-rw-r--r--unix/tclAppInit.c4
-rw-r--r--unix/tclUnixInit.c22
-rw-r--r--unix/tclUnixTest.c118
8 files changed, 90 insertions, 74 deletions
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:
+ */
generated by cgit v0.12 at 2025-09-03 16:57:01 (GMT)