From 8952ee7ee1dc5bbc401ee01f356e3b8ff4a170a3 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 2 Sep 2020 08:39:16 +0000 Subject: Fix safe.test when running in a Tcl 8.7 environment (backported from Tk 8.7) --- tests/safe.test | 34 +++++++++++++++++++++++----------- 1 file changed, 23 insertions(+), 11 deletions(-) diff --git a/tests/safe.test b/tests/safe.test index 64cd64c..a31e029 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -28,23 +28,35 @@ namespace import -force tcltest::test # This probably means that tk wasn't installed properly. ## it indicates that something went wrong sourcing tk.tcl. -## Ensure that any changes that occured to tk.tcl will work or are properly +## Ensure that any changes that occurred to tk.tcl will work or are properly ## prevented in a safe interpreter. -- hobbs # The set of hidden commands is platform dependent: -set hidden_cmds {bell cd clipboard encoding exec exit fconfigure glob grab load menu open pwd selection socket source tcl:encoding:dirs toplevel unload wm} -lappend hidden_cmds {*}[apply {{} { +set hidden_cmds [list bell cd clipboard encoding exec exit \ + fconfigure glob grab load menu open pwd selection \ + socket source tcl:encoding:dirs toplevel unload wm] +if {[package vsatisfies [package provide Tcl] 8.7-]} { + lappend hidden_cmds file tcl:encoding:system tcl:file:tempdir foreach cmd { - atime attributes copy delete dirname executable exists extension - isdirectory isfile link lstat mkdir mtime nativename normalize owned - readable readlink rename rootname size stat tail tempfile type - volumes writable - } {lappend result tcl:file:$cmd}; return $result -}}] + cmdtype nameofexecutable + } {lappend hidden_cmds tcl:info:$cmd} + foreach cmd { + autopurge list purge status + } {lappend hidden_cmds tcl:process:$cmd} + foreach cmd { + lmkimg lmkzip mkimg mkkey mkzip mount mount_data unmount + } {lappend hidden_cmds tcl:zipfs:$cmd} +} +foreach cmd { + atime attributes copy delete dirname executable exists extension + isdirectory isfile link lstat mkdir mtime nativename normalize + owned readable readlink rename rootname size stat tail tempfile + type volumes writable +} {lappend hidden_cmds tcl:file:$cmd} if {[tk windowingsystem] ne "x11"} { - lappend hidden_cmds tk_chooseColor tk_chooseDirectory tk_getOpenFile \ - tk_getSaveFile tk_messageBox + lappend hidden_cmds tk_chooseColor tk_chooseDirectory \ + tk_getOpenFile tk_getSaveFile tk_messageBox } if {[llength [info commands send]]} { lappend hidden_cmds send -- cgit v0.12