diff --git a/dev/modules/README.md b/dev/modules/README.md index d80a316c1..d6bfc358b 100644 --- a/dev/modules/README.md +++ b/dev/modules/README.md @@ -14,6 +14,7 @@ This directory contains design documents and guides related to porting CPAN modu | [xsloader.md](xsloader.md) | XSLoader architecture | | [makemaker_perlonjava.md](makemaker_perlonjava.md) | ExtUtils::MakeMaker implementation | | [cpan_client.md](cpan_client.md) | jcpan - CPAN client for PerlOnJava | +| [cpanplus.md](cpanplus.md) | **CPANPLUS** — `jcpan -t CPANPLUS`: `require` true-value chain, Interpreter/JVM parity, remaining test gaps (**`BUILD_PL`**, SQLite, formatting) | | [dbix_class.md](dbix_class.md) | DBIx::Class support (in progress) | | [padwalker.md](padwalker.md) | PadWalker support plan for Reply lexical persistence | | [dbi_test_parity.md](dbi_test_parity.md) | DBI test-suite parity (~13.5× more passes than master; Phases 1–4 done, incl. a tied-hash method-dispatch fix in the PerlOnJava runtime) | diff --git a/dev/modules/cpanplus.md b/dev/modules/cpanplus.md new file mode 100644 index 000000000..677a56958 --- /dev/null +++ b/dev/modules/cpanplus.md @@ -0,0 +1,186 @@ +# CPANPLUS — full `./jcpan -t CPANPLUS` parity + +This document tracks **PerlOnJava**/`jperl` work so **`./jcpan -t CPANPLUS`** can pass the upstream **`t/`** suite without early aborts (“did not return a true value”, missing imports, …). + +Related: **`dev/modules/cpan_client.md`** (jcpan client), **`AGENTS.md`** (always **`timeout`** around **`jperl`** / **`jcpan`**). + +--- + +## Resolved: `require` / trailing true value (2026-05) + +### Symptoms + +Failures such as: + +```text +CPANPLUS/Config.pm did not return a true value at t/… line 4, line 317. +Compilation failed in require +``` + +Perl requires the loaded compilation unit’s **last statement** to yield a **defined** scalar; an **empty `RuntimeList`** at the boundary behaves like **undef**. + +### Causes addressed in-tree + +1. **`CompilerOptions` leakage (JVM)** + Nested subroutine compilations (`EmitSubroutine`, lazy subs in `SubroutineParser`) reused `compilationUnitFromRequireOrDo` via a shared `CompilerOptions` reference. `EmitBlock` could treat an inner sub’s body like the outer `require` file tail and mis-emit the last statement (empty list). + - **Fix:** **`clone()`** parent options for nested JVM subs / named lazy subs and clear **`compilationUnitFromRequireOrDo`** / **`compilationUnitCallerContext`**. + +2. **`eval`** units inheriting **`require`** flags + **`EmitEval`** and **`RuntimeCode`** eval clones now clear **`compilationUnitFromRequireOrDo`** after cloning so eval strings are not codegen’d as the outer **`require`** body. + +3. **Interpreter parity after JVM `ctx.contextType = RUNTIME`** + Fallback compilation can leave **`currentCallContext == RUNTIME`** so the interpreter emitted the **file’s last statement** in **RUNTIME** context → empty list semantics for trailing **`1;`** relative to **`require`**. + - **Fix:** **`BytecodeCompiler`** — for the outermost block of a **`compilationUnitFromRequireOrDo`** unit, treat the **last** statement like **`EmitBlock`** (use **`compilationUnitCallerContext`** or **scalar**) when **`currentCallContext == RUNTIME`**. + +4. **`LargeBlockRefactorer` vs `require`/do file body** + Whole-block `sub { ... }->()` refactor must not run on the `require`/do outermost body (it would discard the compilation unit’s return value). Mitigated via `compilationUnitFromRequireOrDo` + outer-block detection (`EmitBlockJvmDepth` / `isFileLevelBlock` skips). + +5. **Circularity guard (Configure ⇄ Config ⇄ Backend)** + `CPANPLUS::Configure` loads `CPANPLUS::Config`; `Config` pulls `CPANPLUS` → `Backend` → `Configure` again. Even after codegen fixes, `apply()` could still propagate an empty `RuntimeList` with `$@` unchanged. + - **Fix (belt-and-suspenders):** `ModuleOperators.doFile`: for `require` of a `compilationUnitFromRequireOrDo` unit, if `result.isEmpty()` and `$@` is blank (snapshot before `$@` is cleared on success), coerce success to `scalarTrue`. The **`module_true`** feature flag still overrides as before. + +Supporting plumbing: **`JavaClassInfo`** fields **`emitJvmApplyBodyFromRequireOrDo`** / **`emitBlockJvmDepth`**, **`PerlLanguageProvider`** marking **`compilationUnitCallerContext`**, **`CompilerOptions`** **javadoc**. + +### Verification checklist (regression-sensitive) + +```bash +make + +# CPANPLUS build dir after jcpan fetched sources (adjust path/version) +PERL5LIB="/path/to/CPANPLUS-*/blib/lib:/path/to/CPANPLUS-*/blib/arch:$PERL5LIB" +cd …/CPANPLUS-*/t && timeout 120 /path/to/jperl -e 'require "./inc/conf.pl"; print "ok\n"' +``` + +Always wrap **`./jcpan -t CPANPLUS`**: + +```bash +timeout 3600 ./jcpan -t CPANPLUS # captures full TAP; see jcpan/build logs +``` + +--- + +## Resolved (2026-05-16): **`BUILD_PL` / `MAKEFILE`** “strict bareword” (**`-e`** / **`stat`** + **`->`**) + +Perl treats **`BUILD_PL`**, **`MAKEFILE`**, … as **exported constant subs**, not ALLCAPS filehandle slots. + +PerlOnJava’s **file-test** operator path and **`stat`/`lstat`** mistakenly consumed any **`^[A-Z_][A-Z0-9_]*$`** bareword as a glob handle **before** list/expression parsing, so **`CONSTANT->($path)`** and **`stat CONSTANT->(...)`** left a bare **`IdentifierNode`** behind and tripped **`strict subs`** at emit time. + +**Fix:** **`FileHandle.shouldTreatAllCapsIdentifierAsBareFileHandleSlot`** — only use the legacy handle heuristic when **`NAME`** is **not** followed by **`->`** (skipping whitespace) **and **`GlobalVariable.isGlobalCodeRefDefined(CurrentPackage::NAME)`** is false. Wired from **`ParsePrimary.parseFileTestOperator`** and **`OperatorParser.parseStat`**. + +**Check:** **`timeout 120 ./jperl -e '… -e BUILD_PL->($extract) …'`** and **`timeout 300 ./jperl ./04_CPANPLUS-Module.t`** (exit **0**). + +--- + +## Resolved (2026-05-16): **`t/00`** **`_version_to_number`** (**`version` module** parity) + +Upstream **`Utils::_version_to_number`** strips non-numeric tails (e.g. **`1.5-a` → `version->parse("1.5")`**), then **`numify`**. Failures (**`v1.5`**, **`1.5`**) were **not** fixable by repurposing **`VersionHelper.normalizeVersion`**: that helper is also used for **`use VERSION` / feature-bundle parsing** and must stay coarse; changing it broke **`use v5.36`** signatures and **`IO::Handle`** ( **`use 5.38.0`** + built-in **`say`** ). + +**Fixes:** **`VersionHelper.normalizeVersionForPerlModule`** (tuple + single-dot decimal mantissa chunking + multi-dot **`5.x.y`** tuples) used only from **`Version.java`**; **`normalizeVersion`** unchanged for **`StatementParser`**. **`Version.java`**: removed bogus internal **`v`** prepend on short **`1.x`** decimals; **`numify`** uses **`max(parts − 1, 1)`** fractional **`%03d`** groups (Perl **`version.pm`**). **`StatementParser.parseOptionalPerlBareUseVersion`**: splice lexer-split **`use 5.38.0`** into a tuple string (not **`5.382`** float). + +**Check:** **`./jperl src/test/resources/unit/version_pm_numify_parity.t`**; **`timeout 900 ./jcpan -t CPANPLUS`** ( **`t/00`** + full suite ). + +--- + +## Resolved (2026-05-16): **`$^E`** + **`$!`** uninitialized warnings (**File::Copy** TAP noise) + +`$^E` is created by the **`$^A`–`$^Z`** startup loop as a plain global (**undef**). Perl defines **`$^E`** as the extended OS error; on **POSIX** it **always matches `$!`** (perlvar). Numeric context **`$^E + 0`** must not warn. + +**Fix:** **`GlobalContext.initializeGlobals`**: install **`ErrnoVariable`** for **`main::!`**. Re-point **`$^E`** to the **same `ErrnoVariable`** on non‑Windows hosts; on **Windows** use a **second `ErrnoVariable`** so **`($!, $^E) = (...)`** in **`File::Copy`** can restore errno vs Win32 error independently. Bundled **`File/Copy.pm`** stays stock **`($! + 0, $^E + 0)`**. + +**Check:** **`./jperl src/test/resources/unit/errno_caret_e_defined.t`**; **`timeout 900 ./jcpan -t CPANPLUS`** — no **`File/Copy`** **`uninitialized`** line. + +--- + +## Resolved (2026-05): **Strict + string `eval` + import / `no` — pr694 (**`has … =>`** DSL)** + +### Symptoms + +Failures such as **`Undefined subroutine &Some::Pkg::has`** inside **`eval q{ … use ExporterThing; has foo => (...); no ExporterThing; … }`** even though **`perl`** runs the **`has`** call with the imported CV after the stash entry was deleted (**CPANPLUS**-adjacent **`use`/`no`/DSL** ordering). + +Separate regression **`unit/eval_after_stash_delete.t`** must keep **Perl** semantics: compilations that start **after** **`delete $stash{sub}`** must **not** resurrect a pinned CV. + +### Cause + +For **eval string**, **`Parser.parse()`** runs **`use` / `no`** immediately (BEGIN-like), then **`BytecodeCompiler.compile(ast)`** runs. By emit time the visible **`globalCodeRefs`** entry for **`&Pkg::name`** is often already gone, so **`getGlobalCodeRefForFreshLookup`** constant-pooled an **undef placeholder** for named **`&sub(...)`** sites. **Perl** still calls the **compile-time-pinned** CV. + +A **GlobalVariable-only** “always prefer pinned when stash-deleted” fix broke **`eval_after_stash_delete`** (new compile after delete must see an empty slot). + +### Fix + +- **`SubroutineParser`**: when parsing a **direct** call **`&name(...)`** and **`GlobalVariable`** already shows a **real callable** (**not** a pure **`sub name;`** forward stub with only attributes), **`setAnnotation("parseTimeCodeRef", …)`** on the **`OperatorNode("&", …)`**. +- **`BytecodeCompiler`** embeds **`parseTimeCodeRef`** into the bytecode constant pool (**interpreter** / eval-string parity with compile-time **`&`** pinning). +- **JVM** **`EmitSubroutine.handleApplyOperator`**: **`&(bareword)`** must load the callee via **`EmitVariable` → `getGlobalCodeRef`** (runtime glob). Embedding **`parseTimeCodeRef`** with **`GlobalVariable.registerCompiledCodeRef`** was wrong for **`local *Pkg::…`** overrides (**CPANPLUS::Dist::MM** **`format_available`** / **t/20**) because the ID pins a **`RuntimeScalar`** that **`replacePinnedCodeRef`** does not update. + +### Regression tests + +```bash +./gradlew shadowJar # ./jperl uses target/perlonjava-*.jar — rebuild after Java changes +timeout 120 ./jperl src/test/resources/unit/pr694_core_regressions.t +timeout 120 ./jperl src/test/resources/unit/eval_after_stash_delete.t +``` + +--- + +## Roadmap: `./jcpan -t CPANPLUS` — **detailed next steps** + +**Latest harness (2026-05-16):** **`timeout 900 ./jcpan -t CPANPLUS`** → **PASS** (**20** files, **1576** subtests, CPANPLUS **0.9916**); clean TAP re **`File/Copy`** after **`File/Copy.pm`** line **303** guard + fresh **`shadowJar`**. + +### 0. Routine verification (every CPANPLUS-related push) + +1. **`make`** (Gradle **`shadowJar`** + unit shards — required before PR updates per **`AGENTS.md`**). +2. **Interpreter / eval regressions:** + `timeout 120 ./jperl src/test/resources/unit/pr694_core_regressions.t` + `timeout 120 ./jperl src/test/resources/unit/eval_after_stash_delete.t` +3. **Smoke require** from a CPANPLUS tree (adjust paths): + `PERL5LIB="…/CPANPLUS-*/blib/lib:…/CPANPLUS-*/blib/arch:$PERL5LIB" timeout 120 ./jperl -e 'require CPANPLUS::Config'` +4. **Harness:** **`timeout 3600 ./jcpan -t CPANPLUS`** — capture full log under **`jcpan/`** / build output; note first failing **`t/`** program and TAP line. + +### 1. ~~**`BUILD_PL` / `MAKEFILE` barewords~~ — **Done** + +See “Resolved … **`BUILD_PL` / `MAKEFILE`**” above. + +### 2. ~~**`t/00`** `_version_to_number` / **`version`**~~ — **Done** + +See “Resolved … **`_version_to_number`**” above. + +### 3. ~~**`t/031`** SQLite source + **`DBIx::Simple`**~~ — **Done (2026-05-16, `master`)** + +**`t/031_CPANPLUS-Internals-Source-SQLite.t`** and **`032_…via-sqlite`** pass under **`jcpan -t CPANPLUS`** after upstream **`DBIx::Simple`/JDBC chain** landed on **`master`**. Regression watch: **`dbh`** lifetime under heavy **`SQLite`** use. + +### 4. ~~**`t/20`** **`CPANPLUS::Dist::MM`** / **`can_load`**~~ — **Done (2026-05-16, JVM)** + +- **Symptom:** **`local *CPANPLUS::Dist::MM::can_load = sub { … }`** should change **`can_load(...)`** inside **`format_available`**; **`jperl`** was still calling the pre-local CV. +- **Fix:** **`EmitSubroutine.handleApplyOperator`** no longer embeds parser **`parseTimeCodeRef`** via **`registerCompiledCodeRef`**; **`&(bareword)`** always goes through **`getGlobalCodeRef`** so **`local *glob`** (**`RuntimeGlob.dynamicSaveState`** / **`replacePinnedCodeRef`**) wins. Interpreter path still uses **`parseTimeCodeRef`** (**pr694** / stash-delete pinning). +- **Check:** **`src/test/resources/unit/cpanplus_dist_mm_can_load_local.t`** (also rebuild **`shadowJar`** before spot-checking **`./jperl -e`** — stale jars looked like **`local`** was broken). + +### 5. ~~**`File::Copy`** **`$!`** / **`$^E`** warnings~~ — **Done** + +See “Resolved … **`$^E`**” above. + +### 6. Documentation + incident hygiene + +- After each **`jcpan -t CPANPLUS`** run, update **this file** with: date, subtest totals, dubious-program count, and the **short list** of remaining failing **`t/`** scripts. +- Keep **`dev/modules/cpan_client.md`** in sync only when **`jcpan`** behavior or **`PERL5LIB`** layout changes. + +--- + +## Progress tracking + +| Area | Status | Notes | +|------|--------|--------| +| Empty list / **`require`** false negative | **Done** | Cloned **`CompilerOptions`**, evaluator fixes, bytecode last-stmt **`require`** parity, **`doFile`** empty-list heel when **`$@`** clean | +| **`make`** (unit shards) | **Done** | Run before pushing | +| **`jcpan -t CPANPLUS`** bootstrap | **Unblocked** | **`conf.pl`** + **`Selfupdate`** / **`Report`** no longer abort on **`Config`** | +| **`BUILD_PL` / `MAKEFILE` filetest/`stat`** | **Done** | ALLCAP bareword handle heuristic vs **`->`** / defined package sub (**`FileHandle`** helper) | +| **`t/00`** version / **`numify`** | **Done** | **`normalizeVersionForPerlModule`** + **`Version.java`**; bare **`use 5.x.y`** splice (**`StatementParser`**) | +| **Strict + string `eval` + import/**`no`** (pr694)** | **Done** | **`SubroutineParser`** **`parseTimeCodeRef`** → **`BytecodeCompiler`**; **`pr694_core_regressions.t`**, **`eval_after_stash_delete.t`** | +| **`File::Copy` warn + 0 `$!`/`$^E`** | **Done** | **`GlobalContext`**: **`$^E` → `ErrnoVariable`** (alias **`$!`** on POSIX) | +| **`t/031` SQLite Source** | **Done** | Covered by **`jcpan -t CPANPLUS`** PASS (2026-05-16); upstream **`DBIx::Simple`/JDBC** | +| **`t/20` Dist::MM / `can_load`** | **Done (JVM)** | **`EmitSubroutine`**: no **`registerCompiledCodeRef`** for **`&`** calls; **`cpanplus_dist_mm_can_load_local.t`** | + +--- + +## Open questions + +- Should the **`doFile`** empty-list coercion be tightened (e.g. only **`.pm`** paths, file size cap, circular-depth probe) vs keeping the current conservative **`compilationUnitFromRequireOrDo`** guard? +- **ASM `ArrayIndexOutOfBoundsException`** in frame compute during heavy BEGIN stacks: already falls back to interpreter — track reduction of fallback frequency? diff --git a/src/main/java/org/perlonjava/app/cli/CompilerOptions.java b/src/main/java/org/perlonjava/app/cli/CompilerOptions.java index cfd962708..486bee148 100644 --- a/src/main/java/org/perlonjava/app/cli/CompilerOptions.java +++ b/src/main/java/org/perlonjava/app/cli/CompilerOptions.java @@ -85,6 +85,20 @@ public class CompilerOptions implements Cloneable { * Perl 5 semantics. */ public String initialPackage = null; + /** + * True only when this compilation unit is the body loaded by {@code require} / {@code do} + * ({@link org.perlonjava.runtime.operators.ModuleOperators#doFile}). Used so codegen can treat + * the AST root as a file-level compilation unit regardless of earlier transforms. + */ + public boolean compilationUnitFromRequireOrDo = false; + /** + * Context from require/do/eval caller for this compilation unit (SCALAR/LIST/VOID). + * JVM codegen forces {@link org.perlonjava.runtime.runtimetypes.RuntimeContextType#RUNTIME} + * on {@link org.perlonjava.backend.jvm.EmitterContext}; {@link org.perlonjava.backend.jvm.EmitBlock} + * uses this for the final statement of file-level blocks so {@code require} sees the trailing + * {@code 1;} value. {@code -1} means unset (EmitBlock defaults to SCALAR). + */ + public int compilationUnitCallerContext = -1; public boolean unicodeStdout = false; // -CO public boolean unicodeStderr = false; // -CE public boolean unicodeInput = false; // -CI (same as stdin) diff --git a/src/main/java/org/perlonjava/app/scriptengine/PerlLanguageProvider.java b/src/main/java/org/perlonjava/app/scriptengine/PerlLanguageProvider.java index 3f806539f..2675b4ef5 100644 --- a/src/main/java/org/perlonjava/app/scriptengine/PerlLanguageProvider.java +++ b/src/main/java/org/perlonjava/app/scriptengine/PerlLanguageProvider.java @@ -11,6 +11,7 @@ import org.perlonjava.backend.jvm.InterpreterFallbackException; import org.perlonjava.backend.jvm.JavaClassInfo; import org.perlonjava.frontend.analysis.ConstantFoldingVisitor; +import org.perlonjava.frontend.astnode.AbstractNode; import org.perlonjava.frontend.astnode.Node; import org.perlonjava.frontend.lexer.Lexer; import org.perlonjava.frontend.lexer.LexerToken; @@ -128,6 +129,8 @@ public static RuntimeList executePerlCode(CompilerOptions compilerOptions, int contextType = callerContext >= 0 ? callerContext : (isTopLevelScript ? RuntimeContextType.VOID : RuntimeContextType.SCALAR); + compilerOptions.compilationUnitCallerContext = contextType; + // Create the compiler context EmitterContext ctx = new EmitterContext( new JavaClassInfo(), // internal java class name @@ -208,6 +211,11 @@ public static RuntimeList executePerlCode(CompilerOptions compilerOptions, // bare constant identifiers (e.g., PI from `use constant PI => 3.14`). ast = ConstantFoldingVisitor.foldConstants(ast, ctx.symbolTable.getCurrentPackage()); + if (compilerOptions.compilationUnitFromRequireOrDo && ast instanceof AbstractNode rootAst + && !rootAst.getBooleanAnnotation("blockIsSubroutine")) { + rootAst.setAnnotation("isFileLevelBlock", true); + } + if (ctx.compilerOptions.parseOnly) { // Printing the ast System.out.println(ast); @@ -306,6 +314,8 @@ public static RuntimeList executePerlAST(Node ast, } } + compilerOptions.compilationUnitCallerContext = contextType; + EmitterContext ctx = new EmitterContext( new JavaClassInfo(), globalSymbolTable.snapShot(), @@ -601,10 +611,16 @@ private static RuntimeCode compileToExecutable(Node ast, EmitterContext ctx) thr if (CompilerOptions.DEBUG_ENABLED) ctx.logDebug("Falling back to bytecode interpreter due to method size"); // Reset strict/feature/warning flags before fallback compilation. // The JVM compiler already processed BEGIN blocks (use strict, etc.) - // which set these flags on ctx.symbolTable. But the interpreter will + // which set those flags on ctx.symbolTable. But the interpreter will // re-process those pragmas during execution, so inheriting them causes // false strict violations (e.g. bareword filehandles rejected). - if (ctx.symbolTable != null) { + // + // Skip this reset for require/do compilation units: clearing strict hints + // before recompiling large modules (e.g. CPANPLUS::Config) has been observed + // to interact badly with unit initialization; those files rely on compile-time + // hints accumulated during the failed JVM compile pass matching execution. + if (ctx.symbolTable != null + && !(ctx.compilerOptions != null && ctx.compilerOptions.compilationUnitFromRequireOrDo)) { ctx.symbolTable.strictOptionsStack.pop(); ctx.symbolTable.strictOptionsStack.push(0); } @@ -672,6 +688,8 @@ public static Object compilePerlCode(CompilerOptions compilerOptions) throws Exc globalSymbolTable.enableStrictOption(Strict.HINT_UTF8); } + compilerOptions.compilationUnitCallerContext = RuntimeContextType.SCALAR; + EmitterContext ctx = new EmitterContext( new JavaClassInfo(), globalSymbolTable.snapShot(), diff --git a/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java b/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java index 61d97c3a2..7619d2362 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java +++ b/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java @@ -1,6 +1,7 @@ package org.perlonjava.backend.bytecode; +import org.perlonjava.app.cli.CompilerOptions; import org.perlonjava.backend.jvm.EmitterContext; import org.perlonjava.backend.jvm.EmitterMethodCreator; import org.perlonjava.frontend.analysis.ConstantFoldingVisitor; @@ -102,6 +103,11 @@ public class BytecodeCompiler implements Visitor { Set currentSubroutineClosureVars = new HashSet<>(); // Variables captured from outer scope // EmitterContext for strict checks and other compile-time options private EmitterContext emitterContext; + /** + * Nesting depth during {@link #visit(BlockNode)}; used with require/do units to skip + * mortal flushing at the outer block (see exitScope call in this visitor). + */ + private int bytecodeEmitBlockNesting; // Register allocation private int nextRegister = 3; // 0=this, 1=@_, 2=wantarray private int baseRegisterForStatement = 3; // Reset point after each statement @@ -1000,6 +1006,8 @@ private RuntimeBase getVariableValueFromContext(String varName, EmitterContext c */ @Override public void visit(BlockNode node) { + bytecodeEmitBlockNesting++; + try { // Blocks create a new lexical scope // But if the block needs to return a value (not VOID context), // allocate a result register BEFORE entering the scope so it's valid after @@ -1163,6 +1171,23 @@ public void visit(BlockNode node) { stmtContext = RuntimeContextType.VOID; } else { stmtContext = currentCallContext; + // Mirror JVM EmitBlock: require/do compilation units use RUNTIME call context in apply(), + // but Perl evaluates the unit's *final* statement in the caller's effective context + // (scalar for normal require). After a failed JVM compile, ctx.contextType is often + // still RUNTIME — then trailing `1` emits as RUNTIME and becomes an empty list so + // require sees undef ("did not return a true value"). + if (isLastStatement + && emitterContext != null + && emitterContext.compilerOptions != null + && emitterContext.compilerOptions.compilationUnitFromRequireOrDo + && bytecodeEmitBlockNesting == 1 + && !node.getBooleanAnnotation("blockIsSubroutine") + && currentCallContext == RuntimeContextType.RUNTIME) { + CompilerOptions co = emitterContext.compilerOptions; + stmtContext = co.compilationUnitCallerContext >= 0 + ? co.compilationUnitCallerContext + : RuntimeContextType.SCALAR; + } } compileNode(stmt, stmtTarget, stmtContext); @@ -1227,8 +1252,24 @@ public void visit(BlockNode node) { // promptly at scope exit. Subroutine body blocks and do-blocks must NOT // flush — the implicit return value may still be in a register and // flushing could destroy it before the caller captures it. - exitScope(!node.getBooleanAnnotation("blockIsSubroutine") - && !node.getBooleanAnnotation("blockIsDoBlock")); + // + // require/do compilation units compiled via this interpreter path hit the same bug if we + // flush at the outermost BlockNode: outerResultReg often aliases the trailing `1` via a + // mortal scalar — flushing before RETURN turns require's result into undef. + boolean requireOrDoFileUnit = + emitterContext != null + && emitterContext.compilerOptions != null + && emitterContext.compilerOptions.compilationUnitFromRequireOrDo; + boolean skipRootRequireMortalFlush = + requireOrDoFileUnit + && bytecodeEmitBlockNesting == 1 + && !node.getBooleanAnnotation("blockIsSubroutine") + && !node.getBooleanAnnotation("blockIsDoBlock"); + boolean flushMortals = + !node.getBooleanAnnotation("blockIsSubroutine") + && !node.getBooleanAnnotation("blockIsDoBlock") + && !skipRootRequireMortalFlush; + exitScope(flushMortals); if (needsLocalRestore) { emit(Opcodes.POP_LOCAL_LEVEL); @@ -1237,6 +1278,9 @@ public void visit(BlockNode node) { // Set lastResultReg to the outer register (or -1 if VOID context) lastResultReg = outerResultReg; + } finally { + bytecodeEmitBlockNesting--; + } } // ========================================================================= diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitBlock.java b/src/main/java/org/perlonjava/backend/jvm/EmitBlock.java index 92b3a9955..55074a8df 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitBlock.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitBlock.java @@ -191,6 +191,9 @@ public static void emitBlock(EmitterVisitor emitterVisitor, BlockNode node) { return; } + emitterVisitor.ctx.javaClassInfo.emitBlockJvmDepth++; + try { + if (CompilerOptions.DEBUG_ENABLED) emitterVisitor.ctx.logDebug("generateCodeBlock start context:" + emitterVisitor.ctx.contextType); int scopeIndex = emitterVisitor.ctx.symbolTable.enterScope(); EmitterVisitor voidVisitor = @@ -351,14 +354,32 @@ public static void emitBlock(EmitterVisitor emitterVisitor, BlockNode node) { element.accept(emitterVisitor.with(RuntimeContextType.SCALAR)); mv.visitVarInsn(Opcodes.ASTORE, resultReg); } else if (emitterVisitor.ctx.contextType == RuntimeContextType.RUNTIME - && (node.getBooleanAnnotation("isFileLevelBlock") || node.getBooleanAnnotation("blockIsSubroutine")) + && node.getBooleanAnnotation("blockIsSubroutine") && element instanceof For3Node for3 && for3.isSimpleBlock && for3.labelName == null) { - // Bare block (no label) as last statement in file-level RUNTIME context - // or inside a subroutine. This handles do "file", require, and sub { { 99 } }. - // Visit with SCALAR context to get the block's return value. + // Bare block (no label) as last statement inside a subroutine body under RUNTIME. + // Handles sub { { 99 } } — visit with SCALAR to get the block's return value. element.accept(emitterVisitor.with(RuntimeContextType.SCALAR)); + } else if (emitterVisitor.ctx.contextType == RuntimeContextType.RUNTIME + && !node.getBooleanAnnotation("blockIsSubroutine")) { + JavaClassInfo jci = emitterVisitor.ctx.javaClassInfo; + boolean outerRequireDoApplyBody = + jci.emitJvmApplyBodyFromRequireOrDo && jci.emitBlockJvmDepth == 1; + if (outerRequireDoApplyBody) { + // require/do compile the unit with RUNTIME ctx for wantarray propagation, + // but Perl evaluates the compilation unit's final statement in the caller's + // context (scalar for require). Without this, trailing `1;` is emitted as + // RUNTIME and leaves no value — require sees undef ("did not return a true value"). + int callerCtx = RuntimeContextType.SCALAR; + CompilerOptions co = emitterVisitor.ctx.compilerOptions; + if (co != null && co.compilationUnitCallerContext >= 0) { + callerCtx = co.compilationUnitCallerContext; + } + element.accept(emitterVisitor.with(callerCtx)); + } else { + element.accept(emitterVisitor); + } } else { element.accept(emitterVisitor); } @@ -459,10 +480,24 @@ public static void emitBlock(EmitterVisitor emitterVisitor, BlockNode node) { boolean isSubBody = node.getBooleanAnnotation("blockIsSubroutine"); boolean isDoBlock = node.getBooleanAnnotation("blockIsDoBlock"); boolean doBlockFreshResult = isDoBlock && doBlockResultIsAlwaysFresh(node); + JavaClassInfo jciFlush = emitterVisitor.ctx.javaClassInfo; + boolean skipRequireDoRootMortalFlush = + jciFlush.emitJvmApplyBodyFromRequireOrDo + && jciFlush.emitBlockJvmDepth == 1 + && !isSubBody + && !isDoBlock; + // Outer apply() body for require/do: MortalList.flush() at the outer block exit runs while the + // compilation unit's return value may still live only as a mortal temporary (trailing `1`). + // Flushing turns require's result into undef ("did not return a true value"). Detection uses + // emitBlockJvmDepth (not only isFileLevelBlock) because annotation propagation can miss edge cases. EmitStatement.emitScopeExitNullStores(emitterVisitor.ctx, scopeIndex, - !isSubBody && (!isDoBlock || doBlockFreshResult)); + !skipRequireDoRootMortalFlush && !isSubBody && (!isDoBlock || doBlockFreshResult)); emitterVisitor.ctx.symbolTable.exitScope(scopeIndex); if (CompilerOptions.DEBUG_ENABLED) emitterVisitor.ctx.logDebug("generateCodeBlock end"); + } finally { + emitterVisitor.ctx.javaClassInfo.emitBlockJvmDepth--; + } + } } diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitEval.java b/src/main/java/org/perlonjava/backend/jvm/EmitEval.java index aff8c7eec..ba284b0b2 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitEval.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitEval.java @@ -141,6 +141,8 @@ static void handleEvalOperator(EmitterVisitor emitterVisitor, OperatorNode node) // The filename becomes "(eval N)" for better error messages CompilerOptions compilerOptions = emitterVisitor.ctx.compilerOptions.clone(); compilerOptions.fileName = "(eval " + counter + ")"; + compilerOptions.compilationUnitFromRequireOrDo = false; + compilerOptions.compilationUnitCallerContext = -1; // The evalTag is crucial - it links the runtime eval to this compile-time context // When evalStringHelper is called at runtime, it uses this tag to retrieve diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java b/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java index ee595c8d4..8b8399f8a 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java @@ -10,8 +10,8 @@ import org.perlonjava.frontend.astnode.*; import org.perlonjava.frontend.semantic.ScopedSymbolTable; import org.perlonjava.frontend.semantic.SymbolTable; -import org.perlonjava.runtime.runtimetypes.NameNormalizer; import org.perlonjava.runtime.runtimetypes.GlobalVariable; +import org.perlonjava.runtime.runtimetypes.NameNormalizer; import org.perlonjava.runtime.runtimetypes.RuntimeBase; import org.perlonjava.runtime.runtimetypes.RuntimeCode; import org.perlonjava.runtime.runtimetypes.RuntimeContextType; @@ -216,7 +216,14 @@ public static void emitSubroutine(EmitterContext ctx, SubroutineNode node) { if (isMapGrepBlock != null && isMapGrepBlock) { newJavaClassInfo.isMapGrepBlock = true; } - + + // Nested subroutine compilations share ctx.compilerOptions by reference; require/do flags + // (compilationUnitFromRequireOrDo) must not leak into inner subs or EmitBlock mis-handles + // their final statement — observed as CPANPLUS::Config.pm returning an empty RuntimeList. + CompilerOptions subCompilerOptions = ctx.compilerOptions.clone(); + subCompilerOptions.compilationUnitFromRequireOrDo = false; + subCompilerOptions.compilationUnitCallerContext = -1; + EmitterContext subCtx = new EmitterContext( newJavaClassInfo, // Internal Java class name @@ -226,7 +233,7 @@ public static void emitSubroutine(EmitterContext ctx, SubroutineNode node) { RuntimeContextType.RUNTIME, // Call context true, // Is boxed ctx.errorUtil, // Error message utility - ctx.compilerOptions, + subCompilerOptions, null); int skipVariables = EmitterMethodCreator.skipVariables; // Skip (this, @_, wantarray) @@ -541,17 +548,23 @@ static void handleApplyOperator(EmitterVisitor emitterVisitor, BinaryOperatorNod // twice" error in DBIx::Class torture.t (perf/reduce-apply-bytecode Phase 2). String subroutineName = ""; - if (node.left instanceof OperatorNode operatorNode && operatorNode.operator.equals("&")) { - if (operatorNode.operand instanceof IdentifierNode identifierNode) { + OperatorNode ampNode = + node.left instanceof OperatorNode on && "&".equals(on.operator) ? on : null; + if (ampNode != null && ampNode.operand instanceof IdentifierNode identifierNode) { subroutineName = NameNormalizer.normalizeVariableName(identifierNode.name, emitterVisitor.ctx.symbolTable.getCurrentPackage()); if (CompilerOptions.DEBUG_ENABLED) emitterVisitor.ctx.logDebug("handleApplyElementOperator subroutine " + subroutineName); - } } - if (node.left instanceof OperatorNode operatorNode - && operatorNode.operator.equals("&") - && operatorNode.getAnnotation("parseTimeCodeRef") instanceof RuntimeScalar codeRef) { - int codeRefId = GlobalVariable.registerCompiledCodeRef(codeRef); + // Embed parse-time CODeref when safe: wrapper clone shares the RuntimeCode object, + // so later glob .set(...) does not mutate the pooled wrapper (Perl compile-bind; + // op/symbolcache.t). Skip embedding while local *Pkg::name shadows CODE + // (GlobalVariable.isGlobCodeSlotUnderLocalShadow) so invokes observe + // monkeypatches (CPANPLUS::Dist::MM format_available-style tests). + if (ampNode != null + && !subroutineName.isEmpty() + && !GlobalVariable.isGlobCodeSlotUnderLocalShadow(subroutineName) + && ampNode.getAnnotation("parseTimeCodeRef") instanceof RuntimeScalar parseSnap) { + int codeRefId = GlobalVariable.registerCompiledCodeRef(parseSnap.clone()); mv.visitLdcInsn(codeRefId); mv.visitMethodInsn(Opcodes.INVOKESTATIC, "org/perlonjava/runtime/runtimetypes/GlobalVariable", @@ -559,7 +572,7 @@ static void handleApplyOperator(EmitterVisitor emitterVisitor, BinaryOperatorNod "(I)Lorg/perlonjava/runtime/runtimetypes/RuntimeScalar;", false); } else { - node.left.accept(emitterVisitor.with(RuntimeContextType.SCALAR)); // Target - left parameter: Code ref + node.left.accept(emitterVisitor.with(RuntimeContextType.SCALAR)); // Target: code ref (usually &bareword) } // Dereference the scalar to get the CODE reference if needed diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitterMethodCreator.java b/src/main/java/org/perlonjava/backend/jvm/EmitterMethodCreator.java index 0d6100f30..d36223084 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitterMethodCreator.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitterMethodCreator.java @@ -734,7 +734,17 @@ private static byte[] getBytecodeInternal(EmitterContext ctx, Node ast, boolean // Enable recording of my-variable indices for eval exception cleanup. ctx.javaClassInfo.evalCleanupLocals = new java.util.ArrayList<>(); - ast.accept(visitor); + boolean savedEmitJvmApplyBodyFromRequireDo = ctx.javaClassInfo.emitJvmApplyBodyFromRequireOrDo; + int savedEmitBlockJvmDepth = ctx.javaClassInfo.emitBlockJvmDepth; + ctx.javaClassInfo.emitJvmApplyBodyFromRequireOrDo = + ctx.compilerOptions != null && ctx.compilerOptions.compilationUnitFromRequireOrDo; + ctx.javaClassInfo.emitBlockJvmDepth = 0; + try { + ast.accept(visitor); + } finally { + ctx.javaClassInfo.emitJvmApplyBodyFromRequireOrDo = savedEmitJvmApplyBodyFromRequireDo; + ctx.javaClassInfo.emitBlockJvmDepth = savedEmitBlockJvmDepth; + } // Snapshot and disable recording of my-variable indices. evalCleanupLocals = ctx.javaClassInfo.evalCleanupLocals; @@ -763,7 +773,17 @@ private static byte[] getBytecodeInternal(EmitterContext ctx, Node ast, boolean } else { // No try-catch block is used - ast.accept(visitor); + boolean savedEmitJvmApplyBodyFromRequireDo = ctx.javaClassInfo.emitJvmApplyBodyFromRequireOrDo; + int savedEmitBlockJvmDepth = ctx.javaClassInfo.emitBlockJvmDepth; + ctx.javaClassInfo.emitJvmApplyBodyFromRequireOrDo = + ctx.compilerOptions != null && ctx.compilerOptions.compilationUnitFromRequireOrDo; + ctx.javaClassInfo.emitBlockJvmDepth = 0; + try { + ast.accept(visitor); + } finally { + ctx.javaClassInfo.emitJvmApplyBodyFromRequireOrDo = savedEmitJvmApplyBodyFromRequireDo; + ctx.javaClassInfo.emitBlockJvmDepth = savedEmitBlockJvmDepth; + } // Normal fallthrough return: spill and jump with empty operand stack. mv.visitVarInsn(Opcodes.ASTORE, returnValueSlot); diff --git a/src/main/java/org/perlonjava/backend/jvm/JavaClassInfo.java b/src/main/java/org/perlonjava/backend/jvm/JavaClassInfo.java index ac4f5d374..80f0369f6 100644 --- a/src/main/java/org/perlonjava/backend/jvm/JavaClassInfo.java +++ b/src/main/java/org/perlonjava/backend/jvm/JavaClassInfo.java @@ -58,6 +58,19 @@ public class JavaClassInfo { */ public int dynamicLevelSlot; + /** + * {@link org.perlonjava.backend.jvm.EmitBlock#emitBlock} recursion depth during JVM emission. + * Used with {@link #emitJvmApplyBodyFromRequireOrDo} to recognize the outermost block of the + * generated {@code apply()} body without relying solely on AST annotations. + */ + public int emitBlockJvmDepth; + + /** + * True while emitting the {@code apply()} body in {@link EmitterMethodCreator#getBytecodeInternal} + * for a compilation unit loaded via {@code require}/{@code do}. + */ + public boolean emitJvmApplyBodyFromRequireOrDo; + /** * Flag indicating if this subroutine uses 'local' variables. * Used to optimize return statements - if true, return values must be cloned diff --git a/src/main/java/org/perlonjava/backend/jvm/astrefactor/LargeBlockRefactorer.java b/src/main/java/org/perlonjava/backend/jvm/astrefactor/LargeBlockRefactorer.java index 2f019ac46..78e43b1e4 100644 --- a/src/main/java/org/perlonjava/backend/jvm/astrefactor/LargeBlockRefactorer.java +++ b/src/main/java/org/perlonjava/backend/jvm/astrefactor/LargeBlockRefactorer.java @@ -1,5 +1,6 @@ package org.perlonjava.backend.jvm.astrefactor; +import org.perlonjava.app.cli.CompilerOptions; import org.perlonjava.frontend.analysis.BytecodeSizeEstimator; import org.perlonjava.frontend.analysis.ControlFlowDetectorVisitor; import org.perlonjava.frontend.analysis.EmitterVisitor; @@ -60,6 +61,18 @@ public static boolean processBlock(EmitterVisitor emitterVisitor, BlockNode node return false; } + // Never refactor the outermost block of a require/do compilation unit: EmitBlock runs this + // before bumping emitBlockJvmDepth, so depth==0 identifies that outermost block even when + // isFileLevelBlock failed to annotate. Whole-block refactoring emits sub { ... }->(@_) and + // drops the unit's trailing statement as apply()'s return — require then sees undef. + CompilerOptions co = emitterVisitor.ctx.compilerOptions; + boolean outerRequireDoBlock = + co != null && co.compilationUnitFromRequireOrDo + && emitterVisitor.ctx.javaClassInfo.emitBlockJvmDepth == 0; + if (outerRequireDoBlock || node.getBooleanAnnotation("isFileLevelBlock")) { + return false; + } + // Determine if we need to refactor if (!shouldRefactorBlock(node)) { return false; diff --git a/src/main/java/org/perlonjava/frontend/analysis/ConstantFoldingVisitor.java b/src/main/java/org/perlonjava/frontend/analysis/ConstantFoldingVisitor.java index 1b8c44e41..ec1b88f08 100644 --- a/src/main/java/org/perlonjava/frontend/analysis/ConstantFoldingVisitor.java +++ b/src/main/java/org/perlonjava/frontend/analysis/ConstantFoldingVisitor.java @@ -439,7 +439,16 @@ public void visit(BlockNode node) { } if (changed) { - result = new BlockNode(foldedElements, node.tokenIndex); + BlockNode newBlock = new BlockNode(foldedElements, node.tokenIndex); + // Preserve block annotations (e.g. isFileLevelBlock set by Parser). Replacing the + // BlockNode during folding must not drop them — otherwise require loses the trailing + // statement's scalar return value for large modules like CPANPLUS::Config. + if (node.annotations != null) { + for (var e : node.annotations.entrySet()) { + newBlock.setAnnotation(e.getKey(), e.getValue()); + } + } + result = newBlock; } else { result = node; } diff --git a/src/main/java/org/perlonjava/frontend/parser/FileHandle.java b/src/main/java/org/perlonjava/frontend/parser/FileHandle.java index 6edc378a4..658b4909f 100644 --- a/src/main/java/org/perlonjava/frontend/parser/FileHandle.java +++ b/src/main/java/org/perlonjava/frontend/parser/FileHandle.java @@ -33,6 +33,29 @@ */ public class FileHandle { + /** + * Legacy print/stat paths treat bare ALLCAPS words as IO slots (glob refs), but names like + * {@code BUILD_PL} are often constant subs and must participate in parsing {@code FN->(...) }. + */ + public static boolean shouldTreatAllCapsIdentifierAsBareFileHandleSlot( + Parser parser, String name, int identifierTokenIndex) { + if ("_".equals(name) || !name.matches("^[A-Z_][A-Z0-9_]*$")) { + return false; + } + int nextIdx = + Whitespace.skipWhitespace(parser, identifierTokenIndex + 1, parser.tokens); + if (nextIdx < parser.tokens.size()) { + LexerToken t = parser.tokens.get(nextIdx); + if ("->".equals(t.text) || "::".equals(t.text)) { + return false; + } + } + String fullName = + NameNormalizer.normalizeVariableName( + name, parser.ctx.symbolTable.getCurrentPackage()); + return !GlobalVariable.isGlobalCodeRefDefined(fullName); + } + /** * Parses a file handle expression from the token stream. *

diff --git a/src/main/java/org/perlonjava/frontend/parser/OperatorParser.java b/src/main/java/org/perlonjava/frontend/parser/OperatorParser.java index 278657407..a5ecca4bd 100644 --- a/src/main/java/org/perlonjava/frontend/parser/OperatorParser.java +++ b/src/main/java/org/perlonjava/frontend/parser/OperatorParser.java @@ -976,7 +976,8 @@ static OperatorNode parseStat(Parser parser, LexerToken token, int currentIndex) // Consume it here, before generic expression parsing can turn it into a subroutine call. if (nextToken.type == IDENTIFIER) { String name = nextToken.text; - if (name.matches("^[A-Z_][A-Z0-9_]*$")) { + if (FileHandle.shouldTreatAllCapsIdentifierAsBareFileHandleSlot( + parser, name, parser.tokenIndex)) { TokenUtils.consume(parser); // autovivify filehandle and convert to globref GlobalVariable.getGlobalIO(FileHandle.normalizeBarewordHandle(parser, name)); diff --git a/src/main/java/org/perlonjava/frontend/parser/ParsePrimary.java b/src/main/java/org/perlonjava/frontend/parser/ParsePrimary.java index 4cf768b3b..7d0da8024 100644 --- a/src/main/java/org/perlonjava/frontend/parser/ParsePrimary.java +++ b/src/main/java/org/perlonjava/frontend/parser/ParsePrimary.java @@ -501,13 +501,10 @@ private static Node parseFileTestOperator(Parser parser, LexerToken nextToken, N // File tests accept bareword filehandles; parse them before generic expression parsing // can turn them into subroutine calls. But '_' is special: it refers to the last stat buffer. - // Don't treat as filehandle if followed by :: (qualified package name like CPAN::find_perl) if (nextToken.type == LexerTokenType.IDENTIFIER) { String name = nextToken.text; - LexerToken afterName = parser.tokens.size() > parser.tokenIndex + 1 - ? parser.tokens.get(parser.tokenIndex + 1) : null; - boolean isQualifiedName = afterName != null && afterName.text.equals("::"); - if (!isQualifiedName && !name.equals("_") && name.matches("^[A-Z_][A-Z0-9_]*$")) { + if (FileHandle.shouldTreatAllCapsIdentifierAsBareFileHandleSlot( + parser, name, parser.tokenIndex)) { TokenUtils.consume(parser); // autovivify filehandle and convert to globref GlobalVariable.getGlobalIO(FileHandle.normalizeBarewordHandle(parser, name)); diff --git a/src/main/java/org/perlonjava/frontend/parser/StatementParser.java b/src/main/java/org/perlonjava/frontend/parser/StatementParser.java index f10613e5e..34d64aa06 100644 --- a/src/main/java/org/perlonjava/frontend/parser/StatementParser.java +++ b/src/main/java/org/perlonjava/frontend/parser/StatementParser.java @@ -672,7 +672,10 @@ public static Node parseUseDeclaration(Parser parser, LexerToken token) { // Parse Version string int currentIndex = parser.tokenIndex; RuntimeScalar versionScalar = scalarUndef; - Node versionNode = parseOptionalPackageVersion(parser); + Node versionNode = + packageName == null + ? parseOptionalPerlBareUseVersion(parser) + : parseOptionalPackageVersion(parser); if (versionNode != null) { if (TokenUtils.peek(parser).text.equals(",")) { // no comma allowed after version @@ -1306,6 +1309,42 @@ public static BlockNode parseOptionalPackageBlock(Parser parser, IdentifierNode return null; } + /** + * Optional version literal after bare {@code use} / {@code no} — {@code use 5.x.y} / + * {@code use v5.36}, not {@code use Module ...}. + *

+ * Splices lexer-split dotted perl versions ({@code 5.38.0}), which must behave as tuples + * (v5.38.0) rather than floats (5.382). + */ + private static Node parseOptionalPerlBareUseVersion(Parser parser) { + LexerToken token = TokenUtils.peek(parser); + if (token.type == LexerTokenType.IDENTIFIER && token.text.matches("^v\\d+(\\.\\d+)*")) { + return parseVstring(parser, TokenUtils.consume(parser).text, parser.tokenIndex); + } + if (token.type != LexerTokenType.NUMBER) { + return null; + } + StringBuilder dotted = new StringBuilder(TokenUtils.consume(parser).text); + while (true) { + int beforeDotCursor = parser.tokenIndex; + if (!TokenUtils.peek(parser).text.equals(".")) { + break; + } + TokenUtils.consume(parser); + LexerToken afterDotPeek = TokenUtils.peek(parser); + if (afterDotPeek.type != LexerTokenType.NUMBER) { + parser.tokenIndex = beforeDotCursor; + break; + } + dotted.append('.').append(TokenUtils.consume(parser).text); + } + String verText = dotted.toString(); + if (verText.chars().filter(c -> c == '.').count() >= 2) { + return new StringNode(verText, parser.tokenIndex); + } + return parseNumber(parser, new LexerToken(LexerTokenType.NUMBER, verText)); + } + /** * Parses an optional package version. * diff --git a/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java b/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java index 1d9b13089..890b717c1 100644 --- a/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java +++ b/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java @@ -177,10 +177,15 @@ static Node parseSubroutineCall(Parser parser, boolean isMethod) { boolean subExists = isNewMethod; String prototype = null; List attributes = null; - RuntimeScalar parseTimeCodeRef = null; + // BytecodeCompiler embeds named &SUB in constant pool after parse(); eval-string units + // run use/no during parse(), so stash deletion can happen before bytecode emission. + // Attach only when THIS parse saw an actual callable (not a bare forward stub) so newer + // compilations after delete $stash{sub} keep fresh semantics (unit/eval_after_stash_delete). + // JVM apply() loads \&name via getGlobalCodeRef (honours local()); BytecodeInterpreter + // consumes parseTimeCodeRef for parity with perl's compile-time \& snapshots (pr694). + RuntimeScalar bytecodeParseTimeCodeSnap = null; if (!isNewMethod && !isMethod && GlobalVariable.existsGlobalCodeRef(fullName)) { RuntimeScalar codeRef = GlobalVariable.getGlobalCodeRef(fullName); - parseTimeCodeRef = codeRef; if (codeRef.value instanceof RuntimeCode runtimeCode) { prototype = runtimeCode.prototype; attributes = runtimeCode.attributes; @@ -192,6 +197,19 @@ static Node parseSubroutineCall(Parser parser, boolean isMethod) { // Forward declarations like `sub foo;` create a RuntimeCode with a non-null // attributes list (possibly empty). Placeholders created implicitly use null. || attributes != null; + boolean isForwardNamedStub = !runtimeCode.isBuiltin && !runtimeCode.defined() + && runtimeCode.subroutine == null + && runtimeCode.methodHandle == null + && runtimeCode.compilerSupplier == null + && attributes != null; + boolean hasCallableImplementation = runtimeCode.defined() + || runtimeCode.compilerSupplier != null + || runtimeCode.subroutine != null + || runtimeCode.methodHandle != null + || runtimeCode.isBuiltin; + if (hasCallableImplementation && !isForwardNamedStub) { + bytecodeParseTimeCodeSnap = codeRef; + } } } if (!subExists && !isNewMethod && !isMethod) { @@ -417,7 +435,30 @@ && isValidIndirectMethod(subName, parser) // Check if the subroutine call has parentheses boolean hasParentheses = peek(parser).text.equals("("); - if (!subExists && !hasParentheses) { + // Unknown callee + `WORD ... =>` LISTOP/hash-pairs (dynamic imports / Moose-style DSL): + // must not route through parseIndirectMethodCall(); see strict + eval regression in unit/pr694. + boolean identifierThenFatArrow = false; + if (!subExists && !hasParentheses && parser.tokenIndex < parser.tokens.size()) { + LexerToken firstArgTok = parser.tokens.get(parser.tokenIndex); + int fatArrowIdx = Whitespace.skipWhitespace(parser, parser.tokenIndex + 1, parser.tokens); + identifierThenFatArrow = + firstArgTok.type == LexerTokenType.IDENTIFIER + && fatArrowIdx < parser.tokens.size() + && "=>".equals(parser.tokens.get(fatArrowIdx).text); + } + // When !subExists, skipping the indirect-object block landed in consumeArgsWithPrototype + // with prototype=null. That parses arguments differently than the list form used for e.g. + // `skip "msg", 2` — and breaks strict bareword DSL pairs like `has foo => (...)` + // (unit/pr694) compared to Perl's `@` LISTOP-ish argument handling. + if (!subExists && !hasParentheses && identifierThenFatArrow) { + ListNode arguments = consumeArgsWithPrototype(parser, "@"); + OperatorNode codeRefNode = new OperatorNode("&", nameNode, currentIndex); + return new BinaryOperatorNode("(", + codeRefNode, + arguments, + currentIndex); + } + if (!subExists && !hasParentheses && !identifierThenFatArrow) { // Perl allows calling not-yet-declared subs without parentheses when the // following token is not an identifier (e.g. `skip "msg", 2;`). // This is heavily used by the perl5 test harness (test.pl) inside SKIP/TODO blocks. @@ -557,8 +598,8 @@ && isValidIndirectMethod(subName, parser) // Rewrite and return the subroutine call as `&name(arguments)` OperatorNode codeRefNode = new OperatorNode("&", nameNode, currentIndex); - if (parseTimeCodeRef != null) { - codeRefNode.setAnnotation("parseTimeCodeRef", parseTimeCodeRef); + if (bytecodeParseTimeCodeSnap != null) { + codeRefNode.setAnnotation("parseTimeCodeRef", bytecodeParseTimeCodeSnap); } return new BinaryOperatorNode("(", codeRefNode, @@ -1422,6 +1463,12 @@ public static ListNode handleNamedSubWithFilter(Parser parser, String subName, S filteredSnapshot.strictOptionsStack.pop(); // Remove the initial value pushed by enterScope filteredSnapshot.strictOptionsStack.push(parser.ctx.symbolTable.strictOptionsStack.peek()); + // Nested subroutine compilations must not inherit require/do compilation-unit flags; + // see EmitSubroutine (anon subs) — flags leak breaks EmitBlock final-statement codegen. + CompilerOptions subCompilerOptions = parser.ctx.compilerOptions.clone(); + subCompilerOptions.compilationUnitFromRequireOrDo = false; + subCompilerOptions.compilationUnitCallerContext = -1; + EmitterContext newCtx = new EmitterContext( new JavaClassInfo(), filteredSnapshot, @@ -1430,7 +1477,7 @@ public static ListNode handleNamedSubWithFilter(Parser parser, String subName, S RuntimeContextType.RUNTIME, true, parser.ctx.errorUtil, - parser.ctx.compilerOptions, + subCompilerOptions, new RuntimeArray() ); diff --git a/src/main/java/org/perlonjava/frontend/semantic/ScopedSymbolTable.java b/src/main/java/org/perlonjava/frontend/semantic/ScopedSymbolTable.java index 8a91addc1..cb7a2ce8c 100644 --- a/src/main/java/org/perlonjava/frontend/semantic/ScopedSymbolTable.java +++ b/src/main/java/org/perlonjava/frontend/semantic/ScopedSymbolTable.java @@ -974,6 +974,21 @@ public void copyFlagsFrom(ScopedSymbolTable source) { this.strictOptionsStack.push(source.strictOptionsStack.peek()); } + /** + * Copies the {@link #packageStack} from another table. Used after eval STRING parsing: + * the parse runs on a fresh symbol-table snapshot whose package directives must be + * reflected during JVM emission after we restore the captured outer lexical scope. + */ + public void copyPackageScopeFrom(ScopedSymbolTable source) { + if (source == null) { + throw new IllegalArgumentException("Source ScopedSymbolTable cannot be null."); + } + packageStack.clear(); + for (PackageInfo info : source.packageStack) { + packageStack.push(info); + } + } + public record PackageInfo(String packageName, boolean isClass, String version) { } } diff --git a/src/main/java/org/perlonjava/runtime/operators/ModuleOperators.java b/src/main/java/org/perlonjava/runtime/operators/ModuleOperators.java index 8d420e9f4..c18a8e77b 100644 --- a/src/main/java/org/perlonjava/runtime/operators/ModuleOperators.java +++ b/src/main/java/org/perlonjava/runtime/operators/ModuleOperators.java @@ -626,6 +626,7 @@ else if (code == null) { } CompilerOptions parsedArgs = new CompilerOptions(); + parsedArgs.compilationUnitFromRequireOrDo = true; parsedArgs.fileName = actualFileName; parsedArgs.incHook = incHookRef; parsedArgs.applySourceFilters = shouldApplyFilters; // Enable source filter preprocessing if needed @@ -716,6 +717,20 @@ else if (code == null) { boolean moduleTrue = featureManager.isFeatureEnabled("module_true"); if (moduleTrue) { result = scalarTrue.getList(); + } else if (isRequire + && parsedArgs.compilationUnitFromRequireOrDo + && result != null + && result.isEmpty()) { + // Deep circular BEGIN/use/require chains (e.g. CPANPLUS::Configure loading + // CPANPLUS::Config while Backend re-enters Configure.pm) occasionally leave the + // compilation unit's apply() propagating an empty RuntimeList even though Perl + // semantics expect the trailing statement value (normally 1;) and $@ is untouched. + // Empty list scalarizes to undef -> false "did not return a true value" from require. + RuntimeScalar errVar = GlobalVariable.getGlobalVariable("main::@"); + String errSnap = errVar != null ? errVar.toString() : ""; + if (errSnap.isEmpty()) { + result = scalarTrue.getList(); + } } // Clear $@ on success. do FILE is like eval STRING, which clears $@ diff --git a/src/main/java/org/perlonjava/runtime/operators/VersionHelper.java b/src/main/java/org/perlonjava/runtime/operators/VersionHelper.java index d7db90278..eb22d6d8a 100644 --- a/src/main/java/org/perlonjava/runtime/operators/VersionHelper.java +++ b/src/main/java/org/perlonjava/runtime/operators/VersionHelper.java @@ -4,6 +4,9 @@ import org.perlonjava.runtime.runtimetypes.RuntimeScalar; import org.perlonjava.runtime.runtimetypes.RuntimeScalarType; +import java.util.ArrayList; +import java.util.StringJoiner; + import static org.perlonjava.runtime.runtimetypes.RuntimeScalarType.*; public class VersionHelper { @@ -357,6 +360,91 @@ public static String normalizeVersion(RuntimeScalar wantVersion) { return normalizedVersion; } + /** + * Normalize for {@code version}-module objects ({@link org.perlonjava.runtime.perlmodule.Version}). + * This is deliberately separate from {@link #normalizeVersion}, which implements the coarser rules + * needed for PerlOnJava {@code use VERSION} / feature-bundle parsing. + */ + public static String normalizeVersionForPerlModule(RuntimeScalar wantVersion) { + String normalizedVersion = wantVersion.toString().trim(); + + if (normalizedVersion.equals("undef") || normalizedVersion.isEmpty()) { + return "0.0.0"; + } + + boolean explicitVString = normalizedVersion.startsWith("v"); + if (wantVersion.type == RuntimeScalarType.VSTRING) { + normalizedVersion = + normalizedVersion.startsWith("v") + ? normalizedVersion.substring(1) + : normalizedVersion; + if (normalizedVersion.matches("\\d+(\\.\\d+)*")) { + return perlTupleForVersionModule(normalizedVersion); + } + normalizedVersion = toDottedString(normalizedVersion); + return perlTupleForVersionModule(normalizedVersion); + } + if (explicitVString) { + normalizedVersion = normalizedVersion.substring(1).replace("_", ""); + return perlTupleForVersionModule(normalizedVersion); + } + + normalizedVersion = normalizedVersion.replaceAll("_", ""); + if (normalizedVersion.matches("^\\d+$")) { + return normalizedVersion; + } + long dotCount = normalizedVersion.chars().filter(ch -> ch == '.').count(); + if (dotCount >= 2 && normalizedVersion.matches("^\\d+(\\.\\d+)+$")) { + return perlTupleForVersionModule(normalizedVersion); + } + if (!normalizedVersion.matches("^\\d+\\.\\d+$")) { + return "0.0.0"; + } + int dotIdx = normalizedVersion.indexOf('.'); + try { + String major = normalizedVersion.substring(0, dotIdx); + Integer.parseInt(major); + String frac = normalizedVersion.substring(dotIdx + 1); + while (!frac.isEmpty() && frac.length() % 3 != 0) { + frac = frac + "0"; + } + StringJoiner out = new StringJoiner(".").add(major); + for (int i = 0; i < frac.length(); i += 3) { + out.add(Integer.toString(Integer.parseInt(frac.substring(i, i + 3)))); + } + return out.toString(); + } catch (NumberFormatException e) { + return "0.0.0"; + } + } + + private static String perlTupleForVersionModule(String dottedNoLeadingV) { + String stripped = dottedNoLeadingV.replace("_", ""); + String[] segs = stripped.split("\\."); + ArrayList comps = new ArrayList<>(segs.length); + try { + for (String seg : segs) { + if (!seg.matches("\\d+")) { + return "0.0.0"; + } + comps.add(Integer.parseInt(seg)); + } + if (comps.isEmpty()) { + return "0.0.0"; + } + while (comps.size() < 3) { + comps.add(0); + } + StringJoiner joiner = new StringJoiner("."); + for (int v : comps) { + joiner.add(Integer.toString(v)); + } + return joiner.toString(); + } catch (NumberFormatException e) { + return "0.0.0"; + } + } + public static String toDottedString(String input) { StringBuilder result = new StringBuilder(); diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/Version.java b/src/main/java/org/perlonjava/runtime/perlmodule/Version.java index 7fca2ef00..b36ae3ab0 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/Version.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/Version.java @@ -173,12 +173,6 @@ else if (versionStr.type == VSTRING) { // Perl 5 treats these as v-strings with is_qv=true isVString = true; version = "v" + version; - } else if (dotCount == 1 && version.length() < 4) { - // If exactly one dot and short, prepend "v" for internal processing - // but keep the original for stringify() and qv flag - version = "v" + version; - // Note: originalVersionStr stays as the user's input (e.g., "1.0") - // Note: isVString remains false - this is a decimal version } } @@ -192,7 +186,8 @@ else if (versionStr.type == VSTRING) { versionObj.put("qv", getScalarBoolean(isVString)); // Parse components - String normalized = VersionHelper.normalizeVersion(new RuntimeScalar(version)); + String normalized = + VersionHelper.normalizeVersionForPerlModule(new RuntimeScalar(version)); versionObj.put("version", new RuntimeScalar(normalized)); } else { // Decimal format @@ -203,7 +198,8 @@ else if (versionStr.type == VSTRING) { versionObj.put("qv", scalarFalse); // Normalize the version - String normalized = VersionHelper.normalizeVersion(new RuntimeScalar(cleanVersion)); + String normalized = + VersionHelper.normalizeVersionForPerlModule(new RuntimeScalar(cleanVersion)); versionObj.put("version", new RuntimeScalar(normalized)); } @@ -269,16 +265,14 @@ public static RuntimeList numify(RuntimeArray args, int ctx) { return new RuntimeScalar(0.0).getList(); } - // Build numified string with 3-digit zero-padded groups - // e.g., "5.42.0" -> "5.042000", "1.2.3" -> "1.002003" - StringBuilder numified = new StringBuilder(); - numified.append(parts[0]); + // Perl version.pm numify — minimum one padded frac group after major (decimal "2" -> "2.000"), + // not always two fractional groups like qv tuples. + StringBuilder numified = new StringBuilder(parts[0]); numified.append("."); - - // Ensure at least 2 sub-version groups (minor, patch) for proper padding - int numGroups = Math.max(parts.length - 1, 2); - for (int i = 0; i < numGroups; i++) { - int val = (i + 1 < parts.length) ? Integer.parseInt(parts[i + 1]) : 0; + int fracSlots = Math.max(parts.length - 1, 1); + for (int i = 0; i < fracSlots; i++) { + int idx = i + 1; + int val = idx < parts.length ? Integer.parseInt(parts[idx]) : 0; numified.append(String.format("%03d", val)); } diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalContext.java b/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalContext.java index 5db5f5690..3882e5f47 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalContext.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalContext.java @@ -76,7 +76,18 @@ public static void initializeGlobals(CompilerOptions compilerOptions) { GlobalVariable.getGlobalVariable("main::\"").set(" "); // initialize $" to " " GlobalVariable.getGlobalVariable("main::a"); // initialize $a to "undef" GlobalVariable.getGlobalVariable("main::b"); // initialize $b to "undef" - GlobalVariable.globalVariables.put("main::!", new ErrnoVariable()); // initialize $! with dualvar support + // $! — errno dualvar. $^E is created as an empty slot by the $^A–$^Z loop above; on POSIX + // $^E always matches $! (perlvar), so share the same ErrnoVariable. On Windows $^E can + // differ from $! (GetLastError vs errno); use a second ErrnoVariable so list assignment + // like ($!,$^E)=(...) in File::Copy restores both values. + ErrnoVariable errnoVar = new ErrnoVariable(); + GlobalVariable.globalVariables.put("main::!", errnoVar); + String dollarCaretE = "main::" + Character.toString((char) ('E' - 'A' + 1)); + if (SystemUtils.osIsWindows()) { + GlobalVariable.globalVariables.put(dollarCaretE, new ErrnoVariable()); + } else { + GlobalVariable.globalVariables.put(dollarCaretE, errnoVar); + } // Initialize $, (output field separator) with special variable class if (!GlobalVariable.globalVariables.containsKey("main::,")) { var ofs = new OutputFieldSeparator(); diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalVariable.java b/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalVariable.java index bec936770..fd0f9d604 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalVariable.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalVariable.java @@ -40,6 +40,16 @@ public class GlobalVariable { // and should survive stash deletion. This matches Perl's behavior where // compiled bytecode holds direct references to CVs that survive stash deletion. private static final Map pinnedCodeRefs = new HashMap<>(); + + /** + * Nesting depth of {@code local *Pkg::name} scopes that reinstall the CODE slot (see + * {@link org.perlonjava.runtime.runtimetypes.RuntimeGlob#dynamicSaveState}). While {@code >0}, + * named invokes must resolve the callee through {@link #getGlobalCodeRef(String)} on each call + * so monkeypatched coderefs are visible (CPANPLUS::Dist::MM). Depth {@code 0}: bytecode may embed + * a parse-time CODeref snapshot so redefinitions preserve Perl compile-time CV binding (op/symbolcache.t). + */ + private static final java.util.concurrent.ConcurrentHashMap globCodeLocalShadowDepth = + new java.util.concurrent.ConcurrentHashMap<>(); private static final Set deletedCodeRefPins = new HashSet<>(); private static final Map compiledCodeRefs = new HashMap<>(); private static int nextCompiledCodeRefId = 1; @@ -256,6 +266,7 @@ public static void resetAllGlobals() { globalHashes.clear(); globalCodeRefs.clear(); pinnedCodeRefs.clear(); + globCodeLocalShadowDepth.clear(); deletedCodeRefPins.clear(); compiledCodeRefs.clear(); nextCompiledCodeRefId = 1; @@ -1001,6 +1012,33 @@ static void replacePinnedCodeRef(String key, RuntimeScalar codeRef) { } } + public static boolean isGlobCodeSlotUnderLocalShadow(String fqGlobName) { + if (fqGlobName == null || fqGlobName.isEmpty()) { + return false; + } + Integer d = globCodeLocalShadowDepth.get(fqGlobName); + return d != null && d > 0; + } + + /** Invoked after {@link RuntimeGlob#dynamicSaveState} replaces the pinned CODE slot. */ + public static void beginGlobCodeLocalShadow(String fqGlobName) { + if (fqGlobName == null || fqGlobName.isEmpty()) { + return; + } + globCodeLocalShadowDepth.merge(fqGlobName, 1, Integer::sum); + } + + /** Invoked after {@link RuntimeGlob#dynamicRestoreState} restores the CODE slot. */ + public static void endGlobCodeLocalShadow(String fqGlobName) { + if (fqGlobName == null || fqGlobName.isEmpty()) { + return; + } + globCodeLocalShadowDepth.computeIfPresent(fqGlobName, (k, v) -> { + int n = v - 1; + return n <= 0 ? null : n; + }); + } + /** * Checks if a global code reference exists AND is defined (has a real subroutine), * without auto-creating an entry. @@ -1013,6 +1051,10 @@ public static boolean isGlobalCodeRefDefined(String key) { if (var != null && var.type == RuntimeScalarType.CODE && var.value instanceof RuntimeCode runtimeCode) { return runtimeCode.defined(); } + RuntimeScalar pinned = pinnedCodeRefs.get(key); + if (pinned != null && pinned.type == RuntimeScalarType.CODE && pinned.value instanceof RuntimeCode pv) { + return pv.defined(); + } return false; } @@ -1025,7 +1067,11 @@ private static boolean codeSlotExists(RuntimeScalar var) { public static RuntimeScalar existsGlobalCodeRefAsScalar(String key) { RuntimeScalar var = globalCodeRefs.get(key); - return codeSlotExists(var) ? scalarTrue : scalarFalse; + if (codeSlotExists(var)) { + return scalarTrue; + } + RuntimeScalar pinned = pinnedCodeRefs.get(key); + return codeSlotExists(pinned) ? scalarTrue : scalarFalse; } public static RuntimeScalar existsGlobalCodeRefAsScalar(RuntimeScalar key) { @@ -1076,6 +1122,13 @@ public static RuntimeScalar definedGlobalCodeRefAsScalar(String key) { if (var != null && var.type == RuntimeScalarType.CODE && var.value instanceof RuntimeCode runtimeCode) { return runtimeCode.defined() ? scalarTrue : scalarFalse; } + // Stash deletes remove the visible map entry while keeping pinned CV holders for + // compiled call sites (see getGlobalCodeRef / perl5 stash delete semantics). + // defined(&NAME) still sees those bodies until the CODeref is reclaimed (pr694). + RuntimeScalar pinned = pinnedCodeRefs.get(key); + if (pinned != null && pinned.type == RuntimeScalarType.CODE && pinned.value instanceof RuntimeCode pv) { + return pv.defined() ? scalarTrue : scalarFalse; + } return scalarFalse; } diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/HashSpecialVariable.java b/src/main/java/org/perlonjava/runtime/runtimetypes/HashSpecialVariable.java index 102129172..3dd3a1ff4 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/HashSpecialVariable.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/HashSpecialVariable.java @@ -390,6 +390,9 @@ public RuntimeScalar remove(Object key) { // Remove only from the visible stash, not from pinned code refs: // compiled call sites keep their CV, while future lookups must see // the deletion and create an undefined slot. + RuntimeScalar savedCodePeek = GlobalVariable.globalCodeRefs.get(fullKey); + RuntimeGlob.anonymizeOrphanNamedCvDetached(fullKey, savedCodePeek); + RuntimeScalar code = GlobalVariable.removeGlobalCodeRefForStashDelete(fullKey); RuntimeScalar scalar = GlobalVariable.globalVariables.remove(fullKey); RuntimeArray array = GlobalVariable.globalArrays.remove(fullKey); diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java index 3747a237b..b399ba2e1 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java @@ -1247,6 +1247,8 @@ public static Class evalStringHelper(RuntimeScalar code, String evalTag, Obje // Always generate a unique filename for each eval to prevent source location collisions String actualFileName = getNextEvalFilename(); evalCompilerOptions.fileName = actualFileName; + evalCompilerOptions.compilationUnitFromRequireOrDo = false; + evalCompilerOptions.compilationUnitCallerContext = -1; // Check if the result is already cached (include hasUnicode, isEvalbytes, byte-string-source, feature flags, and package in cache key) // Skip caching when $^P is set, so each eval gets a unique filename @@ -1398,6 +1400,10 @@ public static Class evalStringHelper(RuntimeScalar code, String evalTag, Obje ScopedSymbolTable postParseSymbolTable = evalCtx.symbolTable; evalCtx.symbolTable = capturedSymbolTable; evalCtx.symbolTable.copyFlagsFrom(postParseSymbolTable); + // Package declarations live only on post-parse snapshot; emitting with the outer + // package (e.g. main) breaks defined &barename / &barename lookups inside + // package blocks (unit/pr694, Moose-style DSL in string eval). + evalCtx.symbolTable.copyPackageScopeFrom(postParseSymbolTable); setCurrentScope(evalCtx.symbolTable); // Use the captured environment array from compile-time to ensure @@ -1730,6 +1736,8 @@ public static RuntimeList evalStringWithInterpreter( } // Always generate a unique filename for each eval to prevent source location collisions evalCompilerOptions.fileName = getNextEvalFilename(); + evalCompilerOptions.compilationUnitFromRequireOrDo = false; + evalCompilerOptions.compilationUnitCallerContext = -1; // Setup for BEGIN block support - create aliases for captured variables. // IMPORTANT: Do NOT mutate AST nodes (e.g. operatorAst.id) here. diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGlob.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGlob.java index 6be0e8913..e9fda4ccb 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGlob.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGlob.java @@ -278,6 +278,8 @@ public RuntimeScalar set(RuntimeScalar value) { // This emulates Perl 5's behavior where replacing a sub frees its op-tree, // causing compile-time constants to be freed and weak refs to be cleared. if (codeContainer.value instanceof RuntimeCode oldCode) { + anonymizeCvReplacedAtGlob( + oldCode, value.value instanceof RuntimeCode incoming ? incoming : null, this.globName); oldCode.clearPadConstantWeakRefs(); // Decrement stashRefCount on the old CODE ref being replaced if (oldCode.stashRefCount > 0) { @@ -1181,6 +1183,7 @@ public void dynamicSaveState() { // assignments during the local scope would mutate the saved snapshot instead // of the new empty code, making the restore a no-op. GlobalVariable.replacePinnedCodeRef(this.globName, newCode); + GlobalVariable.beginGlobCodeLocalShadow(this.globName); GlobalVariable.getGlobalFormatRef(this.globName).dynamicSaveState(); // Create a NEW RuntimeGlob for the local scope and install it in globalIORefs. @@ -1284,11 +1287,62 @@ public void dynamicRestoreState() { // Also restore the pinned code ref so getGlobalCodeRef() returns the // original code object again. GlobalVariable.replacePinnedCodeRef(snap.globName, snap.code); + GlobalVariable.endGlobCodeLocalShadow(snap.globName); InheritanceResolver.invalidateCache(); GlobalVariable.getGlobalFormatRef(snap.globName).dynamicRestoreState(); } + /** + * When {@code delete $stash{'sym'}} removes a compiled package sub whose CV is still referenced, + * B::GV->NAME expects {@code __ANON__}. + */ + public static void anonymizeOrphanNamedCvDetached(String fullGlobKey, RuntimeScalar codeScalar) { + if (fullGlobKey == null || codeScalar == null || !(codeScalar.value instanceof RuntimeCode cv)) { + return; + } + anonymizeDeclaredCvDetachedFromGlobSlot(cv, fullGlobKey); + } + + /** When {@code *Pkg::name = sub { ... }} replaces with an anonymous-ish CV, the displaced CV orphans. */ + private static void anonymizeCvReplacedAtGlob(RuntimeCode displaced, RuntimeCode incoming, String globName) { + if (displaced == null || incoming == null) { + return; + } + boolean incomingAnonLike = + incoming.subName == null + || incoming.subName.isEmpty() + || "__ANON__".equals(incoming.subName); + if (!incomingAnonLike || incoming.explicitlyRenamed) { + return; + } + anonymizeDeclaredCvDetachedFromGlobSlot(displaced, globName); + } + + /** Match declared {@code CvNAME} glob slot; clear stash-install metadata Perl keeps off orphans. */ + private static void anonymizeDeclaredCvDetachedFromGlobSlot(RuntimeCode cv, String globName) { + if (globName == null || cv == null) { + return; + } + int li = globName.lastIndexOf("::"); + if (li <= 0 || li + 2 >= globName.length()) { + return; + } + String pkgGlob = globName.substring(0, li); + String shortGlob = globName.substring(li + 2); + if (!cv.isDeclared + || cv.packageName == null + || cv.subName == null + || !pkgGlob.equals(cv.packageName) + || !shortGlob.equals(cv.subName)) { + return; + } + cv.subName = "__ANON__"; + cv.stashInstallPackage = null; + cv.stashInstallSub = null; + cv.installedViaAnonGlobAssign = false; + } + private record GlobSlotSnapshot( String globName, RuntimeScalar scalar, diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeStash.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeStash.java index c33f14b93..fd2e91a6a 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeStash.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeStash.java @@ -183,6 +183,8 @@ private RuntimeScalar deleteGlob(String k) { RuntimeGlob savedIO = GlobalVariable.globalIORefs.get(fullKey); RuntimeScalar savedCode = GlobalVariable.globalCodeRefs.get(fullKey); + RuntimeGlob.anonymizeOrphanNamedCvDetached(fullKey, savedCode); + // Delete all slots from GlobalVariable. The CODE slot helper removes // the visible stash entry while keeping already-pinned CVs alive for // previously compiled call sites. diff --git a/src/test/resources/unit/cpanplus_dist_mm_can_load_local.t b/src/test/resources/unit/cpanplus_dist_mm_can_load_local.t new file mode 100644 index 000000000..15f58176f --- /dev/null +++ b/src/test/resources/unit/cpanplus_dist_mm_can_load_local.t @@ -0,0 +1,47 @@ +#!/usr/bin/env perl + +use strict; +use warnings; + +use Test::More tests => 1; + +BEGIN { + package CPANPLUS::Dist::MM::CanLoadLocalTestOrig; + our $VERSION = 1; + + sub eu_mm_stub { return 1 } +} + +BEGIN { + package CPANPLUS::Dist::MM::CanLoadLocalTestMM; + use strict; + use warnings; + + BEGIN { + no warnings 'once'; + *can_load = \&CPANPLUS::Dist::MM::CanLoadLocalTestOrig::eu_mm_stub; + } + + # Mirrors CPANPLUS::Dist::MM::format_available's bareword call to imported can_load(). + sub format_available_like_mm { + my $mod = 'ExtUtils::MakeMaker'; + + ### Upstream MM.pm: + ### unless( can_load( modules => { $mod => 0.0 } ) ) { ... } + return unless can_load( modules => { $mod => 0.0 } ); + + return 1; + } +} + +package main; + +{ + no warnings qw(redefine once); + local *CPANPLUS::Dist::MM::CanLoadLocalTestMM::can_load = sub { return 0 }; + + ok( + !CPANPLUS::Dist::MM::CanLoadLocalTestMM::format_available_like_mm(), + q{local *Pkg::can_load makes can_load(modules=>...) observe the monkeypatch}, + ); +} diff --git a/src/test/resources/unit/errno_caret_e_defined.t b/src/test/resources/unit/errno_caret_e_defined.t new file mode 100644 index 000000000..477e26e12 --- /dev/null +++ b/src/test/resources/unit/errno_caret_e_defined.t @@ -0,0 +1,23 @@ +#!/usr/bin/env perl + +use strict; +use warnings; + +use Test::More; + +# $^E must be a real errno slot (like $!), not a fresh undef global — regression +# for File::Copy and anything using $^E + 0 under warnings. + +my $warn = 0; +local $SIG{__WARN__} = sub { $warn++ }; + +my $n = $^E + 0; +is($warn, 0, '$^E + 0 triggers no uninitialized warning'); + +SKIP: { + skip 'MSWin32 uses a separate Win32-error $^E from errno $!', 1 if $^O eq 'MSWin32'; + $! = 2; + cmp_ok(0 + $^E, '==', 0 + $!, '$^E numeric matches $! after $! assignment (POSIX)'); +} + +done_testing; diff --git a/src/test/resources/unit/filetest_build_pl_arrow.t b/src/test/resources/unit/filetest_build_pl_arrow.t new file mode 100644 index 000000000..81f2e0431 --- /dev/null +++ b/src/test/resources/unit/filetest_build_pl_arrow.t @@ -0,0 +1,26 @@ +#!/usr/bin/env perl + +use strict; +use warnings; + +use Test::More tests => 1; + +SKIP: { + + skip 'root-style path "/" not useful for filetest portability', 1 unless -e '/'; + + my $ok = eval q{ + use strict; + use warnings; + use constant BUILD_PL => sub { '/' }; + + (-e BUILD_PL->()) ? 1 : 0; + }; + + diag $@ if $@; + + cmp_ok( + $ok, '==', 1, + '-e CONSTANT->(...) treats CONSTANT as invocable sub, not ALLCAPS filehandle slot' + ); +} diff --git a/src/test/resources/unit/version_pm_numify_parity.t b/src/test/resources/unit/version_pm_numify_parity.t new file mode 100644 index 000000000..ede2a074e --- /dev/null +++ b/src/test/resources/unit/version_pm_numify_parity.t @@ -0,0 +1,16 @@ +#!/usr/bin/env perl + +use strict; +use warnings; + +use Test::More tests => 6; +use version (); + +# Matches CPANPLUS::Internals::Utils::_version_to_number + core version.pm tuples/decimals. + +is(version->parse('v1.5')->numify, '1.005000'); +is(version->parse('1.5')->numify, '1.500'); +is(version->parse('v1')->numify, '1.000000'); +is(version->parse('v1.234.5')->numify, '1.234005'); +is(version->parse('2')->numify, '2.000'); +is(version->parse('1.2345')->numify, '1.234500');