# This file is a Tcl script to test out [incr Widgets] Canvasprintdialog # 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 Tako Schotanus # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # 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 Canvasprintdialog-1.$c {Canvasprintdialog construction} { iwidgets::Canvasprintdialog .cpd .cpd activate } {} incr c # # Option tests which are successful. # test Canvasprintdialog-2.$o {configuration option} { llength [.cpd configure] } {28} incr o foreach test { {-background #d9d9d9 #d9d9d9} {-buttonboxpadx 15 15} {-buttonboxpady 15 15} {-buttonboxpos e e} {-buttonboxpos n n} {-buttonboxpos s s} {-buttonboxpos w w} {-cursor gumby gumby} {-filename test.ps test.ps} {-foreground Black Black} {-hpagecnt 2 2} {-modality application application} {-modality global global} {-modality none none} {-orient portrait portrait} {-orient landscape landscape} {-output file file} {-output printer printer} {-padx 15 15} {-pady 15 15} {-pagesize a5 a5} {-pagesize a4 a4} {-pagesize a3 a3} {-pagesize a2 a2} {-pagesize a1 a1} {-pagesize legal legal} {-pagesize letter letter} {-posterize 1 1} {-posterize 0 0} {-printcmd test test} {-printcmd lpr lpr} {-printregion {10 10 100 100} {10 10 100 100}} {-printregion {} {}} {-separator off off} {-separator on on} {-stretch 1 1} {-stretch 0 0} {-thickness 4 4} {-title Test Test} {-vpagecnt 2 2}} { set option [lindex $test 0] test Canvasprintdialog-2.$o "configuration options, $option" { .cpd configure $option [lindex $test 1] lindex [.cpd configure $option] 4 } [lindex $test 2] update incr o } # # Option tests which fail and produce errors. # #foreach test { # {-printregion bogus {bad option "printregion": should contain 4 coordinates}} # {-output bogus {bad option "output": should be file or printer}} # {-orient bogus {bad option "orient": should be portrait or landscape}} # {-stretch bogus {bad option "stretch": should be a boolean}} # {-posterize bogus {bad option "posterize": should be a boolean}} # } { # set option [lindex $test 0] # test Canvasprintdialog-2.$o "configuration options, $option" { # list [catch {.cpd configure $option [lindex $test 1]} msg] $msg # } [list 1 [lindex $test 2]] # incr o #} # # Method tests which are successful. # canvas .c foreach test { {{.cpd getoutput} {lpr}} {{.cpd refresh} {}} {{.cpd setcanvas .c} {}} {{.cpd hide Help} {}} {{.cpd hide Cancel} {}} {{.cpd default Apply} {}} {{.cpd show Cancel} {}} {{.cpd deactivate} {}}} { set method [lindex [lindex $test 0] 1] test Canvasprintdialog-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 Canvasprintdialog-1.$c {Canvasprintdialog destruction} { destroy .c destroy .cpd update } {} incr c test Canvasprintdialog-1.$c {Canvasprintdialog construction} { iwidgets::Canvasprintdialog .cpd update } {} incr c test Canvasprintdialog-1.$c {Canvasprintdialog destruction} { destroy .cpd update } {} incr c test Canvasprintdialog-1.$c {Canvasprintdialog destruction} { iwidgets::Canvasprintdialog .cpd destroy .cpd update } {} ::tcltest::cleanupTests exit