From c2f8b2e9a68f68caa3d13c869423c580ef1972df Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Fri, 30 Oct 2026 15:54:22 +0100 Subject: [PATCH] fix: support experimental warnings and Sub::Import detection Accept experimental::for_list as a no-op category and align bundled Perl 5.44 warning masks, including experimental::builtin. Preserve the source stash in B::CV START so Sub::Import can recognize Sub::Exporter importers. Add focused tests for warning mask behavior and renamed Sub::Exporter imports. Fixes #1208 Fixes #1219 Fixes #1206 Generated with [Codex](https://openai.com/codex) Co-Authored-By: Codex <158243242+openai-codex[bot]@users.noreply.github.com> --- dev/design/issue-queue.md | 3 +- docs/about/changelog.md | 2 + .../runtime/runtimetypes/WarningFlags.java | 2 +- src/main/perl/lib/B.pm | 16 ++++- src/main/perl/lib/warnings.pm | 71 ++++++++++--------- .../unit/sub_import_sub_exporter_detection.t | 23 ++++++ .../unit/warnings_experimental_categories.t | 45 ++++++++++++ 7 files changed, 125 insertions(+), 37 deletions(-) create mode 100644 src/test/resources/unit/sub_import_sub_exporter_detection.t create mode 100644 src/test/resources/unit/warnings_experimental_categories.t diff --git a/dev/design/issue-queue.md b/dev/design/issue-queue.md index 285db18555..c369844b3c 100644 --- a/dev/design/issue-queue.md +++ b/dev/design/issue-queue.md @@ -37,7 +37,8 @@ resolved before implementation. No new pass or failure is asserted here. | Calls and value operations | [#1448](https://github.com/fglock/PerlOnJava/issues/1448) Audit-wrapper recursion | High / Investigate | Runaway recursion on both backends with a passing Perl suite. Trace captured original coderef identity and wrapper replacement under a timeout; no proven #1649 dependency. | | Calls and value operations | [#1342](https://github.com/fglock/PerlOnJava/issues/1342) Relational overload dispatch | Normal / Ready | Report identifies an unwanted `cmp` dispatch. Add direct relational-overload coverage and require Morpheus acceptance on both backends. | | Calls and value operations | [#1428](https://github.com/fglock/PerlOnJava/issues/1428) Decimal stringification | Normal / Ready | One DateTime::Format::Epoch mismatch with passing Perl suite. Reduce the numeric conversion and cover large integral results without scientific notation. | -| Warnings category tables | [#1208](https://github.com/fglock/PerlOnJava/issues/1208), [#1219](https://github.com/fglock/PerlOnJava/issues/1219) Experimental categories | Normal / Ready | Unknown valid categories prevent module load. Check shared registration code, add category-specific focused tests and upstream load acceptance; batch only if one registration mechanism owns both. | +| Warning category tables | [#1208](https://github.com/fglock/PerlOnJava/issues/1208), [#1219](https://github.com/fglock/PerlOnJava/issues/1219) Experimental categories | Normal / Active | Bundled Perl 5.44 warning-category and bit-mask compatibility; focused coverage and both-backend acceptance are in progress. [Current claim](https://github.com/fglock/PerlOnJava/issues/1208#issuecomment-6524996715). | +| B subroutine introspection | [#1206](https://github.com/fglock/PerlOnJava/issues/1206) Sub::Import detection | Normal / Active | Reproduced the upstream `Sub::Import` 1.002 `t/import-se.t` failure; preserve the start-op stash used to identify Sub::Exporter importers. [Current claim](https://github.com/fglock/PerlOnJava/issues/1206#issuecomment-6524997331). | | Regex matcher performance | [#1174](https://github.com/fglock/PerlOnJava/issues/1174) Anchored full match | High / Investigate | Reported 475–550x gap has a bounded workload. Reproduce/profile exact source and JAR, then define semantics-preserving engine coverage. No ownership rewrite prerequisite is established. | | Call-path measurement | [#1885](https://github.com/fglock/PerlOnJava/issues/1885) Memory and ordinary calls | Normal / Investigate | Follow up #1870 with matched allocation/live-heap/RSS and general-call evidence. Coordinate any frame/argument ownership edits with #1649; measurements alone can proceed. | | Call-path measurement | [#1863](https://github.com/fglock/PerlOnJava/issues/1863) Throughput acceptance | Normal / Verify | Portfolio targets are reported met by #1870. Reconcile merged-source evidence and remaining criteria with #1885 before scheduling more optimizations. | diff --git a/docs/about/changelog.md b/docs/about/changelog.md index 82c18de71a..cabaec64ed 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -6,6 +6,8 @@ priorities and future plans. ## Work in progress +- Accept `experimental::for_list` as Perl 5.44's no-op warning category, align bundled warning masks including `experimental::builtin`, and expose B start-op package identity for Sub::Import compatibility (#1208, #1219, #1206). + - Preserve the input line number when a borrowed anonymous filehandle alias leaves a JVM subroutine scope (#1933). - Resolve glob-backed filehandles in `POSIX::isatty` without assuming the glob value is a `RuntimeIO` (#1932). diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/WarningFlags.java b/src/main/java/org/perlonjava/runtime/runtimetypes/WarningFlags.java index aa8712866a..6237e1318a 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/WarningFlags.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/WarningFlags.java @@ -30,7 +30,7 @@ private static CompilationRuntimeState state() { // Initialize the hierarchy of warning categories warningHierarchy.put("all", new String[]{"closure", "deprecated", "exiting", "experimental", "glob", "imprecision", "io", "locale", "misc", "missing", "missing_import", "numeric", "once", "overflow", "pack", "portable", "recursion", "redefine", "redundant", "regexp", "scalar", "severe", "shadow", "signal", "substr", "syntax", "taint", "threads", "uninitialized", "unpack", "untie", "utf8", "void", "__future_81", "__future_82", "__future_83"}); warningHierarchy.put("deprecated", new String[]{"deprecated::apostrophe_as_package_separator", "deprecated::delimiter_will_be_paired", "deprecated::dot_in_inc", "deprecated::goto_construct", "deprecated::missing_import_called_with_args", "deprecated::smartmatch", "deprecated::subsequent_use_version", "deprecated::unicode_property_name", "deprecated::version_downgrade"}); - warningHierarchy.put("experimental", new String[]{"experimental::alpha_assertions", "experimental::args_array_with_signatures", "experimental::bitwise", "experimental::builtin", "experimental::class", "experimental::declared_refs", "experimental::defer", "experimental::enhanced_xx", "experimental::extra_paired_delimiters", "experimental::isa", "experimental::postderef", "experimental::private_use", "experimental::re_strict", "experimental::refaliasing", "experimental::regex_sets", "experimental::script_run", "experimental::signatures", "experimental::smartmatch", "experimental::try", "experimental::uniprop_wildcards", "experimental::vlb", "experimental::keyword_any", "experimental::keyword_all", "experimental::lexical_subs", "experimental::signature_named_parameters", "experimental::equ"}); + warningHierarchy.put("experimental", new String[]{"experimental::alpha_assertions", "experimental::args_array_with_signatures", "experimental::bitwise", "experimental::builtin", "experimental::class", "experimental::declared_refs", "experimental::defer", "experimental::enhanced_xx", "experimental::extra_paired_delimiters", "experimental::for_list", "experimental::isa", "experimental::postderef", "experimental::private_use", "experimental::re_strict", "experimental::refaliasing", "experimental::regex_sets", "experimental::script_run", "experimental::signatures", "experimental::smartmatch", "experimental::try", "experimental::uniprop_wildcards", "experimental::vlb", "experimental::keyword_any", "experimental::keyword_all", "experimental::lexical_subs", "experimental::signature_named_parameters", "experimental::equ"}); warningHierarchy.put("io", new String[]{"io::closed", "io::exec", "io::layer", "io::newline", "io::pipe", "io::syscalls", "io::unopened"}); warningHierarchy.put("severe", new String[]{"severe::debugging", "severe::inplace", "severe::internal", "severe::malloc"}); warningHierarchy.put("syntax", new String[]{"syntax::ambiguous", "syntax::bareword", "syntax::digit", "syntax::illegalproto", "syntax::parenthesis", "syntax::precedence", "syntax::printf", "syntax::prototype", "syntax::qw", "syntax::reserved", "syntax::semicolon"}); diff --git a/src/main/perl/lib/B.pm b/src/main/perl/lib/B.pm index 879e87555f..a1dd7c8623 100644 --- a/src/main/perl/lib/B.pm +++ b/src/main/perl/lib/B.pm @@ -247,7 +247,8 @@ package B::CV { $file ||= "-e"; $line ||= 0; if ($line > 0) { - return B::COP->new($file, $line); + $self->_introspect; + return B::COP->new($file, $line, $self->{_pkg_name}); } } } @@ -472,8 +473,12 @@ package B::COP { our @ISA = ('B::OP'); sub new { - my ($class, $file, $line) = @_; - return bless { file => $file // "-e", line => $line // 0 }, $class; + my ($class, $file, $line, $stash) = @_; + return bless { + file => $file // "-e", + line => $line // 0, + stash => $stash // 'main', + }, $class; } sub file { @@ -486,6 +491,11 @@ package B::COP { return $self->{line}; } + sub stashpv { + my $self = shift; + return $self->{stash}; + } + sub next { return B::NULL->new(); } diff --git a/src/main/perl/lib/warnings.pm b/src/main/perl/lib/warnings.pm index dcbbec08a0..78570f5cbe 100644 --- a/src/main/perl/lib/warnings.pm +++ b/src/main/perl/lib/warnings.pm @@ -71,42 +71,43 @@ our %Offsets = ( 'non_unicode' => 100, 'nonchar' => 102, 'surrogate' => 104, - 'experimental' => 106, + 'experimental' => 104, # Retired experimental categories share the parent bit so old source can # continue to query and suppress them after the features became stable. - 'experimental::alpha_assertions' => 106, - 'experimental::isa' => 106, + 'experimental::alpha_assertions' => 104, + 'experimental::isa' => 104, # Compatibility alias used by code targeting Perl 5.20-5.24. Postfix # dereferencing is stable now, but old sources still disable its warning. - 'experimental::postderef' => 106, - 'experimental::regex_sets' => 108, - 'syscalls' => 110, - 'experimental::re_strict' => 112, - 'experimental::refaliasing' => 114, - 'locale' => 116, - 'missing' => 118, - 'redundant' => 120, - 'experimental::declared_refs' => 122, - 'deprecated::dot_in_inc' => 124, - 'shadow' => 126, - 'experimental::private_use' => 128, - 'experimental::uniprop_wildcards' => 130, - 'experimental::vlb' => 132, - 'experimental::try' => 134, - 'experimental::args_array_with_signatures'=> 136, - 'experimental::builtin' => 138, - 'experimental::defer' => 140, - 'experimental::extra_paired_delimiters'=> 142, - 'scalar' => 144, - 'deprecated::version_downgrade' => 146, - 'deprecated::delimiter_will_be_paired'=> 148, - 'experimental::class' => 150, - 'deprecated::missing_import_called_with_args'=> 152, - 'deprecated::subsequent_use_version'=> 154, - 'experimental::keyword_all' => 156, - 'experimental::keyword_any' => 158, - 'experimental::bitwise' => 160, + 'experimental::postderef' => 104, + 'experimental::regex_sets' => 106, + 'syscalls' => 108, + 'experimental::re_strict' => 110, + 'experimental::refaliasing' => 112, + 'locale' => 114, + 'missing' => 116, + 'redundant' => 118, + 'experimental::declared_refs' => 120, + 'deprecated::dot_in_inc' => 122, + 'shadow' => 124, + 'experimental::private_use' => 126, + 'experimental::uniprop_wildcards' => 128, + 'experimental::vlb' => 130, + 'experimental::try' => 132, + 'experimental::args_array_with_signatures' => 134, + 'experimental::builtin' => 136, + 'experimental::defer' => 138, + 'experimental::extra_paired_delimiters' => 140, + 'scalar' => 142, + 'deprecated::version_downgrade' => 144, + 'deprecated::delimiter_will_be_paired' => 146, + 'experimental::class' => 148, + 'deprecated::subsequent_use_version' => 150, + 'experimental::keyword_all' => 152, + 'experimental::keyword_any' => 154, 'experimental::equ' => 162, + 'experimental::enhanced_xx' => 156, + 'experimental::signature_named_parameters' => 158, + 'missing_import' => 160, ); # Warning category masks - public compatibility data used by modules such as @@ -164,7 +165,13 @@ our %Bits = map { $_ => _mk_warning_mask(0, $_) } keys %Offsets; our %DeadBits = map { $_ => _mk_warning_mask(1, $_) } keys %Offsets; # NoOp warnings - warnings that have been removed but kept for compatibility -our %NoOp = (); +our %NoOp = map { $_ => 1 } qw( + deprecated::goto_construct deprecated::missing_import_called_with_args + deprecated::smartmatch experimental::alpha_assertions experimental::bitwise + experimental::const_attr experimental::for_list experimental::isa + experimental::lexical_subs experimental::postderef experimental::script_run + experimental::signatures experimental::smartmatch +); sub register_categories (;@) { # placeholder diff --git a/src/test/resources/unit/sub_import_sub_exporter_detection.t b/src/test/resources/unit/sub_import_sub_exporter_detection.t new file mode 100644 index 0000000000..3e63bca3ee --- /dev/null +++ b/src/test/resources/unit/sub_import_sub_exporter_detection.t @@ -0,0 +1,23 @@ +use strict; +use warnings; +use Test::More; +use B qw(svref_2object); +use Sub::Exporter; + +{ + package ImportViaSubExporter; + use Sub::Exporter -setup => { + exports => [qw(foo)], + }; + + sub foo { 'FOO' } +} + +my $importer = ImportViaSubExporter->can('import'); +is(svref_2object($importer)->START->stashpv, 'Sub::Exporter', + 'B::CV START identifies the package that created a Sub::Exporter importer'); + +$importer->('ImportViaSubExporter', foo => { -as => 'bar' }); +is(bar(), 'FOO', 'detected Sub::Exporter importer supports renamed imports'); + +done_testing; diff --git a/src/test/resources/unit/warnings_experimental_categories.t b/src/test/resources/unit/warnings_experimental_categories.t new file mode 100644 index 0000000000..8f36d2a6ea --- /dev/null +++ b/src/test/resources/unit/warnings_experimental_categories.t @@ -0,0 +1,45 @@ +use strict; +use warnings; +use Test::More; + +sub warning_bits_at_call_site { + return (caller(0))[9]; +} + +{ + use warnings 'experimental::for_list'; + ok(defined warning_bits_at_call_site(), + 'experimental::for_list is accepted by use warnings'); +} + +{ + no warnings 'experimental::for_list'; + pass('experimental::for_list is accepted by no warnings'); +} + +my $builtin_bits; +{ + use warnings 'experimental::builtin'; + $builtin_bits = warning_bits_at_call_site(); +} +ok(vec($builtin_bits, $warnings::Offsets{'experimental::builtin'}, 1), + 'experimental::builtin sets its Perl warning bit'); + +{ + no warnings 'experimental::builtin'; + $builtin_bits = warning_bits_at_call_site(); +} +ok(!vec($builtin_bits, $warnings::Offsets{'experimental::builtin'}, 1), + 'no warnings clears the experimental::builtin bit'); + +{ + use warnings FATAL => 'experimental::builtin'; + $builtin_bits = warning_bits_at_call_site(); +} +ok(vec($builtin_bits, $warnings::Offsets{'experimental::builtin'} + 1, 1), + 'fatal experimental::builtin sets its fatal bit'); + +require Data::Dumper; +ok($Data::Dumper::VERSION, 'Data::Dumper loads with experimental::builtin declarations'); + +done_testing;