Skip to content

design: DESTROY and weaken() implementation plan #463

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
fglock merged 7 commits into from
Apr 8, 2026
Merged

design: DESTROY and weaken() implementation plan #463

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
7 commits
Select commit Hold shift + click to select a range
bf992c3
design: DESTROY and weaken() implementation plan
fglock Apr 8, 2026
d15538c
design: update destroy_weaken_plan.md to v3.0
fglock Apr 8, 2026
a72039d
test: add DESTROY/weaken sandbox tests (196 tests, 8 files)
fglock Apr 8, 2026
49f0e2c
design: update destroy_weaken_plan.md to v4.0
fglock Apr 8, 2026
34ad3c2
design: update destroy_weaken_plan.md to v5.1
fglock Apr 8, 2026
17dbdf0
design: update destroy_weaken_plan.md to v5.2 with review corrections
fglock Apr 8, 2026
5518a22
design: v5.3 — simplify MortalList scope based on blocked-module survey
fglock Apr 8, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1,871 changes: 1,871 additions & 0 deletions dev/design/destroy_weaken_plan.md
View file
Open in desktop

Large diffs are not rendered by default.

198 changes: 198 additions & 0 deletions dev/sandbox/destroy_weaken/destroy_basic.t
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,198 @@
use strict;
use warnings;
use Test::More;

# =============================================================================
# destroy_basic.t — Core DESTROY semantics
#
# Tests the fundamental DESTROY contract: called once, at the right time,
# for the right triggers (scope exit, undef, overwrite, hash delete).
# =============================================================================

# --- DESTROY at scope exit ---
{
my @log;
{
package DB_ScopeExit;
sub new { bless {}, shift }
sub DESTROY { push @log, "destroyed" }
}
{
my $obj = DB_ScopeExit->new;
}
is_deeply(\@log, ["destroyed"], "DESTROY called when lexical goes out of scope");
}

# --- DESTROY on explicit undef ---
{
my @log;
{
package DB_Undef;
sub new { bless {}, shift }
sub DESTROY { push @log, "destroyed" }
}
my $obj = DB_Undef->new;
is_deeply(\@log, [], "DESTROY not called before undef");
undef $obj;
is_deeply(\@log, ["destroyed"], "DESTROY called on undef \$obj");
}

# --- DESTROY on scalar overwrite ---
{
my @log;
{
package DB_Overwrite;
sub new { bless {}, shift }
sub DESTROY { push @log, "destroyed" }
}
my $obj = DB_Overwrite->new;
$obj = 42;
is_deeply(\@log, ["destroyed"], "DESTROY called when scalar overwritten with non-ref");
}

# --- DESTROY on hash delete ---
{
my @log;
{
package DB_HashDelete;
sub new { bless {}, shift }
sub DESTROY { push @log, "destroyed" }
}
my %h;
$h{obj} = DB_HashDelete->new;
delete $h{obj};
is_deeply(\@log, ["destroyed"], "DESTROY called on hash delete");
}

# --- DESTROY on array element overwrite ---
{
my @log;
{
package DB_ArrayOverwrite;
sub new { bless {}, shift }
sub DESTROY { push @log, "destroyed" }
}
my @a;
$a[0] = DB_ArrayOverwrite->new;
$a[0] = undef;
is_deeply(\@log, ["destroyed"], "DESTROY called when array element set to undef");
}

# --- Multiple references delay DESTROY ---
{
my @log;
{
package DB_MultiRef;
sub new { bless {}, shift }
sub DESTROY { push @log, "destroyed" }
}
my $a = DB_MultiRef->new;
my $b = $a;
undef $a;
is_deeply(\@log, [], "DESTROY not called while second ref exists");
undef $b;
is_deeply(\@log, ["destroyed"], "DESTROY called when last ref gone");
}

# --- Three references ---
{
my @log;
{
package DB_ThreeRef;
sub new { bless {}, shift }
sub DESTROY { push @log, "destroyed" }
}
my $a = DB_ThreeRef->new;
my $b = $a;
my $c = $a;
undef $a;
is_deeply(\@log, [], "not destroyed after first undef (2 refs remain)");
undef $b;
is_deeply(\@log, [], "not destroyed after second undef (1 ref remains)");
undef $c;
is_deeply(\@log, ["destroyed"], "destroyed after last undef");
}

# --- DESTROY called exactly once (scope exit after undef) ---
{
my $count = 0;
{
package DB_Once;
sub new { bless {}, shift }
sub DESTROY { $count++ }
}
{
my $obj = DB_Once->new;
undef $obj;
}
is($count, 1, "DESTROY called exactly once (undef inside scope, then scope exit)");
}

# --- No DESTROY for class without DESTROY method ---
{
my $destroyed = 0;
{
package DB_NoDESTROY;
sub new { bless {}, shift }
}
{ my $obj = DB_NoDESTROY->new; }
is($destroyed, 0, "no DESTROY called for class without DESTROY method");
}

# --- DESTROY receives correct self reference ---
{
my $self_class;
{
package DB_SelfCheck;
sub new { bless { id => 42 }, shift }
sub DESTROY { $self_class = ref($_[0]) . ":" . $_[0]->{id} }
}
{ my $obj = DB_SelfCheck->new; }
is($self_class, "DB_SelfCheck:42", "DESTROY receives correct blessed self");
}

# --- DESTROY with blessed array ref ---
{
my @log;
{
package DB_ArrayRef;
sub new { bless [1, 2, 3], shift }
sub DESTROY { push @log, "array_destroyed" }
}
{ my $obj = DB_ArrayRef->new; }
is_deeply(\@log, ["array_destroyed"], "DESTROY works for blessed arrayrefs");
}

# --- DESTROY with blessed scalar ref ---
{
my @log;
{
package DB_ScalarRef;
sub new { my $x = "hello"; bless \$x, shift }
sub DESTROY { push @log, "scalar_destroyed" }
}
{ my $obj = DB_ScalarRef->new; }
is_deeply(\@log, ["scalar_destroyed"], "DESTROY works for blessed scalar refs");
}

# --- DESTROY ordering: multiple objects in same scope ---
# Note: Perl 5's destruction order for lexicals in the same scope is
# implementation-defined. We only test that both are destroyed.
{
my @log;
{
package DB_Order;
sub new { bless { name => $_[1] }, $_[0] }
sub DESTROY { push @log, $_[0]->{name} }
}
{
my $a = DB_Order->new("first");
my $b = DB_Order->new("second");
}
my %seen = map { $_ => 1 } @log;
ok($seen{first} && $seen{second},
"both objects destroyed at scope exit");
is(scalar @log, 2, "exactly two DESTROY calls");
}

done_testing();
180 changes: 180 additions & 0 deletions dev/sandbox/destroy_weaken/destroy_collections.t
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,180 @@
use strict;
use warnings;
use Test::More;

# =============================================================================
# destroy_collections.t — DESTROY for blessed refs inside collections
#
# Tests blessed objects stored in arrays, hashes, nested structures, and
# various collection operations (splice, shift, pop, clear, etc.).
# =============================================================================

# --- Blessed ref in array, destroyed on clear ---
{
my @log;
{
package DC_ArrClear;
sub new { bless { id => $_[1] }, $_[0] }
sub DESTROY { push @log, "d:" . $_[0]->{id} }
}
my @arr = (DC_ArrClear->new("a"), DC_ArrClear->new("b"), DC_ArrClear->new("c"));
is_deeply(\@log, [], "objects alive in array");
@arr = ();
my %seen = map { $_ => 1 } @log;
ok($seen{"d:a"} && $seen{"d:b"} && $seen{"d:c"},
"all objects destroyed on array clear");
}

# --- Blessed ref removed via pop ---
{
my @log;
{
package DC_Pop;
sub new { bless { id => $_[1] }, $_[0] }
sub DESTROY { push @log, "d:" . $_[0]->{id} }
}
my @arr;
push @arr, DC_Pop->new("p1"), DC_Pop->new("p2");
my $popped = pop @arr;
is_deeply(\@log, [], "popped object still alive (held by \$popped)");
undef $popped;
is_deeply(\@log, ["d:p2"], "destroyed after popped ref dropped");
}

# --- Blessed ref removed via shift ---
{
my @log;
{
package DC_Shift;
sub new { bless { id => $_[1] }, $_[0] }
sub DESTROY { push @log, "d:" . $_[0]->{id} }
}
my @arr;
push @arr, DC_Shift->new("s1"), DC_Shift->new("s2");
my $shifted = shift @arr;
is_deeply(\@log, [], "shifted object still alive");
undef $shifted;
is_deeply(\@log, ["d:s1"], "destroyed after shifted ref dropped");
}

# --- Blessed ref removed via splice ---
{
my @log;
{
package DC_Splice;
sub new { bless { id => $_[1] }, $_[0] }
sub DESTROY { push @log, "d:" . $_[0]->{id} }
}
my @arr = (DC_Splice->new("x"), DC_Splice->new("y"), DC_Splice->new("z"));
my @removed = splice(@arr, 1, 1); # remove "y"
is_deeply(\@log, [], "spliced object alive (in \@removed)");
@removed = ();
is_deeply(\@log, ["d:y"], "destroyed after splice result cleared");
}

# --- Hash clear destroys all values ---
{
my @log;
{
package DC_HashClear;
sub new { bless { id => $_[1] }, $_[0] }
sub DESTROY { push @log, "d:" . $_[0]->{id} }
}
my %h = (a => DC_HashClear->new("ha"), b => DC_HashClear->new("hb"));
%h = ();
my %seen = map { $_ => 1 } @log;
ok($seen{"d:ha"} && $seen{"d:hb"}, "all hash values destroyed on clear");
}

# --- Nested structure: hash of arrays of objects ---
{
my @log;
{
package DC_Nested;
sub new { bless { id => $_[1] }, $_[0] }
sub DESTROY { push @log, "d:" . $_[0]->{id} }
}
{
my %data;
$data{list} = [DC_Nested->new("n1"), DC_Nested->new("n2")];
is_deeply(\@log, [], "nested objects alive");
}
my %seen = map { $_ => 1 } @log;
ok($seen{"d:n1"} && $seen{"d:n2"},
"nested objects destroyed when outer hash goes out of scope");
}

# --- Object stored in two collections, only destroyed when both drop it ---
{
my @log;
{
package DC_SharedRef;
sub new { bless { id => $_[1] }, $_[0] }
sub DESTROY { push @log, "d:" . $_[0]->{id} }
}
my $obj = DC_SharedRef->new("shared");
my @arr = ($obj);
my %h = (key => $obj);
undef $obj;
is_deeply(\@log, [], "object alive (in array and hash)");
@arr = ();
is_deeply(\@log, [], "object alive (still in hash)");
%h = ();
is_deeply(\@log, ["d:shared"], "destroyed when last collection drops it");
}

# --- Blessed ref as hash value, overwritten ---
{
my @log;
{
package DC_HashOverwrite;
sub new { bless { id => $_[1] }, $_[0] }
sub DESTROY { push @log, "d:" . $_[0]->{id} }
}
my %h;
$h{key} = DC_HashOverwrite->new("old");
$h{key} = DC_HashOverwrite->new("new");
is_deeply(\@log, ["d:old"], "old hash value destroyed on overwrite");
delete $h{key};
is_deeply(\@log, ["d:old", "d:new"], "new value destroyed on delete");
}

# --- Array of objects going out of scope ---
{
my @log;
{
package DC_ArrScope;
sub new { bless { id => $_[1] }, $_[0] }
sub DESTROY { push @log, "d:" . $_[0]->{id} }
}
{
my @arr;
for my $i (1..3) {
push @arr, DC_ArrScope->new("item$i");
}
is_deeply(\@log, [], "objects alive inside scope");
}
is(scalar @log, 3, "all 3 objects destroyed at scope exit");
}

# --- Object inside closure ---
{
my @log;
{
package DC_Closure;
sub new { bless { id => $_[1] }, $_[0] }
sub DESTROY { push @log, "d:" . $_[0]->{id} }
}
my $code;
{
my $obj = DC_Closure->new("closure");
$code = sub { return $obj->{id} };
is($code->(), "closure", "closure can access object");
}
is_deeply(\@log, [], "object alive while closure exists");
is($code->(), "closure", "closure still works");
undef $code;
is_deeply(\@log, ["d:closure"], "destroyed when closure dropped");
}

done_testing();
Loading
Loading