URL
https://opencores.org/ocsvn/or1k/or1k/trunk
Subversion Repositories or1k
[/] [or1k/] [trunk/] [insight/] [tk/] [tests/] [safe.test] - Rev 1775
Go to most recent revision | Compare with Previous | Blame | View Log
# 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.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: safe.test,v 1.1.1.1 2002-01-16 10:25:59 markom Exp $
if {[info procs test] != "test"} {
source defs
}
foreach i [winfo children .] {
destroy $i
}
# The set of hidden commands is platform dependent:
if {"$tcl_platform(platform)" == "macintosh"} {
set hidden_cmds {beep bell cd clipboard echo exit fconfigure file glob grab load ls menu open pwd selection socket source tk tk_chooseColor tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm}
} elseif {"$tcl_platform(platform)" == "windows"} {
set hidden_cmds {bell cd clipboard exec exit fconfigure file glob grab load menu open pwd selection socket source tk tk_chooseColor tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm}
} else {
set hidden_cmds {bell cd clipboard exec exit fconfigure file glob grab load menu open pwd selection send socket source tk tk_chooseColor tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm}
}
test safe-1.1 {Safe Tk loading into an interpreter} {
catch {safe::interpDelete a}
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}
safe::interpCreate a
safe::loadTk a
set l [lsort [interp hidden a]]
safe::interpDelete a
set l
} $hidden_cmds
test safe-1.3 {Safe Tk loading into an interpreter} {
catch {safe::interpDelete a}
safe::interpCreate a
safe::loadTk a
set l [lsort [interp aliases a]]
safe::interpDelete a
set l
} {exit file load source}
test safe-2.1 {Unsafe commands not available} {
catch {safe::interpDelete a}
safe::interpCreate a
safe::loadTk a
set status broken
if {[catch {interp eval a {toplevel .t}} msg]} {
set status ok
}
safe::interpDelete a
set status
} ok
test safe-2.2 {Unsafe commands not available} {
catch {safe::interpDelete a}
safe::interpCreate a
safe::loadTk a
set status broken
if {[catch {interp eval a {menu .m}} msg]} {
set status ok
}
safe::interpDelete a
set status
} ok
test safe-3.1 {Unsafe commands are available hidden} {
catch {safe::interpDelete a}
safe::interpCreate a
safe::loadTk a
set status ok
if {[catch {interp invokehidden a toplevel .t} msg]} {
set status broken
}
safe::interpDelete a
set status
} ok
test safe-3.2 {Unsafe commands are available hidden} {
catch {safe::interpDelete a}
safe::interpCreate a
safe::loadTk a
set status ok
if {[catch {interp invokehidden a menu .m} msg]} {
set status broken
}
safe::interpDelete a
set status
} ok
test safe-4.1 {testing loadTk} {
# 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 impy 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
} {}
test safe-4.2 {testing loadTk -use} {
set w .safeTkFrame
catch {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
} {}
test safe-5.1 {loading Tk in safe interps without master's clearance} {
set i [safe::interpCreate]
catch {interp eval $i {load {} Tk}} msg
safe::interpDelete $i
set msg
} {not allowed to start Tk by master's safe::TkInit}
test safe-5.2 {multi-level Tk loading with clearance} {
# 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
}
safe::interpDelete $j
safe::interpDelete $i
} {}
test safe-6.1 {loadTk -use windowPath} {
set w .safeTkFrame
catch {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
} {}
test safe-6.2 {loadTk -use windowPath, conflicting -display} {
set w .safeTkFrame
catch {destroy $w}
frame $w -container 1;
pack .safeTkFrame
set i [safe::interpCreate]
catch {safe::loadTk $i -use $w -display :23.56} msg
safe::interpDelete $i
destroy $w
string range $msg 0 36
} {conflicting -display :23.56 and -use }
unset hidden_cmds
Go to most recent revision | Compare with Previous | Blame | View Log