diff options
| -rw-r--r-- | generic/tclPanic.c | 1 | ||||
| -rw-r--r-- | generic/tclTest.c | 74 | ||||
| -rw-r--r-- | tests/tcltests.tcl | 23 | ||||
| -rw-r--r-- | tests/winDde.test | 2 |
4 files changed, 11 insertions, 89 deletions
diff --git a/generic/tclPanic.c b/generic/tclPanic.c index 1fd922b..ba7e801 100644 --- a/generic/tclPanic.c +++ b/generic/tclPanic.c @@ -45,6 +45,7 @@ static TCL_NORETURN1 Tcl_PanicProc *panicProc = NULL; *---------------------------------------------------------------------- */ +#undef Tcl_SetPanicProc const char * Tcl_SetPanicProc( TCL_NORETURN1 Tcl_PanicProc *proc) diff --git a/generic/tclTest.c b/generic/tclTest.c index 54c0bbc..d32057b 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -228,7 +228,6 @@ 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; @@ -267,7 +266,6 @@ 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, @@ -566,8 +564,6 @@ 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); @@ -632,8 +628,6 @@ 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, @@ -3430,40 +3424,6 @@ 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 @@ -3865,40 +3825,6 @@ 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 diff --git a/tests/tcltests.tcl b/tests/tcltests.tcl index 1ee37d3..b9d7cfd 100644 --- a/tests/tcltests.tcl +++ b/tests/tcltests.tcl @@ -3,22 +3,17 @@ package require tcltest 2.5 namespace import ::tcltest::* testConstraint exec [llength [info commands exec]] -if {[namespace which testdebug] ne {}} { - testConstraint debug [testdebug] - testConstraint purify [testpurify] - testConstraint debugpurify [ - expr { - ![testConstraint memory] - && - [testConstraint debug] - && - [testConstraint purify] - }] -} +testConstraint debug [expr {"debug" in [split [package provide tcl] .]}] +testConstraint purify [expr {"purify" in [split [package provide tcl] .]}] +testConstraint debugpurify [ + expr { + "memdebug" ni [split [package provide tcl] .] + && [testConstraint debug] + && [testConstraint purify] + }] testConstraint fcopy [llength [info commands fcopy]] testConstraint fileevent [llength [info commands fileevent]] -testConstraint thread [ - expr {0 == [catch {package require Thread 2.7-}]}] +testConstraint thread [expr {![catch {package require Thread 2.7-}]}] testConstraint notValgrind [expr {![testConstraint valgrind]}] diff --git a/tests/winDde.test b/tests/winDde.test index 72f3d92..dbadeb4 100644 --- a/tests/winDde.test +++ b/tests/winDde.test @@ -13,8 +13,8 @@ if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } +package require tcltests -testConstraint debug [expr {"debug" in [split [package provide tcl] .]}] testConstraint dde 0 if {[testConstraint win]} { if {![catch { |