Subversion Repositories or1k

# 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