summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/choosedir.test68
-rw-r--r--tests/filebox.test8
2 files changed, 37 insertions, 39 deletions
diff --git a/tests/choosedir.test b/tests/choosedir.test
index 3f4d381..d0fb557 100644
--- a/tests/choosedir.test
+++ b/tests/choosedir.test
@@ -5,7 +5,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: choosedir.test,v 1.7 2000/03/14 20:37:08 ericm Exp $
+# RCS: @(#) $Id: choosedir.test,v 1.8 2000/03/24 19:38:57 ericm Exp $
#
if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -23,8 +23,8 @@ proc ToPressButton {parent btn} {
after 100 SendButtonPress $parent $btn mouse
}
-proc ToEnterDirByKey {parent dir} {
- after 100 EnterDirByKey $parent [list $dir]
+proc ToEnterDirsByKey {parent dirs} {
+ after 100 [list EnterDirsByKey $parent $dirs]
}
proc PressButton {btn} {
@@ -33,28 +33,34 @@ proc PressButton {btn} {
event generate $btn <ButtonRelease-1> -x 5 -y 5
}
-proc EnterDirByKey {parent dir} {
+proc EnterDirsByKey {parent dirs} {
+ global tk_strictMotif
if {$parent == "."} {
- set w .choosedirectory
+ set w .__tk_choosedir
} else {
- set w $parent.choosedirectory
+ set w $parent.__tk_choosedir
}
+ upvar ::tk::dialog::file::__tk_choosedir data
- $w.e delete 0 end
- $w.e insert 0 $dir
-
- update
- SendButtonPress $parent ok mouse
+ foreach dir $dirs {
+ $data(ent) delete 0 end
+ $data(ent) insert 0 $dir
+ update
+ SendButtonPress $parent ok mouse
+ after 50
+ }
}
proc SendButtonPress {parent btn type} {
+ global tk_strictMotif
if {$parent == "."} {
- set w .choosedirectory
+ set w .__tk_choosedir
} else {
- set w $parent.choosedirectory
+ set w $parent.__tk_choosedir
}
+ upvar ::tk::dialog::file::__tk_choosedir data
- set button $w.$btn
+ set button $data($btn\Btn)
if ![winfo ismapped $button] {
update
}
@@ -75,15 +81,6 @@ proc SendButtonPress {parent btn type} {
# The test suite proper
#
#----------------------------------------------------------------------
-catch {unset err}
-append err(usage) "tk_chooseDirectory "
-append err(usage) "?-initialdir directory? ?-mustexist boolean? "
-append err(usage) "?-parent window? ?-title title?"
-
-set err(wrongNumArgs) "wrong # args: should be \"$err(usage)\""
-set err(valueMissing) "value for \"%s\" missing: should be \"$err(usage)\""
-set err(unknownOpt) "unknown option \"%s\": should be \"$err(usage)\""
-
# Make a dir for us to rely on for tests
makeDirectory choosedirTest
set dir [pwd]
@@ -95,11 +92,11 @@ set parent .
foreach opt {-initialdir -mustexist -parent -title} {
test choosedir-1.1 "tk_chooseDirectory command" unixOnly {
list [catch {tk_chooseDirectory $opt} msg] $msg
- } [list 1 [format $err(valueMissing) $opt]]
+ } [list 1 "value for \"$opt\" missing"]
}
test choosedir-1.2 "tk_chooseDirectory command" unixOnly {
list [catch {tk_chooseDirectory -foo bar} msg] $msg
-} [list 1 [format $err(unknownOpt) "-foo"]]
+} [list 1 "bad option \"-foo\": must be -initialdir, -mustexist, -parent, or -title"]
test choosedir-1.3 "tk_chooseDirectory command" unixOnly {
list [catch {tk_chooseDirectory -parent foo.bar} msg] $msg
} {1 {bad window path name "foo.bar"}}
@@ -110,19 +107,16 @@ test choosedir-2.1 "tk_chooseDirectory command, cancel gives null" {unixOnly} {
tk_chooseDirectory -title "Press Cancel" -parent $parent
} ""
-test choosedir-3.1 "tk_chooseDirectory -mustexist 1" {unixOnly badTest} {
+test choosedir-3.1 "tk_chooseDirectory -mustexist 1" {unixOnly} {
# first enter a bogus dirname, then enter a real one.
- set afterId1 [after 100 EnterDirByKey $parent [list $fake]]
- set afterId2 [after 200 EnterDirByKey $parent [list $real]]
+ ToEnterDirsByKey $parent [list $fake $real $real]
set result [tk_chooseDirectory \
-title "Enter \"$fake\", press OK, enter \"$real\", press OK" \
-parent $parent -mustexist 1]
- after cancel $afterId1
- after cancel $afterId2
set result
} $real
-test choosedir-3.2 "tk_chooseDirectory -mustexist 0" {unixOnly badTest} {
- ToEnterDirByKey $parent $fake
+test choosedir-3.2 "tk_chooseDirectory -mustexist 0" {unixOnly} {
+ ToEnterDirsByKey $parent [list $fake $fake]
tk_chooseDirectory -title "Enter \"$fake\", press OK" \
-parent $parent -mustexist 0
} $fake
@@ -132,20 +126,24 @@ test choosedir-4.1 "tk_chooseDirectory command, initialdir" {unixOnly} {
tk_chooseDirectory -title "Press Ok" -parent $parent -initialdir $real
} $real
test choosedir-4.2 "tk_chooseDirectory command, initialdir" {unixOnly} {
- ToEnterDirByKey $parent $fake
+ ToEnterDirsByKey $parent [list $fake $fake]
tk_chooseDirectory \
-title "Enter \"$fake\" and press Ok" \
-parent $parent -initialdir $real
} $fake
test choosedir-4.3 "tk_chooseDirectory, -initialdir {}" {unixOnly} {
+ catch {unset ::tk::dialog::file::__tk_choosedir}
ToPressButton $parent ok
tk_chooseDirectory \
-title "Press OK" \
-parent $parent -initialdir ""
} [pwd]
-
-unset err
+test choosedir-5.1 "tk_chooseDirectory, handles {} entry text" {unixOnly} {
+ ToEnterDirsByKey $parent [list "" $real $real]
+ tk_chooseDirectory -title "Clear entry, Press OK; Enter $real, press OK" \
+ -parent $parent
+} $real
# cleanup
::tcltest::cleanupTests
diff --git a/tests/filebox.test b/tests/filebox.test
index 5aa2050..4f8242e 100644
--- a/tests/filebox.test
+++ b/tests/filebox.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: filebox.test,v 1.8 1999/11/30 00:02:20 hobbs Exp $
+# RCS: @(#) $Id: filebox.test,v 1.9 2000/03/24 19:38:57 ericm Exp $
#
if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -54,7 +54,7 @@ proc EnterFileByKey {parent fileName fileDir} {
} else {
set w $parent.__tk_filedialog
}
- upvar #0 [winfo name $w] data
+ upvar ::tk::dialog::file::__tk_filedialog data
if {$tk_strictMotif} {
$data(sEnt) delete 0 end
@@ -75,7 +75,7 @@ proc SendButtonPress {parent btn type} {
} else {
set w $parent.__tk_filedialog
}
- upvar #0 [winfo name $w] data
+ upvar ::tk::dialog::file::__tk_filedialog data
set button $data($btn\Btn)
if ![winfo ismapped $button] {
@@ -160,7 +160,7 @@ foreach mode $modes {
list [catch {$command -filetypes {Foo}} msg] $msg
} {1 {bad file type "Foo", should be "typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?"}}
- if {[info commands tkMotifFDialog] == "" && [info commands tkFDialog] == ""} {
+ if {[info commands tkMotifFDialog] == "" && [info commands ::tk::dialog::file::tkFDialog] == ""} {
set isNative 1
} else {
set isNative 0