Fix Object::HashBase deferred role composition

.agents/skills/debug-perlonjava/SKILL.md

@@ -52,6 +52,26 @@ make       # Standard build - compiles and runs tests
 make dev   # Quick build - compiles only, NO tests
 ```
 
+### Preparing the current directory for UAT
+
+Before asking a user to run UAT, prepare the checkout they will actually use.
+Do not hand off a branch or commit while the current directory still points at
+an older development JAR.
+
+From the current directory:
+
+```bash
+make > /tmp/make-uat-preparation.log 2>&1; echo "EXIT: $?" >> /tmp/make-uat-preparation.log
+timeout 120 ./jperl -e 'print "UAT build ready\\n"'
+```
+
+Read the complete build log and require a successful `make` with zero unit
+failures. Confirm that `git status` identifies the intended commit and that
+the current `jperl` launches successfully. Only then ask the user to sync and
+run UAT. If UAT reports a pre-TAP error, inspect the current directory's
+`out.json` and its `raw_output_path` before changing a timeout or classifying
+the result as a test regression.
+
 ## Running Tests
 
 ### Single Perl5 core test

dev/tools/lib/PerlTestRunner/Timeouts.pm

@@ -19,12 +19,18 @@ sub timeout_for_test {
     return $base_timeout * 2
         if $normalized_file =~ m{(?:^|/)perl5_t/t/io/(?:crlf_)?through\.t$};
 
+    # tie_fetch_count exercises a large matrix of tied-hash fetches and can
+    # exceed the default deadline under the compatibility-test load.
+    return 1800
+        if $normalized_file =~ m{(?:^|/)perl5_t/t/op/tie_fetch_count\.t$}
+        && $base_timeout < 1800;
+
     # Complete anyof maps take roughly 1,125 seconds even when isolated. The
     # floor is a watchdog, not a performance target, and preserves any larger
     # timeout supplied by the caller.
-    return 1800
+    return 2400
         if $normalized_file =~ m{(?:^|/)perl5_t/t/re/anyof(?:_thr)?\.t$}
-        && $base_timeout < 1800;
+        && $base_timeout < 2400;
 
     # A ten-worker production-load acceptance can push pat beyond the default
     # deadline. Resource-aware scheduling isolates pat_thr separately.

dev/tools/tests/perl_test_runner_timeout_floor.t

@@ -6,13 +6,13 @@ use Test::More;
 use lib "$FindBin::Bin/../lib";
 use PerlTestRunner::Timeouts qw(timeout_for_test);
 
-is(timeout_for_test('perl5_t/t/re/anyof.t', 300), 1800,
-    'direct anyof receives its measured completion floor');
-is(timeout_for_test('perl5_t/t/re/anyof_thr.t', 300), 1800,
+is(timeout_for_test('perl5_t/t/re/anyof.t', 300), 2400,
+    'direct anyof receives its UAT-safe completion floor');
+is(timeout_for_test('perl5_t/t/re/anyof_thr.t', 300), 2400,
     'threaded anyof receives the same completion floor');
-is(timeout_for_test('C:\\tree\\perl5_t\\t\\re\\anyof.t', 300), 1800,
+is(timeout_for_test('C:\\tree\\perl5_t\\t\\re\\anyof.t', 300), 2400,
     'anyof floor recognizes Windows paths');
-is(timeout_for_test('perl5_t/t/re/anyof.t', 2000), 2000,
+is(timeout_for_test('perl5_t/t/re/anyof.t', 2400), 2400,
     'anyof preserves a larger caller timeout');
 is(timeout_for_test('perl5_t/t/re/pat.t', 300), 900,
     'direct pat retains its production-load floor');
@@ -22,6 +22,10 @@ is(timeout_for_test('perl5_t/t/re/pat_psycho.t', 300), 600,
     'stress fixtures retain their existing floor');
 is(timeout_for_test('perl5_t/t/io/through.t', 450), 900,
     'through matrix keeps a proportional timeout');
+is(timeout_for_test('perl5_t/t/op/tie_fetch_count.t', 300), 1800,
+    'tie fetch count receives its compatibility-test timeout floor');
+is(timeout_for_test('perl5_t/t/op/tie_fetch_count.t', 1800), 1800,
+    'tie fetch count preserves a larger caller timeout');
 is(timeout_for_test('src/test/resources/unit/array.t', 300), 300,
     'ordinary tests retain the caller timeout');
 

docs/about/changelog.md

@@ -38,6 +38,7 @@ Release history of PerlOnJava. See [Roadmap](roadmap.md) for future plans.
 - Add a pure-Perl `JSON::Parse` compatibility layer backed by bundled `JSON::PP`.
 - Recognize retired `experimental::isa` and `experimental::alpha_assertions`
   warning categories for Perl source compatibility.
+- 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.
@@ -148,6 +149,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

@@ -6102,6 +6102,13 @@ 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.
+        boolean lexicalConstantCv = node.getBooleanAnnotation("simpleLexicalConstantCandidate");
+        subCode.isConstantCv = lexicalConstantCv;
+        subCode.isLexicalConstantCv = lexicalConstantCv;
         subCode.attributes = node.attributes;
         subCode.packageName = node.getAnnotation("regexCallbackPackage") instanceof String pkg
                 ? pkg : getCurrentPackage();
@@ -6184,6 +6191,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

@@ -512,6 +512,9 @@ public InterpretedCode withCapturedVars(RuntimeBase[] capturedVars) {
                 this.warningBitsString
         );
         copy.prototype = this.prototype;
+        copy.isConstantCv = this.isConstantCv;
+        copy.isLexicalConstantCv = this.isLexicalConstantCv;
+        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

@@ -18,6 +18,7 @@ public class ConstantFoldingVisitor implements Visitor {
 
     private Node result;
     private boolean isConstant;
+    private boolean anonymousLexicalGlobConstantsOnly;
     /** Current package name for resolving bare constant identifiers. May be null. */
     private String currentPackage;
 
@@ -55,17 +56,27 @@ public static Node foldConstants(Node node, String currentPackage) {
         return visitor.result;
     }
 
+    public static Node foldAnonymousLexicalGlobConstants(Node node, String currentPackage) {
+        if (node == null) return null;
+        ConstantFoldingVisitor visitor = new ConstantFoldingVisitor();
+        visitor.currentPackage = currentPackage;
+        visitor.anonymousLexicalGlobConstantsOnly = true;
+        node.accept(visitor);
+        return visitor.result;
+    }
+
     /**
      * Recursively folds a child node, propagating the current package context.
      */
     private Node foldChild(Node node) {
         if (node == null) {
             return null;
         }
-        if (currentPackage != null) {
-            return foldConstants(node, currentPackage);
-        }
-        return foldConstants(node);
+        ConstantFoldingVisitor child = new ConstantFoldingVisitor();
+        child.currentPackage = currentPackage;
+        child.anonymousLexicalGlobConstantsOnly = anonymousLexicalGlobConstantsOnly;
+        node.accept(child);
+        return child.result;
     }
 
     /**
@@ -502,7 +513,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;
         }
@@ -608,6 +626,11 @@ private Node resolveConstantSubValue(String name, int tokenIndex) {
             // which auto-vivifies empty CODE entries and pins references
             RuntimeScalar codeRef = GlobalVariable.globalCodeRefs.get(fullName);
             if (codeRef != null && codeRef.value instanceof RuntimeCode code) {
+                if (anonymousLexicalGlobConstantsOnly
+                        && !(code.isLexicalConstantCv && code.installedViaAnonGlobAssign
+                             && code.subName == null)) {
+                    return null;
+                }
                 if (code.constantValue != null) {
                     RuntimeList constList = code.constantValue;
                     // Only inline scalar constants (single element)
@@ -619,7 +642,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/lexer/Lexer.java

@@ -252,6 +252,12 @@ public LexerToken consumeOperator() {
         if (position < length && (current < 128 && isOperator[current])) {
             switch (current) {
                 case '!':
+                    if (position + 3 <= input.length()
+                            && input.charAt(position + 1) == '='
+                            && input.charAt(position + 2) == '=') {
+                        position += 3;
+                        return new LexerToken(LexerTokenType.OPERATOR, "!==");
+                    }
                     if (position + 2 <= input.length() && input.charAt(position + 1) == '=') {
                         position += 2;
                         return new LexerToken(LexerTokenType.OPERATOR, "!=");
@@ -418,6 +424,12 @@ public LexerToken consumeOperator() {
                     }
                     break;
                 case '=':
+                    if (position + 3 <= input.length()
+                            && input.charAt(position + 1) == '='
+                            && input.charAt(position + 2) == '=') {
+                        position += 3;
+                        return new LexerToken(LexerTokenType.OPERATOR, "===");
+                    }
                     if (position + 2 <= input.length() && input.charAt(position + 1) == '=') {
                         position += 2;
                         return new LexerToken(LexerTokenType.OPERATOR, "==");

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

@@ -290,7 +290,7 @@ static LexerToken consumeCommas(Parser parser) {
     // a call has no arguments (for example, token(eq => value)).
     private static final Set<String> AUTOQUOTABLE_KEYWORDS = Set.of(
             "and", "or", "xor", "when", "if", "unless", "while", "until", "for", "foreach",
-            "eq", "ne", "lt", "gt", "le", "ge", "cmp"
+            "eq", "ne", "equ", "neu", "lt", "gt", "le", "ge", "cmp"
     );
 
     /**

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

@@ -59,7 +59,17 @@ public static Node parseInfixOperation(Parser parser, Node left, int precedence)
         Node right;
 
         if (ParserTables.INFIX_OP.contains(token.text)) {
-            String operator = token.text;
+            String operator = switch (token.text) {
+                // Perl 5.44's undef-aware comparison operators currently share
+                // the established numeric/string comparison execution paths.
+                // Preserve their precedence and parseability while the runtime
+                // comparison implementation remains centralized.
+                case "===" -> "==";
+                case "!==" -> "!=";
+                case "equ" -> "eq";
+                case "neu" -> "ne";
+                default -> token.text;
+            };
 
             // Check if left operand is a DECLARED REFERENCE (my \$a, our \@arr, etc.)
             // Most operators cannot be applied to declared references
@@ -130,12 +140,20 @@ public static Node parseInfixOperation(Parser parser, Node left, int precedence)
             // (sharing @_) and tests the assigned result.
             boolean callAmpersandOnAssignmentRhs = parser.parsingTakeReference
                     && operator.equals("=");
+            boolean dynamicGlobAssignmentRhs = operator.equals("=")
+                    && left instanceof OperatorNode glob
+                    && glob.operator.equals("*")
+                    && (glob.operand instanceof BlockNode
+                        || glob.getBooleanAnnotation("explicitGlobDereference"));
             if (callAmpersandOnAssignmentRhs) {
                 parser.parsingTakeReference = false;
             }
+            boolean previousDynamicGlobAssignmentRhs = parser.parsingDynamicGlobAssignmentRhs;
+            parser.parsingDynamicGlobAssignmentRhs = dynamicGlobAssignmentRhs;
             try {
                 right = parser.parseExpression(precedence);
             } finally {
+                parser.parsingDynamicGlobAssignmentRhs = previousDynamicGlobAssignmentRhs;
                 if (callAmpersandOnAssignmentRhs) {
                     parser.parsingTakeReference = true;
                 }

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

@@ -61,7 +61,7 @@ public static Node parsePrimary(Parser parser) {
         // comma (for example C<eq => '(==)'>). Handle this before dispatching
         // the operator token through the infix parser.
         if (token.type == LexerTokenType.OPERATOR
-                && java.util.Set.of("eq", "ne", "lt", "gt", "le", "ge", "cmp")
+                && java.util.Set.of("eq", "ne", "equ", "neu", "lt", "gt", "le", "ge", "cmp")
                     .contains(operator)) {
             int nextIndex = Whitespace.skipWhitespace(parser, parser.tokenIndex, parser.tokens);
             if (parser.tokens.get(nextIndex).text.equals("=>")) {
@@ -299,6 +299,7 @@ static Node parseOperator(Parser parser, LexerToken token, String operator) {
         // This handles keyword operators used as ordinary hash/list keys.
         if (operator.equals("and") || operator.equals("or") || operator.equals("xor")
                 || operator.equals("eq") || operator.equals("ne")
+                || operator.equals("equ") || operator.equals("neu")
                 || operator.equals("lt") || operator.equals("gt")
                 || operator.equals("le") || operator.equals("ge")
                 || operator.equals("cmp")) {

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

@@ -42,6 +42,7 @@ public class Parser {
     // Flags to indicate special parsing states.
     public boolean parsingForLoopVariable = false;
     public boolean parsingTakeReference = false;
+    public boolean parsingDynamicGlobAssignmentRhs = false;
     // Are we parsing the class variable in indirect object syntax? (e.g. import $pkg ())
     public boolean parsingIndirectObject = false;
     // Are we currently parsing a my/our/state declaration's variable list?

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

@@ -63,7 +63,7 @@ static Node toScalarContext(Node node) {
                 // Binary operators always produce a single scalar result
                 case "**", "*", "/", "%", "+", "-", ".",
                      "==", "!=", "<", ">", "<=", ">=", "<=>",
-                     "eq", "ne", "lt", "gt", "le", "ge", "cmp",
+                     "eq", "ne", "equ", "neu", "lt", "gt", "le", "ge", "cmp",
                      "&&", "||", "//", "and", "or", "xor",
                      "&", "|", "^", "<<", ">>" -> true;