diff --git a/dev/modules/moose_support.md b/dev/modules/moose_support.md index d2409d792..3759517b3 100644 --- a/dev/modules/moose_support.md +++ b/dev/modules/moose_support.md @@ -1991,6 +1991,96 @@ Tests fixed: - A handful of cmop/method introspection edge cases (constants, forward declarations, eval-defined subs). +## Phase D-W6.5: function-store + cmop-bootstrap reproducers (2026-04-29) + +Two more focused reproducers landed; both pass with the gate disabled +on master. + +### `function_hash_store.t` (18 tests) + +Five patterns of the **`sub setit { $METAS{$_[0]} = $_[1] }`** shape +that `Class::MOP::store_metaclass_by_name` uses: + +- A: direct `$_[N]` indexing in the setter sub. +- B: `shift` into my-vars before assignment. +- C: package-global hash + setter in same package (exact MOP shape). +- D: 20-iteration loop (mimics bootstrap fillup). +- E: setter returns the assignment value, with caller scope tracking. + +All 18 pass with the gate disabled. So the function-internal hash-store +path is not the drift source either. + +### `cmop_bootstrap.t` (14 tests) + +The **exact** Class::MOP shape: +`%Registry::METAS = ();` global + `Attr` class with weakened back-ref + +`MetaClass` with DESTROY. Builds a metaclass, attaches an attribute +that weak-refs back, drops the my-var, verifies %METAS keeps the +metaclass alive, then clears %METAS and verifies DESTROY fires once. + +- A: single metaclass + single attribute. +- B: 20-iteration bootstrap-fillup variant. +- C: same shape with `MetaClass` having an explicit `DESTROY`. + +All 14 pass with the gate disabled. + +### What this rules out (cumulative across D-W6.1 through D-W6.5) + +PerlOnJava's cooperative refcount handles ALL of the following +correctly, with the walker gate fully disabled: + +| Shape | Tests | All pass without gate | +|---|---|---| +| Sub installation (5 patterns) | `sub_install.t` | ✅ | +| Closure capture, up to 5-layer wrap | `closure_capture.t` | ✅ | +| Hash-slot tracking | `hash_slot.t` | ✅ | +| Weakened-hash + outer keepalive | `weak_metaclass.t` | ✅ | +| Function-internal hash store (incl. MOP shape) | `function_hash_store.t` | ✅ | +| **cmop_bootstrap** — weak attr back-ref + %METAS + DESTROY | `cmop_bootstrap.t` | ✅ | + +So the actual `Class::MOP` bootstrap drift requires something MORE +specific than any of these clean shapes. Likely candidates left: + +1. **Multi-level metaclass relationships** — + Class::MOP::Class extends Class::MOP::Module extends Class::MOP::Package + extends Class::MOP::Object extends Class::MOP::Mixin + extends Class::MOP::Mixin::HasMethods + extends Class::MOP::Mixin::HasAttributes + extends Class::MOP::Mixin::HasOverloads. + The metaclass has 7+ ancestors, each potentially with their own + attributes that weak-ref back to it. + +2. **Attribute->attach_to_class** is called many times from + different scopes — each `attach_to_class` does + `weaken($self->{associated_class} = $class)`. The combination of + "make slot strong, then weaken" might not properly preserve the + outer scope's strong holders. + +3. **Method modifiers** (`add_around_method_modifier` etc.) + wrap CV references in ways that may interact poorly with + refcount drift. + +4. **`use parent` / `@ISA` setup** — Class.pm uses + `use parent 'Class::MOP::Module', 'Class::MOP::Mixin::HasAttributes', + 'Class::MOP::Mixin::HasMethods', 'Class::MOP::Mixin::HasOverloads';` + The `parent` pragma at compile time might create transient + references that need careful refcount tracking. + +### Suggestion for next session + +Stop trying to write reproducers from scratch. Instead, **bisect the +real Class::MOP source**: take the working `cmop_bootstrap.t` and +gradually add features from `Class::MOP::Class.pm` until something +breaks. Specifically: + +1. Add `use parent` and a 7-deep ISA chain. +2. Add multiple attributes per class. +3. Add method modifiers. +4. Add `use Class::MOP::MiniTrait::apply` semantics on the bootstrap. + +The first one of these that flips the test from green to red with +the gate disabled is the smoking gun. + ## Related Documents - [xs_fallback.md](xs_fallback.md) — XS fallback mechanism diff --git a/src/test/resources/unit/refcount/drift/cmop_bootstrap.t b/src/test/resources/unit/refcount/drift/cmop_bootstrap.t new file mode 100644 index 000000000..9934ab8d6 --- /dev/null +++ b/src/test/resources/unit/refcount/drift/cmop_bootstrap.t @@ -0,0 +1,112 @@ +# D-W6.4 — Mimic the exact MOP pattern: weak attribute back-ref + global hash. +# +# The Class::MOP failure shape: +# - $METAS{$pkg} = $meta; # strong ref in package-global hash +# - $attr->attach_to_class($meta); # makes $attr->{associated_class} = $meta + weaken +# - The metaclass MUST stay alive while %METAS holds it strongly. +# +# Earlier hash_slot.t and function_hash_store.t both pass without the gate. +# This file specifically tests the COMBINATION that breaks during real +# Class::MOP bootstrap: weak ref to a hash-stored object, with the strong +# holder being a function-internal store. +use strict; +use warnings; +use Test::More; +use Scalar::Util qw(weaken); + +my $destroyed = 0; +package Probe; +sub new { bless { id => ++$Probe::N }, shift } +sub DESTROY { $destroyed++ } + +package Attr; +sub new { my ($c, $meta) = @_; my $s = bless { meta => $meta }, $c; + Scalar::Util::weaken($s->{meta}); $s } +sub meta { $_[0]->{meta} } + +package Registry; +our %METAS; +sub store { $METAS{$_[0]} = $_[1] } +sub get { $METAS{$_[0]} } + +package main; + +# ---- Pattern A: build a metaclass + an attribute with weak back-ref ----- +{ + %Registry::METAS = (); + $destroyed = 0; + + my $attr; + { + my $meta = Probe->new; + Registry::store('Foo', $meta); + $attr = Attr->new($meta); + # $meta scope ends. Strong holders: %Registry::METAS{Foo} (strong) + # $attr->{meta} (WEAK) + } + is $destroyed, 0, + 'A: meta survives while %METAS holds it (weak attr back-ref)'; + ok defined Registry::get('Foo'), + 'A: %METAS{Foo} still defined'; + ok defined $attr->meta, + 'A: $attr->meta still defined (weak ref points at live obj)'; + is $attr->meta->{id}, 1, 'A: weak ref returns valid Probe'; + + %Registry::METAS = (); + is $destroyed, 1, 'A: destroyed after %METAS cleared'; + ok !defined $attr->meta, 'A: weak ref now undef'; +} + +# ---- Pattern B: many such metaclasses (Class::MOP bootstrap shape) ------ +{ + %Registry::METAS = (); + $destroyed = 0; + + my @attrs; + for my $i (1 .. 20) { + my $meta = Probe->new; + Registry::store("Pkg$i", $meta); + push @attrs, Attr->new($meta); + } + + # All my-vars exited. %METAS is the only strong holder for each. + is $destroyed, 0, 'B: 20 metaclasses survive bootstrap pattern'; + my $alive = scalar grep { defined Registry::get("Pkg$_") } 1 .. 20; + is $alive, 20, 'B: all 20 still in %METAS'; + my $attr_alive = scalar grep { defined $_->meta } @attrs; + is $attr_alive, 20, 'B: all 20 weak attr back-refs still resolve'; + + %Registry::METAS = (); + is $destroyed, 20, 'B: all 20 destroyed when %METAS cleared'; +} + +# ---- Pattern C: plus a DESTROY method (Class::MOP::Class shape) --------- +# Reproduces the EXACT failure shape: a class that has DESTROY, weak +# attr back-ref, package-global hash store. This is what Class::MOP does. +our $C_destroyed = 0; +package MetaClass; +sub new { bless { name => $_[1] }, $_[0] } +sub DESTROY { $main::C_destroyed++ } + +package main; +{ + %Registry::METAS = (); + $C_destroyed = 0; + + my $attr; + { + my $meta = MetaClass->new('TestPkg'); + Registry::store('TestPkg', $meta); + $attr = Attr->new($meta); + } + is $C_destroyed, 0, + 'C: MetaClass-with-DESTROY survives via %METAS strong hold'; + ok defined $attr->meta, + 'C: weak attr back-ref resolves through %METAS'; + is $attr->meta->{name}, 'TestPkg', 'C: weak ref returns valid metaclass'; + + %Registry::METAS = (); + is $C_destroyed, 1, 'C: DESTROY fires once when %METAS cleared'; +} + +done_testing; diff --git a/src/test/resources/unit/refcount/drift/function_hash_store.t b/src/test/resources/unit/refcount/drift/function_hash_store.t new file mode 100644 index 000000000..3fb90fbb1 --- /dev/null +++ b/src/test/resources/unit/refcount/drift/function_hash_store.t @@ -0,0 +1,135 @@ +# D-W6.4 — Function-internal hash store reproducer. +# +# `Class::MOP::store_metaclass_by_name($pkg, $meta)` does +# `$METAS{$pkg} = $meta` from inside a sub. The argument `$meta` is +# accessed as `$_[1]` (or after a `my $self = shift; my $meta = shift`). +# We hypothesised this path may skip a refCount increment that the +# bare-script `$h{key} = $obj` path exercises correctly. +# +# Patterns covered: +# A. Direct `sub setit { $H{$_[0]} = $_[1] }` form (Class::MOP shape). +# B. With `my $key = shift; my $val = shift;` form. +# C. Package-global hash, sub in same package. +# D. Many calls in a loop (mimics %METAS being filled during bootstrap). +use strict; +use warnings; +use Test::More; + +my $destroyed = 0; +package Probe; +sub new { bless { id => ++$Probe::N }, shift } +sub DESTROY { $destroyed++ } + +package main; + +# ---- Pattern A: direct $_[N] indexing in setter sub ---------------------- +{ + $destroyed = 0; + my %H; + sub setit_A { $H{$_[0]} = $_[1] } + + { + my $obj = Probe->new; + setit_A('Foo', $obj); + # $obj scope ends here. %H still holds it. + } + is $destroyed, 0, 'A: setter using $_[N] keeps Probe alive'; + ok defined $H{Foo}, 'A: hash slot defined'; + ok defined $H{Foo}{id}, 'A: slot has data'; + %H = (); + is $destroyed, 1, 'A: destroyed after %H cleared'; +} + +# ---- Pattern B: shift into my-vars in setter sub ------------------------- +{ + $destroyed = 0; + my %H; + sub setit_B { + my $key = shift; + my $val = shift; + $H{$key} = $val; + } + + { + my $obj = Probe->new; + setit_B('Bar', $obj); + } + is $destroyed, 0, 'B: setter using shift keeps Probe alive'; + ok defined $H{Bar}, 'B: hash slot defined'; + %H = (); + is $destroyed, 1, 'B: destroyed after %H cleared'; +} + +# ---- Pattern C: package-global hash, setter in same package ------------- +# This is the EXACT shape Class::MOP uses (`our %METAS` + `sub store_*`). +{ + package Registry; + our %METAS; + sub store_meta { $METAS{$_[0]} = $_[1] } + sub get_meta { $METAS{$_[0]} } + + package main; + %Registry::METAS = (); + $destroyed = 0; + + { + my $obj = Probe->new; + Registry::store_meta('Pkg', $obj); + } + is $destroyed, 0, + 'C: package-global hash via setter sub keeps Probe alive'; + ok defined Registry::get_meta('Pkg'), 'C: slot still resolvable'; + %Registry::METAS = (); + is $destroyed, 1, 'C: destroyed after clear'; +} + +# ---- Pattern D: many calls in a loop (mimics bootstrap) ------------------ +{ + package Reg2; + our %METAS; + sub store_meta { $METAS{$_[0]} = $_[1] } + + package main; + %Reg2::METAS = (); + $destroyed = 0; + + for my $i (1 .. 20) { + my $obj = Probe->new; + Reg2::store_meta("Pkg$i", $obj); + } + is $destroyed, 0, 'D: 20 setter calls keep all 20 Probes alive'; + my $alive = scalar grep { defined $Reg2::METAS{$_} } + map { "Pkg$_" } 1 .. 20; + is $alive, 20, 'D: all 20 slots resolve'; + %Reg2::METAS = (); + is $destroyed, 20, 'D: all 20 destroyed after clear'; +} + +# ---- Pattern E: setter that returns the value (Class::MOP shape) -------- +# `sub store_metaclass_by_name { $METAS{$_[0]} = $_[1] }` — note the +# implicit return of the assignment value. +{ + package Reg3; + our %METAS; + sub store { $METAS{$_[0]} = $_[1] } + + package main; + %Reg3::METAS = (); + $destroyed = 0; + + { + my $obj = Probe->new; + my $stored = Reg3::store('X', $obj); + # $stored is now another strong holder. + $obj = undef; + is $destroyed, 0, 'E: $stored holds the Probe alive'; + $stored = undef; + is $destroyed, 0, 'E: %Reg3::METAS still holds the Probe'; + } + ok defined $Reg3::METAS{X}, 'E: slot still resolvable after locals dropped'; + is $destroyed, 0, 'E: hash global keeps it alive'; + %Reg3::METAS = (); + is $destroyed, 1, 'E: destroyed only after hash cleared'; +} + +done_testing;