Merge 8.7

5 files changed, 33 insertions, 38 deletions

diff --git a/generic/tkFont.c b/generic/tkFont.c
index 87fa3d9..0f77a91 100644
--- a/generic/tkFont.c
+++ b/generic/tkFont.c
@@ -1329,6 +1329,7 @@ Tk_GetFontFromObj(
 	    FreeFontObj(objPtr);
 	    fontPtr = NULL;
 	} else if (Tk_Screen(tkwin) == fontPtr->screen) {
+	    fontPtr->resourceRefCount++;
 	    return (Tk_Font) fontPtr;
 	}
     }
diff --git a/library/tk.tcl b/library/tk.tcl
index ca58b6f..a9db88c 100644
--- a/library/tk.tcl
+++ b/library/tk.tcl
@@ -744,8 +744,6 @@ if {[info commands ::tk::startOfNextWord] eq ""} {
     proc ::tk::startOfNextWord {str start {locale {}}} {
 	if {$start < 0} {
 	    set start -1
-	} elseif {[string match end-* $start]} {
-	    set start [expr {[string length $str]-1-[string range $start 4 end]}]
 	}
 	set start [tcl_startOfNextWord $str $start]
 	if {$start < 0} {
@@ -758,8 +756,6 @@ if {[info commands ::tk::startOfPreviousWord] eq ""} {
     proc ::tk::startOfPreviousWord {str start {locale {}}} {
 	if {$start < 0} {
 	    set start -1
-	} elseif {[string match end-* $start]} {
-	    set start [expr {[string length $str]-1-[string range $start 4 end]}]
 	}
 	set start [tcl_startOfPreviousWord $str $start]
 	if {$start < 0} {
@@ -772,8 +768,6 @@ if {[info commands ::tk::wordBreakBefore] eq ""} {
     proc ::tk::wordBreakBefore {str start {locale {}}} {
 	if {$start < 0} {
 	    set start -1
-	} elseif {[string match end-* $start]} {
-	    set start [expr {[string length $str]-1-[string range $start 4 end]}]
 	}
 	set start [tcl_wordBreakBefore $str $start]
 	if {$start < 0} {
@@ -786,8 +780,6 @@ if {[info commands ::tk::wordBreakAfter] eq ""} {
     proc ::tk::wordBreakAfter {str start {locale {}}} {
 	if {$start < 0} {
 	    set start -1
-	} elseif {[string match end-* $start]} {
-	    set start [expr {[string length $str]-1-[string range $start 4 end]}]
 	}
 	set start [tcl_wordBreakAfter $str $start]
 	if {$start < 0} {
@@ -807,9 +799,6 @@ if {[info commands ::tk::endOfCluster] eq ""} {
 	} elseif {$start >= [string length $str]} {
 	    return ""
 	}
-	if {[string length [string index $str $start]] > 1} {
-	    incr start
-	}
 	incr start
 	return $start
     }
@@ -825,9 +814,6 @@ if {[info commands ::tk::startOfCluster] eq ""} {
 	} elseif {$start >= [string length $str]} {
 	    return [string length $str]
 	}
-	if {[string length [string index $str $start]] < 1} {
-	    incr start -1
-	}
 	if {$start < 0} {
 	    return ""
 	}
diff --git a/tests/cluster.test b/tests/cluster.test
index 724283a..998759e 100644
--- a/tests/cluster.test
+++ b/tests/cluster.test
@@ -122,7 +122,7 @@ test cluster-4.7 {::tk::startOfPreviousWord} -body {
 test cluster-4.8 {::tk::startOfPreviousWord} -body {
     ::tk::startOfPreviousWord "ab cd" {}
 } -result {}
-test cluster-4.9 {::tk::startOfPreviousWord} -body {
+test cluster-4.9 {::tk::startOfPreviousWord} -constraints needsTcl87 -body {
     ::tk::startOfPreviousWord "ab cd" end-1
 } -result 0
 
diff --git a/tests/font.test b/tests/font.test
index 9bf6d65..8794b98 100644
--- a/tests/font.test
+++ b/tests/font.test
@@ -596,12 +596,13 @@ test font-15.1 {Tk_AllocFontFromObj - converting internal reps} -constraints {
 } -setup {
     destroy .b1 .b2
 } -body {
-    set x {Times 16}
+    set x [font create font-15.1_font -family Times -size 16]
     lindex $x 0
     button .b1 -font $x
     lindex $x 0
-    testfont counts {Times 16}
+    testfont counts $x
 } -cleanup {
+    font delete font-15.1_font
     destroy .b1 .b2
 } -result {{1 0}}
 test font-15.2 {Tk_AllocFontFromObj - discard stale font} -constraints {
@@ -610,13 +611,14 @@ test font-15.2 {Tk_AllocFontFromObj - discard stale font} -constraints {
     destroy .b1 .b2
     set result {}
 } -body {
-    set x {Times 16}
+    set x [font create font-15.2_font -family Times -size 16]
     button .b1 -font $x
     destroy .b1
-    lappend result [testfont counts {Times 16}]
+    lappend result [testfont counts $x]
     button .b2 -font $x
-    lappend result [testfont counts {Times 16}]
+    lappend result [testfont counts $x]
 } -cleanup {
+    font delete font-15.2_font
     destroy .b2
 } -result {{} {{1 1}}}
 test font-15.3 {Tk_AllocFontFromObj - reuse existing font} -constraints {
@@ -625,13 +627,14 @@ test font-15.3 {Tk_AllocFontFromObj - reuse existing font} -constraints {
     destroy .b1 .b2
     set result {}
 } -body {
-    set x {Times 16}
+    set x [font create font-15.3_font -family Times -size 16]
     button .b1 -font $x
-    lappend result [testfont counts {Times 16}]
+    lappend result [testfont counts $x]
     button .b2 -font $x
     pack .b1 .b2 -side top
-    lappend result [testfont counts {Times 16}]
+    lappend result [testfont counts $x]
 } -cleanup {
+    font delete font-15.3_font
     destroy .b1 .b2
 } -result {{{1 1}} {{2 1}}}
 test font-15.4 {Tk_AllocFontFromObj procedure: bump ref count} -setup {
@@ -747,22 +750,24 @@ test font-16.1 {Tk_NameOfFont procedure} -setup {
 
 
 test font-17.1 {Tk_FreeFontFromObj - reference counts} -constraints {
-	testfont
+    testfont
 } -setup {
     destroy .b1 .b2 .b3
     set result {}
 } -body {
-    set x {Courier 12}
+    set x [font create font-17.1_font -family Courier -size 12]
     button .b1 -font $x
     button .b3 -font $x
     button .b2 -font $x
-    lappend result [testfont counts {Courier 12}]
+    lappend result [testfont counts $x]
     destroy .b1
-    lappend result [testfont counts {Courier 12}]
+    lappend result [testfont counts $x]
     destroy .b2
-    lappend result [testfont counts {Courier 12}]
+    lappend result [testfont counts $x]
     destroy .b3
-    lappend result [testfont counts {Courier 12}]
+    lappend result [testfont counts $x]
+} -cleanup {
+    font delete font-17.1_font
 } -result {{{3 1}} {{2 1}} {{1 1}} {}}
 test font-17.2 {Tk_FreeFont procedure: one ref} -setup {
     destroy .t.f
@@ -834,21 +839,24 @@ test font-18.1 {FreeFontObjProc} -constraints testfont -setup {
     destroy .b1
     set result {}
 } -body {
-    set x [join {Courier 12} { }]
+    set f [font create font-18.1_font -family Courier -size 12]
+    set x [join [list $f 50] { }]
     button .b1 -font $x
-    set y [join {Courier 12} { }]
+    set y [join [list $f 50] { }]
     .b1 configure -font $y
-    set z [join {Courier 12} { }]
+    set z [join [list $f 50] { }]
     .b1 configure -font $z
-    lappend result [testfont counts {Courier 12}]
+    lappend result [testfont counts [list $f 50]]
     set x red
-    lappend result [testfont counts {Courier 12}]
+    lappend result [testfont counts [list $f 50]]
     set z 32
-    lappend result [testfont counts {Courier 12}]
+    lappend result [testfont counts [list $f 50]]
     destroy .b1
-    lappend result [testfont counts {Courier 12}]
+    lappend result [testfont counts [list $f 50]]
     set y bogus
     return $result
+} -cleanup {
+    font delete font-18.1_font
 } -result {{{1 3}} {{1 2}} {{1 1}} {}}
 
 
diff --git a/tests/option.test b/tests/option.test
index 3b6ce31..ad802bd 100644
--- a/tests/option.test
+++ b/tests/option.test
@@ -404,7 +404,7 @@ option read $option3
 test option-15.11 {database files} {option get . {x 4} color} brówn
 
 test option-16.1 {ReadOptionFile} -body {
-    set option4 [makeFile {} option.file3]
+    set option4 [makeFile {} option.file4]
     set file [open $option4 w]
     fconfigure $file -translation crlf
     puts $file "*x7: true\n*x8: false"
@@ -422,7 +422,7 @@ set opt162val {label {
 set opt162list [split $opt162val \n]
 
 test option-16.2 {ticket 766ef52f3} -body {
-    set option5 [makeFile {} option.file4]
+    set option5 [makeFile {} option.file5]
     set file [open $option5 w]
     fconfigure $file -translation crlf
     puts $file "*notok: $opt162list"