Fix jcpan compiler storage and fixed-length reads

dev/tools/perl_test_runner.pl

@@ -86,7 +86,7 @@
 my $total_files = @test_files;
 
 print "Found $total_files test files\n";
-print "Running tests with $jperl_path (${jobs} parallel jobs, ${timeout}s timeout)\n";
+print "Running tests with $jperl_path (${jobs} parallel jobs, ${timeout}s base timeout)\n";
 print "-" x 60, "\n";
 
 # Run tests in parallel
@@ -233,6 +233,13 @@ sub process_test_result {
 sub run_single_test {
     my ($test_file) = @_;
 
+    # lib/croak.t launches a fresh jperl process for each of its 300+ cases.
+    # Under a full parallel run it competes with the other workers and has
+    # repeatedly finished within a second of the normal per-file deadline.
+    # Give this subprocess-heavy test a stable minimum wall-clock allowance
+    # while preserving any larger timeout requested by the caller.
+    my $test_timeout = timeout_for_test($test_file);
+
     # Temporarily disable fatal unimplemented errors
     # so we can run tests that mix implemented and unimplemented features
     local $ENV{JPERL_UNIMPLEMENTED} = $test_file =~ m{
@@ -347,10 +354,10 @@ sub run_single_test {
     my $kill_after = 10;  # seconds between SIGTERM and SIGKILL
     if (!$is_windows) {
         if (system('which timeout >/dev/null 2>&1') == 0) {
-            $timeout_cmd = "timeout -k ${kill_after}s ${timeout}s ";
+            $timeout_cmd = "timeout -k ${kill_after}s ${test_timeout}s ";
         } elsif (system('which gtimeout >/dev/null 2>&1') == 0) {
             # macOS with coreutils
-            $timeout_cmd = "gtimeout -k ${kill_after}s ${timeout}s ";
+            $timeout_cmd = "gtimeout -k ${kill_after}s ${test_timeout}s ";
         }
     }
 
@@ -369,7 +376,7 @@ sub run_single_test {
         # Fallback to alarm-based timeout
         eval {
             local $SIG{ALRM} = sub { die "timeout\n" };
-            alarm($timeout);
+            alarm($test_timeout);
             $output = `$abs_jperl $test_name 2>&1`;
             $exit_code = $? >> 8;
             alarm(0);
@@ -408,6 +415,14 @@ sub run_single_test {
     return $result;
 }
 
+sub timeout_for_test {
+    my ($test_file) = @_;
+
+    return 600 if $test_file =~ m{(?:^|/)perl5_t/t/lib/croak\.t$}
+        && $timeout < 600;
+    return $timeout;
+}
+
 sub start_test_job {
     my ($test_queue, $children, $total_files, $completed) = @_;
 
@@ -708,7 +723,8 @@ sub print_usage {
 
 Options:
   --jperl PATH     Path to jperl executable (default: ./jperl)
-  --timeout SEC    Timeout per test in seconds (default: 3)
+  --timeout SEC    Base timeout per test in seconds (default: 300; selected
+                   subprocess-heavy tests have a documented minimum)
   --jobs|-j NUM    Number of parallel jobs (default: 4)
   --output FILE    Save detailed results to JSON file
   --help           Show this help message

src/main/java/org/perlonjava/frontend/parser/SpecialBlockParser.java

@@ -2,6 +2,7 @@
 
 import org.perlonjava.app.cli.CompilerOptions;
 import org.perlonjava.app.scriptengine.PerlLanguageProvider;
+import org.perlonjava.backend.bytecode.VariableCollectorVisitor;
 import org.perlonjava.backend.jvm.EmitterMethodCreator;
 import org.perlonjava.frontend.astnode.*;
 import org.perlonjava.frontend.lexer.LexerTokenType;
@@ -14,8 +15,10 @@
 import java.util.ArrayDeque;
 import java.util.BitSet;
 import java.util.Deque;
+import java.util.HashSet;
 import java.util.List;
 import java.util.Map;
+import java.util.Set;
 import java.util.Stack;
 
 import static org.perlonjava.runtime.runtimetypes.GlobalContext.GLOBAL_PHASE;
@@ -246,6 +249,10 @@ static RuntimeList runSpecialBlock(Parser parser, String blockPhase, Node block,
 
         // Declare capture variables
         Map<Integer, SymbolTable.SymbolEntry> outerVars = parser.ctx.symbolTable.getAllVisibleVariables();
+        Set<String> usedVars = new HashSet<>();
+        VariableCollectorVisitor collector = new VariableCollectorVisitor(usedVars);
+        block.accept(collector);
+        boolean captureAllVisibleVariables = collector.hasEvalString();
         for (SymbolTable.SymbolEntry entry : outerVars.values()) {
             if (!entry.name().equals("@_") && !entry.decl().isEmpty()) {
                 // Skip lexical subs (entries starting with &) - they are stored as hidden variables
@@ -257,6 +264,9 @@ static RuntimeList runSpecialBlock(Parser parser, String blockPhase, Node block,
                         || "$@%*".indexOf(entry.name().charAt(0)) < 0) {
                     continue;
                 }
+                if (!captureAllVisibleVariables && !usedVars.contains(entry.name())) {
+                    continue;
+                }
 
                 String packageName;
                 boolean isFromOuterScope = false;

src/main/java/org/perlonjava/runtime/operators/Readline.java

@@ -111,9 +111,11 @@ public static RuntimeScalar readline(RuntimeIO runtimeIO) {
             return readParagraphMode(runtimeIO);
         }
 
-        if (rs != null && rs.isRecordLengthMode()) {
+        int recordLength = rs != null && rs.isRecordLengthMode()
+                ? rs.getRecordLength()
+                : recordLengthFromLocalizedSeparator(rsScalar);
+        if (recordLength > 0) {
             // Handle record length mode when $/ = \N
-            int recordLength = rs.getRecordLength();
             return readFixedLength(runtimeIO, recordLength);
         }
 
@@ -135,6 +137,31 @@ public static RuntimeScalar readline(RuntimeIO runtimeIO) {
         }
     }
 
+    /**
+     * A dynamically localized special variable is represented by the saved
+     * global binding rather than by the original InputRecordSeparator
+     * subclass. Preserve Perl's $/ = \N mode across that representation
+     * change.
+     */
+    private static int recordLengthFromLocalizedSeparator(RuntimeScalar separator) {
+        if (separator.type != RuntimeScalarType.REFERENCE
+                || !(separator.value instanceof RuntimeScalar referenced)) {
+            return -1;
+        }
+        if (referenced.type == RuntimeScalarType.INTEGER) {
+            return referenced.getInt();
+        }
+        if (referenced.type == RuntimeScalarType.STRING
+                || referenced.type == RuntimeScalarType.BYTE_STRING) {
+            try {
+                return Integer.parseInt(referenced.toString());
+            } catch (NumberFormatException ignored) {
+                return -1;
+            }
+        }
+        return -1;
+    }
+
     private static RuntimeScalar readParagraphMode(RuntimeIO runtimeIO) {
         boolean isByteMode = runtimeIO.isByteMode();
         StringBuilder paragraph = new StringBuilder();

src/test/resources/unit/eval_begin_lexical_storage.t

@@ -0,0 +1,27 @@
+use strict;
+use warnings;
+use Scalar::Util qw(refaddr);
+use Test::More tests => 6;
+
+my %defaults = (value => 1);
+
+sub make_inside_out_object {
+    my ($class) = @_;
+    my $object = bless \my($anonymous_scalar), $class;
+    my $value = eval '$defaults{value}';
+    die $@ if $@;
+    return ($object, $value);
+}
+
+my ($first, $first_value) = make_inside_out_object('First');
+my ($second, $second_value) = make_inside_out_object('Second');
+
+is $first_value, 1, 'runtime eval sees the enclosing file lexical';
+is $second_value, 1, 'runtime eval keeps working on later calls';
+isnt refaddr($first), refaddr($second), 'referenced my scalar is fresh on each call';
+is ref($first), 'First', 'first object keeps its original class';
+is ref($second), 'Second', 'second object receives its requested class';
+
+$defaults{value} = 2;
+my (undef, $updated_value) = make_inside_out_object('Third');
+is $updated_value, 2, 'runtime eval observes updates without persistent local cells';

src/test/resources/unit/input_record_separator_fixed_length.t

@@ -0,0 +1,23 @@
+use strict;
+use warnings;
+use Test::More tests => 8;
+
+my $data = "abcdef";
+open my $fh, '<', \$data or die $!;
+
+{
+    local $/ = \1;
+    is scalar($fh->getline), 'a', 'localized fixed-length separator reads one character';
+    is tell($fh), 1, 'fixed-length getline advances by one character';
+}
+
+{
+    local $/ = \2;
+    is scalar($fh->getline), 'bc', 'localized fixed-length separator accepts larger records';
+    is tell($fh), 3, 'larger fixed-length getline advances by the record size';
+    is scalar($fh->getline), 'de', 'fixed-length mode remains active for repeated reads';
+    is scalar($fh->getline), 'f', 'final short record is returned';
+    is scalar($fh->getline), undef, 'read after the final record returns undef';
+}
+
+is $/, "\n", 'localized input record separator is restored';

src/test/resources/unit/source_filter_subroutine_lexical_storage.t

@@ -0,0 +1,26 @@
+use strict;
+use warnings;
+use Test::More tests => 5;
+use Scalar::Util qw(refaddr);
+use Filter::Simple;
+
+# A no-op filter is enough to exercise the rewritten-source compiler path.
+FILTER { };
+
+sub make_filtered_inside_out_object {
+    my ($class) = @_;
+    return bless \my($anonymous_scalar), $class;
+}
+
+# Source-filter preprocessing used to leave the subroutine's lexical in the
+# shared symbol table, where later BEGIN blocks classified it as persistent.
+BEGIN { my $compile_time_only = 1 }
+
+my $first = make_filtered_inside_out_object('FilteredFirst');
+my $second = make_filtered_inside_out_object('FilteredSecond');
+
+isnt refaddr($first), refaddr($second), 'filtered sub creates a fresh scalar referent';
+is ref($first), 'FilteredFirst', 'first filtered object keeps its class';
+is ref($second), 'FilteredSecond', 'second filtered object gets its class';
+isnt "$first", "$second", 'filtered objects remain distinct';
+pass 'later BEGIN block does not make a filtered sub lexical persistent';