Attachment "test_sections.patch" to
ticket [7caf9e9e]
added by
erikleunissen
2026-06-11 12:29:01.
Index: tests/imgPhInstance.test
==================================================================
--- tests/imgPhInstance.test
+++ tests/imgPhInstance.test
@@ -27,15 +27,44 @@
source [file join [tcltest::configure -testdir] main.tcl]
# Ensure a pristine initial window state
resetWindows
-# Local constraints
+#
+# LOCAL TEST CONSTRAINTS
+#
+
testConstraint testpixel [expr {[llength [info commands testpixel]] > 0}]
testConstraint pixelProbe [expr {
[testConstraint testpixel] && [winfo screendepth .] >= 24
}]
+
+#
+# LOCAL UTILITY PROCS
+#
+
+# blendOver --
+# Expected result of compositing src at the given alpha over dst.
+proc blendOver {src dst alpha} {
+ scan $src "#%2x%2x%2x" sr sg sb
+ scan $dst "#%2x%2x%2x" dr dg db
+ set beta [expr {255 - $alpha}]
+ return [format "#%02x%02x%02x" \
+ [expr {round(($sr*$alpha + $dr*$beta) / 255.0)}] \
+ [expr {round(($sg*$alpha + $dg*$beta) / 255.0)}] \
+ [expr {round(($sb*$alpha + $db*$beta) / 255.0)}]]
+}
+
+# pixelNear --
+# 1 if the window pixel at (x,y) matches color within tol per channel.
+proc pixelNear {w x y color {tol 2}} {
+ scan [testpixel $w $x $y] "#%2x%2x%2x" r g b
+ scan $color "#%2x%2x%2x" er eg eb
+ return [expr {
+ abs($r - $er) <= $tol && abs($g - $eg) <= $tol && abs($b - $eb) <= $tol
+ }]
+}
#
# COMMON TEST SETUP
#
@@ -80,32 +109,10 @@
photo.big put #ff800080 -to 0 0 150 150
photo.big put #00c00080 -to 150 0 300 150
photo.big put #ffffff80 -to 0 150 150 300
photo.big put #00000080 -to 150 150 300 300
-# blendOver --
-# Expected result of compositing src at the given alpha over dst.
-proc blendOver {src dst alpha} {
- scan $src "#%2x%2x%2x" sr sg sb
- scan $dst "#%2x%2x%2x" dr dg db
- set beta [expr {255 - $alpha}]
- return [format "#%02x%02x%02x" \
- [expr {round(($sr*$alpha + $dr*$beta) / 255.0)}] \
- [expr {round(($sg*$alpha + $dg*$beta) / 255.0)}] \
- [expr {round(($sb*$alpha + $db*$beta) / 255.0)}]]
-}
-
-# pixelNear --
-# 1 if the window pixel at (x,y) matches color within tol per channel.
-proc pixelNear {w x y color {tol 2}} {
- scan [testpixel $w $x $y] "#%2x%2x%2x" r g b
- scan $color "#%2x%2x%2x" er eg eb
- return [expr {
- abs($r - $er) <= $tol && abs($g - $eg) <= $tol && abs($b - $eb) <= $tol
- }]
-}
-
#
# TESTS
#
# 1.* -- the three alpha tiers
Index: tests/ttk/nodecache.test
==================================================================
--- tests/ttk/nodecache.test
+++ tests/ttk/nodecache.test
@@ -2,10 +2,11 @@
# Tests for the ttk per-node element render cache in the file
# generic/ttk/ttkNodeCache.c, and its plumbing in ttkImage.c (element
# cache policy, content epoch, opacity classification), ttkTheme.c
# (Ttk_ElementGetCacheInfo) and ttkLayout.c (cached draw traversal).
#
+
# NOTES
#
# * The cache is observed in two ways:
#
# - tktest's "test" image type logs "<image> display ..." to a variable
@@ -42,11 +43,14 @@
# The pixel-probe tests read rendered pixels back from the live screen;
# keep the root window on-screen and on top so nothing overlaps it.
wm geometry . +0+0
raise .
-# Local constraints
+#
+# LOCAL TEST CONSTRAINTS
+#
+
testConstraint testpixel [expr {[llength [info commands testpixel]] > 0}]
testConstraint pixelProbe [expr {
[testConstraint testpixel] && [winfo screendepth .] >= 24
}]
