diff --git a/docs/about/changelog.md b/docs/about/changelog.md index 7137a9542..3fb350138 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -4,6 +4,9 @@ Release history of PerlOnJava. See [Roadmap](roadmap.md) for future plans. ## Work in progress +- Clear weakened references after a nested method releases its final + array-slot owner, restoring `Algorithm::SlidingWindow` eviction and clear + behavior on both execution backends. - Release captured closure owners when their callback is discarded, preventing stale refcounts after a temporary global owner (such as an IO::Async loop notifier) is removed, and retire unreachable eval-capture ownership before diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/MortalList.java b/src/main/java/org/perlonjava/runtime/runtimetypes/MortalList.java index b35c42d43..3ae8af3a1 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/MortalList.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/MortalList.java @@ -1382,26 +1382,28 @@ && isReachableThroughTiedHashCached(base)) { } else if (base.blessId != 0 && hasWeakRefs && !blessedClassHasDestroy(base) - && ((RuntimeCode.argsStackDepth() > 1 - && !base.clearedOwnedAggregateElement) - || isReachableFromExternalRootCached(base) + && (isReachableFromExternalRootCached(base) || ReachabilityWalker.isReachableFromRoots(base))) { // A weakened probe copy can make the selective count reach // zero while an ordinary blessed object is still held by a // live lexical. Test::Refcount exercises this shape; clearing // weak refs here drops callback invocants that should remain - // valid. Once an owned callback aggregate has been explicitly - // replaced with an empty aggregate, however, nested call depth is - // no longer treated as ownership: assertions commonly run in - // subtest callbacks after the observed object has left scope. - // Real roots and explicit method-invocant holds still protect - // live objects. Classes with DESTROY keep the stricter path. - // Keep lifecycle objects at zero rather than inventing an - // unmatched owner. Ordinary objects retain the established - // protective count while nested calls still hold them. - if (!base.clearedOwnedAggregateElement) { - base.refCount = 1; - } + // valid. Real roots and explicit method-invocant holds still + // protect live objects. Classes with DESTROY keep the stricter + // path. + base.refCount = 1; + } else if (base.blessId != 0 + && hasWeakRefs + && !blessedClassHasDestroy(base) + && RuntimeCode.argsStackDepth() > 1 + && !base.clearedOwnedAggregateElement) { + // Nested calls can retain expression temporaries which are not + // selective refcount owners. Leave the count at zero and let + // the next outer statement boundary decide from Perl-visible + // reachability. Retaining a synthetic count here leaks weak + // observers after a method-local alias releases the final real + // owner (Algorithm::SlidingWindow). + requestTargetedWeakSweep(base); } else if (base.blessId != 0 && base.storedInPackageGlobal && hasWeakRefs diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java index 61ce4af50..abd1aa43f 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java @@ -2181,16 +2181,15 @@ && hasLiveIo(assignedGlob)) { && !blessedClassHasDestroy(oldBase) && RuntimeCode.argsStackDepth() > 1 && !oldBase.clearedOwnedAggregateElement) { - // Match MortalList's nested-call protection for ordinary - // blessed objects. Method arguments and expression - // temporaries are real strong references even though the - // selective counter cannot see every copy. Running the - // global reachability walker here made weak interning - // caches (Math::Algebra::Symbols is a representative case) - // quadratic: every temporary overwrite walked every global - // cache entry. Preserve the protective count and let the - // statement-boundary weak sweep make the final decision. - oldBase.refCount = 1; + // A nested method can still have JVM expression temporaries + // that are not represented in the selective count. Do not + // invent a replacement owner here: that count outlives the + // frame when a local alias has already been cleaned up (as + // in Algorithm::SlidingWindow's cleared buffer slot). + // Defer the reachability decision until the enclosing Perl + // statement boundary, where all method-local temporaries + // have gone away and the walker can see real Perl roots. + MortalList.requestTargetedWeakSweep(oldBase); } else if (oldBase.blessId != 0 && oldBase.storedInPackageGlobal && WeakRefRegistry.hasWeakRefsTo(oldBase) diff --git a/src/test/resources/unit/refcount/sliding_window_slot_release.t b/src/test/resources/unit/refcount/sliding_window_slot_release.t new file mode 100644 index 000000000..3e11dcb3e --- /dev/null +++ b/src/test/resources/unit/refcount/sliding_window_slot_release.t @@ -0,0 +1,151 @@ +use strict; +use warnings; +use Test::More; +use Scalar::Util qw(weaken); + +# Regression for issue #1175. Algorithm::SlidingWindow keeps a preallocated +# circular buffer in a blessed hash and clears occupied slots through a local +# array-reference alias. Those stores must release the slot's strong edge. + +{ + package SWR_Object; + sub new { bless { id => $_[1] }, $_[0] } + sub DESTROY { push @SWR_Object::destroyed, $_[0]->{id} } +} + +sub make_window { + my ($capacity) = @_; + my @buf; + $#buf = $capacity - 1; + my $self = bless { _buf => \@buf, _capacity => $capacity, + _head => 0, _size => 0 }, 'SWR_Window'; + return $self; +} + +sub SWR_Window::add { + my $self = $_[0]; + return $self if @_ == 1; + my $cap = $self->{_capacity}; + my $buf = $self->{_buf}; + my $head = $self->{_head}; + my $size = $self->{_size}; + for (my $ai = 1; $ai < @_; $ai++) { + my $item = $_[$ai]; + if ($size == $cap) { + my $old = $buf->[$head]; + $buf->[$head] = undef; + $head++; + $head = 0 if $head == $cap; + } else { + $size++; + } + my $tail = $head + $size - 1; + $tail -= $cap if $tail >= $cap; + $buf->[$tail] = $item; + } + $self->{_head} = $head; + $self->{_size} = $size; + return $self; +} + +sub SWR_Window::clear { + my ($self) = @_; + my $buf = $self->{_buf}; + for my $i (0 .. $self->{_capacity} - 1) { + $buf->[$i] = undef; + } + $self->{_size} = 0; +} + +{ + my $object = SWR_Object->new('direct'); + my $weak = $object; + my @buffer = ($object); + weaken($weak); + undef $object; + $buffer[0] = undef; + ok(!defined($weak), 'direct array slot overwrite releases the referent'); +} + +{ + my $window = make_window(3); + my $object = SWR_Object->new('sparse'); + my $weak = $object; + weaken($weak); + my $buf = $window->{_buf}; + $buf->[1] = $object; + undef $object; + $buf->[1] = undef; + ok(!defined($weak), 'preallocated sparse slot releases the referent'); +} + +{ + my $window = make_window(2); + my $object = SWR_Object->new('nested'); + my $weak = $object; + weaken($weak); + my $buf = $window->{_buf}; + $buf->[0] = $object; + undef $object; + $buf->[0] = undef; + ok(!defined($weak), 'blessed-hash array alias releases the referent'); +} + +{ + my $window = make_window(2); + my $first = SWR_Object->new('evicted'); + my $weak_first = $first; + weaken($weak_first); + my $second = SWR_Object->new('current'); + my $weak_second = $second; + weaken($weak_second); + $window->add($first, $second); + ok(defined($weak_first), 'first circular-buffer item is live'); + ok(defined($weak_second), 'second circular-buffer item is live'); + undef $first; + $window->add(SWR_Object->new('replacement')); + ok(!defined($weak_first), 'circular-buffer eviction clears old slot'); + undef $second; + $window->clear; + ok(!defined($weak_second), 'clear loop releases current slot'); +} + +{ + # Keep this block close to Algorithm::SlidingWindow::refs.t: multiple + # aliased arguments followed by a direct bless temporary. + my $w = make_window(2); + my $obj1 = bless({}, 'SWR_NoDestroy'); + my $weak1 = $obj1; + weaken($weak1); + my $obj2 = bless({}, 'SWR_NoDestroy'); + my $weak2 = $obj2; + weaken($weak2); + $w->add($obj1, $obj2); + undef $obj1; + $w->add(bless({}, 'SWR_NoDestroy')); + ok(!defined($weak1), 'CPAN-shaped eviction clears the first object'); + undef $obj2; + $w->clear; + ok(!defined($weak2), 'CPAN-shaped clear clears the second object'); +} + +{ + my $window = make_window(1); + my $object = SWR_Object->new('destroy'); + my $weak = $object; + weaken($weak); + $window->{_buf}->[0] = $object; + undef $object; + $window->clear; + ok(!defined($weak), 'DESTROY referent weak slot is cleared'); +} +is(scalar @SWR_Object::destroyed, 7, + 'each released referent is destroyed exactly once'); +my %destroyed; +$destroyed{$_}++ for @SWR_Object::destroyed; +is_deeply(\%destroyed, + { direct => 1, sparse => 1, nested => 1, evicted => 1, + current => 1, replacement => 1, destroy => 1 }, + 'all released referents have exactly one DESTROY'); + +done_testing;