Merge 8.7

1 files changed, 141 insertions, 0 deletions

diff --git a/tests/font.test b/tests/font.test
index 95025bb..39d94c0 100644
--- a/tests/font.test
+++ b/tests/font.test
@@ -2408,6 +2408,147 @@ test font-47.1 {Bug f214b8ad5b} -body {
     interp delete two
 } -result {}
 
+test font-47.2 {Bug 3049518 - Canvas} -body {
+    if {"MyFont" ni [font names]} {
+	font create MyFont -family "Liberation Sans" -size 13
+    }
+    set text Hello!
+    destroy .t.c
+    set c [canvas .t.c]
+    set textid [$c create text 20 20 -font MyFont -text $text -anchor nw]
+    set twidth [font measure MyFont $text]
+    set theight [font metrics MyFont -linespace]
+    set circid [$c create polygon \
+		    15                    15 \
+		    [expr {15 + $twidth}] 15 \
+		    [expr {15 + $twidth}] [expr {15 + $theight}] \
+		    15                    [expr {15 + $theight}] \
+		    -width 1 -joinstyle round -smooth true -fill {} -outline blue]
+    pack $c -fill both -expand 1 -side top
+    tkwait visibility $c
+    
+    # Lamda test functions
+    set circle_text {{w user_data text circ} {
+	if {[winfo class $w] ne "Canvas"} {
+	    puts "Wrong widget type: $w"
+	    return
+	}
+	if {$user_data ne "FontChanged"} {
+	    return
+	}
+	lappend ::results called-$w
+	lassign [$w bbox $text] x0 y0 x1 y1
+	set offset 5
+	set coord [lmap expr {
+			      $x0-5 $y0-5   $x1+5 $y0-5
+			      $x1+5 $y1+5   $x0-5 $y1+5
+			  } {expr $expr}]
+	if {[catch {$w coord $circ $coord} err]} {
+	    puts Error:$err
+	}
+    }}
+    set waitfor {{tag {time 333}} {after $time incr ::wait4; vwait ::wait4}}
+    set enclosed {{can id} {$can find enclosed {*}[$can bbox $id]}}
+
+    set results {}
+    apply $circle_text $c FontChanged $textid $circid
+    bind $c <<TkWorldChanged>> [list apply $circle_text %W %d $textid $circid]
+    apply $waitfor 1
+
+    # Begin test:
+    set results {}
+    lappend results [apply $enclosed $c $circid]
+    font configure MyFont -size 26
+    apply $waitfor 2
+    lappend results [apply $enclosed $c $circid]
+    font configure MyFont -size 9
+    apply $waitfor 3
+    lappend results [apply $enclosed $c $circid]
+    apply $waitfor 4
+    font configure MyFont -size 12
+    apply $waitfor 5
+    lappend results [apply $enclosed $c $circid]
+} -cleanup {
+    destroy $c
+    unset -nocomplain ::results
+} -result {{1 2} called-.t.c {1 2} called-.t.c {1 2} called-.t.c {1 2}}
+
+test font-47.3 {Bug 3049518 - Label} -body {
+    if {"MyFont" ni [font names]} {
+	font create MyFont -family "Liberation Sans" -size 13
+    }
+    set text "Label Test"
+    destroy .t.l
+
+    set make-img {{size} {
+	set img [image create photo -width $size -height $size]
+	$img blank
+	set max [expr {$size - 1}]
+	for {set x 0} {$x < $size} {incr x} {
+	    $img put red -to $x $x
+	    $img put black -to 0 $x
+	    $img put black -to $x 0
+	    $img put black -to $max $x
+	    $img put black -to $x $max
+	}
+	return $img
+    }}
+    
+    set testWorldChanged {{w user_data} {
+	global make-img
+	if {$user_data ne "FontChanged"} {
+	    return
+	}
+	if {![winfo exists $w] || [winfo class $w] ne "Label"} {
+	    return
+	}
+	if {[$w cget -image] ne ""} {
+	    image delete [$w cget -image]
+	}
+	set size [font metrics [$w cget -font] -linespace]
+	set img [apply ${make-img} $size]
+	$w configure -image $img
+    }}
+
+    set waitfor {{tag {time 500}} {
+	after $time incr ::wait4
+	vwait ::wait4
+    }}
+
+    set check {{w} {
+	global results
+	set f [$w cget -font]
+	set i [$w cget -image]
+	set fs [font metrics $f -linespace]
+	set ish [image height $i]
+	set isw [image width $i]
+	lappend results [list [expr {$fs == $ish ? 1 : [list $fs $ish]}] [expr {$fs == $isw ? 1 : [list $fs $isw]}]]
+    }}
+
+    set size [font metrics MyFont -linespace]
+    set img [apply ${make-img} $size]
+    set l [label .t.l -compound left -image $img -text $text -font MyFont]
+    pack $l -side top -fill both -expand 1
+    bind $l <<TkWorldChanged>> [list apply $testWorldChanged %W %d]
+    set ::results {}
+
+    apply $waitfor 0
+    apply $check $l
+    font configure MyFont -size 26
+    apply $waitfor 1
+    apply $check $l
+    font configure MyFont -size 9
+    apply $waitfor 2
+    apply $check $l
+    font configure MyFont -size 13
+    apply $waitfor 3
+    apply $check $l
+    set results
+} -cleanup {
+    destroy $l
+    unset -nocomplain ::results
+} -result {{1 1} {1 1} {1 1} {1 1}}
+
 # cleanup
 cleanupTests
 return