From ce91055e029a05502dec2d034254f01414be59e2 Mon Sep 17 00:00:00 2001 From: Tienson Qin Date: Tue, 13 Oct 2026 04:30:05 +0800 Subject: [PATCH 1/7] fix(native): mask secure-field text before it reaches the renderer MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit A secure-field's real text went straight into the text hook and painted as plaintext; the a11y password flag only marks the tree. The paint pass now substitutes one bullet per grapheme before the string reaches the text engine, and the window text engines apply the same mask to any string that bypasses the paint resolver (the IME composition overlay's marked text) and to every geometry answer — measure, caret prefix, pointer-to-offset — so caret/selection/IME geometry is computed on the masked text. Masked hit offsets map back to real byte offsets through the same grapheme boundaries. The grapheme segmenter is a compact UAX #29 subset kept engine-free in Lui_paint so paint and all three window engines share one mask shape. The gallery cell no longer hides the bug behind a literal "********" — it passes a real value and relies on the mask. Tests: lui_paint_test asserts the text hook only ever receives the mask (fails on the old code, which handed it the plaintext), plus grapheme/mask/offset-mapping unit cases. Generated with [Devin](https://devin.ai) Co-Authored-By: Devin <158243242+devin-ai-integration[bot]@users.noreply.github.com> --- platform/native/lui_gallery/lui_gallery.ml | 2 +- platform/native/lui_paint/lui_paint.ml | 349 +++++++++++++++++- .../native/lui_paint/test/lui_paint_test.ml | 86 +++++ platform/native/lui_window/lui_window_text.ml | 23 +- .../lui_window_linux/lui_window_text.ml | 23 +- .../lui_window_windows/lui_window_text.ml | 23 +- 6 files changed, 495 insertions(+), 11 deletions(-) diff --git a/platform/native/lui_gallery/lui_gallery.ml b/platform/native/lui_gallery/lui_gallery.ml index 235d462b..824e62a6 100644 --- a/platform/native/lui_gallery/lui_gallery.ml +++ b/platform/native/lui_gallery/lui_gallery.ml @@ -363,7 +363,7 @@ let cells : cell list = @ [ (FocusShadow, sv "0 0 0 3px rgba(59 130 246 / 40%)") ])) ()); cell "secure_field" "secure-field" "masked secret" (n SecureField ~cov:true - ~props:(sized ~h:30. ([ (TextValue, sv "********") ] @ bordered)) ()); + ~props:(sized ~h:30. ([ (TextValue, sv "hunter2 secret") ] @ bordered)) ()); cell "input" "input" "bare input" (n Input ~cov:true ~props:(sized ~h:28. ([ (TextValue, sv "Plain input") ] @ bordered)) ()); cell "search_field" "search-field" "placeholder" diff --git a/platform/native/lui_paint/lui_paint.ml b/platform/native/lui_paint/lui_paint.ml index f013fdbb..e660d984 100644 --- a/platform/native/lui_paint/lui_paint.ml +++ b/platform/native/lui_paint/lui_paint.ml @@ -1020,13 +1020,360 @@ let text_placement_of store id = in { tp_align = align; tp_pad_x = pad_x; tp_pad_y = pad_y; tp_top = top } +(* ---------- secure-field masking ---------- *) + +(* The glyph a secure field substitutes for every grapheme of its + text — U+2022 BULLET, the platform password-field convention. *) +let mask_char = "\xe2\x80\xa2" +let mask_char_len = String.length mask_char + +(* A compact UAX #29 grapheme-cluster segmenter, engine-free: the + paint pass must count graphemes to mask a secure field without + depending on any platform text engine, and the window engines map + masked caret offsets back through the same boundaries. Rules + covered: CRxLF, hard breaks around controls, Hangul L/V/T chains, + Extend/ZWJ joins, SpacingMark and Prepend attachments, emoji ZWJ + sequences and regional-indicator pairs. A codepoint the tables + miss lands on [G_other] and starts its own cluster — for masking + that only means one bullet too many, never a plaintext leak. *) +type gcb = + | G_other | G_cr | G_lf | G_control | G_extend | G_zwj | G_ri + | G_prepend | G_spacing | G_extpict | G_l | G_v | G_t | G_lv + | G_lvt + +(* Sorted inclusive codepoint ranges, binary-searched. *) +let in_ranges tbl cp = + let rec go lo hi = + if lo > hi then false + else + let mid = (lo + hi) / 2 in + let a, b = tbl.(mid) in + if cp < a then go lo (mid - 1) + else if cp > b then go (mid + 1) hi + else true + in + go 0 (Array.length tbl - 1) + +let gcb_extend = + [| (0x0300, 0x036F); (0x0483, 0x0489); (0x0591, 0x05BD); (0x05BF, 0x05BF); + (0x05C1, 0x05C2); (0x05C4, 0x05C5); (0x05C7, 0x05C7); (0x0610, 0x061A); + (0x064B, 0x065F); (0x0670, 0x0670); (0x06D6, 0x06DC); (0x06DF, 0x06E4); + (0x06E7, 0x06E8); (0x06EA, 0x06ED); (0x0711, 0x0711); (0x0730, 0x074A); + (0x07A6, 0x07B0); (0x07EB, 0x07F3); (0x07FD, 0x07FD); (0x0816, 0x0819); + (0x081B, 0x0823); (0x0825, 0x0827); (0x0829, 0x082D); (0x0859, 0x085B); + (0x0898, 0x089F); (0x08CA, 0x0902); (0x093A, 0x093A); (0x093C, 0x093C); + (0x0941, 0x0948); (0x094D, 0x094D); (0x0951, 0x0957); (0x0962, 0x0963); + (0x0981, 0x0981); (0x09BC, 0x09BC); (0x09C1, 0x09C4); (0x09CD, 0x09CD); + (0x09E2, 0x09E3); (0x09FE, 0x09FE); (0x0A01, 0x0A02); (0x0A3C, 0x0A3C); + (0x0A41, 0x0A42); (0x0A47, 0x0A48); (0x0A4B, 0x0A4D); (0x0A51, 0x0A51); + (0x0A70, 0x0A71); (0x0A75, 0x0A75); (0x0A81, 0x0A82); (0x0ABC, 0x0ABC); + (0x0AC1, 0x0AC5); (0x0AC7, 0x0AC8); (0x0ACD, 0x0ACD); (0x0AE2, 0x0AE3); + (0x0AFA, 0x0AFF); (0x0B01, 0x0B01); (0x0B3C, 0x0B3C); (0x0B3F, 0x0B3F); + (0x0B41, 0x0B44); (0x0B4D, 0x0B4D); (0x0B55, 0x0B56); (0x0B62, 0x0B63); + (0x0B82, 0x0B82); (0x0BC0, 0x0BC0); (0x0BCD, 0x0BCD); (0x0C00, 0x0C00); + (0x0C04, 0x0C04); (0x0C3C, 0x0C3C); (0x0C3E, 0x0C40); (0x0C46, 0x0C48); + (0x0C4A, 0x0C4D); (0x0C55, 0x0C56); (0x0C62, 0x0C63); (0x0C81, 0x0C81); + (0x0CBC, 0x0CBC); (0x0CBF, 0x0CBF); (0x0CC6, 0x0CC6); (0x0CCC, 0x0CCD); + (0x0CE2, 0x0CE3); (0x0D00, 0x0D01); (0x0D3B, 0x0D3C); (0x0D41, 0x0D44); + (0x0D4D, 0x0D4D); (0x0D62, 0x0D63); (0x0D81, 0x0D81); (0x0DCA, 0x0DCA); + (0x0DD2, 0x0DD4); (0x0DD6, 0x0DD6); (0x0E31, 0x0E31); (0x0E34, 0x0E3A); + (0x0E47, 0x0E4E); (0x0EB1, 0x0EB1); (0x0EB4, 0x0EBC); (0x0EC8, 0x0ECE); + (0x0F18, 0x0F19); (0x0F35, 0x0F35); (0x0F37, 0x0F37); (0x0F39, 0x0F39); + (0x0F71, 0x0F7E); (0x0F80, 0x0F84); (0x0F86, 0x0F87); (0x0F8D, 0x0F97); + (0x0F99, 0x0FBC); (0x0FC6, 0x0FC6); (0x102D, 0x1030); (0x1032, 0x1037); + (0x1039, 0x103A); (0x103D, 0x103E); (0x1058, 0x1059); (0x105E, 0x1060); + (0x1071, 0x1074); (0x1082, 0x1082); (0x1085, 0x1086); (0x108D, 0x108D); + (0x109D, 0x109D); (0x135D, 0x135F); (0x1712, 0x1714); (0x1732, 0x1734); + (0x1752, 0x1753); (0x1772, 0x1773); (0x17B4, 0x17B5); (0x17B7, 0x17BD); + (0x17C6, 0x17C6); (0x17C9, 0x17D3); (0x17DD, 0x17DD); (0x180B, 0x180D); + (0x180F, 0x180F); (0x18A9, 0x18A9); (0x1920, 0x1922); (0x1927, 0x1928); + (0x1932, 0x1932); (0x1939, 0x193B); (0x1A17, 0x1A18); (0x1A1B, 0x1A1B); + (0x1A56, 0x1A56); (0x1A58, 0x1A5E); (0x1A60, 0x1A60); (0x1A62, 0x1A62); + (0x1A65, 0x1A6C); (0x1A73, 0x1A7C); (0x1A7F, 0x1A7F); (0x1AB0, 0x1ACE); + (0x1B00, 0x1B03); (0x1B34, 0x1B34); (0x1B36, 0x1B3A); (0x1B3C, 0x1B3C); + (0x1B42, 0x1B42); (0x1B6B, 0x1B73); (0x1B80, 0x1B81); (0x1BA2, 0x1BA5); + (0x1BA8, 0x1BA9); (0x1BAB, 0x1BAD); (0x1BE6, 0x1BE6); (0x1BE8, 0x1BE9); + (0x1BED, 0x1BED); (0x1BEF, 0x1BF1); (0x1C2C, 0x1C33); (0x1C36, 0x1C37); + (0x1CD0, 0x1CD2); (0x1CD4, 0x1CE0); (0x1CE2, 0x1CE8); (0x1CED, 0x1CED); + (0x1CF4, 0x1CF4); (0x1CF7, 0x1CF9); (0x1DC0, 0x1DF9); (0x1DFB, 0x1DFF); + (0x20D0, 0x20F0); (0x2CEF, 0x2CF1); (0x2D7F, 0x2D7F); (0x2DE0, 0x2DFF); + (0x302A, 0x302D); (0x3099, 0x309A); (0xA66F, 0xA672); (0xA674, 0xA67D); + (0xA69E, 0xA69F); (0xA6F0, 0xA6F1); (0xA802, 0xA802); (0xA806, 0xA806); + (0xA80B, 0xA80B); (0xA825, 0xA826); (0xA82C, 0xA82C); (0xA8C4, 0xA8C5); + (0xA8E0, 0xA8F1); (0xA8FF, 0xA8FF); (0xA926, 0xA92D); (0xA947, 0xA951); + (0xA980, 0xA982); (0xA9B3, 0xA9B3); (0xA9B6, 0xA9B9); (0xA9BC, 0xA9BD); + (0xA9E5, 0xA9E5); (0xAA29, 0xAA2E); (0xAA31, 0xAA32); (0xAA35, 0xAA36); + (0xAA43, 0xAA43); (0xAA4C, 0xAA4C); (0xAA7C, 0xAA7C); (0xAAB0, 0xAAB0); + (0xAAB2, 0xAAB4); (0xAAB7, 0xAAB8); (0xAABE, 0xAABF); (0xAAC1, 0xAAC1); + (0xAAEC, 0xAAED); (0xAAF6, 0xAAF6); (0xABE5, 0xABE5); (0xABE8, 0xABE8); + (0xABED, 0xABED); (0xFB1E, 0xFB1E); (0xFE00, 0xFE0F); (0xFE20, 0xFE2F); + (0x101FD, 0x101FD); (0x102E0, 0x102E0); (0x10376, 0x1037A); + (0x10A01, 0x10A03); (0x10A05, 0x10A06); (0x10A0C, 0x10A0F); + (0x10A38, 0x10A3A); (0x10A3F, 0x10A3F); (0x10AE5, 0x10AE6); + (0x10D24, 0x10D27); (0x10EAB, 0x10EAC); (0x10F46, 0x10F50); + (0x10F82, 0x10F82); (0x11001, 0x11001); (0x11038, 0x11046); + (0x11070, 0x11070); (0x11073, 0x11074); (0x1107F, 0x1107F); + (0x110B3, 0x110B6); (0x110B9, 0x110BA); (0x11100, 0x11102); + (0x11127, 0x1112B); (0x1112D, 0x11134); (0x11173, 0x11173); + (0x11180, 0x11181); (0x111B6, 0x111BE); (0x111C9, 0x111CC); + (0x111CF, 0x111CF); (0x1122F, 0x11231); (0x11234, 0x11234); + (0x11236, 0x11237); (0x1123E, 0x1123E); (0x112DF, 0x112DF); + (0x1133B, 0x1133C); (0x11340, 0x11340); (0x11366, 0x1136C); + (0x11370, 0x11374); (0x11438, 0x1143F); (0x11442, 0x11444); + (0x11446, 0x11446); (0x1145E, 0x1145E); (0x114B3, 0x114B8); + (0x114BA, 0x114BA); (0x114BF, 0x114C0); (0x114C2, 0x114C3); + (0x115B2, 0x115B5); (0x115BC, 0x115BD); (0x115BF, 0x115C0); + (0x115DC, 0x115DD); (0x11633, 0x1163A); (0x1163D, 0x1163D); + (0x1163F, 0x11640); (0x116AB, 0x116AB); (0x116AD, 0x116AD); + (0x116B0, 0x116B5); (0x116B7, 0x116B7); (0x1171D, 0x1171F); + (0x11722, 0x11725); (0x11727, 0x1172B); (0x1182F, 0x11837); + (0x11839, 0x1183A); (0x1193B, 0x1193C); (0x1193E, 0x1193E); + (0x11943, 0x11943); (0x119D4, 0x119D7); (0x119DA, 0x119DB); + (0x119E0, 0x119E0); (0x11A01, 0x11A0A); (0x11A33, 0x11A38); + (0x11A3B, 0x11A3E); (0x11A47, 0x11A47); (0x11A51, 0x11A56); + (0x11A59, 0x11A5B); (0x11A8A, 0x11A96); (0x11A98, 0x11A99); + (0x11C30, 0x11C36); (0x11C38, 0x11C3D); (0x11C3F, 0x11C3F); + (0x11C92, 0x11CA7); (0x11CAA, 0x11CB0); (0x11CB2, 0x11CB3); + (0x11CB5, 0x11CB6); (0x11D31, 0x11D36); (0x11D3A, 0x11D3A); + (0x11D3C, 0x11D3D); (0x11D3F, 0x11D45); (0x11D47, 0x11D47); + (0x11D90, 0x11D91); (0x11D95, 0x11D95); (0x11D97, 0x11D97); + (0x11EF3, 0x11EF4); (0x16AF0, 0x16AF4); (0x16B30, 0x16B36); + (0x16F4F, 0x16F4F); (0x16F8F, 0x16F92); (0x1BC9D, 0x1BC9E); + (0x1D167, 0x1D169); (0x1D17B, 0x1D182); (0x1D185, 0x1D18B); + (0x1D1AA, 0x1D1AD); (0x1D242, 0x1D244); (0x1DA00, 0x1DA36); + (0x1DA3B, 0x1DA6C); (0x1DA75, 0x1DA75); (0x1DA84, 0x1DA84); + (0x1DA9B, 0x1DA9F); (0x1DAA1, 0x1DAAF); (0x1E000, 0x1E006); + (0x1E008, 0x1E018); (0x1E01B, 0x1E021); (0x1E023, 0x1E024); + (0x1E026, 0x1E02A); (0x1E130, 0x1E136); (0x1E2AE, 0x1E2AE); + (0x1E2EC, 0x1E2EF); (0x1E8D0, 0x1E8D6); (0x1E944, 0x1E94A); + (0x1F3FB, 0x1F3FF); (0xE0020, 0xE007F); (0xE0100, 0xE01EF) |] + +let gcb_spacing = + [| (0x0903, 0x0903); (0x093B, 0x093B); (0x093E, 0x0940); (0x0949, 0x094C); + (0x094E, 0x094F); (0x0982, 0x0983); (0x09BE, 0x09C0); (0x09C7, 0x09C8); + (0x09CB, 0x09CC); (0x09D7, 0x09D7); (0x0A03, 0x0A03); (0x0A3E, 0x0A40); + (0x0A83, 0x0A83); (0x0ABE, 0x0AC0); (0x0AC9, 0x0AC9); (0x0ACB, 0x0ACC); + (0x0B02, 0x0B03); (0x0BBE, 0x0BBE); (0x0BC1, 0x0BC2); (0x0BC6, 0x0BC8); + (0x0BCA, 0x0BCC); (0x0BD7, 0x0BD7); (0x0C01, 0x0C03); (0x0C41, 0x0C44); + (0x0C82, 0x0C83); (0x0CBE, 0x0CBE); (0x0CC0, 0x0CC4); (0x0CC7, 0x0CC8); + (0x0CCA, 0x0CCB); (0x0CD5, 0x0CD6); (0x0D02, 0x0D03); (0x0D3E, 0x0D40); + (0x0D46, 0x0D48); (0x0D4A, 0x0D4C); (0x0D57, 0x0D57); (0x0D82, 0x0D83); + (0x0DCF, 0x0DD1); (0x0DD8, 0x0DDF); (0x0DF2, 0x0DF3); (0x0F3E, 0x0F3F); + (0x0F7F, 0x0F7F); (0x102B, 0x102C); (0x1031, 0x1031); (0x1038, 0x1038); + (0x103B, 0x103C); (0x1056, 0x1057); (0x1062, 0x1064); (0x1067, 0x106D); + (0x1083, 0x1084); (0x1087, 0x108C); (0x108F, 0x108F); (0x109A, 0x109C); + (0x17B6, 0x17B6); (0x17BE, 0x17C5); (0x17C7, 0x17C8); (0x1923, 0x1926); + (0x1929, 0x192B); (0x1930, 0x1931); (0x1933, 0x1938); (0x1A19, 0x1A1A); + (0x1A55, 0x1A55); (0x1A57, 0x1A57); (0x1A61, 0x1A61); (0x1A63, 0x1A64); + (0x1A6D, 0x1A72); (0x1B04, 0x1B04); (0x1B35, 0x1B35); (0x1B3B, 0x1B3B); + (0x1B3D, 0x1B41); (0x1B43, 0x1B44); (0x1B82, 0x1B82); (0x1BA1, 0x1BA1); + (0x1BA6, 0x1BA7); (0x1BAA, 0x1BAA); (0x1BE7, 0x1BE7); (0x1BEA, 0x1BEC); + (0x1BEE, 0x1BEE); (0x1BF2, 0x1BF3); (0x1C24, 0x1C2B); (0x1C34, 0x1C35); + (0x1CE1, 0x1CE1); (0x302E, 0x302F); (0xA823, 0xA824); (0xA827, 0xA827); + (0xA880, 0xA881); (0xA8B4, 0xA8C3); (0xA952, 0xA953); (0xA983, 0xA983); + (0xA9B4, 0xA9B5); (0xA9BA, 0xA9BB); (0xA9BE, 0xA9C0); (0xAA2F, 0xAA30); + (0xAA33, 0xAA34); (0xAA4D, 0xAA4D); (0xAA7B, 0xAA7B); (0xAA7D, 0xAA7D); + (0xAAEB, 0xAAEB); (0xAAEE, 0xAAEF); (0xAAF5, 0xAAF5); (0xABE3, 0xABE4); + (0xABE6, 0xABE7); (0xABE9, 0xABEA); (0xABEC, 0xABEC); (0x11000, 0x11000); + (0x11002, 0x11002); (0x11082, 0x11082); (0x110B0, 0x110B2); + (0x110B7, 0x110B8); (0x1112C, 0x1112C); (0x11145, 0x11146); + (0x11182, 0x11182); (0x111B3, 0x111B5); (0x111BF, 0x111C0); + (0x111CE, 0x111CE); (0x1122C, 0x1122E); (0x11232, 0x11233); + (0x11235, 0x11235); (0x112E0, 0x112E2); (0x11302, 0x11303); + (0x1133E, 0x1133F); (0x11341, 0x11344); (0x11347, 0x11348); + (0x1134D, 0x1134D); (0x11357, 0x11357); (0x11362, 0x11363); + (0x11435, 0x11437); (0x11440, 0x11441); (0x11445, 0x11445); + (0x114B0, 0x114B2); (0x114B9, 0x114B9); (0x114BB, 0x114BE); + (0x114C1, 0x114C1); (0x115AF, 0x115B1); (0x115B8, 0x115BB); + (0x115BE, 0x115BE); (0x11630, 0x11632); (0x1163B, 0x1163C); + (0x1163E, 0x1163E); (0x116AC, 0x116AC); (0x116AE, 0x116AF); + (0x116B6, 0x116B6); (0x11720, 0x11721); (0x11726, 0x11726); + (0x1182C, 0x1182E); (0x11838, 0x11838); (0x11930, 0x11935); + (0x11937, 0x11938); (0x1193D, 0x1193D); (0x11940, 0x11940); + (0x11942, 0x11942); (0x119D1, 0x119D3); (0x119DC, 0x119DF); + (0x119E4, 0x119E4); (0x11A39, 0x11A39); (0x11A57, 0x11A58); + (0x11A97, 0x11A97); (0x11C2F, 0x11C2F); (0x11C3E, 0x11C3E); + (0x11CA9, 0x11CA9); (0x11CB1, 0x11CB1); (0x11CB4, 0x11CB4); + (0x11D8A, 0x11D8E); (0x11D93, 0x11D94); (0x11D96, 0x11D96); + (0x11EF5, 0x11EF6); (0x11F03, 0x11F03); (0x11F34, 0x11F3A); + (0x11F3E, 0x11F3F); (0x11F41, 0x11F41); (0x16F51, 0x16F87); + (0x16FF0, 0x16FF1); (0x1D165, 0x1D166); (0x1D16D, 0x1D172) |] + +let gcb_prepend = + [| (0x0600, 0x0605); (0x06DD, 0x06DD); (0x070F, 0x070F); + (0x0890, 0x0891); (0x08E2, 0x08E2); (0x0D4E, 0x0D4E); + (0x110BD, 0x110BD); (0x110CD, 0x110CD); (0x111C2, 0x111C3); + (0x1193D, 0x1193D); (0x11941, 0x11941); (0x11A3A, 0x11A3A); + (0x11A84, 0x11A89); (0x11D46, 0x11D46) |] + +(* C0/C1 controls, DEL, soft hyphen, bidi and joiner-adjacent format + characters — everything that hard-breaks a cluster. *) +let gcb_control = + [| (0x0000, 0x0009); (0x000B, 0x000C); (0x000E, 0x001F); + (0x007F, 0x009F); (0x00AD, 0x00AD); (0x061C, 0x061C); + (0x180E, 0x180E); (0x200B, 0x200C); (0x200E, 0x200F); + (0x202A, 0x202E); (0x2060, 0x2064); (0x2066, 0x206F); + (0xFEFF, 0xFEFF); (0xFFF9, 0xFFFB); (0xE0001, 0xE0001); + (0xE0002, 0xE001F) |] + +let gcb_ri = [| (0x1F1E6, 0x1F1FF) |] + +(* Extended_Pictographic: the emoji that join through ZWJ. Ranges are + generous — a stray non-emoji only ever fuses with an explicit ZWJ + chain, so over-inclusion cannot split a real cluster. *) +let gcb_extpict = + [| (0x00A9, 0x00A9); (0x00AE, 0x00AE); (0x203C, 0x203C); (0x2049, 0x2049); + (0x2122, 0x2122); (0x2139, 0x2139); (0x2194, 0x2199); (0x21A9, 0x21AA); + (0x231A, 0x231B); (0x2328, 0x2328); (0x2388, 0x2388); (0x23CF, 0x23CF); + (0x23E9, 0x23F3); (0x23F8, 0x23FA); (0x24C2, 0x24C2); (0x25AA, 0x25AB); + (0x25B6, 0x25B6); (0x25C0, 0x25C0); (0x25FB, 0x25FE); (0x2600, 0x26FF); + (0x2700, 0x27BF); (0x2934, 0x2935); (0x2B05, 0x2B07); (0x2B1B, 0x2B1C); + (0x2B50, 0x2B50); (0x2B55, 0x2B55); (0x3030, 0x3030); (0x303D, 0x303D); + (0x3297, 0x3297); (0x3299, 0x3299); (0x1F000, 0x1F0FF); + (0x1F10D, 0x1F10F); (0x1F12F, 0x1F12F); (0x1F16C, 0x1F171); + (0x1F17E, 0x1F17F); (0x1F18E, 0x1F18E); (0x1F191, 0x1F19A); + (0x1F1AD, 0x1F1E5); (0x1F201, 0x1F20F); (0x1F21A, 0x1F21A); + (0x1F22F, 0x1F22F); (0x1F232, 0x1F23A); (0x1F23C, 0x1F23F); + (0x1F249, 0x1FAFF) |] + +let gcb_l = [| (0x1100, 0x115F); (0xA960, 0xA97C) |] +let gcb_v = [| (0x1160, 0x11A7); (0xD7B0, 0xD7C6) |] +let gcb_t = [| (0x11A8, 0x11FF); (0xD7CB, 0xD7FB) |] + +let gcb_of cp = + if cp = 0x0D then G_cr + else if cp = 0x0A then G_lf + else if cp = 0x200D then G_zwj + else if cp >= 0xAC00 && cp <= 0xD7A3 then + if (cp - 0xAC00) mod 28 = 0 then G_lv else G_lvt + else if in_ranges gcb_l cp then G_l + else if in_ranges gcb_v cp then G_v + else if in_ranges gcb_t cp then G_t + else if in_ranges gcb_ri cp then G_ri + else if in_ranges gcb_extend cp then G_extend + else if in_ranges gcb_prepend cp then G_prepend + else if in_ranges gcb_spacing cp then G_spacing + else if in_ranges gcb_extpict cp then G_extpict + else if in_ranges gcb_control cp then G_control + else G_other + +(* The next UTF-8 sequence: (codepoint, index after it). A malformed + or truncated byte decodes as one U+FFFD unit so the segmenter keeps + moving on any input a store prop can carry. *) +let utf8_decode s i = + let n = String.length s in + let byte k = Char.code s.[k] in + let cont k = k < n && byte k land 0xC0 = 0x80 in + let c = byte i in + if c < 0x80 then (c, i + 1) + else if c >= 0xC2 && c < 0xE0 && cont (i + 1) then + (((c land 0x1F) lsl 6) lor (byte (i + 1) land 0x3F), i + 2) + else if c >= 0xE0 && c < 0xF0 && cont (i + 1) && cont (i + 2) then + (((c land 0x0F) lsl 12) + lor ((byte (i + 1) land 0x3F) lsl 6) + lor (byte (i + 2) land 0x3F), + i + 3) + else if c >= 0xF0 && c < 0xF5 && cont (i + 1) && cont (i + 2) + && cont (i + 3) + then + (((c land 0x07) lsl 18) + lor ((byte (i + 1) land 0x3F) lsl 12) + lor ((byte (i + 2) land 0x3F) lsl 6) + lor (byte (i + 3) land 0x3F), + i + 4) + else (0xFFFD, i + 1) + +(* [grapheme_bounds s] is the sorted array of byte offsets where + grapheme clusters start or end — the same contract the platform + engines' [graphemes] carry: it holds [0] and [String.length s], so + consecutive entries delimit the clusters. *) +let grapheme_bounds s = + let n = String.length s in + if n = 0 then [| 0 |] + else begin + let acc = ref [ 0 ] in + let prev = ref G_other in + (* consecutive regional indicators inside the running cluster — a + flag forms per pair *) + let ri_run = ref 0 in + (* emoji-ZWJ chain state: 1 = suffix "ExtPict Extend*", 2 = that + chain plus a trailing ZWJ *) + let ep = ref 0 in + let i = ref 0 in + while !i < n do + let cp, j = utf8_decode s !i in + let g = gcb_of cp in + let brk = + match (!prev, g) with + | G_cr, G_lf -> false (* GB3 *) + | (G_cr | G_lf | G_control), _ -> true (* GB4 *) + | _, (G_cr | G_lf | G_control) -> true (* GB5 *) + | G_l, (G_l | G_v | G_lv | G_lvt) -> false (* GB6 *) + | (G_lv | G_v), (G_v | G_t) -> false (* GB7 *) + | (G_lvt | G_t), G_t -> false (* GB8 *) + | _, (G_extend | G_zwj) -> false (* GB9 *) + | _, G_spacing -> false (* GB9a *) + | G_prepend, _ -> false (* GB9b *) + | G_zwj, G_extpict when !ep = 2 -> false (* GB11 *) + | G_ri, G_ri -> !ri_run mod 2 = 0 (* GB12/13 pairs *) + | _ -> true (* GB999 *) + in + (* the first cluster already opened at [0] in [acc] *) + if brk && !i > 0 then acc := !i :: !acc; + (match g with + | G_ri -> + ri_run := if !prev = G_ri && not brk then !ri_run + 1 else 1 + | _ -> ri_run := 0); + (match g with + | G_extpict -> ep := 1 + | G_extend -> ep := (if !ep = 1 then 1 else 0) + | G_zwj -> ep := (if !ep = 1 then 2 else 0) + | _ -> ep := 0); + prev := g; + i := j + done; + Array.of_list (List.rev (n :: !acc)) + end + +(* The masked form of a secure field's text: one bullet per grapheme. + Masking is idempotent — a bullet is its own cluster — so callers + may feed it a string the paint pass already masked. *) +let secure_mask s = + let b = grapheme_bounds s in + let n = Array.length b - 1 in + if n <= 0 then "" + else + let buf = Buffer.create (n * mask_char_len) in + for _ = 1 to n do + Buffer.add_string buf mask_char + done; + Buffer.contents buf + +(* The byte offset in the real text that answers byte offset [m] in + its masked form — every bullet spans [mask_char_len] bytes, so a + hit on the masked layout maps to a grapheme index, and the index + maps back through the real text's boundaries. *) +let secure_byte_of_masked s m = + let b = grapheme_bounds s in + let idx = min (max 0 m / mask_char_len) (Array.length b - 1) in + b.(idx) + let text_ops ?fg ctx store id r alpha ~placeholder_ok = let fg = match fg with Some c -> c | None -> text_fg ctx store id in let s = match pstr store id "text" with - | Some s when s <> "" -> Some (s, fg) + | Some s when s <> "" -> + (* A secure field never hands its real text to the text engine: + the renderer only ever shapes the bullet mask — one grapheme, + one bullet. Placeholder and title text are not secrets and + stay readable. *) + let s = + if Lui_store.kind store id = "secure-field" then secure_mask s + else s + in + Some (s, fg) | _ -> if placeholder_ok then match pstr store id "placeholder" with diff --git a/platform/native/lui_paint/test/lui_paint_test.ml b/platform/native/lui_paint/test/lui_paint_test.ml index 41c5160d..61132c07 100644 --- a/platform/native/lui_paint/test/lui_paint_test.ml +++ b/platform/native/lui_paint/test/lui_paint_test.ml @@ -582,6 +582,86 @@ let test_extension () = (* unregistered extension falls back to a box fill *) check int "fallback" 0 (List.length s.ops) +(* ---------- secure field ---------- *) + +(* The strings the paint pass hands the text engine, in order. *) +let text_calls t = + let calls = ref [] in + let h = + { (hooks ()) with + Lui_paint.text_ops = + (fun _ _ _ s -> + calls := s :: !calls; + []) } + in + ignore (paint_with h t ()); + List.rev !calls + +let test_secure_masked () = + let t = store () in + apply t + [ Lui_protocol.CreateNode (1, SecureField); + SetProp (1, TextValue, StringValue "hunter2") ]; + let calls = text_calls t in + (* The real text must never reach the renderer — only the bullet + mask, one grapheme one bullet. *) + check (list string) "mask only" [ "•••••••" ] calls + +let test_secure_masked_graphemes () = + let t = store () in + apply t + [ Lui_protocol.CreateNode (1, SecureField); + SetProp + (1, TextValue, + StringValue + "e\xcc\x81x\xf0\x9f\x91\xa8\xe2\x80\x8d\xf0\x9f\x91\xa9") ]; + (* "é"(combining) + "x" + ZWJ-joined pair: three graphemes. *) + let calls = text_calls t in + check (list string) "one bullet per grapheme" [ "•••" ] calls + +let test_secure_placeholder_unmasked () = + let t = store () in + apply t + [ Lui_protocol.CreateNode (1, SecureField); + SetProp (1, PlaceholderValue, StringValue "password hint") ]; + let calls = text_calls t in + (* the placeholder is a hint, not a secret — it stays readable *) + check (list string) "placeholder readable" [ "password hint" ] calls + +let test_secure_mask_units () = + let bullets s = Lui_paint.secure_mask s in + check string "ascii" "•••••••" (bullets "hunter2"); + check string "empty" "" (bullets ""); + (* combining mark attaches: "e" + U+0301 is one grapheme *) + check string "combining" "•" (bullets "e\xcc\x81"); + (* precomposed counts the same *) + check string "precomposed" "•" (bullets "\xc3\xa9"); + (* emoji modifier joins its base *) + check string "skin tone" "•" + (bullets "\xf0\x9f\x91\x8d\xf0\x9f\x8f\xbb"); + (* ZWJ chain is one grapheme *) + check string "zwj family" "•" + (bullets + "\xf0\x9f\x91\xa8\xe2\x80\x8d\xf0\x9f\x91\xa9\xe2\x80\x8d\xf0\x9f\x91\xa7"); + (* regional indicators pair per flag *) + check string "two flags" "••" + (bullets + "\xf0\x9f\x87\xab\xf0\x9f\x87\xb7\xf0\x9f\x87\xba\xf0\x9f\x87\xb8"); + (* idempotent: masked bullets re-mask one-to-one *) + check string "idempotent" "•••" (bullets "•••") + +let test_secure_byte_of_masked () = + let s = "hunter2" in + check int "start" 0 (Lui_paint.secure_byte_of_masked s 0); + check int "second char" 1 (Lui_paint.secure_byte_of_masked s 3); + check int "end" 7 (Lui_paint.secure_byte_of_masked s 21); + (* a masked offset past the end clamps to the text's end *) + check int "clamp" 7 (Lui_paint.secure_byte_of_masked s 300); + (* multibyte: "éx" is 2 graphemes, 4 bytes *) + let m = "e\xcc\x81x" in + check int "past composed" 3 (Lui_paint.secure_byte_of_masked m 3); + check int "end composed" 4 (Lui_paint.secure_byte_of_masked m 6) + (* ---------- coverage ---------- *) let test_coverage_table () = @@ -642,5 +722,11 @@ let () = test_case "slider" `Quick test_slider; test_case "scrollbar" `Quick test_scrollbar; test_case "extension" `Quick test_extension ]); + ("secure", + [ test_case "masked paint" `Quick test_secure_masked; + test_case "mask per grapheme" `Quick test_secure_masked_graphemes; + test_case "placeholder unmasked" `Quick test_secure_placeholder_unmasked; + test_case "mask units" `Quick test_secure_mask_units; + test_case "masked offset map" `Quick test_secure_byte_of_masked ]); ("coverage", [ test_case "all props" `Quick test_coverage_table ]) ] diff --git a/platform/native/lui_window/lui_window_text.ml b/platform/native/lui_window/lui_window_text.ml index 1c80fd29..9993836d 100644 --- a/platform/native/lui_window/lui_window_text.ml +++ b/platform/native/lui_window/lui_window_text.ml @@ -408,10 +408,21 @@ let line_h (st : text_style) (l : Lui_text.line) = if st.ts_lh > 0. then st.ts_lh else l.ascent +. l.descent +. l.leading +(* A secure field never shapes its real text: the paint pass hands the + engine the bullet mask already, and any string that arrives here + unmasked — the composition overlay's marked text, a caret prefix — + goes through the same mask so plaintext can never reach a shaped + layout. Masking is idempotent, so a masked input passes through + unchanged. *) +let masked_text store id s = + if Lui_store.kind store id = "secure-field" then Lui_paint.secure_mask s + else s + let text_ops t id r fg s = let scene = t.scene () in let scale = t.scale () in let store = t.store () in + let s = masked_text store id s in let st = style_of t store id in let font = st.ts_font in (* Horizontal placement: the shared placement table decides the kind's @@ -540,7 +551,7 @@ let measure t store id ~scale = else let text = match Lui_store.string_prop store id "text" with - | Some s when s <> "" -> s + | Some s when s <> "" -> masked_text store id s | _ -> (match Lui_store.string_prop store id "placeholder" with | Some s -> s @@ -559,6 +570,7 @@ let measure t store id ~scale = so they stay consistent with what [text_ops] paints. *) let measure_text t id s = let store = t.store () in + let s = masked_text store id s in let st = style_of t store id in if s = "" then if Lui_store.is_editable_text_kind (Lui_store.kind store id) then @@ -580,6 +592,10 @@ let measure_text t id s = let hit_text t id text ~lx ~ly ~lw ~lh = let store = t.store () in let scale = t.scale () in + (* A secure field hit-tests the mask it paints; the masked offset + maps back to a real caret offset on the same boundaries. *) + let masked = Lui_store.kind store id = "secure-field" in + let shown = if masked then Lui_paint.secure_mask text else text in let st = style_of t store id in let tp = Lui_paint.text_placement_of store id in let pad = tp.tp_pad_x *. scale in @@ -590,7 +606,7 @@ let hit_text t id text ~lx ~ly ~lw ~lh = else if wrapping_kind (Lui_store.kind store id) then lw /. scale else 0. in - let lay = layout_of t st ~width:wrap_w text in + let lay = layout_of t st ~width:wrap_w shown in let text_h = styled_height st lay *. scale in let y0 = if tp.tp_top then tp.tp_pad_y *. scale @@ -639,4 +655,5 @@ let hit_text t id text ~lx ~ly ~lw ~lh = in (lx -. off) /. scale in - Lui_text.hit_test lay (px, py') + let off = Lui_text.hit_test lay (px, py') in + if masked then Lui_paint.secure_byte_of_masked text off else off diff --git a/platform/native/lui_window_linux/lui_window_text.ml b/platform/native/lui_window_linux/lui_window_text.ml index 71281490..e11c24cc 100644 --- a/platform/native/lui_window_linux/lui_window_text.ml +++ b/platform/native/lui_window_linux/lui_window_text.ml @@ -409,10 +409,21 @@ let emit_glyph t scene ~scale ~nsub ~pen ~baseline ~font ~gid ~g_y ~fg = t.gcount <- t.gcount + 1; true +(* A secure field never shapes its real text: the paint pass hands the + engine the bullet mask already, and any string that arrives here + unmasked — the composition overlay's marked text, a caret prefix — + goes through the same mask so plaintext can never reach a shaped + layout. Masking is idempotent, so a masked input passes through + unchanged. *) +let masked_text store id s = + if Lui_store.kind store id = "secure-field" then Lui_paint.secure_mask s + else s + let text_ops t id r fg s = let scene = t.scene () in let scale = t.scale () in let store = t.store () in + let s = masked_text store id s in let st = style_of t store id in let font = st.ts_font in (* The layout comes from the bounded cache: measure populated the @@ -521,7 +532,7 @@ let measure t store id ~scale = else let text = match Lui_store.string_prop store id "text" with - | Some s when s <> "" -> s + | Some s when s <> "" -> masked_text store id s | _ -> (match Lui_store.string_prop store id "placeholder" with | Some s -> s @@ -538,6 +549,7 @@ let measure t store id ~scale = so they stay consistent with what [text_ops] paints. *) let measure_text t id s = let store = t.store () in + let s = masked_text store id s in let st = style_of t store id in if s = "" then if Lui_store.is_editable_text_kind (Lui_store.kind store id) then @@ -559,8 +571,12 @@ let measure_text t id s = let hit_text t id text ~lx ~ly ~lw:_ ~lh = let store = t.store () in let scale = t.scale () in + (* A secure field hit-tests the mask it paints; the masked offset + maps back to a real caret offset on the same boundaries. *) + let masked = Lui_store.kind store id = "secure-field" in + let shown = if masked then Lui_paint.secure_mask text else text in let st = style_of t store id in - let lay = layout_of t st ~width:0. text in + let lay = layout_of t st ~width:0. shown in let text_h = styled_height st lay *. scale in let y0 = Float.max 0. ((lh -. text_h) /. 2.) in let py = (ly -. y0) /. scale in @@ -581,4 +597,5 @@ let hit_text t id text ~lx ~ly ~lw:_ ~lh = in ll.Lui_text.ll_top +. frac *. ll.Lui_text.ll_height in - Lui_text.hit_test lay (lx /. scale, py') + let off = Lui_text.hit_test lay (lx /. scale, py') in + if masked then Lui_paint.secure_byte_of_masked text off else off diff --git a/platform/native/lui_window_windows/lui_window_text.ml b/platform/native/lui_window_windows/lui_window_text.ml index 5e620fc7..2f1a3397 100644 --- a/platform/native/lui_window_windows/lui_window_text.ml +++ b/platform/native/lui_window_windows/lui_window_text.ml @@ -427,10 +427,21 @@ let emit_glyph t scene ~scale ~nsub ~pen ~baseline ~font ~gid ~g_y ~fg = t.gcount <- t.gcount + 1; true +(* A secure field never shapes its real text: the paint pass hands the + engine the bullet mask already, and any string that arrives here + unmasked — the composition overlay's marked text, a caret prefix — + goes through the same mask so plaintext can never reach a shaped + layout. Masking is idempotent, so a masked input passes through + unchanged. *) +let masked_text store id s = + if Lui_store.kind store id = "secure-field" then Lui_paint.secure_mask s + else s + let text_ops t id r fg s = let scene = t.scene () in let scale = t.scale () in let store = t.store () in + let s = masked_text store id s in let st = style_of t store id in let font = st.ts_font in (* The layout comes from the bounded cache: measure populated the @@ -539,7 +550,7 @@ let measure t store id ~scale = else let text = match Lui_store.string_prop store id "text" with - | Some s when s <> "" -> s + | Some s when s <> "" -> masked_text store id s | _ -> (match Lui_store.string_prop store id "placeholder" with | Some s -> s @@ -556,6 +567,7 @@ let measure t store id ~scale = so they stay consistent with what [text_ops] paints. *) let measure_text t id s = let store = t.store () in + let s = masked_text store id s in let st = style_of t store id in if s = "" then if Lui_store.is_editable_text_kind (Lui_store.kind store id) then @@ -577,8 +589,12 @@ let measure_text t id s = let hit_text t id text ~lx ~ly ~lw:_ ~lh = let store = t.store () in let scale = t.scale () in + (* A secure field hit-tests the mask it paints; the masked offset + maps back to a real caret offset on the same boundaries. *) + let masked = Lui_store.kind store id = "secure-field" in + let shown = if masked then Lui_paint.secure_mask text else text in let st = style_of t store id in - let lay = layout_of t st ~width:0. text in + let lay = layout_of t st ~width:0. shown in let text_h = styled_height st lay *. scale in let y0 = Float.max 0. ((lh -. text_h) /. 2.) in let py = (ly -. y0) /. scale in @@ -599,4 +615,5 @@ let hit_text t id text ~lx ~ly ~lw:_ ~lh = in ll.Lui_text.ll_top +. frac *. ll.Lui_text.ll_height in - Lui_text.hit_test lay (lx /. scale, py') + let off = Lui_text.hit_test lay (lx /. scale, py') in + if masked then Lui_paint.secure_byte_of_masked text off else off From 896a10680987283ae569b2bed655b86468e840f0 Mon Sep 17 00:00:00 2001 From: Tienson Qin Date: Tue, 13 Oct 2026 04:38:29 +0800 Subject: [PATCH 2/7] fix(native): share the stacking/clip walk between paint and hit-test MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Paint and hit-test resolved stacking independently and disagreed: paint sorted siblings by z-index and promoted popup kinds out of ancestor clips into a deferred overlay pass, while hit_path walked raw child order and the drivers' hit mirrors baked an approximate scroll-ancestor clip into stored rects. A z-ordered node could paint on top yet lose the click to a DOM-later sibling, and a popover inside a scroll container could paint outside the clip yet never be hit. Lui_paint gains walk — the traversal producing each node's resolved stacking/clip frame (z-ordered siblings, popup promotion with a fresh clip context, display:contents pass-through, accumulated ancestor clip). paint now runs as enter/leave callbacks on the walk emitting the same op stream, and Ui.hit_path runs the same walk over the driver's resolved rects (fed back as placement overrides) with only the per-node contains check on top. Driver hit mirrors in all three main.ml files stop baking ancestor-clip intersections into stored rects — each node keeps its full resolved box and the walk recomputes the clip with the exact clips rule. Tests: three new hit cases in lui_window_test — z-index order wins the click, a popover inside a clipped scroll container is hittable outside the clip, and a mid-tree popup wins over a later sibling covering the same spot. All fail on the old code. Generated with [Devin](https://devin.ai) Co-Authored-By: Devin <158243242+devin-ai-integration[bot]@users.noreply.github.com> --- platform/native/lui_paint/lui_paint.ml | 231 +++++++++++------- platform/native/lui_window/lui_window.ml | 97 +++----- platform/native/lui_window/main.ml | 40 ++- .../native/lui_window/test/lui_window_test.ml | 65 ++++- platform/native/lui_window_linux/main.ml | 26 +- platform/native/lui_window_windows/main.ml | 26 +- 6 files changed, 275 insertions(+), 210 deletions(-) diff --git a/platform/native/lui_paint/lui_paint.ml b/platform/native/lui_paint/lui_paint.ml index e660d984..38f77fcb 100644 --- a/platform/native/lui_paint/lui_paint.ml +++ b/platform/native/lui_paint/lui_paint.ml @@ -2294,10 +2294,6 @@ let resolve_rect ~scale ~viewport store id kind p parent_r = | None, Some y -> { p.p_rect with y = y *. s } | None, None -> p.p_rect) -(* The ctx-taking form [paint_node_body] calls; the labeled-args one - above is the shared entry point. *) -let resolve_in ctx = resolve_rect ~scale:ctx.scale ~viewport:ctx.viewport - let zindex store id = match Lui_store.prop store id "z-index" with | Some (Lui_protocol.IntValue i) -> i @@ -2331,11 +2327,101 @@ let node_shown store id = let unboxed store id = pstr store id "display" = Some "contents" +(* ---------- shared stacking walk ---------- *) + +(* One frame of the tree walk paint and hit-testing share: the node's + resolved box plus the stacking/clip result both passes agree on — + z-ordered siblings, promoted popups, display:contents pass-through + and the ancestor clip it sits inside. + + [f_clip] is the clip context applying to the node (None inside the + deferred overlay pass — a promoted popup escapes ancestor clips); + [f_clipped] its painted area (f_rect ∩ f_clip). Children inherit + [f_clipped] when the node clips, [f_clip] otherwise, and resolve + their containing block against [f_parent_r]. *) +type frame = { + f_id : int; + f_kind : string; + f_rect : rect; + f_clip : rect option; + f_clipped : rect; + f_clips : bool; + f_contents : bool; + f_parent_r : rect; +} + +(* What [enter] decides for one node: [b_emit] fires the node's own + chrome (ops, clip brackets, hit tests); [b_down] walks the + children; [b_ctx] is the context the subtree and [leave] run under. *) +type 'a branch = { + b_emit : bool; + b_down : bool; + b_ctx : 'a; +} + +(* Walk the forest in paint order — z-sorted siblings, popups + promoted out of their ancestors' clips into a deferred overlay + pass, display:contents unboxed — carrying [clip] (the accumulated + ancestor clip) and the caller's context down the tree. [enter] + fires on every shown node, [leave] closes frames whose own chrome + emitted, and both receive the context the caller threaded down. *) +let walk ~scale ~viewport store ~layout ~enter ~leave ctx0 = + let deferred = Queue.create () in + let rec go ctx clip parent_r (n : Lui_store.node) = + let id = Lui_store.node_id n and kind = Lui_store.node_kind n in + if node_shown store id then + if popup_kind kind && not (unboxed store id) then + (* promoted out of the ancestor clips: painted after the whole + tree with a fresh clip context *) + Queue.add (fun () -> body ctx None parent_r id kind) deferred + else body ctx clip parent_r id kind + and body ctx clip parent_r id kind = + let contents = unboxed store id in + let p = layout id in + let r = resolve_rect ~scale ~viewport store id kind p parent_r in + let clipped = + match clip with + | Some cr -> rect_intersect r cr + | None -> r + in + let clips_own = + (not contents) && clips kind store id + && ((not (rect_empty r)) + || (* An empty split pane still clips: its children's own + minimum sizes would otherwise paint through it. *) + (match Lui_store.parent store id with + | Some pid -> Lui_store.kind store pid = "split" + | None -> false)) + in + let f = + { f_id = id; f_kind = kind; f_rect = r; f_clip = clip; + f_clipped = clipped; f_clips = clips_own; f_contents = contents; + f_parent_r = (if contents then parent_r else r) } + in + let br = enter ctx f in + if br.b_down then + let child_clip = if clips_own then Some clipped else clip in + List.iter (go br.b_ctx child_clip f.f_parent_r) + (ordered_children store id); + if br.b_emit then leave br.b_ctx f + in + List.iter + (fun id -> go ctx0 None viewport + (match Lui_store.find_opt store id with + | Some n -> n + | None -> invalid_arg "Lui_paint.walk: root id missing")) + (Lui_store.root_ids store); + (* Promoted popups drain after the tree — nested popups enqueue + during the drain and preserve preorder among popups. *) + while not (Queue.is_empty deferred) do + (Queue.pop deferred) () + done + let emit scene ops = scene.ops <- List.rev_append ops scene.ops let emit1 scene op = scene.ops <- op :: scene.ops (* Ops for a single node's own chrome. *) -let rec paint_own ctx store id st kind r rs alpha = +let paint_own ctx store id st kind r rs alpha = let fg = default_text_fg ctx store id kind st rs in let own = match kind with @@ -2406,84 +2492,55 @@ let rec paint_own ctx store id st kind r rs alpha = then [ focus_ring_op ctx r (radii_of ctx store id) alpha ] else [] -(* A popup node: defer to the overlay pass so mid-tree popups paint - above later siblings; everything else paints inline. [kind] arrives - from the caller — the child loop already holds the node record, so - the hot path never pays a second store lookup for it. *) -and paint_node ctx store scene id kind parent_r alpha = - if popup_kind kind && not (unboxed store id) then - Queue.add - (fun () -> paint_node_body ctx store scene id kind parent_r alpha) - ctx.deferred - else paint_node_body ctx store scene id kind parent_r alpha - -(* A visible node: resolve placement, cull against the viewport, then - state/style/chrome/children. Geometry comes first deliberately — - a culled node never pays for state resolution, so scrolling a huge - tree costs one layout-hook hit plus a rect check per offscreen - node. *) -and paint_node_body ctx store scene id kind parent_r alpha = - if node_shown store id then ( - let contents = unboxed store id in - let p = ctx.hooks.layout id in - let r = resolve_in ctx store id kind p parent_r in - (* Viewport cull: a node whose box misses the frame produces no - chrome and no descendants. display:contents has no box of its - own so it always walks children; zero-size nodes still walk so - absolute/fixed descendants (resolved against parent_r) are not - lost. Full damage/incremental paint is intentionally unfinished. *) - let misses_viewport = - (not contents) - && (not (rect_empty r)) - && rect_empty (rect_intersect r ctx.viewport) +(* A visible node's own chrome: clip bracket, box ops, scrollbar — + everything except the child walk, which the shared stacking walk + drives. Geometry comes first deliberately — a culled node never + pays for state resolution, so scrolling a huge tree costs one + layout-hook hit plus a rect check per offscreen node. *) +let paint_enter ctx store scene alpha f = + let id = f.f_id and kind = f.f_kind in + let contents = f.f_contents in + (* Viewport cull: a node whose box misses the frame produces no + chrome and no descendants. display:contents has no box of its own + so it always walks children; zero-size nodes still walk so + absolute/fixed descendants (resolved against f_parent_r) are not + lost. Full damage/incremental paint is intentionally unfinished. *) + let misses_viewport = + (not contents) + && (not (rect_empty f.f_rect)) + && rect_empty (rect_intersect f.f_rect ctx.viewport) + in + if misses_viewport then { b_emit = false; b_down = false; b_ctx = alpha } + else begin + let st = effective_state ctx.hooks store id in + let rs = resolve_style store id st in + (* display:contents generates no box, so its opacity and chrome do + not apply — children paint with the parent's alpha and clip. *) + let alpha = + if contents then alpha + else alpha *. rs.rs_opacity *. disabled_alpha store id st in - if misses_viewport then () + (* An alpha-0 subtree emits no ops at all: the raster treats an op + opacity of 0 as "unset" (opaque), so invisible nodes must be + culled here rather than painted at opacity 0. *) + if alpha <= 0. then { b_emit = false; b_down = false; b_ctx = alpha } else begin - let st = effective_state ctx.hooks store id in - let rs = resolve_style store id st in - (* display:contents generates no box, so its opacity and chrome - do not apply — children paint with the parent's alpha and - clip. *) - let alpha = - if contents then alpha - else alpha *. rs.rs_opacity *. disabled_alpha store id st - in - (* An alpha-0 subtree emits no ops at all: the raster treats an - op opacity of 0 as "unset" (opaque), so invisible nodes must - be culled here rather than painted at opacity 0. *) - if alpha <= 0. then () - else begin - let clip = - (not contents) && clips kind store id - && ((not (rect_empty r)) - || (* An empty split pane still clips: its children's own - minimum sizes would otherwise paint through it. *) - (match Lui_store.parent store id with - | Some pid -> Lui_store.kind store pid = "split" - | None -> false)) - in - if clip then - emit1 scene - (Push_clip - { crect = r; - cradii = corners r (radii_of ctx store id) false; - ccontinuous = false }); - if not contents then - emit scene (paint_own ctx store id st kind r rs alpha); - (* Children of a display:contents node keep the parent's - containing block — the node itself generates no box to - anchor to. *) - let child_parent = if contents then parent_r else r in - List.iter - (fun c -> - paint_node ctx store scene (Lui_store.node_id c) - (Lui_store.node_kind c) child_parent alpha) - (ordered_children store id); - if scrollable kind store id && not contents then - emit scene (scrollbar_ops ctx store id r alpha); - if clip then emit1 scene Pop_clip - end - end) + if f.f_clips then + emit1 scene + (Push_clip + { crect = f.f_rect; + cradii = corners f.f_rect (radii_of ctx store id) false; + ccontinuous = false }); + if not contents then + emit scene (paint_own ctx store id st kind f.f_rect rs alpha); + { b_emit = true; b_down = true; b_ctx = alpha } + end + end + +let paint_leave ctx store scene alpha f = + if scrollable f.f_kind store f.f_id && not f.f_contents then + emit scene (scrollbar_ops ctx store f.f_id f.f_rect alpha); + if f.f_clips then emit1 scene Pop_clip (* Full repaint: reset the scene and repaint the whole forest. *) let paint hooks store scene ~width ~height ~scale ~clear = @@ -2493,13 +2550,11 @@ let paint hooks store scene ~width ~height ~scale ~clear = viewport = rect 0. 0. (float width) (float height); deferred = Queue.create () } in - List.iter - (fun id -> - paint_node ctx store scene id (Lui_store.kind store id) - ctx.viewport 1.) - (Lui_store.root_ids store); - (* Nested popups (submenus) enqueue during this drain — they paint - after their parent, preserving preorder among popups. *) + walk ~scale ~viewport:ctx.viewport store ~layout:hooks.layout + ~enter:(paint_enter ctx store scene) + ~leave:(paint_leave ctx store scene) 1.; + (* Extension renderers may enqueue their own deferred work on + ctx.deferred — drain it after the walk's own popup pass. *) while not (Queue.is_empty ctx.deferred) do (Queue.pop ctx.deferred) () done; diff --git a/platform/native/lui_window/lui_window.ml b/platform/native/lui_window/lui_window.ml index 2958487c..56a76ba5 100644 --- a/platform/native/lui_window/lui_window.ml +++ b/platform/native/lui_window/lui_window.ml @@ -232,32 +232,16 @@ let event_supported store id event = in Lui_protocol.event_supported_for_properties kind props event -(* Everything [hit_path] needs from the store for one node: visibility, - the scrollable/split-pane clip rule, overlay presentation, the - pointer-enabled opt, and the two kind strings it branches on. - Computed once per node per store revision — see [hit_flags_of]. *) +(* Everything [hit_path] needs from the store for one node on top of + the shared walk's stacking/clip frame: overlay presentation, the + pointer-enabled opt, and the spacer kind check. Computed once per + node per store revision — see [hit_flags_of]. *) type hit_flags = { - hf_visible : bool; - hf_clips : bool; hf_overlay : bool; hf_pen : bool option; - hf_no_box : bool; hf_spacer : bool; } -(* Mirror of Lui_paint.clips: a node clips its descendants when it - scrolls, carries an overflow prop, or is a split pane. *) -let hit_node_clips store id = - (match Lui_store.kind store id with - | "scroll" | "list" | "virtual-list" -> true - | _ -> false) - || (match Lui_store.parent store id with - | Some pid -> Lui_store.kind store pid = "split" - | None -> false) - || (match Lui_store.string_prop store id "overflow" with - | Some ("hidden" | "clip" | "auto" | "scroll") -> true - | _ -> false) - (* pointer-enabled=false makes a subtree hit-transparent like the web pointer-events:none: descendants inherit it and only an explicit pointer-enabled=true opts a node back in (registering pointer @@ -286,17 +270,11 @@ let presented_overlay store id = | _ -> false) let hit_flags_compute store id = - { hf_visible = - (match Lui_store.prop store id "visible" with - | Some (BoolValue false) -> false - | _ -> true); - hf_clips = hit_node_clips store id; - hf_overlay = presented_overlay store id; + { hf_overlay = presented_overlay store id; hf_pen = (match Lui_store.prop store id "pointer-enabled" with | Some (BoolValue v) -> Some v | _ -> None); - hf_no_box = string_prop store id "display" = "contents"; hf_spacer = Lui_store.kind store id = "spacer" } (* hit_path's per-node flags, memoized for the (store, revision) of the @@ -323,47 +301,38 @@ let hit_flags_of store id = Hashtbl.replace hit_flags_tbl id f; f +(* Hit-testing runs the same stacking walk the paint pass paints: + z-ordered siblings, promoted popups escaping their ancestors' clip, + display:contents pass-through, and the clip context computed with + [Lui_paint.clips]'s exact rule. [rects] carries the driver's + resolved boxes — fed back as placement overrides so the walk + shares the stacking/clip result without re-resolving geometry. *) let hit_path store rects ~x ~y = - let rec walk id path clip_r pointer_on = - let f = hit_flags_of store id in - if not f.hf_visible then path - else - let on = - match f.hf_pen with - | Some v -> v - | None -> pointer_on || f.hf_overlay - in - let r = Rects.get rects id in - let clipped = - match clip_r with - | Some cr -> rect_intersect r cr - | None -> r - in - let path = - (* spacers are layout voids — they paint nothing and must never - be the hit target (a full-window spacer in an overlay layer - would otherwise swallow every DOM event). *) - if on && not f.hf_spacer - && not (rect_empty clipped) && rect_contains clipped x y - then id :: path - else path - in - let child_clip = - (* display:contents has no box to clip with. *) - if f.hf_clips && not f.hf_no_box then Some clipped - else clip_r - in - (* Children paint after their parent, so prepending while walking - leaves the node visited last — visually topmost — at the head. *) - List.fold_left - (fun acc c -> walk c acc child_clip on) - path (Lui_store.child_ids store id) + let path = ref [] in + let enter on (f : Lui_paint.frame) = + let fl = hit_flags_of store f.f_id in + let on = + match fl.hf_pen with + | Some v -> v + | None -> on || fl.hf_overlay + in + (* spacers are layout voids — they paint nothing and must never be + the hit target (a full-window spacer in an overlay layer would + otherwise swallow every DOM event). *) + if on && not fl.hf_spacer + && not (rect_empty f.f_clipped) + && rect_contains f.f_clipped x y + then path := f.f_id :: !path; + { Lui_paint.b_emit = false; b_down = true; b_ctx = on } in + Lui_paint.walk ~scale:1. ~viewport:(rect 0. 0. 0. 0.) store + ~layout:(fun id -> + let r = Rects.get rects id in + { Lui_paint.p_rect = r; p_override = Some r }) + ~enter ~leave:(fun _ _ -> ()) true; (* The head is the node visited last in paint order: visually topmost. *) - List.fold_left - (fun acc id -> walk id acc None true) - [] (Lui_store.root_ids store) + !path let hit store rects ~x ~y = match hit_path store rects ~x ~y with diff --git a/platform/native/lui_window/main.ml b/platform/native/lui_window/main.ml index 5d5ef493..5d8c58fd 100644 --- a/platform/native/lui_window/main.ml +++ b/platform/native/lui_window/main.ml @@ -876,20 +876,20 @@ let open_window ~title ~idx = Some (Ui.pointer ui) | _ -> None)); (* Populate the hit-test mirror from the layout engine: each node's - shifted rect clipped to its scrollable ancestors' viewports (so - scrolled-off content can't be hit), then each scroll container's - range on both axes from its unshifted content extent. Runs after - every repaint while the engine is fresh. *) + shifted rect resolved through the paint pass's placement, then + each scroll container's range on both axes from its unshifted + content extent. Clipping is NOT baked in: [Ui]'s hit walk + recomputes the exact stacking/clip context (clips kinds, + promoted popups escaping ancestor clips). Runs after every + repaint while the engine is fresh. *) let populate () = Hashtbl.reset rects; (* One preorder pass carrying the ancestors' accumulated scroll - offset and clip: the node's own offset shifts only its - children, and a scrollable node's already-stored mirror rect - becomes its descendants' clip — the same result the old - per-node ancestor walk produced, without re-summing the chain - for every node. Placement goes through the same - [Lui_paint.resolve_rect] the paint pass uses, so - position/inset, fixed and popup coordinates hit-test where + offset: the node's own offset shifts only its children — + the same result the old per-node ancestor walk produced, + without re-summing the chain for every node. Placement goes + through the same [Lui_paint.resolve_rect] the paint pass uses, + so position/inset, fixed and popup coordinates hit-test where they paint; [parent_r] is the parent's resolved box (a display:contents node forwards its own containing block). *) let scn = Lui_host.scene host in @@ -897,7 +897,7 @@ let open_window ~title ~idx = Lui_scene.rect 0. 0. (float scn.Lui_scene.width) (float scn.Lui_scene.height) in - let rec visit id ~sx ~sy ~anc_clip ~parent_r = + let rec visit id ~sx ~sy ~parent_r = let base = engine_rect id in let shifted = { base with @@ -909,28 +909,18 @@ let open_window ~title ~idx = (Lui_store.kind store id) (Lui_paint.placement_of_rect shifted) parent_r in - let stored = rect_intersect resolved anc_clip in - Hashtbl.replace rects id stored; + Hashtbl.replace rects id resolved; let sx' = sx +. Ui.scroll_offset_x ui id and sy' = sy +. Ui.scroll_offset ui id in - let anc_clip' = - if Ui.scrollable store id && not (Lui_scene.rect_empty stored) - then rect_intersect anc_clip stored - else anc_clip - in let child_parent = if Lui_paint.unboxed store id then parent_r else resolved in List.iter - (fun c -> - visit c ~sx:sx' ~sy:sy' ~anc_clip:anc_clip' - ~parent_r:child_parent) + (fun c -> visit c ~sx:sx' ~sy:sy' ~parent_r:child_parent) (Lui_store.child_ids store id) in - let everything = Lui_scene.rect (-.1e9) (-.1e9) 2e9 2e9 in List.iter - (fun id -> - visit id ~sx:0. ~sy:0. ~anc_clip:everything ~parent_r:viewport) + (fun id -> visit id ~sx:0. ~sy:0. ~parent_r:viewport) (Lui_store.root_ids store); List.iter (fun id -> diff --git a/platform/native/lui_window/test/lui_window_test.ml b/platform/native/lui_window/test/lui_window_test.ml index ba6e9393..bf69520f 100644 --- a/platform/native/lui_window/test/lui_window_test.ml +++ b/platform/native/lui_window/test/lui_window_test.ml @@ -202,6 +202,64 @@ let test_hit () = Alcotest.failf "deep path %s" (String.concat "," (List.map string_of_int p))) +let rects_of lst = + let t = Rects.create () in + List.iter (fun (id, r) -> Hashtbl.replace t id r) lst; + t + +(* DOM order [z2, z1]: the z2 node paints on top even though it is the + first child, so it must head the hit path — paint order, not store + order, decides who wins a click. *) +let test_hit_z_order () = + let s = + store_of + [ CreateNode (1, Root); CreateNode (2, Stack); + CreateNode (3, Button); CreateNode (4, Button); + InsertChild (1, 2, 0); + InsertChild (2, 3, 0); InsertChild (2, 4, 1); + SetProp (3, ZIndex, IntValue 2); SetProp (4, ZIndex, IntValue 1) ] + in + let r = rect 0. 0. 100. 40. in + let rects = rects_of [ (1, r); (2, r); (3, r); (4, r) ] in + Alcotest.(check (option int)) "z2 paints on top" (Some 3) + (hit s rects ~x:10. ~y:10.) + +(* A popover inside a clipped scroll container paints OUTSIDE the + clip — it is a promoted overlay. A click in that region must reach + the popover's child, not die on the scroll clip like an in-flow + child does. *) +let test_hit_popup_escapes_clip () = + let s = + store_of + [ CreateNode (1, Root); CreateNode (2, Scroll); + CreateNode (3, Popover); CreateNode (4, Button); + InsertChild (1, 2, 0); InsertChild (2, 3, 0); + InsertChild (3, 4, 0) ] + in + let rects = + rects_of + [ (1, rect 0. 0. 100. 100.); (2, rect 0. 0. 100. 100.); + (3, rect 0. 120. 80. 30.); (4, rect 0. 130. 80. 10.) ] + in + Alcotest.(check (option int)) "popover's child hits" (Some 4) + (hit s rects ~x:10. ~y:135.) + +(* A mid-tree popup paints above siblings that come after it, so its + content wins the click even when a later sibling covers the same + spot. *) +let test_hit_popup_promoted () = + let s = + store_of + [ CreateNode (1, Root); CreateNode (2, Popover); + CreateNode (3, Button); CreateNode (4, Button); + InsertChild (1, 2, 0); InsertChild (1, 4, 1); + InsertChild (2, 3, 0) ] + in + let r = rect 0. 0. 100. 100. in + let rects = rects_of [ (1, r); (2, r); (3, r); (4, r) ] in + Alcotest.(check (option int)) "popup over later sibling" (Some 3) + (hit s rects ~x:10. ~y:10.) + (* ---------- event mapping ---------- *) let ui_store_fresh () = @@ -1717,7 +1775,12 @@ let () = [ Alcotest.test_case "stack" `Quick test_layout; Alcotest.test_case "props" `Quick test_layout_props ] ); ( "hit", - [ Alcotest.test_case "path" `Quick test_hit ] ); + [ Alcotest.test_case "path" `Quick test_hit; + Alcotest.test_case "z-order" `Quick test_hit_z_order; + Alcotest.test_case "popup escapes clip" `Quick + test_hit_popup_escapes_clip; + Alcotest.test_case "popup promoted" `Quick + test_hit_popup_promoted ] ); ( "events", [ Alcotest.test_case "click" `Quick test_click_press; Alcotest.test_case "release elsewhere" `Quick diff --git a/platform/native/lui_window_linux/main.ml b/platform/native/lui_window_linux/main.ml index 9889a470..f626c2a2 100644 --- a/platform/native/lui_window_linux/main.ml +++ b/platform/native/lui_window_linux/main.ml @@ -504,41 +504,35 @@ let () = Layout.refresh store rects ~width:!win_w ~height:!win_h ~scale:!scale_cell ~measure:(Lui_window_text.measure text_engine); (* Rebuild the hit mirror through the same resolve_rect the paint - pass applies — position/inset, fixed and popup coordinates — - plus the scrollable-ancestor clip. [parent_r] is the parent's - resolved box (a display:contents node forwards its own - containing block). *) + pass applies — position/inset, fixed and popup coordinates. + Clipping is NOT baked in: [Ui]'s hit walk recomputes the exact + stacking/clip context (clips kinds, promoted popups escaping + ancestor clips), so each node keeps its full resolved box. + [parent_r] is the parent's resolved box (a display:contents + node forwards its own containing block). *) Hashtbl.reset hit_rects; let vp = Lui_scene.rect 0. 0. (float !win_w *. !scale_cell) (float !win_h *. !scale_cell) in - let rec visit id ~anc_clip ~parent_r = + let rec visit id ~parent_r = let base = Rects.get rects id in let resolved = Lui_paint.resolve_rect ~scale:!scale_cell ~viewport:vp store id (Lui_store.kind store id) (Lui_paint.placement_of_rect base) parent_r in - let stored = Lui_scene.rect_intersect resolved anc_clip in - Hashtbl.replace hit_rects id stored; - let anc_clip' = - if Ui.scrollable store id && not (Lui_scene.rect_empty stored) - then Lui_scene.rect_intersect anc_clip stored - else anc_clip - in + Hashtbl.replace hit_rects id resolved; let child_parent = if Lui_paint.unboxed store id then parent_r else resolved in List.iter - (fun c -> - visit c ~anc_clip:anc_clip' ~parent_r:child_parent) + (fun c -> visit c ~parent_r:child_parent) (Lui_store.child_ids store id) in - let everything = Lui_scene.rect (-.1e9) (-.1e9) 2e9 2e9 in List.iter - (fun id -> visit id ~anc_clip:everything ~parent_r:vp) + (fun id -> visit id ~parent_r:vp) (Lui_store.root_ids store); (* Rects were just rebuilt — visible-range memos key on the epoch. *) diff --git a/platform/native/lui_window_windows/main.ml b/platform/native/lui_window_windows/main.ml index 611292f9..b9a4357e 100644 --- a/platform/native/lui_window_windows/main.ml +++ b/platform/native/lui_window_windows/main.ml @@ -332,41 +332,35 @@ let () = Layout.refresh store rects ~width:!win_w ~height:!win_h ~scale:!scale_cell ~measure:(Lui_window_text.measure text_engine); (* Rebuild the hit mirror through the same resolve_rect the paint - pass applies — position/inset, fixed and popup coordinates — - plus the scrollable-ancestor clip. [parent_r] is the parent's - resolved box (a display:contents node forwards its own - containing block). *) + pass applies — position/inset, fixed and popup coordinates. + Clipping is NOT baked in: [Ui]'s hit walk recomputes the exact + stacking/clip context (clips kinds, promoted popups escaping + ancestor clips), so each node keeps its full resolved box. + [parent_r] is the parent's resolved box (a display:contents + node forwards its own containing block). *) Hashtbl.reset hit_rects; let vp = Lui_scene.rect 0. 0. (float !win_w *. !scale_cell) (float !win_h *. !scale_cell) in - let rec visit id ~anc_clip ~parent_r = + let rec visit id ~parent_r = let base = Rects.get rects id in let resolved = Lui_paint.resolve_rect ~scale:!scale_cell ~viewport:vp store id (Lui_store.kind store id) (Lui_paint.placement_of_rect base) parent_r in - let stored = Lui_scene.rect_intersect resolved anc_clip in - Hashtbl.replace hit_rects id stored; - let anc_clip' = - if Ui.scrollable store id && not (Lui_scene.rect_empty stored) - then Lui_scene.rect_intersect anc_clip stored - else anc_clip - in + Hashtbl.replace hit_rects id resolved; let child_parent = if Lui_paint.unboxed store id then parent_r else resolved in List.iter - (fun c -> - visit c ~anc_clip:anc_clip' ~parent_r:child_parent) + (fun c -> visit c ~parent_r:child_parent) (Lui_store.child_ids store id) in - let everything = Lui_scene.rect (-.1e9) (-.1e9) 2e9 2e9 in List.iter - (fun id -> visit id ~anc_clip:everything ~parent_r:vp) + (fun id -> visit id ~parent_r:vp) (Lui_store.root_ids store); (* Rects were just rebuilt — visible-range memos key on the epoch. *) From 3cf6a3846115cb888ad106fb983f200423c5b813 Mon Sep 17 00:00:00 2001 From: Tienson Qin Date: Tue, 13 Oct 2026 04:59:47 +0800 Subject: [PATCH 3/7] test(macos): re-pin headless golden for masked demo secure field --- platform/native/lui_window/test/lui_window_test.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/platform/native/lui_window/test/lui_window_test.ml b/platform/native/lui_window/test/lui_window_test.ml index ef790972..16f8788e 100644 --- a/platform/native/lui_window/test/lui_window_test.ml +++ b/platform/native/lui_window/test/lui_window_test.ml @@ -929,7 +929,7 @@ let test_headless_checksum () = (* the recorded value pins the demo's initial scene: any render-path change shows up here *) Alcotest.(check string) "golden" - "headless done: frames=6 checksum=10ad2bfdcbf7b0ad" c1 + "headless done: frames=6 checksum=e6ca6478011f11ad" c1 (* ---------- multi-window ---------- *) @@ -1091,7 +1091,7 @@ let test_headless_multi () = let out1 = run () and out2 = run () in (match win_done_lines out1 with | [ w0; w1 ] -> - Alcotest.(check string) "win0 golden" "10ad2bfdcbf7b0ad" + Alcotest.(check string) "win0 golden" "e6ca6478011f11ad" (checksum_value w0); Alcotest.(check bool) "independent checksums" true (checksum_value w0 <> checksum_value w1) From 416a1bf4ccfeeb9f8690fbfd02985a6d9f307e09 Mon Sep 17 00:00:00 2001 From: Tienson_Qin Date: Tue, 13 Oct 2026 05:07:58 +0800 Subject: [PATCH 4/7] fix(macos): drop rect_intersect left unused by the shared hit walk --- platform/native/lui_window/main.ml | 13 ------------- 1 file changed, 13 deletions(-) diff --git a/platform/native/lui_window/main.ml b/platform/native/lui_window/main.ml index e524cc31..055023d4 100644 --- a/platform/native/lui_window/main.ml +++ b/platform/native/lui_window/main.ml @@ -741,19 +741,6 @@ let open_window ~title ~idx = Float.min_float, Float.min_float) (Lui_store.preorder ~root:id (store_of ())) in - let rect_intersect a b = - let x = Float.max a.Lui_scene.x b.Lui_scene.x - and y = Float.max a.Lui_scene.y b.Lui_scene.y in - Lui_scene.rect x y - (Float.max 0. - (Float.min (a.Lui_scene.x +. a.Lui_scene.w) - (b.Lui_scene.x +. b.Lui_scene.w) - -. x)) - (Float.max 0. - (Float.min (a.Lui_scene.y +. a.Lui_scene.h) - (b.Lui_scene.y +. b.Lui_scene.h) - -. y)) - in let hooks = Lui_paint. { color_of = Theme.color_of; From 955dea1109821ad491bfdabc2c8c9b0361a51d6a Mon Sep 17 00:00:00 2001 From: Tienson Qin Date: Tue, 13 Oct 2026 05:15:17 +0800 Subject: [PATCH 5/7] fix(native): distinguish node-not-drawn from subtree-invisible in culling MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The viewport cull dropped a node's whole subtree when its own box missed the frame, losing overflow:visible children, position:fixed descendants (which resolve against the frame) and promoted popups. paint_enter now skips only the node's own chrome and keeps walking; the true subtree cull lives in the shared walk as a dead-clip path — a clip that misses the viewport can contain no output, so the walk switches to a ghost pass that skips enter/chrome cost and only hunts promoted popups, still threading alpha and hit flags down the path. hit_path gives the walk the pointer point as its viewport so clips that miss it prune; popup escapes keep their ancestors' flags. Generated with [Devin](https://devin.ai) Co-Authored-By: Devin <158243242+devin-ai-integration[bot]@users.noreply.github.com> --- platform/native/lui_paint/lui_paint.ml | 98 ++++++++++---- .../native/lui_paint/test/lui_paint_test.ml | 125 +++++++++++++++++- platform/native/lui_window/lui_window.ml | 23 +++- 3 files changed, 209 insertions(+), 37 deletions(-) diff --git a/platform/native/lui_paint/lui_paint.ml b/platform/native/lui_paint/lui_paint.ml index 14b2a6e4..25f9292c 100644 --- a/platform/native/lui_paint/lui_paint.ml +++ b/platform/native/lui_paint/lui_paint.ml @@ -2374,9 +2374,22 @@ type 'a branch = { pass, display:contents unboxed — carrying [clip] (the accumulated ancestor clip) and the caller's context down the tree. [enter] fires on every shown node, [leave] closes frames whose own chrome - emitted, and both receive the context the caller threaded down. *) -let walk ~scale ~viewport store ~layout ~enter ~leave ctx0 = + emitted, and both receive the context the caller threaded down. + Inside a dead clip — one that misses [viewport] entirely — the + walk switches to a ghost pass that skips [enter]/[leave] and every + node's chrome cost, keeping only the promoted-popup search and the + [ghost_enter] context update (a popup's alpha and hit flags still + accumulate its clipped-away ancestors). *) +let walk ~scale ~viewport store ~layout ~enter ~ghost_enter ~leave ctx0 = let deferred = Queue.create () in + (* A clip context that misses [viewport] entirely is dead: nothing + inside it can paint or be hit — except promoted popups, which + escape to the overlay pass. *) + let dead clip = + match clip with + | Some cr -> rect_empty (rect_intersect cr viewport) + | None -> false + in let rec go ctx clip parent_r (n : Lui_store.node) = let id = Lui_store.node_id n and kind = Lui_store.node_kind n in if node_shown store id then @@ -2384,7 +2397,24 @@ let walk ~scale ~viewport store ~layout ~enter ~leave ctx0 = (* promoted out of the ancestor clips: painted after the whole tree with a fresh clip context *) Queue.add (fun () -> body ctx None parent_r id kind) deferred + else if dead clip then ghost ctx parent_r n else body ctx clip parent_r id kind + (* The subtree sits entirely inside a dead clip: keep walking only + far enough to find promoted popups (and their containing blocks), + skipping every node's enter/chrome cost. *) + and ghost ctx parent_r (n : Lui_store.node) = + let id = Lui_store.node_id n and kind = Lui_store.node_kind n in + if node_shown store id then + if popup_kind kind && not (unboxed store id) then + Queue.add (fun () -> body ctx None parent_r id kind) deferred + else begin + let contents = unboxed store id in + let p = layout id in + let r = resolve_rect ~scale ~viewport store id kind p parent_r in + let ctx = ghost_enter ctx id contents in + let child_parent = if contents then parent_r else r in + List.iter (ghost ctx child_parent) (ordered_children store id) + end and body ctx clip parent_r id kind = let contents = unboxed store id in let p = layout id in @@ -2502,39 +2532,51 @@ let paint_own ctx store id st kind r rs alpha = then [ focus_ring_op ctx r (radii_of ctx store id) alpha ] else [] +(* Inside a dead clip only the context still matters: a promoted + popup inherits its clipped-away ancestors' opacity, so the ghost + walk threads alpha down without resolving chrome. *) +let paint_ghost_enter ctx store alpha id contents = + if contents then alpha + else + let st = effective_state ctx.hooks store id in + let rs = resolve_style store id st in + alpha *. rs.rs_opacity *. disabled_alpha store id st + (* A visible node's own chrome: clip bracket, box ops, scrollbar — everything except the child walk, which the shared stacking walk - drives. Geometry comes first deliberately — a culled node never - pays for state resolution, so scrolling a huge tree costs one - layout-hook hit plus a rect check per offscreen node. *) + drives. A node whose painted area misses the frame emits nothing + but still walks its children: they can escape the box + (overflow:visible content, absolute/fixed children, promoted + popups) and cull themselves. The only true subtree cull is the + walk's dead-clip path — a clip that misses the viewport cannot + contain output. *) let paint_enter ctx store scene alpha f = let id = f.f_id and kind = f.f_kind in let contents = f.f_contents in - (* Viewport cull: a node whose box misses the frame produces no - chrome and no descendants. display:contents has no box of its own - so it always walks children; zero-size nodes still walk so - absolute/fixed descendants (resolved against f_parent_r) are not - lost. Full damage/incremental paint is intentionally unfinished. *) - let misses_viewport = - (not contents) - && (not (rect_empty f.f_rect)) - && rect_empty (rect_intersect f.f_rect ctx.viewport) + let st = effective_state ctx.hooks store id in + let rs = resolve_style store id st in + (* display:contents generates no box, so its opacity and chrome do + not apply — children paint with the parent's alpha and clip. *) + let alpha = + if contents then alpha + else alpha *. rs.rs_opacity *. disabled_alpha store id st in - if misses_viewport then { b_emit = false; b_down = false; b_ctx = alpha } + (* An alpha-0 subtree emits no ops at all: the raster treats an op + opacity of 0 as "unset" (opaque), so invisible nodes must be + culled here rather than painted at opacity 0. *) + if alpha <= 0. then { b_emit = false; b_down = false; b_ctx = alpha } else begin - let st = effective_state ctx.hooks store id in - let rs = resolve_style store id st in - (* display:contents generates no box, so its opacity and chrome do - not apply — children paint with the parent's alpha and clip. *) - let alpha = - if contents then alpha - else alpha *. rs.rs_opacity *. disabled_alpha store id st + (* Node-not-drawn vs subtree-invisible: only the node's own chrome + is skipped here; the subtree walks on. Zero-size nodes still + emit — shadows and outlines can paint outside an empty box — + matching the pre-cull contract that the raster drops empty + ops. *) + let node_drawn = + (not contents) + && (rect_empty f.f_rect + || not (rect_empty (rect_intersect f.f_clipped ctx.viewport))) in - (* An alpha-0 subtree emits no ops at all: the raster treats an op - opacity of 0 as "unset" (opaque), so invisible nodes must be - culled here rather than painted at opacity 0. *) - if alpha <= 0. then { b_emit = false; b_down = false; b_ctx = alpha } - else begin + if node_drawn then begin if f.f_clips then emit1 scene (Push_clip @@ -2545,6 +2587,7 @@ let paint_enter ctx store scene alpha f = emit scene (paint_own ctx store id st kind f.f_rect rs alpha); { b_emit = true; b_down = true; b_ctx = alpha } end + else { b_emit = false; b_down = true; b_ctx = alpha } end let paint_leave ctx store scene alpha f = @@ -2562,6 +2605,7 @@ let paint hooks store scene ~width ~height ~scale ~clear = in walk ~scale ~viewport:ctx.viewport store ~layout:hooks.layout ~enter:(paint_enter ctx store scene) + ~ghost_enter:(paint_ghost_enter ctx store) ~leave:(paint_leave ctx store scene) 1.; (* Extension renderers may enqueue their own deferred work on ctx.deferred — drain it after the walk's own popup pass. *) diff --git a/platform/native/lui_paint/test/lui_paint_test.ml b/platform/native/lui_paint/test/lui_paint_test.ml index 61132c07..520fadad 100644 --- a/platform/native/lui_paint/test/lui_paint_test.ml +++ b/platform/native/lui_paint/test/lui_paint_test.ml @@ -343,6 +343,121 @@ let test_viewport_cull () = | [ f ] -> check int "red on-screen" 255 f.fcolor.r | _ -> fail "expected the on-screen fill only" +(* ---------- culling: node-not-drawn vs subtree-invisible ---------- *) + +let layout_map f = fun id -> Lui_paint.placement_of_rect (f id) + +(* A parent whose box misses the frame emits no chrome, but its + subtree is NOT culled: an overflow:visible child laid out inside + the viewport still paints. *) +let test_cull_escape_child () = + let t = store () in + apply t + [ Lui_protocol.CreateNode (1, Column); + CreateNode (2, Column); + SetProp (2, BackgroundValue, StringValue "#ff0000"); + InsertChild (1, 2, 0) ]; + let layout = + layout_map (function + | 1 -> rect 0. 500. 100. 40. (* parent offscreen *) + | 2 -> rect 0. 50. 100. 40. (* child inside the frame *) + | _ -> rect 0. 0. 0. 0.) + in + let s = paint_with (hooks ~layout ()) t ~width:200 ~height:200 () in + match s.ops with + | [ Fill _ ] -> () + | _ -> fail "expected the escaped child's fill" + +(* A position:fixed descendant resolves against the frame, so it can + paint even when its parent's box is entirely offscreen. *) +let test_cull_escape_fixed () = + let t = store () in + apply t + [ Lui_protocol.CreateNode (1, Column); + CreateNode (2, Column); + SetProp (2, Position, StringValue "fixed"); + SetProp (2, InsetTop, FloatValue 10.); + SetProp (2, InsetLeft, FloatValue 10.); + SetProp (2, BackgroundValue, StringValue "#ff0000"); + InsertChild (1, 2, 0) ]; + let layout = + layout_map (function + | 1 -> rect 0. 500. 100. 40. + | 2 -> rect 0. 0. 20. 20. + | _ -> rect 0. 0. 0. 0.) + in + let s = paint_with (hooks ~layout ()) t ~width:200 ~height:200 () in + match s.ops with + | [ Fill f ] -> + check bool "fixed at frame inset" true (f.frect.x = 10. && f.frect.y = 10.) + | _ -> fail "expected the fixed child's fill" + +(* A popover inside an offscreen parent is still promoted and paints + at its own coordinates. *) +let test_cull_escape_popup () = + let t = store () in + apply t + [ Lui_protocol.CreateNode (1, Column); + CreateNode (2, Popover); + SetProp (2, BackgroundValue, StringValue "#ff0000"); + InsertChild (1, 2, 0) ]; + let layout = + layout_map (function + | 1 -> rect 0. 500. 100. 40. + | 2 -> rect 0. 60. 80. 30. + | _ -> rect 0. 0. 0. 0.) + in + let s = paint_with (hooks ~layout ()) t ~width:200 ~height:200 () in + (* the popover paints its own chrome (shadow/fill) at y=60 — the + offscreen parent contributes nothing *) + let fills = + List.filter_map (function Lui_scene.Fill f -> Some f | _ -> None) s.ops + in + match fills with + | f :: _ -> check bool "popover painted" true (f.frect.y = 60.) + | _ -> fail "expected the promoted popover's ops" + +(* A scroll container entirely offscreen still culls its clipped + children — that subtree is provably invisible. *) +let test_cull_dead_clip () = + let t = store () in + apply t + [ Lui_protocol.CreateNode (1, Scroll); + CreateNode (2, Column); + SetProp (2, BackgroundValue, StringValue "#ff0000"); + InsertChild (1, 2, 0) ]; + let layout = + layout_map (function + | 1 -> rect 0. 500. 100. 100. + | 2 -> rect 0. 510. 80. 30. + | _ -> rect 0. 0. 0. 0.) + in + let s = paint_with (hooks ~layout ()) t ~width:200 ~height:200 () in + check int "dead clip culls" 0 (List.length s.ops) + +(* But a promoted popup escapes even a dead clip: it is an overlay, + not clipped content. *) +let test_cull_dead_clip_popup () = + let t = store () in + apply t + [ Lui_protocol.CreateNode (1, Scroll); + CreateNode (2, Popover); + SetProp (2, BackgroundValue, StringValue "#ff0000"); + InsertChild (1, 2, 0) ]; + let layout = + layout_map (function + | 1 -> rect 0. 500. 100. 100. + | 2 -> rect 0. 60. 80. 30. + | _ -> rect 0. 0. 0. 0.) + in + let s = paint_with (hooks ~layout ()) t ~width:200 ~height:200 () in + let fills = + List.filter_map (function Lui_scene.Fill f -> Some f | _ -> None) s.ops + in + match fills with + | f :: _ -> check bool "popover painted" true (f.frect.y = 60.) + | _ -> fail "expected the popover to escape the dead clip" + let test_zindex () = let t = store () in apply t @@ -376,8 +491,6 @@ let test_display_contents () = (* ---------- placement ---------- *) -let layout_map f = fun id -> Lui_paint.placement_of_rect (f id) - let test_position_absolute () = let t = store () in apply t @@ -704,7 +817,13 @@ let () = [ test_case "opacity multiply" `Quick test_opacity_multiply; test_case "viewport cull" `Quick test_viewport_cull; test_case "z-index" `Quick test_zindex; - test_case "display contents" `Quick test_display_contents ]); + test_case "display contents" `Quick test_display_contents; + test_case "cull: escaped child" `Quick test_cull_escape_child; + test_case "cull: fixed descendant" `Quick test_cull_escape_fixed; + test_case "cull: promoted popup" `Quick test_cull_escape_popup; + test_case "cull: dead clip" `Quick test_cull_dead_clip; + test_case "cull: popup escapes dead clip" `Quick + test_cull_dead_clip_popup ]); ("placement", [ test_case "absolute" `Quick test_position_absolute; test_case "relative" `Quick test_position_relative; diff --git a/platform/native/lui_window/lui_window.ml b/platform/native/lui_window/lui_window.ml index a39af3f0..dd242155 100644 --- a/platform/native/lui_window/lui_window.ml +++ b/platform/native/lui_window/lui_window.ml @@ -309,13 +309,15 @@ let hit_flags_of store id = shares the stacking/clip result without re-resolving geometry. *) let hit_path store rects ~x ~y = let path = ref [] in + (* pointer-events accumulate down the tree; the ghost pass threads + the same [on] update so a promoted popup keeps its clipped-away + ancestors' flags. *) + let flags_or on fl = + match fl.hf_pen with Some v -> v | None -> on || fl.hf_overlay + in let enter on (f : Lui_paint.frame) = let fl = hit_flags_of store f.f_id in - let on = - match fl.hf_pen with - | Some v -> v - | None -> on || fl.hf_overlay - in + let on = flags_or on fl in (* spacers are layout voids — they paint nothing and must never be the hit target (a full-window spacer in an overlay layer would otherwise swallow every DOM event). *) @@ -325,11 +327,18 @@ let hit_path store rects ~x ~y = then path := f.f_id :: !path; { Lui_paint.b_emit = false; b_down = true; b_ctx = on } in - Lui_paint.walk ~scale:1. ~viewport:(rect 0. 0. 0. 0.) store + (* The walk's "viewport" is the pointer point itself: a clip that + misses it can contain no hit, so the walk prunes the subtree — + promoted popups still escape. *) + Lui_paint.walk ~scale:1. + ~viewport:(rect x y 1e-4 1e-4) store ~layout:(fun id -> let r = Rects.get rects id in { Lui_paint.p_rect = r; p_override = Some r }) - ~enter ~leave:(fun _ _ -> ()) true; + ~enter + ~ghost_enter:(fun on id _contents -> + flags_or on (hit_flags_of store id)) + ~leave:(fun _ _ -> ()) true; (* The head is the node visited last in paint order: visually topmost. *) !path From 07c03432102500a13fbb8e022b065e1424112237 Mon Sep 17 00:00:00 2001 From: Tienson Qin Date: Tue, 13 Oct 2026 05:38:07 +0800 Subject: [PATCH 6/7] test(native): assert actions/state in headless runs; share the ladder walk MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit C8: the Linux/Windows "interaction" tests drove Ui.handle but dropped the returned actions and only compared two runs' scene checksums — inputs whose dispatches never reached the model could still "pass". Likewise the renderer-fallback coverage only asserted the ladder ordering and the no-op renderer's frame size, a CPU→CPU comparison that never touched the driver's real step-down path. - Lui_window.Renderer_ladder now owns the walk/demote/renderer_live sequencing both drivers wrote by hand: try_rung init failures step down, the untried tail is kept for runtime demotion, release and a per-demote window re-fit hook come from the platform. The SDL and Win32 mains wire their rung inits into it unchanged. - The headless harness primes the hit-test mirror before the first scripted event (previously frame 1's click tested against empty rects and always missed), records every action list, and feeds Dispatch events back into the app the way apply_actions does. - test_headless_actions asserts the actions themselves (Focus_changed, Press, TextChanged, Submit) and the resulting store mutations: on Linux the submitted draft mounts as a new item and clears the field; on Windows the Name field's text and the last-event line update. The Windows variant addresses the autofocused field by prop and its laid-out rect rather than guessed coordinates. - test_ladder_demote injects init failures on the GPU rungs and a mid-render device loss on the CPU rung through the same Renderer_ladder the drivers use, asserting walk order, release, and that renderer_live retries on the next rung inside the same render call. Generated with [Devin](https://devin.ai) Co-Authored-By: Devin <158243242+devin-ai-integration[bot]@users.noreply.github.com> --- platform/native/lui_window/lui_window.ml | 80 ++++ platform/native/lui_window/lui_window.mli | 53 +++ platform/native/lui_window_linux/main.ml | 381 +++++++++--------- .../test/lui_window_linux_test.ml | 210 +++++++++- platform/native/lui_window_windows/main.ml | 261 ++++++------ .../test/lui_window_windows_test.ml | 237 ++++++++++- 6 files changed, 856 insertions(+), 366 deletions(-) diff --git a/platform/native/lui_window/lui_window.ml b/platform/native/lui_window/lui_window.ml index dd242155..91a99719 100644 --- a/platform/native/lui_window/lui_window.ml +++ b/platform/native/lui_window/lui_window.ml @@ -2757,6 +2757,86 @@ module Checksum = struct let value t = t.hash end +module Renderer_ladder = struct + (* The renderer-ladder walk shared by the platform drivers. A ladder + is an ordered list of backend rungs (Vulkan/Gl/Cpu/Noop on Linux, + D3d11/Gl/Cpu/Noop on Windows): [walk] tries each rung's init left + to right — [try_rung] returning [None] steps down — and records + the untried tail so a mid-render failure can [demote] the active + rung and resume the walk below it. The platform supplies the + per-rung init (SDL/GL/Vulkan/D3D11 specifics), a [release] for + the dropped rung's resources and an optional [before_walk] hook + (the SDL driver re-creates its window there when the next rung + needs different flags); the sequencing, loss logging and the + exception-catching [renderer_live] wrapper live here once so the + fallback path can be exercised off-device. *) + + type 'a attempt = { + renderer : Lui_host.renderer; + state : 'a; + (** rung payload the driver reads back — e.g. the live-GL flag + or the D3D11 device held for shutdown *) + } + + type ('rung, 'a) t = { + warn : string -> unit; + release : 'a attempt -> unit; + before_walk : 'rung list -> unit; + exhausted_msg : string; + noop : 'a attempt; + try_rung : 'rung -> rest:'rung list -> 'a attempt option; + mutable remaining : 'rung list; + mutable active : 'a attempt; + } + + let rec walk t = function + | [] -> + t.remaining <- []; + t.warn t.exhausted_msg; + t.noop + | rung :: rest -> + (* The tail lands in [remaining] before the try so a later + demote resumes strictly below the active rung — a backend + that already lost its device is never retried. *) + t.remaining <- rest; + (match t.try_rung rung ~rest with + | Some a -> a + | None -> walk t rest) + + let create ~warn ~release ?(before_walk = fun _ -> ()) + ?(exhausted_msg = + "all renderer rungs failed; using no-op loop renderer") + ~noop ~try_rung rungs = + let t = + { warn; release; before_walk; exhausted_msg; noop; try_rung; + remaining = []; active = noop } + in + t.active <- walk t rungs; + t + + let active t = t.active + let remaining t = t.remaining + + let demote t ~reason = + t.warn + (Printf.sprintf "renderer %s lost (%s); stepping down the ladder" + t.active.renderer.Lui_host.name reason); + t.release t.active; + t.before_walk t.remaining; + t.active <- walk t t.remaining + + (* The host owns a stable record whose render delegates to the live + rung, so a demote needs no host rebuild. *) + let renderer_live t = + { Lui_host.name = "lui (resilient)"; + render = + (fun s -> + try t.active.renderer.Lui_host.render s + with exn -> + demote t ~reason:(Printexc.to_string exn); + t.active.renderer.Lui_host.render s) } +end + module Multi = struct (* Multi-window manager: a registry of independent surfaces. Each surface owns a full pipeline — host (store, layout, scene, diff --git a/platform/native/lui_window/lui_window.mli b/platform/native/lui_window/lui_window.mli index cda36c00..497dac2d 100644 --- a/platform/native/lui_window/lui_window.mli +++ b/platform/native/lui_window/lui_window.mli @@ -441,6 +441,59 @@ module Checksum : sig val value : t -> int64 end +(** The renderer-ladder walk shared by the platform drivers. + + A ladder is an ordered list of backend rungs; {!create} tries each + rung's init left to right — [try_rung] returning [None] steps + down — and records the untried tail so a mid-render failure can + {!demote} the active rung and resume the walk below it. The + platform supplies the per-rung init, a [release] for the dropped + rung's resources and an optional [before_walk] hook (used to + re-create the OS window when the next rung needs different + flags); the sequencing, loss logging and the exception-catching + {!renderer_live} wrapper live here once so the fallback path can + be exercised with injected rung failures off-device. *) +module Renderer_ladder : sig + type 'a attempt = { + renderer : Lui_host.renderer; + state : 'a; + (** rung payload the driver reads back — e.g. the live-GL flag + or the D3D11 device held for shutdown *) + } + + type ('rung, 'a) t + + val create : + warn:(string -> unit) -> + release:('a attempt -> unit) -> + ?before_walk:('rung list -> unit) -> + ?exhausted_msg:string -> + noop:'a attempt -> + try_rung:('rung -> rest:'rung list -> 'a attempt option) -> + 'rung list -> ('rung, 'a) t + (** [create ~warn ~release ~noop ~try_rung rungs] walks [rungs], + returning the state with the first successful rung active. + [try_rung rung ~rest] is the platform's init for one rung: + [Some attempt] on success, [None] to step down. [noop] is the + terminal attempt used when every rung fails; [release] drops a + demoted rung's resources; [before_walk] runs once per demote + with the remaining rungs (the SDL driver re-creates its window + there); [exhausted_msg] customises the empty-walk warning. *) + + val active : ('rung, 'a) t -> 'a attempt + val remaining : ('rung, 'a) t -> 'rung list + (** Rungs below the active one — what a demote will walk. *) + + val demote : ('rung, 'a) t -> reason:string -> unit + (** Drop the active rung (release + warn) and resume the walk at + {!remaining}. *) + + val renderer_live : ('rung, 'a) t -> Lui_host.renderer + (** A stable renderer record whose render delegates to the active + rung: a render exception demotes once and retries on the next + rung inside the same call, so the host needs no rebuild. *) +end + (** Multi-window manager: a registry of independent surfaces. Each surface owns a full pipeline — {!Lui_host} (store, layout, diff --git a/platform/native/lui_window_linux/main.ml b/platform/native/lui_window_linux/main.ml index b7b9518a..9665b37f 100644 --- a/platform/native/lui_window_linux/main.ml +++ b/platform/native/lui_window_linux/main.ml @@ -179,176 +179,197 @@ let () = (* Walk the ladder: each rung either yields a renderer or warns and the next rung gets its chance. GL needs the opengl-flagged window — when an earlier rung fails into the Gl rung the window - is recreated with the flag. [remaining] keeps the rungs below - the active one so a runtime demotion can re-walk the tail. *) + is recreated with the flag. The walk/demote sequencing lives in + [Lui_window.Renderer_ladder]; this supplies the per-rung init and + the window re-fit the demote path needs. *) let blit_cell = ref None in let vk_cell = ref None in let gctx_cell = ref None in - let remaining = ref [] in - let renderer, gl_live, attempt = - let mk_blit () = + let mk_blit () = + let dw, dh = + match Sdl.gl_get_drawable_size !win with + | 0, 0 -> (cfg.width, cfg.height) + | d -> d + in + match Lui_blit.create !win ~w:dw ~h:dh with + | Error m -> + warn "lui_blit.create failed: %s" m; + None + | Ok b -> + blit_cell := Some b; + Some b + in + let try_rung rung ~rest = + let attempt renderer state = + Some { Renderer_ladder.renderer; state } + in + match rung with + | Lui_linux.Noop -> attempt Lui_linux.noop_renderer false + | Lui_linux.Cpu -> ( + match mk_blit () with + | None -> None + | Some b -> + let rr = Lui_raster.Renderer.create () in + log "renderer: lui_raster+blit"; + attempt + { Lui_host.name = "lui_raster+blit"; + render = + (fun s -> + let dirty = Lui_raster.Renderer.render rr s in + let img = Lui_raster.Renderer.image rr in + let stride = img.Lui_raster.Image.stride / 4 in + if Lui_raster.Renderer.whole rr || dirty = [] then + ignore + (Lui_blit.update b ~pix:img.Lui_raster.Image.pix + ~stride) + else + List.iter + (fun (r : Lui_scene.irect) -> + ignore + (Lui_blit.update_region b ~x0:r.x0 ~y0:r.y0 + ~x1:r.x1 ~y1:r.y1 + ~pix:img.Lui_raster.Image.pix ~stride)) + dirty; + Lui_blit.present b; + img.Lui_raster.Image.pix) } + false) + | Lui_linux.Vulkan -> ( let dw, dh = match Sdl.gl_get_drawable_size !win with | 0, 0 -> (cfg.width, cfg.height) | d -> d in - match Lui_blit.create !win ~w:dw ~h:dh with + match Lui_vulkan.init ~w:dw ~h:dh with | Error m -> - warn "lui_blit.create failed: %s" m; + warn "lui_vulkan.init failed: %s" m; + if List.mem Lui_linux.Gl rest && not headless then begin + (* The GL rung next needs an opengl-flagged window. *) + Sdl.destroy_window !win; + win := + sdl_ok + (Sdl.create_window "lui_window_linux" ~w:cfg.width + ~h:cfg.height (flags true)) + end; None - | Ok b -> - blit_cell := Some b; - Some b - in - let rec attempt = function - | [] -> - remaining := []; - warn "all renderers unavailable; using no-op loop renderer"; - (Lui_linux.noop_renderer, false) - | Lui_linux.Noop :: _ -> - remaining := []; - (Lui_linux.noop_renderer, false) - | Lui_linux.Cpu :: rest -> - remaining := rest; - (match mk_blit () with - | None -> attempt rest - | Some b -> - let rr = Lui_raster.Renderer.create () in - log "renderer: lui_raster+blit"; - ( { Lui_host.name = "lui_raster+blit"; - render = - (fun s -> - let dirty = Lui_raster.Renderer.render rr s in - let img = Lui_raster.Renderer.image rr in - let stride = img.Lui_raster.Image.stride / 4 in - if Lui_raster.Renderer.whole rr || dirty = [] then - ignore - (Lui_blit.update b ~pix:img.Lui_raster.Image.pix - ~stride) - else - List.iter - (fun (r : Lui_scene.irect) -> - ignore - (Lui_blit.update_region b ~x0:r.x0 ~y0:r.y0 - ~x1:r.x1 ~y1:r.y1 - ~pix:img.Lui_raster.Image.pix ~stride)) - dirty; - Lui_blit.present b; - img.Lui_raster.Image.pix) }, - false )) - | Lui_linux.Vulkan :: rest -> - remaining := rest; - let dw, dh = - match Sdl.gl_get_drawable_size !win with - | 0, 0 -> (cfg.width, cfg.height) - | d -> d - in - (match Lui_vulkan.init ~w:dw ~h:dh with - | Error m -> - warn "lui_vulkan.init failed: %s" m; - if List.mem Lui_linux.Gl rest && not headless then begin - (* The GL rung next needs an opengl-flagged window. *) - Sdl.destroy_window !win; - win := - sdl_ok - (Sdl.create_window "lui_window_linux" ~w:cfg.width - ~h:cfg.height (flags true)) - end; - attempt rest - | Ok v -> - log "renderer: lui_vulkan (device %s, dual=%b)" - (Lui_vulkan.driver v) (Lui_vulkan.dual v); - vk_cell := Some v; - let b = mk_blit () in - ( { Lui_host.name = "lui_vulkan+blit"; - render = - (fun s -> - (* The offscreen frame image is sized at init; a - resized scene forces a re-init. On failure the - rung degrades to a zeroed frame — no crash. *) - let v = - match !vk_cell with - | Some v -> Some v - | None -> ( - match - Lui_vulkan.init ~w:s.Lui_scene.width - ~h:s.Lui_scene.height - with - | Ok v' -> vk_cell := Some v'; Some v' - | Error _ -> None) - in - match v with - | None -> - Bytes.create (s.Lui_scene.width * s.Lui_scene.height * 4) - | Some v -> ( - try - Lui_vulkan.render v s; - let pix = - Lui_vulkan.read_frame v ~w:s.Lui_scene.width - ~h:s.Lui_scene.height - in - (match b with - | Some b -> - ignore - (Lui_blit.update b ~pix - ~stride:s.Lui_scene.width); - Lui_blit.present b - | None -> ()); - pix - with - | Lui_vulkan.Error m -> - warn "lui_vulkan.render: %s" m; - Bytes.create - (s.Lui_scene.width * s.Lui_scene.height * 4))) }, - false )) - | Lui_linux.Gl :: rest -> - remaining := rest; - if headless then begin - (* The dummy driver has no GL to give. *) - attempt rest - end - else - (match Sdl.gl_create_context !win with - | Error (`Msg m) -> - warn "gl_create_context failed: %s" m; - Sdl.destroy_window !win; - win := - sdl_ok - (Sdl.create_window "lui_window_linux" ~w:cfg.width - ~h:cfg.height (flags false)); - attempt rest - | Ok c -> - sdl_ok (Sdl.gl_make_current !win c); - (match Lui_gl.init () with - | Ok gl -> - gctx_cell := Some c; - log "renderer: Lui_gl"; - ( { Lui_host.name = "lui_gl"; - render = - (fun s -> - try - Lui_gl.render gl s; - Bytes.empty - with - | Lui_gl.Error m -> - warn "lui_gl.render: %s" m; - Bytes.create - (s.Lui_scene.width * s.Lui_scene.height * 4)) }, - true ) - | Error m -> - warn "lui_gl.init failed: %s" m; - Sdl.gl_delete_context c; - Sdl.destroy_window !win; - win := - sdl_ok - (Sdl.create_window "lui_window_linux" ~w:cfg.width - ~h:cfg.height (flags false)); - attempt rest)) - in - let r, g = attempt ladder in - (r, g, attempt) + | Ok v -> + log "renderer: lui_vulkan (device %s, dual=%b)" + (Lui_vulkan.driver v) (Lui_vulkan.dual v); + vk_cell := Some v; + let b = mk_blit () in + attempt + { Lui_host.name = "lui_vulkan+blit"; + render = + (fun s -> + (* The offscreen frame image is sized at init; a + resized scene forces a re-init. On failure the + rung degrades to a zeroed frame — no crash. *) + let v = + match !vk_cell with + | Some v -> Some v + | None -> ( + match + Lui_vulkan.init ~w:s.Lui_scene.width + ~h:s.Lui_scene.height + with + | Ok v' -> vk_cell := Some v'; Some v' + | Error _ -> None) + in + match v with + | None -> + Bytes.create (s.Lui_scene.width * s.Lui_scene.height * 4) + | Some v -> ( + try + Lui_vulkan.render v s; + let pix = + Lui_vulkan.read_frame v ~w:s.Lui_scene.width + ~h:s.Lui_scene.height + in + (match b with + | Some b -> + ignore + (Lui_blit.update b ~pix + ~stride:s.Lui_scene.width); + Lui_blit.present b + | None -> ()); + pix + with + | Lui_vulkan.Error m -> + warn "lui_vulkan.render: %s" m; + Bytes.create + (s.Lui_scene.width * s.Lui_scene.height * 4))) } + false) + | Lui_linux.Gl -> + if headless then begin + (* The dummy driver has no GL to give. *) + None + end + else + (match Sdl.gl_create_context !win with + | Error (`Msg m) -> + warn "gl_create_context failed: %s" m; + Sdl.destroy_window !win; + win := + sdl_ok + (Sdl.create_window "lui_window_linux" ~w:cfg.width + ~h:cfg.height (flags false)); + None + | Ok c -> + sdl_ok (Sdl.gl_make_current !win c); + (match Lui_gl.init () with + | Ok gl -> + gctx_cell := Some c; + log "renderer: Lui_gl"; + attempt + { Lui_host.name = "lui_gl"; + render = + (fun s -> + try + Lui_gl.render gl s; + Bytes.empty + with + | Lui_gl.Error m -> + warn "lui_gl.render: %s" m; + Bytes.create + (s.Lui_scene.width * s.Lui_scene.height * 4)) } + true + | Error m -> + warn "lui_gl.init failed: %s" m; + Sdl.gl_delete_context c; + Sdl.destroy_window !win; + win := + sdl_ok + (Sdl.create_window "lui_window_linux" ~w:cfg.width + ~h:cfg.height (flags false)); + None)) in let vk_state = vk_cell in + let ladder_t = + Renderer_ladder.create + ~warn:(fun m -> warn "%s" m) + ~release:(fun _ -> + (match !gctx_cell with + | Some c -> Sdl.gl_delete_context c; gctx_cell := None + | None -> ()); + (match !vk_cell with + | Some v -> Lui_vulkan.release v; vk_cell := None + | None -> ()); + blit_cell := None) + ~before_walk:(fun rest -> + (* Re-flag the window for the rung about to be tried. *) + let next_gl = + match rest with Lui_linux.Gl :: _ -> true | _ -> false + in + Sdl.destroy_window !win; + win := + sdl_ok + (Sdl.create_window "lui_window_linux" ~w:cfg.width + ~h:cfg.height (flags (next_gl && not headless)))) + ~exhausted_msg:"all renderers unavailable; using no-op loop renderer" + ~noop:{ Renderer_ladder.renderer = Lui_linux.noop_renderer; + state = false } + ~try_rung ladder + in + let gl_live () = (Renderer_ladder.active ladder_t).state in (* Runtime backend-loss recovery. An SDL render-target/device reset event (0x2000/0x2001) or a render exception demotes the active rung to the next ladder entry — the window is re-flagged for the @@ -356,40 +377,10 @@ let () = scene store is untouched, so the next repaint re-uploads a full scene — identical pixels on the CPU path by the parity contract. *) - let renderer_cell = ref renderer and gl_live_cell = ref gl_live in - let demote reason = - warn "renderer %s lost (%s); stepping down the ladder" - (!renderer_cell).Lui_host.name reason; - (match !gctx_cell with - | Some c -> Sdl.gl_delete_context c; gctx_cell := None - | None -> ()); - (match !vk_cell with - | Some v -> Lui_vulkan.release v; vk_cell := None - | None -> ()); - blit_cell := None; - let next_gl = - match !remaining with Lui_linux.Gl :: _ -> true | _ -> false - in - Sdl.destroy_window !win; - win := - sdl_ok - (Sdl.create_window "lui_window_linux" ~w:cfg.width ~h:cfg.height - (flags (next_gl && not headless))); - let r, g = attempt !remaining in - renderer_cell := r; - gl_live_cell := g - in + let demote reason = Renderer_ladder.demote ladder_t ~reason in (* The host owns a stable record whose render delegates to the live rung, so a demote needs no host rebuild. *) - let renderer_live = - { Lui_host.name = "lui (resilient)"; - render = - (fun s -> - try (!renderer_cell).Lui_host.render s - with exn -> - demote (Printexc.to_string exn); - (!renderer_cell).Lui_host.render s) } - in + let renderer_live = Renderer_ladder.renderer_live ladder_t in let vsync = match !gctx_cell with | Some _ -> (match Sdl.gl_set_swap_interval 1 with @@ -763,7 +754,7 @@ let () = | None -> true) in log "lui_window_linux: %dx%d drawable (scale %.2f), renderer=%s%s" - dw dh scale (!renderer_cell).Lui_host.name + dw dh scale (Renderer_ladder.active ladder_t).renderer.Lui_host.name (if headless then " [headless]" else ""); while continue () do let t0 = perf_s () in @@ -792,16 +783,16 @@ let () = let dirty = headless || Ui.want_frame ui host in if dirty then begin ignore (Lui_host.repaint host); - if !gl_live_cell then Sdl.gl_swap_window !win; + if gl_live () then Sdl.gl_swap_window !win; Ui.frame_done ui; incr frame; Checksum.add_scene checksum (Lui_host.scene host); - if headless && not !gl_live_cell then + if headless && not (gl_live ()) then log "frame=%d ops=%d" !frame (List.length (Lui_host.scene host).Lui_scene.ops); stats_update st ((perf_s () -. t0) *. 1000.); if !frame mod 60 = 0 then - stats_report st (!renderer_cell).Lui_host.name + stats_report st (Renderer_ladder.active ladder_t).renderer.Lui_host.name end; (* No vsync under the dummy driver and possibly none elsewhere: pace the loop explicitly. An idle iteration (no repaint) also @@ -815,7 +806,7 @@ let () = else if not dirty then Sdl.delay 4l end done; - stats_report st (!renderer_cell).Lui_host.name; + stats_report st (Renderer_ladder.active ladder_t).renderer.Lui_host.name; (match frames_target with | Some _ -> log "headless done: frames=%d checksum=%016Lx" !frame diff --git a/platform/native/lui_window_linux/test/lui_window_linux_test.ml b/platform/native/lui_window_linux/test/lui_window_linux_test.ml index 032122b6..9cc5faf0 100644 --- a/platform/native/lui_window_linux/test/lui_window_linux_test.ml +++ b/platform/native/lui_window_linux/test/lui_window_linux_test.ml @@ -81,6 +81,72 @@ let test_ladder () = let pix = Lui_linux.noop_renderer.Lui_host.render scene in Alcotest.(check int) "noop bytes" (5 * 3 * 4) (Bytes.length pix) +(* The real walk/demote path the driver uses: injected init failures + step down the ladder at startup, and a mid-render device loss + demotes inside the same render call — not a CPU->CPU comparison. *) +let test_ladder_demote () = + let module RL = Renderer_ladder in + let scene () = + let s = + Lui_scene.create ~mask_atlas:(Atlas.create ~bpp:1 ~w:8 ~h:8) + ~color_atlas:(Atlas.create ~bpp:4 ~w:8 ~h:8) + in + s.Lui_scene.width <- 2; + s.Lui_scene.height <- 1; + s + in + let tried = ref [] and released = ref [] in + let cpu_live = ref true in + let cpu_pix = Bytes.make 8 '\xAB' in + let cpu = + { RL.renderer = + { Lui_host.name = "mock-cpu"; + render = + (fun _ -> + if !cpu_live then cpu_pix else failwith "device lost") }; + state = `cpu } + in + let noop = + { RL.renderer = Lui_linux.noop_renderer; state = `noop } + in + let try_rung rung ~rest:_ = + tried := rung :: !tried; + match rung with + (* injected GPU init failures: no Vulkan device, no GL context *) + | Lui_linux.Vulkan | Lui_linux.Gl -> None + | Lui_linux.Cpu -> Some cpu + | Lui_linux.Noop -> Some noop + in + let t = + RL.create ~warn:(fun _ -> ()) + ~release:(fun a -> released := a.RL.state :: !released) + ~noop ~try_rung + [ Lui_linux.Vulkan; Lui_linux.Gl; Lui_linux.Cpu; Lui_linux.Noop ] + in + (* the init walk tried Vulkan and Gl, then settled on Cpu with the + Noop tail kept in reserve for a runtime demote *) + Alcotest.(check bool) "walk order" true + (List.rev !tried + = [ Lui_linux.Vulkan; Lui_linux.Gl; Lui_linux.Cpu ]); + Alcotest.(check bool) "cpu active" true + ((RL.active t).RL.state = `cpu); + Alcotest.(check bool) "tail kept" true + (RL.remaining t = [ Lui_linux.Noop ]); + (* the CPU rung wins a frame before dying *) + let live = RL.renderer_live t in + Alcotest.(check bool) "cpu frame" true + (live.Lui_host.render (scene ()) == cpu_pix); + (* a mid-render device loss demotes to Noop inside the same call: + the rung's release ran and the zeroed fallback frame comes back *) + cpu_live := false; + let pix = live.Lui_host.render (scene ()) in + Alcotest.(check bool) "cpu released" true (!released = [ `cpu ]); + Alcotest.(check bool) "noop active" true + ((RL.active t).RL.state = `noop); + Alcotest.(check int) "zeroed frame" (2 * 1 * 4) (Bytes.length pix); + Alcotest.(check bool) "walked on" true + (List.exists (fun r -> r = Lui_linux.Noop) !tried) + let test_tray_icon () = let px = Lui_linux.tray_icon_rgba () in Alcotest.(check int) "rgba bytes" (22 * 22 * 4) (Bytes.length px); @@ -337,8 +403,31 @@ let host_with_app () = let app = Demo_app.create backend in (host, store, app, refresh, text_engine) +(* One scripted frame's outcome: the actions [Ui.handle] produced and + the scene checksum after the driver's flush/relayout/repaint. *) +type headless_run = { + checksum : int64; + ops : int; + acted : action list list; + ui : Ui.t; + store : Lui_store.t; +} + +(* Feed the host-level action list back into the app the way the + driver's apply_actions does: only [Dispatch] events reach the + model; the rest are driver-side concerns out of scope here. *) +let apply_to_app app acts = + List.iter + (function + | Dispatch ev -> ( + try ignore (Lui_app.dispatch_event app ev) + with Invalid_argument _ -> ()) + | _ -> ()) + acts + (* Drive [script] input events between frames like the SDL loop does, - accumulating the scene checksum. *) + accumulating the scene checksum and keeping the action list each + event produced so callers can assert on them. *) let run_headless frames script = let host, store, app, refresh, text_engine = host_with_app () in let ui = Ui.create () in @@ -350,35 +439,124 @@ let run_headless frames script = Layout.refresh store rects ~width:480 ~height:320 ~scale:1. ~measure:(Lui_window_text.measure text_engine) in + (* prime the hit-test mirror before the first event — the driver + lays out once before its loop, otherwise frame 1's click tests + against empty rects *) + refresh' (); let cs = Checksum.create () in let ops_last = ref 0 in + let acted = ref [] in let scripted = Array.of_list script in for f = 1 to frames do (* one scripted input per frame, then flush + relayout + repaint — the same ordering the driver loop uses *) - if f <= Array.length scripted then - ignore (Ui.handle ui store rects scripted.(f - 1)); + if f <= Array.length scripted then begin + let acts = Ui.handle ui store rects scripted.(f - 1) in + acted := acts :: !acted; + apply_to_app app acts + end; ignore (Lui_app.flush app); refresh' (); ignore (Lui_host.repaint host); Checksum.add_scene cs (Lui_host.scene host); ops_last := List.length (Lui_host.scene host).Lui_scene.ops done; - (Checksum.value cs, !ops_last) + { checksum = Checksum.value cs; ops = !ops_last; + acted = List.rev !acted; ui; store } + +let headless_script = + [ Input.Button_down (60., 100., Input.Left, 1, Input.mods_none); + Input.Button_up (60., 100., Input.Left, Input.mods_none); + Input.Text_input "hello"; + Input.Key_down (Input.Return, Input.mods_none, false) ] let test_headless_checksum () = let frames = 6 in - let script = - [ Input.Button_down (60., 78., Input.Left, 1, Input.mods_none); - Input.Button_up (60., 78., Input.Left, Input.mods_none); - Input.Text_input "hello"; - Input.Key_down (Input.Return, Input.mods_none, false) ] + let r1 = run_headless frames headless_script in + let r2 = run_headless frames headless_script in + Alcotest.(check bool) "scene painted" true (r1.ops > 0); + Alcotest.(check int64) "deterministic" r1.checksum r2.checksum; + Alcotest.(check int) "same ops" r1.ops r2.ops + +(* The scripted frames are an interaction test, not just a render + determinism check: every event must produce the actions the + driver's apply_actions consumes, and the dispatches must land as + store mutations. *) +let show_event = function + | TextChanged (id, s) -> Printf.sprintf "TextChanged(%d,%S)" id s + | Submit id -> Printf.sprintf "Submit %d" id + | Press id -> Printf.sprintf "Press %d" id + | PointerDown (id, _) -> Printf.sprintf "PointerDown %d" id + | PointerUp (id, _) -> Printf.sprintf "PointerUp %d" id + | PressDetail (id, _) -> Printf.sprintf "PressDetail %d" id + | Appear id -> Printf.sprintf "Appear %d" id + | ToggleChanged (id, b) -> Printf.sprintf "ToggleChanged(%d,%b)" id b + | Change id -> Printf.sprintf "Change %d" id + | Dismiss id -> Printf.sprintf "Dismiss %d" id + | _ -> "event" + +let show_acts acts = + String.concat ", " + (List.map + (function + | Focus_changed id -> Printf.sprintf "Focus_changed %d" id + | Dispatch e -> "Dispatch " ^ show_event e + | Quit -> "Quit" + | Ime_rect _ -> "Ime_rect" + | Resize_host _ -> "Resize_host" + | Clipboard_write s -> Printf.sprintf "Clipboard_write %S" s + | Paste_request -> "Paste_request") + acts) + +let test_headless_actions () = + let r = run_headless 4 headless_script in + let field = + match + List.find_opt + (fun id -> + Lui_store.string_prop r.store id "accessibility-label" + = Some "New item") + (Lui_store.preorder r.store) + with + | Some id -> id + | None -> Alcotest.fail "demo text field not mounted" + in + (match r.acted with + | [ down; up; input; submit ] -> + (* the click claims the autofocus field — the Focus_changed the + driver would use to start text input *) + (match down with + | [ Focus_changed f ] when f = field -> () + | _ -> + Alcotest.failf "click did not focus the field: %s" + (show_acts down)); + (match up with + | [ Dispatch (Press p) ] when p <> 0 -> () + | _ -> Alcotest.failf "release not quiet: %s" (show_acts up)); + (match input with + | [ Dispatch (TextChanged (f, "hello")) ] when f = field -> () + | _ -> + Alcotest.failf "typing did not dispatch TextChanged: %s" + (show_acts input)); + (match submit with + | [ Dispatch (Submit f) ] when f = field -> () + | _ -> + Alcotest.failf "Return did not dispatch Submit: %s" + (show_acts submit)) + | frames -> + Alcotest.failf "expected four action frames, got %d" + (List.length frames)); + (* the dispatches reached the model: "hello" mounts as a new item + and the field's draft is cleared *) + let has_text_node v = + List.exists + (fun id -> Lui_store.string_prop r.store id "text" = Some v) + (Lui_store.preorder r.store) in - let v1, ops1 = run_headless frames script in - let v2, ops2 = run_headless frames script in - Alcotest.(check bool) "scene painted" true (ops1 > 0); - Alcotest.(check int64) "deterministic" v1 v2; - Alcotest.(check int) "same ops" ops1 ops2 + Alcotest.(check bool) "item added" true (has_text_node "hello"); + Alcotest.(check bool) "draft cleared" true + (Lui_store.string_prop r.store field "text" = Some ""); + Alcotest.(check int) "focus kept" field (Ui.focused r.ui) (* ---------- accessibility bridge (offline-safe) ---------- *) @@ -478,6 +656,7 @@ let () = Alcotest.run "lui_window_linux" [ ( "ladder", [ Alcotest.test_case "renderer ladder" `Quick test_ladder; + Alcotest.test_case "demote path" `Quick test_ladder_demote; Alcotest.test_case "tray icon" `Quick test_tray_icon ] ); ( "a11y", [ Alcotest.test_case "action mapping" `Quick test_a11y_actions; @@ -491,7 +670,8 @@ let () = Alcotest.test_case "combining" `Quick test_caret_ops_combining; Alcotest.test_case "vertical" `Quick test_caret_ops_vertical ] ); ( "headless", - [ Alcotest.test_case "checksum" `Quick test_headless_checksum ] ); + [ Alcotest.test_case "checksum" `Quick test_headless_checksum; + Alcotest.test_case "actions" `Quick test_headless_actions ] ); ( "shell", [ Alcotest.test_case "menu model" `Quick test_shell_model; Alcotest.test_case "degraded" `Quick test_shell_degraded ] ) ] diff --git a/platform/native/lui_window_windows/main.ml b/platform/native/lui_window_windows/main.ml index 39006ac2..bb57c67f 100644 --- a/platform/native/lui_window_windows/main.ml +++ b/platform/native/lui_window_windows/main.ml @@ -90,149 +90,129 @@ let () = in let dw, dh = drawable () in let scale = Float.max 0.01 (Lui_win32.dpi_scale hwnd) in - (* Renderer selection. [d3d_state] keeps the live [Lui_d3d11.t] for - release at shutdown; [present_last] remembers the last blitted - frame so a WM_PAINT can be answered without a full repaint. *) - let d3d_state = ref None in + (* Renderer selection. The ladder attempt's [state] keeps the live + [Lui_d3d11.t] (when a D3D11 rung won) for release at shutdown; + [present_last] remembers the last blitted frame so a WM_PAINT + can be answered without a full repaint. *) let present_last = ref None in (* The ladder walk returns the renderer plus the live [Lui_d3d11.t] - (when a D3D11 rung won) so shutdown can release the device. - [remaining] keeps the rungs below the active one so a runtime - demotion can re-walk the tail. *) - let remaining = ref [] in - let renderer, d3d_live, walk = - let rec walk = function - | [] -> - remaining := []; - warn "all renderer rungs failed; using no-op loop renderer"; - (Lui_window_windows.noop_renderer, None) - | rung :: rest -> - remaining := rest; - ( - match rung with - | Lui_window_windows.Cpu -> ( - (* CPU rung: Lui_raster renders the scene; StretchDIBits - uploads the damaged rects (or the whole frame). *) - match - let rr = Lui_raster.Renderer.create () in - { Lui_host.name = "lui_raster+dib"; + (when a D3D11 rung won) as the attempt state so shutdown can + release the device. The walk/demote sequencing lives in + [Lui_window.Renderer_ladder]; this supplies the per-rung init. *) + let try_rung rung ~rest:_ = + let attempt renderer state = + Some { Renderer_ladder.renderer; state } + in + match rung with + | Lui_window_windows.Cpu -> ( + (* CPU rung: Lui_raster renders the scene; StretchDIBits + uploads the damaged rects (or the whole frame). *) + match + let rr = Lui_raster.Renderer.create () in + { Lui_host.name = "lui_raster+dib"; + render = + (fun s -> + let dirty = Lui_raster.Renderer.render rr s in + let img = Lui_raster.Renderer.image rr in + let pix = img.Lui_raster.Image.pix in + let stride = img.Lui_raster.Image.stride / 4 in + let w = img.Lui_raster.Image.w + and h = img.Lui_raster.Image.h in + if Lui_raster.Renderer.whole rr || dirty = [] then + ignore (Lui_win32.present_frame hwnd pix ~w ~h) + else + List.iter + (fun (r : Lui_scene.irect) -> + ignore + (Lui_win32.present_region hwnd ~x0:r.x0 + ~y0:r.y0 ~x1:r.x1 ~y1:r.y1 ~pix ~stride)) + dirty; + present_last := Some (pix, w, h); + pix) } + with + | r -> attempt r None + | exception e -> + warn "cpu rung init failed: %s" (Printexc.to_string e); + None) + | Lui_window_windows.D3d11 -> ( + (* Default rung: first a swapchain on the window's HWND — + real presentation with GPU rasterization — then an + offscreen render target whose frames are read back and + uploaded through the same DIB path as the CPU rung. + [Lui_d3d11.render] auto-resizes its target to the scene + size, so resizes need no extra plumbing. *) + let try_hwnd () = + match Lui_d3d11.init_hwnd hwnd ~w:dw ~h:dh with + | Ok d -> + attempt + { Lui_host.name = "lui_d3d11 (hwnd)"; render = (fun s -> - let dirty = Lui_raster.Renderer.render rr s in - let img = Lui_raster.Renderer.image rr in - let pix = img.Lui_raster.Image.pix in - let stride = img.Lui_raster.Image.stride / 4 in - let w = img.Lui_raster.Image.w - and h = img.Lui_raster.Image.h in - if Lui_raster.Renderer.whole rr || dirty = [] then - ignore (Lui_win32.present_frame hwnd pix ~w ~h) - else - List.iter - (fun (r : Lui_scene.irect) -> - ignore - (Lui_win32.present_region hwnd ~x0:r.x0 - ~y0:r.y0 ~x1:r.x1 ~y1:r.y1 ~pix ~stride)) - dirty; - present_last := Some (pix, w, h); - pix) } - with - | r -> (r, None) - | exception e -> - warn "cpu rung init failed: %s" (Printexc.to_string e); - walk rest) - | Lui_window_windows.D3d11 -> ( - (* Default rung: first a swapchain on the window's HWND — - real presentation with GPU rasterization — then an - offscreen render target whose frames are read back and - uploaded through the same DIB path as the CPU rung. - [Lui_d3d11.render] auto-resizes its target to the scene - size, so resizes need no extra plumbing. *) - let try_hwnd () = - match Lui_d3d11.init_hwnd hwnd ~w:dw ~h:dh with - | Ok d -> - Some - ( { Lui_host.name = "lui_d3d11 (hwnd)"; - render = - (fun s -> - Lui_d3d11.render d s; - Bytes.empty) }, - Some d ) - | Error e -> - warn "lui_d3d11.init_hwnd failed: %s" e; - None - in - let try_offscreen () = - match Lui_d3d11.init_offscreen ~w:dw ~h:dh with - | Ok d -> - Some - ( { Lui_host.name = "lui_d3d11 (offscreen+blit)"; - render = - (fun s -> - Lui_d3d11.render d s; - let px = - Lui_d3d11.read_frame d ~w:s.Lui_scene.width - ~h:s.Lui_scene.height - in - ignore - (Lui_win32.present_frame hwnd px - ~w:s.Lui_scene.width - ~h:s.Lui_scene.height); - present_last := - Some (px, s.Lui_scene.width, s.Lui_scene.height); - px) }, - Some d ) - | Error e -> - warn "lui_d3d11.init_offscreen failed: %s" e; - None - in - match try_hwnd () with - | Some v -> v - | None -> ( - match try_offscreen () with - | Some v -> v - | None -> walk rest)) - | Lui_window_windows.Gl -> - (* This build carries no GL bindings (tsdl/tgls are not - installed on the VM), so the rung can only report and - yield — a build that links Lui_gl would create a WGL - context on the HWND here. *) - warn "lui_gl unavailable on this build (no GL bindings)"; - walk rest - | Lui_window_windows.Noop -> - (Lui_window_windows.noop_renderer, None)) - in - let r, d = walk rungs in (r, d, walk) + Lui_d3d11.render d s; + Bytes.empty) } + (Some d) + | Error e -> + warn "lui_d3d11.init_hwnd failed: %s" e; + None + in + let try_offscreen () = + match Lui_d3d11.init_offscreen ~w:dw ~h:dh with + | Ok d -> + attempt + { Lui_host.name = "lui_d3d11 (offscreen+blit)"; + render = + (fun s -> + Lui_d3d11.render d s; + let px = + Lui_d3d11.read_frame d ~w:s.Lui_scene.width + ~h:s.Lui_scene.height + in + ignore + (Lui_win32.present_frame hwnd px + ~w:s.Lui_scene.width + ~h:s.Lui_scene.height); + present_last := + Some (px, s.Lui_scene.width, s.Lui_scene.height); + px) } + (Some d) + | Error e -> + warn "lui_d3d11.init_offscreen failed: %s" e; + None + in + match try_hwnd () with + | Some v -> Some v + | None -> try_offscreen ()) + | Lui_window_windows.Gl -> + (* This build carries no GL bindings (tsdl/tgls are not + installed on the VM), so the rung can only report and + yield — a build that links Lui_gl would create a WGL + context on the HWND here. *) + warn "lui_gl unavailable on this build (no GL bindings)"; + None + | Lui_window_windows.Noop -> + attempt Lui_window_windows.noop_renderer None + in + let ladder_t = + Renderer_ladder.create + ~warn:(fun m -> warn "%s" m) + ~release:(fun a -> + (match a.Renderer_ladder.state with + | Some d -> Lui_d3d11.release d + | None -> ()); + present_last := None) + ~noop:{ Renderer_ladder.renderer = + Lui_window_windows.noop_renderer; + state = None } + ~try_rung rungs in - d3d_state := d3d_live; (* Runtime backend-loss recovery: a device-removed or any render exception demotes the active rung to the next ladder entry. The scene store is untouched, so the next repaint re-uploads a full scene — identical pixels on the CPU path by the parity - contract. *) - let renderer_cell = ref renderer in - let demote reason = - warn "renderer %s lost (%s); stepping down the ladder" - (!renderer_cell).Lui_host.name reason; - (match !d3d_state with - | Some d -> Lui_d3d11.release d; d3d_state := None - | None -> ()); - present_last := None; - let r, d = walk !remaining in - renderer_cell := r; - d3d_state := d - in - (* The host owns a stable record whose render delegates to the live - rung, so a demote needs no host rebuild. *) - let renderer_live = - { Lui_host.name = "lui (resilient)"; - render = - (fun s -> - try (!renderer_cell).Lui_host.render s - with exn -> - demote (Printexc.to_string exn); - (!renderer_cell).Lui_host.render s) } - in + contract. The host owns a stable record whose render delegates + to the live rung, so a demote needs no host rebuild. *) + let renderer_live = Renderer_ladder.renderer_live ladder_t in (* Wiring: mutable cells so the paint hooks can reach the host, scene and scale that only exist after Lui_host.create. *) @@ -473,7 +453,8 @@ let () = second further down. *) ignore (Lui_app.send app - (Demo_app.Badge (!renderer_cell).Lui_host.name)); + (Demo_app.Badge + (Renderer_ladder.active ladder_t).renderer.Lui_host.name)); Some item end in @@ -615,7 +596,7 @@ let () = if req_hit "clipboard" m.Demo_app.req_clipboard then begin let s = Printf.sprintf "lui_window_windows %dx%d renderer=%s frames=%d" - dw dh (!renderer_cell).Lui_host.name !frame in + dw dh (Renderer_ladder.active ladder_t).renderer.Lui_host.name !frame in log "shell clipboard: wrote %d chars (ok=%b)" (String.length s) (Lui_shell_windows.clipboard_write s) end; @@ -645,7 +626,7 @@ let () = | None -> true) in log "lui_window_windows: %dx%d drawable (scale %.2f), renderer=%s%s" - dw dh scale (!renderer_cell).Lui_host.name + dw dh scale (Renderer_ladder.active ladder_t).renderer.Lui_host.name (if headless then " [headless]" else ""); while continue () do let t0 = perf_s () in @@ -688,13 +669,13 @@ let () = if st.frames > 0 && st.acc_ms > 0. then 1000. /. (st.acc_ms /. float st.frames) else 0. in - stats_report st (!renderer_cell).Lui_host.name; + stats_report st (Renderer_ladder.active ladder_t).renderer.Lui_host.name; if not headless then ignore (Lui_app.send app (Demo_app.Badge (Printf.sprintf "%s — %.0f fps" - (!renderer_cell).Lui_host.name fps))) + (Renderer_ladder.active ladder_t).renderer.Lui_host.name fps))) end end; (* The semantic tree tracks the store every iteration — cheap @@ -713,7 +694,7 @@ let () = else Lui_win32.delay_ms 4 end done; - stats_report st (!renderer_cell).Lui_host.name; + stats_report st (Renderer_ladder.active ladder_t).renderer.Lui_host.name; log "a11y: %d nodes" (Lui_a11y.node_count a11y); (match frames_target with | Some _ -> @@ -725,7 +706,7 @@ let () = (match status_item with | Some item -> Lui_shell_windows.status_item_remove item | None -> ()); - (match !d3d_state with + (match (Renderer_ladder.active ladder_t).state with | Some d -> Lui_d3d11.release d | None -> ()); Lui_win32.destroy_window hwnd diff --git a/platform/native/lui_window_windows/test/lui_window_windows_test.ml b/platform/native/lui_window_windows/test/lui_window_windows_test.ml index d7a56e04..bf59e6c8 100644 --- a/platform/native/lui_window_windows/test/lui_window_windows_test.ml +++ b/platform/native/lui_window_windows/test/lui_window_windows_test.ml @@ -79,6 +79,74 @@ let test_ladder () = in Alcotest.(check int) "noop bytes" (5 * 3 * 4) (Bytes.length pix) +(* The real walk/demote path the driver uses: injected init failures + step down the ladder at startup, and a mid-render device loss + demotes inside the same render call — not a CPU->CPU comparison. *) +let test_ladder_demote () = + let module RL = Renderer_ladder in + let scene () = + let s = + Lui_scene.create ~mask_atlas:(Atlas.create ~bpp:1 ~w:8 ~h:8) + ~color_atlas:(Atlas.create ~bpp:4 ~w:8 ~h:8) + in + s.Lui_scene.width <- 2; + s.Lui_scene.height <- 1; + s + in + let tried = ref [] and released = ref [] in + let cpu_live = ref true in + let cpu_pix = Bytes.make 8 '\xAB' in + let cpu = + { RL.renderer = + { Lui_host.name = "mock-cpu"; + render = + (fun _ -> + if !cpu_live then cpu_pix else failwith "device lost") }; + state = `cpu } + in + let noop = + { RL.renderer = Lui_window_windows.noop_renderer; state = `noop } + in + let try_rung rung ~rest:_ = + tried := rung :: !tried; + match rung with + (* injected GPU init failures: no D3D11 device, no GL context *) + | Lui_window_windows.D3d11 | Lui_window_windows.Gl -> None + | Lui_window_windows.Cpu -> Some cpu + | Lui_window_windows.Noop -> Some noop + in + let t = + RL.create ~warn:(fun _ -> ()) + ~release:(fun a -> released := a.RL.state :: !released) + ~noop ~try_rung + [ Lui_window_windows.D3d11; Lui_window_windows.Gl; + Lui_window_windows.Cpu; Lui_window_windows.Noop ] + in + (* the init walk tried D3d11 and Gl, then settled on Cpu with the + Noop tail kept in reserve for a runtime demote *) + Alcotest.(check bool) "walk order" true + (List.rev !tried + = [ Lui_window_windows.D3d11; Lui_window_windows.Gl; + Lui_window_windows.Cpu ]); + Alcotest.(check bool) "cpu active" true + ((RL.active t).RL.state = `cpu); + Alcotest.(check bool) "tail kept" true + (RL.remaining t = [ Lui_window_windows.Noop ]); + (* the CPU rung wins a frame before dying *) + let live = RL.renderer_live t in + Alcotest.(check bool) "cpu frame" true + (live.Lui_host.render (scene ()) == cpu_pix); + (* a mid-render device loss demotes to Noop inside the same call: + the rung's release ran and the zeroed fallback frame comes back *) + cpu_live := false; + let pix = live.Lui_host.render (scene ()) in + Alcotest.(check bool) "cpu released" true (!released = [ `cpu ]); + Alcotest.(check bool) "noop active" true + ((RL.active t).RL.state = `noop); + Alcotest.(check int) "zeroed frame" (2 * 1 * 4) (Bytes.length pix); + Alcotest.(check bool) "walked on" true + (List.exists (fun r -> r = Lui_window_windows.Noop) !tried) + let test_tray_icon () = let px = Lui_window_windows.tray_icon_rgba () in Alcotest.(check int) "rgba bytes" (22 * 22 * 4) (Bytes.length px); @@ -338,10 +406,34 @@ let host_with_app () = let app = Demo_app.create backend in (host, store, app, text_engine, refresh) -(* Drive [script] input events between frames like the Win32 loop - does, accumulating the scene checksum. *) let dbg fmt = Printf.printf (fmt ^^ " %!") + +(* One scripted run's outcome: the actions [Ui.handle] produced and + the scene checksum after the driver's flush/relayout/repaint. *) +type headless_run = { + checksum : int64; + ops : int; + acted : action list list; + ui : Ui.t; + store : Lui_store.t; +} + +(* Feed the host-level action list back into the app the way the + driver's apply_actions does: only [Dispatch] events reach the + model; the rest are driver-side concerns out of scope here. *) +let apply_to_app app acts = + List.iter + (function + | Dispatch ev -> ( + try ignore (Lui_app.dispatch_event app ev) + with Invalid_argument _ -> ()) + | _ -> ()) + acts + +(* Drive [script] input events between frames like the Win32 loop + does, accumulating the scene checksum and keeping the action list + each event produced so callers can assert on them. *) let run_headless frames script = dbg "stage: host_with_app"; let host, store, app, text_engine, refresh = host_with_app () in @@ -358,14 +450,21 @@ let run_headless frames script = Layout.refresh store rects ~width:480 ~height:320 ~scale:1. ~measure:(Lui_window_text.measure text_engine) in + (* prime the hit-test mirror before the first event — the driver + lays out once before its loop, otherwise frame 1's click tests + against empty rects *) + refresh' (); let cs = Checksum.create () in let ops_last = ref 0 in + let acted = ref [] in let scripted = Array.of_list script in for f = 1 to frames do (* one scripted input per frame, then flush + relayout + repaint — the same ordering the driver loop uses *) if f <= Array.length scripted then begin - ignore (Ui.handle ui store rects scripted.(f - 1)); + let acts = Ui.handle ui store rects scripted.(f - 1) in + acted := acts :: !acted; + apply_to_app app acts; dbg "f%d: handled" f end; ignore (Lui_app.flush app); @@ -377,7 +476,8 @@ let run_headless frames script = Checksum.add_scene cs (Lui_host.scene host); ops_last := List.length (Lui_host.scene host).Lui_scene.ops done; - (Checksum.value cs, !ops_last) + { checksum = Checksum.value cs; ops = !ops_last; + acted = List.rev !acted; ui; store } (* Shaped lines rooted for the process: see the comment at [rooted_lines] use below. *) @@ -423,20 +523,123 @@ let test_repaint_min () = ignore (Lui_host.repaint host); dbg "min repaint ok" +let headless_script = + [ Input.Button_down (60., 78., Input.Left, 1, Input.mods_none); + Input.Button_up (60., 78., Input.Left, Input.mods_none); + Input.Text_input "hello"; + Input.Key_down (Input.Return, Input.mods_none, false) ] + let test_headless_checksum () = dbg "entry"; let frames = 6 in - let script = - [ Input.Button_down (60., 78., Input.Left, 1, Input.mods_none); - Input.Button_up (60., 78., Input.Left, Input.mods_none); - Input.Text_input "hello"; - Input.Key_down (Input.Return, Input.mods_none, false) ] - in - let v1, ops1 = run_headless frames script in - let v2, ops2 = run_headless frames script in - Alcotest.(check bool) "scene painted" true (ops1 > 0); - Alcotest.(check int64) "deterministic" v1 v2; - Alcotest.(check int) "same ops" ops1 ops2 + let r1 = run_headless frames headless_script in + let r2 = run_headless frames headless_script in + Alcotest.(check bool) "scene painted" true (r1.ops > 0); + Alcotest.(check int64) "deterministic" r1.checksum r2.checksum; + Alcotest.(check int) "same ops" r1.ops r2.ops + +let show_event = function + | TextChanged (id, s) -> Printf.sprintf "TextChanged(%d,%S)" id s + | Submit id -> Printf.sprintf "Submit %d" id + | Press id -> Printf.sprintf "Press %d" id + | PointerDown (id, _) -> Printf.sprintf "PointerDown %d" id + | PointerUp (id, _) -> Printf.sprintf "PointerUp %d" id + | PressDetail (id, _) -> Printf.sprintf "PressDetail %d" id + | Appear id -> Printf.sprintf "Appear %d" id + | ToggleChanged (id, b) -> Printf.sprintf "ToggleChanged(%d,%b)" id b + | Change id -> Printf.sprintf "Change %d" id + | Dismiss id -> Printf.sprintf "Dismiss %d" id + | _ -> "event" + +let show_acts acts = + String.concat ", " + (List.map + (function + | Focus_changed id -> Printf.sprintf "Focus_changed %d" id + | Dispatch e -> "Dispatch " ^ show_event e + | Quit -> "Quit" + | Ime_rect _ -> "Ime_rect" + | Resize_host _ -> "Resize_host" + | Clipboard_write s -> Printf.sprintf "Clipboard_write %S" s + | Paste_request -> "Paste_request") + acts) + +(* The scripted frames are an interaction test, not just a render + determinism check: every event must produce the actions the + driver's apply_actions consumes, and the dispatches must land as + store mutations. The autofocused Name field is addressed by prop + and by its laid-out rect rather than by guessed coordinates. *) +let test_headless_actions () = + let _host, store, app, text_engine, refresh = host_with_app () in + let ui = Ui.create () in + let rects = Rects.create () in + ignore (Lui_app.start app); + ignore (Lui_app.flush app); + refresh (); + Layout.refresh store rects ~width:480 ~height:320 ~scale:1. + ~measure:(Lui_window_text.measure text_engine); + let field = + match + List.find_opt + (fun id -> + Lui_store.string_prop store id "accessibility-label" + = Some "Name") + (Lui_store.preorder store) + with + | Some id -> id + | None -> Alcotest.fail "name field not mounted" + in + let handle = Ui.handle ui store rects in + (* driver startup parity: the loop hands focus to the first + autofocus field before pumping events *) + Ui.set_focused ui store field; + Alcotest.(check int) "autofocus claimed" field (Ui.focused ui); + (* typing dispatches TextChanged for the focused field *) + let input_acts = handle (Input.Text_input "hello") in + (match press_actions input_acts with + | [ TextChanged (f, "hello") ] when f = field -> () + | _ -> + Alcotest.failf "typing did not dispatch TextChanged: %s" + (show_acts input_acts)); + Alcotest.(check string) "shadow" "hello" (Ui.shadow ui); + (* Enter submits *) + let submit_acts = + handle (Input.Key_down (Input.Return, Input.mods_none, false)) + in + (match press_actions submit_acts with + | [ Submit f ] when f = field -> () + | _ -> + Alcotest.failf "Return did not dispatch Submit: %s" + (show_acts submit_acts)); + (* the dispatches reach the model: the field's text prop carries + "hello" and the status line reports the submit *) + apply_to_app app input_acts; + apply_to_app app submit_acts; + ignore (Lui_app.flush app); + let has_text_node v = + List.exists + (fun id -> Lui_store.string_prop store id "text" = Some v) + (Lui_store.preorder store) + in + Alcotest.(check bool) "name stored" true + (Lui_store.string_prop store field "text" = Some "hello"); + Alcotest.(check bool) "submit reported" true + (has_text_node "name submitted"); + (* a click inside the field's laid-out rect keeps focus and lands + the caret inside the typed text *) + let fr = Rects.get rects field in + let cx = fr.Lui_scene.x +. 6. + and cy = fr.Lui_scene.y +. (fr.Lui_scene.h /. 2.) in + let down = + handle (Input.Button_down (cx, cy, Input.Left, 1, Input.mods_none)) + in + Alcotest.(check bool) "no blur" true + (not + (List.exists (function Focus_changed 0 -> true | _ -> false) + down)); + Alcotest.(check int) "focus kept" field (Ui.focused ui); + Alcotest.(check bool) "caret in text" true + (Ui.caret ui >= 0 && Ui.caret ui <= String.length "hello") (* ---------- Win32 window stubs + UIA bridge (real calls) ---------- *) @@ -557,6 +760,7 @@ let () = Alcotest.run "lui_window_windows" [ ( "ladder", [ Alcotest.test_case "renderer ladder" `Quick test_ladder; + Alcotest.test_case "demote path" `Quick test_ladder_demote; Alcotest.test_case "tray icon" `Quick test_tray_icon ] ); ( "a11y", [ Alcotest.test_case "action mapping" `Quick test_a11y_actions; @@ -571,7 +775,8 @@ let () = ( "headless", [ Alcotest.test_case "rast loop" `Quick test_rast_loop; Alcotest.test_case "repaint min" `Quick test_repaint_min; - Alcotest.test_case "checksum" `Quick test_headless_checksum ] ); + Alcotest.test_case "checksum" `Quick test_headless_checksum; + Alcotest.test_case "actions" `Quick test_headless_actions ] ); ( "shell", [ Alcotest.test_case "menu model" `Quick test_shell_model; Alcotest.test_case "guarded" `Quick test_shell_guarded ] ) ] From e4aa8fdb7e72fca812f5e8b5fdac3c85a6441882 Mon Sep 17 00:00:00 2001 From: Tienson_Qin Date: Tue, 13 Oct 2026 05:51:26 +0800 Subject: [PATCH 7/7] test(windows): assert scripted headless runs replay the same actions, focus and store --- .../test/lui_window_windows_test.ml | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/platform/native/lui_window_windows/test/lui_window_windows_test.ml b/platform/native/lui_window_windows/test/lui_window_windows_test.ml index bf59e6c8..2b467fb0 100644 --- a/platform/native/lui_window_windows/test/lui_window_windows_test.ml +++ b/platform/native/lui_window_windows/test/lui_window_windows_test.ml @@ -536,7 +536,20 @@ let test_headless_checksum () = let r2 = run_headless frames headless_script in Alcotest.(check bool) "scene painted" true (r1.ops > 0); Alcotest.(check int64) "deterministic" r1.checksum r2.checksum; - Alcotest.(check int) "same ops" r1.ops r2.ops + Alcotest.(check int) "same ops" r1.ops r2.ops; + (* the scripted input is replayed identically: one action list per + scripted event, the same focus and the same resulting store *) + Alcotest.(check (list int)) "same actions per event" + (List.map List.length r1.acted) (List.map List.length r2.acted); + Alcotest.(check int) "one action list per event" + (List.length headless_script) (List.length r1.acted); + Alcotest.(check int) "same focus" (Ui.focused r1.ui) (Ui.focused r2.ui); + let texts st = + List.map (fun id -> Lui_store.string_prop st id "text") + (Lui_store.preorder st) + in + Alcotest.(check (list (option string))) "same store text" + (texts r1.store) (texts r2.store) let show_event = function | TextChanged (id, s) -> Printf.sprintf "TextChanged(%d,%S)" id s