Skip to content

Remove skip() workarounds - non-local last SKIP now works #162

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
fglock merged 1 commit into from
Feb 4, 2026
Merged

Remove skip() workarounds - non-local last SKIP now works #162

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
41 changes: 7 additions & 34 deletions dev/import-perl5/patches/test.pl.patch
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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", @_)
Expand All @@ -60,5 +33,5 @@
+ # return if &_have_dynamic_extension($extension);
+ # skip("extension $extension was not built", @_);
}

sub todo_skip {
118 changes: 6 additions & 112 deletions src/main/java/org/perlonjava/parser/TestMoreHelper.java
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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.
}
}
15 changes: 4 additions & 11 deletions src/main/perl/lib/Test/More.pm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
);

Expand Down Expand Up @@ -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
Expand Down