summaryrefslogtreecommitdiffstats
path: root/library/tcltest/tcltest.tcl
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2014-06-23 12:48:16 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2014-06-23 12:48:16 (GMT)
commit2b8bf1a9f78976b319f00258e80ed4c3fe467e50 (patch)
tree5d6b438466d0da5c1a2dbdd3b26a6cb18f655b69 /library/tcltest/tcltest.tcl
parent5d8942cb06b4c5a6b538dd5d80eb4f039bd36d34 (diff)
downloadtcl-2b8bf1a9f78976b319f00258e80ed4c3fe467e50.zip
tcl-2b8bf1a9f78976b319f00258e80ed4c3fe467e50.tar.gz
tcl-2b8bf1a9f78976b319f00258e80ed4c3fe467e50.tar.bz2
Fix execute-6.5 test failure on trunk: the "preserveCore" part of tcltest::test assumes that the cleanup is done first, so moving the cleanup means the the "preserverCore" part needs to move with it.
Diffstat (limited to 'library/tcltest/tcltest.tcl')
-rw-r--r--library/tcltest/tcltest.tcl66
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