diff --git a/dev/design/attributes.md b/dev/design/attributes.md new file mode 100644 index 000000000..4aaed2b9b --- /dev/null +++ b/dev/design/attributes.md @@ -0,0 +1,622 @@ +# Attribute System Implementation Design + +## Overview + +Implement Perl's `attributes` pragma for PerlOnJava, enabling `attributes::get()`, `attributes->import()`, and the full `MODIFY_*_ATTRIBUTES` / `FETCH_*_ATTRIBUTES` callback chain for CODE, SCALAR, ARRAY, and HASH types. + +**Baseline:** 62/216 tests passing (28.7%) across 4 test files. +**Target:** ~140+/216 tests (65%+). + +## Perl Semantics (from `perldoc attributes`) + +### Core Behavior + +When Perl encounters attribute declarations, it translates them into calls to the `attributes` module: + +```perl +# Sub attributes (compile-time) +sub foo : method; +# equivalent to: +use attributes __PACKAGE__, \&foo, 'method'; + +# Variable attributes (my = run-time, our = compile-time) +my ($x, @y, %z) : Bent = 1; +# equivalent to: +use attributes (); +my ($x, @y, %z); +attributes::->import(__PACKAGE__, \$x, 'Bent'); +attributes::->import(__PACKAGE__, \@y, 'Bent'); +attributes::->import(__PACKAGE__, \%z, 'Bent'); +($x, @y, %z) = 1; + +# Typed variable (package comes from type, not current package) +package Dog; +my Canine $spot : Watchful; +# equivalent to: +attributes::->import(Canine => \$spot, "Watchful"); +``` + +### Built-in Attributes + +| Type | Attribute | Purpose | +|------|-----------|---------| +| CODE | `lvalue` | Marks sub as valid lvalue | +| CODE | `method` | Marks sub as method (suppresses ambiguity warnings) | +| CODE | `prototype(...)` | Sets prototype | +| CODE | `const` | Experimental: calls anon sub immediately, captures return as constant | +| SCALAR/ARRAY/HASH | `shared` | Thread-sharing (no-op in PerlOnJava) | + +### `import()` Flow + +1. Get `reftype` of the reference (CODE, SCALAR, ARRAY, HASH) +2. Check if `$home_stash` has `MODIFY__ATTRIBUTES` (via `UNIVERSAL::can`) +3. If handler exists: + - First apply built-in attributes via `_modify_attrs()` (returns non-built-in attrs) + - Pass remaining attrs to `MODIFY__ATTRIBUTES($pkg, $ref, @remaining)` + - If handler returns empty list AND remaining attrs are all-lowercase: emit "may clash with future reserved word" warning + - If handler returns non-empty list: croak with "Invalid attribute(s)" +4. If no handler: apply built-in attrs; anything unrecognized is an error + +### `get()` Flow + +1. Get `reftype` of the reference +2. Determine stash via `_guess_stash()` (for CODE: original package; fallback to `caller`) +3. Get built-in attributes via `_fetch_attrs()` +4. If stash has `FETCH__ATTRIBUTES`: call it and merge results +5. Return combined list + +### Error Messages (must match exactly) + +``` +Invalid CODE attribute: "plugh" +Invalid CODE attributes: "plugh" : "xyzzy" +Invalid SCALAR attribute: "plugh" +Invalid SCALAR attributes: "switch(10,foo(7,3))" : "expensive" +Unterminated attribute parameter in attribute list +Invalid separator character '+' in attribute list +Invalid separator character ':' in attribute list +SCALAR package attribute may clash with future reserved word: "plugh" +SCALAR package attributes may clash with future reserved words: "plugh" : "plover" +lvalue attribute applied to already-defined subroutine +lvalue attribute removed from already-defined subroutine +Useless use of attribute "const" +``` + +## Current State + +### What Already Works + +| Component | Status | Location | +|-----------|--------|----------| +| Sub attribute parsing (`:attr`, `:attr(args)`) | Done | `SubroutineParser.consumeAttributes()` (line 633) | +| Variable attribute parsing | Parsed but **ignored** | `OperatorParser.parseOperatorMyOurState()` (line 413) | +| `:prototype(...)` extraction | Done | `SubroutineParser.consumeAttributes()` (line 650) | +| `RuntimeCode.attributes` storage | Done | `RuntimeCode.java` (line 267) | +| `SubroutineNode.attributes` in AST | Done | `SubroutineNode.java` (line 20) | +| `MODIFY_CODE_ATTRIBUTES` dispatch | Done | `SubroutineParser.callModifyCodeAttributes()` (line 1046) | +| `:=` error detection | Done | `SubroutineParser.consumeAttributes()` (line 638) | +| Empty attr list (`: =`) handling | Done | `SubroutineParser.consumeAttributes()` (line 640) | +| `attributes.pm` module | Done | `src/main/perl/lib/attributes.pm` | +| `Attributes.java` backend | Done | `src/main/java/org/perlonjava/runtime/perlmodule/Attributes.java` | +| `_modify_attrs`, `_fetch_attrs`, `_guess_stash`, `reftype` | Done | `Attributes.java` | +| `:prototype(...)` via `use attributes` | Done | `Attributes.applyCodeAttribute()` | +| Compile-time warning scope for categorized warnings | Done | `Warnings.emitCategoryWarning()` | +| Warning category alias sync (illegalproto <-> syntax::illegalproto) | Done | `WarningFlags.java` hierarchy | + +### What Is Missing + +| Component | Impact | +|-----------|--------| +| `attributes::get()` returning built-in attrs (lvalue, method) | ~8 tests (attrs.t 35-40) | +| `FETCH_*_ATTRIBUTES` merging in `get()` | ~2 tests (attrs.t 35, 40) | +| Variable attribute dispatch (`MODIFY_SCALAR/ARRAY/HASH_ATTRIBUTES`) | ~12 tests | +| `:const` attribute support | ~2 tests (attrs.t 140, 145) | +| Closure prototype handling | ~4 tests (attrs.t 124-126, uni 30-31) | +| `my sub` attribute parsing after prototype | ~4 tests (attrproto.t 48-51) | +| Error message `"BEGIN failed--compilation aborted"` suffix | ~3 tests (attrs.t 155-157) | +| `Can't declare scalar dereference` error detection | ~2 tests (attrs.t 44-45) | +| `MODIFY_CODE_ATTRIBUTES` returning custom error | ~2 tests (attrs.t 32, uni 16) | +| Variable attribute tie integration | ~2 tests (attrs.t 41-42) | +| `Attribute::Handlers` integration | 4 tests (attrhand.t) — low priority | + +## Implementation Strategy + +The key insight is that Perl's `attributes.pm` relies on three XS functions (`_modify_attrs`, `_fetch_attrs`, `_guess_stash`) that operate on Perl internals. In PerlOnJava, we implement these as a Java module (`Attributes.java`) that directly accesses `RuntimeCode.attributes` and other runtime structures. + +The architecture: + +``` +attributes.pm (Perl) Attributes.java (Java) +├── import() ├── _modify_attrs(svref, @attrs) +│ └── calls _modify_attrs │ └── validates built-in attrs +│ └── calls MODIFY_*_ATTRS │ └── applies lvalue/method/prototype +├── get() ├── _fetch_attrs(svref) +│ └── calls _fetch_attrs │ └── reads RuntimeCode.attributes +│ └── calls FETCH_*_ATTRS ├── _guess_stash(svref) +├── reftype() │ └── returns packageName for CODE refs +│ └── calls Java ref() └── reftype(svref) +└── require_version() └── returns underlying ref type +``` + +Variable attribute dispatch happens in the **emitter/compiler** — when a `my`/`our`/`state` declaration has attributes in its AST annotations, the emitter generates code to call `attributes::->import(PKG, \$var, @attrs)` at the appropriate time (compile-time for `our`, run-time for `my`/`state`). + +## Files to Modify + +### New Files (already created) + +| File | Purpose | +|------|---------| +| `src/main/java/org/perlonjava/perlmodule/Attributes.java` | XS-equivalent functions | +| `src/main/perl/lib/attributes.pm` | Perl `attributes` pragma | + +### Modified Files + +| File | Change | +|------|--------| +| `SubroutineParser.java` | Prototype warnings, attribute parsing, error message improvements | +| `Warnings.java` | `emitCategoryWarning()`, `emitWarningFromCaller()` | +| `WarningFlags.java` | Warning category alias sync | +| `StatementResolver.java` | (Pending) `my sub` attribute parsing after prototype | +| `EmitVariable.java` or `EmitOperator.java` | (Pending) Variable attribute dispatch | + +## Related Documents + +- `dev/prompts/test-failures-not-quick-fix.md` — Section 8 (Attribute System) +- `dev/design/defer_blocks.md` — Similar implementation pattern + +--- + +## Progress Tracking + +### Current Status: Phase 7 partially complete (isDeclared + Attribute::Handlers + error format) + +### Completed Phases + +- [x] Phase 1: Core attribute infrastructure (2026-04-01 — 2026-04-02) + - Created `Attributes.java` with `_modify_attrs`, `_fetch_attrs`, `_guess_stash`, `reftype` + - Created `attributes.pm` (ported from system Perl) + - Implemented `attributes::get()` and `attributes->import()` flow + - Implemented `:prototype(...)` via `use attributes` with proper warning emission + - Fixed compile-time warning scope for categorized warnings (`emitCategoryWarning()`) + - Synced warning category aliases (illegalproto <-> syntax::illegalproto, etc.) + - Added `emitWarningFromCaller()` for unconditional warnings with correct location + - Fixed error message separator in `callModifyCodeAttributes` (`, ` → ` : `) + - Added prototype/illegalproto validation and warnings to `SubroutineParser.consumeAttributes()` + - Files: `Attributes.java`, `attributes.pm`, `Warnings.java`, `WarningFlags.java`, `SubroutineParser.java` + +- [x] Phase 5 (partial): :const attribute and MODIFY_CODE_ATTRIBUTES dispatch (2026-04-02) + - Deep-copy bug fix in const folding (`Attributes.java`) + - InterpretedCode override bypass for constantValue + - MODIFY_CODE_ATTRIBUTES dispatch for interpreter backend + - Files: `Attributes.java`, `InterpretedCode.java`, `OpcodeHandlerExtended.java`, `BytecodeCompiler.java` + +- [x] Phase 6 (partial): Detect scalar dereference in declarations (2026-04-02) + - Added `checkForDereference()` in `OperatorParser.java` + - Throws "Can't declare scalar dereference in 'my'" etc. + +- [x] Phase 7 (partial): isDeclared flag + Attribute::Handlers + error format (2026-04-02) + - Added `isDeclared` flag to `RuntimeCode` for explicitly declared subs + - Updated `getGlobSlot("CODE")` to return code refs for declared subs + - Fixed `Attribute::Handlers` `findsym()` — now all 4 attrhand.t tests pass + - Fixed variable attribute error format with BEGIN failed suffix + - Files: `RuntimeCode.java`, `RuntimeGlob.java`, `SubroutineParser.java` + +### Current Test Results (2026-04-02) + +| File | Before | After | Delta | +|------|--------|-------|-------| +| attrs.t | 49/130 → 111/158* | 152/158 | +41 | +| attrproto.t | 3/52 | 51/52 | +48 | +| attrhand.t | 0/0 | 4/4 | +4 | +| uni/attrs.t | 10/34 | 29/34 | +19 | +| **Total** | **62/216** | **236/248** | **+112** | + +\* attrs.t grew from 130 to 158 tests because the test no longer crashes partway through. + +### Remaining Failures Analysis + +#### attrproto.t: 4 remaining (48-51) + +**Root cause: `my sub` parser missing attribute loop after prototype** + +| Test | Issue | +|------|-------| +| 48 | `my sub lexsub1(bar) : prototype(baz) {}` — `:prototype(baz)` not parsed | +| 49 | Illegal proto warning not emitted for `(bar)` on lexical sub | +| 50 | Illegal proto warning not emitted for `(baz)` on lexical sub | +| 51 | "Prototype overridden" warning not emitted | + +**Fix:** In `StatementResolver.java`, after parsing `(prototype)` for `my sub`, add: +1. Call `emitIllegalProtoWarning()` for the parenthesized prototype +2. A second `while (peek(parser).text.equals(":"))` attribute-parsing loop + +**Effort:** Small — straightforward parser fix. + +#### attrs.t: 24 remaining + +**Group A: `attributes::get` not returning built-in attrs (8 tests: 35-42)** + +| Test | Expected | Got | Issue | +|------|----------|-----|-------| +| 35 | `"method Z"` | `"method"` | `FETCH_CODE_ATTRIBUTES` result not merged with built-in attrs | +| 36 | `"lvalue"` | `""` | `_fetch_attrs` not returning `lvalue` for predeclared subs | +| 37 | `"lvalue method"` | `""` | Same — multiple built-in attrs not returned | +| 38 | `"lvalue"` | `""` | `lvalue` on predeclared then defined sub not fetched | +| 39 | `"method"` | `""` | `method` on already-defined sub not fetched | +| 40 | `"method Z"` | `"Z"` | `method` from built-in + `Z` from FETCH not combined | +| 41-42 | `2`, `4` | `1`, `2` | Variable `tie` via `MODIFY_SCALAR_ATTRIBUTES` — `my $x : A0` dispatch missing | + +**Root cause:** `_fetch_attrs` in `Attributes.java` doesn't return `lvalue`/`method` from `RuntimeCode.attributes`. Tests 41-42 need variable attribute dispatch from the parser/emitter. + +**Fix:** +- Fix `_fetch_attrs` to filter and return built-in CODE attrs (`lvalue`, `method`, `const`) +- For 41-42: implement variable attribute dispatch in emitter (Phase 2) + +**Group B: Variable attribute dispatch missing (4 tests: 27-28, 41-42)** + +| Test | Issue | +|------|-------| +| 27 | `my A $x : plugh` — `MODIFY_SCALAR_ATTRIBUTES` not called, no "may clash" warning | +| 28 | Same for multiple attrs | +| 41-42 | `my $x : A0` in loop — tie via MODIFY_SCALAR_ATTRIBUTES not happening | + +**Fix:** Implement variable attribute dispatch. When the parser sees `my $x : Foo`, generate `attributes::->import(__PACKAGE__, \$x, "Foo")`. This requires emitter changes. + +**Group C: Error detection issues (5 tests: 20, 44-45, 87, uni/23)** + +| Test | Expected | Got | Issue | +|------|----------|-----|-------| +| 20 | Error with quoted attr names | Error without quotes | Error message formatting: attrs need double-quoting | +| 44 | `Can't declare scalar dereference in "our"` | `Invalid SCALAR attribute: foo` | Parser doesn't detect `our ${""} : foo` as dereference | +| 45 | `Can't declare scalar dereference in "my"` | `Invalid SCALAR attribute: bar` | Same for `my $$foo : bar` | +| 87 | `Global symbol "$nosuchvar" requires` | `Invalid CODE attribute: foo` | Strict error should be emitted instead of attr error | +| 154 | (TODO test) No separator error | Gets separator error | `$a ? my $var : my $othervar` — `:` parsed as attr separator | + +**Fix:** Multiple parser improvements needed. Tests 44-45 need dereference detection. Test 87 needs strict checking before attribute validation. Test 154 is a known TODO. + +**Group D: `:const` attribute (2 tests: 140, 145)** + +| Test | Expected | Got | Issue | +|------|----------|-----|-------| +| 140 | `Useless use of attribute "const"` warning | No warning | `const` not handled in `_modify_attrs` | +| 145 | `32487` (const closure value) | `undef` | `:Const` -> `const` via MODIFY_CODE_ATTRIBUTES not applied | + +**Fix:** Implement `:const` in `Attributes.java._modify_attrs()` — call the anon sub immediately and capture return value. + +**Group E: `MODIFY_CODE_ATTRIBUTES` returning custom error (2 tests: 32, uni/16)** + +| Test | Expected | Got | +|------|----------|-----| +| 32 | `X at ` (die in handler) | `Invalid CODE attribute: foo` | + +**Root cause:** When `MODIFY_CODE_ATTRIBUTES` dies, the die message should propagate. Currently the error is being replaced by the default "Invalid CODE attribute" message. + +**Group F: Closure prototype handling (3 tests: 124-126)** + +| Test | Expected | Got | +|------|----------|-----| +| 124 | `Closure prototype called` error | Empty `$@` | +| 125 | `Closure prototype called` error | `Not a CODE reference` | +| 126 | `undef` | `"referencing closure prototype"` | + +**Root cause:** Closure prototypes (stubs with captured lexicals) should die with "Closure prototype called" when invoked. This is a runtime feature, not an attribute-specific issue. + +**Group G: Error message suffix (3 tests: 155-157)** + +| Test | Expected | Got | +|------|----------|-----| +| 155 | `...at - line 1.\nBEGIN failed--compilation aborted at - line 1.` | `...at - line 1, near ""` | +| 156 | Same pattern for arrays | Same | +| 157 | Same pattern for hashes | Same | + +**Root cause:** `fresh_perl_is` tests run `./jperl` as a subprocess. The error message format is `"at - line 1."` + `"BEGIN failed--compilation aborted"` suffix. PerlOnJava produces `"at - line 1, near \"\""` instead. + +**Fix:** Two issues: (1) error location format, (2) missing "BEGIN failed" propagation. + +#### uni/attrs.t: 11 remaining + +These mirror attrs.t failures with Unicode identifiers: +- Tests 8, 11-12, 16-18, 20-21, 23, 30-31 — same root causes as attrs.t groups A-F above + +### Next Steps (Priority Order) + +#### Phase 2: `attributes::get` built-in attrs (HIGH — 8 tests) + +Fix `_fetch_attrs` in `Attributes.java` to return built-in CODE attributes (`lvalue`, `method`, `const`) from `RuntimeCode.attributes`. This is a small Java change. + +- **Files:** `Attributes.java` +- **Tests fixed:** attrs.t 35-40, uni/attrs.t equivalent +- **Effort:** Small + +#### Phase 3: Variable attribute dispatch (MEDIUM — 6+ tests) + +When the parser encounters `my $x : Foo` or `our @arr : Bar`, generate calls to `attributes::->import(__PACKAGE__, \$var, @attrs)`. This requires: + +1. In the JVM emitter (`EmitVariable.java` or `EmitOperator.java`): when a variable declaration has `"attributes"` annotation, emit `attributes::->import(PKG, \$var, @attrs)` +2. In the bytecode interpreter: same +3. Timing: compile-time for `our`, run-time for `my`/`state` + +- **Files:** `EmitVariable.java`, `CompileAssignment.java` (interpreter) +- **Tests fixed:** attrs.t 27-28, 41-42; uni/attrs.t 11-12, 17-18 +- **Effort:** Medium + +#### Phase 4: `my sub` attribute parsing (SMALL — 4 tests) + +Add attribute parsing after prototype in `StatementResolver.java` `my sub` path: +1. Call `emitIllegalProtoWarning()` for `(proto)` syntax +2. Add second `:` attribute loop after prototype + +- **Files:** `StatementResolver.java` +- **Tests fixed:** attrproto.t 48-51 +- **Effort:** Small + +#### Phase 5: `:const` attribute (SMALL — 2 tests) + +Implement `:const` in `Attributes.java._modify_attrs()`: +- When `const` is applied to an already-defined sub, emit "Useless use" warning +- When `const` is applied during sub definition, invoke the sub immediately and replace with constant + +- **Files:** `Attributes.java`, possibly `SubroutineParser.java` +- **Tests fixed:** attrs.t 140, 145 +- **Effort:** Small-Medium + +#### Phase 6: Error message improvements (MEDIUM — 7 tests) + +1. Quote attribute names in error messages with `"attr"` format (test 20) +2. Detect `our ${""}` and `my $$foo` as dereferences before attribute processing (tests 44-45) +3. Ensure `MODIFY_CODE_ATTRIBUTES` die propagates correctly (tests 32, uni/16) +4. Fix "BEGIN failed--compilation aborted" error suffix (tests 155-157) +5. Ensure strict errors take priority over attribute errors (test 87) + +- **Files:** `Attributes.java`, `SubroutineParser.java`, parser error handling +- **Tests fixed:** attrs.t 20, 32, 44-45, 87, 155-157; uni/attrs.t 8, 16, 20-21, 23 +- **Effort:** Medium + +#### Phase 7: Closure prototype feature (LOW — 4 tests) + +PerlOnJava does not have the "closure prototype" concept that Perl 5 has. In Perl 5, when a named sub is compiled that closes over lexical variables, the initial CV (before cloning) is a "closure prototype" — it has the captured variable slots but they are not yet bound to specific pad instances. This prototype is accessible via `MODIFY_CODE_ATTRIBUTES` (`$_[1]` before the sub is fully instantiated). Calling a closure prototype should die with "Closure prototype called". + +**What needs to be implemented:** +1. Detect when a RuntimeCode is a closure prototype (has captured variable slots but the closure hasn't been instantiated/cloned yet) +2. In `RuntimeCode.apply()`, check for the prototype state and die with "Closure prototype called" instead of executing the body +3. The prototype should still be referenceable (test 126: `\&{$proto}` should return a ref to it) + +**Test details:** +- Test 124: `eval { $proto->() }` — should die with `/^Closure prototype called/` +- Test 125: `eval { () = &$proto }` — should die with `/^Closure prototype called/` +- Test 126: `\&{$proto}` — should return a reference (referencing closure prototype) + +- **Files:** `RuntimeCode.java`, possibly `EmitSubroutine.java` +- **Tests fixed:** attrs.t 124-126; uni/attrs.t 30-31 +- **Effort:** Medium — requires implementing a new concept in the runtime + +#### Phase 8: Attribute::Handlers (LOW — 4 tests) + +The infrastructure (`attributes.pm`, CHECK blocks, MODIFY_CODE_ATTRIBUTES) is now in place. The remaining blockers are likely edge cases in glob manipulation, ref-identity comparison, or `undef &sub` syntax within `Attribute::Handlers.pm` internals. + +- **Files:** Possibly runtime fixes +- **Tests fixed:** attrhand.t 1-4 +- **Effort:** Unknown — needs investigation + +### Estimated Final Results + +| Phase | Tests Fixed | Cumulative | +|-------|-----------|------------| +| Current | — | 205/244 (84%) | +| Phase 2 | +8 | 213/244 (87%) | +| Phase 3 | +6 | 219/244 (90%) | +| Phase 4 | +4 | 223/244 (91%) | +| Phase 5 | +2 | 225/244 (92%) | +| Phase 6 | +12 | 237/244 (97%) | +| Phase 7 | +4 | 241/244 (99%) | +| Phase 8 | +4 | 244/244 (100%) | + +### Open Questions + +1. **Variable attribute storage**: Should variables store their attributes? Currently `RuntimeCode` has an `attributes` field, but `RuntimeScalar`/`RuntimeArray`/`RuntimeHash` do not. Most test cases only need the `MODIFY_*_ATTRIBUTES` callback (side effects like `tie`), not persistent storage. The `FETCH_*_ATTRIBUTES` tests are only for CODE refs. **Decision: Don't add storage to variables yet — not needed for any current test.** + +2. **`_modify_attrs` implementation level**: The system Perl implements this as XS that directly manipulates SV flags. In PerlOnJava, we access `RuntimeCode.attributes` from Java. For CODE refs this is straightforward. For variable refs, we only need to validate built-in attrs (`shared`) and return unrecognized ones — no actual flag-setting needed since `shared` is a no-op. + +3. **Attribute::Handlers**: The module exists at `src/main/perl/lib/Attribute/Handlers.pm` and the core dependencies (`attributes.pm`, CHECK blocks, MODIFY_CODE_ATTRIBUTES) are now implemented. All core attrhand.t tests pass (4/4). Remaining edge cases are in multi.t (DESTROY, END handler warning) and linerep.t (eval context file/line). + +4. **`our` variable attribute timing**: The perldoc says `our` attributes are applied at compile-time. This means the emitter needs to call `attributes::->import()` immediately during parsing (like `callModifyCodeAttributes` does for subs), not defer to runtime. **Decision: Handle in Phase 3.** + +### Regressions in Other Tests (vs PR #417 baseline) + +Three tests regressed compared to the PR #417 baseline. These are NOT attribute test files, +but they broke due to changes in the attribute-system branch. + +#### op/decl-refs.t: 322/408 → 174/408 (-148) + +**Root cause**: Two bugs in `callModifyVariableAttributes()` for `state` declared refs. + +1. **`state \@h : risible`** — `MODIFY_ARRAY_ATTRIBUTES` handler NOT called. + The handler exists and is found (`hasHandler=true`), but for `my`/`state` variables + the code at line 1294 says "handler will be dispatched at runtime by the emitter". + For declared refs (`state \@h`), the runtime dispatch is not working — the handler + is silently skipped. (For non-declared-ref forms like `state @h : risible`, it works.) + +2. **`state (\@h) : bumpy`** — sigil wrongly detected as `$` (SCALAR) instead of `@` (ARRAY). + The parenthesized declared-ref form `(\@h)` produces an AST where the OperatorNode's + operator is `\` (backslash), not `@`. The code at line 1197 (`String sigil = opNode.operator`) + gets `\`, which doesn't match any sigil case and `continue`s. But somehow the error says + "Invalid SCALAR attribute" — possibly a fallback that defaults to SCALAR. This causes + `die $@` in the template, aborting the test. + +**Reproduction**: +```bash +./jperl -e ' +use feature "declared_refs", "state"; +no warnings "experimental::declared_refs"; +sub MODIFY_ARRAY_ATTRIBUTES { print "handler: @_\n"; return; } +eval q{ state \@h : risible }; # handler NOT called (silent) +eval q{ state (\@h) : bumpy }; # "Invalid SCALAR attribute: bumpy" error +' +``` + +**Fix needed**: In `callModifyVariableAttributes()`, handle the declared-ref case where +the operand is a backslash OperatorNode — unwrap it to get the inner sigil. Also ensure +the runtime dispatch path works for `state` declared refs. + +#### op/lexsub.t: 105/160 → 0/0 (-105) + +**Root cause**: Syntax error at line 370 (`p my @b;`) prevents the entire file from compiling. + +On the baseline, the file compiled and ran 105 tests. On our branch, a syntax error at +line 370 causes 0 tests to run. The line is: +```perl +{ + state sub p (\@) { ... } # line 366: state sub with (\@) prototype + p(my @a); # line 369: works (parenthesized) + p my @b; # line 370: SYNTAX ERROR (unparenthesized) +} +``` + +The `(\@)` prototype should tell the parser that `p` takes an array by reference, +allowing `p my @b` without parentheses. On the baseline, this prototype was applied +during parsing. On our branch, scope management changes (SubroutineParser.java: +enter scope before parseSignature, exit after block body) may have affected how +`state sub` prototypes are registered and visible for later prototype-aware parsing. + +**Investigation needed**: Check whether `state sub p (\@)` registers its prototype +in the symbol table during parsing, and whether the scope changes moved this registration +to a different scope level that's not visible at the call site (line 370). + +#### lib/deprecate.t: 4/10 → 0/10 (-4) + +**Root cause**: `defined(&foo)` returns true for forward-declared subs (`sub foo;`). + +In Perl 5, `sub foo;` (forward declaration) does NOT make `defined(&foo)` true. +In PerlOnJava after Phase 7's `isDeclared` flag changes, it does. This breaks +`File::Copy` which has: +```perl +sub syscopy; # line 22: forward declaration +... +unless (defined &syscopy) { # line 315: should enter this block! + $Syscopy_is_copy = 1; + *syscopy = \© # line 326: sets up syscopy +} +``` + +Because `defined &syscopy` wrongly returns true, the initialization block is skipped. +When `copy()` later calls `syscopy()`, it dies with "Undefined subroutine &File::Copy::syscopy". + +**Reproduction**: +```bash +./jperl -e 'sub foo; print defined(&foo) ? "defined" : "undefined", "\n";' +# Prints "defined" — should print "undefined" +perl -e 'sub foo; print defined(&foo) ? "defined" : "undefined", "\n";' +# Prints "undefined" — correct +``` + +**Fix needed**: In `RuntimeGlob.java` or `RuntimeCode.java`, ensure that `defined(&sub)` +returns false for forward declarations (subs that have `isDeclared=true` but no actual body). +The `isDeclared` flag should only affect `getGlobSlot("CODE")` for attribute handler lookup, +not `defined()` semantics. + +**Note**: Fixing this restores the baseline 4/10. The remaining 6/10 failures are +pre-existing (unrelated to this branch) — caused by `caller()[7]` (is_require) always +returning undef, which breaks `deprecate.pm`'s require-detection logic. + +### Progress Tracking + +#### Current Status: Phase 8 completed + strict vars fix + regression investigation (2026-04-02) + +#### Test Scores After Phase 8 + strict vars fix + +| Test File | Score | Change | +|-----------|-------|--------| +| attrs.t | 158/159 | +6 (test 88 now passes; only TODO test 154 remains) | +| uni/attrs.t | 35/35 | +6 (test 24 now passes; 100% pass rate) | +| attrproto.t | 51/52 | unchanged | +| attrhand.t | 4/4 | unchanged | +| AH/caller.t | 2/2 | unchanged | +| AH/constants.t | 1/1 | unchanged | +| AH/data_convert.t | 8/8 | unchanged | +| AH/linerep.t | 15/18 | unchanged | +| AH/multi.t | 45/51 | unchanged | + +**Total: 319/330 (96.7%)** + +#### Phase 8 Fixes (2026-04-02) + +1. **RuntimeScalarType.java**: Added null check in `blessedId()` for reference-typed scalars with null value +2. **ScalarSpecialVariable.java**: Fixed `${^LAST_SUCCESSFUL_PATTERN}` to return undef when no regex match yet (was REGEX(null)) +3. **ReferenceOperators.java**: Added null-safety checks in `ref()` for CODE, REGEX, REFERENCE, ARRAYREFERENCE, HASHREFERENCE, GLOBREFERENCE types +4. **SubroutineParser.java**: Push CallerStack frames in `callModifyCodeAttributes()` with source file/line +5. **OperatorParser.java**: Push CallerStack frames in `callModifyVariableAttributes()` with source file/line +6. **RuntimeCode.java**: Added CallerStack fallback in `callerWithSub()` for frames beyond Java stack trace + +#### Parse-time strict vars fix (2026-04-02) + +Implemented parse-time `strict 'vars'` checking to fix perl #49472 (attrs.t test 88, uni/attrs.t test 24). +Named subroutine bodies are compiled lazily, so strict vars checking in the bytecode compiler never fired for +undeclared variables inside named sub bodies. Added checking at parse time since parsing is always eager. + +1. **Variable.java**: Added `checkStrictVarsAtParseTime()` with comprehensive exemption logic +2. **OperatorParser.java**: Set `parsingDeclaration` flag during `my`/`our`/`state` parsing +3. **Parser.java**: Added `parsingDeclaration` flag +4. **SignatureParser.java**: Register signature parameters in symbol table during parsing +5. **SubroutineParser.java**: Enter scope for signature variables before parsing, exit after block body +6. **StatementParser.java**: Register catch variable in scope, suppress strict check for `catch ($e)` + +#### Remaining Failures + +| Test | Count | Category | Notes | +|------|-------|----------|-------| +| attrs.t 41-42, uni 17-18 | 4 | Phase 3: `my` var attribute dispatch | Ref points to temp, not lexical | +| attrs.t 124-125, uni 30-31 | 4 | Phase 7: Closure prototype | Not implemented | +| attrs.t 154 | 1 | TODO test (expected failure) | RT #3605 ternary/attribute parsing | +| attrproto.t 48 | 1 | Lexical sub in eval STRING | Pre-existing eval bug | +| linerep.t 16-17 | 2 | eval context file/line | `#line` directive not respected in eval | +| linerep.t 18 | 1 | `my` var ref identity | Same as Phase 3 issue | +| multi.t 45-47,49-50 | 5 | DESTROY not implemented | PerlOnJava limitation | +| multi.t 52 | 1 | END handler warning | Minor edge case | + +#### Known Issue: `\K` Regex Bug Affects decl-refs.t + +The `\K` (keep left) assertion in `s///` is broken. For example: + +```perl +"MODIFY_SCALAR_ATTRIBUTES" =~ s/MODIFY_\KSCALAR/ARRAY/; +# Expected: "MODIFY_ARRAY_ATTRIBUTES" +# Actual: "ARRAY_ATTRIBUTES" +``` + +This is a **pre-existing bug on master** (not introduced by the attribute branch). +It affects `decl-refs.t` because the test template uses `\K` substitution to rename +`MODIFY_SCALAR_ATTRIBUTES` → `MODIFY_ARRAY_ATTRIBUTES` / `MODIFY_HASH_ATTRIBUTES`. +The corrupted handler name causes `can()` to fail, which triggers "Invalid attribute" +errors for `@` and `%` variable types in the test iterations. + +**Impact:** ~45 tests in decl-refs.t that would otherwise pass if `\K` worked correctly. + +**Fix:** Investigate and fix `\K` handling in the regex engine (`org.perlonjava.regex` +or the `s///` substitution logic). Once fixed, decl-refs.t should gain ~45 additional +passing tests without any attribute system changes. + +#### Regressions Next Steps (Priority Order) + +1. **Fix `defined(&foo)` for forward declarations** (deprecate.t, EASY) + - In `RuntimeGlob.getGlobSlot("CODE")` or `defined()` check, treat subs with + `isDeclared=true` but no body as undefined for `defined()` purposes + - Restores deprecate.t from 0/10 → 4/10 (baseline) + - May fix other modules that use `sub foo;` forward declarations + +2. **Fix `state` declared-ref attribute dispatch** (decl-refs.t, MEDIUM) + - Unwrap backslash OperatorNode in `callModifyVariableAttributes()` to get inner sigil + - Ensure runtime dispatch handles declared refs for `my`/`state` + - Restores decl-refs.t from 174/408 → 322/408 (baseline) + +3. **Investigate lexsub.t state sub prototype registration** (lexsub.t, NEEDS INVESTIGATION) + - Check if scope management changes affected `state sub` prototype visibility + - The `(\@)` prototype must be visible at the call site for unparenthesized calls + - Restores lexsub.t from 0/0 → 105/160 (baseline) + +4. **Fix `\K` regex assertion in `s///`** (decl-refs.t, SEPARATE ISSUE) + - Pre-existing bug, not caused by attribute branch + - Once fixed, decl-refs.t gains ~45 more passing tests + - See "Known Issue" section above for details + +### PR +- https://github.com/fglock/PerlOnJava/pull/420 diff --git a/dev/prompts/test-failures-not-quick-fix.md b/dev/prompts/test-failures-not-quick-fix.md index 636478188..7b7d60b11 100644 --- a/dev/prompts/test-failures-not-quick-fix.md +++ b/dev/prompts/test-failures-not-quick-fix.md @@ -745,8 +745,8 @@ After rebasing `feature/test-failure-fixes` onto latest master, the following re ## Recommended Next Steps -1. **(?{...}) non-fatal workaround** (Medium) - change `UNIMPLEMENTED_CODE_BLOCK` from fatal to `(?:)` fallback - 500+ tests -2. **64-bit integer ops** (Medium-Hard) - unsigned semantics, overflow handling -3. **caller() extended fields** (Medium-Hard) - wantarray, evaltext, is_require -4. **Attribute system** (Medium-Hard) - attributes.pm module, MODIFY_*_ATTRIBUTES callbacks +1. ~~**(?{...}) non-fatal workaround**~~ - **NOT AN OPTION** - silently replacing code blocks with no-ops would mask real failures and produce incorrect test results +2. **64-bit integer ops** (Medium-Hard) - Note: PerlOnJava declares itself as 32-bit, so many of these test failures may be expected/irrelevant +3. **Attribute system** (Medium-Hard) - attributes.pm module, MODIFY_*_ATTRIBUTES callbacks - **NEXT TARGET** +4. **caller() extended fields** (Medium-Hard) - wantarray, evaltext, is_require 5. **op/for.t glob/read-only regression** (Medium) - from master's GlobalVariable.java changes diff --git a/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java b/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java index e0d1b196f..31948abfd 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java +++ b/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java @@ -11,6 +11,7 @@ import org.perlonjava.frontend.semantic.ScopedSymbolTable; import org.perlonjava.frontend.semantic.SymbolTable; import org.perlonjava.runtime.debugger.DebugState; +import org.perlonjava.runtime.perlmodule.Attributes; import org.perlonjava.runtime.perlmodule.Strict; import org.perlonjava.runtime.runtimetypes.*; @@ -2348,6 +2349,9 @@ void compileVariableDeclaration(OperatorNode node, String op) { default -> throwCompilerException("Unsupported variable type: " + sigil); } + // Runtime attribute dispatch for state variables with attributes + emitVarAttrsIfNeeded(node, reg, sigil); + // If this is a declared reference, create a reference to it if (isDeclaredReference && currentCallContext != RuntimeContextType.VOID) { int refReg = allocateRegister(); @@ -2381,6 +2385,9 @@ void compileVariableDeclaration(OperatorNode node, String op) { default -> throwCompilerException("Unsupported variable type: " + sigil); } + // Runtime attribute dispatch for my variables with attributes + emitVarAttrsIfNeeded(node, reg, sigil); + // If this is a declared reference, create a reference to it if (isDeclaredReference && currentCallContext != RuntimeContextType.VOID) { int refReg = allocateRegister(); @@ -4158,9 +4165,19 @@ void compileVariableReference(OperatorNode node, String op) { if (node.operand != null) { // Special case: \&name — CODE is already a reference type. // Emit LOAD_GLOBAL_CODE directly without CREATE_REF, matching JVM compiler. + // Also set isSymbolicReference so defined(\&stub) returns true, matching + // the JVM backend's createCodeReference behavior. if (node.operand instanceof OperatorNode operandOp && operandOp.operator.equals("&") - && operandOp.operand instanceof IdentifierNode) { + && operandOp.operand instanceof IdentifierNode idNode) { + // Set isSymbolicReference before loading, so defined(\&Name) returns true + String subName = NameNormalizer.normalizeVariableName( + idNode.name, getCurrentPackage()); + RuntimeScalar codeRef = GlobalVariable.getGlobalCodeRef(subName); + if (codeRef.type == RuntimeScalarType.CODE + && codeRef.value instanceof RuntimeCode rc) { + rc.isSymbolicReference = true; + } node.operand.accept(this); // lastResultReg already holds the CODE scalar — no wrapping needed return; @@ -4329,6 +4346,32 @@ int addToStringPool(String str) { return index; } + /** + * Emit DISPATCH_VAR_ATTRS opcode if the node has variable attributes. + * Called after a my/state variable is initialized in its register. + */ + @SuppressWarnings("unchecked") + void emitVarAttrsIfNeeded(OperatorNode node, int varReg, String sigil) { + if (node.annotations == null || !node.annotations.containsKey("attributes")) return; + + List attrs = (List) node.annotations.get("attributes"); + String packageName = (String) node.annotations.get("attributePackage"); + if (packageName == null) packageName = getCurrentPackage(); + + String fileName = sourceName; + int lineNum = sourceLine; + + // Store metadata in constant pool as Object[] + Object[] data = new Object[]{ + packageName, sigil, attrs.toArray(new String[0]), fileName, lineNum + }; + int constIdx = addToConstantPool(data); + + emit(Opcodes.DISPATCH_VAR_ATTRS); + emitReg(varReg); + emit(constIdx); + } + private int addToConstantPool(Object obj) { // Use HashMap for O(1) lookup instead of O(n) ArrayList.indexOf() Integer cached = constantPoolIndex.get(obj); @@ -4789,6 +4832,11 @@ private void visitAnonymousSubroutine(SubroutineNode node) { // No closures - just wrap the InterpretedCode RuntimeScalar codeScalar = new RuntimeScalar(subCode); subCode.__SUB__ = codeScalar; // Set __SUB__ for self-reference + // Dispatch MODIFY_CODE_ATTRIBUTES for anonymous subs with non-builtin attributes + if (subCode.attributes != null && !subCode.attributes.isEmpty() + && subCode.packageName != null) { + Attributes.runtimeDispatchModifyCodeAttributes(subCode.packageName, codeScalar); + } int constIdx = addToConstantPool(codeScalar); emit(Opcodes.LOAD_CONST); emitReg(codeReg); diff --git a/src/main/java/org/perlonjava/backend/bytecode/BytecodeInterpreter.java b/src/main/java/org/perlonjava/backend/bytecode/BytecodeInterpreter.java index 651d7acaa..bd56273ab 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/BytecodeInterpreter.java +++ b/src/main/java/org/perlonjava/backend/bytecode/BytecodeInterpreter.java @@ -1956,6 +1956,10 @@ public static RuntimeList execute(InterpretedCode code, RuntimeArray args, int c pc = SlowOpcodeHandler.executeArrayKVSliceDelete(bytecode, pc, registers); } + case Opcodes.DISPATCH_VAR_ATTRS -> { + pc = SlowOpcodeHandler.executeDispatchVarAttrs(bytecode, pc, registers, code.constants); + } + default -> { int opcodeInt = opcode; throw new RuntimeException( diff --git a/src/main/java/org/perlonjava/backend/bytecode/CompileAssignment.java b/src/main/java/org/perlonjava/backend/bytecode/CompileAssignment.java index fa37f17bc..1685e3b02 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/CompileAssignment.java +++ b/src/main/java/org/perlonjava/backend/bytecode/CompileAssignment.java @@ -362,6 +362,10 @@ public static void compileAssignmentOperator(BytecodeCompiler bytecodeCompiler, bytecodeCompiler.emit(persistId); bytecodeCompiler.registerVariable(varName, reg); + + // Runtime attribute dispatch for state variables with attributes + bytecodeCompiler.emitVarAttrsIfNeeded(leftOp, reg, "$"); + bytecodeCompiler.lastResultReg = reg; return; } @@ -375,9 +379,23 @@ public static void compileAssignmentOperator(BytecodeCompiler bytecodeCompiler, // Now allocate register for new lexical variable and add to symbol table int reg = bytecodeCompiler.addVariable(varName, "my"); - bytecodeCompiler.emit(Opcodes.MY_SCALAR); - bytecodeCompiler.emitReg(reg); - bytecodeCompiler.emitReg(valueReg); + boolean hasAttrs = leftOp.annotations != null + && leftOp.annotations.containsKey("attributes"); + if (hasAttrs) { + // When attributes are present (e.g., my $x : TieLoop = $i), + // we must create the scalar first, dispatch attributes (which + // may tie the variable), then assign the value so STORE fires. + bytecodeCompiler.emit(Opcodes.LOAD_UNDEF); + bytecodeCompiler.emitReg(reg); + bytecodeCompiler.emitVarAttrsIfNeeded(leftOp, reg, "$"); + bytecodeCompiler.emit(Opcodes.SET_SCALAR); + bytecodeCompiler.emitReg(reg); + bytecodeCompiler.emitReg(valueReg); + } else { + bytecodeCompiler.emit(Opcodes.MY_SCALAR); + bytecodeCompiler.emitReg(reg); + bytecodeCompiler.emitReg(valueReg); + } bytecodeCompiler.lastResultReg = reg; return; @@ -432,6 +450,9 @@ public static void compileAssignmentOperator(BytecodeCompiler bytecodeCompiler, bytecodeCompiler.emitReg(arrayReg); bytecodeCompiler.emitReg(listReg); + // Runtime attribute dispatch for my variables with attributes + bytecodeCompiler.emitVarAttrsIfNeeded(leftOp, arrayReg, "@"); + if (rhsContext == RuntimeContextType.SCALAR) { int countReg = bytecodeCompiler.allocateRegister(); bytecodeCompiler.emit(Opcodes.ARRAY_SIZE); @@ -490,6 +511,9 @@ public static void compileAssignmentOperator(BytecodeCompiler bytecodeCompiler, bytecodeCompiler.emitReg(hashReg); bytecodeCompiler.emitReg(listReg); + // Runtime attribute dispatch for my variables with attributes + bytecodeCompiler.emitVarAttrsIfNeeded(leftOp, hashReg, "%"); + bytecodeCompiler.lastResultReg = hashReg; return; } diff --git a/src/main/java/org/perlonjava/backend/bytecode/InterpretedCode.java b/src/main/java/org/perlonjava/backend/bytecode/InterpretedCode.java index c3f1a8693..c1ac6d156 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/InterpretedCode.java +++ b/src/main/java/org/perlonjava/backend/bytecode/InterpretedCode.java @@ -233,6 +233,10 @@ public InterpreterState.InterpreterFrame getOrCreateFrame(String packageName, St */ @Override public RuntimeList apply(RuntimeArray args, int callContext) { + // Return cached constant value if this sub has been const-folded + if (constantValue != null) { + return new RuntimeList(constantValue); + } // 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); @@ -253,6 +257,10 @@ public RuntimeList apply(RuntimeArray args, int callContext) { @Override public RuntimeList apply(String subroutineName, RuntimeArray args, int callContext) { + // Return cached constant value if this sub has been const-folded + if (constantValue != null) { + return new RuntimeList(constantValue); + } // Push args for getCallerArgs() support (used by List::Util::any/all/etc.) RuntimeCode.pushArgs(args); // Push warning bits for FATAL warnings support diff --git a/src/main/java/org/perlonjava/backend/bytecode/OpcodeHandlerExtended.java b/src/main/java/org/perlonjava/backend/bytecode/OpcodeHandlerExtended.java index 715c6e5af..1bd7d2125 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/OpcodeHandlerExtended.java +++ b/src/main/java/org/perlonjava/backend/bytecode/OpcodeHandlerExtended.java @@ -1,6 +1,7 @@ package org.perlonjava.backend.bytecode; import org.perlonjava.runtime.operators.*; +import org.perlonjava.runtime.perlmodule.Attributes; import org.perlonjava.runtime.regex.RuntimeRegex; import org.perlonjava.runtime.runtimetypes.*; @@ -890,6 +891,13 @@ public static int executeCreateClosure(int[] bytecode, int pc, RuntimeBase[] reg RuntimeScalar codeRef = new RuntimeScalar(closureCode); closureCode.__SUB__ = codeRef; registers[rd] = codeRef; + + // Dispatch MODIFY_CODE_ATTRIBUTES for anonymous subs with non-builtin attributes + // Pass isClosure=true since CREATE_CLOSURE always creates a closure + if (closureCode.attributes != null && !closureCode.attributes.isEmpty() + && closureCode.packageName != null) { + Attributes.runtimeDispatchModifyCodeAttributes(closureCode.packageName, codeRef, true); + } return pc; } diff --git a/src/main/java/org/perlonjava/backend/bytecode/Opcodes.java b/src/main/java/org/perlonjava/backend/bytecode/Opcodes.java index f80243979..38d826e1a 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/Opcodes.java +++ b/src/main/java/org/perlonjava/backend/bytecode/Opcodes.java @@ -2124,6 +2124,14 @@ public class Opcodes { */ public static final short ARRAY_SLICE_DELETE_LOCAL = 450; + // variable attribute dispatch + /** + * Dispatch MODIFY_*_ATTRIBUTES at runtime for my/state variable declarations. + * Format: DISPATCH_VAR_ATTRS var_reg const_idx + * const_idx points to Object[] in constant pool: [packageName, sigil, String[] attrs, fileName, lineNum] + */ + public static final short DISPATCH_VAR_ATTRS = 451; + private Opcodes() { } // Utility class - no instantiation } diff --git a/src/main/java/org/perlonjava/backend/bytecode/SlowOpcodeHandler.java b/src/main/java/org/perlonjava/backend/bytecode/SlowOpcodeHandler.java index fa0a071a2..4c4d78d56 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/SlowOpcodeHandler.java +++ b/src/main/java/org/perlonjava/backend/bytecode/SlowOpcodeHandler.java @@ -1369,4 +1369,27 @@ public static int executeCodeDerefNonStrict(int[] bytecode, int pc, return pc; } + + /** + * Dispatch MODIFY_*_ATTRIBUTES at runtime for my/state variable declarations. + * Format: DISPATCH_VAR_ATTRS var_reg const_idx + * const_idx points to Object[] in constant pool: [packageName, sigil, String[] attrs, fileName, lineNum] + */ + public static int executeDispatchVarAttrs(int[] bytecode, int pc, + RuntimeBase[] registers, Object[] constants) { + int varReg = bytecode[pc++]; + int constIdx = bytecode[pc++]; + + Object[] data = (Object[]) constants[constIdx]; + String packageName = (String) data[0]; + String sigil = (String) data[1]; + String[] attributes = (String[]) data[2]; + String fileName = (String) data[3]; + int lineNum = (Integer) data[4]; + + org.perlonjava.runtime.perlmodule.Attributes.runtimeDispatchModifyVariableAttributes( + packageName, registers[varReg], sigil, attributes, fileName, lineNum); + + return pc; + } } diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java b/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java index 3aac6b8f4..41eb60b41 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java @@ -314,11 +314,11 @@ public static void emitSubroutine(EmitterContext ctx, SubroutineNode node) { // Set prototype if needed if (node.prototype != null) { mv.visitInsn(Opcodes.DUP); - mv.visitMethodInsn(Opcodes.INVOKEVIRTUAL, + mv.visitFieldInsn(Opcodes.GETFIELD, "org/perlonjava/runtime/runtimetypes/RuntimeScalar", - "getCode", - "()Lorg/perlonjava/runtime/runtimetypes/RuntimeCode;", - false); + "value", + "Ljava/lang/Object;"); + mv.visitTypeInsn(Opcodes.CHECKCAST, "org/perlonjava/runtime/runtimetypes/RuntimeCode"); mv.visitLdcInsn(node.prototype); mv.visitFieldInsn(Opcodes.PUTFIELD, "org/perlonjava/runtime/runtimetypes/RuntimeCode", @@ -327,6 +327,76 @@ public static void emitSubroutine(EmitterContext ctx, SubroutineNode node) { } } + // Set attributes if needed (after try-catch, both paths leave RuntimeScalar on stack) + if (node.attributes != null && !node.attributes.isEmpty()) { + mv.visitInsn(Opcodes.DUP); + mv.visitFieldInsn(Opcodes.GETFIELD, + "org/perlonjava/runtime/runtimetypes/RuntimeScalar", + "value", + "Ljava/lang/Object;"); + mv.visitTypeInsn(Opcodes.CHECKCAST, "org/perlonjava/runtime/runtimetypes/RuntimeCode"); + // Create a new ArrayList and populate it + mv.visitTypeInsn(Opcodes.NEW, "java/util/ArrayList"); + mv.visitInsn(Opcodes.DUP); + mv.visitMethodInsn(Opcodes.INVOKESPECIAL, + "java/util/ArrayList", + "", + "()V", + false); + for (String attr : node.attributes) { + mv.visitInsn(Opcodes.DUP); + mv.visitLdcInsn(attr); + mv.visitMethodInsn(Opcodes.INVOKEINTERFACE, + "java/util/List", + "add", + "(Ljava/lang/Object;)Z", + true); + mv.visitInsn(Opcodes.POP); // pop boolean return of add() + } + mv.visitFieldInsn(Opcodes.PUTFIELD, + "org/perlonjava/runtime/runtimetypes/RuntimeCode", + "attributes", + "Ljava/util/List;"); + } + + // Dispatch MODIFY_CODE_ATTRIBUTES for anonymous subs with non-builtin attributes. + // Named subs have their dispatch in SubroutineParser.handleNamedSub at compile time. + // Anonymous subs need runtime dispatch because the code ref only exists at runtime. + if (node.name == null && node.attributes != null && !node.attributes.isEmpty()) { + java.util.Set builtinAttrs = java.util.Set.of("lvalue", "method", "const"); + boolean hasNonBuiltin = false; + for (String attr : node.attributes) { + String name = attr.startsWith("-") ? attr.substring(1) : attr; + int parenIdx = name.indexOf('('); + String baseName = parenIdx >= 0 ? name.substring(0, parenIdx) : name; + if (!builtinAttrs.contains(baseName) && !baseName.equals("prototype")) { + hasNonBuiltin = true; + break; + } + } + if (hasNonBuiltin) { + // Determine if this sub is a closure (captures outer lexical variables). + // Closures get closure prototype semantics: MODIFY_CODE_ATTRIBUTES receives + // the prototype (non-callable), and the expression result is a callable clone. + boolean isClosure = visibleVariables.size() > skipVariables; + + // Stack: [RuntimeScalar(codeRef)] + mv.visitInsn(Opcodes.DUP); + // Stack: [codeRef, codeRef] + mv.visitLdcInsn(ctx.symbolTable.getCurrentPackage()); + mv.visitInsn(Opcodes.SWAP); + // Stack: [codeRef, pkg, codeRef] + mv.visitInsn(isClosure ? Opcodes.ICONST_1 : Opcodes.ICONST_0); + // Stack: [codeRef, pkg, codeRef, isClosure] + mv.visitMethodInsn(Opcodes.INVOKESTATIC, + "org/perlonjava/runtime/perlmodule/Attributes", + "runtimeDispatchModifyCodeAttributes", + "(Ljava/lang/String;Lorg/perlonjava/runtime/runtimetypes/RuntimeScalar;Z)V", + false); + // Stack: [codeRef] (codeRef.value now points to clone if isClosure) + } + } + // 6. Clean up the stack if context is VOID if (ctx.contextType == RuntimeContextType.VOID) { mv.visitInsn(Opcodes.POP); // Remove the RuntimeScalar object from the stack diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitVariable.java b/src/main/java/org/perlonjava/backend/jvm/EmitVariable.java index 422a6b038..8416821b4 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitVariable.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitVariable.java @@ -1459,6 +1459,13 @@ static void handleMyOperator(EmitterVisitor emitterVisitor, OperatorNode node) { // Store the variable in a JVM local variable emitterVisitor.ctx.mv.visitVarInsn(Opcodes.ASTORE, varIndex); + // Emit runtime attribute dispatch for my/state variables. + // For 'our', attributes were already dispatched at compile time. + if (!operator.equals("our") && node.annotations != null + && node.annotations.containsKey("attributes")) { + emitRuntimeAttributeDispatch(emitterVisitor, node, varIndex, sigil); + } + // For declared references in non-void context, return a reference to the variable if (isDeclaredReference && emitterVisitor.ctx.contextType != RuntimeContextType.VOID) { // Load the variable back from the local variable slot @@ -1488,4 +1495,50 @@ static void handleMyOperator(EmitterVisitor emitterVisitor, OperatorNode node) { throw new PerlCompilerException( node.tokenIndex, "Not implemented: " + node.operator, emitterVisitor.ctx.errorUtil); } + + /** + * Emit bytecode to call Attributes.runtimeDispatchModifyVariableAttributes() + * for my/state variable declarations that have non-builtin attributes. + * + *

This is called after the variable is stored in its JVM local slot, so + * the reference passed to MODIFY_*_ATTRIBUTES points to the actual lexical. + */ + @SuppressWarnings("unchecked") + private static void emitRuntimeAttributeDispatch(EmitterVisitor emitterVisitor, + OperatorNode node, int varIndex, String sigil) { + EmitterContext ctx = emitterVisitor.ctx; + MethodVisitor mv = ctx.mv; + + List attributes = (List) node.annotations.get("attributes"); + String packageName = (String) node.annotations.get("attributePackage"); + if (packageName == null) { + packageName = ctx.symbolTable.getCurrentPackage(); + } + String fileName = ctx.compilerOptions.fileName; + int lineNum = ctx.errorUtil != null ? ctx.errorUtil.getLineNumber(node.getIndex()) : 0; + + // Push args: (String packageName, RuntimeBase variable, String sigil, String[] attrs, String fileName, int lineNum) + mv.visitLdcInsn(packageName); + mv.visitVarInsn(Opcodes.ALOAD, varIndex); + mv.visitLdcInsn(sigil); + + // Create String[] for attributes + mv.visitIntInsn(Opcodes.BIPUSH, attributes.size()); + mv.visitTypeInsn(Opcodes.ANEWARRAY, "java/lang/String"); + for (int i = 0; i < attributes.size(); i++) { + mv.visitInsn(Opcodes.DUP); + mv.visitIntInsn(Opcodes.BIPUSH, i); + mv.visitLdcInsn(attributes.get(i)); + mv.visitInsn(Opcodes.AASTORE); + } + + mv.visitLdcInsn(fileName); + mv.visitLdcInsn(lineNum); + + mv.visitMethodInsn(Opcodes.INVOKESTATIC, + "org/perlonjava/runtime/perlmodule/Attributes", + "runtimeDispatchModifyVariableAttributes", + "(Ljava/lang/String;Lorg/perlonjava/runtime/runtimetypes/RuntimeBase;Ljava/lang/String;[Ljava/lang/String;Ljava/lang/String;I)V", + false); + } } diff --git a/src/main/java/org/perlonjava/core/Configuration.java b/src/main/java/org/perlonjava/core/Configuration.java index c1df831b5..c946e278e 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 = "16a116fd6"; + public static final String gitCommitId = "f98f6f772"; /** * 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-04-01"; + public static final String gitCommitDate = "2026-04-02"; // Prevent instantiation private Configuration() { diff --git a/src/main/java/org/perlonjava/frontend/parser/FieldParser.java b/src/main/java/org/perlonjava/frontend/parser/FieldParser.java index 441b1f830..0d92d0014 100644 --- a/src/main/java/org/perlonjava/frontend/parser/FieldParser.java +++ b/src/main/java/org/perlonjava/frontend/parser/FieldParser.java @@ -90,6 +90,11 @@ public static Node parseFieldDeclaration(Parser parser) { String fieldSymbol = "field:" + fieldName; parser.ctx.symbolTable.addVariable(fieldSymbol, "field", fieldPlaceholder); + // Also register with the sigil so the parse-time strict vars check + // can find the field variable in later field default expressions + // (e.g., field $two = $one + 1; needs to see $one) + parser.ctx.symbolTable.addVariable(sigil + fieldName, "field", fieldPlaceholder); + // Also register in global FieldRegistry for inheritance tracking String currentClass = parser.ctx.symbolTable.getCurrentPackage(); FieldRegistry.registerField(currentClass, fieldName); diff --git a/src/main/java/org/perlonjava/frontend/parser/OperatorParser.java b/src/main/java/org/perlonjava/frontend/parser/OperatorParser.java index 117662d1c..fd34a5f62 100644 --- a/src/main/java/org/perlonjava/frontend/parser/OperatorParser.java +++ b/src/main/java/org/perlonjava/frontend/parser/OperatorParser.java @@ -8,10 +8,9 @@ import org.perlonjava.frontend.lexer.LexerToken; import org.perlonjava.runtime.operators.WarnDie; import org.perlonjava.runtime.perlmodule.Strict; -import org.perlonjava.runtime.runtimetypes.GlobalVariable; -import org.perlonjava.runtime.runtimetypes.NameNormalizer; -import org.perlonjava.runtime.runtimetypes.PerlCompilerException; -import org.perlonjava.runtime.runtimetypes.RuntimeScalar; +import org.perlonjava.runtime.mro.InheritanceResolver; +import org.perlonjava.runtime.perlmodule.Universal; +import org.perlonjava.runtime.runtimetypes.*; import java.util.ArrayList; import java.util.List; @@ -316,7 +315,11 @@ static OperatorNode parseVariableDeclaration(Parser parser, String operator, int } // Create OperatorNode ($, @, %), ListNode (includes undef), SubroutineNode + // Suppress strict vars check while parsing the variable being declared + boolean savedParsingDeclaration = parser.parsingDeclaration; + parser.parsingDeclaration = true; Node operand = ParsePrimary.parsePrimary(parser); + parser.parsingDeclaration = savedParsingDeclaration; if (CompilerOptions.DEBUG_ENABLED) parser.ctx.logDebug("parseVariableDeclaration " + operator + ": " + operand + " (ref=" + isDeclaredReference + ")"); // Add variables to the scope @@ -416,21 +419,67 @@ static OperatorNode parseVariableDeclaration(Parser parser, String operator, int while (peek(parser).text.equals(":")) { consumeAttributes(parser, attributes); } + + // Detect scalar/array/hash dereferences in my/our/state declarations. + // E.g., "our ${""}", "my $$foo" — these are dereferences, not simple variables. + // Perl 5: "Can't declare scalar dereference in 'our'" etc. + if (!attributes.isEmpty() || peek(parser).text.equals("=") || peek(parser).text.equals(";")) { + checkForDereference(parser, operator, operand); + } + if (!attributes.isEmpty()) { - // Add the attributes to the operand, preserving any existing annotations - if (decl.annotations != null && decl.annotations.containsKey("isDeclaredReference")) { - // Create a new map with both the existing isDeclaredReference and new attributes - java.util.Map newAnnotations = new java.util.HashMap<>(decl.annotations); - newAnnotations.put("attributes", attributes); - decl.annotations = newAnnotations; + // Determine the package for MODIFY_*_ATTRIBUTES lookup + String attrPackage = varType != null ? varType : parser.ctx.symbolTable.getCurrentPackage(); + + // Validate and dispatch variable attributes. + // For 'our': dispatch at compile time (global vars already exist). + // For 'my'/'state': validate at compile time, dispatch at runtime + // (the actual lexical variable doesn't exist yet during parsing). + callModifyVariableAttributes(parser, attrPackage, operator, operand, attributes); + + // Add the attributes and package to the operand annotations + // so the emitter can dispatch at runtime for my/state variables. + java.util.Map newAnnotations; + if (decl.annotations != null) { + newAnnotations = new java.util.HashMap<>(decl.annotations); } else { - decl.annotations = Map.of("attributes", attributes); + newAnnotations = new java.util.HashMap<>(); } + newAnnotations.put("attributes", attributes); + newAnnotations.put("attributePackage", attrPackage); + decl.annotations = newAnnotations; } return decl; } + /** + * Check if a variable in a my/our/state declaration is actually a dereference. + * E.g., "our ${""}", "my $$foo" — Perl 5 errors with: + * "Can't declare scalar dereference in 'our'" etc. + */ + private static void checkForDereference(Parser parser, String operator, Node operand) { + if (!(operand instanceof OperatorNode opNode)) return; + String sigil = opNode.operator; + if (!"$@%".contains(sigil)) return; + + // A simple variable has IdentifierNode as operand. + // A dereference has OperatorNode, BlockNode, etc. + if (opNode.operand instanceof IdentifierNode) return; + + String typeName = switch (sigil) { + case "$" -> "scalar"; + case "@" -> "array"; + case "%" -> "hash"; + default -> "scalar"; + }; + throw new PerlCompilerException( + opNode.tokenIndex, + "Can't declare " + typeName + " dereference in \"" + operator + "\"", + parser.ctx.errorUtil + ); + } + static OperatorNode parseOperatorWithOneOptionalArgument(Parser parser, LexerToken token) { Node operand; // Handle operators with one optional argument @@ -1120,4 +1169,191 @@ static OperatorNode parseRequire(Parser parser) { } return new OperatorNode("require", operand, parser.tokenIndex); } + + /** + * Dispatch variable attributes via MODIFY_*_ATTRIBUTES at compile time. + * + *

For each variable in the declaration, checks if the package has + * MODIFY_SCALAR_ATTRIBUTES, MODIFY_ARRAY_ATTRIBUTES, or MODIFY_HASH_ATTRIBUTES + * and calls it. Follows the same pattern as SubroutineParser.callModifyCodeAttributes(). + */ + private static void callModifyVariableAttributes(Parser parser, String packageName, + String operator, Node operand, + List attributes) { + // Ensure attributes.pm is loaded so that attributes::get() is available + org.perlonjava.runtime.operators.ModuleOperators.require(new RuntimeScalar("attributes.pm")); + + // Collect the variables from the declaration + List variables = new ArrayList<>(); + if (operand instanceof ListNode listNode) { + variables.addAll(listNode.elements); + } else { + variables.add(operand); + } + + for (Node varNode : variables) { + if (!(varNode instanceof OperatorNode opNode)) continue; + + // Handle declared refs: \$x, \@x, \%x — unwrap backslash to get inner sigil + if (opNode.operator.equals("\\") && opNode.operand instanceof OperatorNode innerOp) { + opNode = innerOp; + } + + String sigil = opNode.operator; + + // For declared refs in parenthesized form (my (\@h) : attr), the parser + // transforms \@h to $h and stores the original sigil in an annotation. + if (opNode.annotations != null && opNode.annotations.containsKey("declaredReferenceOriginalSigil")) { + sigil = (String) opNode.annotations.get("declaredReferenceOriginalSigil"); + } + + String svtype; + switch (sigil) { + case "$": svtype = "SCALAR"; break; + case "@": svtype = "ARRAY"; break; + case "%": svtype = "HASH"; break; + default: continue; + } + + // Filter out built-in attributes + List nonBuiltinAttrs = new ArrayList<>(); + for (String attr : attributes) { + if ("shared".equals(attr)) { + // 'shared' is a no-op (no threads in PerlOnJava) + continue; + } + nonBuiltinAttrs.add(attr); + } + + if (nonBuiltinAttrs.isEmpty()) { + return; + } + + // Check if the package has MODIFY_*_ATTRIBUTES + String modifyMethod = "MODIFY_" + svtype + "_ATTRIBUTES"; + RuntimeArray canArgs = new RuntimeArray(); + RuntimeArray.push(canArgs, new RuntimeScalar(packageName)); + RuntimeArray.push(canArgs, new RuntimeScalar(modifyMethod)); + + InheritanceResolver.autoloadEnabled = false; + RuntimeList codeList; + try { + codeList = Universal.can(canArgs, RuntimeContextType.SCALAR); + } finally { + InheritanceResolver.autoloadEnabled = true; + } + + boolean hasHandler = codeList.size() == 1 && codeList.getFirst().getBoolean(); + + if (hasHandler) { + if (operator.equals("our")) { + // For 'our' variables: dispatch at compile time (global vars already exist) + // Get the variable name for creating a reference + String varName; + if (opNode.operand instanceof IdentifierNode identNode) { + varName = identNode.name; + } else { + continue; + } + + // Resolve full variable name + String fullVarName = NameNormalizer.normalizeVariableName(varName, parser.ctx.symbolTable.getCurrentPackage()); + + // Get a reference to the global variable + RuntimeScalar varRef; + switch (sigil) { + case "$": + varRef = GlobalVariable.getGlobalVariable(fullVarName).createReference(); + break; + case "@": + varRef = GlobalVariable.getGlobalArray(fullVarName).createReference(); + break; + case "%": + varRef = GlobalVariable.getGlobalHash(fullVarName).createReference(); + break; + default: + continue; + } + + RuntimeScalar method = codeList.getFirst(); + // Build args: ($package, \$var, @attributes) + RuntimeArray callArgs = new RuntimeArray(); + RuntimeArray.push(callArgs, new RuntimeScalar(packageName)); + RuntimeArray.push(callArgs, varRef); + for (String attr : nonBuiltinAttrs) { + RuntimeArray.push(callArgs, new RuntimeScalar(attr)); + } + + // Push caller frames so that Attribute::Handlers can find the source file/line + String fileName = parser.ctx.compilerOptions.fileName; + int lineNum = parser.ctx.errorUtil != null + ? parser.ctx.errorUtil.getLineNumber(parser.tokenIndex) : 0; + CallerStack.push(packageName, fileName, lineNum); + CallerStack.push(packageName, fileName, lineNum); + try { + RuntimeList result = RuntimeCode.apply(method, callArgs, RuntimeContextType.LIST); + + // If MODIFY_*_ATTRIBUTES returns any values, they are unrecognized attributes + RuntimeArray resultArray = result.getArrayOfAlias(); + if (resultArray.size() > 0) { + SubroutineParser.throwInvalidAttributeError(svtype, resultArray, parser); + } + } finally { + CallerStack.pop(); + CallerStack.pop(); + } + } + // For 'my'/'state': handler will be dispatched at runtime by the emitter, + // after the actual lexical variable is allocated. + + // Emit "may clash with future reserved word" warning at compile time + emitReservedWordWarning(svtype, nonBuiltinAttrs, parser); + } else { + // No MODIFY_*_ATTRIBUTES handler found at compile time. + // Don't throw — the handler may be set dynamically (e.g., via glob + // in enclosing eval). The \K regex bug (pre-existing) also corrupts + // handler names in decl-refs.t tests, making handlers invisible. + // Runtime dispatch in Attributes.java will silently return if no + // handler exists. See dev/design/attributes.md "Known Issue: \K". + } + } + } + + /** + * Emit "SCALAR/ARRAY/HASH package attribute(s) may clash with future reserved word(s)" + * warning for non-built-in attributes accepted by MODIFY_*_ATTRIBUTES. + * Respects 'no warnings "reserved"'. + */ + private static void emitReservedWordWarning(String svtype, List attrs, Parser parser) { + if (attrs.isEmpty()) return; + + // Check compile-time warning scope directly (consistent with experimental:: checks) + // Use "syntax::reserved" since "reserved" is an alias — use warnings enables + // "syntax::reserved" via the all→syntax→syntax::reserved hierarchy + if (!parser.ctx.symbolTable.isWarningCategoryEnabled("syntax::reserved")) return; + + // Only warn for all-lowercase attribute names (matching Perl 5's + // grep { m/\A[[:lower:]]+(?:\z|\()/ } filter in attributes.pm) + List lowercaseAttrs = new ArrayList<>(); + for (String attr : attrs) { + String baseName = attr.contains("(") ? attr.substring(0, attr.indexOf('(')) : attr; + if (!baseName.isEmpty() && baseName.equals(baseName.toLowerCase())) { + lowercaseAttrs.add(baseName); + } + } + if (lowercaseAttrs.isEmpty()) return; + + StringBuilder sb = new StringBuilder(); + for (int i = 0; i < lowercaseAttrs.size(); i++) { + if (i > 0) sb.append(" : "); + sb.append(lowercaseAttrs.get(i)); + } + + String loc = parser.ctx.errorUtil.warningLocation(parser.tokenIndex); + String word = lowercaseAttrs.size() > 1 ? "words" : "word"; + String attrWord = lowercaseAttrs.size() > 1 ? "attributes" : "attribute"; + String msg = svtype + " package " + attrWord + " may clash with future reserved " + word + ": " + + sb + loc + ".\n"; + WarnDie.warn(new RuntimeScalar(msg), new RuntimeScalar()); + } } \ No newline at end of file diff --git a/src/main/java/org/perlonjava/frontend/parser/Parser.java b/src/main/java/org/perlonjava/frontend/parser/Parser.java index a611ae8b5..a607f6fbc 100644 --- a/src/main/java/org/perlonjava/frontend/parser/Parser.java +++ b/src/main/java/org/perlonjava/frontend/parser/Parser.java @@ -38,6 +38,9 @@ public class Parser { // Flags to indicate special parsing states. public boolean parsingForLoopVariable = false; public boolean parsingTakeReference = false; + // Are we currently parsing a my/our/state declaration's variable list? + // Used to suppress strict vars checking for the variable being declared. + public boolean parsingDeclaration = false; // Are we parsing the top level script? public boolean isTopLevelScript = false; // Are we parsing inside a class block? diff --git a/src/main/java/org/perlonjava/frontend/parser/SignatureParser.java b/src/main/java/org/perlonjava/frontend/parser/SignatureParser.java index b683acc5f..ae2e2db3a 100644 --- a/src/main/java/org/perlonjava/frontend/parser/SignatureParser.java +++ b/src/main/java/org/perlonjava/frontend/parser/SignatureParser.java @@ -164,6 +164,14 @@ private void parseParameter() { paramName = consumeToken().text; } + // Register the parameter variable in the symbol table immediately so that + // (1) default value expressions for later parameters can reference it, and + // (2) the parse-time strict vars check can find it in the sub body. + // The scope was entered by SubroutineParser before calling parseSignature(). + if (paramName != null) { + parser.ctx.symbolTable.addVariable(sigil + paramName, "my", null); + } + if (paramName != null && paramName.equals("_")) { parser.throwError(paramStartIndex, "Can't use global " + sigil + "_ in subroutine signature"); } diff --git a/src/main/java/org/perlonjava/frontend/parser/SpecialBlockParser.java b/src/main/java/org/perlonjava/frontend/parser/SpecialBlockParser.java index 7182b3101..f1207768a 100644 --- a/src/main/java/org/perlonjava/frontend/parser/SpecialBlockParser.java +++ b/src/main/java/org/perlonjava/frontend/parser/SpecialBlockParser.java @@ -53,14 +53,22 @@ static Node parseSpecialBlock(Parser parser) { // ADJUST blocks have implicit $self, so set isInMethod flag boolean wasInMethod = parser.isInMethod; + int adjustScopeIndex = -1; if ("ADJUST".equals(blockName) && parser.isInClassBlock) { parser.isInMethod = true; + // Register $self in a scope so the parse-time strict vars check + // can find it inside ADJUST block bodies. + adjustScopeIndex = parser.ctx.symbolTable.enterScope(); + parser.ctx.symbolTable.addVariable("$self", "my", null); } // Parse the block content BlockNode block = ParseBlock.parseBlock(parser); - // Restore the isInMethod flag + // Restore the isInMethod flag and exit ADJUST scope + if (adjustScopeIndex >= 0) { + parser.ctx.symbolTable.exitScope(adjustScopeIndex); + } parser.isInMethod = wasInMethod; // Consume the closing brace '}' diff --git a/src/main/java/org/perlonjava/frontend/parser/StatementParser.java b/src/main/java/org/perlonjava/frontend/parser/StatementParser.java index e7c8ad486..f7976d63f 100644 --- a/src/main/java/org/perlonjava/frontend/parser/StatementParser.java +++ b/src/main/java/org/perlonjava/frontend/parser/StatementParser.java @@ -344,28 +344,50 @@ public static Node parseTryStatement(Parser parser) { // Parse the catch block TokenUtils.consume(parser, LexerTokenType.IDENTIFIER); // "catch" TokenUtils.consume(parser, LexerTokenType.OPERATOR, "("); + // Suppress strict vars check for the catch variable — catch ($e) implicitly + // declares $e as a lexical variable, similar to my $e. + boolean savedParsingDeclaration = parser.parsingDeclaration; + parser.parsingDeclaration = true; Node catchParameter = parser.parseExpression(0); // Parse the exception variable + parser.parsingDeclaration = savedParsingDeclaration; TokenUtils.consume(parser, LexerTokenType.OPERATOR, ")"); - TokenUtils.consume(parser, LexerTokenType.OPERATOR, "{"); - Node catchBlock = ParseBlock.parseBlock(parser); - TokenUtils.consume(parser, LexerTokenType.OPERATOR, "}"); - // Parse the optional finally block - Node finallyBlock = null; - if (TokenUtils.peek(parser).text.equals("finally")) { - TokenUtils.consume(parser, LexerTokenType.IDENTIFIER); // "finally" + // Register the catch variable in a scope so the parse-time strict vars + // check can find it inside the catch block body. + int catchScopeIndex = -1; + if (catchParameter instanceof OperatorNode catchOp + && "$@%".contains(catchOp.operator) + && catchOp.operand instanceof IdentifierNode catchId) { + catchScopeIndex = parser.ctx.symbolTable.enterScope(); + parser.ctx.symbolTable.addVariable(catchOp.operator + catchId.name, "my", null); + } + + try { TokenUtils.consume(parser, LexerTokenType.OPERATOR, "{"); - finallyBlock = ParseBlock.parseBlock(parser); + Node catchBlock = ParseBlock.parseBlock(parser); TokenUtils.consume(parser, LexerTokenType.OPERATOR, "}"); - } - return new BinaryOperatorNode("->", - new SubroutineNode(null, null, null, - new BlockNode(List.of( + // Parse the optional finally block + Node finallyBlock = null; + if (TokenUtils.peek(parser).text.equals("finally")) { + TokenUtils.consume(parser, LexerTokenType.IDENTIFIER); // "finally" + TokenUtils.consume(parser, LexerTokenType.OPERATOR, "{"); + finallyBlock = ParseBlock.parseBlock(parser); + TokenUtils.consume(parser, LexerTokenType.OPERATOR, "}"); + } + + return new BinaryOperatorNode("->", + new SubroutineNode(null, null, null, + new BlockNode(List.of( new TryNode(tryBlock, catchParameter, catchBlock, finallyBlock, index)), index), false, index), atUnderscoreArgs(parser), index); + } finally { + if (catchScopeIndex >= 0) { + parser.ctx.symbolTable.exitScope(catchScopeIndex); + } + } } /** diff --git a/src/main/java/org/perlonjava/frontend/parser/StatementResolver.java b/src/main/java/org/perlonjava/frontend/parser/StatementResolver.java index b11fb7bde..39a8aabd3 100644 --- a/src/main/java/org/perlonjava/frontend/parser/StatementResolver.java +++ b/src/main/java/org/perlonjava/frontend/parser/StatementResolver.java @@ -151,6 +151,13 @@ public static Node parseStatement(Parser parser, String label) { // Parse signature if present (optional) String prototype = null; ListNode signatureAST = null; + + // Enter a scope for the implicit $self and any signature parameters. + // This scope is exited after the method body is parsed so that + // the parse-time strict vars check can find $self and parameters. + int methodScopeIndex = parser.ctx.symbolTable.enterScope(); + parser.ctx.symbolTable.addVariable("$self", "my", null); + if (peek(parser).text.equals("(")) { // Parse the signature properly to generate parameter declarations // Pass true for isMethod flag to account for implicit $self in error messages @@ -158,6 +165,7 @@ public static Node parseStatement(Parser parser, String label) { // Note: SignatureParser consumes the closing ) } + try { // Check for forward declaration (method name;) or full definition (method name {...}) if (peek(parser).text.equals(";")) { // Forward declaration - just consume the semicolon @@ -210,6 +218,9 @@ public static Node parseStatement(Parser parser, String label) { } yield method; } + } finally { + parser.ctx.symbolTable.exitScope(methodScopeIndex); + } } yield null; } @@ -297,7 +308,8 @@ public static Node parseStatement(Parser parser, String label) { // Parse attributes first (e.g., :prototype()) while (peek(parser).text.equals(":")) { - String attrProto = SubroutineParser.consumeAttributes(parser, attributes); + String attrProto = SubroutineParser.consumeAttributes(parser, attributes, + null, subName, null); if (attrProto != null) { prototype = attrProto; } @@ -324,6 +336,22 @@ public static Node parseStatement(Parser parser, String label) { // Signatures not enabled - always parse as prototype prototype = ((StringNode) StringParser.parseRawString(parser, "q")).value; } + + // Emit illegal proto warning for (proto) syntax (like normal subs do) + if (prototype != null) { + SubroutineParser.emitIllegalProtoWarning(parser, prototype, subName); + } + + // Parse attributes after prototype (e.g., my sub foo(bar) : prototype(baz) {}) + String prevAttrProto = null; + while (peek(parser).text.equals(":")) { + String attrProto = SubroutineParser.consumeAttributes(parser, attributes, + prototype, subName, prevAttrProto); + if (attrProto != null) { + prevAttrProto = prototype; + prototype = attrProto; + } + } } // Now check if there's a body @@ -337,13 +365,22 @@ public static Node parseStatement(Parser parser, String label) { // Parse the rest as an anonymous sub Node anonSub = SubroutineParser.parseSubroutineDefinition(parser, false, null); - // Store prototype in the sub if present - if (prototype != null && anonSub instanceof SubroutineNode subNode) { - varDecl.setAnnotation("prototype", prototype); + // Apply pre-parsed prototype and attributes to the SubroutineNode. + // parseSubroutineDefinition returns a SubroutineNode with prototype=null + // since we already consumed the prototype/attribute tokens. + if ((prototype != null || !attributes.isEmpty()) && anonSub instanceof SubroutineNode subNode) { + String finalProto = prototype != null ? prototype : subNode.prototype; + List finalAttrs = !attributes.isEmpty() ? attributes : subNode.attributes; + anonSub = new SubroutineNode(subNode.name, finalProto, finalAttrs, + subNode.block, subNode.useTryCatch, subNode.tokenIndex); } // NOW add &subName to symbol table AFTER parsing the body // This makes the sub "invisible inside itself" during compilation + // Store prototype in varDecl annotation for call-site parsing + if (prototype != null) { + varDecl.setAnnotation("prototype", prototype); + } if (hadForwardDecl) { parser.ctx.symbolTable.replaceVariable("&" + subName, declaration, varDecl); } else { @@ -448,6 +485,14 @@ public static Node parseStatement(Parser parser, String label) { // Generate unique hidden variable name String hiddenVarName = methodName + "__lexmethod_" + parser.tokenIndex; + // Enter scope for $self and signature parameters early, + // so they are visible during parse-time strict vars check. + int scopeIndex = parser.ctx.symbolTable.enterScope(); + OperatorNode tempSelf = new OperatorNode("my", + new OperatorNode("$", new IdentifierNode("self", parser.tokenIndex), parser.tokenIndex), + parser.tokenIndex); + parser.ctx.symbolTable.addVariable("$self", "my", tempSelf); + // Parse signature if present ListNode signatureAST = null; if (peek(parser).text.equals("(")) { @@ -455,6 +500,7 @@ public static Node parseStatement(Parser parser, String label) { signatureAST = SignatureParser.parseSignature(parser, methodName, true); } + try { // Parse the method body BlockNode block = null; if (peek(parser).text.equals("{")) { @@ -462,17 +508,6 @@ public static Node parseStatement(Parser parser, String label) { boolean wasInMethod = parser.isInMethod; parser.isInMethod = true; // Set method context for lexical method - // Enter scope for the lexical method's body - int scopeIndex = parser.ctx.symbolTable.enterScope(); - - // Add temp $self to THIS scope (the method's inner scope) - // so field access works during parsing - // This will be matched by the actual `my $self = shift;` injected during transformation - OperatorNode tempSelf = new OperatorNode("my", - new OperatorNode("$", new IdentifierNode("self", parser.tokenIndex), parser.tokenIndex), - parser.tokenIndex); - parser.ctx.symbolTable.addVariable("$self", "my", tempSelf); - // Parse the block contents (without creating another scope) List elements = new ArrayList<>(); while (!peek(parser).text.equals("}")) { @@ -483,9 +518,6 @@ public static Node parseStatement(Parser parser, String label) { } block = new BlockNode(elements, parser.tokenIndex); - // Exit the method's scope (this removes temp $self) - parser.ctx.symbolTable.exitScope(scopeIndex); - parser.isInMethod = wasInMethod; // Restore previous context consume(parser, LexerTokenType.OPERATOR, "}"); } else if (peek(parser).text.equals(";")) { @@ -524,6 +556,9 @@ public static Node parseStatement(Parser parser, String label) { parser.ctx.symbolTable.addVariable("&" + methodName, declaration, varDecl); yield assignment; + } finally { + parser.ctx.symbolTable.exitScope(scopeIndex); + } } else { throw new RuntimeException("Method name expected after 'my method'"); } diff --git a/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java b/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java index b8c23640a..4e9a800cc 100644 --- a/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java +++ b/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java @@ -536,17 +536,45 @@ public static Node parseSubroutineDefinition(Parser parser, boolean wantName, St } } + // Build display name for attribute warnings + String attrSubDisplayName; + if (subName != null) { + attrSubDisplayName = NameNormalizer.normalizeVariableName(subName, parser.ctx.symbolTable.getCurrentPackage()); + } else { + attrSubDisplayName = parser.ctx.symbolTable.getCurrentPackage() + "::__ANON__"; + } + // While there are attributes (denoted by a colon ':'), we keep parsing them. + // Track prevAttrPrototype to detect ":prototype(X) : prototype(Y)" across colon-separated calls + String prevAttrProto = null; while (peek(parser).text.equals(":")) { - prototype = consumeAttributes(parser, attributes); + String attrPrototype = consumeAttributes(parser, attributes, null, attrSubDisplayName, prevAttrProto); + if (attrPrototype != null) { + prevAttrProto = attrPrototype; // remember for "discards earlier" warning in next call + prototype = attrPrototype; + } + } + + // Ensure attributes.pm is loaded when attribute syntax is used, so that + // attributes::get() is available (Perl 5 implicitly loads attributes.pm) + if (!attributes.isEmpty()) { + org.perlonjava.runtime.operators.ModuleOperators.require(new RuntimeScalar("attributes.pm")); } ListNode signature = null; + // Scope index for signature parameter variables (for strict vars checking). + // Entered before parseSignature() so that default value expressions can + // reference earlier parameters, and exited after the block body is parsed. + int signatureScopeIndex = -1; // Check if the next token is an opening parenthesis '(' indicating a prototype. if (peek(parser).text.equals("(")) { if (parser.ctx.symbolTable.isFeatureCategoryEnabled("signatures")) { if (CompilerOptions.DEBUG_ENABLED) parser.ctx.logDebug("Signatures feature enabled"); + // Enter a scope for signature parameter variables so the parse-time + // strict vars check can find them. SignatureParser.parseParameter() + // registers each parameter directly in this scope. + signatureScopeIndex = parser.ctx.symbolTable.enterScope(); // If the signatures feature is enabled, we parse a signature. signature = parseSignature(parser, subName); if (CompilerOptions.DEBUG_ENABLED) parser.ctx.logDebug("Signature AST: " + signature); @@ -567,9 +595,33 @@ public static Node parseSubroutineDefinition(Parser parser, boolean wantName, St } } + // Emit "Illegal character in prototype" warning for (proto) syntax + // For (proto) syntax, Perl uses "?" as the name for anonymous subs + { + String protoDisplayName; + if (subName != null) { + protoDisplayName = NameNormalizer.normalizeVariableName(subName, parser.ctx.symbolTable.getCurrentPackage()); + } else { + protoDisplayName = "?"; + } + emitIllegalProtoWarning(parser, prototype, protoDisplayName); + } + + // Build display name for :prototype() warnings + // For :prototype(), Perl uses the full qualified name or __ANON__ + String subDisplayName; + if (subName != null) { + subDisplayName = NameNormalizer.normalizeVariableName(subName, parser.ctx.symbolTable.getCurrentPackage()); + } else { + subDisplayName = parser.ctx.symbolTable.getCurrentPackage() + "::__ANON__"; + } + // While there are attributes after the prototype (denoted by a colon ':'), we keep parsing them. while (peek(parser).text.equals(":")) { - consumeAttributes(parser, attributes); + String attrPrototype = consumeAttributes(parser, attributes, prototype, subDisplayName); + if (attrPrototype != null) { + prototype = attrPrototype; + } } } } @@ -577,9 +629,68 @@ public static Node parseSubroutineDefinition(Parser parser, boolean wantName, St if (wantName && subName != null && !peek(parser).text.equals("{")) { // A named subroutine can be predeclared without a block of code. String fullName = NameNormalizer.normalizeVariableName(subName, parser.ctx.symbolTable.getCurrentPackage()); - RuntimeCode codeRef = (RuntimeCode) GlobalVariable.getGlobalCodeRef(fullName).value; - codeRef.prototype = prototype; - codeRef.attributes = attributes; + RuntimeScalar codeRefScalar = GlobalVariable.getGlobalCodeRef(fullName); + RuntimeCode codeRef = (RuntimeCode) codeRefScalar.value; + // Mark as explicitly declared so *{glob}{CODE} returns this code ref + codeRef.isDeclared = true; + + // Only set prototype/attributes on a forward declaration if the sub + // doesn't already have a body. Perl 5 ignores prototype changes from + // forward redeclarations of already-defined subs. + boolean hasBody = codeRef.subroutine != null || codeRef.methodHandle != null + || codeRef.compilerSupplier != null; + if (!hasBody) { + codeRef.prototype = prototype; + codeRef.attributes = attributes; + } else { + // When redeclaring an existing sub with attributes (e.g., sub X : method), + // merge the new attributes into the existing ones. This matches Perl's behavior + // where `sub X { ... } sub X : method` adds the method attribute to X. + if (attributes != null && !attributes.isEmpty()) { + if (codeRef.attributes == null) { + codeRef.attributes = new java.util.ArrayList<>(attributes); + } else { + for (String attr : attributes) { + if (!codeRef.attributes.contains(attr)) { + codeRef.attributes.add(attr); + } + } + } + } + + // Emit "Prototype mismatch" warning when redeclaring with different prototype + String oldProto = codeRef.prototype; + if (prototype != null || oldProto != null) { + String oldDisplay = oldProto == null ? ": none" : " (" + oldProto + ")"; + String newDisplay = prototype == null ? "none" : "(" + prototype + ")"; + String oldForCompare = oldProto == null ? "none" : "(" + oldProto + ")"; + if (!oldForCompare.equals(newDisplay)) { + String location = ""; + if (parser.ctx.errorUtil != null) { + int line = parser.ctx.errorUtil.getLineNumber(parser.tokenIndex); + location = " at " + parser.ctx.compilerOptions.fileName + " line " + line + ".\n"; + } + String msg = "Prototype mismatch: sub " + fullName + oldDisplay + " vs " + newDisplay + location; + org.perlonjava.runtime.operators.WarnDie.warn( + new RuntimeScalar(msg), new RuntimeScalar("")); + } + } + } + + // Validate attributes on forward declarations too + if (attributes != null && !attributes.isEmpty()) { + String packageToUse = parser.ctx.symbolTable.getCurrentPackage(); + // For cross-package declarations like "sub Y::bar : foo", use the + // original CV's package (where the code was first compiled), not + // the syntactic target package. This matches Perl 5 behavior. + if (codeRef.packageName != null) { + packageToUse = codeRef.packageName; + } else if (subName.contains("::")) { + packageToUse = subName.substring(0, subName.lastIndexOf("::")); + } + callModifyCodeAttributes(packageToUse, codeRefScalar, attributes, parser, currentIndex); + } + ListNode result = new ListNode(parser.tokenIndex); result.setAnnotation("compileTimeOnly", true); return result; @@ -624,6 +735,10 @@ public static Node parseSubroutineDefinition(Parser parser, boolean wantName, St return handleNamedSub(parser, subName, prototype, attributes, block, declaration); } } finally { + // Exit the signature scope if we entered one + if (signatureScopeIndex >= 0) { + parser.ctx.symbolTable.exitScope(signatureScopeIndex); + } // Restore the previous subroutine context parser.ctx.symbolTable.setCurrentSubroutine(previousSubroutine); parser.ctx.symbolTable.setInSubroutineBody(previousInSubroutineBody); @@ -631,6 +746,34 @@ public static Node parseSubroutineDefinition(Parser parser, boolean wantName, St } static String consumeAttributes(Parser parser, List attributes) { + return consumeAttributes(parser, attributes, null, null, null); + } + + /** + * Parse attributes after a colon. Returns a prototype string if :prototype(...) is found. + * + * @param parser The parser + * @param attributes List to accumulate parsed attribute strings + * @param priorPrototype The prototype set by (proto) syntax, for "overridden" warning (may be null) + * @param subDisplayName The sub name for warning messages (may be null for anon subs) + * @return The prototype string from :prototype(...), or null if not found + */ + static String consumeAttributes(Parser parser, List attributes, String priorPrototype, String subDisplayName) { + return consumeAttributes(parser, attributes, priorPrototype, subDisplayName, null); + } + + /** + * Parse attributes after a colon. Returns a prototype string if :prototype(...) is found. + * + * @param parser The parser + * @param attributes List to accumulate parsed attribute strings + * @param parenPrototype The prototype from (proto) syntax, for "overridden" warning (may be null) + * @param subDisplayName The sub name for warning messages (may be null for anon subs) + * @param prevAttrPrototype Prototype from a previous :prototype(...) call, for "discards" warning (may be null) + * @return The prototype string from :prototype(...), or null if not found + */ + static String consumeAttributes(Parser parser, List attributes, String parenPrototype, + String subDisplayName, String prevAttrPrototype) { // Consume the colon TokenUtils.consume(parser, LexerTokenType.OPERATOR, ":"); @@ -643,20 +786,81 @@ static String consumeAttributes(Parser parser, List attributes) { String prototype = null; - String attrString = TokenUtils.consume(parser, LexerTokenType.IDENTIFIER).text; - if (parser.tokens.get(parser.tokenIndex).text.equals("(")) { - String argString = ((StringNode) StringParser.parseRawString(parser, "q")).value; + // Loop to handle space-separated attributes after a single colon + // e.g., `: locked method` parses both `locked` and `method` + while (peek(parser).type == LexerTokenType.IDENTIFIER) { + String attrString = TokenUtils.consume(parser, LexerTokenType.IDENTIFIER).text; + if (parser.tokens.get(parser.tokenIndex).text.equals("(")) { + String argString; + try { + // Parse the parenthesized parameter using raw string parsing. + // Unlike q(), Perl's attribute parameter parsing preserves backslashes: + // :Foo(\() gives parameter \( not ( — backslash is kept literally. + StringParser.ParsedString rawStr = StringParser.parseRawStrings( + parser, parser.ctx, parser.tokens, parser.tokenIndex, 1); + parser.tokenIndex = rawStr.next; + argString = rawStr.buffers.getFirst(); + } catch (PerlCompilerException e) { + // Rethrow with Perl-compatible message for unterminated parens + if (e.getMessage() != null && e.getMessage().contains("Can't find string terminator")) { + String loc = parser.ctx.errorUtil.warningLocation(parser.tokenIndex); + throw new PerlCompilerException( + "Unterminated attribute parameter in attribute list" + loc + ".\n"); + } + throw e; + } + + if (attrString.equals("prototype")) { + // :prototype($) + // Validate prototype characters first (Perl emits this before "overridden") + emitIllegalProtoWarning(parser, argString, subDisplayName); + // Emit "Prototype overridden" warning if prior prototype was set from (proto) syntax + if (parenPrototype != null && subDisplayName != null) { + String msg = "Prototype '" + parenPrototype + "' overridden by attribute 'prototype(" + + argString + ")' in " + subDisplayName; + String loc = parser.ctx.errorUtil.warningLocation(parser.tokenIndex); + org.perlonjava.runtime.operators.WarnDie.warn( + new RuntimeScalar(msg), new RuntimeScalar(loc)); + } + // Emit "discards earlier prototype" warning if :prototype was already set + // (either in this same call or from a previous :prototype() call) + String existingAttrProto = prototype != null ? prototype : prevAttrPrototype; + if (existingAttrProto != null && subDisplayName != null) { + String msg = "Attribute prototype(" + argString + + ") discards earlier prototype attribute in same sub"; + String loc = parser.ctx.errorUtil.warningLocation(parser.tokenIndex); + org.perlonjava.runtime.operators.WarnDie.warn( + new RuntimeScalar(msg), new RuntimeScalar(loc)); + } + prototype = argString; + } - if (attrString.equals("prototype")) { - // :prototype($) - prototype = argString; + attrString += "(" + argString + ")"; } - attrString += "(" + argString + ")"; + // Consume the attribute name (an identifier) and add it to the attributes list. + attributes.add(attrString); + } + + // Check for invalid separator characters after attributes + // Valid separators are: colon (:), semicolon (;), opening/closing brace ({, }), assignment (=), EOF + if (!attributes.isEmpty()) { + LexerToken nextToken = peek(parser); + if (nextToken.type == LexerTokenType.OPERATOR) { + String t = nextToken.text; + if (!t.equals(":") && !t.equals(";") && !t.equals("{") && !t.equals("}") && !t.equals("=") + && !t.equals("(") && !t.equals(",") && !t.equals(")") + && !t.equals("$") && !t.equals("@") && !t.equals("%")) { + // Check for :: (double colon is invalid separator in attr list) + if (t.equals("::") || (t.length() == 1 && !Character.isWhitespace(t.charAt(0)))) { + throw new PerlCompilerException(parser.tokenIndex, + "Invalid separator character '" + t.charAt(0) + "' in attribute list", + parser.ctx.errorUtil); + } + } + } } - // Consume the attribute name (an identifier) and add it to the attributes list. - attributes.add(attrString); return prototype; } @@ -803,6 +1007,11 @@ public static ListNode handleNamedSubWithFilter(Parser parser, String subName, S codeRef.type = RuntimeScalarType.CODE; codeRef.value = new RuntimeCode(subName, attributes); } + // Mark as explicitly declared so *{glob}{CODE} returns this code ref. + // In Perl 5, declared subs (even forward declarations) are visible via *{glob}{CODE}. + if (codeRef.value instanceof RuntimeCode declaredCode) { + declaredCode.isDeclared = true; + } // Register subroutine location for %DB::sub (only in debug mode) if (DebugState.debugMode && parser.ctx.errorUtil != null && block != null) { @@ -815,16 +1024,36 @@ public static ListNode handleNamedSubWithFilter(Parser parser, String subName, S // Initialize placeholder metadata (accessed via codeRef.value) RuntimeCode placeholder = (RuntimeCode) codeRef.value; placeholder.prototype = prototype; - placeholder.attributes = attributes; + // Preserve existing attributes from forward declarations when the new definition + // doesn't specify attributes. In Perl, `sub PS : lvalue; sub PS { }` preserves + // the lvalue attribute. Only overwrite if the new definition specifies attributes. + if (attributes != null && !attributes.isEmpty()) { + placeholder.attributes = attributes; + } else if (placeholder.attributes == null) { + placeholder.attributes = attributes; + } + // else: preserve existing attributes (e.g., from forward declaration) placeholder.subName = subName; - placeholder.packageName = parser.ctx.symbolTable.getCurrentPackage(); // Call MODIFY_CODE_ATTRIBUTES if attributes are present - // In Perl, this is called at compile time after the sub is defined + // In Perl, this is called at compile time after the sub is defined. + // The dispatch package is the CvSTASH of the existing code ref (if any), + // not the current package. E.g., *Y::bar = \&X::foo; sub Y::bar : attr + // dispatches X::MODIFY_CODE_ATTRIBUTES because the code ref's stash is X. if (attributes != null && !attributes.isEmpty()) { - callModifyCodeAttributes(packageToUse, codeRef, attributes, parser); + String attrPackage = (placeholder.packageName != null && !placeholder.packageName.isEmpty()) + ? placeholder.packageName + : packageToUse; + callModifyCodeAttributes(attrPackage, codeRef, attributes, parser, block.tokenIndex); } + // Set packageName from the sub's fully-qualified name (CvSTASH equivalent). + // For `sub X::foo { }` in package main, packageName should be "X", not "main". + int lastSep = fullName.lastIndexOf("::"); + placeholder.packageName = lastSep >= 0 + ? fullName.substring(0, lastSep) + : parser.ctx.symbolTable.getCurrentPackage(); + // Optimization - https://github.com/fglock/PerlOnJava/issues/8 // Prepare capture variables Map outerVars = parser.ctx.symbolTable.getAllVisibleVariables(); @@ -1042,9 +1271,34 @@ public static ListNode handleNamedSubWithFilter(Parser parser, String subName, S * the package's MODIFY_CODE_ATTRIBUTES method is called at compile time with * ($package, \&code, @attributes). If it returns any values, those are * unrecognized attributes and an error is thrown. + * + * If no MODIFY_CODE_ATTRIBUTES handler exists, non-built-in attributes + * are rejected with an error. */ private static void callModifyCodeAttributes(String packageName, RuntimeScalar codeRef, - List attributes, Parser parser) { + List attributes, Parser parser, + int declTokenIndex) { + // Built-in CODE attributes that are always recognized + java.util.Set builtinAttrs = java.util.Set.of("lvalue", "method", "const"); + + // Filter out built-in and prototype(...) attributes — these are always valid + List nonBuiltinAttrs = new java.util.ArrayList<>(); + for (String attr : attributes) { + String name = attr; + if (name.startsWith("-")) name = name.substring(1); + // Strip (args) for matching + int parenIdx = name.indexOf('('); + String baseName = parenIdx >= 0 ? name.substring(0, parenIdx) : name; + if (!builtinAttrs.contains(baseName) && !baseName.equals("prototype")) { + nonBuiltinAttrs.add(attr); + } + } + + // If all attributes are built-in, nothing more to check + if (nonBuiltinAttrs.isEmpty()) { + return; + } + // Check if the package has MODIFY_CODE_ATTRIBUTES RuntimeArray canArgs = new RuntimeArray(); RuntimeArray.push(canArgs, new RuntimeScalar(packageName)); @@ -1058,33 +1312,73 @@ private static void callModifyCodeAttributes(String packageName, RuntimeScalar c InheritanceResolver.autoloadEnabled = true; } - if (codeList.size() == 1) { + boolean hasHandler = codeList.size() == 1 && codeList.getFirst().getBoolean(); + + if (hasHandler) { RuntimeScalar method = codeList.getFirst(); - if (method.getBoolean()) { - // Build args: ($package, \&code, @attributes) - RuntimeArray callArgs = new RuntimeArray(); - RuntimeArray.push(callArgs, new RuntimeScalar(packageName)); - RuntimeArray.push(callArgs, codeRef); - for (String attr : attributes) { - RuntimeArray.push(callArgs, new RuntimeScalar(attr)); - } + // Build args: ($package, \&code, @attributes) + RuntimeArray callArgs = new RuntimeArray(); + RuntimeArray.push(callArgs, new RuntimeScalar(packageName)); + RuntimeArray.push(callArgs, codeRef); + for (String attr : nonBuiltinAttrs) { + RuntimeArray.push(callArgs, new RuntimeScalar(attr)); + } + // Push caller frames so that Attribute::Handlers can find the source file/line + // via `caller 2`. Frame 0 = the MODIFY handler, frame 1 = attributes dispatch, + // frame 2 = the original source location where the attribute was declared. + String fileName = parser.ctx.compilerOptions.fileName; + int lineNum = parser.ctx.errorUtil != null + ? parser.ctx.errorUtil.getLineNumber(declTokenIndex) : 0; + CallerStack.push(packageName, fileName, lineNum); + CallerStack.push(packageName, fileName, lineNum); + try { RuntimeList result = RuntimeCode.apply(method, callArgs, RuntimeContextType.LIST); // If MODIFY_CODE_ATTRIBUTES returns any values, they are unrecognized attributes RuntimeArray resultArray = result.getArrayOfAlias(); if (resultArray.size() > 0) { - StringBuilder sb = new StringBuilder(); - for (int i = 0; i < resultArray.size(); i++) { - if (i > 0) sb.append(", "); - sb.append("\"").append(resultArray.get(i).toString()).append("\""); - } - throw new PerlCompilerException(parser.tokenIndex, - "Invalid CODE attribute" + (resultArray.size() > 1 ? "s" : "") + ": " + sb, - parser.ctx.errorUtil); + throwInvalidAttributeError("CODE", resultArray, parser); } + } finally { + CallerStack.pop(); + CallerStack.pop(); } + } else { + // No MODIFY_CODE_ATTRIBUTES handler — all non-built-in attributes are invalid + throwInvalidAttributeError("CODE", nonBuiltinAttrs, parser); + } + } + + static void throwInvalidAttributeError(String type, RuntimeArray attrs, Parser parser) { + StringBuilder sb = new StringBuilder(); + for (int i = 0; i < attrs.size(); i++) { + if (i > 0) sb.append(" : "); + sb.append(attrs.get(i).toString()); + } + String attrMsg = "Invalid " + type + " attribute" + (attrs.size() > 1 ? "s" : "") + ": " + sb; + if (!type.equals("CODE")) { + // Variable attributes (SCALAR, ARRAY, HASH) use Perl's "use attributes" style error format: + // "Invalid TYPE attribute: Name at FILE line LINE.\nBEGIN failed--compilation aborted at FILE line LINE.\n" + String loc = parser.ctx.errorUtil.warningLocation(parser.tokenIndex); + throw new PerlCompilerException(attrMsg + loc + ".\nBEGIN failed--compilation aborted" + loc + ".\n"); + } + throw new PerlCompilerException(parser.tokenIndex, attrMsg, parser.ctx.errorUtil); + } + + static void throwInvalidAttributeError(String type, List attrs, Parser parser) { + StringBuilder sb = new StringBuilder(); + for (int i = 0; i < attrs.size(); i++) { + if (i > 0) sb.append(" : "); + sb.append(attrs.get(i)); + } + String attrMsg = "Invalid " + type + " attribute" + (attrs.size() > 1 ? "s" : "") + ": " + sb; + if (!type.equals("CODE")) { + // Variable attributes (SCALAR, ARRAY, HASH) use Perl's "use attributes" style error format + String loc = parser.ctx.errorUtil.warningLocation(parser.tokenIndex); + throw new PerlCompilerException(attrMsg + loc + ".\nBEGIN failed--compilation aborted" + loc + ".\n"); } + throw new PerlCompilerException(parser.tokenIndex, attrMsg, parser.ctx.errorUtil); } private static SubroutineNode handleAnonSub(Parser parser, String subName, String prototype, List attributes, BlockNode block, int currentIndex) { @@ -1100,4 +1394,30 @@ private static SubroutineNode handleAnonSub(Parser parser, String subName, Strin return new SubroutineNode(subName, prototype, attributes, block, false, currentIndex); } + /** + * Validates prototype characters and emits "Illegal character in prototype" warnings. + * Valid prototype characters: $ @ % & * ; + \ [ ] _ + * + * @param parser The parser (for location info) + * @param proto The prototype string to validate + * @param subDisplayName The sub name for the warning message (may be null) + */ + static void emitIllegalProtoWarning(Parser parser, String proto, String subDisplayName) { + if (proto == null || proto.isEmpty()) return; + // Check if any character is illegal + boolean hasIllegal = false; + for (int i = 0; i < proto.length(); i++) { + char c = proto.charAt(i); + if ("$@%&*;+\\[]_ ".indexOf(c) < 0) { + hasIllegal = true; + break; + } + } + if (hasIllegal) { + String name = subDisplayName != null ? subDisplayName : "?"; + String msg = "Illegal character in prototype for " + name + " : " + proto; + String loc = parser.ctx.errorUtil.warningLocation(parser.tokenIndex); + Warnings.warnWithCategory("illegalproto", msg, loc); + } + } } diff --git a/src/main/java/org/perlonjava/frontend/parser/Variable.java b/src/main/java/org/perlonjava/frontend/parser/Variable.java index 905d7669c..262bfa2c7 100644 --- a/src/main/java/org/perlonjava/frontend/parser/Variable.java +++ b/src/main/java/org/perlonjava/frontend/parser/Variable.java @@ -7,6 +7,7 @@ import org.perlonjava.frontend.lexer.LexerTokenType; import org.perlonjava.frontend.semantic.SymbolTable; import org.perlonjava.runtime.operators.WarnDie; +import org.perlonjava.runtime.perlmodule.Strict; import org.perlonjava.runtime.runtimetypes.*; import java.util.ArrayList; @@ -239,6 +240,10 @@ && isFieldInClassHierarchy(parser, varName) } } + // Check strict vars at parse time — catches undeclared variables in + // lazily-compiled named sub bodies that would otherwise be missed + checkStrictVarsAtParseTime(parser, sigil, varName); + // Normal variable: create a simple variable reference node return new OperatorNode(sigil, new IdentifierNode(varName, parser.tokenIndex), parser.tokenIndex); } else if (peek(parser).text.equals("{")) { @@ -252,6 +257,122 @@ && isFieldInClassHierarchy(parser, varName) return new OperatorNode(sigil, operand, parser.tokenIndex); } + /** + * Check strict vars at parse time for an unqualified variable. + * This catches undeclared variables inside lazily-compiled named sub bodies + * that would otherwise only be detected at call time (or never). + * Mirrors the exemption logic from EmitVariable.java and BytecodeCompiler.java. + */ + private static void checkStrictVarsAtParseTime(Parser parser, String sigil, String varName) { + // Only check $, @, % sigils (not *, &, $#) + if (!sigil.equals("$") && !sigil.equals("@") && !sigil.equals("%")) return; + + // Skip when parsing a my/our/state declaration — the variable is being declared + if (parser.parsingDeclaration) return; + + // Only apply inside named subroutine bodies. Named subs are compiled + // lazily, so the existing code-generation strict check never fires at + // compile time for them. All other contexts (file-level, anonymous + // subs, eval STRING) are handled correctly by the code-generation check. + if (!parser.ctx.symbolTable.isInSubroutineBody()) return; + String currentSub = parser.ctx.symbolTable.getCurrentSubroutine(); + if (currentSub == null || currentSub.isEmpty()) return; + + // Check if strict vars is enabled in the current scope + if (!parser.ctx.symbolTable.isStrictOptionEnabled(Strict.HINT_STRICT_VARS)) return; + + // Variable declared lexically (my, our, state) — always allowed + if (parser.ctx.symbolTable.getSymbolEntry(sigil + varName) != null) return; + + // For $name{...} (hash element) or $name[...] (array element), check the + // container variable too: $hash{key} is valid if %hash is declared, + // and $array[0] is valid if @array is declared. + // Similarly, @name{...} is a hash slice (valid if %name is declared). + if (sigil.equals("$") || sigil.equals("@")) { + int peekIdx = Whitespace.skipWhitespace(parser, parser.tokenIndex, parser.tokens); + if (peekIdx < parser.tokens.size()) { + String nextText = parser.tokens.get(peekIdx).text; + if (nextText.equals("{") && parser.ctx.symbolTable.getSymbolEntry("%" + varName) != null) return; + if (nextText.equals("[") && parser.ctx.symbolTable.getSymbolEntry("@" + varName) != null) return; + } + } + + // Qualified names (Pkg::var) — always allowed + if (varName.contains("::")) return; + + // Regex capture variables ($1, $2, ...) but not $01, $02 + if (ScalarUtils.isInteger(varName) && !varName.startsWith("0")) return; + + // Sort variables $a and $b + if (sigil.equals("$") && (varName.equals("a") || varName.equals("b"))) return; + + // Built-in special length-one vars ($_, $!, $;, $0, etc.) + if (sigil.equals("$") && varName.length() == 1 && !Character.isLetter(varName.charAt(0))) return; + + // Built-in special scalar vars (${^GLOBAL_PHASE}, $ARGV, $STDIN, etc.) + if (sigil.equals("$") && !varName.isEmpty() && varName.charAt(0) < 32) return; + if (sigil.equals("$") && (varName.equals("ARGV") || varName.equals("ARGVOUT") + || varName.equals("ENV") || varName.equals("INC") || varName.equals("SIG") + || varName.equals("STDIN") || varName.equals("STDOUT") || varName.equals("STDERR"))) return; + + // Built-in special container vars (%ENV, %SIG, @ARGV, @INC, etc.) + if (sigil.equals("%") && (varName.equals("SIG") || varName.equals("ENV") + || varName.equals("INC") || varName.equals("+") || varName.equals("-"))) return; + if (sigil.equals("@") && (varName.equals("ARGV") || varName.equals("INC") + || varName.equals("_") || varName.equals("F"))) return; + + // Non-ASCII length-1 scalars under 'no utf8' (Latin-1 range) + if (sigil.equals("$") && varName.length() == 1) { + char c = varName.charAt(0); + if (c > 127 && c <= 255 + && !parser.ctx.symbolTable.isStrictOptionEnabled(Strict.HINT_UTF8)) return; + } + + // Check if variable already exists in the global registry (from use vars, etc.) + String normalizedName = NameNormalizer.normalizeVariableName( + varName, parser.ctx.symbolTable.getCurrentPackage()); + boolean existsGlobally = false; + if (sigil.equals("$")) { + existsGlobally = GlobalVariable.existsGlobalVariable(normalizedName); + // For $hash{...} and $array[...], also check global container + if (!existsGlobally) { + int peekIdx = Whitespace.skipWhitespace(parser, parser.tokenIndex, parser.tokens); + if (peekIdx < parser.tokens.size()) { + String nextText = parser.tokens.get(peekIdx).text; + if (nextText.equals("{") && GlobalVariable.existsGlobalHash(normalizedName)) existsGlobally = true; + if (nextText.equals("[") && GlobalVariable.existsGlobalArray(normalizedName)) existsGlobally = true; + } + } + } else if (sigil.equals("@")) { + existsGlobally = GlobalVariable.existsGlobalArray(normalizedName); + // For @hash{...} (hash slice), also check global hash + if (!existsGlobally) { + int peekIdx = Whitespace.skipWhitespace(parser, parser.tokenIndex, parser.tokens); + if (peekIdx < parser.tokens.size()) { + String nextText = parser.tokens.get(peekIdx).text; + if (nextText.equals("{") && GlobalVariable.existsGlobalHash(normalizedName)) existsGlobally = true; + } + } + } else if (sigil.equals("%") && !normalizedName.endsWith("::")) + existsGlobally = GlobalVariable.existsGlobalHash(normalizedName); + + // Single-letter scalars require declaration even if they exist globally + if (sigil.equals("$") && varName.length() == 1 + && Character.isLetter(varName.charAt(0)) + && !varName.equals("a") && !varName.equals("b")) { + existsGlobally = false; + } + + if (existsGlobally) return; + + // Undeclared variable under strict vars + throw new PerlCompilerException(parser.tokenIndex, + "Global symbol \"" + sigil + varName + + "\" requires explicit package name (did you forget to declare \"my " + + sigil + varName + "\"?)", + parser.ctx.errorUtil); + } + /** * Parses array and hash access operations within braces (for ${...} constructs). * This is similar to parseArrayHashAccess but stops at the closing brace. diff --git a/src/main/java/org/perlonjava/runtime/operators/ReferenceOperators.java b/src/main/java/org/perlonjava/runtime/operators/ReferenceOperators.java index ff7eb4f11..443df1e65 100644 --- a/src/main/java/org/perlonjava/runtime/operators/ReferenceOperators.java +++ b/src/main/java/org/perlonjava/runtime/operators/ReferenceOperators.java @@ -57,12 +57,16 @@ public static RuntimeScalar ref(RuntimeScalar runtimeScalar) { str = ref(runtimeScalar.tiedFetch()).toString(); break; case CODE: - if (!((RuntimeCode) runtimeScalar.value).defined()) { - str = ""; - break; + // ref() always returns "CODE" for CODE-typed scalars, regardless of whether + // the subroutine is defined. In Perl, ref(\&stub) returns "CODE" even for + // forward-declared subs without a body. The defined() check only matters + // for defined(&name), not for ref(). + if (runtimeScalar.value == null) { + str = "CODE"; + } else { + blessId = ((RuntimeBase) runtimeScalar.value).blessId; + str = blessId == 0 ? "CODE" : NameNormalizer.getBlessStr(blessId); } - blessId = ((RuntimeBase) runtimeScalar.value).blessId; - str = blessId == 0 ? "CODE" : NameNormalizer.getBlessStr(blessId); break; case GLOB: // For globs, check what slots are filled @@ -136,8 +140,12 @@ public static RuntimeScalar ref(RuntimeScalar runtimeScalar) { str = (filledSlots == 1) ? slotType : ""; break; case REGEX: - blessId = ((RuntimeBase) runtimeScalar.value).blessId; - str = blessId == 0 ? "Regexp" : NameNormalizer.getBlessStr(blessId); + if (runtimeScalar.value == null) { + str = "Regexp"; + } else { + blessId = ((RuntimeBase) runtimeScalar.value).blessId; + str = blessId == 0 ? "Regexp" : NameNormalizer.getBlessStr(blessId); + } break; case REFERENCE: // Handle nested references @@ -150,20 +158,36 @@ public static RuntimeScalar ref(RuntimeScalar runtimeScalar) { default -> "SCALAR"; }; } - blessId = ((RuntimeBase) runtimeScalar.value).blessId; - str = blessId == 0 ? ref : NameNormalizer.getBlessStr(blessId); + if (runtimeScalar.value == null) { + str = ref; + } else { + blessId = ((RuntimeBase) runtimeScalar.value).blessId; + str = blessId == 0 ? ref : NameNormalizer.getBlessStr(blessId); + } break; case ARRAYREFERENCE: - blessId = ((RuntimeBase) runtimeScalar.value).blessId; - str = blessId == 0 ? "ARRAY" : NameNormalizer.getBlessStr(blessId); + if (runtimeScalar.value == null) { + str = "ARRAY"; + } else { + blessId = ((RuntimeBase) runtimeScalar.value).blessId; + str = blessId == 0 ? "ARRAY" : NameNormalizer.getBlessStr(blessId); + } break; case HASHREFERENCE: - blessId = ((RuntimeBase) runtimeScalar.value).blessId; - str = blessId == 0 ? "HASH" : NameNormalizer.getBlessStr(blessId); + if (runtimeScalar.value == null) { + str = "HASH"; + } else { + blessId = ((RuntimeBase) runtimeScalar.value).blessId; + str = blessId == 0 ? "HASH" : NameNormalizer.getBlessStr(blessId); + } break; case GLOBREFERENCE: - blessId = ((RuntimeBase) runtimeScalar.value).blessId; - str = blessId == 0 ? "GLOB" : NameNormalizer.getBlessStr(blessId); + if (runtimeScalar.value == null) { + str = "GLOB"; + } else { + blessId = ((RuntimeBase) runtimeScalar.value).blessId; + str = blessId == 0 ? "GLOB" : NameNormalizer.getBlessStr(blessId); + } break; case FORMAT: str = "FORMAT"; diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/Attributes.java b/src/main/java/org/perlonjava/runtime/perlmodule/Attributes.java new file mode 100644 index 000000000..5c33976aa --- /dev/null +++ b/src/main/java/org/perlonjava/runtime/perlmodule/Attributes.java @@ -0,0 +1,538 @@ +package org.perlonjava.runtime.perlmodule; + +import org.perlonjava.runtime.mro.InheritanceResolver; +import org.perlonjava.runtime.runtimetypes.*; + +import java.util.ArrayList; +import java.util.List; +import java.util.Set; + +import static org.perlonjava.runtime.runtimetypes.RuntimeScalarType.*; + +/** + * Java backend for the Perl {@code attributes} pragma. + * + *

Provides the XS-equivalent functions that {@code attributes.pm} calls: + * {@code _modify_attrs}, {@code _fetch_attrs}, {@code _guess_stash}, and {@code reftype}. + * + *

The Perl-level logic ({@code import}, {@code get}, warnings) lives in + * {@code src/main/perl/lib/attributes.pm}. + */ +public class Attributes extends PerlModuleBase { + + public Attributes() { + // Don't set %INC — the Perl attributes.pm file handles that + super("attributes", false); + } + + /** + * Register the XS-equivalent functions in the {@code attributes::} namespace. + * Called eagerly from GlobalContext so functions are available when attributes.pm loads. + */ + public static void initialize() { + Attributes attrs = new Attributes(); + try { + attrs.registerMethod("_modify_attrs", "modifyAttrs", null); + attrs.registerMethod("_fetch_attrs", "fetchAttrs", null); + attrs.registerMethod("_guess_stash", "guessStash", null); + attrs.registerMethod("reftype", "reftype", "$"); + } catch (NoSuchMethodException e) { + System.err.println("Warning: Missing attributes method: " + e.getMessage()); + } + } + + /** + * {@code _modify_attrs($svref, @attrs)} — Apply built-in attributes. + * + *

For CODE refs: recognizes {@code lvalue}, {@code method}, {@code const}, + * {@code prototype(...)}, and {@code -attr} removal. Applies them to the + * {@link RuntimeCode#attributes} list. + * + *

For SCALAR/ARRAY/HASH refs: recognizes {@code shared} (no-op in PerlOnJava). + * + * @return A list of unrecognized attributes (those not built-in). + */ + public static RuntimeList modifyAttrs(RuntimeArray args, int ctx) { + if (args.size() < 1) { + return new RuntimeList(); + } + RuntimeScalar svref = args.get(0); + String svtype = getRefType(svref); + + List unrecognized = new ArrayList<>(); + + for (int i = 1; i < args.size(); i++) { + String attr = args.get(i).toString(); + + // Check for unterminated attribute parameter + if (attr.contains("(") && !attr.endsWith(")")) { + throw new org.perlonjava.runtime.runtimetypes.PerlCompilerException( + "Unterminated attribute parameter in attribute list"); + } + + int result = applyBuiltinAttribute(svref, svtype, attr); + if (result == ATTR_UNRECOGNIZED || result == ATTR_WARN) { + // ATTR_WARN: attribute was applied but should be returned so + // _modify_attrs_and_deprecate can emit the appropriate warning + unrecognized.add(attr); + } + } + + RuntimeArray result = new RuntimeArray(); + for (String attr : unrecognized) { + RuntimeArray.push(result, new RuntimeScalar(attr)); + } + return result.getList(); + } + + // Return values for applyBuiltinAttribute + private static final int ATTR_UNRECOGNIZED = 0; // Not a built-in attribute + private static final int ATTR_APPLIED = 1; // Applied silently (no warning needed) + private static final int ATTR_WARN = 2; // Applied, but should warn (state change on defined sub) + + /** + * Try to apply a single built-in attribute. + * + * @return ATTR_UNRECOGNIZED if not built-in, ATTR_APPLIED if applied silently, + * ATTR_WARN if applied but the original attr name should be returned + * so _modify_attrs_and_deprecate can emit a warning. + */ + private static int applyBuiltinAttribute(RuntimeScalar svref, String svtype, String attr) { + boolean negate = attr.startsWith("-"); + String attrName = negate ? attr.substring(1) : attr; + + if ("CODE".equals(svtype)) { + return applyCodeAttribute(svref, attrName, negate); + } else if ("SCALAR".equals(svtype) || "ARRAY".equals(svtype) || "HASH".equals(svtype)) { + return applyVariableAttribute(attrName, negate) ? ATTR_APPLIED : ATTR_UNRECOGNIZED; + } + return ATTR_UNRECOGNIZED; + } + + /** + * Apply a built-in CODE attribute. + * + *

For {@code lvalue} and {@code const}: returns ATTR_WARN when there's a meaningful + * state change on an already-defined subroutine. This causes the attribute name to be + * returned by {@code _modify_attrs}, allowing {@code _modify_attrs_and_deprecate} in + * attributes.pm to emit the appropriate warning. + * + *

Only attributes with entries in attributes.pm's {@code %msg} hash should return + * ATTR_WARN: {@code lvalue} (adding), {@code -lvalue} (removing), and {@code const} (adding). + */ + private static int applyCodeAttribute(RuntimeScalar svref, String attrName, boolean negate) { + // Handle prototype(...) + if (attrName.startsWith("prototype(") && attrName.endsWith(")")) { + if (svref.type == CODE) { + RuntimeCode code = (RuntimeCode) svref.value; + String newProto = attrName.substring(10, attrName.length() - 1); + String oldProto = code.prototype; + + // Emit "Illegal character in prototype" warning + if (newProto != null && !newProto.isEmpty()) { + boolean hasIllegal = false; + for (int i = 0; i < newProto.length(); i++) { + char c = newProto.charAt(i); + if ("$@%&*;+\\[]_ ".indexOf(c) < 0) { + hasIllegal = true; + break; + } + } + if (hasIllegal) { + // Use *PKG::name format for the warning when called via use attributes + String name = code.subName != null ? "*" + code.packageName + "::" + code.subName : "?"; + String msg = "Illegal character in prototype for " + name + " : " + newProto; + Warnings.emitCategoryWarning("illegalproto", msg); + } + } + + // Emit "Prototype mismatch" warning + if (oldProto != null || newProto != null) { + String oldDisplay = oldProto == null ? ": none" : " (" + oldProto + ")"; + String newDisplay = newProto == null ? "none" : "(" + newProto + ")"; + String oldForCompare = oldProto == null ? "none" : "(" + oldProto + ")"; + if (!oldForCompare.equals(newDisplay)) { + String subName = code.subName != null + ? code.packageName + "::" + code.subName : "__ANON__"; + String msg = "Prototype mismatch: sub " + subName + oldDisplay + " vs " + newDisplay; + Warnings.emitWarningFromCaller(msg); + } + } + + code.prototype = negate ? null : newProto; + } + return ATTR_APPLIED; + } + + switch (attrName) { + case "lvalue": + case "method": + case "const": + if (svref.type == CODE) { + RuntimeCode code = (RuntimeCode) svref.value; + if (code.attributes == null) { + code.attributes = new ArrayList<>(); + } + boolean hadAttr = code.attributes.contains(attrName); + // Check if sub has a callable body (can actually be invoked) + boolean hasCallableBody = code.subroutine != null || code.methodHandle != null + || code instanceof org.perlonjava.backend.bytecode.InterpretedCode; + // Check if sub has an actual body (not just a stub from \&foo) + boolean isDefinedSub = hasCallableBody + || code.constantValue != null || code.compilerSupplier != null + || code.isBuiltin; + if (negate) { + code.attributes.remove(attrName); + if ("const".equals(attrName)) { + code.constantValue = null; // Clear constant value on removal + } + // Only lvalue has a removal warning in %msg ("-lvalue") + // Only warn for already-defined subroutines with a state change + if ("lvalue".equals(attrName) && hadAttr && isDefinedSub) { + return ATTR_WARN; + } + return ATTR_APPLIED; + } else { + if (!hadAttr) { + code.attributes.add(attrName); + } + // lvalue warns on state change for already-defined subs + if ("lvalue".equals(attrName) && !hadAttr && isDefinedSub) { + return ATTR_WARN; + } + // const: invoke and store result if callable, else warn "useless" + if ("const".equals(attrName) && !hadAttr) { + if (hasCallableBody) { + // Const folding: call the sub with no args and store the result + // Deep-copy: the result may contain aliases to mutable variables + // (e.g. sub :const { $_ } — the result aliases $_, which may change later) + RuntimeArray emptyArgs = new RuntimeArray(); + RuntimeList result = code.apply(emptyArgs, RuntimeContextType.LIST); + RuntimeList frozen = new RuntimeList(); + for (RuntimeBase elem : result.elements) { + if (elem instanceof RuntimeScalar rs) { + frozen.elements.add(new RuntimeScalar(rs)); + } else { + frozen.elements.add(elem); + } + } + code.constantValue = frozen; + return ATTR_APPLIED; + } + // No callable body — const is useless + return ATTR_WARN; + } + return ATTR_APPLIED; + } + } + return ATTR_APPLIED; + default: + return ATTR_UNRECOGNIZED; + } + } + + /** + * Apply a built-in variable attribute. + * {@code shared} is recognized (no-op in PerlOnJava). + * {@code -shared} triggers a "may not be unshared" error. + */ + private static boolean applyVariableAttribute(String attrName, boolean negate) { + if ("shared".equals(attrName)) { + if (negate) { + throw new RuntimeException("A variable may not be unshared"); + } + return true; + } + return false; + } + + /** + * {@code _fetch_attrs($svref)} — Retrieve built-in attributes from a reference. + * + *

For CODE refs: returns the built-in attributes (lvalue, method, const) from + * {@link RuntimeCode#attributes}. + * + *

For other ref types: returns an empty list (no built-in variable attributes + * are tracked in PerlOnJava). + */ + public static RuntimeList fetchAttrs(RuntimeArray args, int ctx) { + if (args.size() < 1) { + return new RuntimeList(); + } + RuntimeScalar svref = args.get(0); + + if (svref.type == CODE) { + RuntimeCode code = (RuntimeCode) svref.value; + if (code.attributes == null) { + return new RuntimeList(); + } + RuntimeArray result = new RuntimeArray(); + for (String attr : code.attributes) { + // Only return built-in attributes from _fetch_attrs + // (lvalue, method, const are the built-in CODE attrs) + if ("lvalue".equals(attr) || "method".equals(attr) || "const".equals(attr)) { + RuntimeArray.push(result, new RuntimeScalar(attr)); + } + } + return result.getList(); + } + + return new RuntimeList(); + } + + /** + * {@code _guess_stash($svref)} — Determine the package for FETCH_*_ATTRIBUTES lookup. + * + *

For CODE refs: returns {@link RuntimeCode#packageName} (the original compilation + * package). For anonymous subs, this is the package they were compiled in. + * + *

For other ref types: returns {@code undef} (caller will use {@code caller()} as fallback). + */ + public static RuntimeList guessStash(RuntimeArray args, int ctx) { + if (args.size() < 1) { + return new RuntimeScalar().getList(); + } + RuntimeScalar svref = args.get(0); + + if (svref.type == CODE) { + RuntimeCode code = (RuntimeCode) svref.value; + // For blessed CODE refs, return the blessed class (like Perl's SvSTASH) + if (code.blessId != 0) { + return new RuntimeScalar(NameNormalizer.getBlessStr(code.blessId)).getList(); + } + // For non-blessed CODE refs, return the compilation package + if (code.packageName != null) { + return new RuntimeScalar(code.packageName).getList(); + } + } + + // For non-CODE refs, return undef — caller will use caller() as fallback + return new RuntimeScalar().getList(); + } + + /** + * {@code reftype($ref)} — Returns the underlying reference type, ignoring bless. + * + *

Delegates to the same logic as {@link ScalarUtil#reftype}. + */ + public static RuntimeList reftype(RuntimeArray args, int ctx) { + return ScalarUtil.reftype(args, ctx); + } + + /** + * Dispatch MODIFY_CODE_ATTRIBUTES at runtime for anonymous subs. + * + *

Called from generated bytecode when an anonymous sub has non-builtin + * attributes (e.g., {@code sub : Const { ... }}). Filters out built-in + * attributes (already applied directly) and calls the package's + * MODIFY_CODE_ATTRIBUTES handler for the rest. + * + * @param packageName The package to look up MODIFY_CODE_ATTRIBUTES in + * @param codeRef The RuntimeScalar wrapping the anonymous sub's RuntimeCode + */ + public static void runtimeDispatchModifyCodeAttributes(String packageName, RuntimeScalar codeRef) { + runtimeDispatchModifyCodeAttributes(packageName, codeRef, false); + } + + /** + * Dispatch MODIFY_CODE_ATTRIBUTES at runtime for anonymous subs. + * When {@code isClosure} is true, marks the original code as a closure prototype + * (non-callable) and replaces the RuntimeScalar's value with a callable clone. + * + * @param packageName The package to look up MODIFY_CODE_ATTRIBUTES in + * @param codeRef The RuntimeScalar wrapping the anonymous sub's RuntimeCode + * @param isClosure Whether the sub captures lexical variables (is a closure) + */ + public static void runtimeDispatchModifyCodeAttributes(String packageName, RuntimeScalar codeRef, boolean isClosure) { + if (codeRef.type != CODE) return; + RuntimeCode code = (RuntimeCode) codeRef.value; + if (code.attributes == null || code.attributes.isEmpty()) return; + + // Filter non-builtin attributes + Set builtinAttrs = Set.of("lvalue", "method", "const"); + List nonBuiltinAttrs = new ArrayList<>(); + for (String attr : code.attributes) { + String name = attr.startsWith("-") ? attr.substring(1) : attr; + int parenIdx = name.indexOf('('); + String baseName = parenIdx >= 0 ? name.substring(0, parenIdx) : name; + if (!builtinAttrs.contains(baseName) && !baseName.equals("prototype")) { + nonBuiltinAttrs.add(attr); + } + } + if (nonBuiltinAttrs.isEmpty()) return; + + // Remove non-builtin attrs from the list (they're handled by the handler) + code.attributes.removeAll(nonBuiltinAttrs); + + // Check if the package has MODIFY_CODE_ATTRIBUTES + RuntimeArray canArgs = new RuntimeArray(); + RuntimeArray.push(canArgs, new RuntimeScalar(packageName)); + RuntimeArray.push(canArgs, new RuntimeScalar("MODIFY_CODE_ATTRIBUTES")); + + InheritanceResolver.autoloadEnabled = false; + RuntimeList codeList; + try { + codeList = Universal.can(canArgs, RuntimeContextType.SCALAR); + } finally { + InheritanceResolver.autoloadEnabled = true; + } + + boolean hasHandler = codeList.size() == 1 && codeList.getFirst().getBoolean(); + + if (hasHandler) { + RuntimeScalar method = codeList.getFirst(); + RuntimeArray callArgs = new RuntimeArray(); + RuntimeArray.push(callArgs, new RuntimeScalar(packageName)); + RuntimeArray.push(callArgs, codeRef); + for (String attr : nonBuiltinAttrs) { + RuntimeArray.push(callArgs, new RuntimeScalar(attr)); + } + + RuntimeList result = RuntimeCode.apply(method, callArgs, RuntimeContextType.LIST); + + // If MODIFY_CODE_ATTRIBUTES returns any values, they are unrecognized + RuntimeArray resultArray = result.getArrayOfAlias(); + if (resultArray.size() > 0) { + StringBuilder sb = new StringBuilder(); + for (int i = 0; i < resultArray.size(); i++) { + if (i > 0) sb.append(" : "); + sb.append(resultArray.get(i).toString()); + } + throw new PerlCompilerException( + "Invalid CODE attribute" + (resultArray.size() > 1 ? "s" : "") + ": " + sb); + } + + // For closures: mark the original code as a prototype and replace + // codeRef's value with a callable clone. The MODIFY_CODE_ATTRIBUTES + // handler may have captured codeRef (e.g., $proto = $_[1]), so the + // handler's captured reference will point to the prototype (non-callable), + // while the expression result (codeRef) gets the callable clone. + if (isClosure) { + RuntimeCode originalCode = (RuntimeCode) codeRef.value; + RuntimeCode clone = originalCode.cloneForClosure(); + clone.__SUB__ = new RuntimeScalar(clone); + originalCode.isClosurePrototype = true; + codeRef.type = CODE; + codeRef.value = clone; + } + } else { + // No MODIFY_CODE_ATTRIBUTES handler — all non-builtin attrs are invalid + StringBuilder sb = new StringBuilder(); + for (int i = 0; i < nonBuiltinAttrs.size(); i++) { + if (i > 0) sb.append(" : "); + sb.append(nonBuiltinAttrs.get(i)); + } + throw new PerlCompilerException( + "Invalid CODE attribute" + (nonBuiltinAttrs.size() > 1 ? "s" : "") + ": " + sb); + } + } + + /** + * Dispatch MODIFY_*_ATTRIBUTES at runtime for {@code my}/{@code state} variables. + * + *

Called from generated bytecode when a lexical variable declaration has + * non-builtin attributes (e.g., {@code my $x : TieLoop}). At compile time, + * the parser validates that the handler exists and emits the reserved-word + * warning. At runtime, after the variable is allocated, this method creates + * a reference to the actual lexical and calls the handler. + * + * @param packageName The package to look up MODIFY_*_ATTRIBUTES in + * @param variable The actual runtime variable (RuntimeScalar/RuntimeArray/RuntimeHash) + * @param sigil The variable sigil ("$", "@", or "%") + * @param attributes The attribute strings from the declaration + * @param fileName Source file name for CallerStack (used by Attribute::Handlers) + * @param lineNum Source line number for CallerStack + */ + public static void runtimeDispatchModifyVariableAttributes( + String packageName, RuntimeBase variable, String sigil, + String[] attributes, String fileName, int lineNum) { + + String svtype = switch (sigil) { + case "$" -> "SCALAR"; + case "@" -> "ARRAY"; + case "%" -> "HASH"; + default -> throw new PerlCompilerException("Unknown sigil: " + sigil); + }; + + // Filter built-in attributes + List nonBuiltinAttrs = new ArrayList<>(); + for (String attr : attributes) { + if ("shared".equals(attr)) continue; + nonBuiltinAttrs.add(attr); + } + if (nonBuiltinAttrs.isEmpty()) return; + + // Check if the package has MODIFY_*_ATTRIBUTES + String modifyMethod = "MODIFY_" + svtype + "_ATTRIBUTES"; + RuntimeArray canArgs = new RuntimeArray(); + RuntimeArray.push(canArgs, new RuntimeScalar(packageName)); + RuntimeArray.push(canArgs, new RuntimeScalar(modifyMethod)); + + InheritanceResolver.autoloadEnabled = false; + RuntimeList codeList; + try { + codeList = Universal.can(canArgs, RuntimeContextType.SCALAR); + } finally { + InheritanceResolver.autoloadEnabled = true; + } + + boolean hasHandler = codeList.size() == 1 && codeList.getFirst().getBoolean(); + + if (hasHandler) { + // Create reference to the actual variable + RuntimeScalar varRef = variable.createReference(); + + RuntimeScalar method = codeList.getFirst(); + RuntimeArray callArgs = new RuntimeArray(); + RuntimeArray.push(callArgs, new RuntimeScalar(packageName)); + RuntimeArray.push(callArgs, varRef); + for (String attr : nonBuiltinAttrs) { + RuntimeArray.push(callArgs, new RuntimeScalar(attr)); + } + + // Push caller frames so Attribute::Handlers can find source file/line + CallerStack.push(packageName, fileName, lineNum); + CallerStack.push(packageName, fileName, lineNum); + try { + RuntimeList result = RuntimeCode.apply(method, callArgs, RuntimeContextType.LIST); + + // If handler returns any values, they are unrecognized attributes + RuntimeArray resultArray = result.getArrayOfAlias(); + if (resultArray.size() > 0) { + StringBuilder sb = new StringBuilder(); + for (int i = 0; i < resultArray.size(); i++) { + if (i > 0) sb.append(" : "); + sb.append(resultArray.get(i).toString()); + } + throw new PerlCompilerException( + "Invalid " + svtype + " attribute" + + (resultArray.size() > 1 ? "s" : "") + ": " + sb); + } + } finally { + CallerStack.pop(); + CallerStack.pop(); + } + } + // If no handler found at runtime, silently return. + // For 'our' variables, the compile-time check already threw. + // For 'my'/'state', ideally we'd throw here, but the \K regex bug + // (pre-existing) corrupts handler names in decl-refs.t, causing + // false "Invalid attribute" errors. Deferring until \K is fixed. + // See dev/design/attributes.md "Known Issue: \K Regex Bug". + } + + /** + * Get the uppercase reference type string for a RuntimeScalar. + */ + private static String getRefType(RuntimeScalar scalar) { + return switch (scalar.type) { + case CODE -> "CODE"; + case REFERENCE -> "SCALAR"; + case ARRAYREFERENCE -> "ARRAY"; + case HASHREFERENCE -> "HASH"; + case GLOBREFERENCE -> "GLOB"; + case REGEX -> "REGEXP"; + default -> ""; + }; + } +} diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/Warnings.java b/src/main/java/org/perlonjava/runtime/perlmodule/Warnings.java index 260add150..4aa4f32be 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/Warnings.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/Warnings.java @@ -94,6 +94,26 @@ private static String getCallerPackageAtLevel(int level) { return null; } + /** + * Gets the caller location string (e.g., " at file.pl line 42") at the specified level. + * Used by warnIf/warnIfAtLevel to append location info to warning messages. + * + * @param level The stack level (0 = immediate caller of the warnings:: function) + * @return A RuntimeScalar containing the location string + */ + private static RuntimeScalar getCallerLocation(int level) { + RuntimeList callerInfo = RuntimeCode.caller( + new RuntimeList(RuntimeScalarCache.getScalarInt(level + 1)), + RuntimeContextType.LIST + ); + if (callerInfo.size() >= 3) { + String file = callerInfo.elements.get(1).toString(); + String line = callerInfo.elements.get(2).toString(); + return new RuntimeScalar(" at " + file + " line " + line); + } + return new RuntimeScalar(""); + } + /** * Walks up the call stack past frames in warnings-registered packages to find * the "external caller" whose warning bits should be checked. This implements @@ -485,19 +505,63 @@ public static RuntimeList warnIf(RuntimeArray args, int ctx) { // For custom (registered) categories, walk past the registered package // to find the external caller's warning bits String bits; + int bitsLevel = 0; // track which level the bits came from (for location info) if (WarningFlags.isCustomCategory(category)) { bits = findExternalCallerBits(); + // findExternalCallerBits walks up; approximate the level + // by re-checking which level matches + for (int level = 0; level < 50; level++) { + String candidateBits = getWarningBitsAtLevel(level); + if (candidateBits == bits) { + bitsLevel = level; + break; + } + } } else { - bits = getWarningBitsAtLevel(0); + // Walk up the call stack to find the first caller NOT in an internal + // package (attributes, warnings). This is the "responsible caller" + // whose location should be reported. This approximates Perl 5's + // _error_loc() behavior. + String pkg0 = getCallerPackageAtLevel(0); + boolean isInternalPkg = "attributes".equals(pkg0) || "warnings".equals(pkg0); + if (isInternalPkg) { + for (int level = 1; level < 50; level++) { + String pkg = getCallerPackageAtLevel(level); + if (pkg == null) break; // ran out of callers + if (!"attributes".equals(pkg) && !"warnings".equals(pkg)) { + bitsLevel = level; + break; + } + } + } + // Get bits from the external caller level first + bits = getWarningBitsAtLevel(bitsLevel); + // If bits are null at external caller level (e.g., eval STRING doesn't + // propagate ${^WARNING_BITS}), continue searching up the stack for bits + if (bits == null || !WarningFlags.isEnabledInBits(bits, category)) { + for (int level = bitsLevel + 1; level < 50; level++) { + String candidateBits = getWarningBitsAtLevel(level); + if (candidateBits != null && WarningFlags.isEnabledInBits(candidateBits, category)) { + bits = candidateBits; + break; + } + // Stop if we've run out of callers + String pkg = getCallerPackageAtLevel(level); + if (pkg == null) break; + } + } } // Check if category is enabled in lexical warnings boolean categoryEnabled = bits != null && WarningFlags.isEnabledInBits(bits, category); + // Get caller location from the level where warning bits were found + RuntimeScalar where = getCallerLocation(bitsLevel); + if (!categoryEnabled) { // Category not enabled via lexical warnings - fall back to $^W if (isWarnFlagSet()) { - WarnDie.warn(message, new RuntimeScalar("")); + WarnDie.warn(message, where); } return new RuntimeScalar().getList(); } @@ -505,9 +569,9 @@ public static RuntimeList warnIf(RuntimeArray args, int ctx) { // 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("")); + WarnDie.die(message, where); } else { - WarnDie.warn(message, new RuntimeScalar("")); + WarnDie.warn(message, where); } return new RuntimeScalar().getList(); @@ -536,10 +600,13 @@ public static RuntimeList warnIfAtLevel(RuntimeArray args, int ctx) { // Check if category is enabled in lexical warnings boolean categoryEnabled = bits != null && WarningFlags.isEnabledInBits(bits, category); + // Get caller location for warning/error messages + RuntimeScalar where = getCallerLocation(level); + if (!categoryEnabled) { // Category not enabled via lexical warnings - fall back to $^W if (isWarnFlagSet()) { - WarnDie.warn(message, new RuntimeScalar("")); + WarnDie.warn(message, where); } return new RuntimeScalar().getList(); } @@ -547,11 +614,149 @@ public static RuntimeList warnIfAtLevel(RuntimeArray args, int ctx) { // 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("")); + WarnDie.die(message, where); } else { - WarnDie.warn(message, new RuntimeScalar("")); + WarnDie.warn(message, where); } return new RuntimeScalar().getList(); } + + /** + * Convenience method to emit a warning under a specific warning category. + * Used by the parser for compile-time warnings (e.g., illegalproto). + * + * @param category The warning category (e.g., "illegalproto") + * @param message The warning message text + * @param location The location suffix (e.g., " at file.pl line 42") + */ + public static void warnWithCategory(String category, String message, String location) { + WarnDie.warnWithCategory( + new RuntimeScalar(message), + new RuntimeScalar(location), + category); + } + + /** + * Emit a warning with category checking, using the Perl caller stack. + * + *

This is designed for Java code (like {@link Attributes}) that needs to emit + * categorized warnings respecting the lexical warning context of the Perl caller. + * It walks past {@code attributes} and {@code warnings} package frames to find + * the "responsible caller" whose warning bits should be checked. + * + *

Unlike {@link org.perlonjava.runtime.operators.WarnDie#warnWithCategory}, + * which scans the Java call stack, this method uses {@code caller()} to walk the + * Perl call stack, ensuring correct behavior when Java-implemented modules + * (like {@code attributes::_modify_attrs}) are called from Perl code with + * {@code use warnings}. + * + * @param category The warning category (e.g., "illegalproto", "prototype") + * @param message The warning message text (without location suffix) + */ + public static void emitCategoryWarning(String category, String message) { + // Check scope-based runtime suppression first + if (WarningFlags.isWarningSuppressedAtRuntime(category)) { + return; + } + + // Walk up the Perl call stack past internal frames (attributes, warnings, + // and Java-implemented module frames that have empty package names) + int locationLevel = 0; + for (int level = 0; level < 50; level++) { + String pkg = getCallerPackageAtLevel(level); + if (pkg == null) break; + if (!pkg.isEmpty() && !"attributes".equals(pkg) && !"warnings".equals(pkg)) { + locationLevel = level; + break; + } + } + + // Get warning bits from the external caller level + String bits = getWarningBitsAtLevel(locationLevel); + + // If bits are null at the immediate caller, prefer the compile-time scope + // (this happens during BEGIN/use processing inside eval, where runtime + // warning bits are not propagated but the parser's symbol table has them) + boolean compileTimeScopeDecided = false; + if (bits == null || !WarningFlags.isEnabledInBits(bits, category)) { + try { + ScopedSymbolTable scope = org.perlonjava.frontend.parser.SpecialBlockParser.getCurrentScope(); + if (scope != null) { + // Use the Perl5-format bits string for the check, because + // it correctly maps aliases (e.g., "illegalproto" and + // "syntax::illegalproto" both map to Perl5 offset 47). + // The internal BitSet positions in ScopedSymbolTable assign + // separate positions to these, so isWarningCategoryEnabled() + // would fail when the qualified form is enabled but the + // bare form is checked (or vice versa). + String compileBits = scope.getWarningBitsString(); + if (compileBits != null && WarningFlags.isEnabledInBits(compileBits, category)) { + bits = compileBits; + } + // The compile-time scope is the authoritative source during + // BEGIN/use processing. Don't search further up the runtime stack. + compileTimeScopeDecided = true; + } + } catch (Exception ignored) { + // If compilation scope isn't available, continue with runtime bits + } + } + + // If still no bits found and compile-time scope didn't decide, + // search up the runtime stack as a last resort + if (!compileTimeScopeDecided && (bits == null || !WarningFlags.isEnabledInBits(bits, category))) { + for (int level = locationLevel + 1; level < 50; level++) { + String candidateBits = getWarningBitsAtLevel(level); + if (candidateBits != null && WarningFlags.isEnabledInBits(candidateBits, category)) { + bits = candidateBits; + break; + } + String pkg = getCallerPackageAtLevel(level); + if (pkg == null) break; + } + } + + boolean categoryEnabled = bits != null && WarningFlags.isEnabledInBits(bits, category); + RuntimeScalar where = getCallerLocation(locationLevel); + + if (!categoryEnabled) { + if (isWarnFlagSet()) { + WarnDie.warn(new RuntimeScalar(message), where); + } + return; + } + + // Category enabled -- check FATAL + if (WarningFlags.isFatalInBits(bits, category)) { + WarnDie.die(new RuntimeScalar(message), where); + } else { + WarnDie.warn(new RuntimeScalar(message), where); + } + } + + /** + * Emit a warning using the Perl caller stack for location info. + * + *

This is for unconditional (default-on) warnings emitted by Java code. + * It walks past {@code attributes} and {@code warnings} package frames + * to find the right caller location. + * + * @param message The warning message text (without location suffix) + */ + public static void emitWarningFromCaller(String message) { + // Walk past internal frames for location (attributes, warnings, + // and Java-implemented module frames that have empty package names) + int locationLevel = 0; + for (int level = 0; level < 50; level++) { + String pkg = getCallerPackageAtLevel(level); + if (pkg == null) break; + if (!pkg.isEmpty() && !"attributes".equals(pkg) && !"warnings".equals(pkg)) { + locationLevel = level; + break; + } + } + RuntimeScalar where = getCallerLocation(locationLevel); + WarnDie.warn(new RuntimeScalar(message), where); + } } diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalContext.java b/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalContext.java index 52f97f42b..011b4e9da 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalContext.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalContext.java @@ -257,6 +257,7 @@ public static void initializeGlobals(CompilerOptions compilerOptions) { PerlIO.initialize(); IOHandle.initialize(); // IO::Handle methods (_sync, _error, etc.) Version.initialize(); // Initialize version module for version objects + Attributes.initialize(); // attributes:: XS-equivalent functions (used by attributes.pm) DynaLoader.initialize(); XSLoader.initialize(); // XSLoader will load other classes on-demand // Filter::Util::Call will be loaded via XSLoader when needed diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java index 6493d0e43..561ed2eff 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java @@ -274,6 +274,14 @@ public static void clearInlineMethodCache() { public boolean isSymbolicReference = false; // Flag to indicate this is a built-in operator public boolean isBuiltin = false; + // Flag to indicate this was explicitly declared (sub foo; or sub foo { ... }) + // as opposed to auto-created by getGlobalCodeRef() for lookups. + // In Perl 5, declared subs (even forward declarations) are visible via *{glob}{CODE}. + public boolean isDeclared = false; + // Flag to indicate this is a closure prototype (the template CV before cloning). + // In Perl 5, MODIFY_CODE_ATTRIBUTES receives the closure prototype for closures. + // Calling a closure prototype should die with "Closure prototype called". + public boolean isClosurePrototype = false; // State variables public Map stateVariableInitialized = new HashMap<>(); public Map stateVariable = new HashMap<>(); @@ -320,6 +328,29 @@ private static void evalTrace(String msg) { } } + /** + * Create a callable clone of this RuntimeCode for closure prototype support. + * The original will be marked as a closure prototype (non-callable); + * the clone is the actual closure that can be called. + */ + public RuntimeCode cloneForClosure() { + RuntimeCode clone; + if (this.subroutine != null) { + clone = new RuntimeCode(this.subroutine, this.prototype); + } else { + clone = new RuntimeCode(this.methodHandle, this.codeObject, this.prototype); + } + clone.attributes = this.attributes != null ? new java.util.ArrayList<>(this.attributes) : null; + clone.packageName = this.packageName; + clone.subName = this.subName; + clone.isStatic = this.isStatic; + clone.isDeclared = this.isDeclared; + clone.constantValue = this.constantValue; + clone.compilerSupplier = this.compilerSupplier; + // isClosurePrototype stays false for the clone (it's callable) + return clone; + } + /** * Called by CLI argument parser when --disassemble is set. */ @@ -1775,6 +1806,21 @@ public static RuntimeList callerWithSub(RuntimeList args, int ctx, RuntimeScalar // Add hinthash (element 10): Compile-time %^H hash reference res.add(RuntimeScalarCache.scalarUndef); } + } else if (frame >= stackTraceSize) { + // Fallback: check CallerStack for synthetic frames pushed during compile-time + // operations (e.g., MODIFY_*_ATTRIBUTES called from Java). + // The excess frames beyond the Java stack trace are served from CallerStack. + int callerStackFrame = frame - stackTraceSize; + CallerStack.CallerInfo info = CallerStack.peek(callerStackFrame); + if (info != null) { + if (ctx == RuntimeContextType.SCALAR) { + res.add(new RuntimeScalar(info.packageName())); + } else { + res.add(new RuntimeScalar(info.packageName())); + res.add(new RuntimeScalar(info.filename())); + res.add(new RuntimeScalar(info.line())); + } + } } return res; } @@ -1855,12 +1901,26 @@ public static RuntimeList apply(RuntimeScalar runtimeScalar, RuntimeArray a, int if (runtimeScalar.type == RuntimeScalarType.CODE) { RuntimeCode code = (RuntimeCode) runtimeScalar.value; + // Check for closure prototype — calling one should die + if (code.isClosurePrototype) { + throw new PerlDieException(new RuntimeScalar("Closure prototype called")); + } + // CRITICAL: Run compilerSupplier BEFORE checking defined() // The compilerSupplier may replace runtimeScalar.value with InterpretedCode if (code.compilerSupplier != null) { + RuntimeList savedConstantValue = code.constantValue; + java.util.List savedAttributes = code.attributes; code.compilerSupplier.get(); // Reload code from runtimeScalar.value in case it was replaced code = (RuntimeCode) runtimeScalar.value; + // Transfer fields that were set on the old code (e.g., by :const attribute) + if (savedConstantValue != null && code.constantValue == null) { + code.constantValue = savedConstantValue; + } + if (savedAttributes != null && code.attributes == null) { + code.attributes = savedAttributes; + } } // Check if it's an unfilled forward declaration (not defined) @@ -2079,12 +2139,26 @@ public static RuntimeList apply(RuntimeScalar runtimeScalar, String subroutineNa RuntimeCode code = (RuntimeCode) runtimeScalar.value; + // Check for closure prototype — calling one should die + if (code.isClosurePrototype) { + throw new PerlDieException(new RuntimeScalar("Closure prototype called")); + } + // CRITICAL: Run compilerSupplier BEFORE checking defined() // The compilerSupplier may replace runtimeScalar.value with InterpretedCode if (code.compilerSupplier != null) { + RuntimeList savedConstantValue = code.constantValue; + java.util.List savedAttributes = code.attributes; code.compilerSupplier.get(); // Reload code from runtimeScalar.value in case it was replaced code = (RuntimeCode) runtimeScalar.value; + // Transfer fields that were set on the old code (e.g., by :const attribute) + if (savedConstantValue != null && code.constantValue == null) { + code.constantValue = savedConstantValue; + } + if (savedAttributes != null && code.attributes == null) { + code.attributes = savedAttributes; + } } // Lazily generate CORE:: subroutine wrappers on first call @@ -2211,12 +2285,26 @@ public static RuntimeList apply(RuntimeScalar runtimeScalar, String subroutineNa RuntimeCode code = (RuntimeCode) runtimeScalar.value; + // Check for closure prototype — calling one should die + if (code.isClosurePrototype) { + throw new PerlDieException(new RuntimeScalar("Closure prototype called")); + } + // CRITICAL: Run compilerSupplier BEFORE checking defined() // The compilerSupplier may replace runtimeScalar.value with InterpretedCode if (code.compilerSupplier != null) { + RuntimeList savedConstantValue = code.constantValue; + java.util.List savedAttributes = code.attributes; code.compilerSupplier.get(); // Reload code from runtimeScalar.value in case it was replaced code = (RuntimeCode) runtimeScalar.value; + // Transfer fields that were set on the old code (e.g., by :const attribute) + if (savedConstantValue != null && code.constantValue == null) { + code.constantValue = savedConstantValue; + } + if (savedAttributes != null && code.attributes == null) { + code.attributes = savedAttributes; + } } // Lazily generate CORE:: subroutine wrappers on first call @@ -2537,6 +2625,9 @@ public boolean defined() { if (this.isBuiltin) { return true; } + // Note: isDeclared is NOT checked here. In Perl 5, defined(&foo) returns + // false for forward declarations (sub foo;). The isDeclared flag is used + // only by RuntimeGlob.getGlobSlot("CODE") for *foo{CODE} visibility. return this.constantValue != null || this.compilerSupplier != null || this.subroutine != null || this.methodHandle != null; } diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGlob.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGlob.java index 8b6f62c0b..5416c1678 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGlob.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeGlob.java @@ -356,7 +356,7 @@ public RuntimeScalar getGlobSlot(RuntimeScalar index) { // mechanism where a sub deletes itself from the stash. RuntimeScalar codeRef = GlobalVariable.globalCodeRefs.get(this.globName); if (codeRef != null && codeRef.type == RuntimeScalarType.CODE && codeRef.value instanceof RuntimeCode code) { - if (code.defined()) { + if (code.defined() || code.isDeclared) { yield codeRef; } } diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalarType.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalarType.java index 850319c12..fa783471c 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalarType.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalarType.java @@ -29,7 +29,11 @@ private RuntimeScalarType() { // Get blessing ID as an integer public static int blessedId(RuntimeScalar runtimeScalar) { - return (runtimeScalar.type & REFERENCE_BIT) != 0 ? ((RuntimeBase) runtimeScalar.value).blessId : 0; + if ((runtimeScalar.type & REFERENCE_BIT) != 0) { + if (runtimeScalar.value == null) return 0; + return ((RuntimeBase) runtimeScalar.value).blessId; + } + return 0; } public static boolean isReference(RuntimeScalar runtimeScalar) { diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/ScalarSpecialVariable.java b/src/main/java/org/perlonjava/runtime/runtimetypes/ScalarSpecialVariable.java index f12171c32..d7f1dd56c 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/ScalarSpecialVariable.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/ScalarSpecialVariable.java @@ -214,7 +214,8 @@ public RuntimeScalar getValueAsScalar() { String lastCapture = RuntimeRegex.lastCaptureString(); yield lastCapture != null ? new RuntimeScalar(lastCapture) : scalarUndef; } - case LAST_SUCCESSFUL_PATTERN -> new RuntimeScalar(RuntimeRegex.lastSuccessfulPattern); + case LAST_SUCCESSFUL_PATTERN -> RuntimeRegex.lastSuccessfulPattern != null + ? new RuntimeScalar(RuntimeRegex.lastSuccessfulPattern) : scalarUndef; case LAST_REGEXP_CODE_RESULT -> { // $^R - Result of last (?{...}) code block // Get the last matched regex and retrieve its code block result diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/WarningFlags.java b/src/main/java/org/perlonjava/runtime/runtimetypes/WarningFlags.java index ddbc282c6..4c902bc91 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/WarningFlags.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/WarningFlags.java @@ -53,18 +53,18 @@ public class WarningFlags { warningHierarchy.put("pipe", new String[]{"io::pipe"}); warningHierarchy.put("unopened", new String[]{"io::unopened"}); warningHierarchy.put("FATAL", new String[]{}); - warningHierarchy.put("illegalproto", new String[]{}); - warningHierarchy.put("digit", new String[]{}); + warningHierarchy.put("illegalproto", new String[]{"syntax::illegalproto"}); + warningHierarchy.put("digit", new String[]{"syntax::digit"}); warningHierarchy.put("closed", new String[]{"io::closed"}); warningHierarchy.put("exec", new String[]{"io::exec"}); - warningHierarchy.put("reserved", new String[]{}); - warningHierarchy.put("prototype", new String[]{}); + warningHierarchy.put("reserved", new String[]{"syntax::reserved"}); + warningHierarchy.put("prototype", new String[]{"syntax::prototype"}); warningHierarchy.put("qw", new String[]{"syntax::qw"}); warningHierarchy.put("newline", new String[]{"io::newline"}); warningHierarchy.put("NONFATAL", new String[]{}); - warningHierarchy.put("non_unicode", new String[]{}); - warningHierarchy.put("surrogate", new String[]{}); - warningHierarchy.put("nonchar", new String[]{}); + warningHierarchy.put("non_unicode", new String[]{"utf8::non_unicode"}); + warningHierarchy.put("surrogate", new String[]{"utf8::surrogate"}); + warningHierarchy.put("nonchar", new String[]{"utf8::nonchar"}); } // ==================== Perl 5 Compatible Bit Offsets ==================== diff --git a/src/main/perl/lib/IO/Socket/INET.pm b/src/main/perl/lib/IO/Socket/INET.pm index 527d6a95b..45fd139d9 100644 --- a/src/main/perl/lib/IO/Socket/INET.pm +++ b/src/main/perl/lib/IO/Socket/INET.pm @@ -16,7 +16,7 @@ use Errno; our @ISA = qw(IO::Socket); our $VERSION = "1.56"; -my $EINVAL = eval { Errno::EINVAL() } || 1; +my $EINVAL = exists(&Errno::EINVAL) ? Errno::EINVAL() : 1; IO::Socket::INET->register_domain( AF_INET ); diff --git a/src/main/perl/lib/attributes.pm b/src/main/perl/lib/attributes.pm new file mode 100644 index 000000000..d8e7dd81b --- /dev/null +++ b/src/main/perl/lib/attributes.pm @@ -0,0 +1,100 @@ +package attributes; + +our $VERSION = 0.36; + +@EXPORT_OK = qw(get reftype); +@EXPORT = (); +%EXPORT_TAGS = (ALL => [@EXPORT, @EXPORT_OK]); + +use strict; + +sub croak { + require Carp; + goto &Carp::croak; +} + +sub carp { + require Carp; + goto &Carp::carp; +} + +my %msg = ( + lvalue => 'lvalue attribute applied to already-defined subroutine', + -lvalue => 'lvalue attribute removed from already-defined subroutine', + const => 'Useless use of attribute "const"', +); + +sub _modify_attrs_and_deprecate { + my $svtype = shift; + grep { + $svtype eq 'CODE' && exists $msg{$_} ? do { + require warnings; + warnings::warnif( + 'misc', + $msg{$_} + ); + 0; + } : 1 + } _modify_attrs(@_); +} + +sub import { + @_ > 2 && ref $_[2] or do { + require Exporter; + goto &Exporter::import; + }; + my (undef,$home_stash,$svref,@attrs) = @_; + + my $svtype = uc reftype($svref); + my $pkgmeth; + $pkgmeth = UNIVERSAL::can($home_stash, "MODIFY_${svtype}_ATTRIBUTES") + if defined $home_stash && $home_stash ne ''; + my @badattrs; + if ($pkgmeth) { + my @pkgattrs = _modify_attrs_and_deprecate($svtype, $svref, @attrs); + @badattrs = $pkgmeth->($home_stash, $svref, @pkgattrs); + if (!@badattrs && @pkgattrs) { + require warnings; + return unless warnings::enabled('reserved'); + @pkgattrs = grep { m/\A[[:lower:]]+(?:\z|\()/ } @pkgattrs; + if (@pkgattrs) { + for my $attr (@pkgattrs) { + $attr =~ s/\(.+\z//s; + } + my $s = ((@pkgattrs == 1) ? '' : 's'); + carp "$svtype package attribute$s " . + "may clash with future reserved word$s: " . + join(' : ' , @pkgattrs); + } + } + } + else { + @badattrs = _modify_attrs_and_deprecate($svtype, $svref, @attrs); + } + if (@badattrs) { + croak "Invalid $svtype attribute" . + (( @badattrs == 1 ) ? '' : 's') . + ": " . + join(' : ', @badattrs); + } +} + +sub get ($) { + @_ == 1 && ref $_[0] or + croak 'Usage: '.__PACKAGE__.'::get $ref'; + my $svref = shift; + my $svtype = uc reftype($svref); + my $stash = _guess_stash($svref); + $stash = caller unless defined $stash; + my $pkgmeth; + $pkgmeth = UNIVERSAL::can($stash, "FETCH_${svtype}_ATTRIBUTES") + if defined $stash && $stash ne ''; + return $pkgmeth ? + (_fetch_attrs($svref), $pkgmeth->($stash, $svref)) : + (_fetch_attrs($svref)) + ; +} + +sub require_version { goto &UNIVERSAL::VERSION } + +1; diff --git a/src/main/perl/lib/overload.pm b/src/main/perl/lib/overload.pm index 8070c2b4e..03ad240a9 100644 --- a/src/main/perl/lib/overload.pm +++ b/src/main/perl/lib/overload.pm @@ -109,7 +109,7 @@ sub Method { #return $ {*{$meth}}; } -sub AddrRef ($) { +sub AddrRef { no overloading; "$_[0]"; }