* Merged 8.1 branch into the main trunk

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
+
+
+
+
+
+
+
+
+
+
+