Merge pull request #551 from fglock/feature/dbi-phase10-profile

fix(runtime): package Foo; lexical scoping + DBI parity Phase 10

Author: fglock

dev/known-bugs/local_list_assign_eval_string.pl

@@ -0,0 +1,42 @@
+#!/usr/bin/env perl
+# Minimal reproduction of PerlOnJava bug:
+# `local (HASH_OR_ARRAY_ELEMENT) = value;` inside eval-STRING-compiled
+# subs is a no-op for the value assignment (scope restoration still works).
+#
+# See dev/modules/dbi_test_parity.md "Root cause of t/06attrs.t and
+# t/08keeperr.t failures" for context. Blocks proper DBI::PurePerl
+# error-message formatting.
+#
+# Run with both:
+#   ./jperl dev/known-bugs/local_list_assign_eval_string.pl
+#   perl    dev/known-bugs/local_list_assign_eval_string.pl
+# and compare outputs.
+
+use strict;
+use warnings;
+
+my $h = { x => 0 };
+my @a = (0);
+
+# Case A: direct file-scope compile — works on both
+sub directA { local ($h->{x}) = 42; print "A: h->{x}=$h->{x}\n"; }
+directA();
+print "A: after: h->{x}=$h->{x}\n";
+
+# Case B: eval-STRING compiled sub, hash-element, list form — BUG on jperl
+my $subB = eval q{ sub { local ($h->{x}) = 99; print "B: h->{x}=$h->{x}\n"; } };
+die $@ if $@;
+$subB->();
+
+# Case C: eval-STRING compiled sub, hash-element, SCALAR form — works
+my $subC = eval q{ sub { local $h->{x} = 77; print "C: h->{x}=$h->{x}\n"; } };
+die $@ if $@;
+$subC->();
+
+# Case D: eval-STRING compiled sub, array-element, list form — BUG on jperl
+my $subD = eval q{ sub { local ($a[0]) = 88; print "D: a[0]=$a[0]\n"; } };
+die $@ if $@;
+$subD->();
+
+print "\nExpected (real perl):\n";
+print "A: h->{x}=42\nA: after: h->{x}=0\nB: h->{x}=99\nC: h->{x}=77\nD: a[0]=88\n";

dev/modules/dbi_test_parity.md

@@ -261,6 +261,24 @@ private static boolean handleLocalListAssignment(BytecodeCompiler bc, BinaryOper
                 bc.lastResultReg = localReg;
                 return true;
             }
+            // Single-element list with an lvalue like $h->{k}, $a[i], $obj->method->{k}, etc.
+            // Delegate to the scalar-local handler (matches the `local EXPR = RHS` path at
+            // line 20). Without this, the element falls through the main loop below and
+            // emits nothing - a silent no-op assignment. Reproduced by:
+            //     local ($h->{x}) = 99;   inside an eval-STRING-compiled sub
+            if (element instanceof BinaryOperatorNode binOp) {
+                bc.compileNode(binOp, -1, rhsContext);
+                int elemReg = bc.lastResultReg;
+                bc.emit(Opcodes.PUSH_LOCAL_VARIABLE);
+                bc.emitReg(elemReg);
+                bc.compileNode(node.right, -1, rhsContext);
+                int valueReg = bc.lastResultReg;
+                bc.emit(Opcodes.SET_SCALAR);
+                bc.emitReg(elemReg);
+                bc.emitReg(valueReg);
+                bc.lastResultReg = elemReg;
+                return true;
+            }
         }
         bc.compileNode(node.right, -1, rhsContext);
         int valueReg = bc.lastResultReg;
@@ -292,6 +310,26 @@ private static boolean handleLocalListAssignment(BytecodeCompiler bc, BinaryOper
                 bc.emitReg(localReg);
                 bc.emitReg(elemReg);
                 if (i == 0) bc.lastResultReg = localReg;
+            } else if (element instanceof BinaryOperatorNode binOp) {
+                // Element is an lvalue expression (e.g. $h->{k}, $a[i], $obj->attr).
+                // Compile to get the element reference, localize it, and assign RHS[i].
+                bc.compileNode(binOp, -1, RuntimeContextType.SCALAR);
+                int elemLvalReg = bc.lastResultReg;
+                bc.emit(Opcodes.PUSH_LOCAL_VARIABLE);
+                bc.emitReg(elemLvalReg);
+                int idxReg = bc.allocateRegister();
+                bc.emit(Opcodes.LOAD_INT);
+                bc.emitReg(idxReg);
+                bc.emit(i);
+                int rhsElemReg = bc.allocateRegister();
+                bc.emit(Opcodes.ARRAY_GET);
+                bc.emitReg(rhsElemReg);
+                bc.emitReg(valueReg);
+                bc.emitReg(idxReg);
+                bc.emit(Opcodes.SET_SCALAR);
+                bc.emitReg(elemLvalReg);
+                bc.emitReg(rhsElemReg);
+                if (i == 0) bc.lastResultReg = elemLvalReg;
             }
         }
         return true;

src/main/java/org/perlonjava/backend/bytecode/CompileAssignment.java

@@ -828,9 +828,12 @@ public static void visitOperator(BytecodeCompiler bytecodeCompiler, OperatorNode
                     }
                     bytecodeCompiler.symbolTable.setCurrentPackage(packageName, isClass);
                     if (isClass) ClassRegistry.registerClass(packageName);
-                    boolean isScoped = Boolean.TRUE.equals(node.getAnnotation("isScoped"));
+                    // Always emit PUSH_PACKAGE so the runtime tracker is restored when
+                    // the enclosing block/sub/file exits. Perl 5's `package Foo;` is
+                    // lexically scoped; the `isScoped` annotation used to distinguish
+                    // `package Foo { BLOCK }` but bare `package Foo;` is equally scoped.
                     int nameIdx = bytecodeCompiler.addToStringPool(packageName);
-                    bytecodeCompiler.emit(isScoped ? Opcodes.PUSH_PACKAGE : Opcodes.SET_PACKAGE);
+                    bytecodeCompiler.emit(Opcodes.PUSH_PACKAGE);
                     bytecodeCompiler.emit(nameIdx);
                     bytecodeCompiler.lastResultReg = -1;
                 } else {

src/main/java/org/perlonjava/backend/bytecode/CompileOperator.java

@@ -54,6 +54,23 @@ public class InterpreterState {
     public static void setCurrentPackageStatic(String name) {
         currentPackage.get().set(name);
     }
+
+    /**
+     * Scoped variant of {@link #setCurrentPackageStatic}: pushes the current
+     * package value onto the DynamicVariableManager stack so it will be
+     * restored when the enclosing scope exits, then sets the new value.
+     * <p>
+     * Matches Perl 5 semantics: {@code package Foo;} is lexically scoped to
+     * the enclosing block / eval / file. Without the push, a {@code package Foo;}
+     * inside e.g. {@code Carp::caller_info}'s {@code { package DB; ... }} block
+     * would leak "DB" past the block, corrupting subsequent {@code do FILE}
+     * calls (which inherit the caller's package).
+     */
+    public static void setCurrentPackageLocal(String name) {
+        RuntimeScalar pkg = currentPackage.get();
+        org.perlonjava.runtime.runtimetypes.DynamicVariableManager.pushLocalVariable(pkg);
+        pkg.set(name);
+    }
     private static final ThreadLocal<Deque<InterpreterFrame>> frameStack =
             ThreadLocal.withInitial(ArrayDeque::new);
     // Use ArrayList of mutable int holders for O(1) PC updates (no pop/push overhead)

src/main/java/org/perlonjava/backend/bytecode/InterpreterState.java

@@ -1123,13 +1123,18 @@ static void handlePackageOperator(EmitterVisitor emitterVisitor, OperatorNode no
         // `require FILE` (which inspects InterpreterState.currentPackage to
         // compile the required file in the correct namespace) see the right
         // package after a `package Foo;` declaration in JVM-compiled code.
-        // Without this, the runtime tracker stays at "main" in compiled code,
-        // and `require FILE` incorrectly installs subs in main::.
+        //
+        // Use the *scoped* (local) variant so the runtime tracker is restored
+        // when the enclosing block / sub / file exits. Perl 5's `package Foo;`
+        // is lexically scoped; without the restore, a `package DB;` inside
+        // e.g. Carp::caller_info's inner `{ package DB; ... }` block would
+        // leak past the block and break subsequent `do FILE` calls which
+        // compile the loaded file in the *current* runtime package.
         emitterVisitor.ctx.mv.visitLdcInsn(name);
         emitterVisitor.ctx.mv.visitMethodInsn(
                 org.objectweb.asm.Opcodes.INVOKESTATIC,
                 "org/perlonjava/backend/bytecode/InterpreterState",
-                "setCurrentPackageStatic",
+                "setCurrentPackageLocal",
                 "(Ljava/lang/String;)V",
                 false);
         // Set debug information for the file name.

src/main/java/org/perlonjava/backend/jvm/EmitOperator.java

@@ -33,7 +33,7 @@ public final class Configuration {
      * Automatically populated by Gradle/Maven during build.
      * DO NOT EDIT MANUALLY - this value is replaced at build time.
      */
-    public static final String gitCommitId = "1cdf0926f";
+    public static final String gitCommitId = "7a0687aef";
 
     /**
      * Git commit date of the build (ISO format: YYYY-MM-DD).
@@ -48,7 +48,7 @@ public final class Configuration {
      * Parsed by App::perlbrew and other tools via: perl -V | grep "Compiled at"
      * DO NOT EDIT MANUALLY - this value is replaced at build time.
      */
-    public static final String buildTimestamp = "Apr 23 2026 13:55:28";
+    public static final String buildTimestamp = "Apr 23 2026 18:51:50";
 
     // Prevent instantiation
     private Configuration() {

src/main/java/org/perlonjava/core/Configuration.java

@@ -33,6 +33,30 @@ public class XSLoader extends PerlModuleBase {
             "XSLoader"
     );
 
+    /**
+     * Modules that are pure-XS in real Perl with no PerlOnJava-side implementation.
+     * When XSLoader::load is called for one of these, we die cleanly so that
+     * {@code eval { require SomeModule }} in CPAN code (and test suites that
+     * probe for optional backends like DBM engines) correctly falls through
+     * to alternatives instead of silently "succeeding" and then crashing
+     * later when methods are actually called.
+     * <p>
+     * Rule of thumb: the module's whole functionality lives in a shared
+     * library shipped with CPAN, and there is no pure-Perl or Java-backed
+     * replacement in PerlOnJava. Pre-registered Java modules (File::Glob,
+     * Encode, Time::HiRes, etc.) must NOT appear here.
+     * <p>
+     * Kept in sync with the Perl-side copy in {@code lib/XSLoader.pm}.
+     */
+    private static final Set<String> XS_ONLY_NOT_SUPPORTED = Set.of(
+            "DB_File",
+            "BerkeleyDB",
+            "GDBM_File",
+            "NDBM_File",
+            "ODBM_File",
+            "SDBM_File"
+    );
+
     /**
      * Constructor for XSLoader.
      * Initializes the module with the name "XSLoader".
@@ -57,6 +81,41 @@ public static void initialize() {
         }
     }
 
+    /**
+     * Installs no-op Perl subroutines for XS symbols that a failed-to-load
+     * module's END block is known to call. Without these, the END queue
+     * aborts on interpreter shutdown with a non-zero exit status, which
+     * prove/TAP::Harness counts as a failed test program even when the
+     * program's actual assertions all passed or were SKIPped.
+     *
+     * Keyed by the module name passed to {@code XSLoader::load}.
+     */
+    private static void installEndBlockStubs(String moduleName) {
+        String[] symbols = switch (moduleName) {
+            case "BerkeleyDB" -> new String[] { "BerkeleyDB::Term::close_everything" };
+            default -> null;
+        };
+        if (symbols == null) return;
+        try {
+            java.lang.invoke.MethodHandle mh = RuntimeCode.lookup.findStatic(
+                    XSLoader.class, "noopStub", RuntimeCode.methodType);
+            for (String sym : symbols) {
+                if (GlobalVariable.existsGlobalCodeRef(sym)) continue;
+                RuntimeCode code = new RuntimeCode(mh, null, null);
+                code.isStatic = true;
+                GlobalVariable.getGlobalCodeRef(sym).set(new RuntimeScalar(code));
+            }
+        } catch (Exception e) {
+            // Non-fatal: the test program may still report a spurious non-zero
+            // exit, but the module-load failure path is unaffected.
+        }
+    }
+
+    /** No-op Perl sub used by {@link #installEndBlockStubs}. */
+    public static RuntimeList noopStub(RuntimeArray args, int ctx) {
+        return new RuntimeList();
+    }
+
     /**
      * Loads a PerlOnJava module.
      * <p>
@@ -90,6 +149,29 @@ public static RuntimeList load(RuntimeArray args, int ctx) {
             moduleName = args.getFirst().toString();
         }
 
+        // Bail out cleanly for pure-XS modules PerlOnJava can't back.
+        // Without this, modules like DB_File load but their XS helpers
+        // (constant, etc.) are undefined, leading to infinite AUTOLOAD
+        // recursion (StackOverflowError) the first time the module is
+        // actually used. CPAN test suites commonly probe optional backends
+        // with `eval { require SomeDBM }` and rely on require FAILING to
+        // fall through to alternatives; silent success breaks them.
+        if (XS_ONLY_NOT_SUPPORTED.contains(moduleName)) {
+            // Install no-op stubs for any functions the module registers in an
+            // END block — the `.pm` file was already compiled end-to-end before
+            // we reach this `load`, so its END queue entries will fire at
+            // interpreter shutdown regardless of whether `require` succeeds.
+            // Without these, CPAN prove-style runners report the (otherwise-
+            // passing / SKIPped) test program as "exited 1" from the END die.
+            installEndBlockStubs(moduleName);
+
+            return WarnDie.die(
+                    new RuntimeScalar("Can't load '" + moduleName + "' for module " + moduleName
+                            + ": XS module not supported on PerlOnJava"),
+                    new RuntimeScalar("\n")
+            ).getList();
+        }
+
         // Convert Perl::Module::Name to org.perlonjava.runtime.perlmodule.PerlModuleName
         String[] parts = moduleName.split("::");
         StringBuilder className1 = new StringBuilder("org.perlonjava.runtime.perlmodule.");

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

@@ -15,26 +15,56 @@ package XSLoader;
 
 our $VERSION = "0.32";
 
+# Modules that are pure-XS in real Perl with no PerlOnJava-side implementation.
+# When XSLoader::load is called for one of these, we die cleanly so that
+# `eval { require SomeModule }` in CPAN code (and test suites that probe for
+# optional backends like DBM engines) correctly falls through to alternatives
+# instead of silently "succeeding" and then crashing later when methods are
+# actually called.
+#
+# Rule of thumb for adding to this list: the module's whole functionality
+# lives in a `.so`/DLL shipped with CPAN, and there is no pure-Perl or
+# Java-backed replacement in PerlOnJava. Pre-registered Java modules
+# (File::Glob, Encode, Time::HiRes, etc.) must NOT appear here.
+our %XS_ONLY_NOT_SUPPORTED = map { $_ => 1 } qw(
+    DB_File
+    BerkeleyDB
+    GDBM_File
+    NDBM_File
+    ODBM_File
+    SDBM_File
+);
+
 # Only define our load() if it's not already defined by Java
 BEGIN {
     unless (defined &load) {
         *load = sub {
             my ($module, $version) = @_;
             $module = caller() unless defined $module;
-            
+
+            # Bail out cleanly for pure-XS modules PerlOnJava can't back.
+            # Without this, modules like DB_File load but XS functions such
+            # as `constant` are undefined, which triggers infinite AUTOLOAD
+            # recursion (StackOverflowError) the first time the module is
+            # actually used.
+            if ($XS_ONLY_NOT_SUPPORTED{$module}) {
+                die "Can't load '$module' for module $module: "
+                    . "XS module not supported on PerlOnJava\n";
+            }
+
             # Check if the module has a bootstrap function (like standard XSLoader)
             my $boots = "${module}::bootstrap";
             if (defined &{$boots}) {
                 goto &{$boots};
             }
-            
+
             # For Java-backed modules, the methods are already registered.
             # For pure-Perl modules, nothing needs to be done.
             # Either way, just return success.
             return 1;
         };
     }
-    
+
     # Alias for compatibility
     *bootstrap_inherit = \&load unless defined &bootstrap_inherit;
 }