diff options
Diffstat (limited to 'generic/tclTest.c')
| -rw-r--r-- | generic/tclTest.c | 66 |
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; |