Fix Object::HashBase deferred role composition

docs/about/changelog.md

@@ -4,6 +4,7 @@ Release history of PerlOnJava. See [Roadmap](roadmap.md) for future plans.
 
 ## Work in progress
 
+- Fix Object::HashBase deferred Role::Tiny composition.
 - Fix localization of numbered regex captures.
 - Fix IO-handle type checks and uninitialized-value warning locations.
 - Fix numeric-zero results from failed `s///` substitutions.
@@ -95,6 +96,7 @@ Release history of PerlOnJava. See [Roadmap](roadmap.md) for future plans.
 - **Bundled Moose 2.4000 and Class::MOP 2.4000**: the upstream Moose source tree is shipped in `src/main/perl/lib/{Moose,Class/MOP}/`. Tested by installing `DBIx::Class` 0.082843 via `jcpan` (DBIx::Class itself uses `Moo`, fetched from CPAN) and running its test suite — it passes 100% (314 files / 13858 asserts). Upstream Moose's own test suite passes ~99% (≥396/478 files, ≥13413/13550 asserts). See [bundled modules](../reference/bundled-modules.md#moose--classmop) and [dev/modules/moose_support.md](../../dev/modules/moose_support.md) for the full status and the small set of remaining failure clusters (numeric-arg warnings, anon-class GC timing, threads/fork tests).
 
 - Work in Progress
+  - Fix scoped `%^H` guard destruction.
   - [Multiplicity — per-runtime isolation for concurrent Perl interpreters](https://github.com/fglock/PerlOnJava/pull/480): `PerlRuntime` with `ThreadLocal`-based isolation; all mutable state (globals, I/O, regex, caller stack, method caches) moved to per-runtime instances; 122/126 concurrent interpreter tests pass; pending closure/method dispatch optimization
   - Moose - most tests pass
   - XML::LibXML - some tests pass

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

@@ -6098,6 +6098,11 @@ private void visitAnonymousSubroutine(SubroutineNode node) {
         }
         subCode.lexicalVariableNames = declaredLexicalNames;
         subCode.prototype = node.prototype;
+        // Perl treats a no-argument anonymous sub whose entire body is a
+        // lexical scalar read as a constant CV.  Object::HashBase creates its
+        // accessor-key constants this way during BEGIN; mark only this
+        // side-effect-free shape so the closure creation path can freeze it.
+        subCode.isConstantCv = node.getBooleanAnnotation("simpleLexicalConstantCandidate");
         subCode.attributes = node.attributes;
         subCode.packageName = node.getAnnotation("regexCallbackPackage") instanceof String pkg
                 ? pkg : getCurrentPackage();
@@ -6180,6 +6185,7 @@ private void visitAnonymousSubroutine(SubroutineNode node) {
         lastResultReg = codeReg;
     }
 
+
     private static void copySignatureMetadata(InterpretedCode code, Node block) {
         if (block.getAnnotation("signatureMinArgs") instanceof Integer min) {
             code.signatureMinArgs = min;

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

@@ -283,7 +283,7 @@ private static RuntimeList evalStringList(String perlCode,
         Map<String, RuntimeScalar> lexicalHintHash =
                 HintHashRegistry.getCurrentCallSiteScalarHintHash();
         if (lexicalHintHash != null) {
-            activeHintHash.elements.clear();
+            activeHintHash.clearForHintHashContextTransfer();
             activeHintHash.elements.putAll(lexicalHintHash);
         }
         try {
@@ -638,8 +638,7 @@ private static RuntimeList evalStringList(String perlCode,
                     }
                 }
                 SpecialBlockParser.setCurrentScope(savedCurrentScope);
-                activeHintHash.elements.clear();
-                activeHintHash.elements.putAll(savedHintHash);
+                HintHashRegistry.restoreHintHash(activeHintHash, savedHintHash);
                 HintHashRegistry.setCallSiteHintHashId(savedCallSiteHintHashId);
             } finally {
                 PerlLanguageProvider.COMPILE_LOCK.unlock();

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

@@ -508,6 +508,8 @@ public InterpretedCode withCapturedVars(RuntimeBase[] capturedVars) {
                 this.warningBitsString
         );
         copy.prototype = this.prototype;
+        copy.isConstantCv = this.isConstantCv;
+        copy.constantValue = this.constantValue == null ? null : new RuntimeList(this.constantValue);
         copy.attributes = this.attributes;
         copy.subName = this.subName;
         copy.packageName = this.packageName;

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

@@ -999,6 +999,13 @@ public static int executeCreateClosure(int[] bytecode, int pc, RuntimeBase[] reg
         // Create a new InterpretedCode with the captured variables
         InterpretedCode closureCode = template.withCapturedVars(capturedVars);
 
+        // A side-effect-free `sub () { $lexical }` is a Perl constant CV.  Its
+        // captured scalar is now available, so freeze the value exactly once
+        // before later compilation can inline calls to the installed coderef.
+        if (closureCode.isConstantCv && closureCode.constantValue == null) {
+            closureCode.cacheConstantCvValue();
+        }
+
         // Track captureCount on captured RuntimeScalar variables.
         // This mirrors what RuntimeCode.makeCodeObject() does for JVM-compiled closures.
         // Without this, scopeExitCleanup() doesn't know the variable is still alive

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

@@ -346,6 +346,9 @@ public static void emitSubroutine(EmitterContext ctx, SubroutineNode node) {
                         : ctx.compilerOptions.code;
             }
             int deparseFlags = 0;
+            if (node.getBooleanAnnotation("simpleLexicalConstantCandidate")) {
+                deparseFlags |= 0x40000000;
+            }
             int strictAll = HINT_STRICT_REFS | HINT_STRICT_SUBS | HINT_STRICT_VARS;
             if ((ctx.symbolTable.getStrictOptions() & strictAll) == strictAll) {
                 deparseFlags |= RuntimeCode.DEPARSE_FLAG_STRICT;

src/main/java/org/perlonjava/frontend/analysis/ConstantFoldingVisitor.java

@@ -502,7 +502,14 @@ public void visit(BlockNode node) {
         }
 
         if (changed) {
-            result = new BlockNode(foldedElements, node.tokenIndex);
+            BlockNode folded = new BlockNode(foldedElements, node.tokenIndex);
+            folded.isLoop = node.isLoop;
+            folded.labelName = node.labelName;
+            folded.labels = new ArrayList<>(node.labels);
+            if (node.annotations != null) {
+                folded.annotations = new java.util.HashMap<>(node.annotations);
+            }
+            result = folded;
         } else {
             result = node;
         }
@@ -619,7 +626,8 @@ private Node resolveConstantSubValue(String name, int tokenIndex) {
                                 return new NumberNode(String.valueOf(scalar.getLong()), tokenIndex);
                             } else if (scalar.type == RuntimeScalarType.DOUBLE) {
                                 return new NumberNode(String.valueOf(scalar.getDouble()), tokenIndex);
-                            } else if (scalar.type == RuntimeScalarType.STRING) {
+                            } else if (scalar.type == RuntimeScalarType.STRING
+                                    || scalar.type == RuntimeScalarType.BYTE_STRING) {
                                 return new StringNode(scalar.toString(), tokenIndex);
                             } else if (scalar.type == RuntimeScalarType.UNDEF) {
                                 return new OperatorNode("undef", null, tokenIndex);

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

@@ -104,23 +104,30 @@ static Node parseSpecialBlock(Parser parser) {
             parser.ctx.symbolTable.addVariable("$self", "my", null);
         }
 
-        // Parse the block content
-        BlockNode block = ParseBlock.parseBlock(parser);
+        // Special blocks introduce a lexical compile-time scope for %^H just
+        // like ordinary blocks.  In particular, modules can install a guard
+        // object in %^H from BEGIN and rely on its DESTROY method when the
+        // special block ends.
+        HintHashRegistry.enterScope();
+        BlockNode block;
+        try {
+            // Parse the block content
+            block = ParseBlock.parseBlock(parser);
 
-        // Restore the isInMethod flag and exit ADJUST scope
-        if (adjustScopeIndex >= 0) {
-            parser.ctx.symbolTable.exitScope(adjustScopeIndex);
-        }
-        parser.isInMethod = wasInMethod;
+            // Restore the isInMethod flag and exit ADJUST scope
+            if (adjustScopeIndex >= 0) {
+                parser.ctx.symbolTable.exitScope(adjustScopeIndex);
+            }
+            parser.isInMethod = wasInMethod;
 
-        // Consume the closing brace '}'
-        TokenUtils.consume(parser, LexerTokenType.OPERATOR, "}");
+            // Consume the closing brace '}'
+            TokenUtils.consume(parser, LexerTokenType.OPERATOR, "}");
 
-        // Before executing BEGIN blocks, process any pending heredocs.
+            // Before executing BEGIN blocks, process any pending heredocs.
         // This handles cases like: BEGIN { eval <<'END' } ... \n heredoc content \n END
         // The heredoc content comes after the newline, but BEGIN must execute immediately.
         // We need to fill in the heredoc content before BEGIN tries to use it.
-        if ("BEGIN".equals(blockName) && !parser.getHeredocNodes().isEmpty()) {
+            if ("BEGIN".equals(blockName) && !parser.getHeredocNodes().isEmpty()) {
             if (CompilerOptions.DEBUG_ENABLED) parser.ctx.logDebug("HEREDOC_BEGIN_FIX: Found " + parser.getHeredocNodes().size() + " pending heredocs after BEGIN block");
             int savedIndex = parser.tokenIndex;
             // Find the next NEWLINE token
@@ -143,11 +150,11 @@ static Node parseSpecialBlock(Parser parser) {
                 // Restore tokenIndex to continue parsing from after the '}'
                 parser.tokenIndex = savedIndex;
             }
-        }
+            }
 
         // ADJUST blocks in class context are not executed at parse time
         // They are compiled as anonymous subs and stored for the constructor
-        if ("ADJUST".equals(blockName) && parser.isInClassBlock) {
+            if ("ADJUST".equals(blockName) && parser.isInClassBlock) {
 
             // Create an anonymous sub that captures lexical variables
             SubroutineNode adjustSub = new SubroutineNode(
@@ -162,11 +169,14 @@ static Node parseSpecialBlock(Parser parser) {
             parser.classAdjustBlocks.add(adjustSub);
 
             // Return the anonymous sub node (won't be executed now)
-            return adjustSub;
-        }
+                return adjustSub;
+            }
 
         // Execute other special blocks normally
-        runSpecialBlock(parser, blockName, block);
+            runSpecialBlock(parser, blockName, block);
+        } finally {
+            HintHashRegistry.exitScope();
+        }
 
         // After a BEGIN block runs, propagate any compile-time state changes the
         // block made (e.g. `BEGIN { unimport warnings qw(File::Find) }`) to the

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

@@ -9,6 +9,7 @@
 import org.perlonjava.backend.jvm.EmitterContext;
 import org.perlonjava.backend.jvm.EmitterMethodCreator;
 import org.perlonjava.backend.jvm.JavaClassInfo;
+import org.perlonjava.frontend.analysis.ConstantFoldingVisitor;
 import org.perlonjava.frontend.astnode.*;
 import org.perlonjava.frontend.lexer.LexerToken;
 import org.perlonjava.frontend.lexer.LexerTokenType;
@@ -1673,6 +1674,15 @@ public static ListNode handleNamedSubWithFilter(Parser parser, String subName, S
             placeholder.setLexicalDisabledWarningCategories(names);
         }
 
+        // Named sub bodies are materialized lazily.  Capture constant-CV calls
+        // now, while the parser has just executed any preceding BEGIN block.
+        // Otherwise a later glob replacement can hide a lexical constant before
+        // the body is first compiled, which differs from Perl's optree behavior.
+        Node foldedBody = ConstantFoldingVisitor.foldConstants(
+                block, parser.ctx.symbolTable.getCurrentPackage());
+        BlockNode compilationBlock = foldedBody instanceof BlockNode folded
+                ? folded : block;
+
         // Clone warning flags (critical for 'no warnings' pragmas)
         filteredSnapshot.warningFlagsStack.pop(); // Remove the initial value pushed by enterScope
         filteredSnapshot.warningFlagsStack.push(definitionWarningFlags);
@@ -1720,10 +1730,10 @@ public static ListNode handleNamedSubWithFilter(Parser parser, String subName, S
             }
             // Try unified API (returns RuntimeCode - either CompiledCode or InterpretedCode)
             if (placeholder.attributes != null && placeholder.attributes.contains("lvalue")) {
-                block.setAnnotation("subroutineIsLvalue", true);
+                compilationBlock.setAnnotation("subroutineIsLvalue", true);
             }
             RuntimeCode runtimeCode =
-                    EmitterMethodCreator.createRuntimeCode(newCtx, block, false);
+                    EmitterMethodCreator.createRuntimeCode(newCtx, compilationBlock, false);
 
             Map<String, String> compiledOurRegistry = runtimeCode.ourVariableRegistry;
             if (compiledOurRegistry == null || compiledOurRegistry.isEmpty()) {
@@ -1812,7 +1822,8 @@ public static ListNode handleNamedSubWithFilter(Parser parser, String subName, S
                 if (showFallback) {
                     System.err.println("Note: JVM VerifyError during subroutine instantiation, recompiling with interpreter.");
                 }
-                InterpretedCode interpretedCode = EmitterMethodCreator.compileToInterpreter(block, newCtx, false);
+                InterpretedCode interpretedCode = EmitterMethodCreator.compileToInterpreter(
+                        compilationBlock, newCtx, false);
 
                 // Set captured variables if there are any
                 List<Object> materializedCaptures = closureCapturesForMaterialization(
@@ -1863,6 +1874,13 @@ public static ListNode handleNamedSubWithFilter(Parser parser, String subName, S
         RuntimeCode placeholderForSupplier = (RuntimeCode) codeRef.value;
         placeholderForSupplier.compilerSupplier = subroutineCreationTaskSupplier;
 
+        boolean hasVisibleConstantCv = GlobalVariable.globalCodeRefs.values().stream()
+                .anyMatch(scalar -> scalar.value instanceof RuntimeCode code
+                        && code.constantValue != null);
+        if (hasVisibleConstantCv) {
+            subroutineCreationTaskSupplier.get();
+        }
+
         ListNode result = new ListNode(parser.tokenIndex);
         result.setAnnotation("compileTimeOnly", true);
         return result;
@@ -2104,6 +2122,19 @@ private static SubroutineNode handleAnonSub(Parser parser, String subName, Strin
         SubroutineNode node =
                 new SubroutineNode(subName, prototype, attributes, block, false, currentIndex,
                         sourceEndTokenIndex);
+        Node constantBody = block.elements.size() == 1 ? block.elements.get(0) : null;
+        while (constantBody instanceof ListNode list && list.handle == null
+                && list.elements.size() == 1) {
+            constantBody = list.elements.get(0);
+        }
+        boolean scalarLexicalBody = constantBody instanceof IdentifierNode
+                || (constantBody instanceof OperatorNode op
+                    && "$".equals(op.operator)
+                    && op.operand instanceof IdentifierNode);
+        if (prototype != null && (prototype.isEmpty() || "()".equals(prototype))
+                && scalarLexicalBody) {
+            node.setAnnotation("simpleLexicalConstantCandidate", true);
+        }
         if (attributes != null && hasNonBuiltinCodeAttribute(attributes)) {
             RuntimeCode placeholder = new RuntimeCode(prototype, new ArrayList<>(attributes));
             placeholder.packageName = parser.ctx.symbolTable.getCurrentPackage();

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

@@ -2,6 +2,7 @@
 
 import org.perlonjava.runtime.runtimetypes.GlobalContext;
 import org.perlonjava.runtime.runtimetypes.GlobalVariable;
+import org.perlonjava.runtime.runtimetypes.MortalList;
 import org.perlonjava.runtime.runtimetypes.PerlRuntime;
 import org.perlonjava.runtime.runtimetypes.RuntimeHash;
 import org.perlonjava.runtime.runtimetypes.RuntimeScalar;
@@ -57,10 +58,11 @@ public static void exitScope() {
             Map<String, RuntimeScalar> savedState = stack.pop();
             // Restore global %^H to the state saved when we entered this scope
             RuntimeHash hintHash = GlobalVariable.getGlobalHash(GlobalContext.encodeSpecialVar("H"));
-            hintHash.elements.clear();
-            for (Map.Entry<String, RuntimeScalar> entry : savedState.entrySet()) {
-                hintHash.elements.put(entry.getKey(), new RuntimeScalar(entry.getValue()));
-            }
+            restoreHintHash(hintHash, savedState);
+            // %^H scope guards implement compile-time callbacks in DESTROY.
+            // They must run before parsing/executing the next statement, not
+            // at the interpreter's later top-level mortal sweep.
+            MortalList.flush();
         }
     }
 
@@ -225,6 +227,34 @@ public static Map<String, RuntimeScalar> getCurrentCallSiteScalarHintHash() {
         return copy;
     }
 
+    /**
+     * Restores a saved compile-time hints hash while releasing values created
+     * by the nested compilation.  Hint values may be blessed guards whose
+     * DESTROY method implements an end-of-scope callback (for example
+     * Object::HashBase's deferred Role::Tiny composition).
+     */
+    public static void restoreHintHash(RuntimeHash active, Map<String, RuntimeScalar> saved) {
+        List<RuntimeScalar> discarded = new ArrayList<>();
+        List<String> discardedKeys = new ArrayList<>();
+        for (Map.Entry<String, RuntimeScalar> entry : active.elements.entrySet()) {
+            RuntimeScalar retained = saved.get(entry.getKey());
+            RuntimeScalar current = entry.getValue();
+            if (retained == null || retained.type != current.type || retained.value != current.value) {
+                discarded.add(current);
+                discardedKeys.add(entry.getKey());
+            }
+        }
+        MortalList.deferDestroyForContainerClear(discarded);
+        for (String key : discardedKeys) {
+            active.elements.remove(key);
+        }
+        for (Map.Entry<String, RuntimeScalar> entry : saved.entrySet()) {
+            if (!active.elements.containsKey(entry.getKey())) {
+                active.elements.put(entry.getKey(), entry.getValue());
+            }
+        }
+    }
+
     /**
      * Clears all state.
      * Called by PerlLanguageProvider.resetAll() during reinitialization.

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

@@ -324,7 +324,16 @@ public static int getCallerHintsAtFrame(int frame) {
      * @param hintHash A snapshot of the %^H hash elements
      */
     public static void setCallSiteHintHash(java.util.Map<String, org.perlonjava.runtime.runtimetypes.RuntimeScalar> hintHash) {
-        state().callSiteHintHash = hintHash != null ? new java.util.HashMap<>(hintHash) : new java.util.HashMap<>();
+        java.util.Map<String, org.perlonjava.runtime.runtimetypes.RuntimeScalar> snapshot =
+                new java.util.HashMap<>();
+        if (hintHash != null) {
+            for (java.util.Map.Entry<String, org.perlonjava.runtime.runtimetypes.RuntimeScalar> entry
+                    : hintHash.entrySet()) {
+                snapshot.put(entry.getKey(),
+                        new org.perlonjava.runtime.runtimetypes.RuntimeScalar(entry.getValue()));
+            }
+        }
+        state().callSiteHintHash = snapshot;
     }
 
     /**
@@ -342,7 +351,19 @@ public static void snapshotCurrentHintHash() {
      */
     public static void pushCallerHintHash() {
         CompilationRuntimeState state = state();
-        state.callerHintHashStack.push(new java.util.HashMap<>(state.callSiteHintHash));
+        state.callerHintHashStack.push(copyHintHash(state.callSiteHintHash));
+    }
+
+    private static java.util.Map<String, org.perlonjava.runtime.runtimetypes.RuntimeScalar> copyHintHash(
+            java.util.Map<String, org.perlonjava.runtime.runtimetypes.RuntimeScalar> source) {
+        java.util.Map<String, org.perlonjava.runtime.runtimetypes.RuntimeScalar> copy =
+                new java.util.HashMap<>();
+        for (java.util.Map.Entry<String, org.perlonjava.runtime.runtimetypes.RuntimeScalar> entry
+                : source.entrySet()) {
+            copy.put(entry.getKey(),
+                    new org.perlonjava.runtime.runtimetypes.RuntimeScalar(entry.getValue()));
+        }
+        return copy;
     }
 
     /**