summaryrefslogtreecommitdiffstats
path: root/tests/winDialog.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/winDialog.test')
-rw-r--r--tests/winDialog.test159
1 files changed, 108 insertions, 51 deletions
diff --git a/tests/winDialog.test b/tests/winDialog.test
index 8aa9ac3..fc1114a 100644
--- a/tests/winDialog.test
+++ b/tests/winDialog.test
@@ -22,9 +22,25 @@ testConstraint english [expr {
&& (([testwinlocale] & 0xff) == 9)
}]
+proc vista? {{prevista 0} {postvista 1}} {
+ lassign [split $::tcl_platform(osVersion) .] major
+ return [expr {$major >= 6 ? $postvista : $prevista}]
+}
+
+# What directory to use in initialdir tests. Old code used to use
+# c:/. However, on Vista/later that is a protected directory if you
+# are not running privileged. Moreover, not everyone has a drive c:
+# but not having a TEMP would break a lot Windows programs
+proc initialdir {} {
+ # file join to return in Tcl canonical format (/ separator, not \)
+ return [file join $::env(TEMP)]
+}
+
+
proc start {arg} {
set ::tk_dialog 0
set ::iter_after 0
+ set ::dialogclass "#32770"
after 1 $arg
}
@@ -34,19 +50,35 @@ proc then {cmd} {
set ::dialogresult {}
set ::testfont {}
- afterbody
+ # Do not make the delay too short. The newer Vista dialogs take
+ # time to come up. Even if the testforwindow returns true, the
+ # controls are not ready to accept messages
+ after 500 afterbody
vwait ::dialogresult
return $::dialogresult
}
proc afterbody {} {
- if {$::tk_dialog == 0} {
- if {[incr ::iter_after] > 30} {
- set ::dialogresult ">30 iterations waiting on tk_dialog"
+ # On Vista and later, using the new file dialogs we have to find
+ # the window using its title as tk_dialog will not be set at the C level
+ if {[vista?]} {
+ if {[catch {testfindwindow "" $::dialogclass} ::tk_dialog]} {
+ if {[incr ::iter_after] > 30} {
+ set ::dialogresult ">30 iterations waiting on tk_dialog"
+ return
+ }
+ after 150 {afterbody}
+ return
+ }
+ } else {
+ if {$::tk_dialog == 0} {
+ if {[incr ::iter_after] > 30} {
+ set ::dialogresult ">30 iterations waiting on tk_dialog"
+ return
+ }
+ after 150 {afterbody}
return
}
- after 150 {afterbody}
- return
}
uplevel #0 {set dialogresult [eval $command]}
}
@@ -205,7 +237,7 @@ test winDialog-5.2 {GetFileName: one argument} -constraints {
test winDialog-5.3 {GetFileName: many arguments} -constraints {
nt testwinevent
} -body {
- start {tk_getOpenFile -initialdir c:/ -parent . -title test -initialfile foo}
+ start {tk_getOpenFile -initialdir [initialdir] -parent . -title test -initialfile foo}
then {
Click cancel
}
@@ -238,7 +270,7 @@ test winDialog-5.7 {GetFileName: extension begins with .} -constraints {
start {set x [tk_getSaveFile -defaultextension .foo -title Save]}
set msg {}
then {
- if {[catch {SetText 0x47C bar} msg]} {
+ if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} {
Click cancel
} else {
Click ok
@@ -254,7 +286,7 @@ test winDialog-5.8 {GetFileName: extension doesn't begin with .} -constraints {
start {set x [tk_getSaveFile -defaultextension foo -title Save]}
set msg {}
then {
- if {[catch {SetText 0x47C bar} msg]} {
+ if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} {
Click cancel
} else {
Click ok
@@ -264,18 +296,23 @@ test winDialog-5.8 {GetFileName: extension doesn't begin with .} -constraints {
} -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
- }
- return $x
-} -result {foo files (*.foo)}
+if {![vista?]} {
+ # XXX - currently disabled for vista style dialogs because the file
+ # types control has no control ID and we don't have a mechanism to
+ # locate it.
+ 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
+ }
+ return $x
+ } -result {foo files (*.foo)}
+}
test winDialog-5.10 {GetFileName: file types: MakeFilter() fails} -constraints {
nt
} -body {
@@ -288,7 +325,7 @@ test winDialog-5.11 {GetFileName: initial directory} -constraints {
nt testwinevent
} -body {
# case FILE_INITDIR:
-
+ unset -nocomplain x
start {set x [tk_getSaveFile \
-initialdir [file normalize $::env(TEMP)] \
-initialfile "12x 455" -title Foo]}
@@ -322,19 +359,23 @@ test winDialog-5.14 {GetFileName: initial file: Tcl_TranslateFileName()} -constr
# 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 ok
- }
- list $dialogresult [string match "invalid filename *" $x]
-} -result {1 1}
+if {![vista?]} {
+ # XXX - disabled for Vista because the new dialogs allow long file
+ # names to be specified but force the user to change it.
+ 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 ok
+ }
+ list $dialogresult [string match "invalid filename *" $x]
+ } -result {1 1}
+}
test winDialog-5.16 {GetFileName: parent} -constraints {
nt
} -body {
@@ -358,18 +399,34 @@ test winDialog-5.17 {GetFileName: title} -constraints {
Click cancel
}
} -result {0}
-test winDialog-5.18 {GetFileName: no filter specified} -constraints {
- nt testwinevent
-} -body {
-# if (ofn.lpstrFilter == NULL)
-
- start {tk_getOpenFile -title Filter}
- then {
- set x [GetText 0x470]
- Click cancel
- }
- return $x
-} -result {All Files (*.*)}
+if {[vista?]} {
+ # In the newer file dialogs, the file type widget does not even exist
+ # if no file types specified
+ test winDialog-5.18 {GetFileName: no filter specified} -constraints {
+ nt testwinevent
+ } -body {
+ # if (ofn.lpstrFilter == NULL)
+ start {tk_getOpenFile -title Filter}
+ then {
+ catch {set x [GetText 0x470]} y
+ Click cancel
+ }
+ return $y
+ } -result {Could not find control with id 1136}
+} else {
+ test winDialog-5.18 {GetFileName: no filter specified} -constraints {
+ nt testwinevent
+ } -body {
+ # if (ofn.lpstrFilter == NULL)
+
+ start {tk_getOpenFile -title Filter}
+ then {
+ set x [GetText 0x470]
+ Click cancel
+ }
+ return $x
+ } -result {All Files (*.*)}
+}
test winDialog-5.19 {GetFileName: parent HWND doesn't yet exist} -constraints {
nt
} -setup {
@@ -426,7 +483,7 @@ test winDialog-5.23 {GetFileName: convert \ to /} -constraints {
set msg {}
start {set x [tk_getSaveFile -title Back]}
then {
- if {[catch {SetText 0x47C [file nativename \
+ if {[catch {SetText [vista? 0x47C 0x3e9] [file nativename \
[file join [file normalize $::env(TEMP)] "12x 457"]]} msg]} {
Click cancel
} else {
@@ -492,7 +549,7 @@ test winDialog-9.3 {Tk_ChooseDirectoryObjCmd: many arguments} -constraints {
nt testwinevent
} -body {
start {
- tk_chooseDirectory -initialdir c:/ -mustexist 1 -parent . -title test
+ tk_chooseDirectory -initialdir [initialdir] -mustexist 1 -parent . -title test
}
then {
Click cancel
@@ -521,12 +578,12 @@ test winDialog-9.7 {Tk_ChooseDirectoryObjCmd: -initialdir} -constraints {
} -body {
# case DIR_INITIAL:
- start {set x [tk_chooseDirectory -initialdir c:/ -title Foo]}
+ start {set x [tk_chooseDirectory -initialdir [initialdir] -title Foo]}
then {
Click ok
}
string tolower [set x]
-} -result {c:/}
+} -result [initialdir]
test winDialog-9.8 {Tk_ChooseDirectoryObjCmd: initial directory: Tcl_TranslateFilename()} -constraints {
nt
} -body {
generated by cgit v0.12 at 2024-11-18 12:53:01 (GMT)