summaryrefslogtreecommitdiffstats
path: root/generic/tclTest.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclTest.c')
-rw-r--r--generic/tclTest.c66
1 files changed, 54 insertions, 12 deletions
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;