tests/safe.test: [Bug 1847925]: Update list of hidden commands.

2 files changed, 59 insertions, 49 deletions

diff --git a/ChangeLog b/ChangeLog
index 2f06971..1d5132e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2011-11-29  Donal K. Fellows  <dkf@users.sf.net>
+
+	* tests/safe.test: [Bug 1847925]: Update list of hidden commands.
+
 2011-11-22  Jan Nijtmans  <nijtmans@users.sf.net>
 
 	* unix/Makefile.in: [Bug 1945073]: Demo square.tcl
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: