diff options
Diffstat (limited to 'library/tcltest/tcltest.tcl')
| -rw-r--r-- | library/tcltest/tcltest.tcl | 41 |
1 files changed, 37 insertions, 4 deletions
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index a7a68c7..28c50ef 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -22,7 +22,7 @@ namespace eval tcltest { # When the version number changes, be sure to update the pkgIndex.tcl file, # and the install directory in the Makefiles. When the minor version # changes (new feature) be sure to update the man page as well. - variable Version 2.5.1 + variable Version 2.5.2 # Compatibility support for dumb variables defined in tcltest 1 # Do not use these. Call [package provide Tcl] and [info patchlevel] @@ -1983,7 +1983,9 @@ proc tcltest::test {name description args} { } # First, run the setup script - set code [catch {uplevel 1 $setup} setupMsg] + set code [catch { + uplevel 1 [list [namespace which SetupTest] $setup] + } setupMsg] if {$code == 1} { set errorInfo(setup) $::errorInfo set errorCodeRes(setup) $::errorCode @@ -2067,7 +2069,9 @@ proc tcltest::test {name description args} { } # Always run the cleanup script - set code [catch {uplevel 1 $cleanup} cleanupMsg] + set code [catch { + uplevel 1 [list [namespace which CleanupTest] $cleanup] + } cleanupMsg] if {$code == 1} { set errorInfo(cleanup) $::errorInfo set errorCodeRes(cleanup) $::errorCode @@ -2338,6 +2342,8 @@ proc tcltest::Skipped {name constraints} { return 0 } + + # RunTest -- # # This is where the body of a test is evaluated. The combination of @@ -2354,11 +2360,38 @@ proc tcltest::RunTest {name script} { memory tag $name } - set code [catch {uplevel 1 $script} actualAnswer] + set code [catch {uplevel 1 [list [ + namespace origin EvalTest] $script]} actualAnswer copts] return [list $actualAnswer $code] } + +proc tcltest::EvalTest script { + set code [catch {uplevel 1 $script} cres copts] + dict set copts -code $code + dict incr copts -level + return -options $copts $cres +} + + + +# SetupTest -- +# +# Evaluates the -setup script for a test + +proc tcltest::SetupTest setup { + uplevel 1 $setup +} + + +# CleanupTest -- +# +# Evaluates the -cleanup script for a test +proc tcltest::CleanupTest cleanup { + uplevel 1 $cleanup +} + ##################################################################### # tcltest::cleanupTestsHook -- |