test: add issue #1175 sliding-window slot regression

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

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

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)

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;