Fix compiler and tooling compatibility for CPAN modules

dev/design/jcpan_compiler_tooling_batch.md

@@ -0,0 +1,73 @@
+# CPAN Compiler and Tooling Compatibility Batch
+
+## Scope
+
+This batch fixes shared compiler, runtime, and CPAN-tooling behavior exposed by
+the following `jcpan` test targets and their dependencies:
+
+- `Net::Async::SMTP`
+- `Group::Git`
+- `Locale::CLDR::Locales::Lu`
+- `Dist::Zilla::Plugin::Meta::Maintainers`
+- `TOML::Tiny`
+- `DBIx::Admin::BackupRestore`
+- `Number::Phone::NO`
+
+`WWW::Wikipedia` is excluded because its network-dependent tests also fail
+under system Perl.
+
+## Implemented Fixes
+
+- Parse a trailing comma after a fixed-prototype argument list before boolean
+  infix operators, as used by `DBM::Deep`'s `vec` expressions.
+- Preserve a caller's populated `DATA` handle while compiling a nested
+  dependency that temporarily inherits the caller's package.
+- Treat tied array and hash handlers as strong reachability edges during the
+  selective reference-count sweep.
+- Associate `B::Hooks::EndOfScope` compile scopes with their owning file so a
+  nested compile-time `require` cannot attach cleanup callbacks to its caller.
+- Make DBI metadata statement handles active and provide DBI's default
+  `FetchHashKeyName` value.
+- Preserve methods generated by `DateTime::Format::Builder` during
+  `namespace::autoclean` processing.
+- Narrow the `IO::Async` distropref match so it cannot patch unrelated
+  `IO::Async::Resolver::DNS` distributions.
+
+## Verification
+
+| Target | Result |
+|---|---|
+| `Net::Async::SMTP` | PASS: 3 files, 18 tests |
+| `Group::Git` | PASS: 7 files, 43 tests |
+| `Locale::CLDR::Locales::Lu` | PASS: 1 file, 4 tests |
+| `Dist::Zilla::Plugin::Meta::Maintainers` | PASS: 2 files, 2 tests |
+| `TOML::Tiny` | PASS: 291 files, 484 tests |
+| `DBIx::Admin::BackupRestore` | PASS: 4 files, 15 tests |
+| `Number::Phone::NO` | PASS: 10 files, 23 tests |
+| `WWW::Wikipedia` under system Perl | FAIL: external API tests; excluded |
+
+The focused regression tests were validated with system Perl before running
+the PerlOnJava build and unit suite.
+
+## Progress Tracking
+
+### Current Status: Completed (2026-08-15)
+
+### Completed Phases
+
+- [x] Reproduce and classify requested module failures.
+- [x] Verify the `WWW::Wikipedia` failures under system Perl.
+- [x] Implement shared compiler, runtime, DBI, and CPAN-tooling fixes.
+- [x] Add system-Perl-compatible regression coverage.
+- [x] Re-run all applicable requested distributions.
+
+### Next Steps
+
+1. Monitor the pull request's full CI matrix.
+
+### Open Questions
+
+- `Number::Phone::NO` passes, but JVM teardown can emit a non-fatal
+  `StackOverflowError` while cleaning the very large `DBM::Deep` object graph.
+  This is separate from test correctness and may warrant a future iterative
+  teardown improvement.

src/main/java/org/perlonjava/frontend/parser/DataSection.java

@@ -54,6 +54,18 @@ public static void createPlaceholderDataHandle(Parser parser) {
             return; // Already created placeholder for this package
         }
 
+        // A nested require starts parsing in the caller's package until the
+        // loaded file's package declaration is seen.  Do not let that
+        // temporary package context replace the caller's populated DATA
+        // handle with an empty placeholder.
+        var existingGlob = GlobalVariable.getExistingGlobalIO(handleName);
+        RuntimeIO existingIO = existingGlob == null ? null : existingGlob.getRuntimeIO();
+        if (existingIO != null
+                && !(existingIO.ioHandle instanceof org.perlonjava.runtime.io.ClosedIOHandle)) {
+            state().placeholderCreated.add(handleName);
+            return;
+        }
+
         state().placeholderCreated.add(handleName);
 
         if (CompilerOptions.DEBUG_ENABLED) parser.ctx.logDebug("Creating placeholder DATA handle for package: " + handleName);

src/main/java/org/perlonjava/frontend/parser/PrototypeArgs.java

@@ -341,6 +341,7 @@ static ListNode consumeArgsWithPrototype(Parser parser, String prototype, boolea
                             nextToken.type == LexerTokenType.NEWLINE && !parser.getHeredocNodes().isEmpty();
                     if (!trailingCommaBeforeHeredoc
                             && !Parser.isExpressionTerminator(nextToken)
+                            && !isInfixOperatorAfterTrailingComma(nextToken)
                             && nextToken.type != LexerTokenType.EOF
                             && !nextToken.text.equals(")")) {
                         throwTooManyArgumentsError(parser);
@@ -429,6 +430,19 @@ private static LexerToken tokenAtOrEof(List<LexerToken> tokens, int i) {
         return tokens.get(i);
     }
 
+    /**
+     * A comma after the final fixed-prototype argument may be followed by an
+     * infix operator belonging to the enclosing expression.  For example,
+     * DBM::Deep uses {@code vec $mask, $offset, 1, || vec ...}.  The comma is
+     * trailing punctuation for vec(), not the start of a fourth argument.
+     */
+    private static boolean isInfixOperatorAfterTrailingComma(LexerToken token) {
+        return switch (token.text) {
+            case "||", "&&", "or", "and", "xor" -> true;
+            default -> false;
+        };
+    }
+
     private static int firstNonCodeArgIndexAfterAmpersandPrototype(String prototype, ListNode args) {
         if (prototype == null || args.elements.size() < 2) {
             return -1;

src/main/java/org/perlonjava/runtime/CompilationRuntimeState.java

@@ -43,7 +43,16 @@ public final class CompilationRuntimeState {
     public final Map<String, Deque<RuntimeScalar>> endOfScopeFileCallbacks =
             new ConcurrentHashMap<>();
     public final Deque<String> loadingFileStack = new ArrayDeque<>();
-    public final Deque<Deque<RuntimeScalar>> compileScopes = new ArrayDeque<>();
+    public static final class EndOfScopeCompileScope {
+        public final String ownerFile;
+        public final Deque<RuntimeScalar> callbacks = new ArrayDeque<>();
+
+        public EndOfScopeCompileScope(String ownerFile) {
+            this.ownerFile = ownerFile;
+        }
+    }
+
+    public final Deque<EndOfScopeCompileScope> compileScopes = new ArrayDeque<>();
     /** UNITCHECK queue belonging to each parser currently compiling a file/eval. */
     public final ThreadLocal<Deque<RuntimeArray>> unitcheckQueueStack =
             ThreadLocal.withInitial(ArrayDeque::new);

src/main/java/org/perlonjava/runtime/perlmodule/BHooksEndOfScope.java

@@ -113,19 +113,20 @@ private static String getCurrentLoadingFile() {
 
     /** Enter a parser-visible lexical scope. */
     public static void beginCompileScope() {
-        state().compileScopes.push(new ArrayDeque<>());
+        state().compileScopes.push(new CompilationRuntimeState.EndOfScopeCompileScope(
+                getCurrentLoadingFile()));
     }
 
     /**
      * Leave a parser-visible lexical scope and run callbacks registered in it
      * in LIFO order, matching the native hook's ordering.
      */
     public static void endCompileScope() {
-        Deque<Deque<RuntimeScalar>> scopes = state().compileScopes;
+        Deque<CompilationRuntimeState.EndOfScopeCompileScope> scopes = state().compileScopes;
         if (scopes.isEmpty()) {
             return;
         }
-        Deque<RuntimeScalar> callbacks = scopes.pop();
+        Deque<RuntimeScalar> callbacks = scopes.pop().callbacks;
         while (!callbacks.isEmpty()) {
             RuntimeScalar codeRef = callbacks.pop();
             try {
@@ -166,15 +167,14 @@ public static RuntimeList on_scope_end(RuntimeArray args, int ctx) {
 
         // Prefer the innermost parser-visible lexical scope.  This is the
         // behavior required by namespace::clean for nested blocks.
-        Deque<Deque<RuntimeScalar>> scopes = state().compileScopes;
-        if (!scopes.isEmpty()) {
-            scopes.peek().push(codeRef);
+        String currentFile = getCurrentLoadingFile();
+        Deque<CompilationRuntimeState.EndOfScopeCompileScope> scopes = state().compileScopes;
+        if (!scopes.isEmpty() && Objects.equals(scopes.peek().ownerFile, currentFile)) {
+            scopes.peek().callbacks.push(codeRef);
             return new RuntimeList();
         }
 
         // Find which file is currently being loaded
-        String currentFile = getCurrentLoadingFile();
-
         if (currentFile != null) {
             // Register callback for end of file load
             state().endOfScopeFileCallbacks.computeIfAbsent(currentFile, k -> new ArrayDeque<>()).push(codeRef);

src/main/java/org/perlonjava/runtime/perlmodule/DBI.java

@@ -138,6 +138,7 @@ public static RuntimeList connect(RuntimeArray args, int ctx) {
             // value" on direct assignment. Seen in DBIC t/storage/txn.t line 382.
             dbh.put("ReadOnly", new RuntimeScalar(false));
             dbh.put("AutoCommit", new RuntimeScalar(true));
+            dbh.put("FetchHashKeyName", new RuntimeScalar("NAME"));
 
             // Handle credentials file if specified in attributes
             Properties props = new Properties();
@@ -1403,6 +1404,11 @@ private static RuntimeHash createMetadataResultSet(RuntimeHash dbh, ResultSet rs
         sth.put("NAME_uc", columnNamesUpper.createReference());
         sth.put("NUM_OF_FIELDS", new RuntimeScalar(columnCount));
         sth.put("Type", new RuntimeScalar("st"));
+        // Metadata methods return an already-active result set.  DBI's Perl
+        // fetchall_arrayref/fetchall_hashref implementations gate iteration
+        // on this flag, just like ordinary SELECT statement handles do after
+        // execute().
+        sth.put("Active", new RuntimeScalar(true));
         sth.put("Executed", scalarTrue);
         sth.put("execute_result", result.createReference());
 

src/main/java/org/perlonjava/runtime/runtimetypes/ReachabilityWalker.java

@@ -272,11 +272,17 @@ private void bfs(java.util.ArrayDeque<RuntimeBase> todo, boolean walkCaptures) {
             if (cur instanceof RuntimeStash) continue;
             if (cur instanceof RuntimeHash h) {
                 if (h.elements instanceof HashSpecialVariable) continue;
+                if (h.elements instanceof TieHash tieHash) {
+                    visitScalar(tieHash.getSelf(), todo);
+                }
                 for (RuntimeScalar v : h.elements.values()) {
                     addReachable(v, todo);
                     visitScalar(v, todo);
                 }
             } else if (cur instanceof RuntimeArray a) {
+                if (a.elements instanceof TieArray tieArray) {
+                    visitScalar(tieArray.getSelf(), todo);
+                }
                 for (RuntimeScalar v : a.elements) {
                     addReachable(v, todo);
                     visitScalar(v, todo);

src/main/perl/lib/PerlOnJava/CpanDistroprefs/IO-Async.yml

@@ -8,7 +8,7 @@ comment: |
   capability so fork/process/routine tests skip instead of failing after the
   runtime correctly rejects fork().
 match:
-  distribution: "^PEVANS/IO-Async-"
+  distribution: "^PEVANS/IO-Async-[0-9]"
 patches:
   - "IO-Async/NoFork.patch"
   - "IO-Async/PerlOnJava.patch"

src/main/perl/lib/namespace/autoclean.pm

@@ -158,6 +158,12 @@ sub _method_check {
         # target stash, but the coderefs keep Class::XSAccessor::__ANON__
         # subnames. Those are generated methods, not imports to clean.
         return 1 if $code_stash eq 'Class::XSAccessor';
+        # DateTime::Format::Builder likewise installs parser methods into the
+        # target class from factory coderefs whose subnames remain in Builder.
+        # Nested compile-time dependency loading can defer our scope callback
+        # until after those methods are installed, so identify the provider as
+        # a method generator rather than deleting the generated API.
+        return 1 if $code_stash eq 'DateTime::Format::Builder';
         # Companion/helper packages (e.g. DateTime::PP for DateTime) install
         # functions via glob assignment — these are intentional methods, not imports.
         # In PerlOnJava, method calls are resolved at runtime through the stash,

src/test/resources/unit/b_hooks_endofscope_require.t

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-use Test::More tests => 5;
+use Test::More tests => 7;
 use File::Temp qw(tempdir);
 use File::Spec;
 
@@ -60,6 +60,21 @@ RequireScopeEndInstaller::install(__PACKAGE__);
 EOPM
 close $target_fh;
 
+my $outer_pm = File::Spec->catfile($tmp, 'RequireScopeEndOuter.pm');
+open my $outer_fh, '>', $outer_pm or die "open $outer_pm: $!";
+print {$outer_fh} <<'EOPM';
+package RequireScopeEndOuter;
+use strict;
+use warnings;
+
+{
+    use RequireScopeEndTarget ();
+}
+
+1;
+EOPM
+close $outer_fh;
+
 {
     local @INC = ($tmp, @INC);
 
@@ -84,4 +99,18 @@ close $target_fh;
         'generated',
         'runtime-installed method remains callable',
     );
+
+    delete $INC{'RequireScopeEndTarget.pm'};
+    {
+        no strict 'refs';
+        delete ${'RequireScopeEndTarget::'}{'generated'};
+    }
+
+    my $outer_loaded = eval { require RequireScopeEndOuter; 1 };
+    ok($outer_loaded, 'required module nested inside an outer compile scope loads')
+        or diag "\$@ = $@";
+    ok(
+        RequireScopeEndTarget->can('generated'),
+        'nested require keeps end-of-scope hooks with the required file',
+    );
 }

src/test/resources/unit/data_handle_nested_require.t

@@ -0,0 +1,24 @@
+use strict;
+use warnings;
+use Test::More tests => 3;
+use File::Temp qw(tempdir);
+
+my $initial_position = tell(DATA);
+ok($initial_position > 0, 'DATA starts after its source marker');
+
+my $dir = tempdir(CLEANUP => 1);
+mkdir "$dir/Local" or die "mkdir $dir/Local: $!";
+open my $module, '>', "$dir/Local/DataHandleDependency.pm"
+    or die "create dependency: $!";
+print {$module} "package Local::DataHandleDependency; 1;\n";
+close $module or die "close dependency: $!";
+
+unshift @INC, $dir;
+require Local::DataHandleDependency;
+
+is(tell(DATA), $initial_position,
+   'runtime require does not replace the caller DATA handle');
+is(<DATA>, "payload\n", 'caller DATA remains readable after runtime require');
+
+__DATA__
+payload

src/test/resources/unit/dbi_metadata_fetchall.t

@@ -0,0 +1,34 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Test::More tests => 5;
+use File::Temp qw(tempfile);
+use DBI;
+use DBD::SQLite;
+
+my ($fh, $db_file) = tempfile(SUFFIX => '.sqlite');
+close $fh;
+unlink $db_file;
+
+my $dbh = DBI->connect(
+    "dbi:SQLite:dbname=$db_file", '', '',
+    { RaiseError => 1, AutoCommit => 1 },
+);
+is($dbh->{FetchHashKeyName}, 'NAME', 'DBI sets the default hash key name');
+$dbh->do('create table alpha (id int)');
+$dbh->do('create table beta (id int)');
+
+my $sth = $dbh->table_info(undef, undef, '%', 'TABLE');
+ok($sth->{Active}, 'table_info returns an active statement handle');
+
+my $rows = $sth->fetchall_arrayref({});
+is(ref($rows), 'ARRAY', 'metadata fetchall_arrayref returns an array reference');
+is(scalar(@$rows), 2, 'metadata fetchall_arrayref returns both tables');
+is_deeply(
+    [ sort map { $_->{TABLE_NAME} } @$rows ],
+    [qw(alpha beta)],
+    'metadata hash rows expose TABLE_NAME',
+);
+
+END { unlink $db_file if defined $db_file }

src/test/resources/unit/prototype_trailing_comma_infix.t

@@ -0,0 +1,13 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Test::More tests => 2;
+
+my $mask = "\x01";
+
+my $logical_or = vec $mask, 0, 1, || vec $mask, 1, 1,;
+ok($logical_or, 'trailing comma before logical-or ends fixed-prototype arguments');
+
+my $logical_and = vec $mask, 0, 1, && !vec $mask, 1, 1,;
+ok($logical_and, 'trailing comma before logical-and ends fixed-prototype arguments');