Resolve bug [18a4ba19bd]. Make winfo containing behave consistently across

platforms and fix a bug with embedded toplevels.

3 files changed, 200 insertions, 71 deletions

diff --git a/tests/text.test b/tests/text.test
index c79d818..2d49f59 100644
--- a/tests/text.test
+++ b/tests/text.test
@@ -7532,6 +7532,100 @@ test text-32.4 {peer widget -start, -end and deletion (bug 1630262)} -setup {
     destroy .pt .t
 } -result {5 11 8 10 5 8 6 8 22 27 38 44 55 60 57 57}
 
+test text-32.2 {peer widget -start, -end and deletion (bug 1630262)} -setup {
+    destroy .t .pt
+    set res {}
+} -body {
+    text .t
+    .t peer create .pt
+    for {set i 1} {$i < 100} {incr i} {
+      .t insert end "Line $i\n"
+    }
+    .t configure -startline 5
+    # none of the following delete shall crash
+    # (all did before fixing bug 1630262)
+    # 1. delete on the same line: line1 == line2 in DeleteIndexRange,
+    #    and resetView is true neither for .t not for .pt
+    .pt delete 2.0 2.2
+    # 2. delete just one line: line1 < line2 in DeleteIndexRange,
+    #    and resetView is true only for .t, not for .pt
+    .pt delete 2.0 3.0
+    # 3. delete several lines: line1 < line2 in DeleteIndexRange,
+    #    and resetView is true only for .t, not for .pt
+    .pt delete 2.0 5.0
+    # 4. delete to the end line: line1 < line2 in DeleteIndexRange,
+    #    and resetView is true only for .t, not for .pt
+    .pt delete 2.0 end
+    # this test succeeds provided there is no crash
+    set res 1
+} -cleanup {
+    destroy .pt
+} -result {1}
+
+test text-32.3 {peer widget -start, -end and deletion (bug 1630262)} -setup {
+    destroy .t .pt
+    set res {}
+} -body {
+    text .t
+    .t peer create .pt
+    for {set i 1} {$i < 100} {incr i} {
+      .t insert end "Line $i\n"
+    }
+    .t configure -startline 5
+    .pt configure -startline 3
+    # the following delete shall not crash
+    # (it did before fixing bug 1630262)
+    .pt delete 2.0 3.0
+    # moreover -startline shall be correct
+    # (was wrong before fixing bug 1630262)
+    lappend res [.t cget -start] [.pt cget -start]
+} -cleanup {
+    destroy .pt
+} -result {4 3}
+
+test text-32.4 {peer widget -start, -end and deletion (bug 1630262)} -setup {
+    destroy .t .pt
+    set res {}
+} -body {
+    text .t
+    .t peer create .pt
+    for {set i 1} {$i < 100} {incr i} {
+      .t insert end "Line $i\n"
+    }
+    .t configure -startline 5 -endline 15
+    .pt configure -startline 8 -endline 12
+    # .pt now shows a range entirely inside the range of .pt
+    # from .t, delete lines located after [.pt cget -end]
+    .t delete 9.0 10.0
+    # from .t, delete lines straddling [.pt cget -end]
+    .t delete 6.0 9.0
+    lappend res [.t cget -start] [.t cget -end] [.pt cget -start] [.pt cget -end]
+    .t configure -startline 5 -endline 12
+    .pt configure -startline 8 -endline 12
+    # .pt now shows again a range entirely inside the range of .pt
+    # from .t, delete lines located before [.pt cget -start]
+    .t delete 2.0 3.0
+    # from .t, delete lines straddling [.pt cget -start]
+    .t delete 2.0 5.0
+    lappend res [.t cget -start] [.t cget -end] [.pt cget -start] [.pt cget -end]
+    .t configure -startline 22 -endline 31
+    .pt configure -startline 42 -endline 51
+    # .t now shows a range entirely before the range of .pt
+    # from .t, delete some lines, then do it from .pt
+    .t delete 2.0 3.0
+    .t delete 2.0 5.0
+    .pt delete 2.0 5.0
+    lappend res [.t cget -start] [.t cget -end] [.pt cget -start] [.pt cget -end]
+    .t configure -startline 55 -endline 75
+    .pt configure -startline 60 -endline 70
+    # .pt now shows a range entirely inside the range of .t
+    # from .t, delete a range straddling the entire range of .pt
+    .t delete 3.0 18.0
+    lappend res [.t cget -start] [.t cget -end] [.pt cget -start] [.pt cget -end]
+} -cleanup {
+    destroy .pt .t
+} -result {5 11 8 10 5 8 6 8 22 27 38 44 55 60 57 57}
+
 
 test text-33.1 {TextWidgetCmd procedure, "peer" option} -setup {
     text .t
diff --git a/tests/unixWm.test b/tests/unixWm.test
index 067327d..1102f49 100644
--- a/tests/unixWm.test
+++ b/tests/unixWm.test
@@ -808,14 +808,15 @@ test unixWm-22.2 {Tk_WmCmd procedure, "iconbitmap" option} {unix testwrapper} {
 	    WM_HINTS] 0]]]
     lappend result [wm iconbitmap .t] $bit
 } {{} questhead 0x4 {} 0x0}
-test unixWm-22.3.1 {Tk_WmCmd procedure, "iconbitmap" option for unix only} \
-{unix notAqua} {
-    list [catch {wm iconbitmap .t bad-bitmap} msg] $msg
-} {1 {bitmap "bad-bitmap" not defined}}
-test unixWm-22.3.2 {Tk_WmCmd procedure, "iconbitmap" option for Aqua only} \
-Aqua {
+if {[tk windowingsystem] == "aqua"} {
+    set result_22_3 {0 {}} 
+} else {
+    set result_22_3 {1 {bitmap "bad-bitmap" not defined}}
+}
+test unixWm-22.3 {Tk_WmCmd procedure, "iconbitmap" option for unix only} \
+unix {
     list [catch {wm iconbitmap .t bad-bitmap} msg] $msg
-} {1 {}}
+} $result_22_3
 
 test unixWm-23.1 {Tk_WmCmd procedure, "iconify" option} unix {
     list [catch {wm iconify .t 12} msg] $msg
@@ -1218,13 +1219,14 @@ test unixWm-34.2 {Tk_WmCmd procedure, "sizefrom" option} {unix testwrapper} {
 test unixWm-34.3 {Tk_WmCmd procedure, "sizefrom" option} unix {
     list [catch {wm sizefrom .t none} msg]  $msg
 } {1 {bad argument "none": must be program or user}}
-
-test unixWm-35.1.1 {Tk_WmCmd procedure, "state" option} {unix notAqua} {
-    list [catch {wm state .t 1} msg]  $msg
-} {1 {bad argument "1": must be normal, iconic, or withdrawn}}
-test unixWm-35.1.2 {Tk_WmCmd procedure, "state" option} Aqua {
+if {[tk windowingsystem] == "aqua"} {
+    set result_35_1 {1 {bad argument "1": must be normal, iconic, withdrawn, or zoomed}}
+} else {
+    set result_35_1 {1 {bad argument "1": must be normal, iconic, or withdrawn}}
+}
+test unixWm-35.1 {Tk_WmCmd procedure, "state" option} {unix notAqua} {
     list [catch {wm state .t 1} msg]  $msg
-} {1 {bad argument "1": must be normal, iconic, withdrawn, or zoomed}}
+} $result_35_1
 test unixWm-35.2 {Tk_WmCmd procedure, "state" option} unix {
     list [catch {wm state .t iconic 1} msg]  $msg
 } {1 {wrong # args: should be "wm state window ?state?"}}
@@ -1777,88 +1779,103 @@ test unixWm-49.2 {Tk_GetRootCoords procedure, menubars} {unix testmenubar} {
 } {52 7 12 62}
 
 deleteWindows
-wm iconify .
-test unixWm-50.1 {Tk_CoordsToWindow procedure, finding a toplevel, x-coords} unix {
-    deleteWindows
+wm withdraw .
+if {[tk windowingsystem] == "aqua"} {
+    # Modern mac windows have no border.
+    set result_50_1 {{} {} .t .t .t2 {} .t2 .t .t} 
+} else {
+    # Windows are assumed to have a border (invisible in Gnome 3).
+    set result_50_1 {{} {} .t {} .t2 {} .t2 {} .t}
+}
+test unixWm-50.1 {Tk_CoordsToWindow procedure, finding a toplevel, x-coords, title bar} unix {
+    update
     toplevel .t -width 300 -height 400 -bg green
-    wm geom .t +40+0
+    wm geom .t +100+100
     tkwait visibility .t
-    toplevel .t2 -width 100 -height 80 -bg red
-    wm geom .t2 +140+200
+    toplevel .t2 -width 100 -height 200 -bg red
+    wm geom .t2 +200+200
     tkwait visibility .t2
     raise .t2
+    update
     set x [winfo rootx .t]
     set y [winfo rooty .t]
-    list [winfo containing [expr $x - 30] [expr $y + 250]] \
-	    [winfo containing [expr $x - 1] [expr $y + 250]] \
-	    [winfo containing $x [expr $y + 250]] \
-	    [winfo containing [expr $x + 99] [expr $y + 250]] \
-	    [winfo containing [expr $x + 100] [expr $y + 250]] \
-	    [winfo containing [expr $x + 199] [expr $y + 250]] \
-	    [winfo containing [expr $x + 200] [expr $y + 250]] \
-	    [winfo containing [expr $x + 220] [expr $y + 250]]
-} {{} {} .t {} .t2 .t2 {} .t}
+    list [winfo containing [expr $x - 30]  [expr $y + 250]] \
+	 [winfo containing [expr $x - 1]   [expr $y + 250]] \
+	 [winfo containing $x              [expr $y + 250]] \
+	 [winfo containing [expr $x + 99]  [expr $y + 250]] \
+	 [winfo containing [expr $x + 100] [expr $y + 250]] \
+	 [winfo containing [expr $x + 150] [expr $y + 90]] \
+	 [winfo containing [expr $x + 199] [expr $y + 250]] \
+	 [winfo containing [expr $x + 200] [expr $y + 250]] \
+	 [winfo containing [expr $x + 220] [expr $y + 250]] \
+} $result_50_1
 test unixWm-50.2 {Tk_CoordsToWindow procedure, finding a toplevel, y-coords and overrideredirect} unix {
     deleteWindows
-    toplevel .t -width 300 -height 400 -bg yellow
-    wm geom .t +0+50
+    toplevel .t -width 400 -height 300 -bg yellow
+    wm geom .t +100+100
     tkwait visibility .t
-    toplevel .t2 -width 100 -height 80 -bg blue
+    toplevel .t2 -width 200 -height 100 -bg blue
     wm overrideredirect .t2 1
-    wm geom .t2 +100+200
+    wm geom .t2 +200+200
     tkwait visibility .t2
     raise .t2
     set x [winfo rootx .t]
     set y [winfo rooty .t]
     set y2 [winfo rooty .t2]
-    list [winfo containing [expr $x +150] 10] \
-	    [winfo containing [expr $x +150] [expr $y - 1]] \
-	    [winfo containing [expr $x +150] $y] \
-	    [winfo containing [expr $x +150] [expr $y2 - 1]] \
-	    [winfo containing [expr $x +150] $y2] \
-	    [winfo containing [expr $x +150] [expr $y2 + 79]] \
-	    [winfo containing [expr $x +150] [expr $y2 + 80]] \
-	    [winfo containing [expr $x +150] [expr $y + 450]]
+    list [winfo containing [expr $x +200] [expr $y - 30]] \
+	 [winfo containing [expr $x +200] [expr $y - 1]] \
+	 [winfo containing [expr $x +200] $y] \
+	 [winfo containing [expr $x +200] [expr $y2 - 1]] \
+	 [winfo containing [expr $x +200] $y2] \
+	 [winfo containing [expr $x +200] [expr $y2 + 99]] \
+	 [winfo containing [expr $x +200] [expr $y2 + 100]] \
+	 [winfo containing [expr $x +200] [expr $y + 450]]
 } {{} {} .t .t .t2 .t2 .t {}}
 test unixWm-50.3 {
 	Tk_CoordsToWindow procedure, finding a toplevel with embedding
-} -constraints tempNotWin -setup {
+} tempNotWin {
     deleteWindows
+    catch {interp delete slave}
+    
     toplevel .t -width 300 -height 400 -bg blue
-    wm geom .t +0+50
-    frame .t.f -container 1
+    wm geom .t +100+100
+    frame .t.f -container 1 -bg red
     place .t.f -x 150 -y 50
     tkwait visibility .t.f
-    setupbg
-} -body {
-    dobg "
+    update
+    interp create slave
+    load {} Tk slave
+    slave alias frameid winfo id .t.f
+    slave eval {
 	wm withdraw .
-	toplevel .x -width 100 -height 80 -use [winfo id .t.f] -bg yellow
-	tkwait visibility .x"
-    set result [dobg {
-	set x [winfo rootx .x]
-	set y [winfo rooty .x]
-	list [winfo containing [expr $x - 1] [expr $y + 50]] \
-		[winfo containing $x [expr $y +50]]
-    }]
+        toplevel .x -width 100 -height 80 -use [frameid] -bg yellow
+        tkwait visibility .x
+        update
+        set x [winfo rootx .x]
+        set y [winfo rooty .x]
+    }
+    set result [list [slave eval {winfo containing [expr $x - 1]  [expr $y + 50]}] \
+	       	     [slave eval {winfo containing $x [expr $y + 50]}]]
+    interp delete slave
     set x [winfo rootx .t]
     set y [winfo rooty .t]
     lappend result [winfo containing [expr $x + 200] [expr $y + 49]] \
-		[winfo containing [expr $x + 200] [expr $y +50]]
-} -cleanup {
-    cleanupbg
-} -result {{} .x .t .t.f}
+	[winfo containing [expr $x + 200] [expr $y +50]]
+    set result
+} {{} .x .t .t.f}
 test unixWm-50.4 {Tk_CoordsToWindow procedure, window in other application} unix {
     destroy .t
+
     catch {interp delete slave}
     toplevel .t -width 200 -height 200 -bg green
-    wm geometry .t +0+0
+    wm geometry .t +100+100
     tkwait visibility .t
+    update
     interp create slave
     load {} Tk slave
-    slave eval {wm geometry . 200x200+0+0; tkwait visibility .}
-    set result [list [winfo containing 100 100] \
-	    [slave eval {winfo containing 100 100}]]
+    slave eval {wm geometry . 200x200+100+100; tkwait visibility . ; update}
+    set result [list [winfo containing 200 200] \
+	    [slave eval {winfo containing 200 200}]]
     interp delete slave
     set result
 } {{} .}
@@ -1876,13 +1893,13 @@ test unixWm-50.5 {Tk_CoordsToWindow procedure, handling menubars} {unix testmenu
     update
     set x [winfo rootx .t]
     set y [winfo rooty .t]
-    list [winfo containing $x [expr $y - 31]] \
-		[winfo containing $x [expr $y - 30]] \
-		[winfo containing [expr $x + 50] [expr $y - 19]] \
-		[winfo containing [expr $x + 50] [expr $y - 18]] \
-		[winfo containing [expr $x + 50] $y] \
-		[winfo containing [expr $x + 11] [expr $y + 152]] \
-		[winfo containing [expr $x + 12] [expr $y + 152]]
+    list [winfo containing $x             [expr $y - 31]] \
+	 [winfo containing $x             [expr $y - 30]] \
+	 [winfo containing [expr $x + 50] [expr $y - 19]] \
+	 [winfo containing [expr $x + 50] [expr $y - 18]] \
+	 [winfo containing [expr $x + 50] $y] \
+	 [winfo containing [expr $x + 11] [expr $y + 152]] \
+	 [winfo containing [expr $x + 12] [expr $y + 152]]
 } {{} .t.menu .t.menu .t.menu.f .t .t .t.f}
 test unixWm-50.6 {Tk_CoordsToWindow procedure, embedding within one app.} unix {
     deleteWindows
@@ -1947,6 +1964,7 @@ test unixWm-50.9 {Tk_CoordsToWindow procedure, unmapped windows} unix {
     tkwait visibility .t2
     set result [list [winfo containing 100 100]]
     wm iconify .t2
+    animationDelay
     lappend result [winfo containing 100 100]
 } {.t2 .t}
 test unixWm-50.10 {Tk_CoordsToWindow procedure, unmapped windows} unix {
@@ -2032,6 +2050,7 @@ test unixWm-51.6 {TkWmRestackToplevel procedure, window to be stacked isn't mapp
 test unixWm-51.7 {TkWmRestackToplevel procedure, other window isn't mapped} unix {
     foreach w {.t .t2 .t3} {
 	destroy $w
+	update
 	toplevel $w -width 200 -height 200 -bg green
 	wm geometry $w +0+0
     }
@@ -2068,13 +2087,19 @@ test unixWm-51.8 {TkWmRestackToplevel procedure, overrideredirect windows} unix
     raise .t2
     lappend result [winfo containing $x $y]
 } {.t2 .t .t2}
+# The mac won't put an overrideredirect window above the root,
+if {[tk windowingsystem] == "aqua"} {
+    wm withdraw .
+}
 test unixWm-51.9 {TkWmRestackToplevel procedure, other window overrideredirect} unix {
     foreach w {.t .t2 .t3} {
 	destroy $w
+	update
 	toplevel $w -width 200 -height 200 -bg green
 	wm overrideredirect $w 1
 	wm geometry $w +0+0
 	tkwait visibility $w
+	update
     }
     lower .t3 .t2
     update
@@ -2090,6 +2115,9 @@ test unixWm-51.9 {TkWmRestackToplevel procedure, other window overrideredirect}
     lower .t2
     lappend result [winfo containing $x $y]
 } {.t2 .t3}
+if {[tk windowingsystem] == "aqua"} {
+    wm deiconify .
+}
 test unixWm-51.10 {TkWmRestackToplevel procedure, don't move window that's already in the right place} unix {
     makeToplevels
     raise .raise1
@@ -2465,11 +2493,18 @@ test unixWm-59.3 {exit processing} unix {
 # NOTE: since [wm attributes] is not guaranteed to have any effect,
 # the only thing we can really test here is the syntax.
 #
+if {[tk windowingsystem] == "aqua"} {
+    set result_60_1 {-alpha 1.0 -fullscreen 0 -modified 0 -notify 0\
+			 -titlepath {} -topmost 0 -transparent 0\
+			 -type unsupported}
+} else {
+    set result_60_1 {-alpha 1.0 -topmost 0 -zoomed 0 -fullscreen 0 -type {}}
+}
 test unixWm-60.1 {wm attributes - test} -constraints unix -body {
     destroy .t
     toplevel .t
     wm attributes .t
-} -result [list -alpha 1.0 -topmost 0 -zoomed 0 -fullscreen 0 -type {}]
+} -result $result_60_1
 
 test unixWm-60.2 {wm attributes - test} -constraints unix -body {
     destroy .t
diff --git a/tests/wm.test b/tests/wm.test
index f56eaa7..7b81985 100644
--- a/tests/wm.test
+++ b/tests/wm.test
@@ -140,7 +140,7 @@ test wm-attributes-1.2.4 {usage} -constraints {unix notAqua} -returnCodes error
 } -result {bad attribute "_": must be -alpha, -topmost, -zoomed, -fullscreen, or -type}
 test wm-attributes-1.2.5 {usage} -constraints aqua -returnCodes error -body {
     wm attributes . _
-} -result {bad attribute "_": must be -alpha, -fullscreen, -modified, -notify, -titlepath, -topmost, or -transparent}
+} -result {bad attribute "_": must be -alpha, -fullscreen, -modified, -notify, -titlepath, -topmost, -transparent, or -type}
 
 
 ### wm client ###