diff options
author | William Joye <wjoye@cfa.harvard.edu> | 2017-10-17 19:50:58 (GMT) |
---|---|---|
committer | William Joye <wjoye@cfa.harvard.edu> | 2017-10-17 19:50:58 (GMT) |
commit | 9b7a6c3507ea3383c60aaecb29f873c9b590ccca (patch) | |
tree | 82ce31ebd8f46803d969034f5aa3db8d7974493c /tk8.6/tests/safe.test | |
parent | 87fca7325b97005eb44dcf3e198277640af66115 (diff) | |
download | blt-9b7a6c3507ea3383c60aaecb29f873c9b590ccca.zip blt-9b7a6c3507ea3383c60aaecb29f873c9b590ccca.tar.gz blt-9b7a6c3507ea3383c60aaecb29f873c9b590ccca.tar.bz2 |
rm tcl/tk 8.6.7
Diffstat (limited to 'tk8.6/tests/safe.test')
-rw-r--r-- | tk8.6/tests/safe.test | 248 |
1 files changed, 0 insertions, 248 deletions
diff --git a/tk8.6/tests/safe.test b/tk8.6/tests/safe.test deleted file mode 100644 index 475d938..0000000 --- a/tk8.6/tests/safe.test +++ /dev/null @@ -1,248 +0,0 @@ -# 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. -# All rights reserved. - -package require tcltest 2.2 -eval tcltest::configure $argv -tcltest::loadTestedCommands -namespace import -force tcltest::test - -## NOTE: Any time tests fail here with an error like: - -# Can't find a usable tk.tcl in the following directories: -# {$p(:26:)} -# -# $p(:26:)/tk.tcl: script error -# script error -# invoked from within -# "source {$p(:26:)/tk.tcl}" -# ("uplevel" body line 1) -# invoked from within -# "uplevel #0 [list source $file]" -# -# -# 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 - -# 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 {{} { - 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 {[tk windowingsystem] ne "x11"} { - lappend hidden_cmds tk_chooseColor tk_chooseDirectory tk_getOpenFile \ - tk_getSaveFile tk_messageBox -} -if {[llength [info commands send]]} { - 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} -} -body { - safe::loadTk [safe::interpCreate a] - safe::interpDelete a - set x {} - return $x -} -result {} -test safe-1.2 {Safe Tk loading into an interpreter} -setup { - catch {safe::interpDelete a} -} -body { - safe::interpCreate a - safe::loadTk a - lsort [interp hidden a] -} -cleanup { - safe::interpDelete a -} -result $hidden_cmds -test safe-1.3 {Safe Tk loading into an interpreter} -setup { - catch {safe::interpDelete a} -} -body { - safe::interpCreate a - safe::loadTk a - lsort [interp aliases a] -} -cleanup { - safe::interpDelete a -} -match glob -result {*encoding*exit*glob*load*source*} - -test safe-2.1 {Unsafe commands not available} -setup { - catch {safe::interpDelete a} -} -body { - safe::interpCreate a - safe::loadTk a - set status broken - if {[catch {interp eval a {toplevel .t}} msg]} { - set status ok - } - return $status -} -cleanup { - safe::interpDelete a -} -result ok -test safe-2.2 {Unsafe commands not available} -setup { - catch {safe::interpDelete a} -} -body { - safe::interpCreate a - safe::loadTk a - set status broken - if {[catch {interp eval a {menu .m}} msg]} { - set status ok - } - return $status -} -cleanup { - safe::interpDelete a -} -result ok -test safe-2.3 {Unsafe subcommands not available} -setup { - catch {safe::interpDelete a} -} -body { - safe::interpCreate a - safe::loadTk a - set status broken - if {[catch {interp eval a {tk appname}} msg]} { - set status ok - } - list $status $msg -} -cleanup { - 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} -} -body { - safe::interpCreate a - safe::loadTk a - set status broken - if {[catch {interp eval a {tk scaling}} msg]} { - set status ok - } - list $status $msg -} -cleanup { - 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} -} -body { - safe::interpCreate a - safe::loadTk a - set status ok - if {[catch {interp invokehidden a toplevel .t} msg]} { - set status broken - } - return $status -} -cleanup { - safe::interpDelete a -} -result ok -test safe-3.2 {Unsafe commands are available hidden} -setup { - catch {safe::interpDelete a} -} -body { - safe::interpCreate a - safe::loadTk a - set status ok - if {[catch {interp invokehidden a menu .m} msg]} { - set status broken - } - return $status -} -cleanup { - safe::interpDelete a -} -result ok - -test safe-4.1 {testing loadTk} -body { - # 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 - safe::interpDelete $i -} -result {} -test safe-4.2 {testing loadTk -use} -setup { - destroy .safeTkFrame -} -body { - set w .safeTkFrame - frame $w -container 1; - 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} -test safe-5.2 {multi-level Tk loading with clearance} -setup { - set safeParent [safe::interpCreate] -} -body { - # No error shall occur in that test and no window shall remain at the end. - set i [safe::interpCreate [list $safeParent x]] - safe::loadTk $i - interp eval $i { - button .b -text Ok -command {destroy .} - pack .b -# tkwait window . ; # for interactive testing/debugging - } -} -cleanup { - catch {safe::interpDelete $i} - safe::interpDelete $safeParent -} -result {} - -test safe-6.1 {loadTk -use windowPath} -setup { - destroy .safeTkFrame -} -body { - set w .safeTkFrame - frame $w -container 1; - 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} -setup { - destroy .safeTkFrame -} -body { - set w .safeTkFrame - frame $w -container 1; - pack $w - set i [safe::interpCreate] - catch {safe::loadTk $i -use $w -display :23.56} msg - string range $msg 0 36 -} -cleanup { - safe::interpDelete $i - 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: |