diff options
Diffstat (limited to 'generic/tclTest.c')
| -rw-r--r-- | generic/tclTest.c | 74 |
1 files changed, 74 insertions, 0 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c index a433c49..83c7c18 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -224,6 +224,7 @@ static Tcl_CmdProc TestcreatecommandCmd; static Tcl_CmdProc TestdcallCmd; static Tcl_CmdProc TestdelCmd; static Tcl_CmdProc TestdelassocdataCmd; +static Tcl_ObjCmdProc TestdebugObjCmd; static Tcl_ObjCmdProc TestdoubledigitsObjCmd; static Tcl_CmdProc TestdstringCmd; static Tcl_ObjCmdProc TestencodingObjCmd; @@ -262,6 +263,7 @@ static Tcl_ObjCmdProc TestparsevarObjCmd; static Tcl_ObjCmdProc TestparsevarnameObjCmd; static Tcl_ObjCmdProc TestpreferstableObjCmd; static Tcl_ObjCmdProc TestprintObjCmd; +static Tcl_ObjCmdProc TestpurifyObjCmd; static Tcl_ObjCmdProc TestregexpObjCmd; static Tcl_ObjCmdProc TestreturnObjCmd; static void TestregexpXflags(const char *string, @@ -501,6 +503,8 @@ Tcltest_Init( Tcl_CreateCommand(interp, "testcreatecommand", TestcreatecommandCmd, NULL, NULL); Tcl_CreateCommand(interp, "testdcall", TestdcallCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testdebug", TestdebugObjCmd, + NULL, NULL); Tcl_CreateCommand(interp, "testdel", TestdelCmd, NULL, NULL); Tcl_CreateCommand(interp, "testdelassocdata", TestdelassocdataCmd, NULL, NULL); @@ -565,6 +569,8 @@ Tcltest_Init( NULL, NULL); Tcl_CreateObjCommand(interp, "testpreferstable", TestpreferstableObjCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testpurify", TestpurifyObjCmd, + NULL, NULL); Tcl_CreateObjCommand(interp, "testprint", TestprintObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd, @@ -3362,6 +3368,40 @@ TestlocaleCmd( /* *---------------------------------------------------------------------- * + * TestdebugObjCmd -- + * + * Implements the "testdebug" command, to detect whether Tcl was built with + * --enabble-symbols. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestdebugObjCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, /* Current interpreter. */ + TCL_UNUSED(int) /*objc*/, + TCL_UNUSED(Tcl_Obj *const *) /*objv*/) +{ + +#if defined(NDEBUG) && NDEBUG == 1 + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); +#else + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); +#endif + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * CleanupTestSetassocdataTests -- * * This function is called when an interpreter is deleted to clean @@ -3763,6 +3803,40 @@ TestprintObjCmd( /* *---------------------------------------------------------------------- * + * TestpurifyObjCmd -- + * + * Implements the "testpurify" command, to detect whether Tcl was built with + * -DPURIFY. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestpurifyObjCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, /* Current interpreter. */ + TCL_UNUSED(int) /*objc*/, + TCL_UNUSED(Tcl_Obj *const *) /*objv*/) +{ + +#ifdef PURIFY + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); +#else + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); +#endif + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * TestregexpObjCmd -- * * This procedure implements the "testregexp" command. It is used to give |