From 5f96d33c9e02b6ac2036dc1fe665362b8b4a4326 Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Fri, 8 May 2026 20:22:50 +0200 Subject: [PATCH] fix: support Class::Tiny jcpan tests Teach the built-in subs pragma to expose its version and mark predeclared CODE slots as declared, matching the behavior Class::Tiny relies on for custom accessors. Keep map-produced blessed objects alive until the caller captures the returned list so BUILD/DEMOLISH accounting survives list assignment. Generated with [Codex](https://openai.com/codex) Co-Authored-By: Codex --- .../runtime/operators/ListOperators.java | 4 ++ .../perlonjava/runtime/perlmodule/Subs.java | 6 ++- src/main/perl/lib/subs.pm | 37 +++++++++++++++++++ .../unit/refcount/map_return_destroy.t | 25 +++++++++++++ src/test/resources/unit/subs_pragma.t | 31 ++++++++++++++++ 5 files changed, 102 insertions(+), 1 deletion(-) create mode 100644 src/main/perl/lib/subs.pm create mode 100644 src/test/resources/unit/refcount/map_return_destroy.t create mode 100644 src/test/resources/unit/subs_pragma.t diff --git a/src/main/java/org/perlonjava/runtime/operators/ListOperators.java b/src/main/java/org/perlonjava/runtime/operators/ListOperators.java index fd42c6d21..4d6dfb304 100644 --- a/src/main/java/org/perlonjava/runtime/operators/ListOperators.java +++ b/src/main/java/org/perlonjava/runtime/operators/ListOperators.java @@ -45,6 +45,9 @@ public static RuntimeList map(RuntimeList runtimeList, RuntimeScalar perlMapClos List transformedElements = new ArrayList<>(); RuntimeScalar saveValue = getGlobalVariable("main::_"); + // Map results are captured by the caller after the operator returns; + // flushing between iterations can destroy blessed return values early. + boolean wasFlushing = MortalList.suppressFlush(true); try { // Use the outer @_ instead of an empty array @@ -87,6 +90,7 @@ public static RuntimeList map(RuntimeList runtimeList, RuntimeScalar perlMapClos return transformedList; } } finally { + MortalList.suppressFlush(wasFlushing); GlobalVariable.aliasGlobalVariable("main::_", saveValue); releaseEphemeralCaptures(perlMapClosure); } diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/Subs.java b/src/main/java/org/perlonjava/runtime/perlmodule/Subs.java index c676ff5d2..73e248a96 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/Subs.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/Subs.java @@ -19,6 +19,7 @@ public Subs() { public static void initialize() { Subs subs = new Subs(); try { + GlobalVariable.getGlobalVariable("subs::VERSION").set(new RuntimeScalar("1.04")); subs.registerMethod("import", "importSubs", ";$"); subs.registerMethod("mark_overridable", "markOverridable", "$$"); } catch (NoSuchMethodException e) { @@ -45,7 +46,10 @@ public static RuntimeList importSubs(RuntimeArray args, int ctx) { for (RuntimeScalar variableObj : args.elements) { String variableString = variableObj.toString(); String fullName = caller + "::" + variableString; - GlobalVariable.getGlobalCodeRef(fullName); + RuntimeScalar codeRef = GlobalVariable.getGlobalCodeRef(fullName); + if (codeRef.value instanceof RuntimeCode code) { + code.isDeclared = true; + } GlobalVariable.isSubs.put(fullName, true); } diff --git a/src/main/perl/lib/subs.pm b/src/main/perl/lib/subs.pm new file mode 100644 index 000000000..0b2cc8a4d --- /dev/null +++ b/src/main/perl/lib/subs.pm @@ -0,0 +1,37 @@ +package subs; + +use strict; +use warnings; + +our $VERSION = '1.04'; + +sub import { + my $callpack = caller; + shift; + + for my $sym (@_) { + no strict 'refs'; + *{"${callpack}::$sym"} = \&{"${callpack}::$sym"}; + } +} + +1; + +__END__ + +=head1 NAME + +subs - Perl pragma to predeclare subroutine names + +=head1 SYNOPSIS + + use subs qw(foo bar); + +=head1 DESCRIPTION + +Predeclares package subroutine names by creating CODE slots in the caller's +stash. This matches the core pragma behavior used by modules that want to +install generated methods only when a custom method has not already been +declared. + +=cut diff --git a/src/test/resources/unit/refcount/map_return_destroy.t b/src/test/resources/unit/refcount/map_return_destroy.t new file mode 100644 index 000000000..f8c0b6acf --- /dev/null +++ b/src/test/resources/unit/refcount/map_return_destroy.t @@ -0,0 +1,25 @@ +use strict; +use warnings; +use Test::More; + +{ + package MapReturnDestroy; + our $counter = 0; + sub new { + my $class = shift; + my $self = bless {}, $class; + $counter++; + return $self; + } + sub DESTROY { + $counter-- if $counter > 0; + } +} + +my @objs = map { MapReturnDestroy->new } 1 .. 3; +is($MapReturnDestroy::counter, 3, "map-returned objects survive until caller captures list"); + +@objs = (); +is($MapReturnDestroy::counter, 0, "map-returned objects are destroyed when array is cleared"); + +done_testing; diff --git a/src/test/resources/unit/subs_pragma.t b/src/test/resources/unit/subs_pragma.t new file mode 100644 index 000000000..316e9b9af --- /dev/null +++ b/src/test/resources/unit/subs_pragma.t @@ -0,0 +1,31 @@ +use strict; +use warnings; +use Test::More; + +our @warnings; +BEGIN { $SIG{__WARN__} = sub { push @main::warnings, @_ } } + +{ + package SubsPragmaCustom; + use strict; + use warnings; + + use subs qw(foo); + + BEGIN { + no strict 'refs'; + *{"SubsPragmaCustom::foo"} = sub { "generated" } + unless *{"SubsPragmaCustom::foo"}{CODE}; + } + + sub foo { "custom" } +} + +is(SubsPragmaCustom::foo(), "custom", "predeclared sub can be custom-defined later"); +{ + no strict 'refs'; + ok(*{"SubsPragmaCustom::foo"}{CODE}, "predeclared sub has a visible CODE slot"); +} +is_deeply(\@warnings, [], "predeclared custom sub does not warn as redefined"); + +done_testing;