Fix failures in the top 200 core tests

dev/tools/perl_test_runner.pl

@@ -181,6 +181,12 @@ sub reject_duplicate_long_options {
     }
 }
 
+sub shell_quote {
+    my ($value) = @_;
+    $value =~ s/'/'"'"'/g;
+    return "'$value'";
+}
+
 sub find_test_files {
     my ($dir) = @_;
     my @files;
@@ -477,7 +483,8 @@ sub run_single_test {
           re/pat.t
         | op/repeat.t
         | op/list.t
-        | op/recurse.t }x
+        | op/recurse.t
+        | op/cond.t }x
         ? "-Xss256m" : "";
 
     # Skip memory-intensive tests (e.g., Long Monsters in re/pat.t with 300KB strings)
@@ -538,7 +545,7 @@ sub run_single_test {
     my $test_name;
     my $test_launcher = $abs_jperl;
     if ($^O ne 'MSWin32' && $^O ne 'cygwin' && $^O ne 'msys'
-            && $test_file =~ m{(?:^|/)perl5_t/t/(?:japh/abigail|op/magic|run/fresh_perl)\.t$}) {
+            && $test_file =~ m{(?:^|/)perl5_t/t/(?:japh/abigail|op/(?:magic|taint)|run/fresh_perl)\.t$}) {
         my $source_test_dir = File::Spec->rel2abs('perl5_t/t', $old_dir);
         my $source_lib_dir = File::Spec->rel2abs('perl5_t/lib', $old_dir);
         $private_test_root = tempdir('perlonjava-core-XXXXXX', TMPDIR => 1, CLEANUP => 1);
@@ -597,6 +604,7 @@ sub run_single_test {
         }
         $local_test_dir = $private_test_dir;
         $test_name = $test_file =~ m{/op/magic\.t$} ? 'op/magic.t'
+                   : $test_file =~ m{/op/taint\.t$} ? 'op/taint.t'
                    : $test_file =~ m{/run/fresh_perl\.t$} ? 'run/fresh_perl.t'
                    : 'japh/abigail.t';
         # Run through the private ./perl name so Perl's $^X matches the
@@ -607,6 +615,24 @@ sub run_single_test {
     chdir($local_test_dir) if $local_test_dir && -d $local_test_dir;
     $test_name //= File::Spec->abs2rel($test_file, $local_test_dir || '.');
 
+    # stat.t checks -t and opens /dev/tty. The isolated runner session has no
+    # controlling terminal, so run this test under script's pseudo-terminal.
+    my @test_command = ($test_launcher, $test_name);
+    if ($test_file =~ m{(?:^|/)perl5_t/t/op/stat\.t$}
+            && $^O ne 'MSWin32' && $^O ne 'cygwin' && $^O ne 'msys') {
+        my ($script) = grep { -x $_ }
+            map { File::Spec->catfile($_, 'script') } File::Spec->path;
+        if (defined $script) {
+            if ($^O eq 'darwin' || $^O eq 'freebsd'
+                    || $^O eq 'openbsd' || $^O eq 'netbsd') {
+                @test_command = ($script, '-q', File::Spec->devnull(), $abs_jperl, $test_name);
+            } else {
+                my $command = join ' ', map { shell_quote($_) } ($abs_jperl, $test_name);
+                @test_command = ($script, '-q', '-c', $command, File::Spec->devnull());
+            }
+        }
+    }
+
     # Try to use system timeout command if available.
     # Use --kill-after (-k) so a SIGTERM that the JVM ignores is followed
     # by SIGKILL after a grace period; otherwise wedged jperl processes
@@ -654,7 +680,7 @@ sub run_single_test {
             exec {
                 $timeout_program
             } $timeout_program, '--foreground', '-k', "${kill_after}s",
-                "${test_timeout}s", $test_launcher, $test_name;
+                "${test_timeout}s", @test_command;
             die "Cannot execute $timeout_program: $!";
         }
 
@@ -682,7 +708,7 @@ sub run_single_test {
         $output_captured = 1;
     } else {
         # Fallback to alarm-based timeout
-        my $cmd = join(' ', $test_launcher, $test_name)
+        my $cmd = join(' ', map { shell_quote($_) } @test_command)
             . " < $devnull 2>&1";
         eval {
             local $SIG{ALRM} = sub { die "timeout\n" };

docs/about/changelog.md

@@ -6,6 +6,55 @@ priorities and future plans.
 
 ## Work in progress
 
+- Keep format captures bound to their active lexical cell and prevent reuse of unrelated active lexicals.
+- Match Perl's reference count for the compile-time `%^H` hash.
+- Run deeply nested conditional core tests with an adequate JVM stack.
+- Preserve captured lexical aliases in nested eval `BEGIN` blocks.
+- Preserve lexical sub references passed through the debugger's `DB::goto` hook.
+- Resolve POSIX group records and retain supplementary IDs in `$(` and `$)`.
+- Identify the runtime operating system in `Config::Config{myuname}`.
+- Default bare `-t` file tests to `STDIN`.
+- Inherit terminal `STDIN` in subprocesses launched by `system` and `qx`.
+- Preserve setuid and setgid permission bits after in-place file editing.
+- Provide a controlling pseudo-terminal for Perl core tests that require one.
+- Supply the PerlOnJava launcher for core tests that spawn `./perl`.
+- Keep `close` and `fileno` probes from creating nonexistent symbolic filehandles.
+- Preserve typeglob values from scalar assignments and selected-handle lookups.
+- Return EOF as undef from scalar-backed `getc`, and let argumentless `system()` wait.
+- Resolve scalar pipe names as symbolic handles and reuse descriptor 0 after
+  closing STDIN.
+- Reject splice on read-only arrays and negative tied-array `FETCHSIZE` values.
+- Reset array `each` iterators when replacing their contents.
+- Fetch tied scalars during `study` and return `crypt` results without the
+  UTF-8 flag.
+- Report disabled `evalbytes` as a syntax error.
+- Warn when inserting new keys into a hash during an active `each` traversal.
+- Return the final expression from parenthesized lists in scalar context.
+- Warn about bareword exponent suffixes following numeric literals.
+- Preserve the empty string yielded by a range with two undefined endpoints.
+- Avoid materializing values from empty list assignments in void context.
+- Preserve omitted optional underscore prototype arguments after required arguments.
+- Parse comma-delimited `q` and `qq` strings when disambiguating hashrefs from blocks.
+- Clear `pos()` after a failed second match of a global match-once pattern.
+- Validate typed hash dereferences against explicitly referenced `%FIELDS` tables.
+- Warn about anonymous subroutines in void context and undef dynamic code references in place.
+- Report explicitly referenced stash-backed subroutines as anonymous after deletion while preserving ordinary deleted CV names in `caller()`.
+- Detect oversized repetition counts before they wrap during conversion.
+- Run eval-block destructors before clearing `$@`, and report `ENOENT` from failed `rmdir` calls.
+- Preserve `sprintf` numeric overload counts and format-string UTF-8 flags.
+- Format infinities and NaNs with Perl's spelling across numeric `sprintf` conversions.
+- Preserve runtime list context through short-circuit and ternary branches in empty-list assignments.
+- Restore `EAGAIN` after alarm interrupts `sleep`, even when a signal handler changes `$!`.
+- Preserve Unicode `-s` arguments when a core test launches a nested interpreter through the shell.
+- Preserve non-ASCII byte arguments in unquoted shell commands and nested
+  PerlOnJava launches under C locales and through Windows command shells.
+- Apply Unicode character classes to interpolated Unicode regex patterns.
+- Preserve combining-mark order in Unicode uppercase mappings and honor byte-string method names in `can`.
+- Reject scalar constants passed to hash-reference prototypes with the expected diagnostic.
+- Preserve malformed octets read through Perl's `:utf8` layer while decoding valid UTF-8.
+- Keep `$^X` unflagged for shell command construction and preserve encoded input octets.
+- Evaluate `readline` in list context when an empty-target assignment discards its results.
+
 - Prevent stale CPAN archive-name entries and namespace-resolution errors from
   being recorded as compatibility regressions.
 

jperl

@@ -119,4 +119,40 @@ if [ -n "$CLASSPATH" ]; then
 else
     CP="$PERLONJAVA_CP"
 fi
+
+# On POSIX systems a JVM started under the C locale cannot faithfully decode
+# non-ASCII process arguments. Perl still treats argv as bytes, so preserve
+# non-ASCII arguments as ASCII hex while crossing the native/JVM boundary;
+# Main restores their byte values before parsing the Perl command line.
+ARGV_LOCALE="${LC_ALL:-${LC_CTYPE:-${LANG:-}}}"
+case "$ARGV_LOCALE" in
+    C|POSIX)
+        ARGV_NEEDS_RESTORE=0
+        ARGV_REPLACED=()
+        for ARGV_ITEM in "$@"; do
+            ARGV_HEX=""
+            ARGV_HAS_HIGH_BYTE=0
+            for ((ARGV_INDEX = 0; ARGV_INDEX < ${#ARGV_ITEM}; ARGV_INDEX++)); do
+                ARGV_CHARACTER="${ARGV_ITEM:ARGV_INDEX:1}"
+                printf -v ARGV_BYTE_VALUE '%d' "'$ARGV_CHARACTER"
+                ARGV_BYTE_VALUE=$((ARGV_BYTE_VALUE & 255))
+                printf -v ARGV_BYTE_HEX '%02x' "$ARGV_BYTE_VALUE"
+                ARGV_HEX+="$ARGV_BYTE_HEX"
+                if (( 16#$ARGV_BYTE_HEX >= 128 )); then
+                    ARGV_HAS_HIGH_BYTE=1
+                fi
+            done
+            if [ "$ARGV_HAS_HIGH_BYTE" -eq 1 ]; then
+                ARGV_REPLACED+=("__PERLONJAVA_RAWARG_HEX__$ARGV_HEX")
+                ARGV_NEEDS_RESTORE=1
+            else
+                ARGV_REPLACED+=("$ARGV_ITEM")
+            fi
+        done
+        if [ "$ARGV_NEEDS_RESTORE" -eq 1 ]; then
+            set -- "${ARGV_REPLACED[@]}"
+            JVM_OPTS="$JVM_OPTS -Dperlonjava.rawargv.hex=true"
+        fi
+        ;;
+esac
 exec "$JAVA_BIN" $JVM_OPTS ${JPERL_OPTS} -cp "$CP" org.perlonjava.app.cli.Main "$@"

jperl.bat

@@ -23,7 +23,7 @@ rem   for native system calls (file operations, process management).
 rem Perl call frames currently use the Java stack.  Keep enough stack for
 rem ecosystem recursion guards such as Catalyst's default 1000-call limit.
 rem A later -Xss value in JPERL_OPTS overrides this default.
-set JVM_OPTS=-Xss16m --enable-native-access=ALL-UNNAMED
+set JVM_OPTS=-Xss16m --enable-native-access=ALL-UNNAMED -Dperlonjava.rawargv.hex=true
 
 rem Note on JVM heap settings: do NOT set -XX:SoftMaxHeapSize below -Xmx.
 rem That combination triggers an aggressive G1 GC cadence that interacts

src/main/java/org/perlonjava/app/cli/Main.java

@@ -21,6 +21,9 @@
  */
 public class Main {
 
+    private static final String RAW_ARG_HEX_PREFIX = "__PERLONJAVA_RAWARG_HEX__";
+    private static final String RAW_BYTE_HEX_PREFIX = "__PERLONJAVA_RAWBYTE_HEX__";
+
     static {
         // Set default locale to US (uses dot as decimal separator)
         Locale.setDefault(Locale.US);
@@ -91,13 +94,57 @@ private static void startOrphanWatchdog() {
      * @param args Command-line arguments.
      */
     public static void main(String[] args) {
+        restoreRawByteArguments(args);
         PerlRuntime runtime = new PerlRuntime();
         installThreadExitDiagnostic(runtime);
         try (PerlRuntime.Binding runtimeBinding = runtime.bind()) {
             run(args);
         }
     }
 
+    private static void restoreRawByteArguments(String[] args) {
+        if (!Boolean.getBoolean("perlonjava.rawargv.hex")) {
+            return;
+        }
+        for (int i = 0; i < args.length; i++) {
+            if (args[i].startsWith(RAW_ARG_HEX_PREFIX)) {
+                String encoded = args[i].substring(RAW_ARG_HEX_PREFIX.length());
+                byte[] bytes = java.util.HexFormat.of().parseHex(encoded);
+                args[i] = new String(bytes, java.nio.charset.StandardCharsets.ISO_8859_1);
+            } else if (args[i].contains(RAW_BYTE_HEX_PREFIX)) {
+                args[i] = restoreEmbeddedRawBytes(args[i]);
+            }
+        }
+    }
+
+    private static String restoreEmbeddedRawBytes(String argument) {
+        StringBuilder restored = new StringBuilder(argument.length());
+        for (int index = 0; index < argument.length();) {
+            int marker = argument.indexOf(RAW_BYTE_HEX_PREFIX, index);
+            if (marker < 0) {
+                restored.append(argument, index, argument.length());
+                break;
+            }
+            restored.append(argument, index, marker);
+            int hexStart = marker + RAW_BYTE_HEX_PREFIX.length();
+            if (hexStart + 2 > argument.length()) {
+                restored.append(RAW_BYTE_HEX_PREFIX);
+                index = hexStart;
+                continue;
+            }
+            int high = Character.digit(argument.charAt(hexStart), 16);
+            int low = Character.digit(argument.charAt(hexStart + 1), 16);
+            if (high < 0 || low < 0) {
+                restored.append(RAW_BYTE_HEX_PREFIX);
+                index = hexStart;
+                continue;
+            }
+            restored.append((char) ((high << 4) | low));
+            index = hexStart + 2;
+        }
+        return restored.toString();
+    }
+
     private static void installThreadExitDiagnostic(PerlRuntime runtime) {
         Thread hook = Thread.ofPlatform().name("perlonjava-thread-exit-diagnostic")
                 .unstarted(() -> {

src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java

@@ -2078,7 +2078,12 @@ public void visit(BlockNode node) {
             boolean isLastStatement = (i == lastMeaningfulIndex);
             int stmtTarget = (isLastStatement && outerResultReg >= 0) ? outerResultReg : -1;
             int stmtContext;
-            if (!isLastStatement && !(stmt instanceof BinaryOperatorNode && ((BinaryOperatorNode) stmt).operator.equals("="))) {
+            boolean emptyListAssignment = stmt instanceof BinaryOperatorNode assignment
+                    && assignment.operator.equals("=")
+                    && assignment.left instanceof ListNode targets
+                    && targets.elements.isEmpty();
+            if (!isLastStatement && (!(stmt instanceof BinaryOperatorNode assignment
+                    && assignment.operator.equals("=")) || emptyListAssignment)) {
                 stmtContext = RuntimeContextType.VOID;
             } else {
                 stmtContext = isLastStatement && node.getBooleanAnnotation("subroutineIsLvalue")
@@ -3906,6 +3911,13 @@ void compileVariableDeclaration(OperatorNode node, String op) {
                     }
                     emit(Opcodes.REGISTER_MY_VAR);
                     emitReg(reg);
+                    if (sigil.equals("$")) {
+                        // Keep the active CV pad visible to deferred format
+                        // argument evaluation. Format declarations can occur
+                        // after a write in the source while Perl still binds
+                        // the format to this invocation's lexical cell.
+                        emitActiveLexicalBinding(reg, varName);
+                    }
 
                     // Runtime attribute dispatch for my variables with attributes
                     emitVarAttrsIfNeeded(node, reg, sigil);
@@ -4325,6 +4337,9 @@ void compileVariableDeclaration(OperatorNode node, String op) {
 
                                 emit(Opcodes.REGISTER_MY_VAR);
                                 emitReg(reg);
+                                if (sigil.equals("$")) {
+                                    emitActiveLexicalBinding(reg, varName);
+                                }
 
                                 // Runtime attribute dispatch for list variable declarations.
                                 // Attributes are stored on the parent my/state node, propagate to each element.
@@ -6322,7 +6337,9 @@ void compileVariableReference(OperatorNode node, String op) {
                 emitReg(rd);
                 emit(constIdx);
                 lastResultReg = rd;
-            } else if (node.operand instanceof BlockNode || node.operand instanceof OperatorNode) {
+            } else if (node.operand instanceof BlockNode
+                    || node.operand instanceof OperatorNode
+                    || node.operand instanceof BinaryOperatorNode) {
                 // Dynamic code reference: &{$name} or &$name
                 // Compile the expression to get the name/value, then dereference as code
                 compileNode(node.operand, -1, RuntimeContextType.SCALAR);
@@ -9093,6 +9110,9 @@ public void visit(FormatNode node) {
         // executes, before a later write() can look it up.
         RuntimeFormat format = new RuntimeFormat(node.formatName);
         format.setCompiledLines(node.templateLines);
+        if (node.getAnnotation("formatDeclaringSubroutine") instanceof String subroutine) {
+            format.setLexicalDeclaringSubroutine(subroutine);
+        }
         emit(Opcodes.REGISTER_FORMAT);
         emit(addToConstantPool(format));
         Map<String, Integer> visible = symbolTable.getVisibleVariableRegistry();
@@ -9181,6 +9201,17 @@ public void visit(ListNode node) {
             return;
         }
 
+        if (currentCallContext == RuntimeContextType.VOID
+                && node.getBooleanAnnotation("emptyTargetAssignmentVoidRhs")) {
+            for (Node element : node.elements) {
+                int elementContext = RegexUsageDetector.containsRegexOperation(element)
+                        ? RuntimeContextType.LIST : RuntimeContextType.VOID;
+                compileNode(element, -1, elementContext);
+            }
+            lastResultReg = -1;
+            return;
+        }
+
         int elementContext = switch (currentCallContext) {
             case RuntimeContextType.RUNTIME -> RuntimeContextType.RUNTIME;
             case RuntimeContextType.LVALUE_LIST -> RuntimeContextType.LVALUE_LIST;

src/main/java/org/perlonjava/backend/bytecode/BytecodeInterpreter.java

@@ -942,11 +942,13 @@ private static RuntimeList execute(SuspendedInterpreterFrame frame) {
                                 // RuntimeFormat object rather than replacing it.
                                 RuntimeFormat target = GlobalVariable.getGlobalFormatRef(format.formatName);
                                 target.replaceDefinition(format);
+                                target.setLexicalDeclaringCode(RuntimeCode.getActiveCodeAt(0));
                                 int captureCount = bytecode[pc++];
                                 for (int capture = 0; capture < captureCount; capture++) {
                                     String name = code.stringPool[bytecode[pc++]];
                                     RuntimeBase value = registers[bytecode[pc++]];
                                     target.bindLexicalVariable(name, value);
+                                    RuntimeCode.registerCurrentActiveLexical(name, value);
                                 }
                             }
 
@@ -2614,6 +2616,15 @@ private static RuntimeList execute(SuspendedInterpreterFrame frame) {
                                 pc = InlineOpcodeHandler.executeStoreGlob(bytecode, pc, registers);
                             }
 
+                            case Opcodes.GLOB_ASSIGNMENT_RESULT -> {
+                                int rd = bytecode[pc++];
+                                int globReg = bytecode[pc++];
+                                int valueReg = bytecode[pc++];
+                                registers[rd] = RuntimeGlob.scalarAssignmentResult(
+                                        (RuntimeGlob) registers[globReg],
+                                        (RuntimeScalar) registers[valueReg]);
+                            }
+
                             case Opcodes.OPEN -> {
                                 // Open file: rd = IOOperator.open(ctx, args...)
                                 // Format: OPEN rd ctx argsReg