fix: honor Storable Deparse for code references

src/main/java/org/perlonjava/backend/jvm/EmitSubroutine.java

@@ -255,8 +255,16 @@ 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());
+            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) {
@@ -332,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

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<String> attributes, No
         }
     }
 
+    public SubroutineNode(String name, String prototype, List<String> 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

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<String> attrs, Parser p
         throw new PerlCompilerException(parser.tokenIndex, attrMsg, parser.ctx.errorUtil);
     }
 
-    private static SubroutineNode handleAnonSub(Parser parser, String subName, String prototype, List<String> attributes, BlockNode block, int currentIndex) {
+    private static SubroutineNode handleAnonSub(Parser parser, String subName, String prototype,
+            List<String> 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();

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,19 @@ 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 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;
+        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
      *  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

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,

src/test/resources/unit/storable_code_deparse.t

@@ -0,0 +1,28 @@
+use strict;
+use warnings;
+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');