From 364ba5e8b94ce0664b5fbb16c62fdc9fc60fdc4c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 6 Dec 2019 14:51:39 +0000 Subject: Exclude some test-cases with possible timing problems on Windows. Double ;; in generic/tclTimer.c --- generic/tclTimer.c | 2 +- tests/clock.test | 9 +++++---- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/generic/tclTimer.c b/generic/tclTimer.c index 33838ec..c4d22ce 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -882,7 +882,7 @@ Tcl_AfterObjCmd( if (objc == 3) { commandPtr = objv[2]; } else { - commandPtr = Tcl_ConcatObj(objc-2, objv+2);; + commandPtr = Tcl_ConcatObj(objc-2, objv+2); } command = Tcl_GetStringFromObj(commandPtr, &length); for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL; diff --git a/tests/clock.test b/tests/clock.test index f6cba28..265feed 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -31,6 +31,7 @@ testConstraint detroit \ [expr {![catch {clock format 0 -timezone :America/Detroit -format %z}]}] testConstraint y2038 \ [expr {[clock format 2158894800 -format %z -timezone :America/Detroit] eq {-0400}}] +testConstraint knownWindowsTimingProblem [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] # TEST PLAN @@ -35438,7 +35439,7 @@ test clock-33.4a {clock milliseconds} { expr { [clock milliseconds] + 1 } concat {} } {} -test clock-33.5 {clock clicks tests, millisecond timing test} { +test clock-33.5 {clock clicks tests, millisecond timing test} knownWindowsTimingProblem { # This test can fail on a system that is so heavily loaded that # the test takes >60 ms to run. set start [clock clicks -milli] @@ -35450,7 +35451,7 @@ test clock-33.5 {clock clicks tests, millisecond timing test} { "ok" : "test should have taken 0-60 ms, actually took [expr $end - $start]"} } {ok} -test clock-33.5a {clock tests, millisecond timing test} { +test clock-33.5a {clock tests, millisecond timing test} knownWindowsTimingProblem { # This test can fail on a system that is so heavily loaded that # the test takes >60 ms to run. set start [clock milliseconds] @@ -35469,7 +35470,7 @@ test clock-33.7 {clock clicks, milli with too much abbreviation} { list [catch { clock clicks - } msg] $msg } {1 {ambiguous option "-": must be -milliseconds or -microseconds}} -test clock-33.8 {clock clicks test, microsecond timing test} { +test clock-33.8 {clock clicks test, microsecond timing test} knownWindowsTimingProblem { # This test can fail on a system that is so heavily loaded that # the test takes >60 ms to run. set start [clock clicks -micro] @@ -35477,7 +35478,7 @@ test clock-33.8 {clock clicks test, microsecond timing test} { set end [clock clicks -micro] expr {($end > $start) && (($end - $start) <= 60000)} } {1} -test clock-33.8a {clock test, microsecond timing test} { +test clock-33.8a {clock test, microsecond timing test} knownWindowsTimingProblem { # This test can fail on a system that is so heavily loaded that # the test takes >60 ms to run. set start [clock microseconds] -- cgit v0.12 From 74b0c7c91a141c9a109c3639d762c08c08a89c01 Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 6 Dec 2019 16:42:19 +0000 Subject: rewrite of [dff608952b]: skip tests if there is really a timing issue (and implements new feature ::tcltest::Skip which allows conditionally skipping of tests at runtime) --- library/tcltest/tcltest.tcl | 66 ++++++++++++++++++++++++++++++++++----------- tests/clock.test | 53 ++++++++++++++++++++++++------------ 2 files changed, 87 insertions(+), 32 deletions(-) diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index a7a68c7..68570d2 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -1983,15 +1983,20 @@ proc tcltest::test {name description args} { } # First, run the setup script + set processTest 1 set code [catch {uplevel 1 $setup} setupMsg] if {$code == 1} { set errorInfo(setup) $::errorInfo set errorCodeRes(setup) $::errorCode + if {$errorCodeRes(setup) eq "BYPASS-SKIPPED-TEST"} { + _noticeSkipped $name $setupMsg + set processTest [set code 0] + } } set setupFailure [expr {$code != 0}] # Only run the test body if the setup was successful - if {!$setupFailure} { + if {$processTest && !$setupFailure} { # Register startup time if {[IsVerbose msec] || [IsVerbose usec]} { @@ -2014,16 +2019,20 @@ proc tcltest::test {name description args} { if {$returnCode == 1} { set errorInfo(body) $::errorInfo set errorCodeRes(body) $::errorCode + if {$errorCodeRes(body) eq "BYPASS-SKIPPED-TEST"} { + _noticeSkipped $name $actualAnswer + set processTest [set returnCode 0] + } } } # check if the return code matched the expected return code set codeFailure 0 - if {!$setupFailure && ($returnCode ni $returnCodes)} { + if {$processTest && !$setupFailure && ($returnCode ni $returnCodes)} { set codeFailure 1 } set errorCodeFailure 0 - if {!$setupFailure && !$codeFailure && $returnCode == 1 && \ + if {$processTest && !$setupFailure && !$codeFailure && $returnCode == 1 && \ ![string match $errorCode $errorCodeRes(body)]} { set errorCodeFailure 1 } @@ -2032,7 +2041,7 @@ proc tcltest::test {name description args} { # them. If the comparison fails, then so did the test. set outputFailure 0 variable outData - if {[info exists output] && !$codeFailure} { + if {$processTest && [info exists output] && !$codeFailure} { if {[set outputCompare [catch { CompareStrings $outData $output $match } outputMatch]] == 0} { @@ -2044,7 +2053,7 @@ proc tcltest::test {name description args} { set errorFailure 0 variable errData - if {[info exists errorOutput] && !$codeFailure} { + if {$processTest && [info exists errorOutput] && !$codeFailure} { if {[set errorCompare [catch { CompareStrings $errData $errorOutput $match } errorMatch]] == 0} { @@ -2056,7 +2065,9 @@ proc tcltest::test {name description args} { # check if the answer matched the expected answer # Only check if we ran the body of the test (no setup failure) - if {$setupFailure || $codeFailure} { + if {!$processTest} { + set scriptFailure 0 + } elseif {$setupFailure || $codeFailure} { set scriptFailure 0 } elseif {[set scriptCompare [catch { CompareStrings $actualAnswer $result $match @@ -2117,6 +2128,12 @@ proc tcltest::test {name description args} { } } + # if skipped, it is safe to return here + if {!$processTest} { + incr testLevel -1 + return + } + # if we didn't experience any failures, then we passed variable numTests if {!($setupFailure || $cleanupFailure || $coreFailure @@ -2177,7 +2194,7 @@ proc tcltest::test {name description args} { puts [outputChannel] "---- errorCode(setup): $errorCodeRes(setup)" } } - if {$scriptFailure} { + if {$processTest && $scriptFailure} { if {$scriptCompare} { puts [outputChannel] "---- Error testing result: $scriptMatch" } else { @@ -2244,6 +2261,32 @@ proc tcltest::test {name description args} { return } +# Skip -- +# +# Skips a running test and add a reason to skipped "constraints". Can be used +# to conditional intended abort of the test. +# +# Side Effects: Maintains tally of total tests seen and tests skipped. +# +proc tcltest::Skip {reason} { + return -code error -errorcode BYPASS-SKIPPED-TEST $reason +} + +proc tcltest::_noticeSkipped {name reason} { + variable testLevel + variable numTests + + if {[IsVerbose skip]} { + puts [outputChannel] "++++ $name SKIPPED: $reason" + } + + if {$testLevel == 1} { + incr numTests(Skipped) + AddToSkippedBecause $reason + } +} + + # Skipped -- # # Given a test name and it constraints, returns a boolean indicating @@ -2324,14 +2367,7 @@ proc tcltest::Skipped {name constraints} { } if {!$doTest} { - if {[IsVerbose skip]} { - puts [outputChannel] "++++ $name SKIPPED: $constraints" - } - - if {$testLevel == 1} { - incr numTests(Skipped) - AddToSkippedBecause $constraints - } + _noticeSkipped $name $constraints return 1 } } diff --git a/tests/clock.test b/tests/clock.test index 265feed..862e78c 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -31,7 +31,10 @@ testConstraint detroit \ [expr {![catch {clock format 0 -timezone :America/Detroit -format %z}]}] testConstraint y2038 \ [expr {[clock format 2158894800 -format %z -timezone :America/Detroit] eq {-0400}}] -testConstraint knownWindowsTimingProblem [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] + +if {[namespace which -command ::tcl::unsupported::timerate] ne ""} { + namespace import ::tcl::unsupported::timerate +} # TEST PLAN @@ -35439,24 +35442,32 @@ test clock-33.4a {clock milliseconds} { expr { [clock milliseconds] + 1 } concat {} } {} -test clock-33.5 {clock clicks tests, millisecond timing test} knownWindowsTimingProblem { +test clock-33.5 {clock clicks tests, millisecond timing test} { # This test can fail on a system that is so heavily loaded that # the test takes >60 ms to run. - set start [clock clicks -milli] - after 10 - set end [clock clicks -milli] + if {[lindex [timerate { + set start [clock clicks -milli] + timerate {} 10; # short but precise busy wait + set end [clock clicks -milli] + } 1 1] 0] > 60000} { + ::tcltest::Skip "timing issue" + } # 60 msecs seems to be the max time slice under Windows 95/98 expr { ($end > $start) && (($end - $start) <= 60) ? "ok" : "test should have taken 0-60 ms, actually took [expr $end - $start]"} } {ok} -test clock-33.5a {clock tests, millisecond timing test} knownWindowsTimingProblem { +test clock-33.5a {clock tests, millisecond timing test} { # This test can fail on a system that is so heavily loaded that # the test takes >60 ms to run. - set start [clock milliseconds] - after 10 - set end [clock milliseconds] + if {[lindex [timerate { + set start [clock milliseconds] + timerate {} 10; # short but precise busy wait + set end [clock milliseconds] + } 1 1] 0] > 60000} { + ::tcltest::Skip "timing issue" + } # 60 msecs seems to be the max time slice under Windows 95/98 expr { ($end > $start) && (($end - $start) <= 60) ? @@ -35470,20 +35481,28 @@ test clock-33.7 {clock clicks, milli with too much abbreviation} { list [catch { clock clicks - } msg] $msg } {1 {ambiguous option "-": must be -milliseconds or -microseconds}} -test clock-33.8 {clock clicks test, microsecond timing test} knownWindowsTimingProblem { +test clock-33.8 {clock clicks test, microsecond timing test} { # This test can fail on a system that is so heavily loaded that # the test takes >60 ms to run. - set start [clock clicks -micro] - after 10 - set end [clock clicks -micro] + if {[lindex [timerate { + set start [clock clicks -micro] + timerate {} 10; # short but precise busy wait + set end [clock clicks -micro] + } 1 1] 0] > 60000} { + ::tcltest::Skip "timing issue" + } expr {($end > $start) && (($end - $start) <= 60000)} } {1} -test clock-33.8a {clock test, microsecond timing test} knownWindowsTimingProblem { +test clock-33.8a {clock test, microsecond timing test} { # This test can fail on a system that is so heavily loaded that # the test takes >60 ms to run. - set start [clock microseconds] - after 10 - set end [clock microseconds] + if {[lindex [timerate { + set start [clock microseconds] + timerate {} 10; # short but precise busy wait + set end [clock microseconds] + } 1 1] 0] > 60000} { + ::tcltest::Skip "timing issue" + } expr {($end > $start) && (($end - $start) <= 60000)} } {1} -- cgit v0.12 From f9490c56c66dcc35ca0686411ef0e11742bde5f1 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 9 Dec 2019 10:30:19 +0000 Subject: small amend (whitespace, no functional) --- library/tcltest/tcltest.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 68570d2..e0c925a 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -2020,7 +2020,7 @@ proc tcltest::test {name description args} { set errorInfo(body) $::errorInfo set errorCodeRes(body) $::errorCode if {$errorCodeRes(body) eq "BYPASS-SKIPPED-TEST"} { - _noticeSkipped $name $actualAnswer + _noticeSkipped $name $actualAnswer set processTest [set returnCode 0] } } -- cgit v0.12