Fix bug #1692927 (buffer length problems). Added 'testfindwindow' and 'testgetwindowinfo'

and extended 'testwinevent' for WM_COMMAND support to enable testing native messagebox
dialogs and added a new test file to use these functions.

1 files changed, 299 insertions, 0 deletions

diff --git a/tests/winMsgbox.test b/tests/winMsgbox.test
new file mode 100644
index 0000000..c34873d
--- /dev/null
+++ b/tests/winMsgbox.test
@@ -0,0 +1,299 @@
+# This file is a Tcl script to test the Windows specific message box
+#
+# Copyright (c) 2007 Pat Thoyts <patthoyts@users.sourceforge.net>
+#
+# RCS: @(#) $Id: winMsgbox.test,v 1.1 2007/08/01 09:02:54 patthoyts Exp $
+
+package require tcltest 2.1
+eval tcltest::configure $argv
+tcltest::loadTestedCommands
+
+testConstraint getwindowinfo [expr {[llength [info command ::testgetwindowinfo]] > 0}]
+
+if {[testConstraint testwinevent]} {
+    catch {testwinevent debug 1}
+}
+
+proc Click {hwnd button} {
+    testwinevent $hwnd $button WM_COMMAND
+}
+
+proc GetWindowInfo {title button} {
+    global windowInfo
+    set windowInfo {}
+    set hwnd [testfindwindow $title "#32770"]
+    set windowInfo [testgetwindowinfo $hwnd]
+    array set a $windowInfo
+    set childinfo {} ; set childtext ""
+    foreach child $a(children) {
+        lappend childinfo $child [set info [testgetwindowinfo $child]]
+        array set ca $info
+        if {$ca(class) eq "Static"} {
+            append childtext $ca(text)
+        }
+    }
+    set a(children) $childinfo
+    set a(childtext) $childtext
+    set windowInfo [array get a]
+    testwinevent $hwnd $button WM_COMMAND
+}
+
+# -------------------------------------------------------------------------
+
+test winMsgbox-1.0 {tk_messageBox ok} -constraints {win getwindowinfo} -setup {
+    wm iconify .
+} -body {
+    global windowInfo
+    set title "winMsgbox-1.0 [pid]"
+    after 100 [list GetWindowInfo $title 2]
+    tk_messageBox -icon info -type ok -title $title -message Message
+} -cleanup {
+    wm deiconify .
+} -result {ok}
+
+test winMsgbox-1.1 {tk_messageBox okcancel} -constraints {win getwindowinfo} -setup {
+    wm iconify .
+} -body {
+    global windowInfo
+    set title "winMsgbox-1.1 [pid]"
+    after 100 [list GetWindowInfo $title 1]
+    tk_messageBox -icon info -type okcancel -title $title -message Message
+} -cleanup {
+    wm deiconify .
+} -result {ok}
+
+test winMsgbox-1.2 {tk_messageBox okcancel} -constraints {win getwindowinfo} -setup {
+    wm iconify .
+} -body {
+    global windowInfo
+    set title "winMsgbox-1.2 [pid]"
+    after 100 [list GetWindowInfo $title 2]
+    tk_messageBox -icon info -type okcancel -title $title -message Message
+} -cleanup {
+    wm deiconify .
+} -result {cancel}
+
+test winMsgbox-1.3 {tk_messageBox yesno} -constraints {win getwindowinfo} -setup {
+    wm iconify .
+} -body {
+    global windowInfo
+    set title "winMsgbox-1.3 [pid]"
+    after 100 [list GetWindowInfo $title 6]
+    tk_messageBox -icon info -type yesno -title $title -message Message
+} -cleanup {
+    wm deiconify .
+} -result {yes}
+
+test winMsgbox-1.4 {tk_messageBox yesno} -constraints {win getwindowinfo} -setup {
+    wm iconify .
+} -body {
+    global windowInfo
+    set title "winMsgbox-1.4 [pid]"
+    after 100 [list GetWindowInfo $title 7]
+    tk_messageBox -icon info -type yesno -title $title -message Message
+} -cleanup {
+    wm deiconify .
+} -result {no}
+
+test winMsgbox-1.5 {tk_messageBox abortretryignore} -constraints {win getwindowinfo} -setup {
+    wm iconify .
+} -body {
+    global windowInfo
+    set title "winMsgbox-1.5 [pid]"
+    after 100 [list GetWindowInfo $title 3]
+    tk_messageBox -icon info -type abortretryignore -title $title -message Message
+} -cleanup {
+    wm deiconify .
+} -result {abort}
+
+test winMsgbox-1.6 {tk_messageBox abortretryignore} -constraints {win getwindowinfo} -setup {
+    wm iconify .
+} -body {
+    global windowInfo
+    set title "winMsgbox-1.6 [pid]"
+    after 100 [list GetWindowInfo $title 4]
+    tk_messageBox -icon info -type abortretryignore -title $title -message Message
+} -cleanup {
+    wm deiconify .
+} -result {retry}
+
+test winMsgbox-1.7 {tk_messageBox abortretryignore} -constraints {win getwindowinfo} -setup {
+    wm iconify .
+} -body {
+    global windowInfo
+    set title "winMsgbox-1.7 [pid]"
+    after 100 [list GetWindowInfo $title 5]
+    tk_messageBox -icon info -type abortretryignore -title $title -message Message
+} -cleanup {
+    wm deiconify .
+} -result {ignore}
+
+test winMsgbox-1.8 {tk_messageBox retrycancel} -constraints {win getwindowinfo} -setup {
+    wm iconify .
+} -body {
+    global windowInfo
+    set title "winMsgbox-1.8 [pid]"
+    after 100 [list GetWindowInfo $title 4]
+    tk_messageBox -icon info -type retrycancel -title $title -message Message
+} -cleanup {
+    wm deiconify .
+} -result {retry}
+
+test winMsgbox-1.9 {tk_messageBox retrycancel} -constraints {win getwindowinfo} -setup {
+    wm iconify .
+} -body {
+    global windowInfo
+    set title "winMsgbox-1.9 [pid]"
+    after 100 [list GetWindowInfo $title 2]
+    tk_messageBox -icon info -type retrycancel -title $title -message Message
+} -cleanup {
+    wm deiconify .
+} -result {cancel}
+
+test winMsgbox-1.10 {tk_messageBox yesnocancel} -constraints {win getwindowinfo} -setup {
+    wm iconify .
+} -body {
+    global windowInfo
+    set title "winMsgbox-1.10 [pid]"
+    after 100 [list GetWindowInfo $title 6]
+    tk_messageBox -icon info -type yesnocancel -title $title -message Message
+} -cleanup {
+    wm deiconify .
+} -result {yes}
+
+test winMsgbox-1.11 {tk_messageBox yesnocancel} -constraints {win getwindowinfo} -setup {
+    wm iconify .
+} -body {
+    global windowInfo
+    set title "winMsgbox-1.11 [pid]"
+    after 100 [list GetWindowInfo $title 7]
+    tk_messageBox -icon info -type yesnocancel -title $title -message Message
+} -cleanup {
+    wm deiconify .
+} -result {no}
+
+test winMsgbox-1.12 {tk_messageBox yesnocancel} -constraints {win getwindowinfo} -setup {
+    wm iconify .
+} -body {
+    global windowInfo
+    set title "winMsgbox-1.12 [pid]"
+    after 100 [list GetWindowInfo $title 2]
+    tk_messageBox -icon info -type yesnocancel -title $title -message Message
+} -cleanup {
+    wm deiconify .
+} -result {cancel}
+
+# -------------------------------------------------------------------------
+
+test winMsgbox-2.0 {tk_messageBox message} -constraints {win getwindowinfo} -setup {
+    wm iconify .
+    unset -nocomplain info
+} -body {
+    global windowInfo
+    set title "winMsgbox-2.0 [pid]"
+    set message "message"
+    after 100 [list GetWindowInfo $title 2]
+    set r [tk_messageBox -type ok -title $title -message $message]
+    array set info $windowInfo
+    lappend r $info(childtext)
+} -cleanup {
+    wm deiconify .
+} -result [list ok "message"]
+
+test winMsgbox-2.1 {tk_messageBox message (long)} -constraints {
+    win getwindowinfo
+} -setup {
+    wm iconify .
+    unset -nocomplain info
+} -body {
+    global windowInfo
+    set title "winMsgbox-2.1 [pid]"
+    set message [string repeat Ab 80]
+    after 100 [list GetWindowInfo $title 2]
+    set r [tk_messageBox -type ok -title $title -message $message]
+    array set info $windowInfo
+    lappend r $info(childtext)
+} -cleanup {
+    wm deiconify .
+} -result [list ok [string repeat Ab 80]]
+
+test winMsgbox-2.2 {tk_messageBox message (unicode)} -constraints {
+    win getwindowinfo
+} -setup {
+    wm iconify .
+    unset -nocomplain info
+} -body {
+    global windowInfo
+    set title "winMsgbox-2.2 [pid]"
+    set message "\u041f\u043e\u0438\u0441\u043a\u0020\u0441\u0442\u0440\u0430\u043d\u0438\u0446"
+    after 100 [list GetWindowInfo $title 2]
+    set r [tk_messageBox -type ok -title $title -message $message]
+    array set info $windowInfo
+    lappend r $info(childtext)
+} -cleanup {
+    wm deiconify .
+} -result [list ok "\u041f\u043e\u0438\u0441\u043a\u0020\u0441\u0442\u0440\u0430\u043d\u0438\u0446"]
+
+test winMsgbox-2.3 {tk_messageBox message (empty)} -constraints {
+    win getwindowinfo
+} -setup {
+    wm iconify .
+    unset -nocomplain info
+} -body {
+    global windowInfo
+    set title "winMsgbox-2.3 [pid]"
+    after 100 [list GetWindowInfo $title 2]
+    set r [tk_messageBox -type ok -title $title]
+    array set info $windowInfo
+    lappend r $info(childtext)
+} -cleanup {
+    wm deiconify .
+} -result [list ok ""]
+
+test winMsgbox-3.0 {tk_messageBox detail (sourceforge bug #1692927)} -constraints {
+    win getwindowinfo
+} -setup {
+    wm iconify .
+    unset -nocomplain info
+} -body {
+    global windowInfo
+    set title "winMsgbox-3.0 [pid]"
+    after 100 [list GetWindowInfo $title 2]
+    set r [tk_messageBox -type ok -title $title \
+               -message Hello -detail "Pleased to meet you"]
+    array set info $windowInfo
+    lappend r $info(childtext)
+} -cleanup {
+    wm deiconify .
+} -result [list ok "Hello\n\nPleased to meet you"]
+
+test winMsgbox-3.1 {tk_messageBox detail (unicode)} -constraints {
+    win getwindowinfo
+} -setup {
+    wm iconify .
+    unset -nocomplain info
+} -body {
+    global windowInfo
+    set title "winMsgbox-3.1 [pid]"
+    set message "\u041f\u043e\u0438\u0441\u043a"
+    set detail "\u0441\u0442\u0440\u0430\u043d\u0438\u0446"
+    after 100 [list GetWindowInfo $title 2]
+    set r [tk_messageBox -type ok -title $title -message $message -detail $detail]
+    array set info $windowInfo
+    lappend r $info(childtext)
+} -cleanup {
+    wm deiconify .
+} -result [list ok "\u041f\u043e\u0438\u0441\u043a\n\n\u0441\u0442\u0440\u0430\u043d\u0438\u0446"]
+
+# -------------------------------------------------------------------------
+
+if {[testConstraint testwinevent]} {
+    catch {testwinevent debug 0}
+}
+cleanupTests
+return
+
+# Local variables:
+# mode: tcl
+# indent-tabs-mode: nil
+# End:
\ No newline at end of file