# This file is a Tcl script to test out [incr Widgets] Promptdialog class. # It is organized in the standard fashion for Tcl tests with the following # notation for test case labels: # # 1.x - Construction/Destruction tests # 2.x - Configuration option tests # 3.x - Method tests # 4.x - Other tests # # Copyright (c) 1995 DSC Technologies Corporation # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # @(#) $Id: promptdialog.test,v 1.3 2001/08/07 19:56:48 smithc Exp $ package require tcltest namespace import -force ::tcltest::* if [catch {package require Iwidgets 4.0}] { # Let's try modifying the auto_path. Note that the IWIDGETS_LIBRARY # env var is initialized in the Makefile when doing a 'make test'. # If sourcing this file independently, this variable must be set manually. if ![info exists env(IWIDGETS_LIBRARY)] { error "Unable to locate Iwidgets package. Set your IWIDGETS_LIBRARY\ environment\nvariable to the directory that contains iwidgets.tcl" } lappend auto_path $env(IWIDGETS_LIBRARY) package require Iwidgets 4.0 } if {[string compare test [info procs test]] == 1} { source defs } wm geometry . {} raise . set c 1 set o 1 set m 1 # # Initial construction test # test Promptdialog-1.$c {Promptdialog construction} { iwidgets::Promptdialog .pd .pd activate } {} incr c # # Option tests which are successful. # test Promptdialog-2.$o {configuration option} { llength [.pd configure] } {38} incr o foreach test { {-background #d9d9d9 #d9d9d9} {-buttonboxpos n n} {-buttonboxpadx 10 10} {-buttonboxpos e e} {-buttonboxpos w w} {-buttonboxpady 10 10} {-buttonboxpos s s} {-cursor gumby gumby} {-exportselection 1 1} {-modality global global} {-modality application application} {-modality none none} {-padx 15 15} {-pady 15 15} {-separator off off} {-thickness 5 5} {-separator on on} {-title "Prompt Dialog" "Prompt Dialog"} {-foreground Black Black} {-textbackground GhostWhite GhostWhite} {-insertbackground Black Black} {-insertborderwidth 1 1} {-insertborderwidth 0 0} {-insertofftime 400 400} {-insertontime 700 700} {-insertwidth 3 3} {-labelpos nw nw} {-labelpos n n} {-labelpos ne ne} {-labelpos en en} {-labelpos e e} {-labelpos es es} {-labelpos sw sw} {-labelpos s s} {-labelpos se se} {-labelpos wn wn} {-labelpos w w} {-labelpos ws ws} {-labeltext Label Label} {-relief sunken sunken} {-textbackground GhostWhite GhostWhite} {-validate numeric numeric} {-validate alphabetic alphabetic} {-validate alphanumeric alphanumeric}} { set option [lindex $test 0] test Promptdialog-2.$o "configuration options, $option" { .pd configure $option [lindex $test 1] lindex [.pd configure $option] 4 } [lindex $test 2] update incr o } # # Method tests which are successful. # foreach test { {{.pd childsite} {.pd.shellchildsite.dschildsite}} {{.pd insert end "Test String"} {}} {{.pd get} {Test String}} {{.pd delete 0 end} {}} {{.pd insert end "Another Test"} {}} {{.pd icursor end} {}} {{.pd index end} 12} {{.pd selection from 0} {}} {{.pd selection to end} {}} {{.pd xview 3} {}} {{.pd clear} {}} {{.pd hide Help} {}} {{.pd hide Cancel} {}} {{.pd default Apply} {}} {{.pd show Cancel} {}} {{.pd deactivate} {}}} { set method [lindex [lindex $test 0] 1] test Promptdialog-3.$m "object methods, $method" { list [catch {eval [lindex $test 0]} msg] $msg } [list 0 [lindex $test 1]] update incr m } # # Conclusion of constrcution/destruction tests # test Promptdialog-1.$c {Promptdialog destruction} { destroy .pd update } {} incr c test Promptdialog-1.$c {Promptdialog construction} { iwidgets::promptdialog .pd update } {} incr c test Promptdialog-1.$c {Promptdialog destruction} { destroy .pd update } {} incr c test Promptdialog-1.$c {Promptdialog destruction} { iwidgets::promptdialog .pd destroy .pd update } {} ::tcltest::cleanupTests exit