diff options
author | dkf <dkf@noemail.net> | 2011-11-29 14:26:54 (GMT) |
---|---|---|
committer | dkf <dkf@noemail.net> | 2011-11-29 14:26:54 (GMT) |
commit | 4e3b90b5891163a18304ff2476ffb152e79f6482 (patch) | |
tree | 29452fed1abdbc6f8f82ef3338d051805ef46030 /tests/safe.test | |
parent | 81229ad191052bb4380058ff4bd0b869d25e155d (diff) | |
download | tk-4e3b90b5891163a18304ff2476ffb152e79f6482.zip tk-4e3b90b5891163a18304ff2476ffb152e79f6482.tar.gz tk-4e3b90b5891163a18304ff2476ffb152e79f6482.tar.bz2 |
tests/safe.test: [Bug 1847925]: Update list of hidden commands.
FossilOrigin-Name: dcd76b16d128eda1d308714a2f7f347f83590c5b
Diffstat (limited to 'tests/safe.test')
-rw-r--r-- | tests/safe.test | 104 |
1 files changed, 55 insertions, 49 deletions
diff --git a/tests/safe.test b/tests/safe.test index 99681ee..652e1a2 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -1,5 +1,5 @@ -# This file is a Tcl script to test the Safe Tk facility. It is organized -# in the standard fashion for Tk tests. +# 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. @@ -28,22 +28,33 @@ 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 prevented in a safe interpreter. -- hobbs +## Ensure that any changes that occured to tk.tcl will work or are properly +## prevented in a safe interpreter. -- hobbs # The set of hidden commands is platform dependent: -if {[string equal $tcl_platform(platform) "windows"]} { - set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection socket source tk_chooseColor tk_chooseDirectory tk_getOpenFile tk_getSaveFile tk_messageBox toplevel unload wm} +set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection socket source toplevel unload wm} +lappend hidden_cmds {*}[apply {{} { + 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 +}}] +if {$tcl_platform(platform) eq "windows"} { + lappend hidden_cmds tk_chooseColor tk_chooseDirectory tk_getOpenFile \ + tk_getSaveFile tk_messageBox } else { - set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection send socket source toplevel unload wm} + lappend hidden_cmds send } set saveAutoPath $::auto_path set auto_path [list [info library] $::tk_library] - +set hidden_cmds [lsort $hidden_cmds] + test safe-1.1 {Safe Tk loading into an interpreter} -setup { - catch {safe::interpDelete a} + catch {safe::interpDelete a} } -body { safe::loadTk [safe::interpCreate a] safe::interpDelete a @@ -51,7 +62,7 @@ test safe-1.1 {Safe Tk loading into an interpreter} -setup { return $x } -result {} test safe-1.2 {Safe Tk loading into an interpreter} -setup { - catch {safe::interpDelete a} + catch {safe::interpDelete a} } -body { safe::interpCreate a safe::loadTk a @@ -60,7 +71,7 @@ test safe-1.2 {Safe Tk loading into an interpreter} -setup { safe::interpDelete a } -result $hidden_cmds test safe-1.3 {Safe Tk loading into an interpreter} -setup { - catch {safe::interpDelete a} + catch {safe::interpDelete a} } -body { safe::interpCreate a safe::loadTk a @@ -69,9 +80,8 @@ test safe-1.3 {Safe Tk loading into an interpreter} -setup { safe::interpDelete a } -match glob -result {*encoding*exit*file*load*source*} - test safe-2.1 {Unsafe commands not available} -setup { - catch {safe::interpDelete a} + catch {safe::interpDelete a} } -body { safe::interpCreate a safe::loadTk a @@ -84,7 +94,7 @@ test safe-2.1 {Unsafe commands not available} -setup { safe::interpDelete a } -result ok test safe-2.2 {Unsafe commands not available} -setup { - catch {safe::interpDelete a} + catch {safe::interpDelete a} } -body { safe::interpCreate a safe::loadTk a @@ -97,7 +107,7 @@ test safe-2.2 {Unsafe commands not available} -setup { safe::interpDelete a } -result ok test safe-2.3 {Unsafe subcommands not available} -setup { - catch {safe::interpDelete a} + catch {safe::interpDelete a} } -body { safe::interpCreate a safe::loadTk a @@ -107,10 +117,10 @@ test safe-2.3 {Unsafe subcommands not available} -setup { } list $status $msg } -cleanup { - safe::interpDelete a + safe::interpDelete a } -result {ok {appname not accessible in a safe interpreter}} test safe-2.4 {Unsafe subcommands not available} -setup { - catch {safe::interpDelete a} + catch {safe::interpDelete a} } -body { safe::interpCreate a safe::loadTk a @@ -120,12 +130,11 @@ test safe-2.4 {Unsafe subcommands not available} -setup { } list $status $msg } -cleanup { - safe::interpDelete a + safe::interpDelete a } -result {ok {scaling not accessible in a safe interpreter}} - test safe-3.1 {Unsafe commands are available hidden} -setup { - catch {safe::interpDelete a} + catch {safe::interpDelete a} } -body { safe::interpCreate a safe::loadTk a @@ -138,7 +147,7 @@ test safe-3.1 {Unsafe commands are available hidden} -setup { safe::interpDelete a } -result ok test safe-3.2 {Unsafe commands are available hidden} -setup { - catch {safe::interpDelete a} + catch {safe::interpDelete a} } -body { safe::interpCreate a safe::loadTk a @@ -151,71 +160,66 @@ test safe-3.2 {Unsafe commands are available hidden} -setup { safe::interpDelete a } -result ok - test safe-4.1 {testing loadTk} -body { - # no error shall occur, the user will - # eventually see a new toplevel + # no error shall occur, the user will eventually see a new toplevel set i [safe::loadTk [safe::interpCreate]] interp eval $i {button .b -text "hello world!"; pack .b} - # lets don't update because it might imply that the user has - # to position the window (if the wm does not do it automatically) - # and thus make the test suite not runable non interactively + # lets don't update because it might imply that the user has to position + # the window (if the wm does not do it automatically) and thus make the + # test suite not runable non interactively safe::interpDelete $i } -result {} - -test safe-4.2 {testing loadTk -use} -body { +test safe-4.2 {testing loadTk -use} -setup { + destroy .safeTkFrame +} -body { set w .safeTkFrame - destroy $w frame $w -container 1; - pack .safeTkFrame + pack $w set i [safe::loadTk [safe::interpCreate] -use [winfo id $w]] interp eval $i {button .b -text "hello world!"; pack .b} safe::interpDelete $i destroy $w } -result {} - test safe-5.1 {loading Tk in safe interps without master's clearance} -body { set i [safe::interpCreate] interp eval $i {load {} Tk} } -cleanup { safe::interpDelete $i } -returnCodes error -result {not allowed to start Tk by master's safe::TkInit} - test safe-5.2 {multi-level Tk loading with clearance} -body { - # No error shall occur in that test and no window - # shall remain at the end. + # No error shall occur in that test and no window shall remain at the end. set i [safe::interpCreate] set j [list $i x] set j [safe::interpCreate $j] safe::loadTk $j interp eval $j { - button .b -text Ok -command {destroy .} - pack .b -# tkwait window . ; # for interactive testing/debugging + button .b -text Ok -command {destroy .} + pack .b +# tkwait window . ; # for interactive testing/debugging } } -cleanup { safe::interpDelete $j safe::interpDelete $i } -result {} - -test safe-6.1 {loadTk -use windowPath} -body { +test safe-6.1 {loadTk -use windowPath} -setup { + destroy .safeTkFrame +} -body { set w .safeTkFrame - destroy $w frame $w -container 1; - pack .safeTkFrame + pack $w set i [safe::loadTk [safe::interpCreate] -use $w] interp eval $i {button .b -text "hello world!"; pack .b} safe::interpDelete $i destroy $w } -result {} - -test safe-6.2 {loadTk -use windowPath, conflicting -display} -body { +test safe-6.2 {loadTk -use windowPath, conflicting -display} -setup { + destroy .safeTkFrame +} -body { set w .safeTkFrame - destroy $w frame $w -container 1; - pack .safeTkFrame + pack $w set i [safe::interpCreate] catch {safe::loadTk $i -use $w -display :23.56} msg string range $msg 0 36 @@ -224,18 +228,20 @@ test safe-6.2 {loadTk -use windowPath, conflicting -display} -body { destroy $w } -result {conflicting -display :23.56 and -use } - test safe-7.1 {canvas printing} -body { set i [safe::loadTk [safe::interpCreate]] interp eval $i {canvas .c; .c postscript} } -cleanup { safe::interpDelete $i } -returnCodes ok -match glob -result * - + # cleanup set ::auto_path $saveAutoPath unset hidden_cmds cleanupTests return - +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: |