summaryrefslogtreecommitdiffstats
path: root/tests/winDialog.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/winDialog.test')
-rw-r--r--tests/winDialog.test373
1 files changed, 229 insertions, 144 deletions
diff --git a/tests/winDialog.test b/tests/winDialog.test
index e7d175f..6b55c3d 100644
--- a/tests/winDialog.test
+++ b/tests/winDialog.test
@@ -15,7 +15,9 @@ tcltest::loadTestedCommands
testConstraint testwinevent [llength [info commands testwinevent]]
-catch {testwinevent debug 1}
+if {[testConstraint testwinevent]} {
+ catch {testwinevent debug 1}
+}
proc start {arg} {
set ::tk_dialog 0
@@ -58,134 +60,179 @@ 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 testwinevent} {
+test winDialog-3.1 {Tk_GetOpenFileObjCmd} -constraints {
+ nt testwinevent
+} -body {
start {tk_getOpenFile}
then {
set x [GetText 2]
Click 2
}
- set x
-} {Cancel}
+ return $x
+} -result {Cancel}
+
-test winDialog-4.1 {Tk_GetSaveFileObjCmd} {nt testwinevent} {
+test winDialog-4.1 {Tk_GetSaveFileObjCmd} -constraints {
+ nt testwinevent
+} -body {
start {tk_getSaveFile}
then {
set x [GetText 2]
Click 2
}
- set x
-} {Cancel}
+ return $x
+} -result {Cancel}
-test winDialog-5.1 {GetFileName: no arguments} {nt testwinevent} {
+test winDialog-5.1 {GetFileName: no arguments} -constraints {
+ nt testwinevent
+} -body {
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, -multiple, -parent, or -title}}
-test winDialog-5.4 {GetFileName: many arguments} {nt testwinevent} {
+} -result {0}
+test winDialog-5.2 {GetFileName: one argument} -constraints {
+ nt
+} -body {
+ tk_getOpenFile -foo
+} -returnCodes error -result {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, or -title}
+test winDialog-5.3 {GetFileName: many arguments} -constraints {
+ nt testwinevent
+} -body {
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, -multiple, -parent, or -title}}
-test winDialog-5.6 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} {nt testwinevent} {
+} -result {0}
+test winDialog-5.4 {GetFileName: Tcl_GetIndexFromObj() != TCL_OK} -constraints {
+ nt
+} -body {
+ tk_getOpenFile -foo bar -abc
+} -returnCodes error -result {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, or -title}
+test winDialog-5.5 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} -constraints {
+ nt testwinevent
+} -body {
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 testwinevent} {
+} -result {0}
+test winDialog-5.6 {GetFileName: valid option, but missing value} -constraints {
+ nt
+} -body {
+ tk_getOpenFile -initialdir bar -title
+} -returnCodes error -result {value for "-title" missing}
+test winDialog-5.7 {GetFileName: extension begins with .} -constraints {
+ nt testwinevent
+} -body {
# if (string[0] == '.') {
# string++;
# }
start {set x [tk_getSaveFile -defaultextension .foo -title Save]}
+ set msg {}
then {
- SetText 0x480 bar
- Click 1
+ if {[catch {SetText 0x47C bar} msg]} {
+ Click 2
+ } else {
+ Click 1
+ }
}
- string totitle $x
-} [string totitle [file join [pwd] bar.foo]]
-test winDialog-5.9 {GetFileName: extension doesn't begin with .} {nt testwinevent} {
+ return [string totitle $x]$msg
+} -cleanup {
+ unset msg
+} -result [string totitle [file join [pwd] bar.foo]]
+test winDialog-5.8 {GetFileName: extension doesn't begin with .} -constraints {
+ nt testwinevent
+} -body {
start {set x [tk_getSaveFile -defaultextension foo -title Save]}
+ set msg {}
then {
- SetText 0x480 bar
- Click 1
+ if {[catch {SetText 0x47C bar} msg]} {
+ Click 2
+ } else {
+ Click 1
+ }
}
- string totitle $x
-} [string totitle [file join [pwd] bar.foo]]
-test winDialog-5.10 {GetFileName: file types} {nt testwinevent} {
-# case FILE_TYPES:
+ return [string totitle $x]$msg
+} -cleanup {
+ unset msg
+} -result [string totitle [file join [pwd] bar.foo]]
+test winDialog-5.9 {GetFileName: file types} -constraints {
+ nt testwinevent
+} -body {
+# 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 testwinevent} {
-# case FILE_INITDIR:
-
- start {set x [tk_getSaveFile -initialdir c:/ -initialfile "12x 455" -title Foo]}
+ return $x
+} -result {foo files (*.foo)}
+test winDialog-5.10 {GetFileName: file types: MakeFilter() fails} -constraints {
+ nt
+} -body {
+# if (MakeFilter(interp, string, &utfFilterString) != TCL_OK)
+
+ tk_getSaveFile -filetypes {{"foo" .foo FOO}}
+} -returnCodes error -result {bad Macintosh file type "FOO"}
+if {[info exists ::env(TEMP)]} {
+test winDialog-5.11 {GetFileName: initial directory} -constraints {
+ nt testwinevent
+} -body {
+# case FILE_INITDIR:
+
+ start {set x [tk_getSaveFile \
+ -initialdir [file normalize $::env(TEMP)] \
+ -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 testwinevent} {
-# case FILE_INITFILE:
+ return $x
+} -result [file join [file normalize $::env(TEMP)] "12x 455"]
+}
+test winDialog-5.12 {GetFileName: initial directory: Tcl_TranslateFilename()} -constraints {
+ nt
+} -body {
+# if (Tcl_TranslateFileName(interp, string, &ds) == NULL)
+
+ tk_getOpenFile -initialdir ~12x/455
+} -returnCodes error -result {user "12x" doesn't exist}
+test winDialog-5.13 {GetFileName: initial file} -constraints {
+ nt testwinevent
+} -body {
+# case FILE_INITFILE:
start {set x [tk_getSaveFile -initialfile "12x 456" -title Foo]}
then {
Click 1
}
string totitle $x
-} [string totitle [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} {nt testwinevent} {
- start {set x [tk_getSaveFile -initialfile $a -title Long]}
+} -result [string totitle [file join [pwd] "12x 456"]]
+test winDialog-5.14 {GetFileName: initial file: Tcl_TranslateFileName()} -constraints {
+ nt
+} -body {
+# if (Tcl_TranslateFileName(interp, string, &ds) == NULL)
+ tk_getOpenFile -initialfile ~12x/455
+} -returnCodes error -result {user "12x" doesn't exist}
+test winDialog-5.15 {GetFileName: initial file: long name} -constraints {
+ nt testwinevent
+} -body {
+ start {
+ set dialogresult [catch {
+ tk_getSaveFile -initialfile [string repeat a 1024] -title Long
+ } x]
+ }
then {
Click 1
}
- string totitle $x
-} [string totitle [string range [file join [pwd] $a] 0 257]]
-test winDialog-5.17 {GetFileName: parent} {nt} {
-# case FILE_PARENT:
+ list $dialogresult [string match "invalid filename *" $x]
+} -result {1 1}
+test winDialog-5.16 {GetFileName: parent} -constraints {
+ nt
+} -body {
+# case FILE_PARENT:
toplevel .t
set x 0
@@ -193,133 +240,171 @@ test winDialog-5.17 {GetFileName: parent} {nt} {
then {
destroy .t
}
- set x
-} {1}
-test winDialog-5.18 {GetFileName: title} {nt testwinevent} {
-# case FILE_TITLE:
-
+ return $x
+} -result {1}
+test winDialog-5.17 {GetFileName: title} -constraints {
+ nt testwinevent
+} -body {
+# case FILE_TITLE:
+
start {tk_getOpenFile -title Narf}
then {
Click 2
}
-} {0}
-test winDialog-5.19 {GetFileName: no filter specified} {nt testwinevent} {
-# if (ofn.lpstrFilter == NULL)
+} -result {0}
+test winDialog-5.18 {GetFileName: no filter specified} -constraints {
+ nt testwinevent
+} -body {
+# if (ofn.lpstrFilter == NULL)
- start {tk_getOpenFile -title Filter}
+ 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)
+ return $x
+} -result {All Files (*.*)}
+test winDialog-5.19 {GetFileName: parent HWND doesn't yet exist} -constraints {
+ nt
+} -setup {
+ destroy .t
+} -body {
+# 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} {
+} -result {}
+test winDialog-5.20 {GetFileName: parent HWND already exists} -constraints {
+ nt
+} -setup {
+ destroy .t
+} -body {
toplevel .t
update
start {tk_getOpenFile -parent .t -title Open}
then {
destroy .t
}
-} {}
-test winDialog-5.22 {GetFileName: call GetOpenFileName} {nt testwinevent} {
-# winCode = GetOpenFileName(&ofn);
-
+} -result {}
+test winDialog-5.21 {GetFileName: call GetOpenFileName} -constraints {
+ nt testwinevent
+} -body {
+# winCode = GetOpenFileName(&ofn);
+
start {tk_getOpenFile -title Open}
then {
set x [GetText 1]
Click 2
}
- set x
-} {&Open}
-test winDialog-5.23 {GetFileName: call GetSaveFileName} {nt testwinevent} {
-# winCode = GetSaveFileName(&ofn);
+ return $x
+} -result {&Open}
+test winDialog-5.22 {GetFileName: call GetSaveFileName} -constraints {
+ nt testwinevent
+} -body {
+# winCode = GetSaveFileName(&ofn);
start {tk_getSaveFile -title Save}
then {
set x [GetText 1]
Click 2
}
- set x
-} {&Save}
-test winDialog-5.24 {GetFileName: convert \ to /} {nt testwinevent} {
+ return $x
+} -result {&Save}
+if {[info exists ::env(TEMP)]} {
+test winDialog-5.23 {GetFileName: convert \ to /} -constraints {
+ nt testwinevent
+} -body {
+ set msg {}
start {set x [tk_getSaveFile -title Back]}
then {
- SetText 0x480 "c:\\12x 457"
- Click 1
+ if {[catch {SetText 0x47C [file nativename \
+ [file join [file normalize $::env(TEMP)] "12x 457"]]} msg]} {
+ Click 2
+ } else {
+ Click 1
+ }
}
- set x
-} {c:/12x 457}
-
-test winDialog-6.1 {MakeFilter} {emptyTest nt} {} {}
-
-test winDialog-7.1 {Tk_MessageBoxObjCmd} {emptyTest nt} {} {}
-
-test winDialog-8.1 {OFNHookProc} {emptyTest nt} {} {}
-
+ return $x$msg
+} -cleanup {
+ unset msg
+} -result [file join [file normalize $::env(TEMP)] "12x 457"]
+}
## The Tk_ChooseDirectoryObjCmd hang on the static build of Windows
## because somehow the GetOpenFileName ends up a noop in the static
## build.
##
-test winDialog-9.1 {Tk_ChooseDirectoryObjCmd: no arguments} {nt testwinevent} {
+test winDialog-9.1 {Tk_ChooseDirectoryObjCmd: no arguments} -constraints {
+ nt testwinevent
+} -body {
start {tk_chooseDirectory}
then {
Click cancel
}
-} {0}
-test winDialog-9.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-9.3 {Tk_ChooseDirectoryObjCmd: many arguments} {nt testwinevent} {
+} -result {0}
+test winDialog-9.2 {Tk_ChooseDirectoryObjCmd: one argument} -constraints {
+ nt
+} -body {
+ tk_chooseDirectory -foo
+} -returnCodes error -result {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}
+test winDialog-9.3 {Tk_ChooseDirectoryObjCmd: many arguments} -constraints {
+ nt testwinevent
+} -body {
start {
tk_chooseDirectory -initialdir c:/ -mustexist 1 -parent . -title test
}
then {
Click cancel
}
-} {0}
-test winDialog-9.4 {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-9.5 {Tk_ChooseDirectoryObjCmd:\
- Tcl_GetIndexFromObj() == TCL_OK} {nt testwinevent} {
+} -result {0}
+test winDialog-9.4 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() != TCL_OK} -constraints {
+ nt
+} -body {
+ tk_chooseDirectory -foo bar -abc
+} -returnCodes error -result {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}
+test winDialog-9.5 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() == TCL_OK} -constraints {
+ nt testwinevent
+} -body {
start {tk_chooseDirectory -title bar}
then {
Click cancel
}
-} {0}
-test winDialog-9.6 {Tk_ChooseDirectoryObjCmd:\
- valid option, but missing value} {nt} {
- list [catch {tk_chooseDirectory -initialdir bar -title} msg] $msg
-} {1 {value for "-title" missing}}
-test winDialog-9.7 {Tk_ChooseDirectoryObjCmd: -initialdir} {nt testwinevent} {
-# case DIR_INITIAL:
+} -result {0}
+test winDialog-9.6 {Tk_ChooseDirectoryObjCmd: valid option, but missing value} -constraints {
+ nt
+} -body {
+ tk_chooseDirectory -initialdir bar -title
+} -returnCodes error -result {value for "-title" missing}
+test winDialog-9.7 {Tk_ChooseDirectoryObjCmd: -initialdir} -constraints {
+ nt testwinevent
+} -body {
+# case DIR_INITIAL:
start {set x [tk_chooseDirectory -initialdir c:/ -title Foo]}
then {
Click 1
}
string tolower [set x]
-} {c:/}
-test winDialog-9.8 {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}}
-
-catch {testwinevent debug 0}
+} -result {c:/}
+test winDialog-9.8 {Tk_ChooseDirectoryObjCmd: initial directory: Tcl_TranslateFilename()} -constraints {
+ nt
+} -body {
+# if (Tcl_TranslateFileName(interp, string,
+# &utfDirString) == NULL)
+
+ tk_chooseDirectory -initialdir ~12x/455
+} -returnCodes error -result {user "12x" doesn't exist}
+
+if {[testConstraint testwinevent]} {
+ catch {testwinevent debug 0}
+}
# cleanup
::tcltest::cleanupTests
return
+
+# Local variables:
+# mode: tcl
+# End: