summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclInt.h18
-rw-r--r--generic/tclTest.c66
-rw-r--r--generic/tclTestObj.c7
-rw-r--r--generic/tclTestProcBodyObj.c17
-rw-r--r--generic/tclThreadTest.c16
5 files changed, 97 insertions, 27 deletions
diff --git a/generic/tclInt.h b/generic/tclInt.h
index eefe5f6..d02df6b 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -15,7 +15,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInt.h,v 1.447 2009/11/16 18:00:11 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.448 2009/11/18 23:46:05 nijtmans Exp $
*/
#ifndef _TCLINT
@@ -4026,6 +4026,22 @@ MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int *bignum,
Tcl_WideUInt initVal);
/*
+ *----------------------------------------------------------------------
+ *
+ * External (platform specific) initialization routine, these declarations
+ * explicitly don't use EXTERN since this code does not get compiled into the
+ * library:
+ *
+ *----------------------------------------------------------------------
+ */
+
+MODULE_SCOPE int TclplatformtestInit(Tcl_Interp *interp);
+MODULE_SCOPE int TclObjTest_Init(Tcl_Interp *interp);
+MODULE_SCOPE int TclThread_Init(Tcl_Interp *interp);
+MODULE_SCOPE int Procbodytest_Init(Tcl_Interp *interp);
+MODULE_SCOPE int Procbodytest_SafeInit(Tcl_Interp *interp);
+
+/*
*----------------------------------------------------------------
* Macro used by the Tcl core to check whether a pattern has any characters
* special to [string match]. The ANSI C "prototype" for this macro is:
diff --git a/generic/tclTest.c b/generic/tclTest.c
index b089065..ca0d507 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -14,9 +14,12 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclTest.c,v 1.138 2009/11/16 18:01:49 dgp Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.139 2009/11/18 23:46:05 nijtmans Exp $
*/
+#ifndef USE_TCL_STUBS
+# define USE_TCL_STUBS
+#endif
#define TCL_TEST
#include "tclInt.h"
@@ -40,6 +43,17 @@
*/
/*
+ * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
+ * Tcltest_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
+EXTERN int Tcltest_Init(Tcl_Interp *interp);
+EXTERN int Tcltest_SafeInit(Tcl_Interp *interp);
+
+/*
* Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect
* the results of the various deletion callbacks.
*/
@@ -494,15 +508,6 @@ static const 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);
-
-/*
*----------------------------------------------------------------------
*
* Tcltest_Init --
@@ -535,6 +540,9 @@ Tcltest_Init(
"-appinitprocclosestderr", "-appinitprocsetrcfile", NULL
};
+ if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
+ return TCL_ERROR;
+ }
/* TIP #268: Full patchlevel instead of just major.minor */
if (Tcl_PkgProvide(interp, "Tcltest", TCL_PATCH_LEVEL) == TCL_ERROR) {
@@ -672,7 +680,12 @@ Tcltest_Init(
Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels,
(ClientData) NULL, NULL);
-
+ if (TclObjTest_Init(interp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Procbodytest_Init(interp) != TCL_OK) {
+ return TCL_ERROR;
+ }
#ifdef TCL_THREADS
if (TclThread_Init(interp) != TCL_OK) {
return TCL_ERROR;
@@ -718,6 +731,35 @@ Tcltest_Init(
return TclplatformtestInit(interp);
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcltest_SafeInit --
+ *
+ * This procedure performs application-specific initialization. Most
+ * applications, especially those that incorporate additional packages,
+ * will have their own version of this procedure.
+ *
+ * Results:
+ * Returns a standard Tcl completion code, and leaves an error message in
+ * the interp's result if an error occurs.
+ *
+ * Side effects:
+ * Depends on the startup script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcltest_SafeInit(
+ Tcl_Interp *interp) /* Interpreter for application. */
+{
+ if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
+ return TCL_ERROR;
+ }
+ return Procbodytest_SafeInit(interp);
+}
/*
*----------------------------------------------------------------------
@@ -4387,7 +4429,7 @@ TestfinexitObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
int value;
-
+
if ((objc != 1) && (objc != 2)) {
Tcl_WrongNumArgs(interp, 1, objv, "?returnCode?");
return TCL_ERROR;
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index dba06f9..43a64cd 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -13,9 +13,12 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclTestObj.c,v 1.34 2009/02/16 04:33:10 dgp Exp $
+ * RCS: @(#) $Id: tclTestObj.c,v 1.35 2009/11/18 23:46:05 nijtmans Exp $
*/
+#ifndef USE_TCL_STUBS
+# define USE_TCL_STUBS
+#endif
#include "tclInt.h"
#include "tommath.h"
@@ -996,7 +999,7 @@ TeststringobjCmd(
TestString *strPtr;
static const char *const options[] = {
"append", "appendstrings", "get", "get2", "length", "length2",
- "set", "set2", "setlength", "maxchars", "getunicode",
+ "set", "set2", "setlength", "maxchars", "getunicode",
"appendself", "appendself2", NULL
};
diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c
index b961e3c..2d5745e 100644
--- a/generic/tclTestProcBodyObj.c
+++ b/generic/tclTestProcBodyObj.c
@@ -10,23 +10,26 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclTestProcBodyObj.c,v 1.9 2009/02/10 23:08:56 nijtmans Exp $
+ * RCS: @(#) $Id: tclTestProcBodyObj.c,v 1.10 2009/11/18 23:46:05 nijtmans Exp $
*/
+#ifndef USE_TCL_STUBS
+# define USE_TCL_STUBS
+#endif
#include "tclInt.h"
/*
* name and version of this package
*/
-static char packageName[] = "procbodytest";
-static char packageVersion[] = "1.0";
+static const char packageName[] = "procbodytest";
+static const char packageVersion[] = "1.0";
/*
* Name of the commands exported by this package
*/
-static char procCommand[] = "proc";
+static const char procCommand[] = "proc";
/*
* this struct describes an entry in the table of command names and command
@@ -34,7 +37,7 @@ static char procCommand[] = "proc";
*/
typedef struct CmdTable {
- char *cmdName; /* command name */
+ const char *cmdName; /* command name */
Tcl_ObjCmdProc *proc; /* command proc */
int exportIt; /* if 1, export the command */
} CmdTable;
@@ -47,7 +50,7 @@ static int ProcBodyTestProcObjCmd(ClientData dummy,
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
static int ProcBodyTestInitInternal(Tcl_Interp *interp, int isSafe);
static int RegisterCommand(Tcl_Interp* interp,
- char *namespace, const CmdTable *cmdTablePtr);
+ const char *namespace, const CmdTable *cmdTablePtr);
int Procbodytest_Init(Tcl_Interp * interp);
int Procbodytest_SafeInit(Tcl_Interp * interp);
@@ -135,7 +138,7 @@ static int
RegisterCommand(
Tcl_Interp* interp, /* the Tcl interpreter for which the operation
* is performed */
- char *namespace, /* the namespace in which the command is
+ const char *namespace, /* the namespace in which the command is
* registered */
const CmdTable *cmdTablePtr)/* the command to register */
{
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index 3b7c506..d4a5f92 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -12,13 +12,14 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclThreadTest.c,v 1.31 2009/02/10 23:09:05 nijtmans Exp $
+ * RCS: @(#) $Id: tclThreadTest.c,v 1.32 2009/11/18 23:46:05 nijtmans Exp $
*/
+#ifndef USE_TCL_STUBS
+# define USE_TCL_STUBS
+#endif
#include "tclInt.h"
-extern int Tcltest_Init(Tcl_Interp *interp);
-
#ifdef TCL_THREADS
/*
* Each thread has an single instance of the following structure. There is one
@@ -577,14 +578,19 @@ NewTestThread(
tsdPtr->interp = Tcl_CreateInterp();
result = Tcl_Init(tsdPtr->interp);
- result = TclThread_Init(tsdPtr->interp);
+ if (result != TCL_OK) {
+ ThreadErrorProc(tsdPtr->interp);
+ }
/*
* This is part of the test facility. Initialize _ALL_ test commands for
* use by the new thread.
*/
- result = Tcltest_Init(tsdPtr->interp);
+ result = Tcl_PackageRequire(tsdPtr->interp, "Tcltest", TCL_VERSION, 1);
+ if (result != TCL_OK) {
+ ThreadErrorProc(tsdPtr->interp);
+ }
/*
* Update the list of threads.
generated by cgit v0.12 at 2024-11-22 16:13:21 (GMT)