summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compat/strtol.c2
-rw-r--r--compat/strtoul.c2
-rw-r--r--generic/tclEncoding.c13
-rw-r--r--library/tcltest/tcltest.tcl119
-rw-r--r--tests/clock.test91
-rw-r--r--tests/encoding.test76
-rw-r--r--tests/info.test132
7 files changed, 252 insertions, 183 deletions
diff --git a/compat/strtol.c b/compat/strtol.c
index 22cc1eb..a9866f4 100644
--- a/compat/strtol.c
+++ b/compat/strtol.c
@@ -53,7 +53,7 @@ strtol(
*/
p = string;
- while (TclIsSpaceProc(*p)) {
+ while (isspace(UCHAR(*p))) {
p += 1;
}
diff --git a/compat/strtoul.c b/compat/strtoul.c
index bf16f7a..af63036 100644
--- a/compat/strtoul.c
+++ b/compat/strtoul.c
@@ -74,7 +74,7 @@ strtoul(
*/
p = string;
- while (TclIsSpaceProc(*p)) {
+ while (isspace(UCHAR(*p))) {
p += 1;
}
if (*p == '-') {
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 1bed847..0f5337e 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -2414,18 +2414,19 @@ UtfToUtfProc(
dst += Tcl_UniCharToUtf(*chPtr, dst);
} else {
src += TclUtfToUniChar(src, chPtr);
- if ((*chPtr | 0x3FF) == 0xDBFF) {
- /* A high surrogate character is detected, handle especially */
+ if ((*chPtr | 0x7FF) == 0xDFFF) {
+ /* A surrogate character is detected, handle especially */
Tcl_UniChar low = *chPtr;
- if (src <= srcEnd-3) {
- Tcl_UtfToUniChar(src, &low);
- }
- if ((low | 0x3FF) != 0xDFFF) {
+ size_t len = (src <= srcEnd-3) ? Tcl_UtfToUniChar(src, &low) : 0;
+ if (((low | 0x3FF) != 0xDFFF) || (*chPtr & 0x400)) {
*dst++ = (char) (((*chPtr >> 12) | 0xE0) & 0xEF);
*dst++ = (char) (((*chPtr >> 6) | 0x80) & 0xBF);
*dst++ = (char) ((*chPtr | 0x80) & 0xBF);
continue;
}
+ src += len;
+ dst += Tcl_UniCharToUtf(*chPtr, dst);
+ *chPtr = low;
}
dst += Tcl_UniCharToUtf(*chPtr, dst);
}
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index 28c50ef..c51467b 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -1982,18 +1982,24 @@ proc tcltest::test {name description args} {
}
}
- # First, run the setup script
- set code [catch {
- uplevel 1 [list [namespace which SetupTest] $setup]
- } setupMsg]
+ # First, run the setup script (or a hook if it presents):
+ if {[set cmd [namespace which -command [namespace current]::SetupTest]] ne ""} {
+ set setup [list $cmd $setup]
+ }
+ 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]} {
@@ -2016,16 +2022,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
}
@@ -2034,7 +2044,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} {
@@ -2046,7 +2056,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} {
@@ -2058,7 +2068,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
@@ -2068,10 +2080,11 @@ proc tcltest::test {name description args} {
set scriptFailure 1
}
- # Always run the cleanup script
- set code [catch {
- uplevel 1 [list [namespace which CleanupTest] $cleanup]
- } cleanupMsg]
+ # Always run the cleanup script (or a hook if it presents):
+ if {[set cmd [namespace which -command [namespace current]::CleanupTest]] ne ""} {
+ set cleanup [list $cmd $cleanup]
+ }
+ set code [catch {uplevel 1 $cleanup} cleanupMsg]
if {$code == 1} {
set errorInfo(cleanup) $::errorInfo
set errorCodeRes(cleanup) $::errorCode
@@ -2121,6 +2134,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
@@ -2181,7 +2200,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 {
@@ -2248,6 +2267,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
@@ -2328,22 +2373,13 @@ 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
}
}
return 0
}
-
-
# RunTest --
#
# This is where the body of a test is evaluated. The combination of
@@ -2360,38 +2396,15 @@ proc tcltest::RunTest {name script} {
memory tag $name
}
- set code [catch {uplevel 1 [list [
- namespace origin EvalTest] $script]} actualAnswer copts]
+ # run the test script (or a hook if it presents):
+ if {[set cmd [namespace which -command [namespace current]::EvalTest]] ne ""} {
+ set script [list $cmd $script]
+ }
+ set code [catch {uplevel 1 $script} actualAnswer]
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 --
diff --git a/tests/clock.test b/tests/clock.test
index 8d73bf2..c6dba85 100644
--- a/tests/clock.test
+++ b/tests/clock.test
@@ -250,17 +250,6 @@ proc ::testClock::registry { cmd path key } {
return [dict get $reg $path $key]
}
-proc timeWithinDuration {duration start end} {
- regexp {([\d.]+)(s|ms|us)} $duration -> duration unit
- if {[llength $start] > 1} { set start [expr "([join $start +])/[llength $start]"] }
- if {[llength $end] > 1} { set end [expr "([join $end +])/[llength $end]"] }
- set delta [expr {$end - $start}]
- expr {
- ($delta > 0) && ($delta <= $duration) ?
- "ok" :
- "test should have taken 0-$duration $unit, actually took $delta"}
-}
-
# Test some of the basics of [clock format]
@@ -35451,22 +35440,36 @@ test clock-33.4a {clock milliseconds} {
concat {}
} {}
test clock-33.5 {clock clicks tests, millisecond timing test} {
- set start [set end {}]
- lassign [time {
- lappend start [clock clicks -milli]
- after 1 {lappend end [clock clicks -milli]}
- vwait end
- } 5] tm
- timeWithinDuration [expr {int($tm/1000 + 1)}]ms $start $end
+ # This test can fail on a system that is so heavily loaded that
+ # the test takes >60 ms to run.
+ 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} {
- set start [set end {}]
- lassign [time {
- lappend start [clock milliseconds]
- after 1 {lappend end [clock milliseconds]}
- vwait end
- } 5] tm
- timeWithinDuration [expr {int($tm/1000 + 1)}]ms $start $end
+ # This test can fail on a system that is so heavily loaded that
+ # the test takes >60 ms to run.
+ 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) ?
+ "ok" :
+ "test should have taken 0-60 ms, actually took [expr $end - $start]"}
} {ok}
test clock-33.6 {clock clicks, milli with too much abbreviation} {
list [catch { clock clicks ? } msg] $msg
@@ -35476,23 +35479,29 @@ test clock-33.7 {clock clicks, milli with too much abbreviation} {
} {1 {ambiguous option "-": must be -milliseconds or -microseconds}}
test clock-33.8 {clock clicks test, microsecond timing test} {
- set start [set end {}]
- lassign [time {
- lappend start [clock clicks -micro]
- after 1 {lappend end [clock clicks -micro]}
- vwait end
- } 5] tm
- timeWithinDuration [expr {int($tm + 10)}]us $start $end
-} {ok}
+ # This test can fail on a system that is so heavily loaded that
+ # the test takes >60 ms to run.
+ 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} {
- set start [set end {}]
- lassign [time {
- lappend start [clock microseconds]
- after 1 {lappend end [clock microseconds]}
- vwait end
- } 5] tm
- timeWithinDuration [expr {int($tm + 10)}]us $start $end
-} {ok}
+ # This test can fail on a system that is so heavily loaded that
+ # the test takes >60 ms to run.
+ 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}
test clock-33.9 {clock clicks test, millis align with seconds} {
set t1 [clock seconds]
diff --git a/tests/encoding.test b/tests/encoding.test
index a58303b..643d493 100644
--- a/tests/encoding.test
+++ b/tests/encoding.test
@@ -321,11 +321,11 @@ test encoding-15.3 {UtfToUtfProc null character input} teststringbytes {
binary scan [teststringbytes $y] H* z
set z
} c080
-test encoding-15.4 {UtfToUtfProc emoji character input} {
+test encoding-15.4 {UtfToUtfProc emoji character input} -body {
set x \xED\xA0\xBD\xED\xB8\x82
set y [encoding convertfrom utf-8 \xED\xA0\xBD\xED\xB8\x82]
list [string length $x] $y
-} "6 \U1F602"
+} -result "6 \U1F602"
test encoding-15.5 {UtfToUtfProc emoji character input} {
set x \xF0\x9F\x98\x82
set y [encoding convertfrom utf-8 \xF0\x9F\x98\x82]
@@ -355,7 +355,43 @@ test encoding-15.9 {UtfToUtfProc emoji character output} {
binary scan $y H* z
list [string length $x] [string length $y] $z
} {3 7 edb882eda0bd58}
-test encoding-15.10 {UtfToUtfProc emoji character output} {
+test encoding-15.10 {UtfToUtfProc high surrogate character output} {
+ set x \uDE02\xE9
+ set y [encoding convertto utf-8 \uDE02\xE9]
+ binary scan $y H* z
+ list [string length $x] [string length $y] $z
+} {2 5 edb882c3a9}
+test encoding-15.11 {UtfToUtfProc low surrogate character output} {
+ set x \uDA02\xE9
+ set y [encoding convertto utf-8 \uDA02\xE9]
+ binary scan $y H* z
+ list [string length $x] [string length $y] $z
+} {2 5 eda882c3a9}
+test encoding-15.12 {UtfToUtfProc high surrogate character output} {
+ set x \uDE02Y
+ set y [encoding convertto utf-8 \uDE02Y]
+ binary scan $y H* z
+ list [string length $x] [string length $y] $z
+} {2 4 edb88259}
+test encoding-15.13 {UtfToUtfProc low surrogate character output} {
+ set x \uDA02Y
+ set y [encoding convertto utf-8 \uDA02Y]
+ binary scan $y H* z
+ list [string length $x] [string length $y] $z
+} {2 4 eda88259}
+test encoding-15.14 {UtfToUtfProc high surrogate character output} {
+ set x \uDE02
+ set y [encoding convertto utf-8 \uDE02]
+ binary scan $y H* z
+ list [string length $x] [string length $y] $z
+} {1 3 edb882}
+test encoding-15.15 {UtfToUtfProc low surrogate character output} {
+ set x \uDA02
+ set y [encoding convertto utf-8 \uDA02]
+ binary scan $y H* z
+ list [string length $x] [string length $y] $z
+} {1 3 eda882}
+test encoding-15.16 {UtfToUtfProc emoji character output} {
set x \U1F602
set y [encoding convertto utf-8 \U1F602]
binary scan $y H* z
@@ -365,26 +401,36 @@ test encoding-15.10 {UtfToUtfProc emoji character output} {
test encoding-16.1 {Utf16ToUtfProc} -body {
set val [encoding convertfrom utf-16 NN]
list $val [format %x [scan $val %c]]
-} -result "\u4e4e 4e4e"
+} -result "\u4E4E 4e4e"
test encoding-16.2 {Utf16ToUtfProc} -body {
- set val [encoding convertfrom utf-16 "\xd8\xd8\xdc\xdc"]
+ set val [encoding convertfrom utf-16 "\xD8\xD8\xDC\xDC"]
+ list $val [format %x [scan $val %c]]
+} -result "\U460DC 460dc"
+test encoding-16.3 {Utf16ToUtfProc} -body {
+ set val [encoding convertfrom utf-16 "\xDC\xDC"]
list $val [format %x [scan $val %c]]
-} -result "\U460dc 460dc"
-test encoding-16.3 {Ucs2ToUtfProc} -body {
+} -result "\uDCDC dcdc"
+test encoding-16.4 {Ucs2ToUtfProc} -body {
set val [encoding convertfrom ucs-2 NN]
list $val [format %x [scan $val %c]]
-} -result "\u4e4e 4e4e"
+} -result "\u4E4E 4e4e"
test encoding-16.4 {Ucs2ToUtfProc} -body {
- set val [encoding convertfrom ucs-2 "\xd8\xd8\xdc\xdc"]
+ set val [encoding convertfrom ucs-2 "\xD8\xD8\xDC\xDC"]
list $val [format %x [scan $val %c]]
-} -result "\U460dc 460dc"
+} -result "\U460DC 460dc"
test encoding-17.1 {UtfToUtf16Proc} -body {
- encoding convertto utf-16 "\U460dc"
-} -result "\xd8\xd8\xdc\xdc"
-test encoding-17.2 {UtfToUcs2Proc} -body {
- encoding convertfrom utf-16 [encoding convertto ucs-2 "\U460dc"]
-} -result "\ufffd"
+ encoding convertto utf-16 "\U460DC"
+} -result "\xD8\xD8\xDC\xDC"
+test encoding-17.2 {UtfToUtf16Proc} -body {
+ encoding convertto utf-16 "\uDCDC"
+} -result "\xDC\xDC"
+test encoding-17.3 {UtfToUtf16Proc} -body {
+ encoding convertto utf-16 "\uD8D8"
+} -result "\xD8\xD8"
+test encoding-17.4 {UtfToUcs2Proc} -body {
+ encoding convertfrom utf-16 [encoding convertto ucs-2 "\U460DC"]
+} -result "\uFFFD"
test encoding-18.1 {TableToUtfProc} {
} {}
diff --git a/tests/info.test b/tests/info.test
index 1f3584c..ce51523 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -735,28 +735,28 @@ proc etrace {} {
test info-22.0 {info frame, levels} {!singleTestInterp} {
info frame
-} 9
+} 7
test info-22.1 {info frame, bad level relative} {!singleTestInterp} {
# catch is another level!, i.e. we have 8, not 7
- catch {info frame -10} msg
+ catch {info frame -8} msg
set msg
-} {bad level "-10"}
+} {bad level "-8"}
test info-22.2 {info frame, bad level absolute} {!singleTestInterp} {
# catch is another level!, i.e. we have 8, not 7
- catch {info frame 11} msg
+ catch {info frame 9} msg
set msg
-} {bad level "11"}
+} {bad level "9"}
test info-22.3 {info frame, current, relative} -match glob -body {
info frame 0
-} -result {type source line 750 file */info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+} -result {type source line 750 file */info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-22.4 {info frame, current, relative, nested} -match glob -body {
set res [info frame 0]
-} -result {type source line 753 file */info.test cmd {info frame 0} proc ::tcltest::EvalTest} -cleanup {unset res}
+} -result {type source line 753 file */info.test cmd {info frame 0} proc ::tcltest::RunTest} -cleanup {unset res}
test info-22.5 {info frame, current, absolute} -constraints {!singleTestInterp} -match glob -body {
- reduce [info frame 9]
-} -result {type source line 756 file info.test cmd {info frame 9} proc ::tcltest::EvalTest}
+ reduce [info frame 7]
+} -result {type source line 756 file info.test cmd {info frame 7} proc ::tcltest::RunTest}
test info-22.6 {info frame, global, relative} {!singleTestInterp} {
- reduce [info frame -8]
+ reduce [info frame -6]
} {type source line 758 file info.test cmd test\ info-22.6\ \{info\ frame,\ global,\ relative\}\ \{!singleTestInter level 0}
test info-22.7 {info frame, global, absolute} {!singleTestInterp} {
reduce [info frame 1]
@@ -764,8 +764,8 @@ test info-22.7 {info frame, global, absolute} {!singleTestInterp} {
test info-22.8 {info frame, basic trace} -match glob -body {
join [lrange [etrace] 0 2] \n
} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0}
-* {type source line 765 file info.test cmd etrace proc ::tcltest::EvalTest}
-* {type source line * file tcltest* cmd {uplevel 1 $script} proc ::tcltest::EvalTest}}
+* {type source line 765 file info.test cmd etrace proc ::tcltest::RunTest}
+* {type source line * file tcltest* cmd {uplevel 1 $script} proc ::tcltest::RunTest}}
unset -nocomplain msg
@@ -792,20 +792,20 @@ test info-23.3 {eval'd info frame, literal} -match glob -body {
eval {
info frame 0
}
-} -result {type source line 793 file * cmd {info frame 0} proc ::tcltest::EvalTest}
+} -result {type source line 793 file * cmd {info frame 0} proc ::tcltest::RunTest}
test info-23.4 {eval'd info frame, semi-dynamic} {
eval info frame 0
-} {type eval line 1 cmd {info frame 0} proc ::tcltest::EvalTest}
+} {type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest}
test info-23.5 {eval'd info frame, dynamic} -cleanup {unset script} -body {
set script {info frame 0}
eval $script
-} -result {type eval line 1 cmd {info frame 0} proc ::tcltest::EvalTest}
+} -result {type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest}
test info-23.6 {eval'd info frame, trace} -match glob -cleanup {unset script} -body {
set script {etrace}
join [lrange [eval $script] 0 2] \n
} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0}
-* {type eval line 1 cmd etrace proc ::tcltest::EvalTest}
-* {type source line 805 file info.test cmd {eval $script} proc ::tcltest::EvalTest}}
+* {type eval line 1 cmd etrace proc ::tcltest::RunTest}
+* {type source line 805 file info.test cmd {eval $script} proc ::tcltest::RunTest}}
# -------------------------------------------------------------------------
@@ -1024,7 +1024,7 @@ test info-30.0 {bs+nl in literal words} -cleanup {unset res} -body {
# offsets of all bs+nl sequences in literal words, then using the
# information in the bcc and other places to bump line numbers when
# parsing over the location. Also affected: testcases 22.8 and 23.6.
-} -result {type source line 1018 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+} -result {type source line 1018 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
# -------------------------------------------------------------------------
# See 24.0 - 24.5 for similar situations, using literal scripts.
@@ -1042,36 +1042,36 @@ test info-31.0 {ns eval, script in variable} -body {namespace eval foo {variable
test info-31.1 {if, script in variable} -cleanup {unset res a flag} -body {
if 1 $body
return $res
-} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::EvalTest}
+} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
test info-31.1a {if, script in variable} -cleanup {unset res a flag} -body {
if 1 then $body
return $res
-} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::EvalTest}
+} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
test info-31.2 {while, script in variable} -cleanup {unset flag res a} -body {
set flag 1
while {$flag} $body
return $res
-} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::EvalTest}
+} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
# .3 - proc - scoping prevent return of result ...
test info-31.4 {foreach, script in variable} -cleanup {unset var res a flag} -body {
foreach var val $body
set res
-} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::EvalTest}
+} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
test info-31.5 {for, script in variable} -cleanup {unset flag res a} -body {
set flag 1
for {} {$flag} {} $body
return $res
-} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::EvalTest}
+} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
test info-31.6 {eval, script in variable} -cleanup {unset res a flag} -body {
eval $body
return $res
-} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::EvalTest}
+} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
# -------------------------------------------------------------------------
@@ -1319,8 +1319,8 @@ test info-37.0 {eval pure list, single line} -match glob -body {
eval $cmd
return $res
} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0}
-* {type eval line 2 cmd etrace proc ::tcltest::EvalTest}
-* {type eval line 1 cmd foreac proc ::tcltest::EvalTest}} -cleanup {unset foo cmd res b c}
+* {type eval line 2 cmd etrace proc ::tcltest::RunTest}
+* {type eval line 1 cmd foreac proc ::tcltest::RunTest}} -cleanup {unset foo cmd res b c}
# -------------------------------------------------------------------------
@@ -1360,8 +1360,8 @@ test info-38.1 {location information for uplevel, dv, direct-var} -match glob -b
}
join [lrange [uplevel \#0 $script] 0 2] \n
} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0}
-* {type eval line 3 cmd etrace proc ::tcltest::EvalTest}
-* {type source line 1361 file info.test cmd {uplevel \\#0 $script} proc ::tcltest::EvalTest}} -cleanup {unset script y}
+* {type eval line 3 cmd etrace proc ::tcltest::RunTest}
+* {type source line 1361 file info.test cmd {uplevel \\#0 $script} proc ::tcltest::RunTest}} -cleanup {unset script y}
# 38.2 moved to bottom to not disturb other tests with the necessary changes to this one.
@@ -1381,7 +1381,7 @@ test info-38.3 {location information for uplevel, dpv, direct-proc-var} -match g
} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type eval line 3 cmd etrace proc ::control}
* {type source line 1338 file info.test cmd {uplevel 1 $script} proc ::control}
-* {type source line 1380 file info.test cmd {control y $script} proc ::tcltest::EvalTest}} -cleanup {unset script y}
+* {type source line 1380 file info.test cmd {control y $script} proc ::tcltest::RunTest}} -cleanup {unset script y}
# 38.4 moved to bottom to not disturb other tests with the necessary changes to this one.
@@ -1399,7 +1399,7 @@ test info-38.5 {location information for uplevel, ppv, proc-proc-var} -match glo
* {type eval line 3 cmd etrace proc ::control}
* {type source line 1338 file info.test cmd {uplevel 1 $script} proc ::control}
* {type source line 1353 file info.test cmd {control y $script} proc ::datav level 1}
-* {type source line 1397 file info.test cmd datav proc ::tcltest::EvalTest}}
+* {type source line 1397 file info.test cmd datav proc ::tcltest::RunTest}}
# 38.6 moved to bottom to not disturb other tests with the necessary changes to this one.
@@ -1413,9 +1413,9 @@ testConstraint testevalex [llength [info commands testevalex]]
test info-38.7 {location information for arg substitution} -constraints testevalex -match glob -body {
join [lrange [testevalex {return -level 0 [etrace]}] 0 3] \n
} -result {* {type source line 730 file info.test cmd {info frame \$level} proc ::etrace level 0}
-* {type eval line 1 cmd etrace proc ::tcltest::EvalTest}
-* {type source line 1414 file info.test cmd {testevalex {return -level 0 \[etrace]}} proc ::tcltest::EvalTest}
-* {type source line * file tcltest* cmd {uplevel 1 $script} proc ::tcltest::EvalTest}}
+* {type eval line 1 cmd etrace proc ::tcltest::RunTest}
+* {type source line 1414 file info.test cmd {testevalex {return -level 0 \[etrace]}} proc ::tcltest::RunTest}
+* {type source line * file tcltest* cmd {uplevel 1 $script} proc ::tcltest::RunTest}}
# -------------------------------------------------------------------------
# literal sharing
@@ -1463,7 +1463,7 @@ test info-30.3 {bs+nl in literal words, namespace multi-word script} {
namespace eval xxx variable res \
[list [reduce [info frame 0]]];# line 1464
return $xxx::res
-} {type source line 1464 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+} {type source line 1464 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.4 {bs+nl in literal words, eval script} -cleanup {unset res} -body {
eval {
@@ -1471,7 +1471,7 @@ test info-30.4 {bs+nl in literal words, eval script} -cleanup {unset res} -body
[reduce [info frame 0]];# line 1471
}
return $res
-} -result {type source line 1471 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+} -result {type source line 1471 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.5 {bs+nl in literal words, eval script, with nested words} -body {
eval {
@@ -1482,12 +1482,12 @@ test info-30.5 {bs+nl in literal words, eval script, with nested words} -body {
}
}
return $res
-} -cleanup {unset res} -result {type source line 1481 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+} -cleanup {unset res} -result {type source line 1481 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.6 {bs+nl in computed word} -cleanup {unset res} -body {
set res "\
[reduce [info frame 0]]";# line 1489
-} -result { type source line 1489 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+} -result { type source line 1489 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.7 {bs+nl in computed word, in proc} -body {
proc abra {} {
@@ -1505,7 +1505,7 @@ test info-30.8 {bs+nl in computed word, nested eval} -body {
res "\
[reduce [info frame 0]]";# line 1506
}
-} -cleanup {unset res} -result { type source line 1506 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+} -cleanup {unset res} -result { type source line 1506 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.9 {bs+nl in computed word, nested eval} -body {
eval {
@@ -1514,7 +1514,7 @@ test info-30.9 {bs+nl in computed word, nested eval} -body {
[reduce \
[info frame 0]]";# line 1515
}
-} -cleanup {unset res} -result { type source line 1515 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+} -cleanup {unset res} -result { type source line 1515 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.10 {bs+nl in computed word, key to array} -body {
set tmp([set \
@@ -1523,14 +1523,14 @@ test info-30.10 {bs+nl in computed word, key to array} -body {
[info frame 0]]"]) x ; #1523
unset tmp
set res
-} -cleanup {unset res} -result { type source line 1523 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+} -cleanup {unset res} -result { type source line 1523 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.11 {bs+nl in subst arguments} -body {
subst {[set \
res "\
[reduce \
[info frame 0]]"]} ; #1532
-} -cleanup {unset res} -result { type source line 1532 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+} -cleanup {unset res} -result { type source line 1532 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.12 {bs+nl in computed word, nested eval} -body {
eval {
@@ -1540,7 +1540,7 @@ test info-30.12 {bs+nl in computed word, nested eval} -body {
[reduce \
[info frame 0]]";# line 1541
}
-} -cleanup {unset res x} -result { type source line 1541 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+} -cleanup {unset res x} -result { type source line 1541 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.13 {bs+nl in literal words, uplevel script, with nested words} -body {
subinterp ; set res [interp eval sub { uplevel #0 {
@@ -1601,7 +1601,7 @@ test info-30.17 {bs+nl in multi-body switch, direct} {
^key { reduce [info frame 0] ;# 1601 } \
\t### { } \
{[0-9]*} { }
-} {type source line 1601 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+} {type source line 1601 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.18 {bs+nl, literal word, uplevel through proc, appended, loss of primary tracking data} {
proc abra {script} {
@@ -1644,7 +1644,7 @@ test info-30.20 {bs+nl in single-body switch, direct} {
\t### { }
{[0-9]*} { }
}
-} {type source line 1643 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+} {type source line 1643 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.21 {bs+nl in if, full compiled} {
proc a {value} {
@@ -1710,71 +1710,71 @@ type source line 1700 file info.test cmd {info frame 0} proc ::a level 0}
test info-30.25 {TIP 280 for compiled [subst]} {
subst {[reduce [info frame 0]]} ; # 1712
-} {type source line 1712 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+} {type source line 1712 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.26 {TIP 280 for compiled [subst]} {
subst \
{[reduce [info frame 0]]} ; # 1716
-} {type source line 1716 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+} {type source line 1716 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.27 {TIP 280 for compiled [subst]} {
subst {
[reduce [info frame 0]]} ; # 1720
} {
-type source line 1720 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+type source line 1720 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.28 {TIP 280 for compiled [subst]} {
subst {\
[reduce [info frame 0]]} ; # 1725
-} { type source line 1725 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+} { type source line 1725 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.29 {TIP 280 for compiled [subst]} {
subst {foo\
[reduce [info frame 0]]} ; # 1729
-} {foo type source line 1729 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+} {foo type source line 1729 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.30 {TIP 280 for compiled [subst]} {
subst {foo
[reduce [info frame 0]]} ; # 1733
} {foo
-type source line 1733 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+type source line 1733 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.31 {TIP 280 for compiled [subst]} {
subst {[][reduce [info frame 0]]} ; # 1737
-} {type source line 1737 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+} {type source line 1737 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.32 {TIP 280 for compiled [subst]} {
subst {[\
][reduce [info frame 0]]} ; # 1741
-} {type source line 1741 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+} {type source line 1741 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.33 {TIP 280 for compiled [subst]} {
subst {[
][reduce [info frame 0]]} ; # 1745
-} {type source line 1745 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+} {type source line 1745 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.34 {TIP 280 for compiled [subst]} {
subst {[format %s {}
][reduce [info frame 0]]} ; # 1749
-} {type source line 1749 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+} {type source line 1749 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.35 {TIP 280 for compiled [subst]} {
subst {[format %s {}
]
[reduce [info frame 0]]} ; # 1754
} {
-type source line 1754 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+type source line 1754 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.36 {TIP 280 for compiled [subst]} {
subst {
[format %s {}][reduce [info frame 0]]} ; # 1759
} {
-type source line 1759 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+type source line 1759 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.37 {TIP 280 for compiled [subst]} {
subst {
[format %s {}]
[reduce [info frame 0]]} ; # 1765
} {
-type source line 1765 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+type source line 1765 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.38 {TIP 280 for compiled [subst]} {
subst {\
[format %s {}][reduce [info frame 0]]} ; # 1771
-} { type source line 1771 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+} { type source line 1771 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.39 {TIP 280 for compiled [subst]} {
subst {\
[format %s {}]\
[reduce [info frame 0]]} ; # 1776
-} { type source line 1776 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+} { type source line 1776 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.40 {TIP 280 for compiled [subst]} -setup {
unset -nocomplain empty
} -body {
@@ -1782,7 +1782,7 @@ test info-30.40 {TIP 280 for compiled [subst]} -setup {
subst {$empty[reduce [info frame 0]]} ; # 1782
} -cleanup {
unset empty
-} -result {type source line 1782 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+} -result {type source line 1782 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.41 {TIP 280 for compiled [subst]} -setup {
unset -nocomplain empty
} -body {
@@ -1792,7 +1792,7 @@ test info-30.41 {TIP 280 for compiled [subst]} -setup {
} -cleanup {
unset empty
} -result {
-type source line 1791 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+type source line 1791 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.42 {TIP 280 for compiled [subst]} -setup {
unset -nocomplain empty
} -body {
@@ -1800,25 +1800,25 @@ test info-30.42 {TIP 280 for compiled [subst]} -setup {
[reduce [info frame 0]]} ; # 1800
} -cleanup {
unset empty
-} -result { type source line 1800 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+} -result { type source line 1800 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.43 {TIP 280 for compiled [subst]} -body {
unset -nocomplain a\nb
set a\nb {}
subst {${a
b}[reduce [info frame 0]]} ; # 1808
-} -cleanup {unset a\nb} -result {type source line 1808 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+} -cleanup {unset a\nb} -result {type source line 1808 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.44 {TIP 280 for compiled [subst]} {
unset -nocomplain a
set a(\n) {}
subst {$a(
)[reduce [info frame 0]]} ; # 1814
-} {type source line 1814 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+} {type source line 1814 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.45 {TIP 280 for compiled [subst]} {
unset -nocomplain a
set a() {}
subst {$a([
return -level 0])[reduce [info frame 0]]} ; # 1820
-} {type source line 1820 file info.test cmd {info frame 0} proc ::tcltest::EvalTest}
+} {type source line 1820 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.46 {TIP 280 for compiled [subst]} {
unset -nocomplain a
set a(1825) YES; set a(1824) 1824; set a(1826) 1826
@@ -1835,7 +1835,7 @@ unset -nocomplain a
test info-30.48 {Bug 2850901} testevalex {
testevalex {return -level 0 [format %s {}
][reduce [info frame 0]]} ; # line 2 of the eval
-} {type eval line 2 cmd {info frame 0} proc ::tcltest::EvalTest}
+} {type eval line 2 cmd {info frame 0} proc ::tcltest::RunTest}
# -------------------------------------------------------------------------
generated by cgit v0.12 at 2025-11-21 20:20:56 (GMT)