From 57a55e45c1bfd9ead8d9a47e5fb83e322db069a1 Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Thu, 30 Jul 2026 14:54:16 +0200 Subject: [PATCH 1/3] fix: honor Storable Deparse for code references Allow the native Storable writer to serialize Perl code references when Storable::Deparse is enabled, using compiler-retained source text. Add a unit regression test validated against standard Perl. Generated with [Codex](https://openai.com/codex) Co-Authored-By: Codex <158243242+openai-codex[bot]@users.noreply.github.com> --- .../perlmodule/storable/StorableWriter.java | 47 ++++++++++++++++++- .../resources/unit/storable_code_deparse.t | 11 +++++ 2 files changed, 57 insertions(+), 1 deletion(-) create mode 100644 src/test/resources/unit/storable_code_deparse.t diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/storable/StorableWriter.java b/src/main/java/org/perlonjava/runtime/perlmodule/storable/StorableWriter.java index 848b47596..398e89df6 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/storable/StorableWriter.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/storable/StorableWriter.java @@ -10,6 +10,7 @@ import org.perlonjava.runtime.runtimetypes.RuntimeScalarType; import org.perlonjava.runtime.runtimetypes.NameNormalizer; import org.perlonjava.runtime.runtimetypes.ScalarUtils; +import org.perlonjava.runtime.runtimetypes.GlobalVariable; import java.nio.charset.StandardCharsets; import java.util.ArrayList; @@ -165,7 +166,23 @@ private void dispatchReferent(StorableContext c, RuntimeScalar refScalar) { dispatch(c, (RuntimeScalar) refScalar.value); break; case RuntimeScalarType.CODE: - throw new StorableFormatException("Can't store CODE items"); + // Storable's $Deparse flag enables code-reference storage by + // writing the source text produced by B::Deparse. RuntimeCode + // keeps the source text specifically for this purpose. The + // old implementation unconditionally rejected CODE values, + // which made otherwise pure-Perl users of Storable::freeze + // fail (Struct::Diff is one such consumer). + if (!GlobalVariable.getGlobalVariable("Storable::Deparse").getBoolean()) { + throw new StorableFormatException("Can't store CODE items"); + } + RuntimeCode code = (RuntimeCode) refScalar.value; + String source = codeSource(code); + if (source == null) { + throw new StorableFormatException("Can't store CODE items"); + } + c.writeByte(Opcodes.SX_CODE); + writeStringBody(c, source.getBytes(StandardCharsets.UTF_8), true); + break; case RuntimeScalarType.REGEX: // SX_REGEXP encoder. Foundation delegates to RegexpEncoder // which the regexp agent fills in. @@ -178,6 +195,34 @@ private void dispatchReferent(StorableContext c, RuntimeScalar refScalar) { } } + /** Return the source for this anonymous sub rather than the complete + * compilation unit. CompilerOptions retains the unit for diagnostics; + * using that whole string made every anonymous sub serialize identically. + * The block offset is the opening brace recorded by EmitSubroutine. */ + private static String codeSource(RuntimeCode code) { + String source = code.deparseSourceText; + int start = code.deparseSourceOffset; + if (source == null || start < 0 || start >= source.length()) return source; + int open = source.indexOf('{', start); + if (open < 0) return source; + int depth = 0; + boolean escaped = false; + char quote = 0; + for (int i = open; i < source.length(); i++) { + char ch = source.charAt(i); + if (quote != 0) { + if (escaped) escaped = false; + else if (ch == '\\') escaped = true; + else if (ch == quote) quote = 0; + continue; + } + if (ch == '\'' || ch == '"') { quote = ch; continue; } + if (ch == '{') depth++; + else if (ch == '}' && --depth == 0) return source.substring(open, i + 1); + } + return source; + } + /** Mirrors {@code store_hook} (Storable.xs L3574). Returns true if we * emitted a {@code SX_HOOK} frame for this object; false to let the * caller fall through to the normal {@code SX_BLESS} path. False is diff --git a/src/test/resources/unit/storable_code_deparse.t b/src/test/resources/unit/storable_code_deparse.t new file mode 100644 index 000000000..6f56c380f --- /dev/null +++ b/src/test/resources/unit/storable_code_deparse.t @@ -0,0 +1,11 @@ +use strict; +use warnings; +use Test::More tests => 2; +use Storable qw(freeze); + +my $code = sub { return 42 }; +local $Storable::Deparse = 1; +my $frozen = eval { freeze($code) }; + +ok(!$@, 'Storable can freeze a code reference with Deparse enabled'); +ok(defined($frozen) && length($frozen), 'the frozen code reference is non-empty'); From 4d6e56dd12e95e7141de63c2fa450279c4346c2d Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Thu, 30 Jul 2026 15:17:03 +0200 Subject: [PATCH 2/3] fix: preserve anonymous subroutine source locations Use the anonymous subroutine token index when retaining source text for Storable::Deparse. The block child index can point at a later enclosing block, causing adjacent closures to serialize the wrong source and breaking Struct::Diff and JSON::Patch comparisons. Generated with [Codex](https://openai.com/codex) Co-Authored-By: Codex <158243242+openai-codex[bot]@users.noreply.github.com> --- .../java/org/perlonjava/backend/jvm/EmitSubroutine.java | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java b/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java index 728a2df68..f91b860dc 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java @@ -255,8 +255,12 @@ public static void emitSubroutine(EmitterContext ctx, SubroutineNode node) { cvStartFile = ctx.compilerOptions.fileName; } int deparseSourceOffset = -1; - if (ctx.errorUtil != null && node.block != null) { - deparseSourceOffset = ctx.errorUtil.getSourceOffset(node.block.getIndex()); + if (ctx.errorUtil != null) { + // The subroutine node carries the lexer token index. The + // block's index is the first AST child index and can point at + // a later enclosing block for adjacent anonymous subs, + // causing Storable::Deparse to retain the wrong source. + deparseSourceOffset = ctx.errorUtil.getSourceOffset(node.getIndex()); } String deparseSourceText = null; if (ctx.compilerOptions != null) { From 14a0bfe42ec4c5221f3138a5747ab3b1a152ea49 Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Thu, 30 Jul 2026 15:40:18 +0200 Subject: [PATCH 3/3] fix: retain compiler source spans for deparsed subs Record the exclusive closing-token index for parsed anonymous subs and carry the resulting source span into RuntimeCode. Storable can then serialize the exact compiler span without attempting to parse Perl delimiters at runtime. Expand the regression coverage for quote-like braces and adjacent closures. Generated with [Codex](https://openai.com/codex) Co-Authored-By: Codex <158243242+openai-codex[bot]@users.noreply.github.com> --- .../backend/jvm/EmitSubroutine.java | 7 +++++- .../frontend/astnode/SubroutineNode.java | 9 +++++++ .../frontend/parser/SubroutineParser.java | 9 ++++--- .../perlmodule/storable/StorableWriter.java | 25 ++++--------------- .../runtime/runtimetypes/RuntimeCode.java | 18 +++++++++++++ .../resources/unit/storable_code_deparse.t | 19 +++++++++++++- 6 files changed, 62 insertions(+), 25 deletions(-) diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java b/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java index f91b860dc..25147078f 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java @@ -255,12 +255,16 @@ public static void emitSubroutine(EmitterContext ctx, SubroutineNode node) { cvStartFile = ctx.compilerOptions.fileName; } int deparseSourceOffset = -1; + int deparseSourceEnd = -1; if (ctx.errorUtil != null) { // The subroutine node carries the lexer token index. The // block's index is the first AST child index and can point at // a later enclosing block for adjacent anonymous subs, // causing Storable::Deparse to retain the wrong source. deparseSourceOffset = ctx.errorUtil.getSourceOffset(node.getIndex()); + if (node.sourceEndTokenIndex >= 0) { + deparseSourceEnd = ctx.errorUtil.getSourceOffset(node.sourceEndTokenIndex); + } } String deparseSourceText = null; if (ctx.compilerOptions != null) { @@ -336,11 +340,12 @@ public static void emitSubroutine(EmitterContext ctx, SubroutineNode node) { } mv.visitLdcInsn(deparseFlags); mv.visitLdcInsn(deparseSourceOffset); + mv.visitLdcInsn(deparseSourceEnd); mv.visitMethodInsn( Opcodes.INVOKESTATIC, "org/perlonjava/runtime/runtimetypes/RuntimeCode", "makeCodeObject", - "(Ljava/lang/Object;Ljava/lang/String;Ljava/lang/String;Ljava/lang/String;ILjava/lang/String;II)Lorg/perlonjava/runtime/runtimetypes/RuntimeScalar;", + "(Ljava/lang/Object;Ljava/lang/String;Ljava/lang/String;Ljava/lang/String;ILjava/lang/String;III)Lorg/perlonjava/runtime/runtimetypes/RuntimeScalar;", false); } catch (InterpreterFallbackException fallback) { // JVM compilation failed (e.g., ASM frame crash) - use InterpretedCode instead diff --git a/src/main/java/org/perlonjava/frontend/astnode/SubroutineNode.java b/src/main/java/org/perlonjava/frontend/astnode/SubroutineNode.java index e37225dc3..db455bf25 100644 --- a/src/main/java/org/perlonjava/frontend/astnode/SubroutineNode.java +++ b/src/main/java/org/perlonjava/frontend/astnode/SubroutineNode.java @@ -29,6 +29,9 @@ public class SubroutineNode extends AbstractNode { */ public final boolean useTryCatch; + /** Token immediately after the closing brace, when parsed from source. */ + public int sourceEndTokenIndex = -1; + /** * Constructs a new SubroutineNode with the specified parts. * @@ -50,6 +53,12 @@ public SubroutineNode(String name, String prototype, List attributes, No } } + public SubroutineNode(String name, String prototype, List attributes, Node block, + boolean useTryCatch, int tokenIndex, int sourceEndTokenIndex) { + this(name, prototype, attributes, block, useTryCatch, tokenIndex); + this.sourceEndTokenIndex = sourceEndTokenIndex; + } + /** * Accepts a visitor that performs some operation on this node. * This method is part of the Visitor design pattern, which allows diff --git a/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java b/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java index 484aa7a9d..b5a23e1ab 100644 --- a/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java +++ b/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java @@ -935,7 +935,8 @@ public static Node parseSubroutineDefinition(Parser parser, boolean wantName, St } if (subName == null) { - return handleAnonSub(parser, subName, prototype, attributes, block, currentIndex); + return handleAnonSub(parser, subName, prototype, attributes, block, currentIndex, + parser.tokenIndex); } else { return handleNamedSub(parser, subName, prototype, attributes, block, declaration); } @@ -1802,7 +1803,8 @@ static void throwInvalidAttributeError(String type, List attrs, Parser p 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) { + private static SubroutineNode handleAnonSub(Parser parser, String subName, String prototype, + List attributes, BlockNode block, int currentIndex, int sourceEndTokenIndex) { // Now we check if the next token is one of the illegal characters that cannot follow a subroutine. // These are '(', '{', and '['. If any of these follow, we throw a syntax error. LexerToken token = peek(parser); @@ -1815,7 +1817,8 @@ private static SubroutineNode handleAnonSub(Parser parser, String subName, Strin // a compile-time CODE placeholder on the AST; the JVM/interpreter // compiler attaches the executable body to it later. SubroutineNode node = - new SubroutineNode(subName, prototype, attributes, block, false, currentIndex); + new SubroutineNode(subName, prototype, attributes, block, false, currentIndex, + sourceEndTokenIndex); if (attributes != null && hasNonBuiltinCodeAttribute(attributes)) { RuntimeCode placeholder = new RuntimeCode(prototype, new ArrayList<>(attributes)); placeholder.packageName = parser.ctx.symbolTable.getCurrentPackage(); diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/storable/StorableWriter.java b/src/main/java/org/perlonjava/runtime/perlmodule/storable/StorableWriter.java index 398e89df6..aaf1760c5 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/storable/StorableWriter.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/storable/StorableWriter.java @@ -198,29 +198,14 @@ private void dispatchReferent(StorableContext c, RuntimeScalar refScalar) { /** Return the source for this anonymous sub rather than the complete * compilation unit. CompilerOptions retains the unit for diagnostics; * using that whole string made every anonymous sub serialize identically. - * The block offset is the opening brace recorded by EmitSubroutine. */ + * The compiler records the exact token span, so runtime serialization does + * not need to parse Perl's delimiter syntax. */ private static String codeSource(RuntimeCode code) { String source = code.deparseSourceText; int start = code.deparseSourceOffset; - if (source == null || start < 0 || start >= source.length()) return source; - int open = source.indexOf('{', start); - if (open < 0) return source; - int depth = 0; - boolean escaped = false; - char quote = 0; - for (int i = open; i < source.length(); i++) { - char ch = source.charAt(i); - if (quote != 0) { - if (escaped) escaped = false; - else if (ch == '\\') escaped = true; - else if (ch == quote) quote = 0; - continue; - } - if (ch == '\'' || ch == '"') { quote = ch; continue; } - if (ch == '{') depth++; - else if (ch == '}' && --depth == 0) return source.substring(open, i + 1); - } - return source; + int end = code.deparseSourceEnd; + if (source == null || start < 0 || end <= start || start >= source.length()) return source; + return source.substring(start, Math.min(end, source.length())); } /** Mirrors {@code store_hook} (Storable.xs L3574). Returns true if we diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java index d6e2f4bd2..04bdfadb7 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeCode.java @@ -732,6 +732,8 @@ private RuntimeList detachTryExpressionLvalueResult(RuntimeList result, int call public String deparseSourceText; public int deparseFlags; public int deparseSourceOffset = -1; + /** Exclusive source offset for the compiler-recorded subroutine span. */ + public int deparseSourceEnd = -1; public static final int DEPARSE_FLAG_STRICT = 1; public static final int DEPARSE_FLAG_WARNINGS = 2; /** @@ -1041,6 +1043,7 @@ public RuntimeCode cloneForClosure() { clone.deparseSourceText = this.deparseSourceText; clone.deparseFlags = this.deparseFlags; clone.deparseSourceOffset = this.deparseSourceOffset; + clone.deparseSourceEnd = this.deparseSourceEnd; clone.isConstantCv = this.isConstantCv; clone.isStatic = this.isStatic; clone.isDeclared = this.isDeclared; @@ -2677,6 +2680,20 @@ public static RuntimeScalar makeCodeObject( String deparseSourceText, int deparseFlags, int deparseSourceOffset) throws Exception { + return makeCodeObject(codeObject, prototype, packageName, cvStartFile, cvStartLine, + deparseSourceText, deparseFlags, deparseSourceOffset, -1); + } + + public static RuntimeScalar makeCodeObject( + Object codeObject, + String prototype, + String packageName, + String cvStartFile, + int cvStartLine, + String deparseSourceText, + int deparseFlags, + int deparseSourceOffset, + int deparseSourceEnd) throws Exception { // Retrieve the class of the provided code object Class clazz = codeObject.getClass(); @@ -2699,6 +2716,7 @@ public static RuntimeScalar makeCodeObject( code.deparseSourceText = deparseSourceText; code.deparseFlags = deparseFlags; code.deparseSourceOffset = deparseSourceOffset; + code.deparseSourceEnd = deparseSourceEnd; // Look up pad constants registered at compile time for this class. // These track cached string literals referenced via \ inside the sub, diff --git a/src/test/resources/unit/storable_code_deparse.t b/src/test/resources/unit/storable_code_deparse.t index 6f56c380f..19b4b9a9b 100644 --- a/src/test/resources/unit/storable_code_deparse.t +++ b/src/test/resources/unit/storable_code_deparse.t @@ -1,11 +1,28 @@ use strict; use warnings; -use Test::More tests => 2; +use Test::More tests => 4; use Storable qw(freeze); my $code = sub { return 42 }; local $Storable::Deparse = 1; +local $Storable::Eval = 1; my $frozen = eval { freeze($code) }; ok(!$@, 'Storable can freeze a code reference with Deparse enabled'); ok(defined($frozen) && length($frozen), 'the frozen code reference is non-empty'); + +my $delimited = sub { + my $text = q{a{b}}; + return $text; +}; +my $delimited_frozen = eval { freeze($delimited) }; +ok(!$@ && defined($delimited_frozen), + 'compiler span survives quote-like delimiters'); + +my $adjacent = sub { return 1 }; +my $second = sub { return 2 }; +my $adjacent_frozen = eval { freeze($adjacent) }; +my $second_frozen = eval { freeze($second) }; +ok(!$@ && defined($adjacent_frozen) && defined($second_frozen) + && $adjacent_frozen ne $second_frozen, + 'compiler span selects the complete adjacent anonymous subroutine');