diff options
Diffstat (limited to 'tk/tests/choosedir.test')
-rw-r--r-- | tk/tests/choosedir.test | 150 |
1 files changed, 150 insertions, 0 deletions
diff --git a/tk/tests/choosedir.test b/tk/tests/choosedir.test new file mode 100644 index 00000000000..1b1d20ebd4d --- /dev/null +++ b/tk/tests/choosedir.test @@ -0,0 +1,150 @@ +# This file is a Tcl script to test out Tk's "tk_chooseDir" and +# It is organized in the standard fashion for Tcl tests. +# +# Copyright (c) 1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. +# +# RCS: @(#) $Id$ +# + +if {[lsearch [namespace children] ::tcltest] == -1} { + package require tcltest + namespace import -force ::tcltest::* +} + +#---------------------------------------------------------------------- +# +# Procedures needed by this test file +# +#---------------------------------------------------------------------- + +proc ToPressButton {parent btn} { + after 100 SendButtonPress $parent $btn mouse +} + +proc ToEnterDirsByKey {parent dirs} { + after 100 [list EnterDirsByKey $parent $dirs] +} + +proc PressButton {btn} { + event generate $btn <Enter> + event generate $btn <1> -x 5 -y 5 + event generate $btn <ButtonRelease-1> -x 5 -y 5 +} + +proc EnterDirsByKey {parent dirs} { + global tk_strictMotif + if {$parent == "."} { + set w .__tk_choosedir + } else { + set w $parent.__tk_choosedir + } + upvar ::tk::dialog::file::__tk_choosedir data + + 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 .__tk_choosedir + } else { + set w $parent.__tk_choosedir + } + upvar ::tk::dialog::file::__tk_choosedir data + + set button $data($btn\Btn) + if ![winfo ismapped $button] { + update + } + + if {$type == "mouse"} { + PressButton $button + } else { + event generate $w <Enter> + focus $w + event generate $button <Enter> + event generate $w <KeyPress> -keysym Return + } +} + + +#---------------------------------------------------------------------- +# +# The test suite proper +# +#---------------------------------------------------------------------- +# Make a dir for us to rely on for tests +makeDirectory choosedirTest +set dir [pwd] +set fake [file join $dir non-existant] +set real [file join $dir choosedirTest] + +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 "value for \"$opt\" missing"] +} +test choosedir-1.2 "tk_chooseDirectory command" unixOnly { + list [catch {tk_chooseDirectory -foo bar} msg] $msg +} [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"}} + + +test choosedir-2.1 "tk_chooseDirectory command, cancel gives null" {unixOnly} { + ToPressButton $parent cancel + tk_chooseDirectory -title "Press Cancel" -parent $parent +} "" + +test choosedir-3.1 "tk_chooseDirectory -mustexist 1" {unixOnly} { + # first enter a bogus dirname, then enter a real one. + ToEnterDirsByKey $parent [list $fake $real $real] + set result [tk_chooseDirectory \ + -title "Enter \"$fake\", press OK, enter \"$real\", press OK" \ + -parent $parent -mustexist 1] + set result +} $real +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 + +test choosedir-4.1 "tk_chooseDirectory command, initialdir" {unixOnly} { + ToPressButton $parent ok + tk_chooseDirectory -title "Press Ok" -parent $parent -initialdir $real +} $real +test choosedir-4.2 "tk_chooseDirectory command, initialdir" {unixOnly} { + 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] + +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 +return |