diff options
-rw-r--r-- | ChangeLog | 5 | ||||
-rw-r--r-- | tests/winDialog.test | 81 | ||||
-rw-r--r-- | win/tkWinTest.c | 27 |
3 files changed, 78 insertions, 35 deletions
@@ -1,3 +1,8 @@ +2009-11-13 Pat Thoyts <patthoyts@users.sourceforge.net> + + * tests/winDialog.test: Backported fix for running dialog tests + * win/tkWinTest.c: on non-English locales [Bug 2307837] + 2009-11-12 Don Porter <dgp@users.sourceforge.net> *** 8.5.8 TAGGED FOR RELEASE *** diff --git a/tests/winDialog.test b/tests/winDialog.test index b147210..b9e8eb3 100644 --- a/tests/winDialog.test +++ b/tests/winDialog.test @@ -7,7 +7,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # Copyright (c) 1998-1999 ActiveState Corporation. # -# RCS: @(#) $Id: winDialog.test,v 1.15.2.2 2008/11/12 22:35:14 patthoyts Exp $ +# RCS: @(#) $Id: winDialog.test,v 1.15.2.3 2009/11/13 23:32:05 patthoyts Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -17,6 +17,12 @@ if {[testConstraint testwinevent]} { catch {testwinevent debug 1} } +# Locale identifier LANG_ENGLISH is 0x09 +testConstraint english [expr { + [llength [info commands testwinlocale]] + && (([testwinlocale] & 0xff) == 9) +}] + proc start {arg} { set ::tk_dialog 0 set ::iter_after 0 @@ -46,16 +52,24 @@ proc afterbody {} { } proc Click {button} { + switch -exact -- $button { + ok { set button 1 } + cancel { set button 2 } + } 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 GetText {id} { + switch -exact -- $id { + ok { set id 1 } + cancel { set id 2 } + } + return [testwinevent $::tk_dialog $id WM_GETTEXT] } -proc SetText {button text} { - return [testwinevent $::tk_dialog $button WM_SETTEXT $text] +proc SetText {id text} { + return [testwinevent $::tk_dialog $id WM_SETTEXT $text] } test winDialog-1.1.0 {Tk_ChooseColorObjCmd} -constraints { @@ -80,7 +94,7 @@ test winDialog-1.1.2 {Tk_ChooseColorObjCmd} -constraints { } -body { start {set clr [tk_chooseColor -initialcolor "#ff9933"]} then { - set x [Click 1] + set x [Click ok] } list $x $clr } -result [list 0 "#ff9933"] @@ -94,7 +108,7 @@ test winDialog-1.1.3 {Tk_ChooseColorObjCmd: -title} -constraints { array set a [testgetwindowinfo $::tk_dialog] if {[info exists a(text)]} {lappend x $a(text)} } err]} { lappend x $err } - lappend x [Click 1] + lappend x [Click ok] } lappend x $clr } -result [list Hello 0 "#ff9933"] @@ -111,7 +125,7 @@ test winDialog-1.1.4 {Tk_ChooseColorObjCmd: -title} -constraints { array set a [testgetwindowinfo $::tk_dialog] if {[info exists a(text)]} {lappend x $a(text)} } err]} { lappend x $err } - lappend x [Click 1] + lappend x [Click ok] } lappend x $clr } -result [list "\u041f\u0440\u0438\u0432\u0435\u0442" 0 "#ff9933"] @@ -127,7 +141,7 @@ test winDialog-1.1.5 {Tk_ChooseColorObjCmd: -parent} -constraints { append x [expr {$a(parent) == [wm frame .]}] } } err]} {lappend x $err} - Click 1 + Click ok } list $x $clr } -result [list 1 "#ff9933"] @@ -140,20 +154,20 @@ test winDialog-1.1.6 {Tk_ChooseColorObjCmd: -parent} -constraints { test winDialog-2.1 {ColorDlgHookProc} {emptyTest nt} { } {} -test winDialog-3.1 {Tk_GetOpenFileObjCmd} {nt testwinevent} { +test winDialog-3.1 {Tk_GetOpenFileObjCmd} {nt testwinevent english} { start {tk_getOpenFile} then { - set x [GetText 2] - Click 2 + set x [GetText cancel] + Click cancel } set x } {Cancel} -test winDialog-4.1 {Tk_GetSaveFileObjCmd} {nt testwinevent} { +test winDialog-4.1 {Tk_GetSaveFileObjCmd} {nt testwinevent english} { start {tk_getSaveFile} then { - set x [GetText 2] - Click 2 + set x [GetText cancel] + Click cancel } set x } {Cancel} @@ -193,7 +207,7 @@ test winDialog-5.8 {GetFileName: extension begins with .} {nt testwinevent} { start {set x [tk_getSaveFile -defaultextension .foo -title Save]} then { SetText 0x480 bar - Click 1 + Click ok } string totitle $x } [string totitle [file join [pwd] bar.foo]] @@ -201,7 +215,7 @@ test winDialog-5.9 {GetFileName: extension doesn't begin with .} {nt testwineven start {set x [tk_getSaveFile -defaultextension foo -title Save]} then { SetText 0x480 bar - Click 1 + Click ok } string totitle $x } [string totitle [file join [pwd] bar.foo]] @@ -228,7 +242,7 @@ test winDialog-5.12 {GetFileName: initial directory} {nt testwinevent} { -initialdir [file normalize $::env(TEMP)] \ -initialfile "12x 455" -title Foo]} then { - Click 1 + Click ok } set x } [file join [file normalize $::env(TEMP)] "12x 455"] @@ -244,7 +258,7 @@ test winDialog-5.14 {GetFileName: initial file} {nt testwinevent} { start {set x [tk_getSaveFile -initialfile "12x 456" -title Foo]} then { - Click 1 + Click ok } string totitle $x } [string totitle [file join [pwd] "12x 456"]] @@ -259,7 +273,7 @@ test winDialog-5.16 {GetFileName: initial file: long name} {nt testwinevent} { } x] } then { - Click 1 + Click ok } list $dialogresult [string match "invalid filename *" $x] } {1 1} @@ -279,7 +293,7 @@ test winDialog-5.18 {GetFileName: title} {nt testwinevent} { start {tk_getOpenFile -title Narf} then { - Click 2 + Click cancel } } {0} test winDialog-5.19 {GetFileName: no filter specified} {nt testwinevent} { @@ -288,7 +302,7 @@ test winDialog-5.19 {GetFileName: no filter specified} {nt testwinevent} { start {tk_getOpenFile -title Filter} then { set x [GetText 0x470] - Click 2 + Click cancel } set x } {All Files (*.*)} @@ -309,23 +323,23 @@ test winDialog-5.21 {GetFileName: parent HWND already exists} {nt} { destroy .t } } {} -test winDialog-5.22 {GetFileName: call GetOpenFileName} {nt testwinevent} { +test winDialog-5.22 {GetFileName: call GetOpenFileName} {nt testwinevent english} { # winCode = GetOpenFileName(&ofn); start {tk_getOpenFile -title Open} then { - set x [GetText 1] - Click 2 + set x [GetText ok] + Click cancel } set x } {&Open} -test winDialog-5.23 {GetFileName: call GetSaveFileName} {nt testwinevent} { +test winDialog-5.23 {GetFileName: call GetSaveFileName} {nt testwinevent english} { # winCode = GetSaveFileName(&ofn); start {tk_getSaveFile -title Save} then { - set x [GetText 1] - Click 2 + set x [GetText ok] + Click cancel } set x } {&Save} @@ -333,8 +347,9 @@ if {[info exists ::env(TEMP)]} { test winDialog-5.24 {GetFileName: convert \ to /} {nt testwinevent} { start {set x [tk_getSaveFile -title Back]} then { - SetText 0x480 "$::env(TEMP)\\12x 457" - Click 1 + SetText 0x480 [file nativename \ + [file join [file normalize $::env(TEMP)] "12x 457"]] + Click ok } set x } [file join [file normalize $::env(TEMP)] "12x 457"] @@ -344,7 +359,7 @@ test winDialog-5.25 {GetFileName: file types: MakeFilter() succeeds} {nt} { start {set x [catch {tk_getSaveFile -filetypes {{"foo" .foo {\0\0\0\0}}}}]} then { - Click 2 + Click cancel } set x } {0} @@ -353,7 +368,7 @@ test winDialog-5.26 {GetFileName: file types: MakeFilter() succeeds} {nt} { start {set x [catch {tk_getSaveFile -filetypes {{"foo" .foo {\u2022\u2022\u2022\u2022}}}}]} then { - Click 2 + Click cancel } set x } {0} @@ -405,7 +420,7 @@ test winDialog-9.7 {Tk_ChooseDirectoryObjCmd: -initialdir} {nt testwinevent} { start {set x [tk_chooseDirectory -initialdir c:/ -title Foo]} then { - Click 1 + Click ok } string tolower [set x] } {c:/} diff --git a/win/tkWinTest.c b/win/tkWinTest.c index 95b5336..1131f8d 100644 --- a/win/tkWinTest.c +++ b/win/tkWinTest.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinTest.c,v 1.14.2.1 2008/04/14 20:59:51 patthoyts Exp $ + * RCS: @(#) $Id: tkWinTest.c,v 1.14.2.2 2009/11/13 23:32:05 patthoyts Exp $ */ #include "tkWinInt.h" @@ -33,6 +33,9 @@ static int TestfindwindowObjCmd(ClientData clientData, static int TestgetwindowinfoObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); +static int TestwinlocaleObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); MODULE_SCOPE int TkplatformtestInit(Tcl_Interp *interp); @@ -69,7 +72,8 @@ TkplatformtestInit( (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateObjCommand(interp, "testgetwindowinfo", TestgetwindowinfoObjCmd, (ClientData) Tk_MainWindow(interp), NULL); - + Tcl_CreateObjCommand(interp, "testwinlocale", TestwinlocaleObjCmd, + (ClientData) Tk_MainWindow(interp), NULL); return TCL_OK; } @@ -306,6 +310,8 @@ TestwineventCmd( child = GetWindow(child, GW_HWNDNEXT); } if (child == NULL) { + Tcl_AppendResult(interp, "could not find a control matching \"", + argv[2], "\"", NULL); return TCL_ERROR; } } @@ -479,6 +485,23 @@ TestgetwindowinfoObjCmd( return TCL_OK; } +static int +TestwinlocaleObjCmd( + ClientData clientData, /* Main window for application. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument values. */ +{ + Tk_Window tkwin = (Tk_Window) clientData; + + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, NULL); + return TCL_ERROR; + } + Tcl_SetObjResult(interp, Tcl_NewIntObj((int)GetSystemDefaultLCID())); + return TCL_OK; +} + /* * Local Variables: * mode: c |