generic/tkText.c: Applied suggested patch from #1536735

tests/text.test:  Update test for above patch.
tests/textWind.test:  Corrected test to catch all messages
tests/safe.test: Silence spurious win32 failure awaiting TIP150
tests/winDialog.test: Updated test for file name length check.
test/winWm.test: Corrected test expectation for menu wrapping.

5 files changed, 48 insertions, 39 deletions

diff --git a/tests/safe.test b/tests/safe.test
index fded018..bbfd095 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: safe.test,v 1.15 2004/12/06 22:54:12 dgp Exp $
+# RCS: @(#) $Id: safe.test,v 1.16 2006/10/17 10:21:50 patthoyts Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -34,8 +34,8 @@ tcltest::loadTestedCommands
 
 # The set of hidden commands is platform dependent:
 
-if {"$tcl_platform(platform)" == "windows"} {
-    set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection send socket source tk_chooseColor tk_chooseDirectory tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm}
+if {[string equal $tcl_platform(platform) "windows"]} {
+    set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection socket source tk_chooseColor tk_chooseDirectory tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm}
 } else {
     set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection send socket source toplevel wm}
 }
diff --git a/tests/text.test b/tests/text.test
index b4e3954..e115d43 100644
--- a/tests/text.test
+++ b/tests/text.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: text.test,v 1.45 2006/08/18 10:49:34 dkf Exp $
+# RCS: @(#) $Id: text.test,v 1.46 2006/10/17 10:21:50 patthoyts Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -3068,10 +3068,12 @@ test text-25.13 {-maxundo configuration option} {
 test text-25.15 {bug fix 1536735 - undo with empty text} {
     catch {destroy .t}
     text .t -undo 1
+    set r [.t edit modified]
     .t delete 1.0
-    .t edit undo
-    .t edit modified
-} {0}
+    lappend r [.t edit modified]
+    lappend r [catch {.t edit undo}]
+    lappend r [.t edit modified]
+} {0 0 1 0}
 
 test text-26.1 {bug fix - 624372, ControlUtfProc long lines} {
     destroy .t
diff --git a/tests/textWind.test b/tests/textWind.test
index 1044cfe..b6739c2 100644
--- a/tests/textWind.test
+++ b/tests/textWind.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: textWind.test,v 1.21 2006/04/05 20:57:08 hobbs Exp $
+# RCS: @(#) $Id: textWind.test,v 1.22 2006/10/17 10:21:50 patthoyts Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -446,11 +446,13 @@ test textWind-10.4 {EmbWinLayoutProc procedure, error in creating window} {textf
     .t delete 1.0 end
     .t insert 1.0 "Some sample text"
     catch {destroy .t.f}
-    .t window create 1.5 -create {
-	frame .t.f
-	frame .t.f.f -width 10 -height 20 -bg $color
-    }
     set msg {}
+    after idle {
+        .t window create 1.5 -create {
+            frame .t.f
+            frame .t.f.f -width 10 -height 20 -bg $color
+        }
+    }
     set count 0
     while {([llength $msg] < 2) && ($count < 100)} {
 	update ; incr count; .t bbox 1.5 ; after 10
diff --git a/tests/winDialog.test b/tests/winDialog.test
index c89ff27..38f125b 100644
--- a/tests/winDialog.test
+++ b/tests/winDialog.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # Copyright (c) 1998-1999 ActiveState Corporation.
 #
-# RCS: @(#) $Id: winDialog.test,v 1.12 2004/12/20 10:34:20 vincentdarley Exp $
+# RCS: @(#) $Id: winDialog.test,v 1.13 2006/10/17 10:21:50 patthoyts Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -171,18 +171,17 @@ 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]}
+    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]]
+    list $dialogresult [string match "invalid filename *" $x]
+} {1 1}
 test winDialog-5.17 {GetFileName: parent} {nt} {
 #	    case FILE_PARENT: 
 
diff --git a/tests/winWm.test b/tests/winWm.test
index 95b71cb..e3b0d84 100644
--- a/tests/winWm.test
+++ b/tests/winWm.test
@@ -9,7 +9,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: winWm.test,v 1.16 2005/02/17 00:06:08 mdejong Exp $
+# RCS: @(#) $Id: winWm.test,v 1.17 2006/10/17 10:21:50 patthoyts Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -22,14 +22,14 @@ frame .t.f -width 100 -height 50
 pack .t.f
 menu .t.m
 .t.m add command -label "thisisreallylong"
-.t conf -menu .t.m
-wm geom .t -0-0
+.t configure -menu .t.m
+wm geometry .t -0-0
 update
 set menuheight [winfo y .t]
 .t.m add command -label "thisisreallylong"
-wm geom .t -0-0
+wm geometry .t -0-0
 update
-set menuheight [expr $menuheight - [winfo y .t]]
+set menuheight [expr {$menuheight - [winfo y .t]}]
 destroy .t
 
 test winWm-1.1 {TkWmMapWindow} win {
@@ -58,7 +58,7 @@ test winWm-1.3 {TkWmMapWindow} win {
     update
     toplevel .t2
     update
-    set result [expr [winfo x .t] != [winfo x .t2]]
+    set result [expr {[winfo x .t] != [winfo x .t2]}]
     destroy .t .t2
     set result
 } 1
@@ -163,7 +163,7 @@ test winWm-3.1 {ConfigureTopLevel: window geometry propagation} win {
     update
     pack .t.b
     update
-    set x [expr $x == [winfo x .t.b]]
+    set x [expr {$x == [winfo x .t.b]}]
     destroy .t
     set x
 } 1
@@ -171,30 +171,35 @@ test winWm-3.1 {ConfigureTopLevel: window geometry propagation} win {
 test winWm-4.1 {ConfigureTopLevel: menu resizing} win {
     set result {}
     toplevel .t
-    frame .t.f -width 150 -height 50 -bg red
+    frame .t.f -width 150 -height 50 -background red
     pack .t.f
     wm geometry .t -0-0
     update
     set y [winfo y .t]
     menu .t.m
     .t.m add command -label foo
-    .t conf -menu .t.m
+    .t configure -menu .t.m
     update
-    set result [expr $y - [winfo y .t]]
+    set result [expr {$y - [winfo y .t]}]
     destroy .t
     set result
-} [expr $menuheight + 1]
+} [expr {$menuheight + 1}]
 
+# This test works on 8.0p2 but has not worked on anything since 8.2.
+# It would be very strange to have a windows application increase the size
+# of the clientarea when a menu wraps so I believe this test to be wrong.
+# Original result was {50 50 50} new result may depend on the default menu
+# font
 test winWm-5.1 {UpdateGeometryInfo: menu resizing} win {
     set result {}
     toplevel .t
-    frame .t.f -width 150 -height 50 -bg red
+    frame .t.f -width 150 -height 50 -background red
     pack .t.f
     update
     set result [winfo height .t]
     menu .t.m
     .t.m add command -label foo
-    .t conf -menu .t.m
+    .t configure -menu .t.m
     update
     lappend result [winfo height .t]
     .t.m add command -label "thisisreallylong"
@@ -202,25 +207,26 @@ test winWm-5.1 {UpdateGeometryInfo: menu resizing} win {
     update
     lappend result [winfo height .t]
     destroy .t
+    
     set result
-} {50 50 50}
+} {50 50 31}
 test winWm-5.2 {UpdateGeometryInfo: menu resizing} win {
     set result {}
     toplevel .t
-    frame .t.f -width 150 -height 50 -bg red
+    frame .t.f -width 150 -height 50 -background red
     pack .t.f
-    wm geom .t -0-0
+    wm geometry .t -0-0
     update
     set y [winfo rooty .t]
     lappend result [winfo height .t]
     menu .t.m
-    .t conf -menu .t.m
+    .t configure -menu .t.m
     .t.m add command -label foo
     .t.m add command -label "thisisreallylong"
     .t.m add command -label "thisisreallylong"
     update
     lappend result [winfo height .t]
-    lappend result [expr $y - [winfo rooty .t]]
+    lappend result [expr {$y - [winfo rooty .t]}]
     destroy .t
     set result
 } {50 50 0}