diff options
| -rw-r--r-- | generic/tclTest.c | 16 | ||||
| -rw-r--r-- | tests/encoding.test | 8 | ||||
| -rw-r--r-- | tests/fileSystem.test | 16 | ||||
| -rw-r--r-- | tests/registry.test | 2 |
4 files changed, 30 insertions, 12 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c index bf75a0f..680e360 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -313,11 +313,13 @@ static int TestexitmainloopCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestpanicCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); +#ifndef _WIN32 static int TestfinexitObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int TestparseargsCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); +#endif /* _WIN32 */ +static int TestparseargsCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); static int TestparserObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -638,7 +640,9 @@ Tcltest_Init( Tcl_CreateObjCommand(interp, "testlocale", TestlocaleCmd, NULL, NULL); Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, NULL, NULL); +#ifndef _WIN32 Tcl_CreateObjCommand(interp, "testfinexit", TestfinexitObjCmd, NULL, NULL); +#endif /* _WIN32 */ Tcl_CreateObjCommand(interp, "testparseargs", TestparseargsCmd,NULL,NULL); Tcl_CreateObjCommand(interp, "testparser", TestparserObjCmd, NULL, NULL); @@ -4559,6 +4563,11 @@ TestpanicCmd( * * Calls a variant of [exit] including the full finalization path. * + * On Win32, the test suite is run with all Tcltest funcions in a dll, + * but TclpExit cannot be called from inside a dynamically loaded dll. + * It would mean that the dll is terminated, while there is still a + * function on the stack which belong to the dll. + * * Results: * Error, or doesn't return. * @@ -4568,6 +4577,7 @@ TestpanicCmd( *---------------------------------------------------------------------- */ +#ifndef _WIN32 static int TestfinexitObjCmd( ClientData dummy, /* Not used. */ @@ -4592,6 +4602,8 @@ TestfinexitObjCmd( /*NOTREACHED*/ return TCL_ERROR; /* Better not ever reach this! */ } +#endif /* _WIN32 */ + static int TestfileCmd( diff --git a/tests/encoding.test b/tests/encoding.test index 47bb81e..30aada0 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -15,8 +15,11 @@ namespace eval ::tcl::test::encoding { namespace import -force ::tcltest::* -::tcltest::loadTestedCommands -catch [list package require -exact Tcltest [info patchlevel]] +catch { + ::tcltest::loadTestedCommands + package require -exact Tcltest [info patchlevel] + set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1] +} proc toutf {args} { variable x @@ -406,6 +409,7 @@ cd [workingDirectory] # Code to make the next few tests more intelligible; the code being tested # should be in the body of the test! proc runInSubprocess {contents {filename iso2022.tcl}} { + set contents "load $::tcltestlib Tcltest\n$contents" set theFile [makeFile $contents $filename] try { exec [interpreter] $theFile diff --git a/tests/fileSystem.test b/tests/fileSystem.test index 638c427..3348b7b 100644 --- a/tests/fileSystem.test +++ b/tests/fileSystem.test @@ -19,8 +19,12 @@ namespace eval ::tcl::test::fileSystem { file delete -force [file join dir.dir linkinside.file] } -::tcltest::loadTestedCommands -catch [list package require -exact Tcltest [info patchlevel]] +catch { + ::tcltest::loadTestedCommands + package require -exact Tcltest [info patchlevel] + set ::ddelib [lindex [package ifneeded dde 1.4.0b1] 1] + set ::reglib [lindex [package ifneeded registry 1.3.0] 1] +} # Test for commands defined in Tcltest executable testConstraint testfilesystem [llength [info commands ::testfilesystem]] @@ -507,10 +511,9 @@ test filesystem-7.1.1 {load from vfs} -setup { } -constraints {win testsimplefilesystem} -body { # This may cause a crash on exit cd [file dirname [info nameof]] - set dde [lindex [glob *dde*[info sharedlib]] 0] testsimplefilesystem 1 # This loads dde via a complex copy-to-temp operation - load simplefs:/$dde dde + load simplefs:/$::ddelib dde testsimplefilesystem 0 return ok # The real result of this test is what happens when Tcl exits. @@ -522,11 +525,10 @@ test filesystem-7.1.2 {load from vfs, and then unload again} -setup { } -constraints {win testsimplefilesystem} -body { # This may cause a crash on exit cd [file dirname [info nameof]] - set reg [lindex [glob tclreg*[info sharedlib]] 0] testsimplefilesystem 1 # This loads reg via a complex copy-to-temp operation - load simplefs:/$reg Registry - unload simplefs:/$reg + load simplefs:/$::reglib Registry + unload simplefs:/$::reglib testsimplefilesystem 0 return ok # The real result of this test is what happens when Tcl exits. diff --git a/tests/registry.test b/tests/registry.test index 7881e82..8f8aa98 100644 --- a/tests/registry.test +++ b/tests/registry.test @@ -19,7 +19,7 @@ testConstraint reg 0 if {[testConstraint win]} { if {![catch { ::tcltest::loadTestedCommands - package require registry + package require -exact registry 1.3.0 }]} { testConstraint reg 1 } |