merge 8.5

3 files changed, 198 insertions, 12 deletions

diff --git a/tests/platform.test b/tests/platform.test
index 9d88f98..4f1eb82 100644
--- a/tests/platform.test
+++ b/tests/platform.test
@@ -14,7 +14,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
     namespace import -force ::tcltest::*
 }
 
-testConstraint testWinCPUID [llength [info commands testwincpuid]]
+testConstraint testCPUID [llength [info commands testcpuid]]
 
 test platform-1.1 {TclpSetVariables: tcl_platform} {
     interp create i
@@ -36,12 +36,12 @@ test platform-2.1 {tcl_platform(wordSize) indicates size of native word} {
     list [expr {$result < 0}] [expr {$result ^ int($result - 1)}]
 } {1 -1}
 
-# On Windows, test that the CPU ID works
+# On Windows/UNIX, test that the CPU ID works
 
-test platform-3.1 {CPU ID on Windows } \
-    -constraints testWinCPUID \
+test platform-3.1 {CPU ID on Windows/UNIX} \
+    -constraints testCPUID \
     -body {		
-	set cpudata [testwincpuid 0]
+	set cpudata [testcpuid 0]
 	binary format iii \
 	    [lindex $cpudata 1] \
 	    [lindex $cpudata 3] \
diff --git a/tests/safe.test b/tests/safe.test
index fbcb2a1..7b83cc6 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -30,7 +30,7 @@ set ::auto_path [info library]
 catch {safe::interpConfigure}
 
 proc equiv {x} {return $x}
-
+
 test safe-1.1 {safe::interpConfigure syntax} {
     list [catch {safe::interpConfigure} msg] $msg;
 } {1 {no value given for parameter "slave" (use -help for full usage) :
@@ -515,6 +515,182 @@ test safe-12.6 {glob is restricted [Bug 2906841]} -setup {
     safe::interpDelete $i
 } -result {}
 
+proc mkfile {filename} {
+    close [open $filename w]
+}
+#### New tests for Safe base glob, with patches @ Bug 2964715
+test safe-13.1 {glob is restricted [Bug 2964715]} -setup {
+    set i [safe::interpCreate]
+} -body {
+    $i eval glob *
+} -returnCodes error -cleanup {
+    safe::interpDelete $i
+} -result {permission denied}
+test safe-13.2 {mimic the valid glob call by ::tcl::tm::UnknownHandler [Bug 2964715]} -setup {
+    set i [safe::interpCreate]
+    set testdir  [file join [temporaryDirectory] deletethisdir]
+    set testdir2 [file join $testdir deletemetoo]
+    set testfile [file join $testdir2 deleteme.tm]
+    file mkdir $testdir2
+    mkfile $testfile
+} -body {
+    ::safe::interpAddToAccessPath $i $testdir2
+    set result [$i eval glob -nocomplain -directory $testdir2 *.tm]
+    if {$result eq [list $testfile]} {
+        return "glob match"
+    } else {
+        return "no match: $result"
+    }
+} -cleanup {
+    safe::interpDelete $i
+    file delete -force $testdir
+} -result {glob match}
+test safe-13.3 {cf 13.2 but test glob failure when -directory is outside access path [Bug 2964715]} -setup {
+    set i [safe::interpCreate]
+    set testdir  [file join [temporaryDirectory] deletethisdir]
+    set testdir2 [file join $testdir deletemetoo]
+    set testfile [file join $testdir2 deleteme.tm]
+    file mkdir $testdir2
+    mkfile $testfile
+} -body {
+    $i eval glob -directory $testdir2 *.tm
+} -returnCodes error -cleanup {
+    safe::interpDelete $i
+    file delete -force $testdir
+} -result {permission denied}
+test safe-13.4 {another valid glob call [Bug 2964715]} -setup {
+    set i [safe::interpCreate]
+    set testdir  [file join [temporaryDirectory] deletethisdir]
+    set testdir2 [file join $testdir deletemetoo]
+    set testfile [file join $testdir2 deleteme.tm]
+    file mkdir $testdir2
+    mkfile $testfile
+} -body {
+    ::safe::interpAddToAccessPath $i $testdir
+    ::safe::interpAddToAccessPath $i $testdir2
+    set result [$i eval \
+	    glob -nocomplain -directory $testdir [file join deletemetoo *.tm]]
+    if {$result eq [list $testfile]} {
+        return "glob match"
+    } else {
+        return "no match: $result"
+    }
+} -cleanup {
+    safe::interpDelete $i
+    file delete -force $testdir
+} -result {glob match}
+test safe-13.5 {as 13.4 but test glob failure when -directory is outside access path [Bug 2964715]} -setup {
+    set i [safe::interpCreate]
+    set testdir  [file join [temporaryDirectory] deletethisdir]
+    set testdir2 [file join $testdir deletemetoo]
+    set testfile [file join $testdir2 deleteme.tm]
+    file mkdir $testdir2
+    mkfile $testfile
+} -body {
+    ::safe::interpAddToAccessPath $i $testdir2
+    $i eval \
+	glob -directory $testdir [file join deletemetoo *.tm]
+} -returnCodes error -cleanup {
+    safe::interpDelete $i
+    file delete -force $testdir
+} -result {permission denied}
+test safe-13.6 {as 13.4 but test silent failure when result is outside access_path [Bug 2964715]} -setup {
+    set i [safe::interpCreate]
+    set testdir  [file join [temporaryDirectory] deletethisdir]
+    set testdir2 [file join $testdir deletemetoo]
+    set testfile [file join $testdir2 deleteme.tm]
+    file mkdir $testdir2
+    mkfile $testfile
+} -body {
+    ::safe::interpAddToAccessPath $i $testdir
+    $i eval \
+	glob -nocomplain -directory $testdir [file join deletemetoo *.tm]
+} -cleanup {
+    safe::interpDelete $i
+    file delete -force $testdir
+} -result {}
+test safe-13.7 {mimic the glob call by tclPkgUnknown which gives a deliberate error in a safe interpreter [Bug 2964715]} -setup {
+    set i [safe::interpCreate]
+    set testdir  [file join [temporaryDirectory] deletethisdir]
+    set testdir2 [file join $testdir deletemetoo]
+    set testfile [file join $testdir2 pkgIndex.tcl]
+    file mkdir $testdir2
+    mkfile $testfile
+} -body {
+    set safeTD [::safe::interpAddToAccessPath $i $testdir]
+    ::safe::interpAddToAccessPath $i $testdir2
+    string map [list $safeTD EXPECTED] [$i eval [list \
+	glob -directory $safeTD -join * pkgIndex.tcl]]
+} -cleanup {
+    safe::interpDelete $i
+    file delete -force $testdir
+} -result {{EXPECTED/deletemetoo/pkgIndex.tcl}}
+# Note the extra {} around the result above; that's *expected* because of the
+# format of virtual path roots.
+test safe-13.8 {mimic the glob call by tclPkgUnknown without the deliberate error that is specific to pkgIndex.tcl [Bug 2964715]} -setup {
+    set i [safe::interpCreate]
+    set testdir  [file join [temporaryDirectory] deletethisdir]
+    set testdir2 [file join $testdir deletemetoo]
+    set testfile [file join $testdir2 notIndex.tcl]
+    file mkdir $testdir2
+    mkfile $testfile
+} -body {
+    set safeTD [::safe::interpAddToAccessPath $i $testdir]
+    ::safe::interpAddToAccessPath $i $testdir2
+    $i eval [list glob -directory $safeTD -join -nocomplain * notIndex.tcl]
+} -cleanup {
+    safe::interpDelete $i
+    file delete -force $testdir
+} -result {}
+test safe-13.9 {as 13.8 but test glob failure when -directory is outside access path [Bug 2964715]} -setup {
+    set i [safe::interpCreate]
+    set testdir  [file join [temporaryDirectory] deletethisdir]
+    set testdir2 [file join $testdir deletemetoo]
+    set testfile [file join $testdir2 notIndex.tcl]
+    file mkdir $testdir2
+    mkfile $testfile
+} -body {
+    ::safe::interpAddToAccessPath $i $testdir2
+    set result [$i eval \
+	    glob -directory $testdir -join -nocomplain * notIndex.tcl]
+    if {$result eq [list $testfile]} {
+        return {glob match}
+    } else {
+        return "no match: $result"
+    }
+} -cleanup {
+    safe::interpDelete $i
+    file delete -force $testdir
+} -result {no match: }
+test safe-13.10 {as 13.8 but test silent failure when result is outside access_path [Bug 2964715]} -setup {
+    set i [safe::interpCreate]
+    set testdir  [file join [temporaryDirectory] deletethisdir]
+    set testdir2 [file join $testdir deletemetoo]
+    set testfile [file join $testdir2 notIndex.tcl]
+    file mkdir $testdir2
+    mkfile $testfile
+} -body {
+    ::safe::interpAddToAccessPath $i $testdir
+    $i eval glob -directory $testdir -join -nocomplain * notIndex.tcl
+} -cleanup {
+    safe::interpDelete $i
+    file delete -force $testdir
+} -result {}
+rename mkfile {}
+
+#### Test for the module path
+test safe-14.1 {Check that module path is the same as in the master interpreter [Bug 2964715]} -setup {
+    set i [safe::interpCreate]
+} -body {
+    set tm {}
+    foreach token [$i eval ::tcl::tm::path list] {
+        lappend tm [dict get [set ::safe::S${i}(access_path,map)] $token]
+    }
+    return $tm
+} -cleanup {
+    safe::interpDelete $i
+} -result [::tcl::tm::path list]
+
 set ::auto_path $saveAutoPath
 # cleanup
 ::tcltest::cleanupTests
diff --git a/tests/switch.test b/tests/switch.test
index 5ee7216..f04f636 100644
--- a/tests/switch.test
+++ b/tests/switch.test
@@ -536,7 +536,7 @@ test switch-11.6 {-matchvar unwritable} {
 
 test switch-12.1 {regexp matching with -indexvar} {
     switch -regexp -indexvar x -- abc {.(.). {set x}}
-} {{0 3} {1 2}}
+} {{0 2} {1 1}}
 test switch-12.2 {regexp matching with -indexvar} {
     set x GOOD
     switch -regexp -indexvar x -- abc {.(.).. {list $x z}}
@@ -544,7 +544,7 @@ test switch-12.2 {regexp matching with -indexvar} {
 } GOOD
 test switch-12.3 {regexp matching with -indexvar} {
     switch -regexp -indexvar x -- "a b c" {.(.). {set x}}
-} {{0 3} {1 2}}
+} {{0 2} {1 1}}
 test switch-12.4 {regexp matching with -indexvar} {
     set x BAD
     switch -regexp -indexvar x -- "a b c" {
@@ -560,22 +560,32 @@ test switch-12.6 {-indexvar unwritable} {
     set x {}
     list [catch {switch -regexp -indexvar x(x) -- abc . {set x}} msg] $x $msg
 } {1 {} {can't set "x(x)": variable isn't array}}
+test switch-12.7 {[Bug 3106532] -indexvar should be directly usable with [string range]} {
+    set str abcdef
+    switch -regexp -indexvar x -- $str ^... {string range $str {*}[lindex $x 0]}
+} abc
+test switch-12.8 {-indexvar and matched empty strings} {
+    switch -regexp -indexvar x -- abcdef ^...(x?) {return $x}
+} {{0 2} {3 2}}
+test switch-12.9 {-indexvar and unmatched strings} {
+    switch -regexp -indexvar x -- abcdef ^...(x)? {return $x}
+} {{0 2} {-1 -1}}
 
 test switch-13.1 {-indexvar -matchvar combinations} {
     switch -regexp -indexvar x -matchvar y abc {
 	. {list $x $y}
     }
-} {{{0 1}} a}
+} {{{0 0}} a}
 test switch-13.2 {-indexvar -matchvar combinations} {
     switch -regexp -indexvar x -matchvar y abc {
 	.$ {list $x $y}
     }
-} {{{2 3}} c}
+} {{{2 2}} c}
 test switch-13.3 {-indexvar -matchvar combinations} {
     switch -regexp -indexvar x -matchvar y abc {
 	(.)(.)(.) {list $x $y}
     }
-} {{{0 3} {0 1} {1 2} {2 3}} {abc a b c}}
+} {{{0 2} {0 0} {1 1} {2 2}} {abc a b c}}
 test switch-13.4 {-indexvar -matchvar combinations} {
     set x -
     set y -
@@ -597,7 +607,7 @@ test switch-13.6 {-indexvar -matchvar combinations} {
     list [catch {
 	switch -regexp -indexvar x -matchvar y(y) abc {. {list $x $y}}
     } msg] $x $y $msg
-} {1 {{0 1}} - {can't set "y(y)": variable isn't array}}
+} {1 {{0 0}} - {can't set "y(y)": variable isn't array}}
 
 test switch-14.1 {-regexp -- compilation [Bug 1854399]} {
     switch -regexp -- 0 {