diff --git a/dev/tools/lib/PerlTestRunner/Timeouts.pm b/dev/tools/lib/PerlTestRunner/Timeouts.pm index 06a925752d..6faf4617dc 100644 --- a/dev/tools/lib/PerlTestRunner/Timeouts.pm +++ b/dev/tools/lib/PerlTestRunner/Timeouts.pm @@ -19,6 +19,12 @@ 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 600 + if $normalized_file =~ m{(?:^|/)perl5_t/t/op/tie_fetch_count\.t$} + && $base_timeout < 600; + # 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. diff --git a/dev/tools/tests/perl_test_runner_timeout_floor.t b/dev/tools/tests/perl_test_runner_timeout_floor.t index 2338ed5bc8..e060a23ec3 100644 --- a/dev/tools/tests/perl_test_runner_timeout_floor.t +++ b/dev/tools/tests/perl_test_runner_timeout_floor.t @@ -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), 600, + 'tie fetch count receives its compatibility-test timeout floor'); +is(timeout_for_test('perl5_t/t/op/tie_fetch_count.t', 900), 900, + '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'); diff --git a/docs/about/changelog.md b/docs/about/changelog.md index d1746669a9..fa18d33c8f 100644 --- a/docs/about/changelog.md +++ b/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 diff --git a/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java b/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java index 23c58dae96..53e9969f8a 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java +++ b/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java @@ -6098,6 +6098,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(); @@ -6180,6 +6187,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; diff --git a/src/main/java/org/perlonjava/backend/bytecode/EvalStringHandler.java b/src/main/java/org/perlonjava/backend/bytecode/EvalStringHandler.java index 03399e8272..820ccebf2f 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/EvalStringHandler.java +++ b/src/main/java/org/perlonjava/backend/bytecode/EvalStringHandler.java @@ -283,7 +283,7 @@ private static RuntimeList evalStringList(String perlCode, Map 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(); diff --git a/src/main/java/org/perlonjava/backend/bytecode/InterpretedCode.java b/src/main/java/org/perlonjava/backend/bytecode/InterpretedCode.java index 9c6ac87640..f0ab1732bf 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/InterpretedCode.java +++ b/src/main/java/org/perlonjava/backend/bytecode/InterpretedCode.java @@ -508,6 +508,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; diff --git a/src/main/java/org/perlonjava/backend/bytecode/OpcodeHandlerExtended.java b/src/main/java/org/perlonjava/backend/bytecode/OpcodeHandlerExtended.java index c9610ad041..0baa511031 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/OpcodeHandlerExtended.java +++ b/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 diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java b/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java index fb3166b5db..743040b976 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java +++ b/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; diff --git a/src/main/java/org/perlonjava/frontend/analysis/ConstantFoldingVisitor.java b/src/main/java/org/perlonjava/frontend/analysis/ConstantFoldingVisitor.java index 2170cd9d87..c5181e8df1 100644 --- a/src/main/java/org/perlonjava/frontend/analysis/ConstantFoldingVisitor.java +++ b/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,6 +56,15 @@ 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. */ @@ -62,10 +72,11 @@ 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); diff --git a/src/main/java/org/perlonjava/frontend/parser/ParseInfix.java b/src/main/java/org/perlonjava/frontend/parser/ParseInfix.java index 49c547a57b..70c5d5af42 100644 --- a/src/main/java/org/perlonjava/frontend/parser/ParseInfix.java +++ b/src/main/java/org/perlonjava/frontend/parser/ParseInfix.java @@ -130,12 +130,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; } diff --git a/src/main/java/org/perlonjava/frontend/parser/Parser.java b/src/main/java/org/perlonjava/frontend/parser/Parser.java index e5f46da12c..93271763ed 100644 --- a/src/main/java/org/perlonjava/frontend/parser/Parser.java +++ b/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? diff --git a/src/main/java/org/perlonjava/frontend/parser/SpecialBlockParser.java b/src/main/java/org/perlonjava/frontend/parser/SpecialBlockParser.java index 219a45a410..1504c96622 100644 --- a/src/main/java/org/perlonjava/frontend/parser/SpecialBlockParser.java +++ b/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.exitSpecialBlockScope(); + } // After a BEGIN block runs, propagate any compile-time state changes the // block made (e.g. `BEGIN { unimport warnings qw(File::Find) }`) to the diff --git a/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java b/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java index 33d03982b5..0611619b99 100644 --- a/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java +++ b/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,13 @@ public static ListNode handleNamedSubWithFilter(Parser parser, String subName, S placeholder.setLexicalDisabledWarningCategories(names); } + // Preserve only the lexical constant-CV form installed through an + // anonymous glob during a preceding BEGIN. This excludes ordinary + // anonymous callbacks such as overload handlers. + Node foldedBody = ConstantFoldingVisitor.foldAnonymousLexicalGlobConstants( + 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 +1728,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 compiledOurRegistry = runtimeCode.ourVariableRegistry; if (compiledOurRegistry == null || compiledOurRegistry.isEmpty()) { @@ -1812,7 +1820,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 materializedCaptures = closureCapturesForMaterialization( @@ -2104,6 +2113,24 @@ 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); + } + IdentifierNode lexicalIdentifier = constantBody instanceof IdentifierNode id ? id + : constantBody instanceof OperatorNode op && "$".equals(op.operator) + && op.operand instanceof IdentifierNode id ? id : null; + boolean scalarLexicalBody = lexicalIdentifier != null + && (parser.ctx.symbolTable.getVariableIndex(lexicalIdentifier.name) >= 0 + || parser.ctx.symbolTable.getVariableIndex("$" + lexicalIdentifier.name) >= 0); + if (prototype != null && (prototype.isEmpty() || "()".equals(prototype)) + && scalarLexicalBody) { + node.setAnnotation("simpleLexicalConstantCandidate", true); + if (parser.parsingDynamicGlobAssignmentRhs) { + node.setAnnotation("dynamicGlobAssignment", true); + } + } if (attributes != null && hasNonBuiltinCodeAttribute(attributes)) { RuntimeCode placeholder = new RuntimeCode(prototype, new ArrayList<>(attributes)); placeholder.packageName = parser.ctx.symbolTable.getCurrentPackage(); diff --git a/src/main/java/org/perlonjava/frontend/parser/Variable.java b/src/main/java/org/perlonjava/frontend/parser/Variable.java index bb66b613d5..72d17ed511 100644 --- a/src/main/java/org/perlonjava/frontend/parser/Variable.java +++ b/src/main/java/org/perlonjava/frontend/parser/Variable.java @@ -266,11 +266,21 @@ && isFieldInClassHierarchy(parser, varName) SymbolTable.SymbolEntry lexicalExport = getLexicalExportEntry(parser, sigil, varName); if (lexicalExport != null) { String qualifiedName = lexicalExport.perlPackage() + "::" + varName; - return new OperatorNode(sigil, new IdentifierNode(qualifiedName, parser.tokenIndex), parser.tokenIndex); + OperatorNode result = new OperatorNode(sigil, + new IdentifierNode(qualifiedName, parser.tokenIndex), parser.tokenIndex); + if (sigil.equals("*")) { + result.setAnnotation("explicitGlobDereference", true); + } + return result; } // Normal variable: create a simple variable reference node - return new OperatorNode(sigil, new IdentifierNode(varName, parser.tokenIndex), parser.tokenIndex); + OperatorNode result = new OperatorNode(sigil, + new IdentifierNode(varName, parser.tokenIndex), parser.tokenIndex); + if (sigil.equals("*")) { + result.setAnnotation("explicitGlobDereference", true); + } + return result; } else if (peek(parser).text.equals("{")) { // Handle curly brackets - use parseBracedVariable instead of parseBlock return parseBracedVariable(parser, sigil, false); @@ -1248,7 +1258,11 @@ public static Node parseBracedVariable(Parser parser, String sigil, boolean isSt // Without this check, *{expr} would be incorrectly unwrapped like *F if (operatorNode.operand instanceof IdentifierNode identifierNode) { identifierNode.name = NameNormalizer.normalizeVariableName(identifierNode.name, parser.ctx.symbolTable.getCurrentPackage()); - return new OperatorNode(sigil, operatorNode.operand, parser.tokenIndex); + OperatorNode dereference = new OperatorNode(sigil, operatorNode.operand, parser.tokenIndex); + if (sigil.equals("*")) { + dereference.setAnnotation("explicitGlobDereference", true); + } + return dereference; } // When operand is NOT an IdentifierNode (e.g., it's a block like {expr}), // fall through to return the full block as the dereference target diff --git a/src/main/java/org/perlonjava/runtime/HintHashRegistry.java b/src/main/java/org/perlonjava/runtime/HintHashRegistry.java index e08e670912..fc227ba7ff 100644 --- a/src/main/java/org/perlonjava/runtime/HintHashRegistry.java +++ b/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,11 +58,44 @@ public static void exitScope() { Map 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 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(); + } + } + + /** + * Leaves a special compile-time block. Pragmas installed by a BEGIN block + * are visible to the surrounding lexical scope, while reference-valued + * entries are scope guards and must be released at the block boundary. + */ + public static void exitSpecialBlockScope() { + Deque> stack = state().hintCompileTimeStack; + if (stack.isEmpty()) { + return; + } + Map savedState = stack.pop(); + RuntimeHash hintHash = GlobalVariable.getGlobalHash(GlobalContext.encodeSpecialVar("H")); + Map pragmaUpdates = new HashMap<>(); + for (Map.Entry entry : hintHash.elements.entrySet()) { + RuntimeScalar old = savedState.get(entry.getKey()); + RuntimeScalar value = entry.getValue(); + boolean changed = old == null || old.type != value.type || old.value != value.value; + // CODE-valued hints are compile-time pragma handlers (for example + // overload::constant and lexical charnames), not scope guards. + // They must remain visible in the enclosing lexical scope. Other + // reference-valued hints are the temporary guard objects whose + // lifetime ends with the BEGIN block. + if (changed && (value.type == org.perlonjava.runtime.runtimetypes.RuntimeScalarType.CODE + || !org.perlonjava.runtime.runtimetypes.RuntimeScalarType.isReference(value))) { + pragmaUpdates.put(entry.getKey(), new RuntimeScalar(value)); } } + restoreHintHash(hintHash, savedState); + hintHash.elements.putAll(pragmaUpdates); + MortalList.flush(); } /** @@ -225,6 +259,34 @@ public static Map 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 saved) { + List discarded = new ArrayList<>(); + List discardedKeys = new ArrayList<>(); + for (Map.Entry 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 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. diff --git a/src/main/java/org/perlonjava/runtime/WarningBitsRegistry.java b/src/main/java/org/perlonjava/runtime/WarningBitsRegistry.java index f13a397c79..aab53fb8f0 100644 --- a/src/main/java/org/perlonjava/runtime/WarningBitsRegistry.java +++ b/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 hintHash) { - state().callSiteHintHash = hintHash != null ? new java.util.HashMap<>(hintHash) : new java.util.HashMap<>(); + java.util.Map snapshot = + new java.util.HashMap<>(); + if (hintHash != null) { + for (java.util.Map.Entry 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 copyHintHash( + java.util.Map source) { + java.util.Map copy = + new java.util.HashMap<>(); + for (java.util.Map.Entry entry + : source.entrySet()) { + copy.put(entry.getKey(), + new org.perlonjava.runtime.runtimetypes.RuntimeScalar(entry.getValue())); + } + return copy; } /** diff --git a/src/main/java/org/perlonjava/runtime/mro/InheritanceResolver.java b/src/main/java/org/perlonjava/runtime/mro/InheritanceResolver.java index 602be25d58..19ae2310a2 100644 --- a/src/main/java/org/perlonjava/runtime/mro/InheritanceResolver.java +++ b/src/main/java/org/perlonjava/runtime/mro/InheritanceResolver.java @@ -247,6 +247,7 @@ public static void invalidateMethodLookupCachesForStashSubKey(String stashFqn) { String suffix = "::" + leaf; String suffixNoAutoload = suffix + "\0noautoload"; SHARED_SYMBOL_MUTATION_EPOCH.incrementAndGet(); + RuntimeCode.clearInlineMethodCache(); MroRuntimeState state = currentState(); state.methodCache().entrySet().removeIf(e -> { String k = e.getKey(); diff --git a/src/main/java/org/perlonjava/runtime/operators/ModuleOperators.java b/src/main/java/org/perlonjava/runtime/operators/ModuleOperators.java index e94ab6f679..070d9cfc00 100644 --- a/src/main/java/org/perlonjava/runtime/operators/ModuleOperators.java +++ b/src/main/java/org/perlonjava/runtime/operators/ModuleOperators.java @@ -4,6 +4,7 @@ import org.perlonjava.app.scriptengine.PerlLanguageProvider; import org.perlonjava.backend.bytecode.InterpreterState; import org.perlonjava.core.Configuration; +import org.perlonjava.runtime.HintHashRegistry; import org.perlonjava.runtime.perlmodule.BHooksEndOfScope; import org.perlonjava.runtime.perlmodule.Feature; import org.perlonjava.runtime.runtimetypes.*; @@ -725,7 +726,7 @@ else if (code == null) { Feature.setFeatureManager(new FeatureFlags()); // Clear the hints hash for a fresh compilation context - hintHash.elements.clear(); + hintHash.clearForHintHashContextTransfer(); result = PerlLanguageProvider.executePerlCode(parsedArgs, false, ctx); @@ -762,8 +763,7 @@ else if (code == null) { InterpreterState.currentPackage.get().set(savedPackage); // Restore the caller's hints hash - hintHash.elements.clear(); - hintHash.elements.putAll(savedHintHash); + HintHashRegistry.restoreHintHash(hintHash, savedHintHash); // Restore the caller's source-filter state (filters installed // inside the required file must not leak back to the caller). diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalContext.java b/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalContext.java index 36f4ef496f..6283a97902 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalContext.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalContext.java @@ -233,7 +233,7 @@ public static void initializeGlobals(CompilerOptions compilerOptions) { // Initialize hashes // %SIG uses a special hash that auto-qualifies handler names for known signals GlobalVariable.globalHashes.put("main::SIG", new RuntimeSigHash()); - GlobalVariable.getGlobalHash(encodeSpecialVar("H")); + GlobalVariable.getGlobalHash(encodeSpecialVar("H")).isHintHash = true; // These magic hashes are valid under strict vars but their stash slots // are created lazily on first access. GlobalVariable.declareGlobalHash("main::!"); diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalRuntimeHash.java b/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalRuntimeHash.java index b2a4da7c03..74289aaeef 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalRuntimeHash.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalRuntimeHash.java @@ -45,6 +45,7 @@ public void dynamicSaveState() { // Install a fresh empty hash in the global map RuntimeHash newLocal = new RuntimeHash(); + newLocal.isHintHash = original != null && original.isHintHash; GlobalVariable.globalHashes.put(fullName, newLocal); newLocal.isGlobalPackageHash = true; diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java index 33e6a48a7c..2357d96b98 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java @@ -1054,6 +1054,9 @@ public static void registerDisabledWarnings(String className, Set catego */ public boolean isConstantCv; + /** True for a parser-recognized `sub () { $lexical }` constant CV. */ + public boolean isLexicalConstantCv; + /** * When a coderef is installed with {@code *Package::name = $cr}, records the * stash slot FQN for method dispatch helpers without mutating @@ -1498,6 +1501,7 @@ public RuntimeCode cloneForClosure() { clone.deparseSourceOffset = this.deparseSourceOffset; clone.deparseSourceEnd = this.deparseSourceEnd; clone.isConstantCv = this.isConstantCv; + clone.isLexicalConstantCv = this.isLexicalConstantCv; clone.isStatic = this.isStatic; clone.isDeclared = this.isDeclared; clone.constantValue = this.constantValue; @@ -2066,6 +2070,7 @@ public void adoptDefinitionFrom(RuntimeCode codeFrom) { this.deparseSourceOffset = codeFrom.deparseSourceOffset; this.deparseSourceEnd = codeFrom.deparseSourceEnd; this.isConstantCv = codeFrom.isConstantCv; + this.isLexicalConstantCv = codeFrom.isLexicalConstantCv; this.stashInstallPackage = codeFrom.stashInstallPackage; this.stashInstallSub = codeFrom.stashInstallSub; this.hadStashRef = codeFrom.hadStashRef; @@ -2593,8 +2598,7 @@ public static Class evalStringHelper(RuntimeScalar code, String evalTag, Obje capturedSymbolTable.strictOptionsStack.push(savedStrictOptions); // Restore %^H (compile-time hints hash) to the caller snapshot. - capturedHintHash.elements.clear(); - capturedHintHash.elements.putAll(savedHintHash); + HintHashRegistry.restoreHintHash(capturedHintHash, savedHintHash); // Note: Scope restoration moved to outer finally block to handle cache hits @@ -2812,7 +2816,7 @@ public static RuntimeList evalStringWithInterpreter( Map lexicalHintHash = HintHashRegistry.getCurrentCallSiteScalarHintHash(); if (lexicalHintHash != null) { - activeHintHash.elements.clear(); + activeHintHash.clearForHintHashContextTransfer(); activeHintHash.elements.putAll(lexicalHintHash); } @@ -3276,8 +3280,7 @@ public static RuntimeList evalStringWithInterpreter( // Restore the original current scope, not the captured symbol table. // This prevents eval from leaking its compile-time scope to the caller. setCurrentScope(savedCurrentScope); - activeHintHash.elements.clear(); - activeHintHash.elements.putAll(savedHintHash); + HintHashRegistry.restoreHintHash(activeHintHash, savedHintHash); HintHashRegistry.setCallSiteHintHashId(savedCallSiteHintHashId); // Store source lines in debugger symbol table if $^P flags are set @@ -3486,6 +3489,16 @@ public static RuntimeScalar makeCodeObject( if (!capturedAggregates.isEmpty()) { code.capturedAggregates = capturedAggregates.toArray(new RuntimeBase[0]); } + + // A BEGIN-installed `sub () { $lexical }` is a Perl constant CV. The + // JVM emitter does not retain the anonymous-sub AST here, but it does + // retain the exact source span; recognize only this side-effect-free + // shape and freeze it after its lexical captures have been attached. + if ((deparseFlags & 0x40000000) != 0) { + code.isConstantCv = true; + code.isLexicalConstantCv = true; + code.cacheConstantCvValue(); + } if (!captured.isEmpty() || !capturedAggregates.isEmpty()) { // Enable refCount tracking for closures with captures. // When the CODE ref's refCount drops to 0, releaseCaptures() @@ -3503,6 +3516,25 @@ public static RuntimeScalar makeCodeObject( return codeRef; } + /** + * Freeze the value of a parser-recognized constant CV after its lexical + * captures have been attached. The resulting payload is what later source + * parsing consults for Perl's compile-time constant-sub inlining. + */ + public void cacheConstantCvValue() { + if (!isConstantCv || constantValue != null) { + return; + } + RuntimeList result = apply(new RuntimeArray(), RuntimeContextType.LIST); + RuntimeList frozen = new RuntimeList(); + for (RuntimeBase value : result.elements) { + frozen.elements.add(value instanceof RuntimeScalar scalar + ? new RuntimeScalar(scalar) : value); + } + constantValue = frozen; + } + + /** * Call a method in a Perl-like class hierarchy using the C3 linearization algorithm. * This version accepts a native RuntimeBase[] array for parameters. diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGlob.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGlob.java index f0836db38e..eb89f20eb6 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGlob.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGlob.java @@ -536,6 +536,13 @@ public RuntimeScalar set(RuntimeScalar value) { } } + // A BEGIN-installed `sub () { $lexical }` becomes a constant + // CV when it enters a glob slot. Freeze it before parsing + // continues so later named-sub bodies can inline its value. + if (value.value instanceof RuntimeCode newCode) { + newCode.cacheConstantCvValue(); + } + codeContainer.set(value); if (value.value instanceof RuntimeCode newCode) { diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGraphCloner.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGraphCloner.java index 8a02b3f2aa..412e026a4e 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGraphCloner.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGraphCloner.java @@ -363,6 +363,7 @@ private void copyCodeMetadata(RuntimeCode source, RuntimeCode target) { target.inheritsSelfReference = source.inheritsSelfReference; target.explicitlyRenamed = source.explicitlyRenamed; target.isConstantCv = source.isConstantCv; + target.isLexicalConstantCv = source.isLexicalConstantCv; target.stashInstallPackage = source.stashInstallPackage; target.stashInstallSub = source.stashInstallSub; target.hadStashRef = source.hadStashRef; diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeHash.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeHash.java index 03f5c9da78..720d149863 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeHash.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeHash.java @@ -34,6 +34,9 @@ private static Stack dynamicStateStack() { public int type; // Map to store the elements of the hash public Map elements; + /** True only for Perl's compile-time %^H hash. */ + public boolean isHintHash; + private boolean suppressHintHashLifecycleCleanup; // Set when this hash is installed as %ENV through a typeglob alias. // Perl rejects process execution before inspecting PATH in that case. public String taintEnvironmentAliasDescription; @@ -69,6 +72,20 @@ public RuntimeHash() { elements = newElementMap(); } + /** + * Clears %^H while an enclosing compilation context still owns its + * values. Nested require/eval uses this to start from empty hints without + * releasing the caller's lexical hint guards. + */ + public void clearForHintHashContextTransfer() { + suppressHintHashLifecycleCleanup = true; + try { + elements.clear(); + } finally { + suppressHintHashLifecycleCleanup = false; + } + } + private RuntimeHashElementMap newElementMap() { return new RuntimeHashElementMap(this); } @@ -142,6 +159,10 @@ public RuntimeScalar put(String key, RuntimeScalar value) { value = new RuntimeEnvironmentScalar(value); } RuntimeScalar previous = super.get(key); + if (owner.isHintHash && !owner.suppressHintHashLifecycleCleanup + && previous != null && previous != value) { + MortalList.deferDestroyForContainerClear(java.util.Collections.singletonList(previous)); + } owner.notePackageRootMutation(previous, value); if (value != null) value.markContainerOwner(owner); owner.markPackageRootedValue(value); @@ -179,6 +200,9 @@ public void putAll(Map m) { public RuntimeScalar remove(Object key) { RuntimeScalar previous = super.remove(key); if (previous != null) { + if (owner.isHintHash && !owner.suppressHintHashLifecycleCleanup) { + MortalList.deferDestroyForContainerClear(java.util.Collections.singletonList(previous)); + } owner.notePackageRootMutation(previous, null); } return previous; @@ -187,6 +211,9 @@ public RuntimeScalar remove(Object key) { @Override public void clear() { if (!isEmpty()) { + if (owner.isHintHash && !owner.suppressHintHashLifecycleCleanup) { + MortalList.deferDestroyForContainerClear(values()); + } owner.notePackageRootClear(values()); } super.clear(); @@ -1586,6 +1613,7 @@ public RuntimeArray setArrayOfAlias(RuntimeArray arr) { public void dynamicSaveState() { // Create a new RuntimeHash to save the current state RuntimeHash currentState = new RuntimeHash(); + currentState.isHintHash = this.isHintHash; currentState.elements = currentState.newElementMap(this.elements); currentState.blessId = this.blessId; currentState.byteKeys = this.byteKeys != null ? new HashSet<>(this.byteKeys) : null; @@ -1640,6 +1668,7 @@ public void dynamicRestoreState() { this.blessId = previousState.blessId; this.byteKeys = previousState.byteKeys; this.type = previousState.type; + this.isHintHash = previousState.isHintHash; } } diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeStashEntry.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeStashEntry.java index 3a5d409a88..18b2e0cf35 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeStashEntry.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeStashEntry.java @@ -201,6 +201,9 @@ public RuntimeScalar set(RuntimeScalar value) { return set(value.tiedFetch()); case CODE: RuntimeScalar codeContainer = GlobalVariable.defineGlobalCodeRef(this.globName); + if (value.value instanceof RuntimeCode code) { + code.cacheConstantCvValue(); + } if (!RuntimeGlob.fillForwardCodeRefInPlace(this.globName, codeContainer, value)) { codeContainer.set(value); if (value.value instanceof RuntimeCode code) { diff --git a/src/test/resources/unit/dynamic_constant_sub_inlining.t b/src/test/resources/unit/dynamic_constant_sub_inlining.t new file mode 100644 index 0000000000..49b8a83c35 --- /dev/null +++ b/src/test/resources/unit/dynamic_constant_sub_inlining.t @@ -0,0 +1,25 @@ +use strict; +use warnings; +use Test::More; + +BEGIN { + my $value = 'truthy'; + *DynamicConstant::VALUE = sub () { $value }; +} + +sub result_from_compile_time_constant { + return DynamicConstant::VALUE() ? 'inlined' : 'runtime'; +} + +{ + no warnings 'redefine'; + *DynamicConstant::VALUE = sub { 0 }; +} + +my $name = 'DynamicConstant::VALUE'; +no strict 'refs'; +is(&{$name}(), 0, 'the constant subroutine was replaced at runtime'); +is(result_from_compile_time_constant(), 'inlined', + 'a constant installed during BEGIN is inlined into later code'); + +done_testing; diff --git a/src/test/resources/unit/hint_hash_scope_destroy.t b/src/test/resources/unit/hint_hash_scope_destroy.t new file mode 100644 index 0000000000..639854c69a --- /dev/null +++ b/src/test/resources/unit/hint_hash_scope_destroy.t @@ -0,0 +1,42 @@ +use strict; +use warnings; +use Test::More; + +our $destroyed = 0; + +{ + package Local::HintHash::Guard; + sub DESTROY { $main::destroyed++ } +} + +my $ok = eval q{ + BEGIN { + $^H{'Local::HintHash::Guard'} = bless {}, 'Local::HintHash::Guard'; + } + sub local_hint_hash_scope_guard { 1 } + 1; +}; + +ok($ok, 'eval with a compile-time hint guard succeeds'); +is($destroyed, 1, 'discarding an eval hint hash releases its guard'); + +{ + package Local::HintHash::Importer; + sub import { + $^H{'Local::HintHash::Importer'} = bless {}, 'Local::HintHash::Guard'; + } +} +$INC{'Local/HintHash/Importer.pm'} = __FILE__; + +$ok = eval q{ + BEGIN { + package Local::HintHash::Consumer; + use Local::HintHash::Importer; + } + 1; +}; + +ok($ok, 'eval with a use-time hint guard succeeds'); +is($destroyed, 2, 'a call-site hint snapshot does not retain a discarded guard'); + +done_testing;