diff --git a/docs/about/changelog.md b/docs/about/changelog.md index 15bf39ba71..ac6720c248 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -8,6 +8,8 @@ priorities and future plans. - Parse forward-declared qualified classes as indirect constructors inside `new` methods (#1899). +- Preserve literal control bytes at the edges of `qw` lists and keep original named CV references when `MODIFY_CODE_ATTRIBUTES` installs wrappers (#1481, #1448). + - Match Perl `Encode` aliases for ANSI X3.4-1968, HZ-GB-2312, and ISO-8859-8-I, and include the BOM when encoding generic UTF-32 (#1897). - Separate organizational and project issue queues, record temporary agent claims and dependencies, and keep agent checkpoints concise (#1895). diff --git a/src/main/java/org/perlonjava/frontend/parser/StringParser.java b/src/main/java/org/perlonjava/frontend/parser/StringParser.java index 1ca12510ba..efad3d896c 100644 --- a/src/main/java/org/perlonjava/frontend/parser/StringParser.java +++ b/src/main/java/org/perlonjava/frontend/parser/StringParser.java @@ -763,7 +763,10 @@ public static ListNode parseWordsString(ParsedString rawStr) { index++; } - String trimmed = processed.toString().trim(); + // Java String.trim() removes every leading/trailing character <= U+0020. + // Perl qw splits on whitespace, but control bytes such as BEL/ENQ/ACK + // are ordinary data and must remain part of their words. + String trimmed = processed.toString().replaceAll("^\\s+|\\s+$", ""); ListNode list = new ListNode(rawStr.index); if (trimmed.isEmpty()) { return list; diff --git a/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java b/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java index 6709a55340..2057935cf4 100644 --- a/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java +++ b/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java @@ -2141,6 +2141,12 @@ public static ListNode handleNamedSubWithFilter(Parser parser, String subName, S // Initialize placeholder metadata (accessed via codeRef.value) RuntimeCode placeholder = (RuntimeCode) codeRef.value; + // Attribute handlers may replace the named CV's glob while retaining + // the supplied code reference (for example, an audit wrapper captures + // the original and installs an anonymous wrapper under the same name). + // Keep a stable scalar reference to the definition CV before dispatch; + // the live glob slot can be mutated by the handler. + RuntimeScalar definitionCodeRef = new RuntimeScalar(placeholder); if (block != null && block.getAnnotation("signatureMinArgs") instanceof Integer minArgs) { placeholder.applySignatureMetadata(block); } @@ -2219,7 +2225,7 @@ public static ListNode handleNamedSubWithFilter(Parser parser, String subName, S String attrPackage = (placeholder.packageName != null && !placeholder.packageName.isEmpty()) ? placeholder.packageName : packageToUse; - callModifyCodeAttributes(attrPackage, codeRef, attributes, parser, block.tokenIndex); + callModifyCodeAttributes(attrPackage, definitionCodeRef, attributes, parser, block.tokenIndex); } // B::CV->START line must be available before lazy compilation instantiates @@ -2646,7 +2652,7 @@ && isLexicalSubStorageReferenced(explicitlyUsedVars, entry.name()) // Set the __SUB__ instance field to codeRef Field field = placeholder.codeObject.getClass().getDeclaredField("__SUB__"); - field.set(placeholder.codeObject, codeRef); + field.set(placeholder.codeObject, definitionCodeRef); installClosureCaptureMetadata(placeholder, paramList); placeholder.cvStartFile = compiledCode.cvStartFile; @@ -2695,7 +2701,7 @@ && isLexicalSubStorageReferenced(explicitlyUsedVars, entry.name()) } // Set the __SUB__ field for self-reference - interpretedCode.__SUB__ = codeRef; + interpretedCode.__SUB__ = definitionCodeRef; // Set PerlSubroutine interface for direct invocation // InterpretedCode implements PerlSubroutine, so we can use it directly @@ -2751,7 +2757,7 @@ && isLexicalSubStorageReferenced(explicitlyUsedVars, entry.name()) placeholder.constantValue = interpretedCode.constantValue; } } - interpretedCode.__SUB__ = codeRef; + interpretedCode.__SUB__ = definitionCodeRef; placeholder.subroutine = interpretedCode; placeholder.codeObject = interpretedCode; installClosureCaptureMetadata(placeholder, materializedCaptures); @@ -2778,8 +2784,7 @@ && isLexicalSubStorageReferenced(explicitlyUsedVars, entry.name()) }; // Store the supplier in the placeholder - RuntimeCode placeholderForSupplier = (RuntimeCode) codeRef.value; - placeholderForSupplier.compilerSupplier = subroutineCreationTaskSupplier; + placeholder.compilerSupplier = subroutineCreationTaskSupplier; ListNode result = new ListNode(parser.tokenIndex); result.setAnnotation("compileTimeOnly", true); diff --git a/src/test/resources/unit/issue_1448_code_attribute_wrapper.t b/src/test/resources/unit/issue_1448_code_attribute_wrapper.t new file mode 100644 index 0000000000..9436013e14 --- /dev/null +++ b/src/test/resources/unit/issue_1448_code_attribute_wrapper.t @@ -0,0 +1,35 @@ +use strict; +use warnings; +use Test::More; + +{ + package Local::AuditWrapper; + our $calls = 0; + + sub MODIFY_CODE_ATTRIBUTES { + my ($package, $code, @attributes) = @_; + return @attributes unless @attributes == 1 && $attributes[0] eq 'Audit'; + + no strict 'refs'; + no warnings 'redefine'; + *{"${package}::run"} = sub { + my @out = $code->(@_); + return wantarray ? @out : shift @out; + }; + return (); + } + + sub run : Audit { + ++$calls; + return wantarray ? ('first', 'second') : 'scalar'; + } +} + +is(scalar Local::AuditWrapper::run(), 'first', 'audit wrapper returns the first list value in scalar context'); +is($Local::AuditWrapper::calls, 1, 'scalar call reaches the original sub once'); + +my @result = Local::AuditWrapper::run(); +is_deeply(\@result, ['first', 'second'], 'audit wrapper preserves list context'); +is($Local::AuditWrapper::calls, 2, 'list call reaches the original sub once'); + +done_testing; diff --git a/src/test/resources/unit/issue_1481_qw_control_characters.t b/src/test/resources/unit/issue_1481_qw_control_characters.t new file mode 100644 index 0000000000..87b9539be9 --- /dev/null +++ b/src/test/resources/unit/issue_1481_qw_control_characters.t @@ -0,0 +1,16 @@ +use strict; +use warnings; +use Test::More; + +my @leading = qw(  middle); +is_deeply(\@leading, ["\x07", "\x05", "middle"], + 'qw preserves leading literal control characters'); + +my @trailing = qw(middle  ); +is_deeply(\@trailing, ["middle", "\x05", "\x06"], + 'qw preserves trailing literal control characters'); + +my @ordinary = qw(alpha beta gamma); +is_deeply(\@ordinary, [qw(alpha beta gamma)], 'qw still splits ordinary whitespace'); + +done_testing;