From 8abce765a23aeab6da65eb01c031eead588cba12 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 5 Nov 2012 18:49:25 +0000 Subject: Release branch for Tk 8.5.13. --- README | 2 +- generic/tk.h | 4 ++-- library/tk.tcl | 2 +- unix/configure | 14 +++++++------- unix/configure.in | 2 +- unix/tk.spec | 2 +- win/configure | 2 +- win/configure.in | 2 +- 8 files changed, 15 insertions(+), 15 deletions(-) diff --git a/README b/README index 62d945b..6b589d2 100644 --- a/README +++ b/README @@ -1,5 +1,5 @@ README: Tk - This is the Tk 8.5.12 source distribution. + This is the Tk 8.5.13 source distribution. http://tcl.sourceforge.net/ You can get any source release of Tcl from the file distributions link at the above URL. diff --git a/generic/tk.h b/generic/tk.h index 5ebe71d..8c13df2 100644 --- a/generic/tk.h +++ b/generic/tk.h @@ -51,10 +51,10 @@ extern "C" { #define TK_MAJOR_VERSION 8 #define TK_MINOR_VERSION 5 #define TK_RELEASE_LEVEL TCL_FINAL_RELEASE -#define TK_RELEASE_SERIAL 12 +#define TK_RELEASE_SERIAL 13 #define TK_VERSION "8.5" -#define TK_PATCH_LEVEL "8.5.12" +#define TK_PATCH_LEVEL "8.5.13" /* * A special definition used to allow this header file to be included from diff --git a/library/tk.tcl b/library/tk.tcl index 99ab97b..8d6f0f9 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -15,7 +15,7 @@ package require Tcl 8.5 ;# Guard against [source] in an 8.4- interp before # Insist on running with compatible version of Tcl package require Tcl 8.5.0 # Verify that we have Tk binary and script components from the same release -package require -exact Tk 8.5.12 +package require -exact Tk 8.5.13 # Create a ::tk namespace namespace eval ::tk { diff --git a/unix/configure b/unix/configure index dfacc6b..cc918fa 100755 --- a/unix/configure +++ b/unix/configure @@ -1338,7 +1338,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu TK_VERSION=8.5 TK_MAJOR_VERSION=8 TK_MINOR_VERSION=5 -TK_PATCH_LEVEL=".12" +TK_PATCH_LEVEL=".13" VERSION=${TK_VERSION} LOCALES="cs da de el en en_gb eo es fr hu it nl pl pt ru sv" @@ -10106,7 +10106,7 @@ ac_x_header_dirs=' /usr/openwin/share/include' if test "$ac_x_includes" = no; then - # Guess where to find include files, by looking for Intrinsic.h. + # Guess where to find include files, by looking for Xlib.h. # First, try using that file with no special directory specified. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -10114,7 +10114,7 @@ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -#include +#include _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 @@ -10141,7 +10141,7 @@ else sed 's/^/| /' conftest.$ac_ext >&5 for ac_dir in $ac_x_header_dirs; do - if test -r "$ac_dir/X11/Intrinsic.h"; then + if test -r "$ac_dir/X11/Xlib.h"; then ac_x_includes=$ac_dir break fi @@ -10155,18 +10155,18 @@ if test "$ac_x_libraries" = no; then # See if we find them without any special options. # Don't add to $LIBS permanently. ac_save_LIBS=$LIBS - LIBS="-lXt $LIBS" + LIBS="-lX11 $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -#include +#include int main () { -XtMalloc (0) +XrmInitialize () ; return 0; } diff --git a/unix/configure.in b/unix/configure.in index 8595421..d052675 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -25,7 +25,7 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [ TK_VERSION=8.5 TK_MAJOR_VERSION=8 TK_MINOR_VERSION=5 -TK_PATCH_LEVEL=".12" +TK_PATCH_LEVEL=".13" VERSION=${TK_VERSION} LOCALES="cs da de el en en_gb eo es fr hu it nl pl pt ru sv" diff --git a/unix/tk.spec b/unix/tk.spec index df3b965..ecf17c4 100644 --- a/unix/tk.spec +++ b/unix/tk.spec @@ -4,7 +4,7 @@ Name: tk Summary: Tk graphical toolkit for the Tcl scripting language. -Version: 8.5.12 +Version: 8.5.13 Release: 2 License: BSD Group: Development/Languages diff --git a/win/configure b/win/configure index dedbedb..5cc7819 100755 --- a/win/configure +++ b/win/configure @@ -1311,7 +1311,7 @@ SHELL=/bin/sh TK_VERSION=8.5 TK_MAJOR_VERSION=8 TK_MINOR_VERSION=5 -TK_PATCH_LEVEL=".12" +TK_PATCH_LEVEL=".13" VER=$TK_MAJOR_VERSION$TK_MINOR_VERSION #------------------------------------------------------------------------ diff --git a/win/configure.in b/win/configure.in index 1d0ab37..ef517e6 100644 --- a/win/configure.in +++ b/win/configure.in @@ -14,7 +14,7 @@ SHELL=/bin/sh TK_VERSION=8.5 TK_MAJOR_VERSION=8 TK_MINOR_VERSION=5 -TK_PATCH_LEVEL=".12" +TK_PATCH_LEVEL=".13" VER=$TK_MAJOR_VERSION$TK_MINOR_VERSION #------------------------------------------------------------------------ -- cgit v0.12 From faeb60ffb28f0e8441c07adba2a4c06772332e30 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 6 Nov 2012 15:08:09 +0000 Subject: 3584471 Repair `make dist` backport. --- unix/Makefile.in | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index 6834f26..c530368 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -1551,10 +1551,11 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tkConfig.h.in $(MAC_OSX_DIR)/configure $(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/wish.exe.manifest.in mkdir $(DISTDIR)/macosx cp -p $(MAC_OSX_DIR)/GNUmakefile $(MAC_OSX_DIR)/README \ - $(MAC_OSX_DIR)/Tk.* $(MAC_OSX_DIR)/*.[ch] \ - $(MAC_OSX_DIR)/*.in $(MAC_OSX_DIR)/*.ac \ - $(MAC_OSX_DIR)/*.xcconfig $(MAC_OSX_DIR)/*.sdef \ - $(MAC_OSX_DIR)/configure $(DISTDIR)/macosx + $(MAC_OSX_DIR)/*.icns $(MAC_OSX_DIR)/*.tiff \ + $(MAC_OSX_DIR)/*.[ch] $(MAC_OSX_DIR)/*.in \ + $(MAC_OSX_DIR)/*.ac $(MAC_OSX_DIR)/*.xcconfig \ + $(MAC_OSX_DIR)/*.sdef $(MAC_OSX_DIR)/configure \ + $(DISTDIR)/macosx cp -p $(TOP_DIR)/license.terms $(DISTDIR)/macosx mkdir $(DISTDIR)/macosx/Wish.xcode cp -p $(MAC_OSX_DIR)/Wish.xcode/project.pbxproj \ -- cgit v0.12 From ecf35360551aca4a6a30a19bbdf6a68b6523fb8e Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 6 Nov 2012 15:09:45 +0000 Subject: make dist --- unix/tkConfig.h.in | 22 ++++++++++++++++++---- 1 file changed, 18 insertions(+), 4 deletions(-) diff --git a/unix/tkConfig.h.in b/unix/tkConfig.h.in index 8750b86..74f6d73 100644 --- a/unix/tkConfig.h.in +++ b/unix/tkConfig.h.in @@ -4,6 +4,9 @@ #ifndef _TKCONFIG #define _TKCONFIG +/* Define if building universal (internal helper macro) */ +#undef AC_APPLE_UNIVERSAL_BUILD + /* Is pthread_attr_get_np() declared in ? */ #undef ATTRGETNP_NOT_DECLARED @@ -139,6 +142,9 @@ /* Define to the one symbol short name of this package. */ #undef PACKAGE_TARNAME +/* Define to the home page for this package. */ +#undef PACKAGE_URL + /* Define to the version of this package. */ #undef PACKAGE_VERSION @@ -187,9 +193,17 @@ /* Do we want to use the threaded memory allocator? */ #undef USE_THREAD_ALLOC -/* Define to 1 if your processor stores words with the most significant byte - first (like Motorola and SPARC, unlike Intel and VAX). */ -#undef WORDS_BIGENDIAN +/* Define WORDS_BIGENDIAN to 1 if your processor stores words with the most + significant byte first (like Motorola and SPARC, unlike Intel). */ +#if defined AC_APPLE_UNIVERSAL_BUILD +# if defined __BIG_ENDIAN__ +# define WORDS_BIGENDIAN 1 +# endif +#else +# ifndef WORDS_BIGENDIAN +# undef WORDS_BIGENDIAN +# endif +#endif /* Are Darwin SUSv3 extensions available? */ #undef _DARWIN_C_SOURCE @@ -238,7 +252,7 @@ /* Define to `int' if does not define. */ #undef pid_t -/* Define to `unsigned' if does not define. */ +/* Define to `unsigned int' if does not define. */ #undef size_t /* Do we want to use the strtod() in compat? */ -- cgit v0.12 From 87cdc5e96f563eb3ae28924f18fdc58d7e494ad9 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 7 Nov 2012 19:20:48 +0000 Subject: update changes --- changes | 2 ++ 1 file changed, 2 insertions(+) diff --git a/changes b/changes index 6864ebe..a803a3e 100644 --- a/changes +++ b/changes @@ -6864,4 +6864,6 @@ Many revisions to better support a Cygwin environment (nijtmans) 2012-10-24 (bug fix)[3574893] crash in [wm forget] (porter) +2012-11-07 (bug fix)[3574708] TkSetFocusWin() crash on XP (mcdonald) + --- Released 8.5.13, November 12, 2012 --- See ChangeLog for details --- -- cgit v0.12 From 84daf732f3905a6f3f96746e8c65eaa1fce83d9e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 9 Nov 2012 10:59:45 +0000 Subject: demo fix for bug 3585396. On which platforms this fails? --- tests/winDialog.test | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/winDialog.test b/tests/winDialog.test index c092e76..77317b1 100644 --- a/tests/winDialog.test +++ b/tests/winDialog.test @@ -237,7 +237,7 @@ test winDialog-5.7 {GetFileName: extension begins with .} -constraints { start {set x [tk_getSaveFile -defaultextension .foo -title Save]} then { - SetText 0x480 bar + SetText 0x47C bar Click ok } string totitle $x @@ -247,7 +247,7 @@ test winDialog-5.8 {GetFileName: extension doesn't begin with .} -constraints { } -body { start {set x [tk_getSaveFile -defaultextension foo -title Save]} then { - SetText 0x480 bar + SetText 0x47C bar Click ok } string totitle $x @@ -413,7 +413,7 @@ test winDialog-5.23 {GetFileName: convert \ to /} -constraints { } -body { start {set x [tk_getSaveFile -title Back]} then { - SetText 0x480 [file nativename \ + SetText 0x47C [file nativename \ [file join [file normalize $::env(TEMP)] "12x 457"]] Click ok } -- cgit v0.12 From 21c167075272a63c52a71d7710417463a7dcc0d9 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 9 Nov 2012 15:14:26 +0000 Subject: ChangeLog release mark --- ChangeLog | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/ChangeLog b/ChangeLog index e39ebd1..a1e88e9 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,17 @@ +2012-11-09 Don Porter + + *** 8.5.13 TAGGED FOR RELEASE *** + + * generic/tk.h: Bump to 8.5.13 for release. + * library/tk.tcl: + * unix/configure.in: + * unix/tk.spec: + * win/configure.in: + * README: + + * unix/configure: autoconf-2.59 + * win/configure: + 2012-11-07 Donal K. Fellows * generic/tkFocus.c (TkSetFocusWin): [Bug 3574708]: Move window -- cgit v0.12 From 902f5496fc385aac6e791e1b6c296f1031e2d6d1 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 11 Nov 2012 08:50:50 +0000 Subject: Fixed, but only tested yet on Windows 7. On other platforms, at least the 'user input problem' is gone, but the test might still fail. --- tests/winDialog.test | 38 ++++++++++++++++++++++++++++---------- win/tkWinTest.c | 8 +++++++- 2 files changed, 35 insertions(+), 11 deletions(-) diff --git a/tests/winDialog.test b/tests/winDialog.test index 77317b1..8aa9ac3 100644 --- a/tests/winDialog.test +++ b/tests/winDialog.test @@ -236,21 +236,33 @@ test winDialog-5.7 {GetFileName: extension begins with .} -constraints { # } start {set x [tk_getSaveFile -defaultextension .foo -title Save]} + set msg {} then { - SetText 0x47C bar - Click ok + if {[catch {SetText 0x47C bar} msg]} { + Click cancel + } else { + Click ok + } } - string totitle $x + 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 0x47C bar - Click ok + if {[catch {SetText 0x47C bar} msg]} { + Click cancel + } else { + Click ok + } } - string totitle $x + 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 @@ -411,13 +423,19 @@ 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 0x47C [file nativename \ - [file join [file normalize $::env(TEMP)] "12x 457"]] - Click ok + if {[catch {SetText 0x47C [file nativename \ + [file join [file normalize $::env(TEMP)] "12x 457"]]} msg]} { + Click cancel + } else { + Click ok + } } - return $x + return $x$msg +} -cleanup { + unset msg } -result [file join [file normalize $::env(TEMP)] "12x 457"] } test winDialog-5.24 {GetFileName: file types: MakeFilter() succeeds} -constraints { diff --git a/win/tkWinTest.c b/win/tkWinTest.c index d7d4d0f..3dd7d7a 100644 --- a/win/tkWinTest.c +++ b/win/tkWinTest.c @@ -335,10 +335,16 @@ TestwineventCmd( } case WM_SETTEXT: { Tcl_DString ds; + BOOL result; Tcl_UtfToExternalDString(NULL, argv[4], -1, &ds); - SetDlgItemTextA(hwnd, id, Tcl_DStringValue(&ds)); + result = SetDlgItemTextA(hwnd, id, Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); + if (result == 0) { + Tcl_SetResult(interp, "failed to send text to dialog: ", TCL_STATIC); + AppendSystemError(interp, GetLastError()); + return TCL_ERROR; + } break; } case WM_COMMAND: { -- cgit v0.12 From 85cb48baf157d799ec37a2b228a15ef3a7873ece Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 11 Nov 2012 20:20:07 +0000 Subject: winDialog-5.7 should be knownBug, not winDialog-5.9 --- tests/winDialog.test | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/winDialog.test b/tests/winDialog.test index 3285a4c..abf9af3 100644 --- a/tests/winDialog.test +++ b/tests/winDialog.test @@ -229,7 +229,7 @@ test winDialog-5.6 {GetFileName: valid option, but missing value} -constraints { tk_getOpenFile -initialdir bar -title } -returnCodes error -result {value for "-title" missing} test winDialog-5.7 {GetFileName: extension begins with .} -constraints { - nt testwinevent + nt testwinevent knownBug } -body { # if (string[0] == '.') { # string++; @@ -253,7 +253,7 @@ test winDialog-5.8 {GetFileName: extension doesn't begin with .} -constraints { string totitle $x } -result [string totitle [file join [pwd] bar.foo]] test winDialog-5.9 {GetFileName: file types} -constraints { - nt testwinevent knownBug + nt testwinevent } -body { # case FILE_TYPES: -- cgit v0.12 From 33c21b13cccb585c96fb2b77a27cf0b89f66a547 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 13 Nov 2012 10:11:43 +0000 Subject: [Bug 3585396]: winDialog.test requires user interaction.

Renumber test-cases as in Tk 8.6, and convert various to tcltest-2 style. --- ChangeLog | 6 + tests/winDialog.test | 373 +++++++++++++++++++++++++++++++-------------------- win/tkWinTest.c | 139 +++++++++++-------- 3 files changed, 315 insertions(+), 203 deletions(-) diff --git a/ChangeLog b/ChangeLog index 56928ef..b95588b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2012-11-13 Jan Nijtmans + + * win/tkWinTest.c: [Bug 3585396]: winDialog.test requires user + * tests/winDialog.test: interaction. Renumber test-cases as in + Tk 8.6, and convert various to tcltest-2 style. + 2012-09-27 Jan Nijtmans * generic/tkInt.h: Add 8 colors to the supported color list 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: diff --git a/win/tkWinTest.c b/win/tkWinTest.c index bad3df3..ed862ed 100644 --- a/win/tkWinTest.c +++ b/win/tkWinTest.c @@ -1,40 +1,39 @@ -/* +/* * tkWinTest.c -- * - * Contains commands for platform specific tests for - * the Windows platform. + * Contains commands for platform specific tests for the Windows + * platform. * * Copyright (c) 1997 Sun Microsystems, Inc. * Copyright (c) 2000 by Scriptics Corporation. * Copyright (c) 2001 by ActiveState Corporation. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tkWinInt.h" HWND tkWinCurrentDialog; - + /* - * Forward declarations of procedures defined later in this file: + * Forward declarations of functions defined later in this file: */ -int TkplatformtestInit(Tcl_Interp *interp); static int TestclipboardObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); -static int TestwineventCmd(ClientData clientData, - Tcl_Interp *interp, int argc, CONST char **argv); - + Tcl_Obj *const objv[]); +static int TestwineventCmd(ClientData clientData, + Tcl_Interp *interp, int argc, const char **argv); +int TkplatformtestInit(Tcl_Interp *interp); /* *---------------------------------------------------------------------- * * TkplatformtestInit -- * - * Defines commands that test platform specific functionality for - * Unix platforms. + * Defines commands that test platform specific functionality for Windows + * platforms. * * Results: * A standard Tcl result. @@ -52,12 +51,11 @@ TkplatformtestInit( /* * Add commands for platform specific tests on MacOS here. */ - + Tcl_CreateObjCommand(interp, "testclipboard", TestclipboardObjCmd, (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testwinevent", TestwineventCmd, - (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); - + (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); return TCL_OK; } @@ -66,8 +64,8 @@ TkplatformtestInit( * * AppendSystemError -- * - * This routine formats a Windows system error message and places - * it into the interpreter result. Originally from tclWinReg.c. + * This routine formats a Windows system error message and places it into + * the interpreter result. Originally from tclWinReg.c. * * Results: * None. @@ -85,11 +83,14 @@ AppendSystemError( { int length; WCHAR *wMsgPtr; - char *msg; + const char *msg; char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE]; Tcl_DString ds; Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); + if (Tcl_IsShared(resultPtr)) { + resultPtr = Tcl_DuplicateObj(resultPtr); + } length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) &wMsgPtr, @@ -110,35 +111,41 @@ AppendSystemError( } if (length == 0) { if (error == ERROR_CALL_NOT_IMPLEMENTED) { - msg = "function not supported under Win32s"; + strcpy(msgBuf, "function not supported under Win32s"); } else { sprintf(msgBuf, "unknown error: %ld", error); - msg = msgBuf; } + msg = msgBuf; } else { Tcl_Encoding encoding; + char *msgPtr; encoding = Tcl_GetEncoding(NULL, "unicode"); - msg = Tcl_ExternalToUtfDString(encoding, (char *) wMsgPtr, -1, &ds); + Tcl_ExternalToUtfDString(encoding, (char *) wMsgPtr, -1, &ds); Tcl_FreeEncoding(encoding); LocalFree(wMsgPtr); + msgPtr = Tcl_DStringValue(&ds); length = Tcl_DStringLength(&ds); /* * Trim the trailing CR/LF from the system message. */ - if (msg[length-1] == '\n') { - msg[--length] = 0; + + if (msgPtr[length-1] == '\n') { + --length; } - if (msg[length-1] == '\r') { - msg[--length] = 0; + if (msgPtr[length-1] == '\r') { + --length; } + msgPtr[length] = 0; + msg = msgPtr; } sprintf(id, "%ld", error); Tcl_SetErrorCode(interp, "WINDOWS", id, msg, (char *) NULL); Tcl_AppendToObj(resultPtr, msg, length); + Tcl_SetObjResult(interp, resultPtr); if (length != 0) { Tcl_DStringFree(&ds); @@ -150,8 +157,8 @@ AppendSystemError( * * TestclipboardObjCmd -- * - * This procedure implements the testclipboard command. It provides - * a way to determine the actual contents of the Windows clipboard. + * This function implements the testclipboard command. It provides a way + * to determine the actual contents of the Windows clipboard. * * Results: * A standard Tcl result. @@ -163,11 +170,11 @@ AppendSystemError( */ static int -TestclipboardObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Main window for application. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument values. */ +TestclipboardObjCmd( + ClientData clientData, /* Main window for application. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument values. */ { HGLOBAL handle; char *data; @@ -208,8 +215,8 @@ TestclipboardObjCmd(clientData, interp, objc, objv) * * TestwineventCmd -- * - * This procedure implements the testwinevent command. It provides - * a way to send messages to windows dialogs. + * This function implements the testwinevent command. It provides a way + * to send messages to windows dialogs. * * Results: * A standard Tcl result. @@ -221,24 +228,26 @@ TestclipboardObjCmd(clientData, interp, objc, objv) */ static int -TestwineventCmd(clientData, interp, argc, argv) - ClientData clientData; /* Main window for application. */ - Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - CONST char **argv; /* Argument strings. */ +TestwineventCmd( + ClientData clientData, /* Main window for application. */ + Tcl_Interp *interp, /* Current interpreter. */ + int argc, /* Number of arguments. */ + const char **argv) /* Argument strings. */ { HWND hwnd = 0; + HWND child = 0; int id; char *rest; UINT message; WPARAM wParam; LPARAM lParam; - static TkStateMap messageMap[] = { + static const TkStateMap messageMap[] = { {WM_LBUTTONDOWN, "WM_LBUTTONDOWN"}, {WM_LBUTTONUP, "WM_LBUTTONUP"}, {WM_CHAR, "WM_CHAR"}, {WM_GETTEXT, "WM_GETTEXT"}, {WM_SETTEXT, "WM_SETTEXT"}, + {WM_COMMAND, "WM_COMMAND"}, {-1, NULL} }; @@ -256,16 +265,6 @@ TestwineventCmd(clientData, interp, argc, argv) return TCL_ERROR; } -#if 0 - TkpScanWindowId(interp, argv[1], &id); - if ( -#ifdef _WIN64 - (sscanf(string, "0x%p", &number) != 1) && -#endif - Tcl_GetInt(interp, string, (int *)&number) != TCL_OK) { - return TCL_ERROR; - } -#endif hwnd = (HWND) strtol(argv[1], &rest, 0); if (rest == argv[1]) { hwnd = FindWindow(NULL, argv[1]); @@ -278,7 +277,6 @@ TestwineventCmd(clientData, interp, argc, argv) id = strtol(argv[2], &rest, 0); if (rest == argv[2]) { - HWND child; char buf[256]; child = GetWindow(hwnd, GW_CHILD); @@ -291,6 +289,8 @@ TestwineventCmd(clientData, interp, argc, argv) child = GetWindow(child, GW_HWNDNEXT); } if (child == NULL) { + Tcl_AppendResult(interp, "could not find a control matching \"", + argv[2], "\"", NULL); return TCL_ERROR; } } @@ -321,16 +321,32 @@ TestwineventCmd(clientData, interp, argc, argv) } case WM_SETTEXT: { Tcl_DString ds; + BOOL result; Tcl_UtfToExternalDString(NULL, argv[4], -1, &ds); - SetDlgItemText(hwnd, id, Tcl_DStringValue(&ds)); + result = SetDlgItemText(hwnd, id, Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); + if (result == 0) { + Tcl_SetResult(interp, "failed to send text to dialog: ", TCL_STATIC); + AppendSystemError(interp, GetLastError()); + return TCL_ERROR; + } + break; + } + case WM_COMMAND: { + char buf[TCL_INTEGER_SPACE]; + if (argc < 5) { + wParam = MAKEWPARAM(id, 0); + lParam = (LPARAM)child; + } + sprintf(buf, "%d", (int) SendMessageA(hwnd, message, wParam, lParam)); + Tcl_SetResult(interp, buf, TCL_VOLATILE); break; } default: { char buf[TCL_INTEGER_SPACE]; - - sprintf(buf, "%d", + + sprintf(buf, "%d", (int) SendDlgItemMessage(hwnd, id, message, wParam, lParam)); Tcl_SetResult(interp, buf, TCL_VOLATILE); break; @@ -338,6 +354,11 @@ TestwineventCmd(clientData, interp, argc, argv) } return TCL_OK; } - - - + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ -- cgit v0.12 From efee4d5fc9d93a3da7decfba9d738b894bbeaf7b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 13 Nov 2012 10:22:29 +0000 Subject: missing changelog entry --- ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/ChangeLog b/ChangeLog index dcaa26a..ec4e237 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-11-11 Jan Nijtmans + + * win/tkWinTest.c: [Bug 3585396]: winDialog.test requires user + * tests/winDialog.test: interaction. + 2012-11-07 Donal K. Fellows * generic/tkFocus.c (TkSetFocusWin): [Bug 3574708]: Move window -- cgit v0.12