Selkie.git | t/ | 112-parent-chain-cycle-guard.rakutest
use Test;
use lib 'lib';
use Notcurses::Native::Types;
use Selkie::App;
use Selkie::App::Internal::Dispatch;
use Selkie::Container;
use Selkie::Event;
use Selkie::Test::Keys;
use Selkie::Tree;
use Selkie::Widget;
use Selkie::Widget::Button;
# Cycle guard on parent-chain walks.
#
# A widget tree is a tree by convention only: `parent` is a writable
# attribute that layouts set when they adopt a child. One mis-ordered
# reparent makes a widget its own ancestor, and every `while
# $node.defined { $node = $node.parent }` loop then spins forever.
# Several of those run on the frame path — focus validation, dirty
# propagation, event bubbling — so the symptom is a frozen screen with
# every key dead and no crash to look at.
#
# Every such walk now hops through Selkie::Tree's `next-ancestor`,
# which dies loudly at PARENT-CHAIN-LIMIT. The cycles below are built
# by hand through `parent`: they are simulating the upstream bug, not
# a shape any Selkie container can produce on its own.
class TestContainer does Selkie::Container {
method render() { self!render-children; self.clear-dirty }
}
# Two widgets pointing at each other: the smallest possible cycle.
sub cycled-pair() {
my $a = Selkie::Widget::Button.new(label => 'A');
my $b = Selkie::Widget::Button.new(label => 'B');
$a.parent = $b;
$b.parent = $a;
($a, $b);
}
plan 8;
subtest "next-ancestor is an ordinary hop on a healthy chain" => {
plan 3;
my $root = TestContainer.new;
my $mid = TestContainer.new;
my $leaf = Selkie::Widget::Button.new(label => 'x');
$root.add($mid);
$mid.add($leaf);
is next-ancestor($leaf, 0).WHICH, $mid.WHICH, 'one hop reaches the parent';
is next-ancestor($mid, 1).WHICH, $root.WHICH, 'the next hop reaches the root';
nok next-ancestor($root, 2).defined,
'and the hop off the root is undefined, which is what ends a walk';
};
subtest "next-ancestor dies once a single walk exceeds the hop budget" => {
plan 4;
my ($a, $b) = cycled-pair();
lives-ok { next-ancestor($a, PARENT-CHAIN-LIMIT - 1) },
'the last hop inside the budget is allowed';
throws-like { next-ancestor($a, PARENT-CHAIN-LIMIT) },
X::Selkie::WidgetCycle,
'the hop past it throws X::Selkie::WidgetCycle';
my $err;
{ next-ancestor($a, PARENT-CHAIN-LIMIT); CATCH { default { $err = $_ } } }
like $err.message, /:i cycle/,
'the message says what went wrong';
like $err.message, /'Button#'/,
'and names the widgets in the loop, so the bug is findable';
};
subtest "the exception describes a bounded slice of the chain" => {
plan 3;
my ($a, $b) = cycled-pair();
my $err;
{ next-ancestor($a, PARENT-CHAIN-LIMIT); CATCH { default { $err = $_ } } }
is $err.hops, PARENT-CHAIN-LIMIT, 'the hop budget is reported';
ok $err.chain.contains('->'), 'the chain is rendered as a walk';
# Bounded: a cycle is infinite, the description is not.
ok $err.chain.chars < 600,
'and it is truncated rather than dumping an endless loop';
};
subtest "focus-eligible dies on a cycled chain instead of spinning" => {
plan 2;
my ($a, $b) = cycled-pair();
throws-like { Selkie::App.focus-eligible($a) },
X::Selkie::WidgetCycle,
'the focus-eligibility walk trips the guard';
my $healthy = Selkie::Widget::Button.new(label => 'ok');
ok Selkie::App.focus-eligible($healthy),
'a healthy widget is unaffected';
};
subtest "widget-attached dies on a cycled chain" => {
plan 2;
my ($a, $b) = cycled-pair();
my $unrelated = TestContainer.new;
throws-like { Selkie::App.widget-attached($a, $unrelated) },
X::Selkie::WidgetCycle,
'the attachment walk trips the guard rather than looping forever';
# A cycle that DOES contain the root still terminates early, because
# the walk stops the moment it recognises the root.
ok Selkie::App.widget-attached($a, $b),
'a walk that reaches its target before the budget still answers';
};
subtest "mark-screen-dirty dies on a cycled chain" => {
plan 2;
my ($a, $b) = cycled-pair();
throws-like { $a.mark-screen-dirty },
X::Selkie::WidgetCycle,
'the root-finding walk trips the guard';
my $root = TestContainer.new;
my $leaf = Selkie::Widget::Button.new(label => 'x');
$root.add($leaf);
lives-ok { $leaf.mark-screen-dirty },
'a healthy chain still reaches its root';
};
subtest "effective-bounds dies on a cycled chain" => {
plan 1;
my ($a, $b) = cycled-pair();
# The ancestor intersection stops early once the visible rectangle
# collapses, so both widgets need real extents for the walk to be
# the thing that ends it.
.resize(4, 12) for ($a, $b);
throws-like { $a.effective-bounds },
X::Selkie::WidgetCycle,
'the clip-to-ancestors walk trips the guard';
};
subtest "event bubbling dies on a cycled chain" => {
plan 2;
# Stand-in for the screen manager: an unhandled event falls through
# to the global-keybind table, which asks which screen is active.
my class StubScreens {
method active-screen(--> Str) { 'main' }
}
my class DispatchHarness does Selkie::App::Internal::Dispatch {
has $.root is rw;
has $.focused is rw;
has $.screen-manager = StubScreens.new;
method !active-modal() { Nil }
method focus($widget --> Nil) { $!focused = $widget }
method focus-eligible($w) { Selkie::App.focus-eligible($w) }
method widget-attached($widget, $root --> Bool) {
Selkie::App.widget-attached($widget, $root);
}
method close-modal(--> Nil) { }
method !check-terminal-resize(--> Nil) { }
method dispatch-event-for-test(Selkie::Event $ev --> Nil) {
self!dispatch-event($ev);
}
}
# A widget that consumes nothing, so the event keeps bubbling — up
# a chain that never ends.
my class PassThrough does Selkie::Widget {
method render() { self.clear-dirty }
method handle-event(Selkie::Event $ev --> Bool) { False }
}
my $a = PassThrough.new;
my $b = PassThrough.new;
$a.parent = $b;
$b.parent = $a;
my $h = DispatchHarness.new(root => TestContainer.new, focused => $a);
throws-like { $h.dispatch-event-for-test(key-event('a')) },
X::Selkie::WidgetCycle,
'a key event bubbling up a cycled chain trips the guard';
my $healthy = PassThrough.new;
$h.focused = $healthy;
lives-ok { $h.dispatch-event-for-test(key-event('a')) },
'and an ordinary chain still bubbles to the end';
};