diff --git a/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java b/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java index 94d8bb971..06f032a2e 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java +++ b/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java @@ -1189,6 +1189,11 @@ public void visit(BlockNode node) { Node elem = node.elements.get(i); if (elem == null) continue; if (elem instanceof ListNode ln && ln.elements.isEmpty()) continue; + // Pragma flag nodes and format declarations adjust compile-time state + // but do not contribute a do/require return value (matches Perl 5: + // use/no run as BEGIN; their CompilerFlagNode epilogue is not the + // file's last runtime expression). + if (elem instanceof CompilerFlagNode || elem instanceof FormatNode) continue; if (elem instanceof AbstractNode an && (an.getBooleanAnnotation("compileTimeOnly") || an.getBooleanAnnotation("noReturnValue"))) continue; lastMeaningfulIndex = i; break; @@ -6356,8 +6361,6 @@ public void visit(CompilerFlagNode node) { // Update per-call-site $^H and %^H for caller()[8] and caller()[10] WarningBitsRegistry.setCallSiteHints(node.getStrictOptions()); WarningBitsRegistry.snapshotCurrentHintHash(); - - lastResultReg = -1; } @Override @@ -6365,7 +6368,6 @@ public void visit(FormatNode node) { // Format declarations are handled at the JVM compilation stage. // When the interpreter backend processes the AST, formats are already // registered, so this is a no-op. - lastResultReg = -1; } @Override diff --git a/src/main/java/org/perlonjava/backend/bytecode/CompileOperator.java b/src/main/java/org/perlonjava/backend/bytecode/CompileOperator.java index 81c528db6..f7ded8410 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/CompileOperator.java +++ b/src/main/java/org/perlonjava/backend/bytecode/CompileOperator.java @@ -1040,11 +1040,13 @@ public static void visitOperator(BytecodeCompiler bytecodeCompiler, OperatorNode } java.util.List hashIdxs = bytecodeCompiler.symbolTable.getMyHashIndicesInScope(0); for (int idx : hashIdxs) { + if (idx == exprReg) continue; bytecodeCompiler.emit(Opcodes.SCOPE_EXIT_CLEANUP_HASH); bytecodeCompiler.emitReg(idx); } java.util.List arrayIdxs = bytecodeCompiler.symbolTable.getMyArrayIndicesInScope(0); for (int idx : arrayIdxs) { + if (idx == exprReg) continue; bytecodeCompiler.emit(Opcodes.SCOPE_EXIT_CLEANUP_ARRAY); bytecodeCompiler.emitReg(idx); } diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitBlock.java b/src/main/java/org/perlonjava/backend/jvm/EmitBlock.java index 1b8fe6a97..70a21b303 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitBlock.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitBlock.java @@ -225,7 +225,10 @@ public static void emitBlock(EmitterVisitor emitterVisitor, BlockNode node) { int lastNonNullIndex = -1; for (int i = list.size() - 1; i >= 0; i--) { Node elem = list.get(i); - if (elem != null && !(elem instanceof AbstractNode ab && (ab.getBooleanAnnotation("compileTimeOnly") || ab.getBooleanAnnotation("noReturnValue")))) { + if (elem != null + && !(elem instanceof CompilerFlagNode) + && !(elem instanceof FormatNode) + && !(elem instanceof AbstractNode ab && (ab.getBooleanAnnotation("compileTimeOnly") || ab.getBooleanAnnotation("noReturnValue")))) { lastNonNullIndex = i; break; } diff --git a/src/main/java/org/perlonjava/runtime/operators/ModuleOperators.java b/src/main/java/org/perlonjava/runtime/operators/ModuleOperators.java index 8d420e9f4..c33a6d2c4 100644 --- a/src/main/java/org/perlonjava/runtime/operators/ModuleOperators.java +++ b/src/main/java/org/perlonjava/runtime/operators/ModuleOperators.java @@ -873,7 +873,6 @@ public static RuntimeScalar require(RuntimeScalar runtimeScalar) { String message; if (err.isEmpty() && ioErr.isEmpty()) { // File executed but returned undef - // For non-moduleTrue, undef means failure message = fileName + " did not return a true value"; throw new PerlCompilerException(message); } else if (err.isEmpty()) { @@ -920,7 +919,6 @@ public static RuntimeScalar require(RuntimeScalar runtimeScalar) { // Check if the result is false (0 or empty string but not undef) if (!result.getBoolean()) { - // False values cause failure in require String message = fileName + " did not return a true value"; // Remove from %INC since it didn't return true incHash.elements.remove(fileName); diff --git a/src/main/java/org/perlonjava/runtime/regex/RegexPreprocessorHelper.java b/src/main/java/org/perlonjava/runtime/regex/RegexPreprocessorHelper.java index 2c0755f9b..63338eeb0 100644 --- a/src/main/java/org/perlonjava/runtime/regex/RegexPreprocessorHelper.java +++ b/src/main/java/org/perlonjava/runtime/regex/RegexPreprocessorHelper.java @@ -516,6 +516,14 @@ static int handleEscapeSequences(String s, StringBuilder sb, int c, int offset, sb.append(String.format("x{%X}", hexVal)); offset = pos - 1; // -1 because caller will increment } + } else if (c2 == 'e') { + // Perl \e is ESC (0x1B); Java regex has no \e alias + sb.setLength(sb.length() - 1); + sb.append("\\x1B"); + } else if (c2 == 'a') { + // Perl \a is BEL (0x07) + sb.setLength(sb.length() - 1); + sb.append("\\x07"); } else { // Other escape sequences, pass through sb.append(Character.toChars(c2)); diff --git a/src/main/java/org/perlonjava/runtime/regex/RuntimeRegex.java b/src/main/java/org/perlonjava/runtime/regex/RuntimeRegex.java index 2b6c4b162..7e39af73f 100644 --- a/src/main/java/org/perlonjava/runtime/regex/RuntimeRegex.java +++ b/src/main/java/org/perlonjava/runtime/regex/RuntimeRegex.java @@ -559,7 +559,7 @@ private static boolean hasTopLevelAlternation(String pattern) { private static boolean isEscapedRequiredLiteral(char ch) { return switch (ch) { case 'A', 'B', 'C', 'D', 'G', 'H', 'K', 'N', 'P', 'R', 'S', 'V', 'W', 'X', 'Z', - 'b', 'c', 'd', 'g', 'h', 'k', 'n', 'o', 'p', 'r', 's', 't', 'v', 'w', 'x', 'z', + 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'k', 'n', 'o', 'p', 'r', 's', 't', 'v', 'w', 'x', 'z', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9' -> false; default -> true; }; diff --git a/src/test/resources/unit/eval_return_hash.t b/src/test/resources/unit/eval_return_hash.t new file mode 100644 index 000000000..17d6dcaf5 --- /dev/null +++ b/src/test/resources/unit/eval_return_hash.t @@ -0,0 +1,32 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +# Regression: eval STRING subs must return flattened my-hash values. +# Params::ValidationCompiler (DateTime stack) depends on this. + +{ + my $code = eval q{ + sub { + my %args; + if (@_ % 2 == 0) { %args = @_; } + return %args; + } + }; + ok($code, 'eval_closure-style sub compiles'); + + my %got = $code->(name => 'foo'); + is($got{name}, 'foo', 'eval sub returns hash pairs from return %hash'); + + $code = eval q{ + sub { + my %args = (name => 'bar'); + return %args; + } + }; + %got = $code->(); + is($got{name}, 'bar', 'eval sub returns preset hash via return %hash'); +} + +done_testing(); diff --git a/src/test/resources/unit/regex/regex_escape_e.t b/src/test/resources/unit/regex/regex_escape_e.t new file mode 100644 index 000000000..027a075e3 --- /dev/null +++ b/src/test/resources/unit/regex/regex_escape_e.t @@ -0,0 +1,15 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +# Regression: Perl regex \e must match ESC (0x1B). Text::ANSI::Util uses \e\[[0-9;]+m. + +my $esc = "\e"; +ok($esc =~ /\e/, 'm// matches ESC via \\e'); +ok($esc =~ qr/\e/, 'qr// matches ESC via \\e'); + +my $ansi_reset = "\e[0m"; +ok($ansi_reset =~ /\e\[[0-9;]+m/, 'ANSI SGR reset matches common detection regex'); + +done_testing(); diff --git a/src/test/resources/unit/require_module_return.t b/src/test/resources/unit/require_module_return.t new file mode 100644 index 000000000..718dac3c0 --- /dev/null +++ b/src/test/resources/unit/require_module_return.t @@ -0,0 +1,62 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use File::Temp qw(tempdir); +use File::Spec; + +# Regression: do/require return the last *runtime* statement value. +# use/no pragmas and sub declarations are compile-time and must not +# clobber an earlier runtime assignment such as our $VERSION = '...'. + +my $dir = tempdir(CLEANUP => 1); +require File::Basename; +require File::Path; + +sub write_mod { + my ($name, $body) = @_; + my $path = File::Spec->catfile($dir, split m{::}, $name) . '.pm'; + File::Path::make_path(File::Basename::dirname($path)); + open my $fh, '>', $path or die $!; + print {$fh} $body; + close $fh; + return $path; +} + +{ + my $path = write_mod('Ok::Mod', <<'PM'); +package Ok::Mod; +our $VERSION = '9.87'; +use strict; +use warnings; +sub foo {} +PM + { + local @INC = ($dir, @INC); + my $inc_key = 'Ok/Mod.pm'; + delete $INC{$inc_key}; + my $do = do $path; + is($do, '9.87', 'do returns last runtime assignment'); + delete $INC{$inc_key}; + my $req = eval { require Ok::Mod; 1 }; + is($req, 1, 'require succeeds without trailing 1;'); + is($Ok::Mod::VERSION, '9.87', 'package version preserved'); + } +} + +{ + my $path = write_mod('Bad::Mod', <<'PM'); +package Bad::Mod; +our $VERSION = '1.0'; +0; +PM + { + local @INC = ($dir, @INC); + delete $INC{'Bad/Mod.pm'}; + my $ok = eval { require Bad::Mod; 1 }; + ok(!$ok, 'explicit false last statement still fails require'); + like($@, qr/did not return a true value/, 'expected require error'); + } +} + +done_testing();