summaryrefslogtreecommitdiffstats
path: root/unix/dltest
diff options
context:
space:
mode:
Diffstat (limited to 'unix/dltest')
-rw-r--r--unix/dltest/pkga.c28
-rw-r--r--unix/dltest/pkgb.c55
-rw-r--r--unix/dltest/pkgc.c31
-rw-r--r--unix/dltest/pkgd.c31
-rw-r--r--unix/dltest/pkge.c13
-rw-r--r--unix/dltest/pkgua.c37
6 files changed, 125 insertions, 70 deletions
diff --git a/unix/dltest/pkga.c b/unix/dltest/pkga.c
index f001cdf..c4d3f32 100644
--- a/unix/dltest/pkga.c
+++ b/unix/dltest/pkga.c
@@ -10,16 +10,25 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
+#undef STATIC_BUILD
#include "tcl.h"
/*
+ * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
+ * Pkga_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
+
+/*
* Prototypes for procedures defined later in this file:
*/
static int Pkga_EqObjCmd(ClientData clientData,
- Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
static int Pkga_QuoteObjCmd(ClientData clientData,
- Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
/*
*----------------------------------------------------------------------
@@ -44,10 +53,10 @@ Pkga_EqObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
- Tcl_Obj *CONST objv[]) /* Argument objects. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int result;
- CONST char *str1, *str2;
+ const char *str1, *str2;
int len1, len2;
if (objc != 3) {
@@ -88,7 +97,7 @@ Pkga_QuoteObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
- Tcl_Obj *CONST objv[]) /* Argument strings. */
+ Tcl_Obj *const objv[]) /* Argument strings. */
{
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "value");
@@ -115,7 +124,7 @@ Pkga_QuoteObjCmd(
*----------------------------------------------------------------------
*/
-int
+EXTERN int
Pkga_Init(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
@@ -129,9 +138,8 @@ Pkga_Init(
if (code != TCL_OK) {
return code;
}
- Tcl_CreateObjCommand(interp, "pkga_eq", Pkga_EqObjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateObjCommand(interp, "pkga_quote", Pkga_QuoteObjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "pkga_eq", Pkga_EqObjCmd, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "pkga_quote", Pkga_QuoteObjCmd, NULL,
+ NULL);
return TCL_OK;
}
diff --git a/unix/dltest/pkgb.c b/unix/dltest/pkgb.c
index 3338eb5..40f1fdd 100644
--- a/unix/dltest/pkgb.c
+++ b/unix/dltest/pkgb.c
@@ -11,6 +11,7 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
+#undef STATIC_BUILD
#include "tcl.h"
/*
@@ -18,9 +19,11 @@
*/
static int Pkgb_SubObjCmd(ClientData clientData,
- Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
static int Pkgb_UnsafeObjCmd(ClientData clientData,
- Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
+static int Pkgb_DemoObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
/*
*----------------------------------------------------------------------
@@ -44,7 +47,7 @@ Pkgb_SubObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
- Tcl_Obj *CONST objv[]) /* Argument objects. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int first, second;
@@ -82,10 +85,30 @@ Pkgb_UnsafeObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
- Tcl_Obj *CONST objv[]) /* Argument objects. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
return Tcl_EvalEx(interp, "list unsafe command invoked", -1, TCL_EVAL_GLOBAL);
}
+
+static int
+Pkgb_DemoObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+#if (TCL_MAJOR_VERSION > 8) || (TCL_MINOR_VERSION > 4)
+ Tcl_Obj *first;
+
+ if (Tcl_ListObjIndex(NULL, Tcl_GetEncodingSearchPath(), 0, &first)
+ == TCL_OK) {
+ Tcl_SetObjResult(interp, first);
+ }
+#else
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetDefaultEncodingDir(), -1));
+#endif
+ return TCL_OK;
+}
/*
*----------------------------------------------------------------------
@@ -111,20 +134,16 @@ Pkgb_Init(
{
int code;
- if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
- if (Tcl_InitStubs(interp, "8.4-", 0) == NULL) {
- return TCL_ERROR;
- }
- Tcl_ResetResult(interp);
+ if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
+ return TCL_ERROR;
}
code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL);
if (code != TCL_OK) {
return code;
}
- Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateObjCommand(interp, "pkgb_unsafe", Pkgb_UnsafeObjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "pkgb_unsafe", Pkgb_UnsafeObjCmd, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "pkgb_demo", Pkgb_DemoObjCmd, NULL, NULL);
return TCL_OK;
}
@@ -152,17 +171,13 @@ Pkgb_SafeInit(
{
int code;
- if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
- if (Tcl_InitStubs(interp, "8.4-", 0) == NULL) {
- return TCL_ERROR;
- }
- Tcl_ResetResult(interp);
+ if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
+ return TCL_ERROR;
}
code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL);
if (code != TCL_OK) {
return code;
}
- Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd, NULL, NULL);
return TCL_OK;
}
diff --git a/unix/dltest/pkgc.c b/unix/dltest/pkgc.c
index 6ad5ab4..557f21b 100644
--- a/unix/dltest/pkgc.c
+++ b/unix/dltest/pkgc.c
@@ -11,16 +11,25 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
+#undef STATIC_BUILD
#include "tcl.h"
/*
+ * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
+ * Pkgc_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
+
+/*
* Prototypes for procedures defined later in this file:
*/
static int Pkgc_SubObjCmd(ClientData clientData,
- Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
static int Pkgc_UnsafeObjCmd(ClientData clientData,
- Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
/*
*----------------------------------------------------------------------
@@ -44,7 +53,7 @@ Pkgc_SubObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
- Tcl_Obj *CONST objv[]) /* Argument objects. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int first, second;
@@ -82,7 +91,7 @@ Pkgc_UnsafeObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
- Tcl_Obj *CONST objv[]) /* Argument objects. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", -1));
return TCL_OK;
@@ -105,7 +114,7 @@ Pkgc_UnsafeObjCmd(
*----------------------------------------------------------------------
*/
-int
+EXTERN int
Pkgc_Init(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
@@ -119,10 +128,9 @@ Pkgc_Init(
if (code != TCL_OK) {
return code;
}
- Tcl_CreateObjCommand(interp, "pkgc_sub", Pkgc_SubObjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateObjCommand(interp, "pkgc_unsafe", Pkgc_UnsafeObjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "pkgc_sub", Pkgc_SubObjCmd, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "pkgc_unsafe", Pkgc_UnsafeObjCmd, NULL,
+ NULL);
return TCL_OK;
}
@@ -143,7 +151,7 @@ Pkgc_Init(
*----------------------------------------------------------------------
*/
-int
+EXTERN int
Pkgc_SafeInit(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
@@ -157,7 +165,6 @@ Pkgc_SafeInit(
if (code != TCL_OK) {
return code;
}
- Tcl_CreateObjCommand(interp, "pkgc_sub", Pkgc_SubObjCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "pkgc_sub", Pkgc_SubObjCmd, NULL, NULL);
return TCL_OK;
}
diff --git a/unix/dltest/pkgd.c b/unix/dltest/pkgd.c
index 7fe7c49..6e114e9 100644
--- a/unix/dltest/pkgd.c
+++ b/unix/dltest/pkgd.c
@@ -11,16 +11,25 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
+#undef STATIC_BUILD
#include "tcl.h"
/*
+ * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
+ * Pkgd_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
+
+/*
* Prototypes for procedures defined later in this file:
*/
static int Pkgd_SubObjCmd(ClientData clientData,
- Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
static int Pkgd_UnsafeObjCmd(ClientData clientData,
- Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
/*
*----------------------------------------------------------------------
@@ -44,7 +53,7 @@ Pkgd_SubObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
- Tcl_Obj *CONST objv[]) /* Argument objects. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int first, second;
@@ -82,7 +91,7 @@ Pkgd_UnsafeObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
- Tcl_Obj *CONST objv[]) /* Argument objects. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", -1));
return TCL_OK;
@@ -105,7 +114,7 @@ Pkgd_UnsafeObjCmd(
*----------------------------------------------------------------------
*/
-int
+EXTERN int
Pkgd_Init(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
@@ -119,10 +128,9 @@ Pkgd_Init(
if (code != TCL_OK) {
return code;
}
- Tcl_CreateObjCommand(interp, "pkgd_sub", Pkgd_SubObjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateObjCommand(interp, "pkgd_unsafe", Pkgd_UnsafeObjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "pkgd_sub", Pkgd_SubObjCmd, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "pkgd_unsafe", Pkgd_UnsafeObjCmd, NULL,
+ NULL);
return TCL_OK;
}
@@ -143,7 +151,7 @@ Pkgd_Init(
*----------------------------------------------------------------------
*/
-int
+EXTERN int
Pkgd_SafeInit(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
@@ -157,7 +165,6 @@ Pkgd_SafeInit(
if (code != TCL_OK) {
return code;
}
- Tcl_CreateObjCommand(interp, "pkgd_sub", Pkgd_SubObjCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "pkgd_sub", Pkgd_SubObjCmd, NULL, NULL);
return TCL_OK;
}
diff --git a/unix/dltest/pkge.c b/unix/dltest/pkge.c
index abd2359..d616352 100644
--- a/unix/dltest/pkge.c
+++ b/unix/dltest/pkge.c
@@ -11,8 +11,17 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
+#undef STATIC_BUILD
#include "tcl.h"
+/*
+ * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
+ * Pkge_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
+
/*
*----------------------------------------------------------------------
@@ -31,12 +40,12 @@
*----------------------------------------------------------------------
*/
-int
+EXTERN int
Pkge_Init(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
{
- static char script[] = "if 44 {open non_existent}";
+ static const char script[] = "if 44 {open non_existent}";
if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
return TCL_ERROR;
diff --git a/unix/dltest/pkgua.c b/unix/dltest/pkgua.c
index 9c36e88..417bedb 100644
--- a/unix/dltest/pkgua.c
+++ b/unix/dltest/pkgua.c
@@ -11,16 +11,25 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
+#undef STATIC_BUILD
#include "tcl.h"
/*
+ * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
+ * Pkgua_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
+
+/*
* Prototypes for procedures defined later in this file:
*/
static int PkguaEqObjCmd(ClientData clientData,
- Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
static int PkguaQuoteObjCmd(ClientData clientData,
- Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
/*
* In the following hash table we are going to store a struct that holds all
@@ -49,7 +58,7 @@ PkguaInitTokensHashTable(void)
interpTokenMapInitialised = 1;
}
-void
+static void
PkguaFreeTokensHashTable(void)
{
Tcl_HashSearch search;
@@ -77,7 +86,7 @@ PkguaInterpToTokens(
for (newEntry=0 ; newEntry<MAX_REGISTERED_COMMANDS+1 ; ++newEntry) {
cmdTokens[newEntry] = NULL;
}
- Tcl_SetHashValue(entryPtr, (ClientData) cmdTokens);
+ Tcl_SetHashValue(entryPtr, cmdTokens);
} else {
cmdTokens = (Tcl_Command *) Tcl_GetHashValue(entryPtr);
}
@@ -120,10 +129,10 @@ PkguaEqObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
- Tcl_Obj *CONST objv[]) /* Argument objects. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
int result;
- CONST char *str1, *str2;
+ const char *str1, *str2;
int len1, len2;
if (objc != 3) {
@@ -164,7 +173,7 @@ PkguaQuoteObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
- Tcl_Obj *CONST objv[]) /* Argument strings. */
+ Tcl_Obj *const objv[]) /* Argument strings. */
{
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "value");
@@ -191,7 +200,7 @@ PkguaQuoteObjCmd(
*----------------------------------------------------------------------
*/
-int
+EXTERN int
Pkgua_Init(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
@@ -219,11 +228,11 @@ Pkgua_Init(
cmdTokens = PkguaInterpToTokens(interp);
cmdTokens[cmdIndex++] =
- Tcl_CreateObjCommand(interp, "pkgua_eq", PkguaEqObjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "pkgua_eq", PkguaEqObjCmd, NULL,
+ NULL);
cmdTokens[cmdIndex++] =
Tcl_CreateObjCommand(interp, "pkgua_quote", PkguaQuoteObjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ NULL, NULL);
return TCL_OK;
}
@@ -244,7 +253,7 @@ Pkgua_Init(
*----------------------------------------------------------------------
*/
-int
+EXTERN int
Pkgua_SafeInit(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
@@ -269,7 +278,7 @@ Pkgua_SafeInit(
*----------------------------------------------------------------------
*/
-int
+EXTERN int
Pkgua_Unload(
Tcl_Interp *interp, /* Interpreter from which the package is to be
* unloaded. */
@@ -322,7 +331,7 @@ Pkgua_Unload(
*----------------------------------------------------------------------
*/
-int
+EXTERN int
Pkgua_SafeUnload(
Tcl_Interp *interp, /* Interpreter from which the package is to be
* unloaded. */
generated by cgit v0.12 at 2024-07-22 23:31:18 (GMT)