diff options
| author | dgp <dgp@users.sourceforge.net> | 2023-09-15 16:59:29 (GMT) |
|---|---|---|
| committer | dgp <dgp@users.sourceforge.net> | 2023-09-15 16:59:29 (GMT) |
| commit | 04f3f00f1ac9cd9d59ceba4e1856c6dfd79fb756 (patch) | |
| tree | c061c23cb804c65d65a3f27d3ed8f128caa2e226 | |
| parent | df8dea33ceca2149662ce1be57695636a8147137 (diff) | |
| parent | 2766b53d261822dfce8fa4a8b6c158837436fcfb (diff) | |
| download | tcl-04f3f00f1ac9cd9d59ceba4e1856c6dfd79fb756.zip tcl-04f3f00f1ac9cd9d59ceba4e1856c6dfd79fb756.tar.gz tcl-04f3f00f1ac9cd9d59ceba4e1856c6dfd79fb756.tar.bz2 | |
merge 8.7
| -rw-r--r-- | tests/tcltests.tcl | 10 | ||||
| -rw-r--r-- | tests/winPipe.test | 1 | ||||
| -rw-r--r-- | tests/zipfs.test | 3 |
3 files changed, 10 insertions, 4 deletions
diff --git a/tests/tcltests.tcl b/tests/tcltests.tcl index 67c6bf9..409a2cc 100644 --- a/tests/tcltests.tcl +++ b/tests/tcltests.tcl @@ -69,6 +69,7 @@ namespace eval ::tcltests { # testnumargs "zipfs mount" "" "?mountpoint? ?zipfile? ?password?" # testnumargs "lappend" "varName" "?value ...?" proc testnumargs {cmd {fixed {}} {optional {}} args} { + variable count set minargs [llength $fixed] set maxargs [expr {$minargs + [llength $optional]}] if {[regexp {\.\.\.\??$} [lindex $optional end]]} { @@ -89,12 +90,14 @@ namespace eval ::tcltests { set label [join $cmd -] if {$minargs > 0} { set arguments [lrepeat [expr {$minargs-1}] x] - test $label-minargs-1 "$label no arguments" \ + test $label-minargs-[incr count($label-minargs)] \ + "$label no arguments" \ -body "$cmd" \ -result $message -returnCodes error \ {*}$args if {$minargs > 1} { - test $label-minargs-1 "$label missing arguments" \ + test $label-minargs-[incr count($label-minargs)] \ + "$label missing arguments" \ -body "$cmd $arguments" \ -result $message -returnCodes error \ {*}$args @@ -102,7 +105,8 @@ namespace eval ::tcltests { } if {[info exists maxargs]} { set arguments [lrepeat [expr {$maxargs+1}] x] - test $label-maxargs-1 "$label extra arguments" \ + test $label-maxargs-[incr count($label-maxargs)] \ + "$label extra arguments" \ -body "$cmd $arguments" \ -result $message -returnCodes error \ {*}$args diff --git a/tests/winPipe.test b/tests/winPipe.test index 28d4f5b..2827595 100644 --- a/tests/winPipe.test +++ b/tests/winPipe.test @@ -616,6 +616,7 @@ removeFile nothing if {[info exists path(echoArgs.tcl)]} { removeFile echoArgs.tcl } if {[info exists path(echoArgs.bat)]} { removeFile echoArgs.bat } if {[info exists path(echoArgs2.bat)]} { removeDirectory test(Dir)Check } +unset -nocomplain path ::tcltest::cleanupTests # back to original directory: cd $org_pwd; unset org_pwd diff --git a/tests/zipfs.test b/tests/zipfs.test index 689fd5f..4f980f7 100644 --- a/tests/zipfs.test +++ b/tests/zipfs.test @@ -791,6 +791,7 @@ namespace eval test_ns_zipfs { test.zip testmountA test.zip testmountB/subdir } {} + variable path testzipfsfind absolute-path [file join [zipfs root] testmountA] { test.zip testmountA test.zip testmountB/subdir } [lmap path { @@ -914,7 +915,7 @@ namespace eval test_ns_zipfs { testzipfscanonical drivepath X:/foo/bar [file join [zipfs root] foo bar] -constraints win # (backslashes need additional escaping passed to testzipfscanonical) testzipfscanonical backslashes X:\\\\foo\\\\bar [file join [zipfs root] foo bar] -constraints win - testzipfscanonical backslashes X:/foo\\\\bar [file join [zipfs root] foo bar] -constraints win + testzipfscanonical backslashes-1 X:/foo\\\\bar [file join [zipfs root] foo bar] -constraints win |