From 7eeaf8c86c941481d97e02b3dd4729a31f10ae10 Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Mon, 7 Sep 2026 16:14:58 +0200 Subject: [PATCH] fix: preserve readonly coercion caller aggregates Do not run lexical aggregate cleanup for arrays and hashes borrowed through an active argument frame. This keeps SvREFCNT accurate for Const::Fast so Types::Const clones before freezing its coercion result. Generated with [Codex](https://openai.com/codex/) Co-Authored-By: Codex --- docs/about/changelog.md | 4 ++ .../runtime/runtimetypes/MortalList.java | 13 +++++- .../runtime/runtimetypes/RuntimeCode.java | 7 +++- .../readonly_coercion_argument_lifetime.t | 42 +++++++++++++++++++ 4 files changed, 62 insertions(+), 4 deletions(-) create mode 100644 src/test/resources/unit/readonly_coercion_argument_lifetime.t diff --git a/docs/about/changelog.md b/docs/about/changelog.md index 8247f5149..56baf990e 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -6,6 +6,10 @@ priorities and future plans. ## Work in progress +- Preserve caller-owned array and hash lifetimes across generated coercion + callbacks, so `Types::Const` freezes cloned values without modifying the + original reference. + - Keep deferred interpreter-fallback return values alive while a replacement scalar reference releases a guard, restoring Object::Event callback-guard assignment semantics. diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/MortalList.java b/src/main/java/org/perlonjava/runtime/runtimetypes/MortalList.java index e5138450f..6e24e8e4c 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/MortalList.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/MortalList.java @@ -483,13 +483,19 @@ public static void evalExceptionScopeCleanup(Object local) { */ public static void scopeExitCleanupHash(RuntimeHash hash) { if (!isActive() || hash == null) return; + // An aggregate borrowed through @_ belongs to its caller. Its + // current frame can end while the caller's lexical is still live; + // leave its lexical-owner marker for the caller's own scope cleanup. + // Clearing it here + // makes Internals::SvREFCNT under-report the caller's reference and + // lets Const::Fast freeze the original instead of its clone. + if (RuntimeCode.deferCleanupForActiveArgumentAggregate(hash)) return; // Clear localBindingExists: the named variable's scope is ending. // This allows subsequent refCount==0 events (from setLargeRefCounted // or flush) to correctly trigger callDestroy, since the local // variable no longer holds a strong reference. boolean hadLocalBinding = hash.localBindingExists; hash.localBindingExists = false; - if (RuntimeCode.deferCleanupForActiveArgumentAggregate(hash)) return; if (hash.captureCount > 0) { hash.scopeExited = true; return; @@ -569,12 +575,15 @@ public static void scopeExitCleanupArray(RuntimeArray arr) { /** Scope-exit cleanup with a returned aggregate whose IO aliases must survive. */ public static void scopeExitCleanupArray(RuntimeArray arr, RuntimeBase returned) { if (!isActive() || arr == null) return; + // See scopeExitCleanupHash: an active @_ alias does not end the + // caller's lexical lifetime. In particular, Const::Fast uses + // SvREFCNT to decide whether it must clone a referenced aggregate. + if (RuntimeCode.deferCleanupForActiveArgumentAggregate(arr)) return; // Clear localBindingExists: the named variable's scope is ending. // This allows subsequent refCount==0 events (from setLargeRefCounted // or flush) to correctly trigger callDestroy, since the local // variable no longer holds a strong reference. arr.localBindingExists = false; - if (RuntimeCode.deferCleanupForActiveArgumentAggregate(arr)) return; if (arr.captureCount > 0) { arr.scopeExited = true; return; diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java index 2c76884cc..235e40e53 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java @@ -648,8 +648,11 @@ static boolean deferCleanupForActiveArgumentAggregate(RuntimeBase aggregate) { || !isActiveArgumentReferent(aggregate)) { return false; } - PerlRuntime.current().executionState() - .deferredArgumentAggregateCleanup.put(aggregate, Boolean.TRUE); + // This is a borrowed caller aggregate, not a lexical owned by the + // frame currently unwinding. Calling its scope-exit cleanup after + // the argument frame pops would incorrectly clear the caller's + // localBindingExists marker. The caller will perform its own cleanup + // when its lexical scope actually exits. return true; } diff --git a/src/test/resources/unit/readonly_coercion_argument_lifetime.t b/src/test/resources/unit/readonly_coercion_argument_lifetime.t new file mode 100644 index 000000000..f7668c55d --- /dev/null +++ b/src/test/resources/unit/readonly_coercion_argument_lifetime.t @@ -0,0 +1,42 @@ +use strict; +use warnings; +use Test::More; +use Storable qw(dclone); + +# This is the ownership decision made by Const::Fast before it freezes a +# coercion result: clone a shared aggregate. Keep it behind an eval-created +# callback, matching the generated Type::Tiny coercion path which used to +# clean up the caller's aggregate as though it belonged to the callback. +sub freeze_for_coercion { + my ($value) = @_; + $value = dclone($value) if &Internals::SvREFCNT($value) > 1; + return $value; +} + +my $coerce = eval q{ + sub { + my $value = @_ ? $_[0] : $_; + return freeze_for_coercion($value); + } +}; +die $@ if $@; + +my @values = (1, 2); +my $readonly_array = $coerce->(\@values); +ok !&Internals::SvREADONLY(\@values), + 'generated coercion leaves the caller array writable'; +isnt $readonly_array, \@values, + 'generated coercion clones its array result'; +ok eval { $values[0]++; 1 }, 'caller array remains mutable'; +is $readonly_array->[0], 1, 'cloned array is independent of caller mutation'; + +my %values = (answer => 42); +my $readonly_hash = $coerce->(\%values); +ok !&Internals::SvREADONLY(\%values), + 'generated coercion leaves the caller hash writable'; +isnt $readonly_hash, \%values, + 'generated coercion clones its hash result'; +ok eval { $values{answer}++; 1 }, 'caller hash remains mutable'; +is $readonly_hash->{answer}, 42, 'cloned hash is independent of caller mutation'; + +done_testing;