diff options
author | Kevin B Kenny <kennykb@acm.org> | 2014-06-29 02:20:31 (GMT) |
---|---|---|
committer | Kevin B Kenny <kennykb@acm.org> | 2014-06-29 02:20:31 (GMT) |
commit | 54aa5c1f2d5513d45d1361a3615125a4810cc1c0 (patch) | |
tree | 9e84f6c42d0fdc3d3a0958996705d2c2fbb5f722 /library/tcltest | |
parent | 2ac3c16d405d20153ce0ad43f308ff05bc372f7a (diff) | |
parent | c0edc29d67c0944180ce922c7f63d6dd3c3bdf6c (diff) | |
download | tcl-54aa5c1f2d5513d45d1361a3615125a4810cc1c0.zip tcl-54aa5c1f2d5513d45d1361a3615125a4810cc1c0.tar.gz tcl-54aa5c1f2d5513d45d1361a3615125a4810cc1c0.tar.bz2 |
merge trunk
Diffstat (limited to 'library/tcltest')
-rw-r--r-- | library/tcltest/pkgIndex.tcl | 2 | ||||
-rw-r--r-- | library/tcltest/tcltest.tcl | 84 |
2 files changed, 43 insertions, 43 deletions
diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl index c99ad2a..987725f 100644 --- a/library/tcltest/pkgIndex.tcl +++ b/library/tcltest/pkgIndex.tcl @@ -9,4 +9,4 @@ # full path name of this file's directory. if {![package vsatisfies [package provide Tcl] 8.5]} {return} -package ifneeded tcltest 2.3.7 [list source [file join $dir tcltest.tcl]] +package ifneeded tcltest 2.3.8 [list source [file join $dir tcltest.tcl]] diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 4b94312..8e43859 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.3.7 + variable Version 2.3.8 # Compatibility support for dumb variables defined in tcltest 1 # Do not use these. Call [package provide Tcl] and [info patchlevel] @@ -1991,47 +1991,6 @@ proc tcltest::test {name description args} { } } - # Always run the cleanup script - set code [catch {uplevel 1 $cleanup} cleanupMsg] - if {$code == 1} { - set errorInfo(cleanup) $::errorInfo - set errorCode(cleanup) $::errorCode - } - set cleanupFailure [expr {$code != 0}] - - set coreFailure 0 - set coreMsg "" - # check for a core file first - if one was created by the test, - # then the test failed - if {[preserveCore]} { - if {[file exists [file join [workingDirectory] core]]} { - # There's only a test failure if there is a core file - # and (1) there previously wasn't one or (2) the new - # one is different from the old one. - if {[info exists coreModTime]} { - if {$coreModTime != [file mtime \ - [file join [workingDirectory] core]]} { - set coreFailure 1 - } - } else { - set coreFailure 1 - } - - if {([preserveCore] > 1) && ($coreFailure)} { - append coreMsg "\nMoving file to:\ - [file join [temporaryDirectory] core-$name]" - catch {file rename -force -- \ - [file join [workingDirectory] core] \ - [file join [temporaryDirectory] core-$name] - } msg - if {$msg ne {}} { - append coreMsg "\nError:\ - Problem renaming core file: $msg" - } - } - } - } - # check if the return code matched the expected return code set codeFailure 0 if {!$setupFailure && ($returnCode ni $returnCodes)} { @@ -2076,6 +2035,47 @@ proc tcltest::test {name description args} { set scriptFailure 1 } + # Always run the cleanup script + set code [catch {uplevel 1 $cleanup} cleanupMsg] + if {$code == 1} { + set errorInfo(cleanup) $::errorInfo + set errorCode(cleanup) $::errorCode + } + set cleanupFailure [expr {$code != 0}] + + set coreFailure 0 + set coreMsg "" + # check for a core file first - if one was created by the test, + # then the test failed + if {[preserveCore]} { + if {[file exists [file join [workingDirectory] core]]} { + # There's only a test failure if there is a core file + # and (1) there previously wasn't one or (2) the new + # one is different from the old one. + if {[info exists coreModTime]} { + if {$coreModTime != [file mtime \ + [file join [workingDirectory] core]]} { + set coreFailure 1 + } + } else { + set coreFailure 1 + } + + if {([preserveCore] > 1) && ($coreFailure)} { + append coreMsg "\nMoving file to:\ + [file join [temporaryDirectory] core-$name]" + catch {file rename -force -- \ + [file join [workingDirectory] core] \ + [file join [temporaryDirectory] core-$name] + } msg + if {$msg ne {}} { + append coreMsg "\nError:\ + Problem renaming core file: $msg" + } + } + } + } + # if we didn't experience any failures, then we passed variable numTests if {!($setupFailure || $cleanupFailure || $coreFailure |