summaryrefslogtreecommitdiffstats
path: root/tests/winDialog.test
diff options
context:
space:
mode:
authorstanton <stanton@noemail.net>1999-04-16 01:51:06 (GMT)
committerstanton <stanton@noemail.net>1999-04-16 01:51:06 (GMT)
commit58364783d6f176ecb8520dade8d1cb1a346c0950 (patch)
tree31378e81bd58f8c726fc552d6b30cbf3ca07497b /tests/winDialog.test
parent878ed3a2c9af6e583516ac48fd69ce3b349ac5f8 (diff)
downloadtk-58364783d6f176ecb8520dade8d1cb1a346c0950.zip
tk-58364783d6f176ecb8520dade8d1cb1a346c0950.tar.gz
tk-58364783d6f176ecb8520dade8d1cb1a346c0950.tar.bz2
* Merged 8.1 branch into the main trunk
FossilOrigin-Name: 1120dc4257448ed1955333e682de48e2940cc741
Diffstat (limited to 'tests/winDialog.test')
-rw-r--r--tests/winDialog.test335
1 files changed, 335 insertions, 0 deletions
diff --git a/tests/winDialog.test b/tests/winDialog.test
new file mode 100644
index 0000000..64ed21b
--- /dev/null
+++ b/tests/winDialog.test
@@ -0,0 +1,335 @@
+# This file is a Tcl script to test the Windows specific behavior of
+# the common dialog boxes. It is organized in the standard
+# fashion for Tcl tests.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id: winDialog.test,v 1.2 1999/04/16 01:51:43 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+if {[info command testwinevent] == ""} {
+ puts "skipping: tests require the testwinevent command"
+ ::tcltest::cleanupTests
+ return
+}
+
+testwinevent debug 1
+
+eval destroy [winfo children .]
+wm geometry . {}
+raise .
+
+proc start {arg} {
+ set ::tk_dialog 0
+
+ after 1 "$arg"
+}
+
+proc then {cmd} {
+ set ::command $cmd
+ set ::dialogresult {}
+
+ afterbody
+ vwait ::dialogresult
+ return $::dialogresult
+}
+
+proc afterbody {} {
+ if {$::tk_dialog == 0} {
+ after 100 {afterbody}
+ return
+ }
+ uplevel #0 {set dialogresult [eval $command]}
+}
+
+proc Click {button} {
+ testwinevent $::tk_dialog $button WM_LBUTTONDOWN 1 0x000a000b
+ testwinevent $::tk_dialog $button WM_LBUTTONUP 0 0x000a000b
+}
+
+proc GetText {button} {
+ return [testwinevent $::tk_dialog $button WM_GETTEXT]
+}
+
+proc SetText {button text} {
+ return [testwinevent $::tk_dialog $button WM_SETTEXT $text]
+}
+
+test winDialog-1.1 {Tk_ChooseColorObjCmd} {nt} {
+} {}
+
+test winDialog-2.1 {ColorDlgHookProc} {nt} {
+} {}
+
+test winDialog-3.1 {Tk_GetOpenFileObjCmd} {nt} {
+ start {tk_getOpenFile}
+ then {
+ set x [GetText 2]
+ Click 2
+ }
+ set x
+} {Cancel}
+
+test winDialog-4.1 {Tk_GetSaveFileObjCmd} {nt} {
+ start {tk_getSaveFile}
+ then {
+ set x [GetText 2]
+ Click 2
+ }
+ set x
+} {Cancel}
+
+test winDialog-5.1 {GetFileName: no arguments} {nt} {
+ start {tk_getOpenFile -title Open}
+ then {
+ Click cancel
+ }
+} {0}
+test winDialog-5.2 {GetFileName: one argument} {nt} {
+ list [catch {tk_getOpenFile -foo} msg] $msg
+} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}}
+test winDialog-5.4 {GetFileName: many arguments} {nt} {
+ start {tk_getOpenFile -initialdir c:/ -parent . -title test -initialfile foo}
+ then {
+ Click cancel
+ }
+} {0}
+test winDialog-5.5 {GetFileName: Tcl_GetIndexFromObj() != TCL_OK} {nt} {
+ list [catch {tk_getOpenFile -foo bar -abc} msg] $msg
+} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}}
+test winDialog-5.6 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} {nt} {
+ start {tk_getOpenFile -title bar}
+ then {
+ Click cancel
+ }
+} {0}
+test winDialog-5.7 {GetFileName: valid option, but missing value} {nt} {
+ list [catch {tk_getOpenFile -initialdir bar -title} msg] $msg
+} {1 {value for "-title" missing}}
+test winDialog-5.8 {GetFileName: extension begins with .} {nt} {
+# if (string[0] == '.') {
+# string++;
+# }
+
+ start {set x [tk_getSaveFile -defaultextension .foo -title Save]}
+ then {
+ SetText 0x480 bar
+ Click 1
+ }
+ set x
+} [file join [pwd] bar.foo]
+test winDialog-5.9 {GetFileName: extension doesn't begin with .} {nt} {
+ start {set x [tk_getSaveFile -defaultextension foo -title Save]}
+ then {
+ SetText 0x480 bar
+ Click 1
+ }
+ set x
+} [file join [pwd] bar.foo]
+test winDialog-5.10 {GetFileName: file types} {nt} {
+# case FILE_TYPES:
+
+ start {tk_getSaveFile -filetypes {{"foo files" .foo FOOF}} -title Foo}
+ then {
+ set x [GetText 0x470]
+ Click cancel
+ }
+ set x
+} {foo files (*.foo)}
+test winDialog-5.11 {GetFileName: file types: MakeFilter() fails} {nt} {
+# if (MakeFilter(interp, string, &utfFilterString) != TCL_OK)
+
+ list [catch {tk_getSaveFile -filetypes {{"foo" .foo FOO}}} msg] $msg
+} {1 {bad Macintosh file type "FOO"}}
+test winDialog-5.12 {GetFileName: initial directory} {nt} {
+# case FILE_INITDIR:
+
+ start {set x [tk_getSaveFile -initialdir c:/ -initialfile "12x 455" -title Foo]}
+ then {
+ Click 1
+ }
+ set x
+} {C:/12x 455}
+test winDialog-5.13 {GetFileName: initial directory: Tcl_TranslateFilename()} \
+ {nt} {
+# if (Tcl_TranslateFileName(interp, string, &ds) == NULL)
+
+ list [catch {tk_getOpenFile -initialdir ~12x/455} msg] $msg
+} {1 {user "12x" doesn't exist}}
+test winDialog-5.14 {GetFileName: initial file} {nt} {
+# case FILE_INITFILE:
+
+ start {set x [tk_getSaveFile -initialfile "12x 456" -title Foo]}
+ then {
+ Click 1
+ }
+ set x
+} [file join [pwd] "12x 456"]
+test winDialog-5.15 {GetFileName: initial file: Tcl_TranslateFileName()} {nt} {
+# if (Tcl_TranslateFileName(interp, string, &ds) == NULL)
+ list [catch {tk_getOpenFile -initialfile ~12x/455} msg] $msg
+} {1 {user "12x" doesn't exist}}
+set a aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+append a $a
+append a $a
+append a $a
+append a $a
+test winDialog-5.16 {GetFileName: initial file: long name} {knownBug nt} {
+ start {set x [tk_getSaveFile -initialfile $a -title Long]}
+ then {
+ Click 1
+ }
+ set x
+} [string range [file join [pwd] $a] 0 257]
+test winDialog-5.17 {GetFileName: parent} {nt} {
+# case FILE_PARENT:
+
+ toplevel .t
+ set x 0
+ start {tk_getOpenFile -parent .t -title Parent; set x 1}
+ then {
+ destroy .t
+ }
+ set x
+} {1}
+test winDialog-5.18 {GetFileName: title} {nt} {
+# case FILE_TITLE:
+
+ start {tk_getOpenFile -title Narf}
+ then {
+ Click 2
+ }
+} {0}
+test winDialog-5.19 {GetFileName: no filter specified} {nt} {
+# if (ofn.lpstrFilter == NULL)
+
+ start {tk_getOpenFile -title Filter}
+ then {
+ set x [GetText 0x470]
+ Click 2
+ }
+ set x
+} {All Files (*.*)}
+test winDialog-5.20 {GetFileName: parent HWND doesn't yet exist} {nt} {
+# if (Tk_WindowId(parent) == None)
+
+ toplevel .t
+ start {tk_getOpenFile -parent .t -title Open}
+ then {
+ destroy .t
+ }
+} {}
+test winDialog-5.21 {GetFileName: parent HWND already exists} {nt} {
+ toplevel .t
+ update
+ start {tk_getOpenFile -parent .t -title Open}
+ then {
+ destroy .t
+ }
+} {}
+test winDialog-5.22 {GetFileName: call GetOpenFileName} {nt} {
+# winCode = GetOpenFileName(&ofn);
+
+ start {tk_getOpenFile -title Open}
+ then {
+ set x [GetText 1]
+ Click 2
+ }
+ set x
+} {&Open}
+test winDialog-5.22 {GetFileName: call GetSaveFileName} {nt} {
+# winCode = GetSaveFileName(&ofn);
+
+ start {tk_getSaveFile -title Save}
+ then {
+ set x [GetText 1]
+ Click 2
+ }
+ set x
+} {&Save}
+test winDialog-5.22 {GetFileName: convert \ to /} {nt} {
+ start {set x [tk_getSaveFile -title Back]}
+ then {
+ SetText 0x480 "c:\\12x 457"
+ Click 1
+ }
+ set x
+} {c:/12x 457}
+
+test winDialog-8.1 {OFNHookProc} {nt} {
+} {}
+
+test winDialog-6.1 {MakeFilter} {nt} {
+} {}
+
+test winDialog-5.1 {Tk_ChooseDirectoryObjCmd: no arguments} {nt} {
+ start {tk_chooseDirectory}
+ then {
+ Click cancel
+ }
+} {0}
+test winDialog-5.2 {Tk_ChooseDirectoryObjCmd: one argument} {nt} {
+ list [catch {tk_chooseDirectory -foo} msg] $msg
+} {1 {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}}
+test winDialog-5.4 {Tk_ChooseDirectoryObjCmd: many arguments} {nt} {
+ start {tk_chooseDirectory -initialdir c:/ -mustexist 1 -parent . -title test}
+ then {
+ Click cancel
+ }
+} {0}
+test winDialog-5.5 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() != TCL_OK} \
+ {nt} {
+ list [catch {tk_chooseDirectory -foo bar -abc} msg] $msg
+} {1 {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}}
+test winDialog-5.6 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() == TCL_OK} \
+ {nt} {
+ start {tk_chooseDirectory -title bar}
+ then {
+ Click cancel
+ }
+} {0}
+test winDialog-5.7 {Tk_ChooseDirectoryObjCmd: valid option, but missing value} \
+ {nt} {
+ list [catch {tk_chooseDirectory -initialdir bar -title} msg] $msg
+} {1 {value for "-title" missing}}
+test winDialog-5.12 {Tk_ChooseDirectoryObjCmd: initial directory} {nt} {
+# case DIR_INITIAL:
+
+ start {set x [tk_chooseDirectory -initialdir c:/ -title Foo]}
+ then {
+ Click 1
+ }
+ string tolower [set x]
+} {c:/}
+test winDialog-5.13 \
+ {Tk_ChooseDirectoryObjCmd: initial directory: Tcl_TranslateFilename()} \
+ {nt} {
+# if (Tcl_TranslateFileName(interp, string,
+# &utfDirString) == NULL)
+
+ list [catch {tk_chooseDirectory -initialdir ~12x/455} msg] $msg
+} {1 {user "12x" doesn't exist}}
+
+test winDialog-7.1 {Tk_MessageBoxObjCmd} {emptyTest nt} {} {}
+
+testwinevent debug 0
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+