diff options
Diffstat (limited to 'tests/safe.test')
| -rw-r--r-- | tests/safe.test | 151 |
1 files changed, 88 insertions, 63 deletions
diff --git a/tests/safe.test b/tests/safe.test index 3e9f716..99681ee 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -6,9 +6,10 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +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: @@ -41,99 +42,117 @@ if {[string equal $tcl_platform(platform) "windows"]} { set saveAutoPath $::auto_path set auto_path [list [info library] $::tk_library] -test safe-1.1 {Safe Tk loading into an interpreter} { - catch {safe::interpDelete a} +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 {} - set x -} "" -test safe-1.2 {Safe Tk loading into an interpreter} { - catch {safe::interpDelete a} + 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 - set l [lsort [interp hidden a]] + lsort [interp hidden a] +} -cleanup { safe::interpDelete a - set l -} $hidden_cmds -test safe-1.3 {Safe Tk loading into an interpreter} -body { - catch {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 - set l [lsort [interp aliases a]] + lsort [interp aliases a] +} -cleanup { safe::interpDelete a - set l } -match glob -result {*encoding*exit*file*load*source*} -test safe-2.1 {Unsafe commands not available} { - catch {safe::interpDelete a} + +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 - set status -} ok -test safe-2.2 {Unsafe commands not available} { - catch {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 - set status -} ok -test safe-2.3 {Unsafe subcommands not available} { - catch {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 } - safe::interpDelete a list $status $msg -} {ok {appname not accessible in a safe interpreter}} -test safe-2.4 {Unsafe subcommands not available} { - catch {safe::interpDelete a} +} -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 } - safe::interpDelete a list $status $msg -} {ok {scaling not accessible in a safe interpreter}} +} -cleanup { + safe::interpDelete a +} -result {ok {scaling not accessible in a safe interpreter}} + -test safe-3.1 {Unsafe commands are available hidden} { - catch {safe::interpDelete a} +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 - set status -} ok -test safe-3.2 {Unsafe commands are available hidden} { - catch {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 - set status -} ok +} -result ok -test safe-4.1 {testing loadTk} { + +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]] @@ -142,27 +161,28 @@ test safe-4.1 {testing loadTk} { # 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} { +test safe-4.2 {testing loadTk -use} -body { set w .safeTkFrame - catch {destroy $w} + destroy $w frame $w -container 1; pack .safeTkFrame 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} { +test safe-5.1 {loading Tk in safe interps without master's clearance} -body { set i [safe::interpCreate] - catch {interp eval $i {load {} Tk}} msg + interp eval $i {load {} Tk} +} -cleanup { safe::interpDelete $i - set msg -} {not allowed to start Tk by master's safe::TkInit} +} -returnCodes error -result {not allowed to start Tk by master's safe::TkInit} -test safe-5.2 {multi-level Tk loading with clearance} { +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. set i [safe::interpCreate] @@ -170,47 +190,52 @@ test safe-5.2 {multi-level Tk loading with clearance} { 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} { + +test safe-6.1 {loadTk -use windowPath} -body { set w .safeTkFrame - catch {destroy $w} + destroy $w frame $w -container 1; pack .safeTkFrame 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} { +test safe-6.2 {loadTk -use windowPath, conflicting -display} -body { set w .safeTkFrame - catch {destroy $w} + destroy $w frame $w -container 1; pack .safeTkFrame 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 - string range $msg 0 36 -} {conflicting -display :23.56 and -use } +} -result {conflicting -display :23.56 and -use } -test safe-7.1 {canvas printing} { +test safe-7.1 {canvas printing} -body { set i [safe::loadTk [safe::interpCreate]] - set r [catch {interp eval $i {canvas .c; .c postscript}}] + interp eval $i {canvas .c; .c postscript} +} -cleanup { safe::interpDelete $i - set r -} 0 +} -returnCodes ok -match glob -result * # cleanup set ::auto_path $saveAutoPath unset hidden_cmds cleanupTests return + + |