home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / tests / safe.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  3.7 KB  |  123 lines  |  [TEXT/ALFA]
  1. # This file is a Tcl script to test the Safe Tk facility. It is organized
  2. # in the standard fashion for Tk tests.
  3. #
  4. # Copyright (c) 1994 The Regents of the University of California.
  5. # Copyright (c) 1994-1995 Sun Microsystems, Inc.
  6. #
  7. # See the file "license.terms" for information on usage and redistribution
  8. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  9. #
  10. # SCCS: @(#) safe.test 1.15 97/08/13 16:05:17
  11.  
  12. if {[info procs test] != "test"} {
  13.     source defs
  14. }
  15.  
  16. foreach i [winfo children .] {
  17.     destroy $i
  18. }
  19.  
  20. # The set of hidden commands is platform dependent:
  21.  
  22. if {"$tcl_platform(platform)" == "macintosh"} {
  23.     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}
  24. } elseif {"$tcl_platform(platform)" == "windows"} {
  25.     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}
  26. } else {
  27.     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}
  28. }
  29.  
  30. test safe-1.1 {Safe Tk loading into an interpreter} {
  31.     catch {safe::interpDelete a}
  32.     safe::loadTk [safe::interpCreate a]
  33.     safe::interpDelete a
  34.     set x {}
  35.     set x
  36. } ""
  37. test safe-1.2 {Safe Tk loading into an interpreter} {
  38.     catch {safe::interpDelete a}
  39.     safe::interpCreate a
  40.     safe::loadTk a
  41.     set l [lsort [interp hidden a]]
  42.     safe::interpDelete a
  43.     set l
  44. } $hidden_cmds
  45. test safe-1.3 {Safe Tk loading into an interpreter} {
  46.     catch {safe::interpDelete a}
  47.     safe::interpCreate a
  48.     safe::loadTk a
  49.     set l [lsort [interp aliases a]]
  50.     safe::interpDelete a
  51.     set l
  52. } {exit file load source}
  53.  
  54. test safe-2.1 {Unsafe commands not available} {
  55.     catch {safe::interpDelete a}
  56.     safe::interpCreate a
  57.     safe::loadTk a
  58.     set status broken
  59.     if {[catch {interp eval a {toplevel .t}} msg]} {
  60.     set status ok
  61.     }
  62.     safe::interpDelete a
  63.     set status
  64. } ok
  65. test safe-2.2 {Unsafe commands not available} {
  66.     catch {safe::interpDelete a}
  67.     safe::interpCreate a
  68.     safe::loadTk a
  69.     set status broken
  70.     if {[catch {interp eval a {menu .m}} msg]} {
  71.     set status ok
  72.     }
  73.     safe::interpDelete a
  74.     set status
  75. } ok
  76.  
  77. test safe-3.1 {Unsafe commands are available hidden} {
  78.     catch {safe::interpDelete a}
  79.     safe::interpCreate a
  80.     safe::loadTk a
  81.     set status ok
  82.     if {[catch {interp invokehidden a toplevel .t} msg]} {
  83.     set status broken
  84.     }
  85.     safe::interpDelete a
  86.     set status
  87. } ok
  88. test safe-3.2 {Unsafe commands are available hidden} {
  89.     catch {safe::interpDelete a}
  90.     safe::interpCreate a
  91.     safe::loadTk a
  92.     set status ok
  93.     if {[catch {interp invokehidden a menu .m} msg]} {
  94.     set status broken
  95.     }
  96.     safe::interpDelete a
  97.     set status
  98. } ok
  99.  
  100. test safe-4.1 {testing loadTk} {
  101.     # no error shall occur, the user will
  102.     # eventually see a new toplevel
  103.     set i [safe::loadTk [safe::interpCreate]]
  104.     interp eval $i {button .b -text "hello world!"; pack .b}
  105. # lets don't update because it might impy that the user has
  106. # to position the window (if the wm does not do it automatically)
  107. # and thus make the test suite not runable non interactively
  108.     safe::interpDelete $i
  109. } {}
  110.  
  111. test safe-4.2 {testing loadTk -use} {
  112.     set w .safeTkFrame
  113.     catch {destroy $w}
  114.     frame $w -container 1;
  115.     pack .safeTkFrame
  116.     set i [safe::loadTk [safe::interpCreate] -use [winfo id $w]]
  117.     interp eval $i {button .b -text "hello world!"; pack .b}
  118.     safe::interpDelete $i
  119.     destroy $w
  120. } {}
  121.  
  122. unset hidden_cmds
  123.