summaryrefslogtreecommitdiffstats
path: root/tests/safe.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/safe.test')
-rw-r--r--tests/safe.test122
1 files changed, 122 insertions, 0 deletions
diff --git a/tests/safe.test b/tests/safe.test
new file mode 100644
index 0000000..65aed36
--- /dev/null
+++ b/tests/safe.test
@@ -0,0 +1,122 @@
+# 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.
+#
+# SCCS: @(#) safe.test 1.15 97/08/13 16:05:17
+
+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
+} {}
+
+unset hidden_cmds