diff options
Diffstat (limited to 'tests/safe.test')
| -rw-r--r-- | tests/safe.test | 65 |
1 files changed, 30 insertions, 35 deletions
diff --git a/tests/safe.test b/tests/safe.test index 4f0ce15..627d242 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -1,9 +1,9 @@ # This file is a Tcl script to test the Safe Tk facility. It is organized in # the standard fashion for Tk tests. # -# Copyright (c) 1994 The Regents of the University of California. -# Copyright (c) 1994-1995 Sun Microsystems, Inc. -# Copyright (c) 1998-1999 by Scriptics Corporation. +# Copyright © 1994 The Regents of the University of California. +# Copyright © 1994-1995 Sun Microsystems, Inc. +# Copyright © 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.2 @@ -33,38 +33,33 @@ namespace import -force tcltest::test # The set of hidden commands is platform dependent: -set hidden_cmds {bell cd clipboard encoding exec exit fconfigure} -lappend hidden_cmds {*}[apply {{} { - if {[package vsatisfies [package provide Tcl] 8.7-]} { - lappend result file - } - lappend result glob grab load menu open pwd selection socket source tcl:encoding:dirs - if {[package vsatisfies [package provide Tcl] 8.7-]} { - lappend result tcl:encoding:system - } - lappend result toplevel unload wm +set hidden_cmds [list bell cd clipboard encoding exec exit \ + fconfigure glob grab load menu open pwd selection \ + socket source toplevel unload wm] +if {[package vsatisfies [package provide Tcl] 8.6.7-]} { + lappend hidden_cmds tcl:encoding:dirs +} +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 tempdir tempfile type - volumes writable - } {lappend result tcl:file:$cmd} - if {[package vsatisfies [package provide Tcl] 8.7-]} { - foreach cmd { - cmdtype nameofexecutable - } {lappend result tcl:info:$cmd} - foreach cmd { - autopurge list purge status - } {lappend result tcl:process:$cmd} - foreach cmd { - lmkimg lmkzip mkimg mkkey mkzip mount mount_data unmount - } {lappend result tcl:zipfs:$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 @@ -202,12 +197,12 @@ test safe-4.2 {testing loadTk -use} -setup { destroy $w } -result {} -test safe-5.1 {loading Tk in safe interps without master's clearance} -body { +test safe-5.1 {loading Tk in safe interps without parent's clearance} -body { set i [safe::interpCreate] interp eval $i {load {} Tk} } -cleanup { safe::interpDelete $i -} -returnCodes error -result {not allowed} +} -returnCodes error -match glob -result {*not allowed} test safe-5.2 {multi-level Tk loading with clearance} -setup { set safeParent [safe::interpCreate] } -body { |