diff --git a/dev/design/lexical-warnings.md b/dev/design/lexical-warnings.md index 1f00e48dd..2e7fad22a 100644 --- a/dev/design/lexical-warnings.md +++ b/dev/design/lexical-warnings.md @@ -939,12 +939,196 @@ The following documents were superseded by this one and have been deleted: ## Progress Tracking -### Status: Implementation Ready +### Status: Phase 2 Complete (2026-03-29) ### Completed - [x] Design document created - [x] Superseded design documents deleted +- [x] Phase 1: Infrastructure (2026-03-29) + - Created `WarningBitsRegistry.java` - HashMap registry for class name → warning bits + - Enhanced `WarningFlags.java`: + - Added `PERL5_OFFSETS` map with Perl 5 compatible category offsets + - Added `userCategoryOffsets` for `warnings::register` support + - Added `toWarningBitsString()` for caller()[9] bits format + - Added `isEnabledInBits()` and `isFatalInBits()` utility methods + - Added `registerUserCategoryOffset()` for dynamic category allocation + - Enhanced `ScopedSymbolTable.java`: + - Added `warningFatalStack` for FATAL warnings tracking + - Updated `enterScope()`/`exitScope()` to handle fatal stack + - Updated `snapShot()` and `copyFlagsFrom()` to copy fatal stack + - Added `enableFatalWarningCategory()`, `disableFatalWarningCategory()`, `isFatalWarningCategory()` + - Added `getWarningBitsString()` for caller()[9] support +- [x] Phase 2: Two-variant operator methods (2026-03-29) + - Added `getNumberWarn(String operation)` to `RuntimeScalar.java`: + - Centralizes undef check and warning emission + - Correctly handles tied scalars (single FETCH) + - Returns scalarZero for UNDEF after emitting warning + - Added warn variants to `MathOperators.java`: + - `addWarn()` (both scalar,int and scalar,scalar) + - `subtractWarn()` (both variants) + - `multiplyWarn()` + - `divideWarn()` + - `modulusWarn()` + - `powWarn()` + - `unaryMinusWarn()` + - Refactored existing operators to remove inline warnings (fast path) + - Added warn operator entries to `OperatorHandler.java`: + - `+_warn`, `-_warn`, `*_warn`, `/_warn`, `%_warn`, `**_warn`, `unaryMinus_warn` + - Emitter already uses `OperatorHandler.getWarn()` based on `isWarningCategoryEnabled("uninitialized")` +- [x] Phase 3: Per-closure warning bits storage for JVM backend (2026-03-29) + - Added `WarningBitsRegistry.java` in `org.perlonjava.runtime`: + - ConcurrentHashMap from class name to warning bits string + - `register()` method called from class static initializer + - `get()` method for caller() lookups + - `clear()` method for PerlLanguageProvider.resetAll() + - Updated `EmitterMethodCreator.java`: + - Added `WARNING_BITS` static final field to generated classes + - Added `` static initializer to register bits with WarningBitsRegistry + - Updated `RuntimeCode.callerWithSub()`: + - Added `extractJavaClassNames()` helper to get Java class names from stack trace + - Element 9 now looks up warning bits from WarningBitsRegistry + - **Known Limitation**: Warning bits are per-class, not per-call-site + - Perl 5 tracks warning bits at statement granularity + - PerlOnJava tracks at class (closure) granularity + - All calls from the same class share the same warning bits + - Different closures DO get their own warning bits (correctly) +- [x] Phase 4: Per-closure warning bits storage for interpreter (2026-03-29) + - Added `warningBitsString` field to `InterpretedCode.java`: + - Stores Perl 5 compatible warning bits string + - Passed from BytecodeCompiler using symbolTable.getWarningBitsString() + - Updated constructors in `InterpretedCode.java`: + - Main constructor accepts warningBitsString parameter + - Registers with WarningBitsRegistry using "interpreter:" + identityHashCode key + - withCapturedVars() copies warningBitsString to new instance + - Updated `BytecodeCompiler.buildInterpretedCode()`: + - Extracts warningBitsString from emitterContext.symbolTable + - Passes to InterpretedCode constructor + - `extractJavaClassNames()` in RuntimeCode already handles interpreter frames + - Uses "interpreter:" + System.identityHashCode(frame.code()) as registry key +- [x] Phase 6: warnings:: functions using caller()[9] (2026-03-29) + - Updated `Warnings.java`: + - Added `getWarningBitsAtLevel()` helper to get warning bits from caller() + - `enabled()` now uses caller()[9] with `WarningFlags.isEnabledInBits()` + - `warnif()` now checks caller()[9] and handles FATAL warnings + - Added `fatal_enabled()` using `WarningFlags.isFatalInBits()` + - Added `enabled_at_level()` for checking at specific stack levels + - Added `fatal_enabled_at_level()` for FATAL check at specific levels + - Added `warnif_at_level()` for warning at specific stack levels + - Registered new methods in initialize(): + - `warnings::enabled_at_level`, `warnings::fatal_enabled` + - `warnings::fatal_enabled_at_level`, `warnings::warnif_at_level` ### Next Steps -1. Implement Phase 1: Infrastructure -2. Continue with remaining phases + +#### Phase 9: Per-Call-Site Warning Bits (Future) + +**Goal:** Enable block-scoped `use warnings` / `no warnings` to work correctly. + +**Current Limitation:** +Warning bits are captured per-class at compile time. This means: +```perl +sub foo { + my $x; + print $x . "a"; # Uses class-level warning bits + { + no warnings 'uninitialized'; + print $x . "b"; # Still uses class-level bits - warns incorrectly! + } +} +``` + +**Proposed Solution:** +Store warning bits per-statement (call-site) rather than per-class. + +**Implementation Approach:** + +1. **Compile-time: Emit warning bits with each statement** + - Each statement that can warn stores its warning bits as a parameter + - Example: `concatWarn(a, b, warningBits)` instead of `concatWarn(a, b)` + - The `warningBits` is a compile-time constant string + +2. **Runtime: Check bits at call site** + - Warning operators receive the bits as a parameter + - `warnWithCategory()` uses the passed bits instead of looking up caller() + - No ThreadLocal or caller() lookup needed for most cases + +3. **Alternative: Scope ID approach** + - Each scope gets a unique ID at compile time + - Store `scopeId → warningBits` mapping in registry + - Emit `local ${^WARNING_SCOPE} = scopeId` at scope entry + - Runtime looks up bits by current scope ID + +**Trade-offs:** + +| Approach | Pros | Cons | +|----------|------|------| +| Per-statement bits | Fast, no lookup | Increases bytecode size | +| Scope ID registry | Smaller bytecode | Runtime lookup overhead | + +**Files to Modify:** +- `EmitOperator.java` - Pass warning bits to warn variants +- `StringOperators.java` (and others) - Accept bits parameter +- `WarnDie.java` - Use passed bits instead of caller() lookup +- `ScopedSymbolTable.java` - Track scope-level warning changes + +**Estimated Complexity:** Medium-High +- Requires changes to operator signatures +- Need to update all warn-variant operators +- Must maintain backward compatibility + +**Priority:** Low (current implementation handles most use cases) + +### Phase 7-8 Progress (2026-03-29) +- [x] Added `warnWithCategory()` to WarnDie.java: + - Checks if warning category is FATAL in caller's scope + - Uses caller()[9] for subroutine frames + - Falls back to ThreadLocal context stack for top-level code + - Converts warning to die() when FATAL bit is set +- [x] Added ThreadLocal context stack to WarningBitsRegistry: + - `pushCurrent()` / `popCurrent()` track current warning bits during execution + - `getCurrent()` retrieves bits for FATAL checks +- [x] Updated RuntimeCode.apply() to push/pop warning bits +- [x] Updated InterpretedCode.apply() to push/pop warning bits +- [x] Updated StringOperators.stringConcatWarnUninitialized() to use warnWithCategory() + +**FATAL warnings work for:** +- File-scope `use warnings FATAL => 'all'` +- Named subroutines inheriting FATAL from enclosing scope +- Top-level code execution + +**Known limitation:** +Block-scoped `use warnings FATAL` inside a subroutine/program doesn't work because +warning bits are captured per-class at compile time, not per-scope. This would require +per-call-site warning bits for full parity. + +### Phase 8: $^W Interaction (2026-03-29) +- [x] Added `isWarnFlagSet()` helper in Warnings.java: + - Checks if `$^W` global variable is set to a true value + - `$^W` is stored as `main::` + char(23) using Perl's special variable encoding +- [x] Updated `warnif()` to fall back to `$^W`: + - If category is NOT enabled in lexical warnings, check `$^W` + - If `$^W` is true, issue warning + - This allows `$^W` to work with modules using `warnings::warnif()` +- [x] Updated `warnIfAtLevel()` with same `$^W` fallback logic + +**$^W interaction works for:** +- File-scope code without `use warnings` or `no warnings` +- Module code calling `warnings::warnif()` when caller has `$^W = 1` + +**Known limitation:** +Block-scoped `no warnings` doesn't override `$^W` for `warnif()` calls because +our warning bits are per-class, not per-scope. This differs from Perl 5 where +`no warnings` takes precedence over `$^W`. However, file-scope `no warnings` +at the class level does correctly suppress warnings. + +**Test results:** +```perl +# Works correctly: +$^W = 0; warnings::warnif("cat", "msg"); # No warning +$^W = 1; warnings::warnif("cat", "msg"); # Warning issued +use warnings; warnings::warnif("cat", "msg"); # Warning issued (file-scope) + +# Known limitation: +$^W = 1; +{ no warnings; warnings::warnif("cat", "msg"); } # Warning issued (differs from Perl 5) +``` diff --git a/docs/about/changelog.md b/docs/about/changelog.md index ed30a84cd..71241b7ba 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -9,6 +9,7 @@ Release history of PerlOnJava. See [Roadmap](roadmap.md) for future plans. - Tools: added `jcpan`, `jperldoc`, and `jprove` - Perl debugger with `-d` command line option - Add `defer` feature +- Lexical warnings with `use warnings` and FATAL support - Non-local control flow: `last`/`next`/`redo`/`goto LABEL` - Tail call with trampoline for `goto &NAME` and `goto __SUB__` - Add modules: `CPAN`, `Time::Piece`, `TOML`, `DirHandle`, `Dumpvalue`, `Sys::Hostname`, `IO::Socket`, `IO::Socket::INET`, `IO::Socket::UNIX`, `IO::Zlib`, `Archive::Tar`, `Archive::Zip`, `Net::FTP`, `Net::Cmd`, `IPC::Open2`, `IPC::Open3`, `ExtUtils::MakeMaker`. diff --git a/docs/reference/feature-matrix.md b/docs/reference/feature-matrix.md index 2a0090893..de8c6390c 100644 --- a/docs/reference/feature-matrix.md +++ b/docs/reference/feature-matrix.md @@ -68,7 +68,7 @@ PerlOnJava implements most core Perl features with some key differences: - ✅ **Perl-like runtime error messages**: Runtime errors are formatted similarly to Perl's. - ✅ **Comments**: Support for comments and POD (documentation) in code is implemented. - ✅ **Environment**: Support for `PERL5LIB`, `PERL5OPT` environment variables. -- 🚧 **Perl-like warnings**: Warnings is work in progress. Some warnings need to be formatted to resemble Perl's output. +- 🚧 **Perl-like warnings**: Lexical warnings with FATAL support. Block-scoped warnings pending. --- diff --git a/src/main/java/org/perlonjava/app/cli/ArgumentParser.java b/src/main/java/org/perlonjava/app/cli/ArgumentParser.java index 14bcf948f..dd4d3ed35 100644 --- a/src/main/java/org/perlonjava/app/cli/ArgumentParser.java +++ b/src/main/java/org/perlonjava/app/cli/ArgumentParser.java @@ -324,8 +324,8 @@ private static int processClusteredSwitches(String[] args, CompilerOptions parse return index; case 'w': - // enable many useful warnings - parsedArgs.moduleUseStatements.add(new ModuleUseStatement(switchChar, "warnings", null, false)); + // enable many useful warnings by setting $^W = 1 + parsedArgs.warnFlag = true; break; case 'W': // enable all warnings diff --git a/src/main/java/org/perlonjava/app/cli/CompilerOptions.java b/src/main/java/org/perlonjava/app/cli/CompilerOptions.java index fec62f910..34a37d458 100644 --- a/src/main/java/org/perlonjava/app/cli/CompilerOptions.java +++ b/src/main/java/org/perlonjava/app/cli/CompilerOptions.java @@ -82,6 +82,7 @@ public class CompilerOptions implements Cloneable { public boolean unicodeOutput = false; // -CO (same as stdout) public boolean unicodeArgs = false; // -CA public boolean unicodeLocale = false; // -CL + public boolean warnFlag = false; // For -w (sets $^W = 1) public RuntimeScalar incHook = null; // For storing @INC hook reference List moduleUseStatements = new ArrayList<>(); // For -m -M diff --git a/src/main/java/org/perlonjava/app/scriptengine/PerlLanguageProvider.java b/src/main/java/org/perlonjava/app/scriptengine/PerlLanguageProvider.java index 56d3b5177..7da23f67b 100644 --- a/src/main/java/org/perlonjava/app/scriptengine/PerlLanguageProvider.java +++ b/src/main/java/org/perlonjava/app/scriptengine/PerlLanguageProvider.java @@ -245,6 +245,19 @@ public static RuntimeList executePerlAST(Node ast, // can see and modify the enclosing scope's compile-time hints if (savedCurrentScope != null) { globalSymbolTable.setStrictOptions(savedCurrentScope.getStrictOptions()); + // Inherit warning flags so ${^WARNING_BITS} returns correct values in BEGIN blocks + if (!savedCurrentScope.warningFlagsStack.isEmpty()) { + globalSymbolTable.warningFlagsStack.pop(); + globalSymbolTable.warningFlagsStack.push((java.util.BitSet) savedCurrentScope.warningFlagsStack.peek().clone()); + } + if (!savedCurrentScope.warningDisabledStack.isEmpty()) { + globalSymbolTable.warningDisabledStack.pop(); + globalSymbolTable.warningDisabledStack.push((java.util.BitSet) savedCurrentScope.warningDisabledStack.peek().clone()); + } + if (!savedCurrentScope.warningFatalStack.isEmpty()) { + globalSymbolTable.warningFatalStack.pop(); + globalSymbolTable.warningFatalStack.push((java.util.BitSet) savedCurrentScope.warningFatalStack.peek().clone()); + } } EmitterContext ctx = new EmitterContext( diff --git a/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java b/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java index 9afaeb3e3..d68f2408e 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java +++ b/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java @@ -280,6 +280,8 @@ private void enterScope() { st.strictOptionsStack.push(st.strictOptionsStack.peek()); st.featureFlagsStack.push(st.featureFlagsStack.peek()); st.warningFlagsStack.push((java.util.BitSet) st.warningFlagsStack.peek().clone()); + st.warningFatalStack.push((java.util.BitSet) st.warningFatalStack.peek().clone()); + st.warningDisabledStack.push((java.util.BitSet) st.warningDisabledStack.peek().clone()); } } @@ -297,6 +299,8 @@ private void exitScope() { st.strictOptionsStack.pop(); st.featureFlagsStack.pop(); st.warningFlagsStack.pop(); + st.warningFatalStack.pop(); + st.warningDisabledStack.pop(); } } } @@ -528,6 +532,10 @@ public InterpretedCode compile(Node node, EmitterContext ctx) { symbolTable.featureFlagsStack.push(ctx.symbolTable.featureFlagsStack.peek()); symbolTable.warningFlagsStack.pop(); symbolTable.warningFlagsStack.push((java.util.BitSet) ctx.symbolTable.warningFlagsStack.peek().clone()); + symbolTable.warningFatalStack.pop(); + symbolTable.warningFatalStack.push((java.util.BitSet) ctx.symbolTable.warningFatalStack.peek().clone()); + symbolTable.warningDisabledStack.pop(); + symbolTable.warningDisabledStack.push((java.util.BitSet) ctx.symbolTable.warningDisabledStack.peek().clone()); } } @@ -577,10 +585,12 @@ public InterpretedCode compile(Node node, EmitterContext ctx) { int strictOptions = 0; int featureFlags = 0; BitSet warningFlags = new BitSet(); + String warningBitsString = null; if (emitterContext != null && emitterContext.symbolTable != null) { strictOptions = emitterContext.symbolTable.strictOptionsStack.peek(); featureFlags = emitterContext.symbolTable.featureFlagsStack.peek(); warningFlags = (BitSet) emitterContext.symbolTable.warningFlagsStack.peek().clone(); + warningBitsString = emitterContext.symbolTable.getWarningBitsString(); } // Populate debug source lines if in debug mode @@ -608,7 +618,8 @@ public InterpretedCode compile(Node node, EmitterContext ctx) { warningFlags, symbolTable.getCurrentPackage(), evalSiteRegistries.isEmpty() ? null : evalSiteRegistries, - evalSitePragmaFlags.isEmpty() ? null : evalSitePragmaFlags + evalSitePragmaFlags.isEmpty() ? null : evalSitePragmaFlags, + warningBitsString ); // Set optimization flag - if no LOCAL_* or PUSH_LOCAL_VARIABLE opcodes were emitted, // the interpreter can skip DynamicVariableManager.getLocalLevel/popToLocalLevel @@ -5286,6 +5297,10 @@ public void visit(CompilerFlagNode node) { ScopedSymbolTable st = emitterContext.symbolTable; st.warningFlagsStack.pop(); st.warningFlagsStack.push((java.util.BitSet) node.getWarningFlags().clone()); + st.warningFatalStack.pop(); + st.warningFatalStack.push((java.util.BitSet) node.getWarningFatalFlags().clone()); + st.warningDisabledStack.pop(); + st.warningDisabledStack.push((java.util.BitSet) node.getWarningDisabledFlags().clone()); st.featureFlagsStack.pop(); st.featureFlagsStack.push(node.getFeatureFlags()); st.strictOptionsStack.pop(); @@ -5297,6 +5312,10 @@ public void visit(CompilerFlagNode node) { symbolTable.strictOptionsStack.push(node.getStrictOptions()); symbolTable.warningFlagsStack.pop(); symbolTable.warningFlagsStack.push((java.util.BitSet) node.getWarningFlags().clone()); + symbolTable.warningFatalStack.pop(); + symbolTable.warningFatalStack.push((java.util.BitSet) node.getWarningFatalFlags().clone()); + symbolTable.warningDisabledStack.pop(); + symbolTable.warningDisabledStack.push((java.util.BitSet) node.getWarningDisabledFlags().clone()); lastResultReg = -1; } diff --git a/src/main/java/org/perlonjava/backend/bytecode/CompileAssignment.java b/src/main/java/org/perlonjava/backend/bytecode/CompileAssignment.java index d66a14a1d..069d712ab 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/CompileAssignment.java +++ b/src/main/java/org/perlonjava/backend/bytecode/CompileAssignment.java @@ -1,5 +1,6 @@ package org.perlonjava.backend.bytecode; +import org.perlonjava.frontend.analysis.ConstantFoldingVisitor; import org.perlonjava.frontend.analysis.LValueVisitor; import org.perlonjava.frontend.astnode.*; import org.perlonjava.runtime.runtimetypes.NameNormalizer; @@ -1549,6 +1550,20 @@ public static void compileAssignmentOperator(BytecodeCompiler bytecodeCompiler, return; } + // Handle constant-folded logical operators: e.g. `1 && my $x = val` → `my $x = val` + // Perl constant-folds logical ops with constant LHS at compile time. + if (leftBin.operator.equals("&&") || leftBin.operator.equals("and") || + leftBin.operator.equals("||") || leftBin.operator.equals("or") || + leftBin.operator.equals("//")) { + Node foldedLeft = ConstantFoldingVisitor.foldConstants(node.left); + if (foldedLeft != node.left) { + // Operator was folded - recursively handle assignment with folded LHS + BinaryOperatorNode newNode = new BinaryOperatorNode("=", foldedLeft, node.right, node.tokenIndex); + compileAssignmentOperator(bytecodeCompiler, newNode); + return; + } + } + bytecodeCompiler.throwCompilerException("Assignment to non-identifier not yet supported: " + node.left.getClass().getSimpleName()); } else if (node.left instanceof TernaryOperatorNode) { LValueVisitor.getContext(node.left); diff --git a/src/main/java/org/perlonjava/backend/bytecode/CompileBinaryOperator.java b/src/main/java/org/perlonjava/backend/bytecode/CompileBinaryOperator.java index 39aaea7c5..9cacce102 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/CompileBinaryOperator.java +++ b/src/main/java/org/perlonjava/backend/bytecode/CompileBinaryOperator.java @@ -1,8 +1,10 @@ package org.perlonjava.backend.bytecode; +import org.perlonjava.frontend.analysis.ConstantFoldingVisitor; import org.perlonjava.frontend.astnode.*; import org.perlonjava.runtime.runtimetypes.NameNormalizer; import org.perlonjava.runtime.runtimetypes.RuntimeContextType; +import org.perlonjava.runtime.runtimetypes.RuntimeScalar; public class CompileBinaryOperator { static void visitBinaryOperator(BytecodeCompiler bytecodeCompiler, BinaryOperatorNode node) { @@ -377,6 +379,37 @@ else if (node.right instanceof BinaryOperatorNode rightCall) { } // Handle short-circuit operators specially - don't compile right operand yet! + // But first, try constant folding: if LHS is a compile-time constant, eliminate the branch. + if (node.operator.equals("&&") || node.operator.equals("and") || + node.operator.equals("||") || node.operator.equals("or") || + node.operator.equals("//")) { + Node foldedLHS = ConstantFoldingVisitor.foldConstants(node.left); + RuntimeScalar constantLHS = ConstantFoldingVisitor.getConstantValue(foldedLHS); + if (constantLHS != null) { + boolean testResult; + if (node.operator.equals("//")) { + testResult = constantLHS.getDefinedBoolean(); + } else { + testResult = constantLHS.getBoolean(); + } + // For &&/and: true → emit RHS, false → emit LHS + // For ||/or: true → emit LHS, false → emit RHS + // For //: defined → emit LHS, undef → emit RHS + boolean emitLHS; + if (node.operator.equals("&&") || node.operator.equals("and")) { + emitLHS = !testResult; + } else { + emitLHS = testResult; + } + if (emitLHS) { + bytecodeCompiler.compileNode(foldedLHS, -1, bytecodeCompiler.currentCallContext); + } else { + bytecodeCompiler.compileNode(node.right, -1, bytecodeCompiler.currentCallContext); + } + return; + } + } + if (node.operator.equals("&&") || node.operator.equals("and")) { int rd = bytecodeCompiler.allocateOutputRegister(); diff --git a/src/main/java/org/perlonjava/backend/bytecode/InlineOpcodeHandler.java b/src/main/java/org/perlonjava/backend/bytecode/InlineOpcodeHandler.java index dbdeb5336..a87dd96ad 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/InlineOpcodeHandler.java +++ b/src/main/java/org/perlonjava/backend/bytecode/InlineOpcodeHandler.java @@ -1059,6 +1059,7 @@ public static int executeAddAssign(int[] bytecode, int pc, RuntimeBase[] registe if (isImmutableProxy(registers[rd])) { registers[rd] = ensureMutableScalar(registers[rd]); } + // Note: += does NOT warn for uninitialized values in Perl MathOperators.addAssign((RuntimeScalar) registers[rd], (RuntimeScalar) registers[rs]); return pc; } diff --git a/src/main/java/org/perlonjava/backend/bytecode/InterpretedCode.java b/src/main/java/org/perlonjava/backend/bytecode/InterpretedCode.java index 2eed5fd75..1d681c698 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/InterpretedCode.java +++ b/src/main/java/org/perlonjava/backend/bytecode/InterpretedCode.java @@ -1,5 +1,6 @@ package org.perlonjava.backend.bytecode; +import org.perlonjava.runtime.WarningBitsRegistry; import org.perlonjava.runtime.runtimetypes.*; import java.util.BitSet; @@ -67,6 +68,7 @@ public void releaseRegisters() { public final int strictOptions; // Strict flags at compile time public final int featureFlags; // Feature flags at compile time public final BitSet warningFlags; // Warning flags at compile time + public final String warningBitsString; // Perl 5 compatible warning bits string (for caller()[9]) public final String compilePackage; // Package at compile time (for eval STRING name resolution) // Debug information (optional) @@ -101,7 +103,7 @@ public InterpretedCode(int[] bytecode, Object[] constants, String[] stringPool, int strictOptions, int featureFlags, BitSet warningFlags) { this(bytecode, constants, stringPool, maxRegisters, capturedVars, sourceName, sourceLine, pcToTokenIndex, variableRegistry, errorUtil, - strictOptions, featureFlags, warningFlags, "main", null, null); + strictOptions, featureFlags, warningFlags, "main", null, null, null); } public InterpretedCode(int[] bytecode, Object[] constants, String[] stringPool, @@ -114,7 +116,7 @@ public InterpretedCode(int[] bytecode, Object[] constants, String[] stringPool, String compilePackage) { this(bytecode, constants, stringPool, maxRegisters, capturedVars, sourceName, sourceLine, pcToTokenIndex, variableRegistry, errorUtil, - strictOptions, featureFlags, warningFlags, compilePackage, null, null); + strictOptions, featureFlags, warningFlags, compilePackage, null, null, null); } public InterpretedCode(int[] bytecode, Object[] constants, String[] stringPool, @@ -126,7 +128,8 @@ public InterpretedCode(int[] bytecode, Object[] constants, String[] stringPool, int strictOptions, int featureFlags, BitSet warningFlags, String compilePackage, List> evalSiteRegistries, - List evalSitePragmaFlags) { + List evalSitePragmaFlags, + String warningBitsString) { super(null, new java.util.ArrayList<>()); this.bytecode = bytecode; this.constants = constants; @@ -143,10 +146,16 @@ public InterpretedCode(int[] bytecode, Object[] constants, String[] stringPool, this.strictOptions = strictOptions; this.featureFlags = featureFlags; this.warningFlags = warningFlags; + this.warningBitsString = warningBitsString; this.compilePackage = compilePackage; if (this.packageName == null && compilePackage != null) { this.packageName = compilePackage; } + // Register with WarningBitsRegistry for caller()[9] support + if (warningBitsString != null) { + String registryKey = "interpreter:" + System.identityHashCode(this); + WarningBitsRegistry.register(registryKey, warningBitsString); + } } // Legacy constructor for backward compatibility @@ -223,9 +232,17 @@ public RuntimeList apply(RuntimeArray args, int callContext) { // Push args for getCallerArgs() support (used by List::Util::any/all/etc.) // This matches what RuntimeCode.apply() does for JVM-compiled subs RuntimeCode.pushArgs(args); + // Push warning bits for FATAL warnings support + // This allows runtime code to check current warning context + if (warningBitsString != null) { + WarningBitsRegistry.pushCurrent(warningBitsString); + } try { return BytecodeInterpreter.execute(this, args, callContext); } finally { + if (warningBitsString != null) { + WarningBitsRegistry.popCurrent(); + } RuntimeCode.popArgs(); } } @@ -234,9 +251,16 @@ public RuntimeList apply(RuntimeArray args, int callContext) { public RuntimeList apply(String subroutineName, RuntimeArray args, int callContext) { // Push args for getCallerArgs() support (used by List::Util::any/all/etc.) RuntimeCode.pushArgs(args); + // Push warning bits for FATAL warnings support + if (warningBitsString != null) { + WarningBitsRegistry.pushCurrent(warningBitsString); + } try { return BytecodeInterpreter.execute(this, args, callContext, subroutineName); } finally { + if (warningBitsString != null) { + WarningBitsRegistry.popCurrent(); + } RuntimeCode.popArgs(); } } @@ -274,7 +298,8 @@ public InterpretedCode withCapturedVars(RuntimeBase[] capturedVars) { this.warningFlags, this.compilePackage, this.evalSiteRegistries, - this.evalSitePragmaFlags + this.evalSitePragmaFlags, + this.warningBitsString ); copy.prototype = this.prototype; copy.attributes = this.attributes; diff --git a/src/main/java/org/perlonjava/backend/bytecode/OpcodeHandlerExtended.java b/src/main/java/org/perlonjava/backend/bytecode/OpcodeHandlerExtended.java index eb9ce8f12..76204284e 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/OpcodeHandlerExtended.java +++ b/src/main/java/org/perlonjava/backend/bytecode/OpcodeHandlerExtended.java @@ -162,7 +162,8 @@ public static int executePowAssign(int[] bytecode, int pc, RuntimeBase[] registe RuntimeBase val2 = registers[rs]; RuntimeScalar s1 = (val1 instanceof RuntimeScalar) ? (RuntimeScalar) val1 : val1.scalar(); RuntimeScalar s2 = (val2 instanceof RuntimeScalar) ? (RuntimeScalar) val2 : val2.scalar(); - RuntimeScalar result = MathOperators.pow(s1, s2); + // Use warn variant - it checks at runtime if warnings are enabled + RuntimeScalar result = MathOperators.powWarn(s1, s2); ((RuntimeScalar) registers[rd]).set(result); return pc; } @@ -940,6 +941,7 @@ public static int executeSubtractAssign(int[] bytecode, int pc, RuntimeBase[] re RuntimeScalar s1 = (val1 instanceof RuntimeScalar) ? (RuntimeScalar) val1 : val1.scalar(); RuntimeScalar s2 = (val2 instanceof RuntimeScalar) ? (RuntimeScalar) val2 : val2.scalar(); + // Note: -= does NOT warn for uninitialized values in Perl registers[rd] = MathOperators.subtractAssign(s1, s2); return pc; } @@ -961,7 +963,7 @@ public static int executeMultiplyAssign(int[] bytecode, int pc, RuntimeBase[] re RuntimeScalar s1 = (val1 instanceof RuntimeScalar) ? (RuntimeScalar) val1 : val1.scalar(); RuntimeScalar s2 = (val2 instanceof RuntimeScalar) ? (RuntimeScalar) val2 : val2.scalar(); - registers[rd] = MathOperators.multiplyAssign(s1, s2); + registers[rd] = MathOperators.multiplyAssignWarn(s1, s2); return pc; } @@ -981,7 +983,7 @@ public static int executeDivideAssign(int[] bytecode, int pc, RuntimeBase[] regi RuntimeScalar s1 = (val1 instanceof RuntimeScalar) ? (RuntimeScalar) val1 : val1.scalar(); RuntimeScalar s2 = (val2 instanceof RuntimeScalar) ? (RuntimeScalar) val2 : val2.scalar(); - registers[rd] = MathOperators.divideAssign(s1, s2); + registers[rd] = MathOperators.divideAssignWarn(s1, s2); return pc; } @@ -997,7 +999,7 @@ public static int executeModulusAssign(int[] bytecode, int pc, RuntimeBase[] reg RuntimeScalar s1 = (val1 instanceof RuntimeScalar) ? (RuntimeScalar) val1 : val1.scalar(); RuntimeScalar s2 = (val2 instanceof RuntimeScalar) ? (RuntimeScalar) val2 : val2.scalar(); - registers[rd] = MathOperators.modulusAssign(s1, s2); + registers[rd] = MathOperators.modulusAssignWarn(s1, s2); return pc; } } diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitBinaryOperator.java b/src/main/java/org/perlonjava/backend/jvm/EmitBinaryOperator.java index d32fb325e..d44dc35f8 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitBinaryOperator.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitBinaryOperator.java @@ -205,9 +205,18 @@ static void handleBinaryOperator(EmitterVisitor emitterVisitor, BinaryOperatorNo static void handleCompoundAssignment(EmitterVisitor emitterVisitor, BinaryOperatorNode node) { // Compound assignment operators like `+=`, `-=`, etc. // These now have proper overload support via MathOperators.*Assign() methods + + // Operators that SHOULD warn for uninitialized: * / ** << >> x & + // Operators that should NOT warn: + - . | ^ && || + boolean shouldUseWarnVariant = switch (node.operator) { + case "*=", "/=", "%=", "**=", "<<=", ">>=", "x=", "&=" -> true; + default -> false; + }; // Check if we have an operator handler for this compound operator - OperatorHandler operatorHandler = OperatorHandler.get(node.operator); + OperatorHandler operatorHandler = shouldUseWarnVariant + ? OperatorHandler.getWarn(node.operator) + : OperatorHandler.get(node.operator); if (operatorHandler != null) { // Use the new *Assign methods which check for compound overloads first @@ -279,8 +288,13 @@ static void handleCompoundAssignment(EmitterVisitor emitterVisitor, BinaryOperat // perform the operation // Note: operands are already on the stack (left DUPped, then right) String baseOperator = node.operator.substring(0, node.operator.length() - 1); - // Get the operator handler for the base operator and call it directly - OperatorHandler baseOpHandler = OperatorHandler.get(baseOperator); + // Get the operator handler for the base operator, use warn variant only for certain ops + OperatorHandler baseOpHandler = shouldUseWarnVariant + ? OperatorHandler.getWarn(baseOperator) + : OperatorHandler.get(baseOperator); + if (baseOpHandler == null) { + baseOpHandler = OperatorHandler.get(baseOperator); + } if (baseOpHandler != null) { mv.visitMethodInsn( baseOpHandler.methodType(), diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitBinaryOperatorNode.java b/src/main/java/org/perlonjava/backend/jvm/EmitBinaryOperatorNode.java index cc09a8f04..f5e528f56 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitBinaryOperatorNode.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitBinaryOperatorNode.java @@ -87,8 +87,15 @@ public static void emitBinaryOperatorNode(EmitterVisitor emitterVisitor, BinaryO // Binary operators case "%", "&", "&.", "binary&", "*", "**", "+", "-", "/", "<<", "<=>", ">>", "^", "^.", "binary^", "|", "|.", "binary|", - "bless", "cmp", "isa", "~~" -> EmitBinaryOperator.handleBinaryOperator(emitterVisitor, node, - OperatorHandler.get(node.operator)); + "bless", "cmp", "isa", "~~" -> { + // Check if uninitialized warnings are enabled at compile time + // Use warn variant for zero-overhead when warnings disabled + boolean warnUninit = emitterVisitor.ctx.symbolTable.isWarningCategoryEnabled("uninitialized"); + OperatorHandler handler = warnUninit + ? OperatorHandler.getWarn(node.operator) + : OperatorHandler.get(node.operator); + EmitBinaryOperator.handleBinaryOperator(emitterVisitor, node, handler); + } default -> throw new PerlCompilerException(node.tokenIndex, "Not implemented operator: " + node.operator, emitterVisitor.ctx.errorUtil); diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitCompilerFlag.java b/src/main/java/org/perlonjava/backend/jvm/EmitCompilerFlag.java index c55223be0..dae063476 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitCompilerFlag.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitCompilerFlag.java @@ -14,6 +14,14 @@ public static void emitCompilerFlag(EmitterContext ctx, CompilerFlagNode node) { currentScope.warningFlagsStack.pop(); currentScope.warningFlagsStack.push((java.util.BitSet) node.getWarningFlags().clone()); + // Set the fatal warning flags + currentScope.warningFatalStack.pop(); + currentScope.warningFatalStack.push((java.util.BitSet) node.getWarningFatalFlags().clone()); + + // Set the disabled warning flags + currentScope.warningDisabledStack.pop(); + currentScope.warningDisabledStack.push((java.util.BitSet) node.getWarningDisabledFlags().clone()); + // Set the feature flags currentScope.featureFlagsStack.pop(); currentScope.featureFlagsStack.push(node.getFeatureFlags()); @@ -24,6 +32,17 @@ public static void emitCompilerFlag(EmitterContext ctx, CompilerFlagNode node) { EmitterContext.fixupContext(ctx); + // Emit runtime code to update per-call-site warning bits. + // This allows caller()[9] to return accurate warning bits for the current + // statement, not just the class-level bits captured at compilation time. + MethodVisitor mv = ctx.mv; + String newBits = currentScope.getWarningBitsString(); + mv.visitLdcInsn(newBits); + mv.visitMethodInsn(Opcodes.INVOKESTATIC, + "org/perlonjava/runtime/WarningBitsRegistry", + "setCallSiteBits", + "(Ljava/lang/String;)V", false); + // Emit runtime code for warning scope if needed int warningScopeId = node.getWarningScopeId(); if (warningScopeId > 0) { diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitLogicalOperator.java b/src/main/java/org/perlonjava/backend/jvm/EmitLogicalOperator.java index 3e47dd338..3c34490b8 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitLogicalOperator.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitLogicalOperator.java @@ -5,6 +5,7 @@ import org.objectweb.asm.Label; import org.objectweb.asm.MethodVisitor; import org.objectweb.asm.Opcodes; +import org.perlonjava.frontend.analysis.ConstantFoldingVisitor; import org.perlonjava.frontend.analysis.EmitterVisitor; import org.perlonjava.frontend.analysis.FindDeclarationVisitor; import org.perlonjava.frontend.astnode.BinaryOperatorNode; @@ -13,6 +14,7 @@ import org.perlonjava.frontend.astnode.TernaryOperatorNode; import org.perlonjava.runtime.operators.ScalarFlipFlopOperator; import org.perlonjava.runtime.runtimetypes.RuntimeContextType; +import org.perlonjava.runtime.runtimetypes.RuntimeScalar; import static org.perlonjava.runtime.operators.ScalarFlipFlopOperator.flipFlops; @@ -159,6 +161,37 @@ static void emitLogicalAssign(EmitterVisitor emitterVisitor, BinaryOperatorNode * @param getBoolean The method name to convert the result to a boolean. */ static void emitLogicalOperator(EmitterVisitor emitterVisitor, BinaryOperatorNode node, int compareOpcode, String getBoolean) { + // Constant folding: if LHS is a compile-time constant, eliminate the branch entirely. + // This matches Perl's behavior where e.g. `1 && expr` is folded to `expr` at compile time, + // enabling patterns like `my $c = 1 && my $d = 42`. + // Fold the LHS first to handle nested constant expressions like `1 && 2 && expr`. + Node foldedLHS = ConstantFoldingVisitor.foldConstants(node.left); + RuntimeScalar constantLHS = ConstantFoldingVisitor.getConstantValue(foldedLHS); + if (constantLHS != null) { + boolean testResult = "getDefinedBoolean".equals(getBoolean) + ? constantLHS.getDefinedBoolean() + : constantLHS.getBoolean(); + // IFEQ (&&): short-circuits when LHS is false → result is LHS + // IFNE (||, //): short-circuits when LHS is true/defined → result is LHS + boolean shortCircuits = (compareOpcode == Opcodes.IFEQ) ? !testResult : testResult; + if (emitterVisitor.ctx.contextType == RuntimeContextType.VOID) { + // VOID context: only emit code for side effects + if (!shortCircuits) { + // RHS has side effects — emit it in VOID context (it handles its own stack) + node.right.accept(emitterVisitor); + } + // Short-circuit in VOID: nothing to emit — constant has no side effects + return; + } + // Non-VOID context: emit the surviving operand + if (shortCircuits) { + foldedLHS.accept(emitterVisitor); + } else { + node.right.accept(emitterVisitor); + } + return; + } + MethodVisitor mv = emitterVisitor.ctx.mv; int callerContext = emitterVisitor.ctx.contextType; diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitOperator.java b/src/main/java/org/perlonjava/backend/jvm/EmitOperator.java index ad6d1303a..4fde55763 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitOperator.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitOperator.java @@ -32,8 +32,12 @@ static void emitOperator(Node node, EmitterVisitor emitterVisitor) { throw new PerlCompilerException(node.getIndex(), "Node must be OperatorNode or BinaryOperatorNode", emitterVisitor.ctx.errorUtil); } - // Invoke the method for the operator. - OperatorHandler operatorHandler = OperatorHandler.get(operator); + // Check if uninitialized warnings are enabled at compile time + // Use warn variant for zero-overhead when warnings disabled + boolean warnUninit = emitterVisitor.ctx.symbolTable.isWarningCategoryEnabled("uninitialized"); + OperatorHandler operatorHandler = warnUninit + ? OperatorHandler.getWarn(operator) + : OperatorHandler.get(operator); if (operatorHandler == null) { throw new PerlCompilerException(node.getIndex(), "Operator \"" + operator + "\" doesn't have a defined JVM descriptor", emitterVisitor.ctx.errorUtil); } @@ -60,8 +64,12 @@ static void emitOperator(Node node, EmitterVisitor emitterVisitor) { } static void emitOperatorWithKey(String operator, Node node, EmitterVisitor emitterVisitor) { - // Invoke the method for the operator. - OperatorHandler operatorHandler = OperatorHandler.get(operator); + // Check if uninitialized warnings are enabled at compile time + // Use warn variant for zero-overhead when warnings disabled + boolean warnUninit = emitterVisitor.ctx.symbolTable.isWarningCategoryEnabled("uninitialized"); + OperatorHandler operatorHandler = warnUninit + ? OperatorHandler.getWarn(operator) + : OperatorHandler.get(operator); if (operatorHandler == null) { throw new PerlCompilerException(node.getIndex(), "Operator \"" + operator + "\" doesn't have a defined JVM descriptor", emitterVisitor.ctx.errorUtil); } diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java b/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java index 5e7b6537d..9ff60c5ab 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java @@ -135,7 +135,11 @@ public static void emitSubroutine(EmitterContext ctx, SubroutineNode node) { newSymbolTable.setCurrentSubroutine(ctx.symbolTable.getCurrentSubroutine()); } newSymbolTable.warningFlagsStack.pop(); - newSymbolTable.warningFlagsStack.push(ctx.symbolTable.warningFlagsStack.peek()); + newSymbolTable.warningFlagsStack.push((java.util.BitSet) ctx.symbolTable.warningFlagsStack.peek().clone()); + newSymbolTable.warningFatalStack.pop(); + newSymbolTable.warningFatalStack.push((java.util.BitSet) ctx.symbolTable.warningFatalStack.peek().clone()); + newSymbolTable.warningDisabledStack.pop(); + newSymbolTable.warningDisabledStack.push((java.util.BitSet) ctx.symbolTable.warningDisabledStack.peek().clone()); newSymbolTable.featureFlagsStack.pop(); newSymbolTable.featureFlagsStack.push(ctx.symbolTable.featureFlagsStack.peek()); newSymbolTable.strictOptionsStack.pop(); diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitterMethodCreator.java b/src/main/java/org/perlonjava/backend/jvm/EmitterMethodCreator.java index 118e575a3..92d0c63c5 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitterMethodCreator.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitterMethodCreator.java @@ -16,7 +16,9 @@ import org.perlonjava.frontend.analysis.EmitterVisitor; import org.perlonjava.frontend.analysis.TempLocalCountVisitor; import org.perlonjava.frontend.astnode.BlockNode; +import org.perlonjava.frontend.astnode.CompilerFlagNode; import org.perlonjava.frontend.astnode.Node; +import org.perlonjava.frontend.semantic.ScopedSymbolTable; import org.perlonjava.runtime.runtimetypes.*; import java.io.PrintWriter; @@ -453,6 +455,28 @@ private static byte[] getBytecodeInternal(EmitterContext ctx, Node ast, boolean // Add instance field for __SUB__ code reference cw.visitField(Opcodes.ACC_PUBLIC, "__SUB__", "Lorg/perlonjava/runtime/runtimetypes/RuntimeScalar;", null, null).visitEnd(); + // Pre-apply CompilerFlagNodes to capture effective warning flags + // This ensures that 'use warnings FATAL => "all"' affects WARNING_BITS + applyCompilerFlagNodes(ctx, ast); + + // Add static field WARNING_BITS for per-closure warning state (caller()[9] support) + String warningBits = ctx.symbolTable.getWarningBitsString(); + cw.visitField(Opcodes.ACC_PUBLIC | Opcodes.ACC_STATIC | Opcodes.ACC_FINAL, + "WARNING_BITS", "Ljava/lang/String;", null, warningBits).visitEnd(); + + // Create static initializer to register warning bits with WarningBitsRegistry + MethodVisitor clinit = cw.visitMethod(Opcodes.ACC_STATIC, "", "()V", null, null); + clinit.visitCode(); + clinit.visitLdcInsn(className.replace('/', '.')); // Convert to Java class name format + clinit.visitLdcInsn(warningBits); + clinit.visitMethodInsn(Opcodes.INVOKESTATIC, + "org/perlonjava/runtime/WarningBitsRegistry", + "register", + "(Ljava/lang/String;Ljava/lang/String;)V", false); + clinit.visitInsn(Opcodes.RETURN); + clinit.visitMaxs(2, 0); + clinit.visitEnd(); + // Add a constructor with parameters for initializing the fields // Include ALL env slots (even nulls) so signature matches caller expectations StringBuilder constructorDescriptor = new StringBuilder("("); @@ -1718,4 +1742,35 @@ public static void debugInspectClass(Class generatedClass) { } } } + + /** + * Pre-applies CompilerFlagNodes to the symbol table so that warning flags + * (including FATAL and disabled) are captured in WARNING_BITS. + * This scans the AST for CompilerFlagNode nodes at the top level and applies them. + */ + private static void applyCompilerFlagNodes(EmitterContext ctx, Node ast) { + if (ast instanceof BlockNode) { + BlockNode block = (BlockNode) ast; + for (Node stmt : block.elements) { + if (stmt instanceof CompilerFlagNode) { + CompilerFlagNode node = (CompilerFlagNode) stmt; + ScopedSymbolTable currentScope = ctx.symbolTable; + + // Only apply warning flags for WARNING_BITS capture + // Do NOT apply feature flags or strict options here - they must be + // applied in order during code emission to maintain lexical scoping + currentScope.warningFlagsStack.pop(); + currentScope.warningFlagsStack.push((java.util.BitSet) node.getWarningFlags().clone()); + + // Apply fatal warning flags + currentScope.warningFatalStack.pop(); + currentScope.warningFatalStack.push((java.util.BitSet) node.getWarningFatalFlags().clone()); + + // Apply disabled warning flags + currentScope.warningDisabledStack.pop(); + currentScope.warningDisabledStack.push((java.util.BitSet) node.getWarningDisabledFlags().clone()); + } + } + } + } } diff --git a/src/main/java/org/perlonjava/core/Configuration.java b/src/main/java/org/perlonjava/core/Configuration.java index 51b17ed5b..2aa7a642b 100644 --- a/src/main/java/org/perlonjava/core/Configuration.java +++ b/src/main/java/org/perlonjava/core/Configuration.java @@ -33,14 +33,14 @@ public final class Configuration { * Automatically populated by Gradle/Maven during build. * DO NOT EDIT MANUALLY - this value is replaced at build time. */ - public static final String gitCommitId = "acbe5fbb2"; + public static final String gitCommitId = "fd1b70046"; /** * Git commit date of the build (ISO format: YYYY-MM-DD). * Automatically populated by Gradle/Maven during build. * DO NOT EDIT MANUALLY - this value is replaced at build time. */ - public static final String gitCommitDate = "2026-03-29"; + public static final String gitCommitDate = "2026-03-30"; // Prevent instantiation private Configuration() { diff --git a/src/main/java/org/perlonjava/frontend/analysis/ConstantFoldingVisitor.java b/src/main/java/org/perlonjava/frontend/analysis/ConstantFoldingVisitor.java index a0ec6ad4d..a68cb7d48 100644 --- a/src/main/java/org/perlonjava/frontend/analysis/ConstantFoldingVisitor.java +++ b/src/main/java/org/perlonjava/frontend/analysis/ConstantFoldingVisitor.java @@ -108,6 +108,47 @@ public void visit(BinaryOperatorNode node) { Node foldedLeft = foldConstants(node.left); Node foldedRight = foldConstants(node.right); + // Short-circuit constant folding for logical operators. + // Only the LHS needs to be constant for these. + // This matches Perl's behavior: `1 && expr` folds to `expr`, `0 && expr` folds to `0`, etc. + if (isConstantNode(foldedLeft)) { + RuntimeScalar leftVal = getConstantValue(foldedLeft); + if (leftVal != null) { + switch (node.operator) { + case "&&": case "and": + // true && expr → expr; false && expr → false constant + if (leftVal.getBoolean()) { + result = foldedRight; + isConstant = isConstantNode(foldedRight); + } else { + result = foldedLeft; + isConstant = true; + } + return; + case "||": case "or": + // true || expr → true constant; false || expr → expr + if (leftVal.getBoolean()) { + result = foldedLeft; + isConstant = true; + } else { + result = foldedRight; + isConstant = isConstantNode(foldedRight); + } + return; + case "//": + // defined // expr → defined constant; undef // expr → expr + if (leftVal.getDefinedBoolean()) { + result = foldedLeft; + isConstant = true; + } else { + result = foldedRight; + isConstant = isConstantNode(foldedRight); + } + return; + } + } + } + // Check if both operands are constants if (isConstantNode(foldedLeft) && isConstantNode(foldedRight)) { Node folded = foldBinaryOperation(node.operator, foldedLeft, foldedRight, node.tokenIndex); @@ -131,7 +172,8 @@ public void visit(BinaryOperatorNode node) { public void visit(OperatorNode node) { if (node.operand == null) { result = node; - isConstant = false; + // undef is a constant + isConstant = "undef".equals(node.operator); return; } @@ -277,7 +319,9 @@ public void visit(HashLiteralNode node) { } private boolean isConstantNode(Node node) { - return node instanceof NumberNode || node instanceof StringNode; + return node instanceof NumberNode || node instanceof StringNode + || (node instanceof OperatorNode opNode + && "undef".equals(opNode.operator) && opNode.operand == null); } private Node foldFunctionCall(IdentifierNode function, Node args, int tokenIndex) { diff --git a/src/main/java/org/perlonjava/frontend/analysis/FindDeclarationVisitor.java b/src/main/java/org/perlonjava/frontend/analysis/FindDeclarationVisitor.java index 9de87a82a..15eb540f2 100644 --- a/src/main/java/org/perlonjava/frontend/analysis/FindDeclarationVisitor.java +++ b/src/main/java/org/perlonjava/frontend/analysis/FindDeclarationVisitor.java @@ -26,9 +26,17 @@ public class FindDeclarationVisitor implements Visitor { * Stores the found operator node when located */ private OperatorNode operatorNode = null; + /** + * When true, do not descend into BlockNode children. + * Used by findOperator to avoid finding 'my' declarations inside + * do-blocks/if-blocks that have their own scope. + */ + private boolean stopAtBlockNode = false; /** * Static factory method to find a specific operator within an AST node. + * Does not descend into BlockNode or SubroutineNode children, since + * declarations inside those are scoped to their own blocks. * * @param blockNode The AST node to search within * @param operatorName The name of the operator to find @@ -37,6 +45,7 @@ public class FindDeclarationVisitor implements Visitor { public static OperatorNode findOperator(Node blockNode, String operatorName) { FindDeclarationVisitor visitor = new FindDeclarationVisitor(); visitor.operatorName = operatorName; + visitor.stopAtBlockNode = true; blockNode.accept(visitor); return visitor.operatorNode; } @@ -68,9 +77,13 @@ public void visit(FormatNode node) { /** * Visits a block node and searches through its elements. * Stops searching once an operator is found. + * When stopAtBlockNode is true, does not descend (blocks create their own scope). */ @Override public void visit(BlockNode node) { + if (stopAtBlockNode) { + return; + } if (!containsLocalOperator) { for (Node element : node.elements) { if (element != null) { @@ -146,7 +159,11 @@ public void visit(IfNode node) { @Override public void visit(SubroutineNode node) { - node.block.accept(this); + // Do NOT descend into subroutine bodies. + // Variables declared with 'my' inside an anonymous sub are scoped to + // that sub and must not be hoisted to the outer scope. + // Similarly, 'local' and 'defer' inside a sub are handled by the + // sub's own scope management, not the enclosing block. } @Override diff --git a/src/main/java/org/perlonjava/frontend/analysis/LValueVisitor.java b/src/main/java/org/perlonjava/frontend/analysis/LValueVisitor.java index 3d21f84a9..28898a0c5 100644 --- a/src/main/java/org/perlonjava/frontend/analysis/LValueVisitor.java +++ b/src/main/java/org/perlonjava/frontend/analysis/LValueVisitor.java @@ -3,6 +3,7 @@ import org.perlonjava.frontend.astnode.*; import org.perlonjava.runtime.runtimetypes.PerlCompilerException; import org.perlonjava.runtime.runtimetypes.RuntimeContextType; +import org.perlonjava.runtime.runtimetypes.RuntimeScalar; /** * Is this Node assignable (Lvalue) and is it Scalar-like or List-like @@ -64,11 +65,68 @@ public void visit(BinaryOperatorNode node) { // XXX TODO - check for lvalue attribute context = RuntimeContextType.SCALAR; break; + case "&&": + case "and": + // Constant folding: `1 && expr` folds to `expr`, `0 && expr` folds to `0` + handleLogicalLValue(node, true); + break; + case "||": + case "or": + // Constant folding: `0 || expr` folds to `expr`, `1 || expr` folds to `1` + handleLogicalLValue(node, false); + break; + case "//": + // Constant folding: `undef // expr` folds to `expr`, `defined // expr` folds to LHS + handleDefinedOrLValue(node); + break; default: context = RuntimeContextType.VOID; // Not an L-value } } + /** + * Handle lvalue context for && (isAnd=true) and || (isAnd=false) with constant LHS. + * Matches Perl's constant folding: if LHS is a compile-time constant, the logical + * operator is eliminated and the surviving operand determines lvalue context. + */ + private void handleLogicalLValue(BinaryOperatorNode node, boolean isAnd) { + // Fold the LHS first (handles nested constant expressions like `1 && 2 && my $x`) + Node foldedLeft = ConstantFoldingVisitor.foldConstants(node.left); + RuntimeScalar constVal = ConstantFoldingVisitor.getConstantValue(foldedLeft); + if (constVal != null) { + boolean lhsTrue = constVal.getBoolean(); + // For &&: true LHS → RHS survives; false LHS → LHS survives (constant, not lvalue) + // For ||: false LHS → RHS survives; true LHS → LHS survives (constant, not lvalue) + boolean rhsSurvives = isAnd ? lhsTrue : !lhsTrue; + if (rhsSurvives) { + node.right.accept(this); + } else { + context = RuntimeContextType.VOID; // constant is not an lvalue + } + } else { + context = RuntimeContextType.VOID; // non-constant LHS, not an lvalue + } + } + + /** + * Handle lvalue context for // (defined-or) with constant LHS. + */ + private void handleDefinedOrLValue(BinaryOperatorNode node) { + Node foldedLeft = ConstantFoldingVisitor.foldConstants(node.left); + RuntimeScalar constVal = ConstantFoldingVisitor.getConstantValue(foldedLeft); + if (constVal != null) { + if (constVal.getDefinedBoolean()) { + // LHS is defined → LHS survives (constant, not lvalue) + context = RuntimeContextType.VOID; + } else { + // LHS is undef → RHS survives + node.right.accept(this); + } + } else { + context = RuntimeContextType.VOID; // non-constant LHS, not an lvalue + } + } + @Override public void visit(OperatorNode node) { switch (node.operator) { diff --git a/src/main/java/org/perlonjava/frontend/astnode/CompilerFlagNode.java b/src/main/java/org/perlonjava/frontend/astnode/CompilerFlagNode.java index 2a4cce94b..1b715d7a6 100644 --- a/src/main/java/org/perlonjava/frontend/astnode/CompilerFlagNode.java +++ b/src/main/java/org/perlonjava/frontend/astnode/CompilerFlagNode.java @@ -9,6 +9,8 @@ */ public class CompilerFlagNode extends AbstractNode { private final java.util.BitSet warningFlags; + private final java.util.BitSet warningFatalFlags; + private final java.util.BitSet warningDisabledFlags; private final int featureFlags; private final int strictOptions; private final int warningScopeId; // Runtime scope ID for "no warnings" propagation @@ -22,7 +24,7 @@ public class CompilerFlagNode extends AbstractNode { * @param tokenIndex the index of the token in the source code */ public CompilerFlagNode(java.util.BitSet warningFlags, int featureFlags, int strictOptions, int tokenIndex) { - this(warningFlags, featureFlags, strictOptions, 0, tokenIndex); + this(warningFlags, null, null, featureFlags, strictOptions, 0, tokenIndex); } /** @@ -35,7 +37,26 @@ public CompilerFlagNode(java.util.BitSet warningFlags, int featureFlags, int str * @param tokenIndex the index of the token in the source code */ public CompilerFlagNode(java.util.BitSet warningFlags, int featureFlags, int strictOptions, int warningScopeId, int tokenIndex) { + this(warningFlags, null, null, featureFlags, strictOptions, warningScopeId, tokenIndex); + } + + /** + * Constructs a new CompilerFlagNode with all flag states including fatal and disabled warnings. + * + * @param warningFlags the bitmask representing the state of warning flags + * @param warningFatalFlags the bitmask representing FATAL warning flags (may be null) + * @param warningDisabledFlags the bitmask representing disabled warning flags (may be null) + * @param featureFlags the bitmask representing the state of feature flags + * @param strictOptions the bitmask representing the state of strict options + * @param warningScopeId the runtime warning scope ID (0 if not applicable) + * @param tokenIndex the index of the token in the source code + */ + public CompilerFlagNode(java.util.BitSet warningFlags, java.util.BitSet warningFatalFlags, + java.util.BitSet warningDisabledFlags, int featureFlags, int strictOptions, + int warningScopeId, int tokenIndex) { this.warningFlags = (java.util.BitSet) warningFlags.clone(); + this.warningFatalFlags = warningFatalFlags != null ? (java.util.BitSet) warningFatalFlags.clone() : new java.util.BitSet(); + this.warningDisabledFlags = warningDisabledFlags != null ? (java.util.BitSet) warningDisabledFlags.clone() : new java.util.BitSet(); this.featureFlags = featureFlags; this.strictOptions = strictOptions; this.warningScopeId = warningScopeId; @@ -51,6 +72,24 @@ public java.util.BitSet getWarningFlags() { return warningFlags; } + /** + * Returns the bitmask representing FATAL warning flags. + * + * @return the FATAL warning flags bitmask + */ + public java.util.BitSet getWarningFatalFlags() { + return warningFatalFlags; + } + + /** + * Returns the bitmask representing disabled warning flags. + * + * @return the disabled warning flags bitmask + */ + public java.util.BitSet getWarningDisabledFlags() { + return warningDisabledFlags; + } + /** * Returns the bitmask representing the state of feature flags. * diff --git a/src/main/java/org/perlonjava/frontend/parser/NumberParser.java b/src/main/java/org/perlonjava/frontend/parser/NumberParser.java index e7508f9c6..b2fe1e82a 100644 --- a/src/main/java/org/perlonjava/frontend/parser/NumberParser.java +++ b/src/main/java/org/perlonjava/frontend/parser/NumberParser.java @@ -415,7 +415,12 @@ public static RuntimeScalar parseNumber(RuntimeScalar runtimeScalar) { while (start < length && Character.isWhitespace(str.charAt(start))) start++; while (end > start && Character.isWhitespace(str.charAt(end - 1))) end--; + // Track whether to emit a "isn't numeric" warning + boolean shouldWarn = false; + if (start == end) { + // Empty or whitespace-only string: value is 0, but warn if string is non-null + shouldWarn = true; result = getScalarInt(0); } @@ -436,7 +441,6 @@ public static RuntimeScalar parseNumber(RuntimeScalar runtimeScalar) { int numberEnd = start; // Check for special values with trailing characters - boolean shouldWarn = false; String originalStr = str.substring(start, end); int specialEnd = start; @@ -555,39 +559,44 @@ else if (WINDOWS_NAN_PATTERN.matcher(remaining).matches()) { numberEnd = exponentPos; } - if (numberEnd == start) return getScalarInt(0); - - try { - String numberStr = str.substring(start, numberEnd); - if (hasDecimal || hasExponent) { - double value = Double.parseDouble(numberStr); - result = new RuntimeScalar(isNegative ? -value : value); - } else { - long value = Long.parseLong(numberStr); - result = getScalarInt(isNegative ? -value : value); + if (numberEnd == start) { + // No numeric characters found - value is 0, warn about non-numeric string + shouldWarn = true; + result = getScalarInt(0); + } else { + // Trailing non-numeric characters after the number - warn + if (numberEnd < end) { + shouldWarn = true; } - } catch (NumberFormatException e) { + try { - double value = Double.parseDouble(str.substring(start, numberEnd)); - result = new RuntimeScalar(isNegative ? -value : value); - } catch (NumberFormatException e2) { - result = getScalarInt(0); + String numberStr = str.substring(start, numberEnd); + if (hasDecimal || hasExponent) { + double value = Double.parseDouble(numberStr); + result = new RuntimeScalar(isNegative ? -value : value); + } else { + long value = Long.parseLong(numberStr); + result = getScalarInt(isNegative ? -value : value); + } + } catch (NumberFormatException e) { + try { + double value = Double.parseDouble(str.substring(start, numberEnd)); + result = new RuntimeScalar(isNegative ? -value : value); + } catch (NumberFormatException e2) { + result = getScalarInt(0); + } } } } + } - // Generate warning if needed - if (shouldWarn) { - String warnStr = str.trim(); - if (warnStr.startsWith("-") || warnStr.startsWith("+")) { - warnStr = warnStr.substring(1); - } - WarnDie.warn(new RuntimeScalar("Argument \"" + warnStr + "\" isn't numeric"), - RuntimeScalarCache.scalarEmptyString); - } + // Generate warning for non-numeric strings (all cases) + if (shouldWarn) { + WarnDie.warnWithCategory(new RuntimeScalar("Argument \"" + str + "\" isn't numeric"), + RuntimeScalarCache.scalarEmptyString, "numeric"); } - if (result.type != RuntimeScalarType.STRING + if (!shouldWarn && result.type != RuntimeScalarType.STRING && result.type != RuntimeScalarType.BYTE_STRING) { numificationCache.put(str, result); } diff --git a/src/main/java/org/perlonjava/frontend/parser/StatementParser.java b/src/main/java/org/perlonjava/frontend/parser/StatementParser.java index 12a325dbe..070b03e0a 100644 --- a/src/main/java/org/perlonjava/frontend/parser/StatementParser.java +++ b/src/main/java/org/perlonjava/frontend/parser/StatementParser.java @@ -727,8 +727,12 @@ public static Node parseUseDeclaration(Parser parser, LexerToken token) { // return the current compiler flags // If warningScopeId > 0, this node needs to emit runtime code for local ${^WARNING_SCOPE} + java.util.BitSet fatalFlags = (java.util.BitSet) ctx.symbolTable.warningFatalStack.peek().clone(); + java.util.BitSet disabledFlags = (java.util.BitSet) ctx.symbolTable.warningDisabledStack.peek().clone(); CompilerFlagNode result = new CompilerFlagNode( (java.util.BitSet) ctx.symbolTable.warningFlagsStack.getLast().clone(), + fatalFlags, + disabledFlags, ctx.symbolTable.featureFlagsStack.getLast(), ctx.symbolTable.strictOptionsStack.getLast(), warningScopeId, diff --git a/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java b/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java index a6a26939d..d9a1c9b27 100644 --- a/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java +++ b/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java @@ -869,6 +869,14 @@ public static ListNode handleNamedSubWithFilter(Parser parser, String subName, S // Clone warning flags (critical for 'no warnings' pragmas) filteredSnapshot.warningFlagsStack.pop(); // Remove the initial value pushed by enterScope filteredSnapshot.warningFlagsStack.push(parser.ctx.symbolTable.warningFlagsStack.peek()); + + // Clone fatal warning flags (critical for 'use warnings FATAL' pragmas) + filteredSnapshot.warningFatalStack.pop(); + filteredSnapshot.warningFatalStack.push((java.util.BitSet) parser.ctx.symbolTable.warningFatalStack.peek().clone()); + + // Clone disabled warning flags (critical for 'no warnings' pragmas) + filteredSnapshot.warningDisabledStack.pop(); + filteredSnapshot.warningDisabledStack.push((java.util.BitSet) parser.ctx.symbolTable.warningDisabledStack.peek().clone()); // Clone feature flags (critical for 'use feature' pragmas like refaliasing) filteredSnapshot.featureFlagsStack.pop(); // Remove the initial value pushed by enterScope diff --git a/src/main/java/org/perlonjava/frontend/semantic/ScopedSymbolTable.java b/src/main/java/org/perlonjava/frontend/semantic/ScopedSymbolTable.java index a8050a746..ff78f5680 100644 --- a/src/main/java/org/perlonjava/frontend/semantic/ScopedSymbolTable.java +++ b/src/main/java/org/perlonjava/frontend/semantic/ScopedSymbolTable.java @@ -57,6 +57,8 @@ public static void registerCustomWarningCategory(String category) { public final Stack warningFlagsStack = new Stack<>(); // Stack to track explicitly disabled warning categories (for proper $^W interaction) public final Stack warningDisabledStack = new Stack<>(); + // Stack to track FATAL warning categories for each scope + public final Stack warningFatalStack = new Stack<>(); // Stack to manage feature categories for each scope public final Stack featureFlagsStack = new Stack<>(); // Stack to manage strict options for each scope @@ -76,18 +78,16 @@ public static void registerCustomWarningCategory(String category) { * Initializes the warning, feature categories, and strict options stacks with default values for the global scope. */ public ScopedSymbolTable() { - // Initialize the warning categories stack with experimental warnings enabled by default - // Experimental warnings are always on by default in Perl + // Initialize the warning categories stack with empty warnings by default + // This matches Perl behavior where code without explicit 'use warnings' + // has no warning bits set. Experimental warnings will be enabled when + // the relevant features are used (e.g., 'use feature "try"'). BitSet defaultWarnings = new BitSet(); - // Enable all experimental:: warnings by default - for (Map.Entry entry : warningBitPositions.entrySet()) { - if (entry.getKey().startsWith("experimental::")) { - defaultWarnings.set(entry.getValue()); - } - } - warningFlagsStack.push((BitSet) defaultWarnings.clone()); + warningFlagsStack.push(defaultWarnings); // Initialize the disabled warnings stack (empty by default) warningDisabledStack.push(new BitSet()); + // Initialize the fatal warnings stack (empty by default) + warningFatalStack.push(new BitSet()); // Initialize the feature categories stack with an empty map for the global scope featureFlagsStack.push(0); // Initialize the strict options stack with 0 for the global scope @@ -160,6 +160,8 @@ public int enterScope() { warningFlagsStack.push((BitSet) warningFlagsStack.peek().clone()); // Push a copy of the current disabled warnings map onto the stack warningDisabledStack.push((BitSet) warningDisabledStack.peek().clone()); + // Push a copy of the current fatal warnings map onto the stack + warningFatalStack.push((BitSet) warningFatalStack.peek().clone()); // Push a copy of the current feature categories map onto the stack featureFlagsStack.push(featureFlagsStack.peek()); // Push a copy of the current strict options onto the stack @@ -185,6 +187,7 @@ public void exitScope(int scopeIndex) { inSubroutineBodyStack.pop(); warningFlagsStack.pop(); warningDisabledStack.pop(); + warningFatalStack.pop(); featureFlagsStack.pop(); strictOptionsStack.pop(); } @@ -558,6 +561,10 @@ public ScopedSymbolTable snapShot() { st.warningDisabledStack.pop(); // Remove the initial value pushed by enterScope st.warningDisabledStack.push((BitSet) this.warningDisabledStack.peek().clone()); + // Clone fatal warnings flags + st.warningFatalStack.pop(); // Remove the initial value pushed by enterScope + st.warningFatalStack.push((BitSet) this.warningFatalStack.peek().clone()); + // Clone feature flags st.featureFlagsStack.pop(); // Remove the initial value pushed by enterScope st.featureFlagsStack.push(this.featureFlagsStack.peek()); @@ -689,6 +696,51 @@ public boolean isWarningCategoryDisabled(String category) { return bitPosition != null && warningDisabledStack.peek().get(bitPosition); } + /** + * Enables FATAL mode for a warning category. + * When a warning is FATAL, it throws an exception instead of printing a warning. + */ + public void enableFatalWarningCategory(String category) { + Integer bitPosition = warningBitPositions.get(category); + if (bitPosition != null) { + warningFatalStack.peek().set(bitPosition); + // FATAL implies enabled + warningFlagsStack.peek().set(bitPosition); + warningDisabledStack.peek().clear(bitPosition); + } + } + + /** + * Disables FATAL mode for a warning category (warning will be printed, not thrown). + */ + public void disableFatalWarningCategory(String category) { + Integer bitPosition = warningBitPositions.get(category); + if (bitPosition != null) { + warningFatalStack.peek().clear(bitPosition); + } + } + + /** + * Checks if a warning category is in FATAL mode. + */ + public boolean isFatalWarningCategory(String category) { + Integer bitPosition = warningBitPositions.get(category); + return bitPosition != null && warningFatalStack.peek().get(bitPosition); + } + + /** + * Gets the current warning bits as a Perl 5 compatible string. + * This is used for caller()[9] to return the compile-time warning bits. + * Format: each category uses 2 bits - bit 0 = enabled, bit 1 = fatal. + * + * @return A string of bytes representing the warning bits in Perl 5 format. + */ + public String getWarningBitsString() { + BitSet enabled = warningFlagsStack.peek(); + BitSet fatal = warningFatalStack.peek(); + return WarningFlags.toWarningBitsString(enabled, fatal, warningBitPositions); + } + // Methods for managing features using bit positions public void enableFeatureCategory(String feature) { if (isNoOpFeature(feature)) { @@ -700,6 +752,17 @@ public void enableFeatureCategory(String feature) { throw new PerlCompilerException("Feature \"" + feature + "\" is not supported by Perl " + getPerlVersionNoV()); } else { featureFlagsStack.push(featureFlagsStack.pop() | (1 << bitPosition)); + + // Enable the corresponding experimental warning if this is an experimental feature + // In Perl 5, experimental warnings are ON by default for experimental features + String experimentalWarning = "experimental::" + feature; + Integer warnBitPos = warningBitPositions.get(experimentalWarning); + if (warnBitPos != null) { + // Only enable if not explicitly disabled + if (!warningDisabledStack.peek().get(warnBitPos)) { + warningFlagsStack.peek().set(warnBitPos); + } + } } } @@ -752,6 +815,10 @@ public void copyFlagsFrom(ScopedSymbolTable source) { this.warningDisabledStack.pop(); this.warningDisabledStack.push((BitSet) source.warningDisabledStack.peek().clone()); + // Copy fatal warnings flags + this.warningFatalStack.pop(); + this.warningFatalStack.push((BitSet) source.warningFatalStack.peek().clone()); + // Copy feature flags this.featureFlagsStack.pop(); this.featureFlagsStack.push(source.featureFlagsStack.peek()); diff --git a/src/main/java/org/perlonjava/runtime/WarningBitsRegistry.java b/src/main/java/org/perlonjava/runtime/WarningBitsRegistry.java new file mode 100644 index 000000000..0ff9cd5ba --- /dev/null +++ b/src/main/java/org/perlonjava/runtime/WarningBitsRegistry.java @@ -0,0 +1,192 @@ +package org.perlonjava.runtime; + +import java.util.ArrayDeque; +import java.util.Deque; +import java.util.concurrent.ConcurrentHashMap; + +/** + * Registry for per-closure warning bits storage. + * + * Each subroutine/closure stores its compile-time warning bits here, + * allowing caller() to return accurate warning bits for any stack frame. + * + * JVM Backend: Classes register their bits in static initializer. + * Interpreter Backend: InterpretedCode registers bits in constructor. + * + * At runtime, caller() looks up warning bits by class name. + * + * Additionally, a ThreadLocal stack tracks the "current" warning bits + * for runtime code that needs to check FATAL warnings. + */ +public class WarningBitsRegistry { + + // Map from fully-qualified class name to warning bits string + private static final ConcurrentHashMap registry = + new ConcurrentHashMap<>(); + + // ThreadLocal stack of warning bits for the current execution context + // This allows runtime code to find warning bits even at top-level (no subroutine frame) + private static final ThreadLocal> currentBitsStack = + ThreadLocal.withInitial(ArrayDeque::new); + + // ThreadLocal tracking the warning bits at the current call site. + // Updated at runtime when 'use warnings' / 'no warnings' pragmas are encountered. + // This provides per-statement warning bits (like Perl 5's per-COP bits). + private static final ThreadLocal callSiteBits = + ThreadLocal.withInitial(() -> null); + + // ThreadLocal stack saving caller's call-site bits across subroutine calls. + // Each apply() pushes the current callSiteBits before calling the subroutine, + // and pops it when the subroutine returns. This allows caller()[9] to return + // the correct per-call-site warning bits. + private static final ThreadLocal> callerBitsStack = + ThreadLocal.withInitial(ArrayDeque::new); + + /** + * Registers the warning bits for a class. + * Called at class load time (static initializer) for JVM backend, + * or from InterpretedCode constructor for interpreter backend. + * + * @param className The fully-qualified class name + * @param bits The Perl 5 compatible warning bits string + */ + public static void register(String className, String bits) { + if (className != null && bits != null) { + registry.put(className, bits); + } + } + + /** + * Gets the warning bits for a class. + * Called by caller() to retrieve warning bits for a stack frame. + * + * @param className The fully-qualified class name + * @return The warning bits string, or null if not registered + */ + public static String get(String className) { + if (className == null) { + return null; + } + return registry.get(className); + } + + /** + * Pushes warning bits onto the current context stack. + * Called when entering a subroutine or code block with warning settings. + * + * @param bits The warning bits string + */ + public static void pushCurrent(String bits) { + if (bits != null) { + currentBitsStack.get().push(bits); + } + } + + /** + * Pops warning bits from the current context stack. + * Called when exiting a subroutine or code block. + */ + public static void popCurrent() { + Deque stack = currentBitsStack.get(); + if (!stack.isEmpty()) { + stack.pop(); + } + } + + /** + * Gets the current warning bits from the context stack. + * Used by runtime code to check FATAL warnings. + * + * @return The current warning bits string, or null if stack is empty + */ + public static String getCurrent() { + Deque stack = currentBitsStack.get(); + return stack.isEmpty() ? null : stack.peek(); + } + + /** + * Clears all registered warning bits and the current context stack. + * Called by PerlLanguageProvider.resetAll() during reinitialization. + */ + public static void clear() { + registry.clear(); + currentBitsStack.get().clear(); + callSiteBits.remove(); + callerBitsStack.get().clear(); + } + + /** + * Sets the warning bits for the current call site. + * Called at runtime when 'use warnings' / 'no warnings' pragmas are encountered. + * This provides per-statement granularity for caller()[9]. + * + * @param bits The warning bits string for the current call site + */ + public static void setCallSiteBits(String bits) { + callSiteBits.set(bits); + } + + /** + * Gets the warning bits for the current call site. + * + * @return The current call-site warning bits, or null if not set + */ + public static String getCallSiteBits() { + return callSiteBits.get(); + } + + /** + * Saves the current call-site bits onto the caller stack. + * Called by RuntimeCode.apply() before entering a subroutine. + * This preserves the caller's warning bits so caller()[9] can retrieve them. + */ + public static void pushCallerBits() { + String bits = callSiteBits.get(); + callerBitsStack.get().push(bits != null ? bits : ""); + } + + /** + * Restores the caller's call-site bits from the caller stack. + * Called by RuntimeCode.apply() after a subroutine returns. + */ + public static void popCallerBits() { + Deque stack = callerBitsStack.get(); + if (!stack.isEmpty()) { + stack.pop(); + } + } + + /** + * Gets the caller's warning bits at a given frame depth. + * Frame 0 = immediate caller, frame 1 = caller's caller, etc. + * Used by caller()[9] for per-call-site warning bits. + * + * @param frame The frame depth (0 = immediate caller) + * @return The warning bits string, or null if not available + */ + public static String getCallerBitsAtFrame(int frame) { + Deque stack = callerBitsStack.get(); + if (stack.isEmpty()) { + return null; + } + // Stack is LIFO: top = most recent caller (frame 0) + int index = 0; + for (String bits : stack) { + if (index == frame) { + return bits.isEmpty() ? null : bits; + } + index++; + } + return null; + } + + /** + * Returns the number of registered classes. + * Useful for debugging and testing. + * + * @return The number of registered class → bits mappings + */ + public static int size() { + return registry.size(); + } +} diff --git a/src/main/java/org/perlonjava/runtime/io/CustomFileChannel.java b/src/main/java/org/perlonjava/runtime/io/CustomFileChannel.java index 92418a21f..495e6982e 100644 --- a/src/main/java/org/perlonjava/runtime/io/CustomFileChannel.java +++ b/src/main/java/org/perlonjava/runtime/io/CustomFileChannel.java @@ -461,6 +461,12 @@ public RuntimeScalar sysread(int length) { return new RuntimeScalar(result); } catch (IOException e) { + String msg = e.getMessage(); + if (msg != null && msg.toLowerCase().contains("is a directory")) { + // Treat EISDIR as EOF - don't set $! + // This matches platforms that can "read directories as plain files" + return new RuntimeScalar(""); + } getGlobalVariable("main::!").set(e.getMessage()); return new RuntimeScalar(); // undef } diff --git a/src/main/java/org/perlonjava/runtime/operators/MathOperators.java b/src/main/java/org/perlonjava/runtime/operators/MathOperators.java index 41a792ad4..01e66e37c 100644 --- a/src/main/java/org/perlonjava/runtime/operators/MathOperators.java +++ b/src/main/java/org/perlonjava/runtime/operators/MathOperators.java @@ -44,6 +44,40 @@ public static RuntimeScalar add(RuntimeScalar arg1, int arg2) { } } + /** + * Adds an integer to a RuntimeScalar with uninitialized value warnings. + * Called when 'use warnings "uninitialized"' is in effect. + * + * @param arg1 The RuntimeScalar to add to. + * @param arg2 The integer value to add. + * @return A new RuntimeScalar representing the sum. + */ + public static RuntimeScalar addWarn(RuntimeScalar arg1, int arg2) { + // Prepare overload context and check if object is eligible for overloading + int blessId = blessedId(arg1); + if (blessId < 0) { + RuntimeScalar result = OverloadContext.tryTwoArgumentOverload(arg1, new RuntimeScalar(arg2), blessId, 0, "(+", "+"); + if (result != null) return result; + } + + // Convert to number with warning for uninitialized values + arg1 = arg1.getNumberWarn("addition (+)"); + + // Perform addition based on the type of RuntimeScalar + if (arg1.type == DOUBLE) { + return new RuntimeScalar(arg1.getDouble() + arg2); + } else { + long a = arg1.getLong(); + try { + // Note: do not cache, because the result of addition is mutable - t/comp/fold.t + return new RuntimeScalar(Math.addExact(a, arg2)); + } catch (ArithmeticException ignored) { + // Overflow: promote to double (Perl NV semantics) + return new RuntimeScalar((double) a + (double) arg2); + } + } + } + /** * Adds two RuntimeScalar objects and returns the result. * @@ -89,6 +123,53 @@ public static RuntimeScalar add(RuntimeScalar arg1, RuntimeScalar arg2) { } } + /** + * Adds two RuntimeScalar objects with uninitialized value warnings. + * Called when 'use warnings "uninitialized"' is in effect. + * + * @param arg1 The first RuntimeScalar to add. + * @param arg2 The second RuntimeScalar to add. + * @return A new RuntimeScalar representing the sum. + */ + public static RuntimeScalar addWarn(RuntimeScalar arg1, RuntimeScalar arg2) { + // Fast path: both INTEGER - skip blessedId check, getNumber(), type checks + if (arg1.type == INTEGER && arg2.type == INTEGER) { + int a = (int) arg1.value; + int b = (int) arg2.value; + try { + return getScalarInt(Math.addExact(a, b)); + } catch (ArithmeticException ignored) { + return new RuntimeScalar((double) a + (double) b); + } + } + + // Prepare overload context and check if object is eligible for overloading + int blessId = blessedId(arg1); + int blessId2 = blessedId(arg2); + if (blessId < 0 || blessId2 < 0) { + RuntimeScalar result = OverloadContext.tryTwoArgumentOverload(arg1, arg2, blessId, blessId2, "(+", "+"); + if (result != null) return result; + } + + // Convert to number with warning for uninitialized values + arg1 = arg1.getNumberWarn("addition (+)"); + arg2 = arg2.getNumberWarn("addition (+)"); + + // Perform addition based on the type of RuntimeScalar + if (arg1.type == DOUBLE || arg2.type == DOUBLE) { + return new RuntimeScalar(arg1.getDouble() + arg2.getDouble()); + } else { + long a = arg1.getLong(); + long b = arg2.getLong(); + try { + return getScalarInt(Math.addExact(a, b)); + } catch (ArithmeticException ignored) { + // Overflow: promote to double (Perl NV semantics) + return new RuntimeScalar((double) a + (double) b); + } + } + } + /** * Subtracts an integer from a RuntimeScalar and returns the result. * @@ -120,6 +201,39 @@ public static RuntimeScalar subtract(RuntimeScalar arg1, int arg2) { } } + /** + * Subtracts an integer from a RuntimeScalar with uninitialized value warnings. + * Called when 'use warnings "uninitialized"' is in effect. + * + * @param arg1 The RuntimeScalar to subtract from. + * @param arg2 The integer value to subtract. + * @return A new RuntimeScalar representing the difference. + */ + public static RuntimeScalar subtractWarn(RuntimeScalar arg1, int arg2) { + // Prepare overload context and check if object is eligible for overloading + int blessId = blessedId(arg1); + if (blessId < 0) { + RuntimeScalar result = OverloadContext.tryTwoArgumentOverload(arg1, new RuntimeScalar(arg2), blessId, 0, "(-", "-"); + if (result != null) return result; + } + + // Convert to number with warning for uninitialized values + arg1 = arg1.getNumberWarn("subtraction (-)"); + + // Perform subtraction based on the type of RuntimeScalar + if (arg1.type == DOUBLE) { + return new RuntimeScalar(arg1.getDouble() - arg2); + } else { + long a = arg1.getLong(); + try { + return getScalarInt(Math.subtractExact(a, arg2)); + } catch (ArithmeticException ignored) { + // Overflow: promote to double (Perl NV semantics) + return new RuntimeScalar((double) a - (double) arg2); + } + } + } + /** * Subtracts one RuntimeScalar from another and returns the result. * @@ -165,15 +279,63 @@ public static RuntimeScalar subtract(RuntimeScalar arg1, RuntimeScalar arg2) { } } + /** + * Subtracts one RuntimeScalar from another with uninitialized value warnings. + * Called when 'use warnings "uninitialized"' is in effect. + * + * @param arg1 The RuntimeScalar to subtract from. + * @param arg2 The RuntimeScalar to subtract. + * @return A new RuntimeScalar representing the difference. + */ + public static RuntimeScalar subtractWarn(RuntimeScalar arg1, RuntimeScalar arg2) { + // Fast path: both INTEGER - skip blessedId check, getNumber(), type checks + if (arg1.type == INTEGER && arg2.type == INTEGER) { + int a = (int) arg1.value; + int b = (int) arg2.value; + try { + return getScalarInt(Math.subtractExact(a, b)); + } catch (ArithmeticException ignored) { + return new RuntimeScalar((double) a - (double) b); + } + } + + // Prepare overload context and check if object is eligible for overloading + int blessId = blessedId(arg1); + int blessId2 = blessedId(arg2); + if (blessId < 0 || blessId2 < 0) { + RuntimeScalar result = OverloadContext.tryTwoArgumentOverload(arg1, arg2, blessId, blessId2, "(-", "-"); + if (result != null) return result; + } + + // Convert to number with warning for uninitialized values + arg1 = arg1.getNumberWarn("subtraction (-)"); + arg2 = arg2.getNumberWarn("subtraction (-)"); + + // Perform subtraction based on the type of RuntimeScalar + if (arg1.type == DOUBLE || arg2.type == DOUBLE) { + return new RuntimeScalar(arg1.getDouble() - arg2.getDouble()); + } else { + long a = arg1.getLong(); + long b = arg2.getLong(); + try { + return getScalarInt(Math.subtractExact(a, b)); + } catch (ArithmeticException ignored) { + // Overflow: promote to double (Perl NV semantics) + return new RuntimeScalar((double) a - (double) b); + } + } + } + /** * Multiplies two RuntimeScalar objects and returns the result. + * Fast path - no warning checks. * * @param arg1 The first RuntimeScalar to multiply. * @param arg2 The second RuntimeScalar to multiply. * @return A new RuntimeScalar representing the product. */ public static RuntimeScalar multiply(RuntimeScalar arg1, RuntimeScalar arg2) { - // Fast path: both INTEGER - skip blessedId check, getDefinedBoolean(), getNumber() + // Fast path: both INTEGER - skip blessedId check, getNumber(), type checks if (arg1.type == INTEGER && arg2.type == INTEGER) { int a = (int) arg1.value; int b = (int) arg2.value; @@ -192,17 +354,6 @@ public static RuntimeScalar multiply(RuntimeScalar arg1, RuntimeScalar arg2) { if (result != null) return result; } - // Check for uninitialized values and generate warnings - // Use getDefinedBoolean() to handle tied scalars correctly - if (!arg1.getDefinedBoolean()) { - WarnDie.warn(new RuntimeScalar("Use of uninitialized value in multiplication (*)"), - RuntimeScalarCache.scalarEmptyString); - } - if (!arg2.getDefinedBoolean()) { - WarnDie.warn(new RuntimeScalar("Use of uninitialized value in multiplication (*)"), - RuntimeScalarCache.scalarEmptyString); - } - // Convert string type to number if necessary arg1 = arg1.getNumber(); arg2 = arg2.getNumber(); @@ -221,8 +372,56 @@ public static RuntimeScalar multiply(RuntimeScalar arg1, RuntimeScalar arg2) { } } + /** + * Multiplies two RuntimeScalar objects with uninitialized value warnings. + * Called when 'use warnings "uninitialized"' is in effect. + * + * @param arg1 The first RuntimeScalar to multiply. + * @param arg2 The second RuntimeScalar to multiply. + * @return A new RuntimeScalar representing the product. + */ + public static RuntimeScalar multiplyWarn(RuntimeScalar arg1, RuntimeScalar arg2) { + // Fast path: both INTEGER - skip blessedId check, getNumber(), type checks + if (arg1.type == INTEGER && arg2.type == INTEGER) { + int a = (int) arg1.value; + int b = (int) arg2.value; + try { + return getScalarInt(Math.multiplyExact(a, b)); + } catch (ArithmeticException ignored) { + return new RuntimeScalar((double) a * (double) b); + } + } + + // Prepare overload context and check if object is eligible for overloading + int blessId = blessedId(arg1); + int blessId2 = blessedId(arg2); + if (blessId < 0 || blessId2 < 0) { + RuntimeScalar result = OverloadContext.tryTwoArgumentOverload(arg1, arg2, blessId, blessId2, "(*", "*"); + if (result != null) return result; + } + + // Convert to number with warning for uninitialized values + arg1 = arg1.getNumberWarn("multiplication (*)"); + arg2 = arg2.getNumberWarn("multiplication (*)"); + + // Perform multiplication based on the type of RuntimeScalar + if (arg1.type == DOUBLE || arg2.type == DOUBLE) { + return new RuntimeScalar(arg1.getDouble() * arg2.getDouble()); + } else { + long a = arg1.getLong(); + long b = arg2.getLong(); + try { + return getScalarInt(Math.multiplyExact(a, b)); + } catch (ArithmeticException ignored) { + // Overflow: promote to double (Perl NV semantics) + return new RuntimeScalar((double) a * (double) b); + } + } + } + /** * Divides one RuntimeScalar by another and returns the result. + * Fast path - no warning checks. * * @param arg1 The RuntimeScalar to divide. * @param arg2 The RuntimeScalar to divide by. @@ -237,17 +436,6 @@ public static RuntimeScalar divide(RuntimeScalar arg1, RuntimeScalar arg2) { if (result != null) return result; } - // Check for uninitialized values and generate warnings - // Use getDefinedBoolean() to handle tied scalars correctly - if (!arg1.getDefinedBoolean()) { - WarnDie.warn(new RuntimeScalar("Use of uninitialized value in division (/)"), - RuntimeScalarCache.scalarEmptyString); - } - if (!arg2.getDefinedBoolean()) { - WarnDie.warn(new RuntimeScalar("Use of uninitialized value in division (/)"), - RuntimeScalarCache.scalarEmptyString); - } - // Convert string type to number if necessary arg1 = arg1.getNumber(); arg2 = arg2.getNumber(); @@ -267,8 +455,45 @@ public static RuntimeScalar divide(RuntimeScalar arg1, RuntimeScalar arg2) { return new RuntimeScalar(result); } + /** + * Divides one RuntimeScalar by another with uninitialized value warnings. + * Called when 'use warnings "uninitialized"' is in effect. + * + * @param arg1 The RuntimeScalar to divide. + * @param arg2 The RuntimeScalar to divide by. + * @return A new RuntimeScalar representing the quotient. + * @throws PerlCompilerException if division by zero occurs. + */ + public static RuntimeScalar divideWarn(RuntimeScalar arg1, RuntimeScalar arg2) { + // Prepare overload context and check if object is eligible for overloading + int blessId = blessedId(arg1); + if (blessId < 0) { + RuntimeScalar result = OverloadContext.tryTwoArgumentOverload(arg1, arg2, blessId, 0, "(/", "/"); + if (result != null) return result; + } + + // Convert to number with warning for uninitialized values + arg1 = arg1.getNumberWarn("division (/)"); + arg2 = arg2.getNumberWarn("division (/)"); + double divisor = arg2.getDouble(); + // Check for division by zero + if (divisor == 0.0) { + throw new PerlCompilerException("Illegal division by zero"); + } + // Perform division + double result = arg1.getDouble() / divisor; + + // Fix negative zero to positive zero + if (result == 0.0 && Double.doubleToRawLongBits(result) == Double.doubleToRawLongBits(-0.0)) { + result = 0.0; + } + + return new RuntimeScalar(result); + } + /** * Computes the modulus of one RuntimeScalar by another and returns the result. + * Fast path - no warning checks. * * @param arg1 The RuntimeScalar to divide. * @param arg2 The RuntimeScalar to divide by. @@ -321,6 +546,65 @@ public static RuntimeScalar modulus(RuntimeScalar arg1, RuntimeScalar arg2) { return new RuntimeScalar(result); } + /** + * Computes the modulus of one RuntimeScalar by another with uninitialized value warnings. + * Called when 'use warnings "uninitialized"' is in effect. + * + * @param arg1 The RuntimeScalar to divide. + * @param arg2 The RuntimeScalar to divide by. + * @return A new RuntimeScalar representing the modulus. + */ + public static RuntimeScalar modulusWarn(RuntimeScalar arg1, RuntimeScalar arg2) { + // Prepare overload context and check if object is eligible for overloading + int blessId = blessedId(arg1); + if (blessId < 0) { + RuntimeScalar result = OverloadContext.tryTwoArgumentOverload(arg1, arg2, blessId, 0, "(%", "%"); + if (result != null) return result; + } + + // Convert to number with warning for uninitialized values + arg1 = arg1.getNumberWarn("modulus (%)"); + arg2 = arg2.getNumberWarn("modulus (%)"); + + if (arg1.type == DOUBLE || arg2.type == DOUBLE) { + // Use double arithmetic when either argument is a double + double dividend = arg1.getDouble(); + double divisor = arg2.getDouble(); + + // Handle division by zero + if (divisor == 0.0) { + throw new PerlCompilerException("Division by zero in modulus operation"); + } + + // Calculate modulus using double precision + double result = truncate(dividend) % truncate(divisor); + + // Adjust result for Perl-style modulus behavior + // In Perl, the result has the same sign as the divisor + if (result != 0.0 && ((divisor > 0.0 && result < 0.0) || (divisor < 0.0 && result > 0.0))) { + result += divisor; + } + return new RuntimeScalar(result); + } + + // Use long arithmetic to handle large integers (beyond int range) + long dividend = arg1.getLong(); + long divisor = arg2.getLong(); + long result = dividend % divisor; + + // Adjust result for Perl-style modulus behavior + // In Perl, the result has the same sign as the divisor + if (result != 0 && ((divisor > 0 && result < 0) || (divisor < 0 && result > 0))) { + result += divisor; + } + + // Return as int if it fits, otherwise as long + if (result >= Integer.MIN_VALUE && result <= Integer.MAX_VALUE) { + return new RuntimeScalar((int) result); + } + return new RuntimeScalar(result); + } + /** * Compound assignment: += * Checks for (+= overload first, then falls back to (+ overload. @@ -456,6 +740,99 @@ public static RuntimeScalar modulusAssign(RuntimeScalar arg1, RuntimeScalar arg2 return arg1; } + // ========== WARN VARIANTS FOR COMPOUND ASSIGNMENT ========== + // These are called when 'use warnings "uninitialized"' is in effect + + /** + * Compound assignment: += with uninitialized value warnings. + */ + public static RuntimeScalar addAssignWarn(RuntimeScalar arg1, RuntimeScalar arg2) { + int blessId = blessedId(arg1); + int blessId2 = blessedId(arg2); + if (blessId < 0 || blessId2 < 0) { + RuntimeScalar result = OverloadContext.tryTwoArgumentOverload(arg1, arg2, blessId, blessId2, "(+=", "+="); + if (result != null) { + arg1.set(result); + return arg1; + } + } + RuntimeScalar result = addWarn(arg1, arg2); + arg1.set(result); + return arg1; + } + + /** + * Compound assignment: -= with uninitialized value warnings. + */ + public static RuntimeScalar subtractAssignWarn(RuntimeScalar arg1, RuntimeScalar arg2) { + int blessId = blessedId(arg1); + int blessId2 = blessedId(arg2); + if (blessId < 0 || blessId2 < 0) { + RuntimeScalar result = OverloadContext.tryTwoArgumentOverload(arg1, arg2, blessId, blessId2, "(-=", "-="); + if (result != null) { + arg1.set(result); + return arg1; + } + } + RuntimeScalar result = subtractWarn(arg1, arg2); + arg1.set(result); + return arg1; + } + + /** + * Compound assignment: *= with uninitialized value warnings. + */ + public static RuntimeScalar multiplyAssignWarn(RuntimeScalar arg1, RuntimeScalar arg2) { + int blessId = blessedId(arg1); + int blessId2 = blessedId(arg2); + if (blessId < 0 || blessId2 < 0) { + RuntimeScalar result = OverloadContext.tryTwoArgumentOverload(arg1, arg2, blessId, blessId2, "(*=", "*="); + if (result != null) { + arg1.set(result); + return arg1; + } + } + RuntimeScalar result = multiplyWarn(arg1, arg2); + arg1.set(result); + return arg1; + } + + /** + * Compound assignment: /= with uninitialized value warnings. + */ + public static RuntimeScalar divideAssignWarn(RuntimeScalar arg1, RuntimeScalar arg2) { + int blessId = blessedId(arg1); + int blessId2 = blessedId(arg2); + if (blessId < 0 || blessId2 < 0) { + RuntimeScalar result = OverloadContext.tryTwoArgumentOverload(arg1, arg2, blessId, blessId2, "(/=", "/="); + if (result != null) { + arg1.set(result); + return arg1; + } + } + RuntimeScalar result = divideWarn(arg1, arg2); + arg1.set(result); + return arg1; + } + + /** + * Compound assignment: %= with uninitialized value warnings. + */ + public static RuntimeScalar modulusAssignWarn(RuntimeScalar arg1, RuntimeScalar arg2) { + int blessId = blessedId(arg1); + int blessId2 = blessedId(arg2); + if (blessId < 0 || blessId2 < 0) { + RuntimeScalar result = OverloadContext.tryTwoArgumentOverload(arg1, arg2, blessId, blessId2, "(%=", "%="); + if (result != null) { + arg1.set(result); + return arg1; + } + } + RuntimeScalar result = modulusWarn(arg1, arg2); + arg1.set(result); + return arg1; + } + /** * Performs integer division operation on two RuntimeScalars. * This is used when "use integer" pragma is in effect. @@ -600,6 +977,7 @@ public static RuntimeScalar exp(RuntimeScalar runtimeScalar) { /** * Raises a RuntimeScalar to the power of another RuntimeScalar. + * Fast path - no warning checks. * * @param arg1 The base RuntimeScalar. * @param arg2 The exponent RuntimeScalar. @@ -613,17 +991,29 @@ public static RuntimeScalar pow(RuntimeScalar arg1, RuntimeScalar arg2) { if (result != null) return result; } - // Check for uninitialized values and generate warnings - // Use getDefinedBoolean() to handle tied scalars correctly - if (!arg1.getDefinedBoolean()) { - WarnDie.warn(new RuntimeScalar("Use of uninitialized value in exponentiation (**)"), - RuntimeScalarCache.scalarEmptyString); - } - if (!arg2.getDefinedBoolean()) { - WarnDie.warn(new RuntimeScalar("Use of uninitialized value in exponentiation (**)"), - RuntimeScalarCache.scalarEmptyString); + return new RuntimeScalar(Math.pow(arg1.getDouble(), arg2.getDouble())); + } + + /** + * Raises a RuntimeScalar to the power of another RuntimeScalar with uninitialized value warnings. + * Called when 'use warnings "uninitialized"' is in effect. + * + * @param arg1 The base RuntimeScalar. + * @param arg2 The exponent RuntimeScalar. + * @return A new RuntimeScalar representing the power. + */ + public static RuntimeScalar powWarn(RuntimeScalar arg1, RuntimeScalar arg2) { + // Prepare overload context and check if object is eligible for overloading + int blessId = blessedId(arg1); + if (blessId < 0) { + RuntimeScalar result = OverloadContext.tryTwoArgumentOverload(arg1, new RuntimeScalar(arg2), blessId, 0, "(**", "**"); + if (result != null) return result; } + // Convert to number with warning for uninitialized values + arg1 = arg1.getNumberWarn("exponentiation (**)"); + arg2 = arg2.getNumberWarn("exponentiation (**)"); + return new RuntimeScalar(Math.pow(arg1.getDouble(), arg2.getDouble())); } @@ -678,6 +1068,10 @@ public static RuntimeScalar abs(RuntimeScalar runtimeScalar) { } } + /** + * Unary minus operator. + * Fast path - no warning checks. + */ public static RuntimeScalar unaryMinus(RuntimeScalar runtimeScalar) { // Check if object is eligible for overloading int blessId = blessedId(runtimeScalar); @@ -720,6 +1114,47 @@ public static RuntimeScalar unaryMinus(RuntimeScalar runtimeScalar) { return subtract(getScalarInt(0), runtimeScalar); } + /** + * Unary minus operator with uninitialized value warnings. + * Called when 'use warnings "uninitialized"' is in effect. + */ + public static RuntimeScalar unaryMinusWarn(RuntimeScalar runtimeScalar) { + // Check if object is eligible for overloading + int blessId = blessedId(runtimeScalar); + if (blessId < 0) { + RuntimeScalar result = OverloadContext.tryOneArgumentOverload(runtimeScalar, blessId, "(neg", "neg", MathOperators::unaryMinusWarn); + if (result != null) return result; + } + + if (runtimeScalar.isString()) { + String input = runtimeScalar.toString(); + if (input.length() < 2) { + if (input.isEmpty()) { + return getScalarInt(0); + } + if (input.equals("-")) { + return new RuntimeScalar("+"); + } + if (input.equals("+")) { + return new RuntimeScalar("-"); + } + } + // Check if string has non-numeric trailing characters (not purely numeric) + if (!input.matches("^\\s*[-+]?\\d+(\\.\\d+)?([eE][-+]?\\d+)?\\s*$")) { + // String is not purely numeric + if (input.startsWith("-")) { + return new RuntimeScalar("+" + input.substring(1)); + } else if (input.startsWith("+")) { + return new RuntimeScalar("-" + input.substring(1)); + } else if (input.matches("^[_A-Za-z].*")) { + return new RuntimeScalar("-" + input); + } + } + } + // Use subtractWarn to check for uninitialized values + return subtractWarn(getScalarInt(0), runtimeScalar); + } + public static RuntimeScalar integer(RuntimeScalar arg1) { // Check if object is eligible for overloading int blessId = blessedId(arg1); diff --git a/src/main/java/org/perlonjava/runtime/operators/OperatorHandler.java b/src/main/java/org/perlonjava/runtime/operators/OperatorHandler.java index d63c7dec5..c44c74b39 100644 --- a/src/main/java/org/perlonjava/runtime/operators/OperatorHandler.java +++ b/src/main/java/org/perlonjava/runtime/operators/OperatorHandler.java @@ -29,6 +29,16 @@ public record OperatorHandler(String className, String methodName, int methodTyp put("!", "not", "org/perlonjava/runtime/operators/MathOperators", "(Lorg/perlonjava/runtime/runtimetypes/RuntimeScalar;)Lorg/perlonjava/runtime/runtimetypes/RuntimeScalar;"); put("not", "not", "org/perlonjava/runtime/operators/MathOperators", "(Lorg/perlonjava/runtime/runtimetypes/RuntimeScalar;)Lorg/perlonjava/runtime/runtimetypes/RuntimeScalar;"); + // Arithmetic warn variants (with uninitialized value warnings) + // Used when 'use warnings "uninitialized"' is in effect + put("+_warn", "addWarn", "org/perlonjava/runtime/operators/MathOperators"); + put("-_warn", "subtractWarn", "org/perlonjava/runtime/operators/MathOperators"); + put("*_warn", "multiplyWarn", "org/perlonjava/runtime/operators/MathOperators"); + put("/_warn", "divideWarn", "org/perlonjava/runtime/operators/MathOperators"); + put("%_warn", "modulusWarn", "org/perlonjava/runtime/operators/MathOperators"); + put("**_warn", "powWarn", "org/perlonjava/runtime/operators/MathOperators", "(Lorg/perlonjava/runtime/runtimetypes/RuntimeScalar;Lorg/perlonjava/runtime/runtimetypes/RuntimeScalar;)Lorg/perlonjava/runtime/runtimetypes/RuntimeScalar;"); + put("unaryMinus_warn", "unaryMinusWarn", "org/perlonjava/runtime/operators/MathOperators", "(Lorg/perlonjava/runtime/runtimetypes/RuntimeScalar;)Lorg/perlonjava/runtime/runtimetypes/RuntimeScalar;"); + put("^^", "xor", "org/perlonjava/runtime/operators/Operator", "(Lorg/perlonjava/runtime/runtimetypes/RuntimeScalar;Lorg/perlonjava/runtime/runtimetypes/RuntimeScalar;)Lorg/perlonjava/runtime/runtimetypes/RuntimeScalar;"); put("xor", "xor", "org/perlonjava/runtime/operators/Operator", "(Lorg/perlonjava/runtime/runtimetypes/RuntimeScalar;Lorg/perlonjava/runtime/runtimetypes/RuntimeScalar;)Lorg/perlonjava/runtime/runtimetypes/RuntimeScalar;"); @@ -48,6 +58,12 @@ public record OperatorHandler(String className, String methodName, int methodTyp put("*=", "multiplyAssign", "org/perlonjava/runtime/operators/MathOperators"); put("/=", "divideAssign", "org/perlonjava/runtime/operators/MathOperators"); put("%=", "modulusAssign", "org/perlonjava/runtime/operators/MathOperators"); + // Warn variants for compound assignment (when 'use warnings "uninitialized"' is in effect) + put("+=_warn", "addAssignWarn", "org/perlonjava/runtime/operators/MathOperators"); + put("-=_warn", "subtractAssignWarn", "org/perlonjava/runtime/operators/MathOperators"); + put("*=_warn", "multiplyAssignWarn", "org/perlonjava/runtime/operators/MathOperators"); + put("/=_warn", "divideAssignWarn", "org/perlonjava/runtime/operators/MathOperators"); + put("%=_warn", "modulusAssignWarn", "org/perlonjava/runtime/operators/MathOperators"); // Bitwise put("&", "bitwiseAnd", "org/perlonjava/runtime/operators/BitwiseOperators"); @@ -391,6 +407,19 @@ public static OperatorHandler get(String operator) { return operatorHandlers.get(operator); } + /** + * Retrieves the warn variant of an OperatorHandler if available. + * For operators like + and -, returns the warn variant (addWarn, subtractWarn) + * that includes uninitialized value warning checks. + * + * @param operator The operator symbol. + * @return The warn variant OperatorHandler, or the regular handler if no warn variant exists. + */ + public static OperatorHandler getWarn(String operator) { + OperatorHandler warnHandler = operatorHandlers.get(operator + "_warn"); + return warnHandler != null ? warnHandler : operatorHandlers.get(operator); + } + /** * Gets the class name containing the method associated with the operator. * diff --git a/src/main/java/org/perlonjava/runtime/operators/StringOperators.java b/src/main/java/org/perlonjava/runtime/operators/StringOperators.java index ed25f6e4f..b2a74d720 100644 --- a/src/main/java/org/perlonjava/runtime/operators/StringOperators.java +++ b/src/main/java/org/perlonjava/runtime/operators/StringOperators.java @@ -329,8 +329,8 @@ public static RuntimeScalar stringConcatWarnUninitialized(RuntimeScalar runtimeS // Now check definedness on the resolved values (no additional FETCH) if (!aResolved.getDefinedBoolean() || !bResolved.getDefinedBoolean()) { - WarnDie.warn(new RuntimeScalar("Use of uninitialized value in concatenation (.)"), - RuntimeScalarCache.scalarEmptyString); + WarnDie.warnWithCategory(new RuntimeScalar("Use of uninitialized value in concatenation (.)"), + RuntimeScalarCache.scalarEmptyString, "uninitialized"); } // Get string values from resolved scalars diff --git a/src/main/java/org/perlonjava/runtime/operators/WarnDie.java b/src/main/java/org/perlonjava/runtime/operators/WarnDie.java index 1dc583659..71ac16970 100644 --- a/src/main/java/org/perlonjava/runtime/operators/WarnDie.java +++ b/src/main/java/org/perlonjava/runtime/operators/WarnDie.java @@ -1,6 +1,7 @@ package org.perlonjava.runtime.operators; import org.perlonjava.runtime.perlmodule.Universal; +import org.perlonjava.runtime.perlmodule.Warnings; import org.perlonjava.runtime.runtimetypes.*; import static org.perlonjava.runtime.runtimetypes.GlobalVariable.*; @@ -192,6 +193,86 @@ public static RuntimeBase warn(RuntimeBase message, RuntimeScalar where, String return new RuntimeScalar(); } + /** + * Issues a warning message with category checking. + * - If the warning category is not enabled in the caller's scope, suppresses the warning. + * - If the warning category is suppressed at runtime (via "no warnings"), suppresses it. + * - If the warning category is FATAL in the caller's scope, throws an exception instead. + * + * @param message The warning message to be issued. + * @param where Additional context or location information. + * @param category The warning category (e.g., "uninitialized", "numeric"). + * @return A RuntimeBase representing the result of the warning operation. + */ + public static RuntimeBase warnWithCategory(RuntimeBase message, RuntimeScalar where, String category) { + return warnWithCategory(message, where, category, null, 0); + } + + public static RuntimeBase warnWithCategory(RuntimeBase message, RuntimeScalar where, String category, + String fileName, int lineNumber) { + // Get the warning bits for the current Perl execution context. + // We scan the Java call stack for the nearest Perl frame (org.perlonjava.anon* or perlmodule) + // and look up its warning bits in WarningBitsRegistry. + String warningBits = getWarningBitsFromCurrentContext(); + + // If no bits from direct stack scan, check the current context stack (pushed on sub entry) + if (warningBits == null) { + warningBits = org.perlonjava.runtime.WarningBitsRegistry.getCurrent(); + } + + // If warning bits are available, check if this category is enabled + if (warningBits != null) { + if (WarningFlags.isEnabledInBits(warningBits, category)) { + // Category is lexically enabled - check for FATAL + if (WarningFlags.isFatalInBits(warningBits, category)) { + return die(message, where, fileName, lineNumber); + } + // Fall through to emit warning + } else if (!Warnings.isWarnFlagSet()) { + // Category not lexically enabled AND $^W not set - suppress + return new RuntimeScalar(); + } + // If $^W is set, fall through to emit warning even if not lexically enabled + } else { + // No bits from caller - fall back to $^W global flag + if (!Warnings.isWarnFlagSet()) { + return new RuntimeScalar(); + } + } + + // Check if the category is suppressed at runtime via "no warnings" in current scope + if (WarningFlags.isWarningSuppressedAtRuntime(category)) { + return new RuntimeScalar(); + } + + // Issue as regular warning + return warn(message, where, fileName, lineNumber); + } + + /** + * Gets warning bits by scanning the Java call stack for Perl frames. + * This looks for org.perlonjava.anon* and perlmodule classes, which are + * JVM-compiled Perl code, and returns the first found warning bits. + * This is more reliable than using caller() which may skip frames. + * + * @return The warning bits string, or null if not available + */ + private static String getWarningBitsFromCurrentContext() { + Throwable t = new Throwable(); + for (StackTraceElement element : t.getStackTrace()) { + String className = element.getClassName(); + if (className.contains("org.perlonjava.anon") || + className.contains("org.perlonjava.runtime.perlmodule")) { + // Found a Perl frame - look up its warning bits + String bits = org.perlonjava.runtime.WarningBitsRegistry.get(className); + if (bits != null) { + return bits; + } + } + } + return null; + } + /** * Terminates execution with an error message. If a custom die handler is defined * in the global %SIG hash under the "__DIE__" key, it will be invoked with the diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/Warnings.java b/src/main/java/org/perlonjava/runtime/perlmodule/Warnings.java index cbc97c59b..260add150 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/Warnings.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/Warnings.java @@ -1,13 +1,19 @@ package org.perlonjava.runtime.perlmodule; +import org.perlonjava.frontend.semantic.ScopedSymbolTable; import org.perlonjava.runtime.operators.WarnDie; import org.perlonjava.runtime.runtimetypes.*; import java.util.HashSet; import java.util.Set; +import static org.perlonjava.frontend.parser.SpecialBlockParser.getCurrentScope; + /** * The Warnings class provides functionalities similar to the Perl warnings module. + * + * Key methods use caller()[9] to check the warning bits at the caller's scope, + * enabling lexical warning control to work correctly across subroutine calls. */ public class Warnings extends PerlModuleBase { @@ -27,11 +33,15 @@ public Warnings() { public static void initialize() { Warnings warnings = new Warnings(); try { - warnings.registerMethod("enabled", ";$"); + warnings.registerMethod("enabled", "enabled", ";$"); + warnings.registerMethod("fatal_enabled", "fatalEnabled", ";$"); + warnings.registerMethod("enabled_at_level", "enabledAtLevel", "$$"); + warnings.registerMethod("fatal_enabled_at_level", "fatalEnabledAtLevel", "$$"); warnings.registerMethod("import", "useWarnings", ";$"); warnings.registerMethod("unimport", "noWarnings", ";$"); warnings.registerMethod("warn", "warn", "$;$"); warnings.registerMethod("warnif", "warnIf", "$;$"); + warnings.registerMethod("warnif_at_level", "warnIfAtLevel", "$$$"); warnings.registerMethod("register_categories", "registerCategories", ";@"); // Set $VERSION so CPAN.pm can detect our bundled version GlobalVariable.getGlobalVariable("warnings::VERSION").set(new RuntimeScalar("1.74")); @@ -40,6 +50,116 @@ public static void initialize() { } } + /** + * Gets the warning bits string from caller() at the specified level. + * Level 0 is the immediate caller of the warnings:: function. + * + * @param level The stack level (0 = immediate caller) + * @return The warning bits string, or null if not available + */ + private static String getWarningBitsAtLevel(int level) { + // Level 0 = the Perl code that called the warnings:: function + // We add 1 to skip the Java implementation frame (Warnings.java) that appears + // in the caller() stack trace when called from Java code + RuntimeList caller = RuntimeCode.caller( + new RuntimeList(RuntimeScalarCache.getScalarInt(level + 1)), + RuntimeContextType.LIST + ); + if (caller.size() > 9) { + RuntimeBase bitsBase = caller.elements.get(9); + if (bitsBase instanceof RuntimeScalar) { + RuntimeScalar bits = (RuntimeScalar) bitsBase; + if (bits.type != RuntimeScalarType.UNDEF) { + return bits.toString(); + } + } + } + return null; + } + + /** + * Gets the package name from caller() at the specified level. + * + * @param level The stack level (0 = immediate caller of the warnings:: function) + * @return The package name, or null if not available + */ + private static String getCallerPackageAtLevel(int level) { + RuntimeList caller = RuntimeCode.caller( + new RuntimeList(RuntimeScalarCache.getScalarInt(level + 1)), + RuntimeContextType.LIST + ); + if (caller.size() > 0) { + return caller.elements.get(0).toString(); + } + return null; + } + + /** + * Walks up the call stack past frames in warnings-registered packages to find + * the "external caller" whose warning bits should be checked. This implements + * Perl 5's _error_loc() behavior: skip frames in any package that has used + * warnings::register (i.e., any custom warning category package). + * + * @return The warning bits string from the first caller outside registered packages, + * or null if not found + */ + private static String findExternalCallerBits() { + for (int level = 0; level < 50; level++) { + RuntimeList callerInfo = RuntimeCode.caller( + new RuntimeList(RuntimeScalarCache.getScalarInt(level + 1)), + RuntimeContextType.LIST + ); + if (callerInfo.size() <= 0) break; + + String pkg = callerInfo.elements.get(0).toString(); + // Skip frames in any warnings-registered package + if (!WarningFlags.isCustomCategory(pkg)) { + // Found a caller outside registered packages + if (callerInfo.size() > 9) { + RuntimeBase bitsBase = callerInfo.elements.get(9); + if (bitsBase instanceof RuntimeScalar) { + RuntimeScalar bitsScalar = (RuntimeScalar) bitsBase; + if (bitsScalar.type != RuntimeScalarType.UNDEF) { + return bitsScalar.toString(); + } + } + } + return null; + } + } + return null; + } + + /** + * Checks if the $^W global warning flag is set. + * $^W is stored using Perl's internal encoding: "main::" + Character.toString('W' - 'A' + 1). + * + * @return true if $^W is set to a true value, false otherwise + */ + public static boolean isWarnFlagSet() { + // $^W is stored as main:: + character code 23 (W - 'A' + 1 = 87 - 65 + 1 = 23) + String varName = "main::" + Character.toString('W' - 'A' + 1); + return GlobalVariable.getGlobalVariable(varName).getBoolean(); + } + + /** + * Checks if warnings should be emitted for a specific category at runtime. + * This is used by warn methods (like getNumberWarn) to determine if warnings + * are enabled either via lexical warnings or $^W. + * + * @param category The warning category to check (e.g., "uninitialized") + * @return true if warnings should be emitted, false otherwise + */ + public static boolean shouldWarn(String category) { + // First check lexical warnings + String bits = getWarningBitsAtLevel(1); + if (bits != null && WarningFlags.isEnabledInBits(bits, category)) { + return true; + } + // Fall back to $^W + return isWarnFlagSet(); + } + /** * Registers custom warning categories (used by warnings::register). * @@ -56,7 +176,14 @@ public static RuntimeList registerCategories(RuntimeArray args, int ctx) { } /** - * Enables a warning category. + * Enables warning categories, with support for FATAL/NONFATAL modifiers. + * + * Supported syntax: + * - use warnings; - enable all warnings + * - use warnings 'category'; - enable specific category + * - use warnings FATAL => 'all'; - enable all as FATAL + * - use warnings FATAL => 'category'; - enable category as FATAL + * - use warnings NONFATAL => 'all'; - downgrade FATAL to warnings * * @param args The arguments passed to the method. * @param ctx The context in which the method is called. @@ -69,24 +196,92 @@ public static RuntimeList useWarnings(RuntimeArray args, int ctx) { return new RuntimeScalar().getList(); } + ScopedSymbolTable symbolTable = getCurrentScope(); + + // Track current modifier: null = normal, "FATAL" = make fatal, "NONFATAL" = make non-fatal + String currentModifier = null; + for (int i = 1; i < args.size(); i++) { - String category = args.get(i).toString(); - if (category.startsWith("-")) { - category = category.substring(1); - if (!warningExists(category)) { + String arg = args.get(i).toString(); + + // Check for FATAL/NONFATAL modifiers + if ("FATAL".equals(arg)) { + currentModifier = "FATAL"; + continue; + } + if ("NONFATAL".equals(arg)) { + currentModifier = "NONFATAL"; + continue; + } + + // Handle disabled category (with - prefix) + if (arg.startsWith("-")) { + String category = arg.substring(1); + if (!warningExists(category) && !"all".equals(category)) { throw new PerlCompilerException("Unknown warnings category '" + category + "'"); } - warningManager.disableWarning(category.substring(1)); + warningManager.disableWarning(category); + currentModifier = null; // Reset modifier after use + continue; + } + + // Normal category + String category = arg; + if (!warningExists(category) && !"all".equals(category) && !"FATAL".equals(category) && !"NONFATAL".equals(category)) { + throw new PerlCompilerException("Unknown warnings category '" + category + "'"); + } + + // Apply based on current modifier + if ("FATAL".equals(currentModifier)) { + // Enable as FATAL + enableFatalCategory(symbolTable, category); + } else if ("NONFATAL".equals(currentModifier)) { + // Downgrade from FATAL to normal warning + disableFatalCategory(symbolTable, category); + warningManager.enableWarning(category); // Still enable the warning } else { - if (!warningExists(category)) { - throw new PerlCompilerException("Unknown warnings category '" + category + "'"); - } + // Normal enable warningManager.enableWarning(category); } + + currentModifier = null; // Reset modifier after use } + return new RuntimeScalar().getList(); } + /** + * Enables a warning category as FATAL (including subcategories). + */ + private static void enableFatalCategory(ScopedSymbolTable symbolTable, String category) { + // Enable the category + symbolTable.enableWarningCategory(category); + symbolTable.enableFatalWarningCategory(category); + + // Propagate to subcategories + String[] subcategories = WarningFlags.getSubcategories(category); + if (subcategories != null) { + for (String sub : subcategories) { + enableFatalCategory(symbolTable, sub); + } + } + } + + /** + * Disables FATAL mode for a warning category (including subcategories). + */ + private static void disableFatalCategory(ScopedSymbolTable symbolTable, String category) { + symbolTable.disableFatalWarningCategory(category); + + // Propagate to subcategories + String[] subcategories = WarningFlags.getSubcategories(category); + if (subcategories != null) { + for (String sub : subcategories) { + disableFatalCategory(symbolTable, sub); + } + } + } + /** * Disables a warning category. * This is called for "no warnings 'category'". @@ -133,28 +328,111 @@ public static boolean warningExists(String category) { } /** - * Checks if a warning is enabled. + * Checks if a warning category is enabled at the caller's scope. + * Uses caller()[9] to get the warning bits from the calling scope. * - * @param args The arguments passed to the method. + * @param args The arguments passed to the method (optional category). * @param ctx The context in which the method is called. * @return A RuntimeList containing a boolean value. */ public static RuntimeList enabled(RuntimeArray args, int ctx) { - if (args.size() > 2) { - throw new IllegalStateException("Bad number of arguments for warnings::enabled()"); - } String category; - if (args.size() < 1) { - // No category specified - check if warnings are enabled for calling package - // Use "all" as the category to check general warning state - category = "all"; - } else { + if (args.size() > 0) { category = args.get(0).toString(); + } else { + // No args: use calling package as category (Perl 5 behavior) + String pkg = getCallerPackageAtLevel(0); + category = (pkg != null) ? pkg : "all"; + } + + // Check scope-based runtime suppression first (from "no warnings 'category'" blocks) + if (WarningFlags.isWarningSuppressedAtRuntime(category)) { + return new RuntimeScalar(false).getList(); } - boolean isEnabled = warningManager.isWarningEnabled(category); + + // For custom (registered) categories, walk past the registered package + // to find the external caller's warning bits + String bits; + if (WarningFlags.isCustomCategory(category)) { + bits = findExternalCallerBits(); + } else { + bits = getWarningBitsAtLevel(0); + } + boolean isEnabled = bits != null && WarningFlags.isEnabledInBits(bits, category); return new RuntimeScalar(isEnabled).getList(); } + /** + * Checks if a warning category is enabled at the specified stack level. + * + * @param args The arguments: level, category + * @param ctx The context in which the method is called. + * @return A RuntimeList containing a boolean value. + */ + public static RuntimeList enabledAtLevel(RuntimeArray args, int ctx) { + if (args.size() < 2) { + throw new IllegalStateException("Usage: warnings::enabled_at_level(level, category)"); + } + int level = args.get(0).getInt(); + String category = args.get(1).toString(); + + String bits = getWarningBitsAtLevel(level); + boolean isEnabled = bits != null && WarningFlags.isEnabledInBits(bits, category); + return new RuntimeScalar(isEnabled).getList(); + } + + /** + * Checks if a warning category is FATAL at the caller's scope. + * + * @param args The arguments passed to the method (optional category). + * @param ctx The context in which the method is called. + * @return A RuntimeList containing a boolean value. + */ + public static RuntimeList fatalEnabled(RuntimeArray args, int ctx) { + String category; + if (args.size() > 0) { + category = args.get(0).toString(); + } else { + // No args: use calling package as category (Perl 5 behavior) + String pkg = getCallerPackageAtLevel(0); + category = (pkg != null) ? pkg : "all"; + } + + // Check scope-based runtime suppression first + if (WarningFlags.isWarningSuppressedAtRuntime(category)) { + return new RuntimeScalar(false).getList(); + } + + // For custom categories, walk past the registered package + String bits; + if (WarningFlags.isCustomCategory(category)) { + bits = findExternalCallerBits(); + } else { + bits = getWarningBitsAtLevel(0); + } + boolean isFatal = bits != null && WarningFlags.isFatalInBits(bits, category); + return new RuntimeScalar(isFatal).getList(); + } + + /** + * Checks if a warning category is FATAL at the specified stack level. + * + * @param args The arguments: level, category + * @param ctx The context in which the method is called. + * @return A RuntimeList containing a boolean value. + */ + public static RuntimeList fatalEnabledAtLevel(RuntimeArray args, int ctx) { + if (args.size() < 2) { + throw new IllegalStateException("Usage: warnings::fatal_enabled_at_level(level, category)"); + } + int level = args.get(0).getInt(); + String category = args.get(1).toString(); + + String bits = getWarningBitsAtLevel(level); + boolean isFatal = bits != null && WarningFlags.isFatalInBits(bits, category); + return new RuntimeScalar(isFatal).getList(); + } + /** * Issues a warning. * @@ -172,11 +450,11 @@ public static RuntimeList warn(RuntimeArray args, int ctx) { } /** - * Issues a warning if the category is enabled. - * When called with just a message, checks if the calling package's warning category is enabled. - * Also checks ${^WARNING_SCOPE} for runtime warning suppression via "no warnings 'category'". + * Issues a warning if the category is enabled at the caller's scope. + * Uses caller()[9] to check warning bits from the calling scope. + * If the category is FATAL, dies instead of warning. * - * @param args The arguments passed to the method. + * @param args The arguments: category, message OR just message * @param ctx The context in which the method is called. * @return A RuntimeList. */ @@ -193,30 +471,87 @@ public static RuntimeList warnIf(RuntimeArray args, int ctx) { category = args.get(0).toString(); message = args.get(1); } else { - // warnif(message) - check calling package's category + // warnif(message) - use calling package as category message = args.get(0); - // Get the calling package to use as category - RuntimeList caller = RuntimeCode.caller(new RuntimeList(RuntimeScalarCache.getScalarInt(0)), RuntimeContextType.LIST); - if (caller.size() > 0) { - category = caller.elements.get(0).toString(); - } else { - category = "main"; + String pkg = getCallerPackageAtLevel(0); + category = (pkg != null) ? pkg : "main"; + } + + // Check scope-based runtime suppression first (from "no warnings 'category'" blocks) + if (WarningFlags.isWarningSuppressedAtRuntime(category)) { + return new RuntimeScalar().getList(); + } + + // For custom (registered) categories, walk past the registered package + // to find the external caller's warning bits + String bits; + if (WarningFlags.isCustomCategory(category)) { + bits = findExternalCallerBits(); + } else { + bits = getWarningBitsAtLevel(0); + } + + // Check if category is enabled in lexical warnings + boolean categoryEnabled = bits != null && WarningFlags.isEnabledInBits(bits, category); + + if (!categoryEnabled) { + // Category not enabled via lexical warnings - fall back to $^W + if (isWarnFlagSet()) { + WarnDie.warn(message, new RuntimeScalar("")); } + return new RuntimeScalar().getList(); + } + + // Category is enabled via lexical warnings + // Check if FATAL - if so, die instead of warn + if (WarningFlags.isFatalInBits(bits, category)) { + WarnDie.die(message, new RuntimeScalar("")); + } else { + WarnDie.warn(message, new RuntimeScalar("")); } - // Check runtime scope suppression via ${^WARNING_SCOPE} - // This allows "no warnings 'Category'" in user code to propagate to warnif() calls - RuntimeScalar scopeVar = GlobalVariable.getGlobalVariable(GlobalContext.WARNING_SCOPE); - int scopeId = scopeVar.getInt(); - if (scopeId > 0 && WarningFlags.isWarningDisabledInScope(scopeId, category)) { - // Warning is suppressed by caller's "no warnings" + return new RuntimeScalar().getList(); + } + + /** + * Issues a warning if the category is enabled at the specified stack level. + * If the category is FATAL at that level, dies instead of warning. + * + * @param args The arguments: level, category, message + * @param ctx The context in which the method is called. + * @return A RuntimeList. + */ + public static RuntimeList warnIfAtLevel(RuntimeArray args, int ctx) { + if (args.size() < 3) { + throw new IllegalStateException("Usage: warnings::warnif_at_level(level, category, message)"); + } + + int level = args.get(0).getInt(); + String category = args.get(1).toString(); + RuntimeScalar message = args.get(2); + + // Check warning bits at specified level + String bits = getWarningBitsAtLevel(level); + + // Check if category is enabled in lexical warnings + boolean categoryEnabled = bits != null && WarningFlags.isEnabledInBits(bits, category); + + if (!categoryEnabled) { + // Category not enabled via lexical warnings - fall back to $^W + if (isWarnFlagSet()) { + WarnDie.warn(message, new RuntimeScalar("")); + } return new RuntimeScalar().getList(); } - if (warningManager.isWarningEnabled(category)) { - // Use WarnDie.warn to go through $SIG{__WARN__} + // Category is enabled via lexical warnings + // Check if FATAL - if so, die instead of warn + if (WarningFlags.isFatalInBits(bits, category)) { + WarnDie.die(message, new RuntimeScalar("")); + } else { WarnDie.warn(message, new RuntimeScalar("")); } + return new RuntimeScalar().getList(); } } diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/ErrnoVariable.java b/src/main/java/org/perlonjava/runtime/runtimetypes/ErrnoVariable.java index e2f7edf1d..b7014de0b 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/ErrnoVariable.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/ErrnoVariable.java @@ -9,7 +9,8 @@ * and a string value (error message). * * When set to a number, it stores the errno and looks up the message. - * When set to a string, it stores 0 as errno and the string as message. + * When set to a string (known errno message), it looks up the errno code. + * When set to an unknown string, it stores 0 as errno and the string as message. */ public class ErrnoVariable extends RuntimeScalar { @@ -18,49 +19,63 @@ public class ErrnoVariable extends RuntimeScalar { // Map of errno numbers to messages (POSIX standard messages) private static final Map ERRNO_MESSAGES = new HashMap<>(); + // Reverse map of messages to errno numbers + private static final Map MESSAGE_TO_ERRNO = new HashMap<>(); static { // Standard POSIX errno values and messages - ERRNO_MESSAGES.put(1, "Operation not permitted"); - ERRNO_MESSAGES.put(2, "No such file or directory"); - ERRNO_MESSAGES.put(3, "No such process"); - ERRNO_MESSAGES.put(4, "Interrupted system call"); - ERRNO_MESSAGES.put(5, "Input/output error"); - ERRNO_MESSAGES.put(6, "No such device or address"); - ERRNO_MESSAGES.put(7, "Argument list too long"); - ERRNO_MESSAGES.put(8, "Exec format error"); - ERRNO_MESSAGES.put(9, "Bad file descriptor"); - ERRNO_MESSAGES.put(10, "No child processes"); - ERRNO_MESSAGES.put(11, "Resource temporarily unavailable"); - ERRNO_MESSAGES.put(12, "Cannot allocate memory"); - ERRNO_MESSAGES.put(13, "Permission denied"); - ERRNO_MESSAGES.put(14, "Bad address"); - ERRNO_MESSAGES.put(15, "Block device required"); - ERRNO_MESSAGES.put(16, "Device or resource busy"); - ERRNO_MESSAGES.put(17, "File exists"); - ERRNO_MESSAGES.put(18, "Invalid cross-device link"); - ERRNO_MESSAGES.put(19, "No such device"); - ERRNO_MESSAGES.put(20, "Not a directory"); - ERRNO_MESSAGES.put(21, "Is a directory"); - ERRNO_MESSAGES.put(22, "Invalid argument"); - ERRNO_MESSAGES.put(23, "Too many open files in system"); - ERRNO_MESSAGES.put(24, "Too many open files"); - ERRNO_MESSAGES.put(25, "Inappropriate ioctl for device"); - ERRNO_MESSAGES.put(26, "Text file busy"); - ERRNO_MESSAGES.put(27, "File too large"); - ERRNO_MESSAGES.put(28, "No space left on device"); - ERRNO_MESSAGES.put(29, "Illegal seek"); - ERRNO_MESSAGES.put(30, "Read-only file system"); - ERRNO_MESSAGES.put(31, "Too many links"); - ERRNO_MESSAGES.put(32, "Broken pipe"); - ERRNO_MESSAGES.put(33, "Numerical argument out of domain"); - ERRNO_MESSAGES.put(34, "Numerical result out of range"); - ERRNO_MESSAGES.put(35, "Resource deadlock avoided"); - ERRNO_MESSAGES.put(36, "File name too long"); - ERRNO_MESSAGES.put(37, "No locks available"); - ERRNO_MESSAGES.put(38, "Function not implemented"); - ERRNO_MESSAGES.put(39, "Directory not empty"); - ERRNO_MESSAGES.put(40, "Too many levels of symbolic links"); + addErrno(1, "Operation not permitted"); + addErrno(2, "No such file or directory"); + addErrno(3, "No such process"); + addErrno(4, "Interrupted system call"); + addErrno(5, "Input/output error"); + addErrno(6, "No such device or address"); + addErrno(7, "Argument list too long"); + addErrno(8, "Exec format error"); + addErrno(9, "Bad file descriptor"); + addErrno(10, "No child processes"); + addErrno(11, "Resource temporarily unavailable"); + addErrno(12, "Cannot allocate memory"); + addErrno(13, "Permission denied"); + addErrno(14, "Bad address"); + addErrno(15, "Block device required"); + addErrno(16, "Device or resource busy"); + addErrno(17, "File exists"); + addErrno(18, "Invalid cross-device link"); + addErrno(19, "No such device"); + addErrno(20, "Not a directory"); + addErrno(21, "Is a directory"); + addErrno(22, "Invalid argument"); + addErrno(23, "Too many open files in system"); + addErrno(24, "Too many open files"); + addErrno(25, "Inappropriate ioctl for device"); + addErrno(26, "Text file busy"); + addErrno(27, "File too large"); + addErrno(28, "No space left on device"); + addErrno(29, "Illegal seek"); + addErrno(30, "Read-only file system"); + addErrno(31, "Too many links"); + addErrno(32, "Broken pipe"); + addErrno(33, "Numerical argument out of domain"); + addErrno(34, "Numerical result out of range"); + addErrno(35, "Resource deadlock avoided"); + addErrno(36, "File name too long"); + addErrno(37, "No locks available"); + addErrno(38, "Function not implemented"); + addErrno(39, "Directory not empty"); + addErrno(40, "Too many levels of symbolic links"); + addErrno(48, "Address already in use"); + addErrno(49, "Cannot assign requested address"); + addErrno(61, "Connection refused"); + addErrno(111, "Connection refused"); + // Additional messages used in PerlOnJava code + addErrno(5, "I/O error"); + addErrno(21, "Is a directory"); + } + + private static void addErrno(int code, String msg) { + ERRNO_MESSAGES.put(code, msg); + MESSAGE_TO_ERRNO.putIfAbsent(msg, code); } public ErrnoVariable() { @@ -83,8 +98,9 @@ public RuntimeScalar set(int value) { /** * Set errno from a string value. - * If the string is a number, treat it as errno. - * Otherwise, set errno to 0 and use the string as the message. + * If the string is a known errno message, looks up and stores the errno code. + * If the string is a number, treats it as errno code. + * Otherwise, stores 0 as errno with the string as message. */ @Override public RuntimeScalar set(String value) { @@ -96,13 +112,22 @@ public RuntimeScalar set(String value) { return this; } + // Check if the string is a known errno message (reverse lookup) + Integer code = MESSAGE_TO_ERRNO.get(value); + if (code != null) { + this.errno = code; + this.message = value; + this.type = RuntimeScalarType.INTEGER; + this.value = code; + return this; + } + // Try to parse as integer try { int num = Integer.parseInt(value.trim()); return set(num); } catch (NumberFormatException e) { - // Not a number - store as message with errno 0 - // This is legacy behavior for code that sets $! = "message" + // Not a number and not a known message - store as message with errno 0 this.errno = 0; this.message = value; this.type = RuntimeScalarType.STRING; @@ -175,3 +200,4 @@ public void clear() { set(0); } } + diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalContext.java b/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalContext.java index a8804c977..583060290 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalContext.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalContext.java @@ -52,6 +52,10 @@ public static void initializeGlobals(CompilerOptions compilerOptions) { GlobalVariable.getGlobalVariable("main::" + Character.toString('O' - 'A' + 1)).set(SystemUtils.getPerlOsName()); // initialize $^O GlobalVariable.getGlobalVariable("main::" + Character.toString('V' - 'A' + 1)).set(Configuration.getPerlVersionVString()); // initialize $^V GlobalVariable.getGlobalVariable("main::" + Character.toString('T' - 'A' + 1)).set((int) (System.currentTimeMillis() / 1000)); // initialize $^T to epoch time + // Initialize $^W based on -w flag + if (compilerOptions.warnFlag) { + GlobalVariable.getGlobalVariable("main::" + Character.toString('W' - 'A' + 1)).set(1); // initialize $^W = 1 for -w flag + } // Initialize $^X - the name used to execute the current copy of Perl // PERLONJAVA_EXECUTABLE is set by the `jperl` or `jperl.bat` launcher @@ -137,7 +141,7 @@ public static void initializeGlobals(CompilerOptions compilerOptions) { // Initialize additional magic scalar variables that tests expect to exist at startup GlobalVariable.getGlobalVariable(encodeSpecialVar("UTF8LOCALE")); // ${^UTF8LOCALE} - GlobalVariable.getGlobalVariable(encodeSpecialVar("WARNING_BITS")); // ${^WARNING_BITS} + GlobalVariable.globalVariables.put(encodeSpecialVar("WARNING_BITS"), new ScalarSpecialVariable(ScalarSpecialVariable.Id.WARNING_BITS)); // ${^WARNING_BITS} GlobalVariable.getGlobalVariable(encodeSpecialVar("UTF8CACHE")).set(0); // ${^UTF8CACHE} GlobalVariable.getGlobalVariable("main::[").set(0); // $[ (array base, deprecated) GlobalVariable.getGlobalVariable("main::~"); // $~ (current format name) diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java index 21a7efdb7..72bd87044 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java @@ -17,6 +17,7 @@ import org.perlonjava.frontend.semantic.ScopedSymbolTable; import org.perlonjava.frontend.semantic.SymbolTable; import org.perlonjava.runtime.ForkOpenCompleteException; +import org.perlonjava.runtime.WarningBitsRegistry; import org.perlonjava.runtime.mro.InheritanceResolver; import org.perlonjava.runtime.debugger.DebugHooks; import org.perlonjava.runtime.debugger.DebugState; @@ -1627,6 +1628,7 @@ public static RuntimeList callerWithSub(RuntimeList args, int ctx, RuntimeScalar Throwable t = new Throwable(); ArrayList> stackTrace = ExceptionFormatter.formatException(t); + java.util.ArrayList javaClassNames = extractJavaClassNames(t); int stackTraceSize = stackTrace.size(); // Skip the first frame which is the caller() builtin itself @@ -1731,7 +1733,23 @@ public static RuntimeList callerWithSub(RuntimeList args, int ctx, RuntimeScalar res.add(new RuntimeScalar(0)); // Add bitmask (element 9): Compile-time warnings bitmask - res.add(RuntimeScalarCache.scalarUndef); + // First try per-call-site bits from callerBitsStack (accurate per-statement) + // frame is 1-based here (after skip increment), callerBitsStack is 0-based + String warningBits = WarningBitsRegistry.getCallerBitsAtFrame(frame - 1); + if (warningBits == null) { + // Fall back to per-class bits + if (frame < javaClassNames.size()) { + String className = javaClassNames.get(frame); + if (className != null) { + warningBits = WarningBitsRegistry.get(className); + } + } + } + if (warningBits != null) { + res.add(new RuntimeScalar(warningBits)); + } else { + res.add(RuntimeScalarCache.scalarUndef); + } // Add hinthash (element 10): Compile-time %^H hash reference res.add(RuntimeScalarCache.scalarUndef); @@ -1749,6 +1767,63 @@ private static String gotoErrorPrefix(String subroutineName) { return "tailcall".equals(subroutineName) ? "Goto u" : "U"; } + /** + * Extracts Java class names from a Throwable's stack trace, parallel to + * how ExceptionFormatter.formatException produces Perl frames. + * This allows caller() to look up warning bits from WarningBitsRegistry. + * + * @param t The Throwable containing the stack trace + * @return List of Java class names, one per Perl frame in same order as formatException + */ + private static java.util.ArrayList extractJavaClassNames(Throwable t) { + java.util.ArrayList classNames = new java.util.ArrayList<>(); + java.util.HashSet seenLocations = new java.util.HashSet<>(); + + // Track interpreter frames similar to ExceptionFormatter + var interpreterFrames = InterpreterState.getStack(); + int interpreterFrameIndex = 0; + boolean addedFrameForCurrentLevel = false; + + for (var element : t.getStackTrace()) { + if (element.getClassName().equals("org.perlonjava.frontend.parser.StatementParser") && + element.getMethodName().equals("parseUseDeclaration")) { + // Use statement - no class name for warning bits lookup + classNames.add(null); + } else if (element.getClassName().equals("org.perlonjava.backend.bytecode.InterpretedCode") && + element.getMethodName().equals("apply")) { + // InterpretedCode.apply marks the END of a Perl call level + if (addedFrameForCurrentLevel) { + interpreterFrameIndex++; + addedFrameForCurrentLevel = false; + } + } else if (element.getClassName().equals("org.perlonjava.backend.bytecode.BytecodeInterpreter") && + element.getMethodName().equals("execute")) { + // Interpreter frame - use InterpretedCode's class for warning bits lookup + if (!addedFrameForCurrentLevel && interpreterFrameIndex < interpreterFrames.size()) { + var frame = interpreterFrames.get(interpreterFrameIndex); + if (frame != null && frame.code() != null) { + // For interpreter, warning bits come from InterpretedCode.warningBits + // For now, we use the code's identifier as a pseudo-class name + String codeId = "interpreter:" + System.identityHashCode(frame.code()); + classNames.add(codeId); + addedFrameForCurrentLevel = true; + } + } + } else if (element.getClassName().contains("org.perlonjava.anon") || + element.getClassName().contains("org.perlonjava.runtime.perlmodule")) { + // JVM frame - use the actual class name for warning bits lookup + // Use source location key to avoid duplicates (same logic as ExceptionFormatter) + String locationKey = element.getFileName() + ":" + element.getLineNumber(); + if (!seenLocations.contains(locationKey)) { + seenLocations.add(locationKey); + classNames.add(element.getClassName()); + } + } + } + + return classNames; + } + // Method to apply (execute) a subroutine reference public static RuntimeList apply(RuntimeScalar runtimeScalar, RuntimeArray a, int callContext) { // Check if the type of this RuntimeScalar is CODE @@ -1794,8 +1869,23 @@ public static RuntimeList apply(RuntimeScalar runtimeScalar, RuntimeArray a, int } throw new PerlCompilerException("Undefined subroutine &" + subroutineName + " called"); } - // Cast the value to RuntimeCode and call apply() - return code.apply(a, callContext); + // Look up warning bits for the code's class and push to context stack + // This enables FATAL warnings to work even at top-level (no caller frame) + String warningBits = getWarningBitsForCode(code); + if (warningBits != null) { + WarningBitsRegistry.pushCurrent(warningBits); + } + // Save caller's call-site warning bits so caller()[9] can retrieve them + WarningBitsRegistry.pushCallerBits(); + try { + // Cast the value to RuntimeCode and call apply() + return code.apply(a, callContext); + } finally { + WarningBitsRegistry.popCallerBits(); + if (warningBits != null) { + WarningBitsRegistry.popCurrent(); + } + } } if (runtimeScalar.type == STRING || runtimeScalar.type == BYTE_STRING) { @@ -1866,6 +1956,38 @@ private static RuntimeScalar handleCodeOverload(RuntimeScalar runtimeScalar) { return null; } + /** + * Gets the warning bits string for a RuntimeCode. + * For InterpretedCode, uses the stored warningBitsString field. + * For JVM-compiled code, looks up in WarningBitsRegistry by class name. + * + * @param code The RuntimeCode to get warning bits for + * @return The warning bits string, or null if not available + */ + private static String getWarningBitsForCode(RuntimeCode code) { + // For InterpretedCode, use the stored field directly + if (code instanceof org.perlonjava.backend.bytecode.InterpretedCode interpCode) { + return interpCode.warningBitsString; + } + + // For JVM-compiled code, look up by class name in the registry + // The methodHandle's class is the generated class that has WARNING_BITS field + if (code.methodHandle != null) { + // Get the declaring class of the method handle + try { + // The type contains the declaring class as the first parameter type for instance methods + // For our generated apply methods, we use the class that was loaded + String className = code.methodHandle.type().parameterType(0).getName(); + return WarningBitsRegistry.get(className); + } catch (Exception e) { + // If we can't get the class name, fall back to null + return null; + } + } + + return null; + } + // Method to apply (execute) a subroutine reference using native array for parameters public static RuntimeList apply(RuntimeScalar runtimeScalar, String subroutineName, RuntimeBase[] args, int callContext) { // WORKAROUND for eval-defined subs not filling lexical forward declarations: @@ -1902,8 +2024,22 @@ public static RuntimeList apply(RuntimeScalar runtimeScalar, String subroutineNa } if (code.defined()) { - // Cast the value to RuntimeCode and call apply() - return code.apply(subroutineName, a, callContext); + // Look up warning bits for the code's class and push to context stack + String warningBits = getWarningBitsForCode(code); + if (warningBits != null) { + WarningBitsRegistry.pushCurrent(warningBits); + } + // Save caller's call-site warning bits so caller()[9] can retrieve them + WarningBitsRegistry.pushCallerBits(); + try { + // Cast the value to RuntimeCode and call apply() + return code.apply(subroutineName, a, callContext); + } finally { + WarningBitsRegistry.popCallerBits(); + if (warningBits != null) { + WarningBitsRegistry.popCurrent(); + } + } } // Does AUTOLOAD exist? @@ -1989,8 +2125,22 @@ public static RuntimeList apply(RuntimeScalar runtimeScalar, String subroutineNa } if (code.defined()) { - // Cast the value to RuntimeCode and call apply() - return code.apply(subroutineName, a, callContext); + // Look up warning bits for the code's class and push to context stack + String warningBits = getWarningBitsForCode(code); + if (warningBits != null) { + WarningBitsRegistry.pushCurrent(warningBits); + } + // Save caller's call-site warning bits so caller()[9] can retrieve them + WarningBitsRegistry.pushCallerBits(); + try { + // Cast the value to RuntimeCode and call apply() + return code.apply(subroutineName, a, callContext); + } finally { + WarningBitsRegistry.popCallerBits(); + if (warningBits != null) { + WarningBitsRegistry.popCurrent(); + } + } } // Does AUTOLOAD exist? @@ -2293,6 +2443,12 @@ public RuntimeList apply(RuntimeArray a, int callContext) { } // Always push args for getCurrentArgs() support (used by List::Util::any/all/etc.) pushArgs(a); + + // Push warning bits for FATAL warnings support + String warningBits = getWarningBitsForCode(this); + if (warningBits != null) { + WarningBitsRegistry.pushCurrent(warningBits); + } try { RuntimeList result; // Prefer functional interface over MethodHandle for better performance @@ -2305,6 +2461,9 @@ public RuntimeList apply(RuntimeArray a, int callContext) { } return result; } finally { + if (warningBits != null) { + WarningBitsRegistry.popCurrent(); + } popArgs(); if (DebugState.debugMode) { DebugHooks.exitSubroutine(); @@ -2383,6 +2542,12 @@ public RuntimeList apply(String subroutineName, RuntimeArray a, int callContext) } // Always push args for getCurrentArgs() support (used by List::Util::any/all/etc.) pushArgs(a); + + // Push warning bits for FATAL warnings support + String warningBits = getWarningBitsForCode(this); + if (warningBits != null) { + WarningBitsRegistry.pushCurrent(warningBits); + } try { RuntimeList result; // Prefer functional interface over MethodHandle for better performance @@ -2395,6 +2560,9 @@ public RuntimeList apply(String subroutineName, RuntimeArray a, int callContext) } return result; } finally { + if (warningBits != null) { + WarningBitsRegistry.popCurrent(); + } popArgs(); if (DebugState.debugMode) { DebugHooks.exitSubroutine(); diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java index ee6433b6d..3ff96b37a 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java @@ -3,6 +3,8 @@ import org.perlonjava.frontend.parser.NumberParser; import org.perlonjava.runtime.mro.InheritanceResolver; import org.perlonjava.runtime.operators.StringOperators; +import org.perlonjava.runtime.operators.WarnDie; +import org.perlonjava.runtime.perlmodule.Warnings; import org.perlonjava.runtime.regex.RuntimeRegex; import java.math.BigInteger; @@ -304,6 +306,34 @@ public RuntimeScalar getNumberLarge() { }; } + /** + * Converts scalar to number with uninitialized value warning. + * Called when 'use warnings "uninitialized"' is in effect. + * + * @param operation The operation name for the warning message (e.g., "addition (+)") + * @return A RuntimeScalar representing the numeric value + */ + public RuntimeScalar getNumberWarn(String operation) { + // Fast path for defined numeric types + if (type == INTEGER || type == DOUBLE) { + return this; + } + // Check for UNDEF and emit warning if warnings are enabled + if (type == UNDEF) { + if (Warnings.shouldWarn("uninitialized")) { + WarnDie.warn(new RuntimeScalar("Use of uninitialized value in " + operation), + scalarEmptyString); + } + return scalarZero; + } + // For tied scalars, fetch first then check the fetched value + if (type == TIED_SCALAR) { + return this.tiedFetch().getNumberWarn(operation); + } + // All other types are defined, just convert to number + return getNumberLarge(); + } + /** * Postfix glob dereference helper used by the parser for `->**` and `->*{...}`. * diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/ScalarSpecialVariable.java b/src/main/java/org/perlonjava/runtime/runtimetypes/ScalarSpecialVariable.java index 71f98768e..1d6f8db91 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/ScalarSpecialVariable.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/ScalarSpecialVariable.java @@ -70,6 +70,10 @@ void vivify() { if (variableId == Id.HINTS) { return; } + // WARNING_BITS doesn't need lvalue - it always reads/writes from the symbol table + if (variableId == Id.WARNING_BITS) { + return; + } throw new PerlCompilerException("Modification of a read-only value attempted"); } @@ -98,6 +102,16 @@ public RuntimeScalar set(RuntimeScalar value) { // Return a scalar with the hints value return getScalarInt(hints); } + if (variableId == Id.WARNING_BITS) { + // ${^WARNING_BITS} - Set warning bits from a string + // This is used by Test::Builder to restore warning state in eval blocks + ScopedSymbolTable symbolTable = SpecialBlockParser.getCurrentScope(); + if (symbolTable != null) { + String bits = value.toString(); + WarningFlags.setWarningBitsFromString(symbolTable, bits); + } + return value; + } return super.set(value); } @@ -235,6 +249,16 @@ public RuntimeScalar getValueAsScalar() { // $> - Effective user ID (lazy evaluation to avoid JNA overhead at startup) yield NativeUtils.geteuid(0); } + case WARNING_BITS -> { + // ${^WARNING_BITS} - Compile-time warning bits + // Always read from the current scope's symbol table + ScopedSymbolTable symbolTable = SpecialBlockParser.getCurrentScope(); + if (symbolTable != null) { + String bits = symbolTable.getWarningBitsString(); + yield new RuntimeScalar(bits); + } + yield scalarUndef; + } }; return result; } catch (IllegalStateException e) { @@ -246,6 +270,17 @@ public RuntimeScalar getNumber() { return this.getValueAsScalar().getNumber(); } + /** + * Converts the special variable to a number with uninitialized warnings. + * + * @param operation The operation name for the warning message. + * @return The numeric value of the special variable. + */ + @Override + public RuntimeScalar getNumberWarn(String operation) { + return this.getValueAsScalar().getNumberWarn(operation); + } + /** * Retrieves the integer representation of the special variable. * @@ -423,6 +458,7 @@ public enum Id { EFFECTIVE_GID, // $) - Effective group ID (lazy, JNA call only on access) REAL_UID, // $< - Real user ID (lazy, JNA call only on access) EFFECTIVE_UID, // $> - Effective user ID (lazy, JNA call only on access) + WARNING_BITS, // ${^WARNING_BITS} - Compile-time warning bits } private record InputLineState(RuntimeIO lastHandle, int lastLineNumber, RuntimeScalar localValue) { diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/WarningFlags.java b/src/main/java/org/perlonjava/runtime/runtimetypes/WarningFlags.java index 4411a3339..60cf5fe97 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/WarningFlags.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/WarningFlags.java @@ -2,7 +2,9 @@ import org.perlonjava.frontend.semantic.ScopedSymbolTable; +import java.nio.charset.StandardCharsets; import java.util.*; +import java.util.concurrent.ConcurrentHashMap; import java.util.concurrent.atomic.AtomicInteger; import static org.perlonjava.frontend.parser.SpecialBlockParser.getCurrentScope; @@ -39,9 +41,9 @@ public class WarningFlags { static { // Initialize the hierarchy of warning categories - warningHierarchy.put("all", new String[]{"closure", "deprecated", "exiting", "experimental", "glob", "imprecision", "io", "locale", "misc", "missing", "numeric", "once", "overflow", "pack", "portable", "recursion", "redefine", "redundant", "regexp", "scalar", "severe", "shadow", "signal", "substr", "syntax", "taint", "threads", "uninitialized", "unpack", "untie", "utf8", "void"}); + warningHierarchy.put("all", new String[]{"closure", "deprecated", "exiting", "experimental", "glob", "imprecision", "io", "locale", "misc", "missing", "missing_import", "numeric", "once", "overflow", "pack", "portable", "recursion", "redefine", "redundant", "regexp", "scalar", "severe", "shadow", "signal", "substr", "syntax", "taint", "threads", "uninitialized", "unpack", "untie", "utf8", "void", "__future_81", "__future_82", "__future_83"}); warningHierarchy.put("deprecated", new String[]{"deprecated::apostrophe_as_package_separator", "deprecated::delimiter_will_be_paired", "deprecated::dot_in_inc", "deprecated::goto_construct", "deprecated::missing_import_called_with_args", "deprecated::smartmatch", "deprecated::subsequent_use_version", "deprecated::unicode_property_name", "deprecated::version_downgrade"}); - warningHierarchy.put("experimental", new String[]{"experimental::args_array_with_signatures", "experimental::bitwise", "experimental::builtin", "experimental::class", "experimental::declared_refs", "experimental::defer", "experimental::extra_paired_delimiters", "experimental::private_use", "experimental::re_strict", "experimental::refaliasing", "experimental::regex_sets", "experimental::try", "experimental::uniprop_wildcards", "experimental::vlb", "experimental::keyword_any", "experimental::keyword_all", "experimental::lexical_subs", "experimental::signature_named_parameters"}); + warningHierarchy.put("experimental", new String[]{"experimental::args_array_with_signatures", "experimental::bitwise", "experimental::builtin", "experimental::class", "experimental::declared_refs", "experimental::defer", "experimental::enhanced_xx", "experimental::extra_paired_delimiters", "experimental::private_use", "experimental::re_strict", "experimental::refaliasing", "experimental::regex_sets", "experimental::try", "experimental::uniprop_wildcards", "experimental::vlb", "experimental::keyword_any", "experimental::keyword_all", "experimental::lexical_subs", "experimental::signature_named_parameters"}); warningHierarchy.put("io", new String[]{"io::closed", "io::exec", "io::layer", "io::newline", "io::pipe", "io::syscalls", "io::unopened"}); warningHierarchy.put("severe", new String[]{"severe::debugging", "severe::inplace", "severe::internal", "severe::malloc"}); warningHierarchy.put("syntax", new String[]{"syntax::ambiguous", "syntax::bareword", "syntax::digit", "syntax::illegalproto", "syntax::parenthesis", "syntax::precedence", "syntax::printf", "syntax::prototype", "syntax::qw", "syntax::reserved", "syntax::semicolon"}); @@ -63,6 +65,384 @@ public class WarningFlags { warningHierarchy.put("surrogate", new String[]{}); warningHierarchy.put("nonchar", new String[]{}); } + + // ==================== Perl 5 Compatible Bit Offsets ==================== + // These match the offsets from Perl 5's warnings.h for caller()[9] compatibility. + // Each category uses 2 bits: bit 0 = enabled, bit 1 = fatal. + + /** + * Perl 5 compatible category offsets (from warnings.h). + * These are used for caller()[9] return value compatibility. + */ + private static final Map PERL5_OFFSETS; + + /** + * User-defined category offsets (dynamically assigned starting at 128). + */ + private static final ConcurrentHashMap userCategoryOffsets = + new ConcurrentHashMap<>(); + + /** + * Next available offset for user-defined categories. + */ + private static final AtomicInteger nextUserOffset = new AtomicInteger(128); + + /** + * Size of warning bits string in bytes (Perl 5's WARNsize). + */ + public static final int WARN_SIZE = 21; + + static { + // Initialize Perl 5 compatible offsets + Map offsets = new HashMap<>(); + offsets.put("all", 0); + offsets.put("closure", 1); + offsets.put("deprecated", 2); + offsets.put("exiting", 3); + offsets.put("glob", 4); + offsets.put("io", 5); + offsets.put("closed", 6); + offsets.put("io::closed", 6); // Alias + offsets.put("exec", 7); + offsets.put("io::exec", 7); // Alias + offsets.put("layer", 8); + offsets.put("io::layer", 8); // Alias + offsets.put("newline", 9); + offsets.put("io::newline", 9); // Alias + offsets.put("pipe", 10); + offsets.put("io::pipe", 10); // Alias + offsets.put("unopened", 11); + offsets.put("io::unopened", 11); // Alias + offsets.put("misc", 12); + offsets.put("numeric", 13); + offsets.put("once", 14); + offsets.put("overflow", 15); + offsets.put("pack", 16); + offsets.put("portable", 17); + offsets.put("recursion", 18); + offsets.put("redefine", 19); + offsets.put("regexp", 20); + offsets.put("severe", 21); + offsets.put("debugging", 22); + offsets.put("severe::debugging", 22); // Alias + offsets.put("inplace", 23); + offsets.put("severe::inplace", 23); // Alias + offsets.put("internal", 24); + offsets.put("severe::internal", 24); // Alias + offsets.put("malloc", 25); + offsets.put("severe::malloc", 25); // Alias + offsets.put("signal", 26); + offsets.put("substr", 27); + offsets.put("syntax", 28); + offsets.put("ambiguous", 29); + offsets.put("syntax::ambiguous", 29); // Alias + offsets.put("bareword", 30); + offsets.put("syntax::bareword", 30); // Alias + offsets.put("digit", 31); + offsets.put("syntax::digit", 31); // Alias + offsets.put("parenthesis", 32); + offsets.put("syntax::parenthesis", 32); // Alias + offsets.put("precedence", 33); + offsets.put("syntax::precedence", 33); // Alias + offsets.put("printf", 34); + offsets.put("syntax::printf", 34); // Alias + offsets.put("prototype", 35); + offsets.put("syntax::prototype", 35); // Alias + offsets.put("qw", 36); + offsets.put("syntax::qw", 36); // Alias + offsets.put("reserved", 37); + offsets.put("syntax::reserved", 37); // Alias + offsets.put("semicolon", 38); + offsets.put("syntax::semicolon", 38); // Alias + offsets.put("taint", 39); + offsets.put("threads", 40); + offsets.put("uninitialized", 41); + offsets.put("unpack", 42); + offsets.put("untie", 43); + offsets.put("utf8", 44); + offsets.put("void", 45); + offsets.put("imprecision", 46); + offsets.put("illegalproto", 47); + offsets.put("syntax::illegalproto", 47); // Alias + // Perl 5.011003+ + offsets.put("deprecated::unicode_property_name", 48); + // Perl 5.013+ + offsets.put("non_unicode", 49); + offsets.put("utf8::non_unicode", 49); // Alias + offsets.put("nonchar", 50); + offsets.put("utf8::nonchar", 50); // Alias + offsets.put("surrogate", 51); + offsets.put("utf8::surrogate", 51); // Alias + // Perl 5.017+ + offsets.put("experimental", 52); + offsets.put("experimental::regex_sets", 53); + // Perl 5.019+ + offsets.put("syscalls", 54); + offsets.put("io::syscalls", 54); // Alias + // Perl 5.021+ + offsets.put("experimental::re_strict", 55); + offsets.put("experimental::refaliasing", 56); + offsets.put("locale", 57); + offsets.put("missing", 58); + offsets.put("redundant", 59); + // Perl 5.025+ + offsets.put("experimental::declared_refs", 60); + offsets.put("deprecated::dot_in_inc", 61); + // Perl 5.027+ + offsets.put("shadow", 62); + // Perl 5.029+ + offsets.put("experimental::private_use", 63); + offsets.put("experimental::uniprop_wildcards", 64); + offsets.put("experimental::vlb", 65); + // Perl 5.033+ + offsets.put("experimental::try", 66); + // Perl 5.035+ + offsets.put("experimental::args_array_with_signatures", 67); + offsets.put("experimental::builtin", 68); + offsets.put("experimental::defer", 69); + offsets.put("experimental::extra_paired_delimiters", 70); + offsets.put("scalar", 71); + offsets.put("deprecated::version_downgrade", 72); + offsets.put("deprecated::delimiter_will_be_paired", 73); + // Perl 5.037+ + offsets.put("experimental::class", 74); + // Additional categories + offsets.put("deprecated::subsequent_use_version", 75); + offsets.put("experimental::keyword_all", 76); + offsets.put("experimental::keyword_any", 77); + // Perl 5.043+ + offsets.put("experimental::enhanced_xx", 78); + offsets.put("experimental::signature_named_parameters", 79); + offsets.put("missing_import", 80); + offsets.put("deprecated::missing_import_called_with_args", 80); // Alias + // Placeholder offsets for future categories (needed for WARN_ALLstring compatibility) + // Perl 5's WARN_ALLstring sets all 21 bytes to 0x55, covering offsets 0-83 + offsets.put("__future_81", 81); + offsets.put("__future_82", 82); + offsets.put("__future_83", 83); + // Aliases for deprecated subcategories (use parent's offset since they don't have their own) + offsets.put("deprecated::apostrophe_as_package_separator", 2); + offsets.put("deprecated::goto_construct", 2); + offsets.put("deprecated::smartmatch", 2); + // Additional experimental aliases + offsets.put("experimental::bitwise", 52); // Use experimental's offset + offsets.put("experimental::lexical_subs", 52); // Use experimental's offset + + PERL5_OFFSETS = Collections.unmodifiableMap(offsets); + } + + // ==================== Warning Bits String Methods ==================== + + /** + * Gets the Perl 5 compatible bit offset for a category. + * Returns -1 if the category is not known. + * + * @param category The warning category name + * @return The bit offset, or -1 if unknown + */ + public static int getPerl5Offset(String category) { + Integer offset = PERL5_OFFSETS.get(category); + if (offset != null) { + return offset; + } + // Check user-defined categories + offset = userCategoryOffsets.get(category); + return offset != null ? offset : -1; + } + + /** + * Registers a user-defined category and returns its bit offset. + * If already registered, returns the existing offset. + * + * @param category The category name to register + * @return The assigned bit offset + */ + public static int registerUserCategoryOffset(String category) { + // Check if already in built-in offsets + Integer existing = PERL5_OFFSETS.get(category); + if (existing != null) { + return existing; + } + // Check or assign user category offset + return userCategoryOffsets.computeIfAbsent(category, + k -> nextUserOffset.getAndIncrement()); + } + + /** + * Converts BitSets to a Perl 5 compatible warning bits string. + * Each category uses 2 bits: bit 0 = enabled, bit 1 = fatal. + * + * @param enabled BitSet of enabled warning categories (by internal bit position) + * @param fatal BitSet of fatal warning categories (by internal bit position), may be null + * @param categoryToInternalBit Map from category name to internal bit position + * @return The Perl 5 compatible warning bits string + */ + public static String toWarningBitsString(BitSet enabled, BitSet fatal, + Map categoryToInternalBit) { + // Calculate required size + int maxOffset = WARN_SIZE * 4; // Default Perl 5 size in categories + for (String category : userCategoryOffsets.keySet()) { + int offset = userCategoryOffsets.get(category); + if (offset >= maxOffset) { + maxOffset = offset + 1; + } + } + + // Calculate bytes needed (2 bits per category) + int numBytes = Math.max(WARN_SIZE, (maxOffset * 2 + 7) / 8); + byte[] bytes = new byte[numBytes]; + + if (enabled != null && categoryToInternalBit != null) { + for (Map.Entry entry : categoryToInternalBit.entrySet()) { + String category = entry.getKey(); + int internalBit = entry.getValue(); + + if (internalBit >= 0 && enabled.get(internalBit)) { + int perl5Offset = getPerl5Offset(category); + if (perl5Offset >= 0) { + // Set enabled bit (offset * 2) + int bitPos = perl5Offset * 2; + int byteIndex = bitPos / 8; + int bitInByte = bitPos % 8; + if (byteIndex < numBytes) { + bytes[byteIndex] |= (1 << bitInByte); + } + } + } + } + } + + if (fatal != null && categoryToInternalBit != null) { + for (Map.Entry entry : categoryToInternalBit.entrySet()) { + String category = entry.getKey(); + int internalBit = entry.getValue(); + + if (internalBit >= 0 && fatal.get(internalBit)) { + int perl5Offset = getPerl5Offset(category); + if (perl5Offset >= 0) { + // Set fatal bit (offset * 2 + 1) + int bitPos = perl5Offset * 2 + 1; + int byteIndex = bitPos / 8; + int bitInByte = bitPos % 8; + if (byteIndex < numBytes) { + bytes[byteIndex] |= (1 << bitInByte); + } + } + } + } + } + + return new String(bytes, StandardCharsets.ISO_8859_1); + } + + /** + * Checks if a category is enabled in a warning bits string. + * + * @param bits The warning bits string (from caller()[9]) + * @param category The category to check + * @return true if the category is enabled + */ + public static boolean isEnabledInBits(String bits, String category) { + if (bits == null || category == null) { + return false; + } + + int offset = getPerl5Offset(category); + if (offset < 0) { + // Unknown category - check if it might be a registered user category + offset = userCategoryOffsets.get(category) != null ? + userCategoryOffsets.get(category) : -1; + if (offset < 0) { + return false; + } + } + + int bitPos = offset * 2; // Enabled bit + int byteIndex = bitPos / 8; + int bitInByte = bitPos % 8; + + if (byteIndex >= bits.length()) { + return false; + } + + return (bits.charAt(byteIndex) & (1 << bitInByte)) != 0; + } + + /** + * Checks if a category is fatal in a warning bits string. + * + * @param bits The warning bits string (from caller()[9]) + * @param category The category to check + * @return true if the category is fatal + */ + public static boolean isFatalInBits(String bits, String category) { + if (bits == null || category == null) { + return false; + } + + int offset = getPerl5Offset(category); + if (offset < 0) { + offset = userCategoryOffsets.get(category) != null ? + userCategoryOffsets.get(category) : -1; + if (offset < 0) { + return false; + } + } + + int bitPos = offset * 2 + 1; // Fatal bit + int byteIndex = bitPos / 8; + int bitInByte = bitPos % 8; + + if (byteIndex >= bits.length()) { + return false; + } + + return (bits.charAt(byteIndex) & (1 << bitInByte)) != 0; + } + + /** + * Sets the warning flags in a ScopedSymbolTable from a warning bits string. + * This is the reverse of toWarningBitsString - it parses the Perl 5 compatible + * warning bits string and sets the corresponding flags in the symbol table. + * + * @param symbolTable The symbol table to update + * @param bits The warning bits string (format used by ${^WARNING_BITS}) + */ + public static void setWarningBitsFromString(ScopedSymbolTable symbolTable, String bits) { + if (symbolTable == null || bits == null) { + return; + } + + // Clear all warning flags first + symbolTable.warningFlagsStack.peek().clear(); + symbolTable.warningFatalStack.peek().clear(); + + // For each known category, check if it's enabled/fatal in the bits string + for (String category : getWarningList()) { + int offset = getPerl5Offset(category); + if (offset >= 0) { + // Check enabled bit (offset * 2) + int enabledBitPos = offset * 2; + int enabledByteIndex = enabledBitPos / 8; + int enabledBitInByte = enabledBitPos % 8; + + if (enabledByteIndex < bits.length() && + (bits.charAt(enabledByteIndex) & (1 << enabledBitInByte)) != 0) { + symbolTable.enableWarningCategory(category); + } + + // Check fatal bit (offset * 2 + 1) + int fatalBitPos = offset * 2 + 1; + int fatalByteIndex = fatalBitPos / 8; + int fatalBitInByte = fatalBitPos % 8; + + if (fatalByteIndex < bits.length() && + (bits.charAt(fatalByteIndex) & (1 << fatalBitInByte)) != 0) { + symbolTable.enableFatalWarningCategory(category); + } + } + } + } /** * Constructs a WarningFlags object associated with a ScopedSymbolTable. @@ -83,7 +463,20 @@ public static List getWarningList() { } // Include custom categories registered via warnings::register warningSet.addAll(customCategories); - return new ArrayList<>(warningSet); + // Sort to ensure stable bit positions across runs and when new categories are added + List sorted = new ArrayList<>(warningSet); + Collections.sort(sorted); + return sorted; + } + + /** + * Gets the subcategories of a warning category. + * + * @param category The parent category + * @return Array of subcategory names, or null if none + */ + public static String[] getSubcategories(String category) { + return warningHierarchy.get(category); } /** @@ -98,7 +491,25 @@ public static void registerCategory(String category) { if (!warningHierarchy.containsKey(category)) { warningHierarchy.put(category, new String[]{}); } - // Register in the symbol table so it gets a bit position + // Add custom category as a subcategory of "all" so that + // "use warnings" / "no warnings" properly enable/disable it + String[] allSubs = warningHierarchy.get("all"); + if (allSubs != null) { + boolean found = false; + for (String s : allSubs) { + if (s.equals(category)) { found = true; break; } + } + if (!found) { + String[] newAllSubs = new String[allSubs.length + 1]; + System.arraycopy(allSubs, 0, newAllSubs, 0, allSubs.length); + newAllSubs[allSubs.length] = category; + warningHierarchy.put("all", newAllSubs); + } + } + // Assign a Perl5 bit offset so the category can be serialized + // to/from warning bits strings (caller()[9]) + registerUserCategoryOffset(category); + // Register in the symbol table so it gets an internal bit position ScopedSymbolTable.registerCustomWarningCategory(category); // If "all" warnings are already enabled, enable this new category too diff --git a/src/main/perl/lib/warnings.pm b/src/main/perl/lib/warnings.pm index b7cda0e16..c713d7902 100644 --- a/src/main/perl/lib/warnings.pm +++ b/src/main/perl/lib/warnings.pm @@ -1,6 +1,10 @@ package warnings; our $VERSION = '1.74'; +# Number of bytes in a warnings bit mask (required by caller.t tests) +# Matches Perl 5's WARNsize from warnings.h +our $BYTES = 21; + # # Original warnings pragma is part of the Perl core, maintained by the Perl 5 Porters. #