diff --git a/tests/choosedir.test b/tests/choosedir.test index f1a817eb9..7ee2aa5a1 100644 --- a/tests/choosedir.test +++ b/tests/choosedir.test @@ -11,7 +11,7 @@ eval tcltest::configure $argv tcltest::loadTestedCommands # Import utility procs for specific functional areas -namespace import -force ::tk::test::dialog::* +testutils import -novars dialog setDialogType choosedir #---------------------------------------------------------------------- @@ -143,6 +143,6 @@ test choosedir-5.1 {tk_chooseDirectory, handles {} entry text} -constraints { removeDirectory choosedirTest setDialogType none -namespace forget ::tk::test::dialog::* +testutils forget dialog cleanupTests return diff --git a/tests/clrpick.test b/tests/clrpick.test index a5852388f..729c48c31 100644 --- a/tests/clrpick.test +++ b/tests/clrpick.test @@ -11,7 +11,7 @@ tcltest::loadTestedCommands namespace import -force tcltest::test # Import utility procs for specific functional areas -namespace import -force ::tk::test::dialog::* +testutils import -novars dialog setDialogType clrpick if {[testConstraint defaultPseudocolor8]} { @@ -173,6 +173,6 @@ test clrpick-4.1 {tk_chooseColor: screen is inherited from parent} -constraints # setDialogType none -namespace forget ::tk::test::dialog::* +testutils forget dialog cleanupTests return diff --git a/tests/dialog.test b/tests/dialog.test index 616e9aefa..b7239616a 100644 --- a/tests/dialog.test +++ b/tests/dialog.test @@ -7,7 +7,7 @@ tcltest::loadTestedCommands namespace import -force tcltest::test # Import utility procs for specific functional areas -namespace import -force ::tk::test::dialog::* +testutils import -novars dialog test dialog-1.1 {tk_dialog command} -body { tk_dialog @@ -64,6 +64,6 @@ test dialog-2.3 {tk_dialog operation} -body { # CLEANUP # -namespace forget ::tk::test::dialog::* +testutils forget dialog cleanupTests return diff --git a/tests/filebox.test b/tests/filebox.test index adde50e3d..a4c6c6c3b 100644 --- a/tests/filebox.test +++ b/tests/filebox.test @@ -11,7 +11,7 @@ eval tcltest::configure $argv tcltest::loadTestedCommands # Import utility procs for specific functional areas -namespace import -force ::tk::test::dialog::* +testutils import -novars dialog setDialogType filebox test fileDialog-0.1 {GetFileName: file types: MakeFilter() fails} { @@ -446,6 +446,6 @@ foreach mode $modes { set tk_strictMotif $tk_strictMotif_old removeFile filebox.tmp setDialogType none -namespace forget ::tk::test::dialog::* +testutils forget dialog cleanupTests return diff --git a/tests/fontchooser.test b/tests/fontchooser.test index 2a69eeb42..bbc80059c 100644 --- a/tests/fontchooser.test +++ b/tests/fontchooser.test @@ -7,8 +7,8 @@ eval tcltest::configure $argv tcltest::loadTestedCommands # Import utility procs for specific functional areas -namespace import -force ::tk::test::dialog::* -upvar #0 ::tk::test::dialog::testDialog testDialog +testutils import dialog + set applyFontCmd [list testDialogFont set] # ------------------------------------------------------------------------- @@ -165,7 +165,7 @@ test fontchooser-5.1 {fontchooser multiple configure} -constraints {scriptImpl} # unset applyFontCmd -namespace forget ::tk::test::dialog::* +testutils forget dialog cleanupTests return diff --git a/tests/msgbox.test b/tests/msgbox.test index efd623e0b..ed7e34bf3 100644 --- a/tests/msgbox.test +++ b/tests/msgbox.test @@ -11,7 +11,7 @@ tcltest::loadTestedCommands namespace import -force tcltest::test # Import utility procs for specific functional areas -namespace import -force ::tk::test::dialog::* +testutils import -novars dialog setDialogType msgbox test msgbox-1.1.1 {tk_messageBox command} -constraints notAqua -body { @@ -423,6 +423,6 @@ test msgbox-3.2 {tk_messageBox handles iconified parent} -constraints { # CLEANUP # -namespace forget ::tk::test::dialog::* +testutils forget dialog cleanupTests return diff --git a/tests/testutils.tcl b/tests/testutils.tcl index 93cba1307..5332fdb43 100644 --- a/tests/testutils.tcl +++ b/tests/testutils.tcl @@ -29,6 +29,20 @@ namespace eval tk { namespace eval test { + # auto_ns_vars -- + # + # Each new namespace automatically holds several variables upvar'ed + # from the global namespace. Notably: + # + # argc argv argv0 auto_index auto_path env tcl_interactive tcl_library \ + # tcl_patchLevel tcl_pkgPath tcl_platform tcl_rcFileName tcl_version + # + # proc testutils (see below) needs to know about them to keep track of + # newly created variables. + # + variable auto_ns_vars [namespace eval tmp {info vars}] + namespace delete tmp + proc assert {expr} { if {! [uplevel 1 [list expr $expr]]} { return -code error "assertion failed: \"[uplevel 1 [list subst -nocommands $expr]]\"" @@ -192,6 +206,86 @@ namespace eval tk { unset _pause($num) } + # testutils -- + # + # Takes care of importing/forgetting utility procs with any associated + # variables from a specific test domain (functional area). It hides + # details/peculiarities from the test writer. + # + # The "import" subcmd invokes any proc "init" defined in the doamin- + # specific namespace. See also the explanation of this mehanism below + # the header for the section "DEFINITIONS OF UTILITY PROCS PER + # FUNCTIONAL AREA" in this file. + # + # Arguments: + # subCmd : "import" or "forget" + # args : a sequence of domains that need to be imported/forgotten, + # optionally preceded by the option -nocommands or -novars. + # + proc testutils {subCmd args} { + variable importedVars + + set usage "[lindex [info level 0] 0] import|forget ?-nocommands|-novars? domain ?domain domain ...?" + set argc [llength $args] + if {$argc < 1} { + return -code error $usage + } + + set option [lindex $args 0] + if {$option ni "-nocommands -novars"} { + set option {} + } + if {($subCmd ni "import forget") || (($option ne "") && ($argc < 2))} { + return -code error $usage + } + if {($subCmd eq "forget") && ($option ne "")} { + return -code error "options \"-nocommands\" and \"-novars\" are not valid with subCmd \"forget\"" + } + + set domains [expr {$option eq ""?$args:[lrange $args 1 end]}] + foreach domain $domains { + if {! [namespace exists ::tk::test::$domain]} { + return -code error "Tk test domain \"$domain\" doesn't exist" + } + switch -- $subCmd { + import { + if {$domain ni [array names importedVars]} { + if {$option ne "-nocommands"} { + uplevel 1 [list namespace import -force ::tk::test::${domain}::*] + set importedVars($domain) [list] + } + if {$option ne "-novars"} { + variable auto_ns_vars + if {[namespace inscope ::tk::test::$domain {info procs init}] eq "init"} { + ::tk::test::${domain}::init + } + foreach varName [namespace inscope ::tk::test::$domain {info vars}] { + if {$varName ni $auto_ns_vars} { + uplevel 1 [list upvar #0 ::tk::test::${domain}::$varName $varName] + lappend importedVars($domain) $varName + } + } + } + } else { + if {[namespace inscope ::tk::test::$domain {info procs init}] eq "init"} { + ::tk::test::${domain}::init + } + } + } + forget { + if {! [info exists importedVars($domain)]} { + return -code error "domain \"$domain\" was not imported" + } + uplevel 1 [list namespace forget ::tk::test::${domain}::*] + foreach varName $importedVars($domain) { + uplevel 1 unset -nocomplain $varName + } + unset importedVars($domain) + } + } + } + } + namespace export * } } @@ -203,6 +297,40 @@ namespace import -force tk::test::* # DEFINITIONS OF UTILITY PROCS PER FUNCTIONAL AREA # +# +# INIT PROCS, IMPORTING UTILITY PROCS AND ASSOCIATED NAMESPACE VARIABLES, +# AND AUTO-INITIALIZATION +# +# Some utility procs from specific functional areas store state in a namespace +# variable that is also accessed from the namespace in which the tests are +# executed (the "executing namespace"). Some tests require such variables +# to be initialized. +# +# When such variables are imported into the "executing namespace" through +# an "upvar" command, and the test file unsets these variables as part of a +# cleanup operation, this results in the deletion of the target variable +# inside the specific domain namespace. This, in turn, poses a problem for +# the next test file, which presumes that the variable is initialized. +# +# The proc "testutils" deals with this upvar issue as follows: +# +# If a namespace for a specific functional area holds a proc "init", the +# "testutils import xxx" will invoke it to carry out the initialization of +# such namespace variables and subsequently imports them into the executing +# namespace using "upvar" (import with auto-initialization). +# Upon test file cleanup "testutils forget xxx" will remove the imported +# utility procs with the associated namespace variables, and unset the upvar'ed +# variable in both the source and target namespace, including their link. The +# link and initialization will be recreated for the next namespace upon +# "testutils import yyy". +# +# Test writers that create a new utility procs that use a namespace variable +# that is also accessed by a test file, need to add the initialization +# statements to the init proc. Just placing them inside the "namespace eval" +# scope for the specific domain (outside the init proc) isn't enough because +# that foregoes the importing of the namespace variables and their automatic +# re-initialization. +# namespace eval ::tk::test::button { proc bogusTrace args { error "trace aborted" @@ -388,6 +516,11 @@ namespace eval ::tk::test::colors { namespace eval ::tk::test::dialog { + proc init {} { + variable dialogType none + variable testDialog + } + proc Click {button} { variable testDialog if {$button ni "ok cancel apply"} { @@ -456,7 +589,6 @@ namespace eval ::tk::test::dialog { } } - variable dialogType none proc setDialogType {type} { variable dialogType $type } @@ -534,7 +666,8 @@ namespace eval ::tk::test::dialog { ::tk::test::createStdAccessProc testDialogFont - namespace export * + namespace export Click PressButton SendButtonPress setDialogType testDialog \ + testDialogFont ToPressButton } @@ -599,7 +732,6 @@ namespace eval ::tk::test::geometry { } namespace eval ::tk::test::image { - variable ImageNames proc imageCleanup {} { variable ImageNames @@ -774,10 +906,12 @@ namespace eval ::tk::test::select { } namespace eval ::tk::test::text { - variable fixedFont {Courier -12} - variable fixedWidth [font measure $fixedFont m] - variable fixedHeight [font metrics $fixedFont -linespace] - variable fixedAscent [font metrics $fixedFont -ascent] + proc init {} { + variable fixedFont {Courier -12} + variable fixedWidth [font measure $fixedFont m] + variable fixedHeight [font metrics $fixedFont -linespace] + variable fixedAscent [font metrics $fixedFont -ascent] + } # full border size of the text widget, i.e. first x or y coordinate inside the text widget # warning: -padx is supposed to be the same as -pady (same border size horizontally and @@ -803,7 +937,7 @@ namespace eval ::tk::test::text { return [expr {[bo $w] + ($l - 1) * $fixedHeight}] } - namespace export * + namespace export bo xchar xw yline } # EOF diff --git a/tests/textDisp.test b/tests/textDisp.test index e4506b7f1..64c681087 100644 --- a/tests/textDisp.test +++ b/tests/textDisp.test @@ -12,11 +12,7 @@ tcltest::loadTestedCommands namespace import -force tcltest::test # Import utility procs for specific functional areas -namespace import -force ::tk::test::text::* -upvar 0 ::tk::test::text::fixedFont fixedFont \ - ::tk::test::text::fixedWidth fixedWidth \ - ::tk::test::text::fixedHeight fixedHeight \ - ::tk::test::text::fixedAscent fixedAscent +testutils import text namespace import -force ::tk::test::scroll::* @@ -4908,7 +4904,7 @@ test textDisp-36.1 {Display bug with 'yview insert'} -constraints {knownBug} -se unset scrollCmdPrefix namespace forget ::tk::test::scroll::* -namespace forget ::tk::test::text::* +testutils forget text deleteWindows option clear cleanupTests diff --git a/tests/textIndex.test b/tests/textIndex.test index 91a8598e9..450ce0ad5 100644 --- a/tests/textIndex.test +++ b/tests/textIndex.test @@ -10,10 +10,7 @@ package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands namespace import -force tcltest::test - -upvar 0 ::tk::test::text::fixedFont fixedFont \ - ::tk::test::text::fixedWidth fixedWidth \ - ::tk::test::text::fixedHeight fixedHeight +testutils import -nocommands text catch {destroy .t} text .t -font {Courier -12} -width 20 -height 10 @@ -1027,5 +1024,6 @@ test textIndex-26.2 {GetIndex errors out if mark, image, window, or tag is outsi # cleanup rename textimage {} catch {destroy .t} +testutils forget text cleanupTests return diff --git a/tests/textWind.test b/tests/textWind.test index 9703776b1..83d58c1d7 100644 --- a/tests/textWind.test +++ b/tests/textWind.test @@ -12,11 +12,7 @@ tcltest::configure {*}$argv tcltest::loadTestedCommands # Import utility procs for specific functional areas -namespace import -force ::tk::test::text::* -upvar 0 ::tk::test::text::fixedFont fixedFont \ - ::tk::test::text::fixedWidth fixedWidth \ - ::tk::test::text::fixedHeight fixedHeight \ - ::tk::test::text::fixedAscent fixedAscent +testutils import text deleteWindows @@ -1653,6 +1649,6 @@ test textWind-18.3 {embedded window destruction in cascade} -setup { # option clear -namespace forget ::tk::test::text::* +testutils forget text cleanupTests return diff --git a/tests/winDialog.test b/tests/winDialog.test index 078c9f23e..b5662d22a 100755 --- a/tests/winDialog.test +++ b/tests/winDialog.test @@ -13,8 +13,7 @@ tcltest::configure {*}$argv tcltest::loadTestedCommands # Import utility procs for specific functional areas -namespace import -force ::tk::test::dialog::* -upvar #0 ::tk::test::dialog::testDialog testDialog +testutils import dialog set applyFontCmd [list testDialogFont set] if {[testConstraint testwinevent]} { @@ -978,7 +977,7 @@ if {[testConstraint testwinevent]} { # unset applyFontCmd initialDir -namespace forget ::tk::test::dialog::* +testutils forget dialog cleanupTests return