From 52e78be6e9d253570cc3441c2349dc66630189fd Mon Sep 17 00:00:00 2001 From: Flavio Soibelmann Glock Date: Wed, 4 Feb 2026 18:53:00 +0100 Subject: [PATCH] Remove skip() workarounds - non-local last SKIP now works With block-level dispatcher sharing (PR #161), non-local control flow now works correctly. The skip() function can use 'last SKIP' directly without workarounds. Changes: - Test/More.pm: Replaced skip_internal() with proper skip() that uses last SKIP - TestMoreHelper.java: Removed skip() call rewriting logic - test.pl.patch: Removed skip_internal() workaround from Perl 5 tests Testing: - All 2012 unit tests pass (100%) - Perl 5 tests work correctly with native skip() implementation - Non-local last SKIP exits SKIP block immediately from subroutine This cleanup removes ~100 lines of workaround code that is no longer needed. Co-Authored-By: Claude Opus 4.5 --- dev/import-perl5/patches/test.pl.patch | 41 ++---- .../org/perlonjava/parser/TestMoreHelper.java | 118 +----------------- src/main/perl/lib/Test/More.pm | 15 +-- 3 files changed, 17 insertions(+), 157 deletions(-) diff --git a/dev/import-perl5/patches/test.pl.patch b/dev/import-perl5/patches/test.pl.patch index 5eab8f277..79e2e77a0 100644 --- a/dev/import-perl5/patches/test.pl.patch +++ b/dev/import-perl5/patches/test.pl.patch @@ -4,49 +4,22 @@ +# -------------------------------------------- +# Modified t/test.pl for running Perl test suite with PerlOnJava: +# -+# - added subroutine `skip_internal` to workaround the use of non-local goto (`last SKIP`). -+# - no other changes. ++# - no changes needed: non-local goto (`last SKIP`) now works correctly. ++# - as of 2026-02-04: block-level dispatcher sharing enables proper skip() support. +# -------------------------------------------- + # # t/test.pl - most of Test::More functionality without the fuss - -@@ -587,16 +594,44 @@ - last SKIP; + +@@ -44,7 +51,8 @@ } - -+sub skip_internal { -+ my $why = shift; -+ my $n = @_ ? shift : 1; -+ my $bad_swap; -+ my $both_zero; -+ { -+ local $^W = 0; -+ $bad_swap = $why > 0 && $n == 0; -+ $both_zero = $why == 0 && $n == 0; -+ } -+ if ($bad_swap || $both_zero || @_) { -+ my $arg = "'$why', '$n'"; -+ if (@_) { -+ $arg .= join(", ", '', map { qq['$_'] } @_); -+ } -+ die qq[$0: expected skip(why, count), got skip($arg)\n]; -+ } -+ for (1..$n) { -+ _print "ok $test # skip $why\n"; -+ $test = $test + 1; -+ } -+ local $^W = 0; -+ # last SKIP; -+ 1; -+} -+ + sub skip_if_miniperl { - skip(@_) if is_miniperl(); + ## PerlOnJava is not miniperl + # skip(@_) if is_miniperl(); } - + sub skip_without_dynamic_extension { - my $extension = shift; - skip("no dynamic loading on miniperl, no extension $extension", @_) @@ -60,5 +33,5 @@ + # return if &_have_dynamic_extension($extension); + # skip("extension $extension was not built", @_); } - + sub todo_skip { diff --git a/src/main/java/org/perlonjava/parser/TestMoreHelper.java b/src/main/java/org/perlonjava/parser/TestMoreHelper.java index c38213743..f7d0582c7 100644 --- a/src/main/java/org/perlonjava/parser/TestMoreHelper.java +++ b/src/main/java/org/perlonjava/parser/TestMoreHelper.java @@ -1,122 +1,16 @@ package org.perlonjava.parser; import org.perlonjava.astnode.*; -import org.perlonjava.runtime.GlobalVariable; -import org.perlonjava.runtime.NameNormalizer; - -import java.util.List; public class TestMoreHelper { // Use a macro to emulate Test::More SKIP blocks static void handleSkipTest(Parser parser, BlockNode block) { - // Locate and rewrite skip() calls inside SKIP: { ... } blocks. - // This must be robust because in perl5 tests skip() is often nested under - // boolean operators/modifiers (e.g. `eval {...} or skip "...", 2;`). - for (Node node : block.elements) { - handleSkipTestNode(parser, node); - } - } - - private static void handleSkipTestNode(Parser parser, Node node) { - if (node == null) { - return; - } - - if (node instanceof BinaryOperatorNode binop) { - // Recurse first so we don't miss nested skip calls. - handleSkipTestNode(parser, binop.left); - handleSkipTestNode(parser, binop.right); - - // Also try to rewrite this node itself if it's a call. - handleSkipTestInner(parser, binop); - return; - } - - if (node instanceof OperatorNode op) { - handleSkipTestNode(parser, op.operand); - return; - } - - if (node instanceof ListNode list) { - for (Node elem : list.elements) { - handleSkipTestNode(parser, elem); - } - return; - } - - if (node instanceof BlockNode block) { - for (Node elem : block.elements) { - handleSkipTestNode(parser, elem); - } - return; - } - - if (node instanceof For3Node for3) { - handleSkipTestNode(parser, for3.initialization); - handleSkipTestNode(parser, for3.condition); - handleSkipTestNode(parser, for3.increment); - handleSkipTestNode(parser, for3.body); - handleSkipTestNode(parser, for3.continueBlock); - return; - } - - if (node instanceof For1Node for1) { - handleSkipTestNode(parser, for1.variable); - handleSkipTestNode(parser, for1.list); - handleSkipTestNode(parser, for1.body); - return; - } - - if (node instanceof IfNode ifNode) { - handleSkipTestNode(parser, ifNode.condition); - handleSkipTestNode(parser, ifNode.thenBranch); - handleSkipTestNode(parser, ifNode.elseBranch); - return; - } - - if (node instanceof TryNode tryNode) { - handleSkipTestNode(parser, tryNode.tryBlock); - handleSkipTestNode(parser, tryNode.catchBlock); - handleSkipTestNode(parser, tryNode.finallyBlock); - } - } - - private static void handleSkipTestInner(Parser parser, BinaryOperatorNode op) { - if (op.operator.equals("(")) { - int index = op.tokenIndex; - IdentifierNode subName = null; - if (op.left instanceof OperatorNode sub - && sub.operator.equals("&") - && sub.operand instanceof IdentifierNode subId - && subId.name.equals("skip")) { - subName = subId; - } else if (op.left instanceof IdentifierNode subId && subId.name.equals("skip")) { - subName = subId; - } - - if (subName != null) { - // skip() call - // op.right contains the arguments - - // Becomes: `skip_internal(...) && last SKIP` if available, otherwise `skip(...) && last SKIP`. - // This is critical for perl5 tests that rely on Test::More-style SKIP blocks. - // We cannot rely on non-local `last SKIP` propagation through subroutine returns, - // so we force the `last SKIP` to execute in the caller's scope. - String fullName = NameNormalizer.normalizeVariableName(subName.name + "_internal", parser.ctx.symbolTable.getCurrentPackage()); - if (GlobalVariable.existsGlobalCodeRef(fullName)) { - subName.name = fullName; - } - - // Ensure the `last SKIP` runs regardless of the return value of skip(). - BinaryOperatorNode skipCall = new BinaryOperatorNode("(", op.left, op.right, index); - BinaryOperatorNode skipCallOrTrue = new BinaryOperatorNode("||", skipCall, new NumberNode("1", index), index); - - op.operator = "&&"; - op.left = skipCallOrTrue; - op.right = new OperatorNode("last", - new ListNode(List.of(new IdentifierNode("SKIP", index)), index), index); - } - } + // As of 2026-02-04: Non-local control flow (last SKIP) now works correctly + // with block-level dispatcher sharing. The skip() function in Test::More.pm + // can now use 'last SKIP' directly without workarounds. + // + // This method is kept for potential future SKIP block handling needs, + // but the skip() call rewriting is no longer necessary. } } diff --git a/src/main/perl/lib/Test/More.pm b/src/main/perl/lib/Test/More.pm index 6ef2e2be9..9ff1ae153 100644 --- a/src/main/perl/lib/Test/More.pm +++ b/src/main/perl/lib/Test/More.pm @@ -16,7 +16,6 @@ our @EXPORT = qw( pass fail diag note done_testing is_deeply subtest use_ok require_ok BAIL_OUT skip - skip_internal eq_array eq_hash eq_set ); @@ -287,20 +286,14 @@ sub BAIL_OUT { } sub skip { - die "Test::More::skip() is not implemented"; -} - -# Workaround to avoid non-local goto (last SKIP). -# The skip_internal subroutine is called from a macro in TestMoreHelper.java -# -sub skip_internal { my ($name, $count) = @_; + $count ||= 1; for (1..$count) { $Test_Count++; - my $result = "ok"; - print "$Test_Indent$result $Test_Count # skip $name\n"; + print "${Test_Indent}ok $Test_Count # skip $name\n"; } - return 1; + # Use non-local control flow to exit the SKIP block + last SKIP; } # Legacy comparison functions - simple implementations using is_deeply