From 7030cf99f16c6603e86afc939f24a1e1ae5e49bf Mon Sep 17 00:00:00 2001 From: fvogel Date: Sun, 21 Jan 2024 21:14:18 +0000 Subject: Fix [8da7af2f8e]: slow widget creation if default font is not used --- generic/tkFont.c | 1 + 1 file changed, 1 insertion(+) diff --git a/generic/tkFont.c b/generic/tkFont.c index 737d04c..cef6f86 100644 --- a/generic/tkFont.c +++ b/generic/tkFont.c @@ -1326,6 +1326,7 @@ Tk_GetFontFromObj( FreeFontObj(objPtr); fontPtr = NULL; } else if (Tk_Screen(tkwin) == fontPtr->screen) { + fontPtr->resourceRefCount++; return (Tk_Font) fontPtr; } } -- cgit v0.12 From 930bca60d127aadc6eb563edaac3cc8a59e58f6c Mon Sep 17 00:00:00 2001 From: fvogel Date: Sun, 21 Jan 2024 21:26:30 +0000 Subject: Let this bugfix branch build and test at Github Actions. --- .github/workflows/linux-build.yml | 1 + .github/workflows/mac-build.yml | 1 + .github/workflows/win-build.yml | 1 + 3 files changed, 3 insertions(+) diff --git a/.github/workflows/linux-build.yml b/.github/workflows/linux-build.yml index 9414037..bd1fe80 100644 --- a/.github/workflows/linux-build.yml +++ b/.github/workflows/linux-build.yml @@ -5,6 +5,7 @@ on: - "main" - "core-8-branch" - "core-8-6-branch" + - "bug-8da7af2f8e" tags: - "core-**" permissions: diff --git a/.github/workflows/mac-build.yml b/.github/workflows/mac-build.yml index 9fd297a..15fa320 100644 --- a/.github/workflows/mac-build.yml +++ b/.github/workflows/mac-build.yml @@ -5,6 +5,7 @@ on: - "main" - "core-8-branch" - "core-8-6-branch" + - "bug-8da7af2f8e" tags: - "core-**" permissions: diff --git a/.github/workflows/win-build.yml b/.github/workflows/win-build.yml index a0af658..cd8a95b 100644 --- a/.github/workflows/win-build.yml +++ b/.github/workflows/win-build.yml @@ -5,6 +5,7 @@ on: - "main" - "core-8-branch" - "core-8-6-branch" + - "bug-8da7af2f8e" tags: - "core-**" permissions: -- cgit v0.12 From e512946739a3d69a50f106ec6cdf14f30c42349f Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 22 Jan 2024 21:46:54 +0000 Subject: Test suite hygiene - Let font-17.1 and font-18.1 be independent from previous tests (interaction was with config-4.47 and config-4.48). --- tests/font.test | 31 ++++++++++++++++++------------- 1 file changed, 18 insertions(+), 13 deletions(-) diff --git a/tests/font.test b/tests/font.test index d57b998..9e84975 100644 --- a/tests/font.test +++ b/tests/font.test @@ -747,22 +747,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 +836,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_font1 -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_font1 } -result {{{1 3}} {{1 2}} {{1 1}} {}} -- cgit v0.12 From bfc6c158b58a9e1872e012842f7f0db790aa1e69 Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 22 Jan 2024 21:50:09 +0000 Subject: Fix typo --- tests/font.test | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/font.test b/tests/font.test index 9e84975..ec55284 100644 --- a/tests/font.test +++ b/tests/font.test @@ -836,7 +836,7 @@ test font-18.1 {FreeFontObjProc} -constraints testfont -setup { destroy .b1 set result {} } -body { - set f [font create font-18.1_font1 -family Courier -size 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 [list $f 50] { }] @@ -853,7 +853,7 @@ test font-18.1 {FreeFontObjProc} -constraints testfont -setup { set y bogus return $result } -cleanup { - font delete font-18.1_font1 + font delete font-18.1_font } -result {{{1 3}} {{1 2}} {{1 1}} {}} -- cgit v0.12 From f75524182f56f35a68bfb6f24ca83d38c8faaff8 Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 23 Jan 2024 20:23:51 +0000 Subject: Since we are here make font-15.1, font-15.2 and font-15.3 robust against previous fonts potentially used by the test suite. --- tests/font.test | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/tests/font.test b/tests/font.test index ec55284..4a264f8 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 { -- cgit v0.12 From cfd8ddff49dd35946a2b18b95661d067fecb40e1 Mon Sep 17 00:00:00 2001 From: fvogel Date: Fri, 26 Jan 2024 21:02:15 +0000 Subject: Fix [7e5f72c9dd]: Test script option.test deletes file option.file3 in Tk distribution --- tests/option.test | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/option.test b/tests/option.test index 8bc7f21..0d89ec5 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\xf3wn 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" -- cgit v0.12 From 748f5f9a656f5a308c1296c9217e47cb4fbe9db7 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 27 Jan 2024 22:40:22 +0000 Subject: Simplify some TIP #621 procs, since it's Tcl counterparts can (now) handle indices like "end-1" --- library/tk.tcl | 14 -------------- tests/cluster.test | 2 +- 2 files changed, 1 insertion(+), 15 deletions(-) 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 -- cgit v0.12