diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2014-06-24 07:42:32 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2014-06-24 07:42:32 (GMT) |
commit | f0bba60202785e634e8e1712db5cc37246d36e32 (patch) | |
tree | 3dfc724e92d5c38042e1d5a2d378aaf80df19963 | |
parent | 33356d7984d054b9c6888c451f8d331e35ed292b (diff) | |
parent | 1f0269b58249734182a5bcae22fb7b31071d775f (diff) | |
download | tcl-f0bba60202785e634e8e1712db5cc37246d36e32.zip tcl-f0bba60202785e634e8e1712db5cc37246d36e32.tar.gz tcl-f0bba60202785e634e8e1712db5cc37246d36e32.tar.bz2 |
merge trunk
-rw-r--r-- | library/tcltest/tcltest.tcl | 66 |
1 files changed, 33 insertions, 33 deletions
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 22d79e1..8e43859 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -1991,39 +1991,6 @@ proc tcltest::test {name description args} { } } - 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 +2043,39 @@ proc tcltest::test {name description args} { } 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 |