From 548a464b48c7399e7cb18305e05fe83ea9a93a96 Mon Sep 17 00:00:00 2001 From: Flavio Soibelmann Glock Date: Tue, 21 Apr 2026 12:47:15 +0200 Subject: [PATCH] fix(List/Scalar/Sub::Util): sync to v1.70, improve CPAN test pass rate MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Running `./jcpan -t Scalar::Util` against the CPAN Scalar-List-Utils-1.70 distribution went from 25/38 test programs failing (209/832 subtests) to 21/38 (163/842 subtests) — a reduction of 46 subtest failures. Changes: * Bump bundled List::Util, Scalar::Util, Sub::Util to v1.70 (was pinned at 1.63; caused version-mismatch failures because the tarball's List/Util/XS.pm reports the distribution version). * List::Util.pm: add import() that touches caller's $a/$b to silence the "Name used only once" warning (RT #88848), and define the List::Util::_Pair class methods (key / value / TO_JSON). * ListUtil.java: - Validate code refs for reduce/reductions/first/any/all/none/notall and pair*: non-CODE args now croak "Not a subroutine reference"; calls into undefined stubs croak "Undefined subroutine in " (matches XS error messages). - pairmap / pairgrep / pairfirst now alias $a and $b to the source list elements (matching XS semantics), so modifications inside the block are visible to the caller. - pairgrep / pairmap warn on odd-sized input lists. - pairs() blesses returned arrayrefs into List::Util::_Pair so ->key, ->value, ->TO_JSON work. - unpairs() pads short input arrayrefs with undef. - uniq distinguishes undef from the empty string; uniq/uniqstr/ uniqint/uniqnum warn on undef with "Use of uninitialized value". - head/tail croak "Not enough arguments for List::Util::head|tail" when called with no args. * ScalarUtil.java: blessed / reftype / refaddr now trigger FETCH on tied scalars exactly once before inspecting the underlying value (fixes t/getmagic-once.t). Tests that now pass completely: t/00version.t, t/getmagic-once.t, t/pair.t, t/undefined-block.t Remaining failures are mostly in areas requiring deeper work: - t/exotic_names.t (120 failures): stash names with NUL / control chars / apostrophes — needs set_subname & caller() stash work. - t/subname.t (7): related to the above. - BigInt integration in sum / product / min (3+3+1). - Misc overload / taint / DESTROY tracking edge cases. Generated with [Devin](https://cli.devin.ai/docs) Co-Authored-By: Devin <158243242+devin-ai-integration[bot]@users.noreply.github.com> --- .../org/perlonjava/core/Configuration.java | 4 +- .../runtime/perlmodule/ListUtil.java | 346 +++++++++++++----- .../runtime/perlmodule/ScalarUtil.java | 26 +- .../runtime/perlmodule/SubUtil.java | 2 +- src/main/perl/lib/List/Util.pm | 28 +- src/main/perl/lib/Scalar/Util.pm | 2 +- src/main/perl/lib/Sub/Util.pm | 2 +- 7 files changed, 303 insertions(+), 107 deletions(-) diff --git a/src/main/java/org/perlonjava/core/Configuration.java b/src/main/java/org/perlonjava/core/Configuration.java index 4412a9eb9..33684bd23 100644 --- a/src/main/java/org/perlonjava/core/Configuration.java +++ b/src/main/java/org/perlonjava/core/Configuration.java @@ -33,7 +33,7 @@ public final class Configuration { * Automatically populated by Gradle/Maven during build. * DO NOT EDIT MANUALLY - this value is replaced at build time. */ - public static final String gitCommitId = "ef6eaab61"; + public static final String gitCommitId = "250de1e53"; /** * Git commit date of the build (ISO format: YYYY-MM-DD). @@ -48,7 +48,7 @@ public final class Configuration { * Parsed by App::perlbrew and other tools via: perl -V | grep "Compiled at" * DO NOT EDIT MANUALLY - this value is replaced at build time. */ - public static final String buildTimestamp = "Apr 21 2026 11:56:14"; + public static final String buildTimestamp = "Apr 21 2026 12:45:08"; // Prevent instantiation private Configuration() { diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/ListUtil.java b/src/main/java/org/perlonjava/runtime/perlmodule/ListUtil.java index 065a3d2b1..669c69c8f 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/ListUtil.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/ListUtil.java @@ -2,6 +2,7 @@ import org.perlonjava.runtime.operators.ListOperators; import org.perlonjava.runtime.runtimetypes.*; +import org.perlonjava.runtime.runtimetypes.PerlCompilerException; import java.util.*; @@ -36,7 +37,7 @@ public ListUtil() { public static void initialize() { ListUtil listUtil = new ListUtil(); // Set $VERSION so CPAN.pm can detect our bundled version - GlobalVariable.getGlobalVariable("List::Util::VERSION").set(new RuntimeScalar("1.63")); + GlobalVariable.getGlobalVariable("List::Util::VERSION").set(new RuntimeScalar("1.70")); try { // List reduction functions listUtil.registerMethod("reduce", "reduce", "&@"); @@ -100,6 +101,62 @@ private static RuntimeList createSubList(RuntimeArray args, int startIndex) { return result; } + /** + * Validates that a scalar is a CODE reference pointing to a defined + * subroutine. Used by reduce/first/any/all/none/notall and pair* functions + * to produce error messages matching Perl 5's List::Util XS behaviour: + * "Not a subroutine reference" + * "Undefined subroutine in <funcName>" + */ + /** + * Check whether a thrown exception represents an "Undefined subroutine ..." + * error, possibly wrapped by ListOperators in a plain RuntimeException. + */ + private static boolean isUndefinedSubError(Throwable e) { + while (e != null) { + String msg = e.getMessage(); + if (msg != null && msg.startsWith("Undefined subroutine ")) { + return true; + } + if (e.getCause() == e) break; + e = e.getCause(); + } + return false; + } + + private static void validateCodeRef(RuntimeScalar codeRef, String funcName) { + RuntimeScalar deref = codeRef; + if (deref != null && deref.type == RuntimeScalarType.READONLY_SCALAR) { + deref = (RuntimeScalar) deref.value; + } + if (deref == null || deref.type != RuntimeScalarType.CODE + || !(deref.value instanceof RuntimeCode)) { + throw new PerlCompilerException("Not a subroutine reference"); + } + RuntimeCode code = (RuntimeCode) deref.value; + if (!code.getDefinedBoolean()) { + throw new PerlCompilerException("Undefined subroutine in " + funcName); + } + } + + /** + * Invokes the code block, translating "Undefined subroutine ... called" + * errors thrown from stub subs into the List::Util-specific + * "Undefined subroutine in <funcName>" message. + */ + private static RuntimeList applyBlock(RuntimeScalar codeRef, RuntimeArray filterArgs, + int callContext, String funcName) { + try { + return RuntimeCode.apply(codeRef, filterArgs, callContext); + } catch (PerlCompilerException e) { + String msg = e.getMessage(); + if (msg != null && msg.startsWith("Undefined subroutine ")) { + throw new PerlCompilerException("Undefined subroutine in " + funcName); + } + throw e; + } + } + /** * Gets the package name from a code ref for $a/$b variable resolution. * In Perl 5, reduce/pairmap/etc. use $a and $b in the caller's package, @@ -127,11 +184,11 @@ private static String getCodeRefPackage(RuntimeScalar codeRef) { * Reduces a list by calling a block multiple times. */ public static RuntimeList reduce(RuntimeArray args, int ctx) { - if (args.size() < 2) { + if (args.size() < 1) { return scalarUndef.getList(); } - RuntimeScalar codeRef = args.get(0); + validateCodeRef(codeRef, "reduce"); RuntimeList values = createSubList(args, 1); if (values.size() == 0) { @@ -158,7 +215,7 @@ public static RuntimeList reduce(RuntimeArray args, int ctx) { varA.set(accumulator); varB.set(values.elements.get(i).scalar()); - RuntimeList result = RuntimeCode.apply(codeRef, filterArgs, RuntimeContextType.SCALAR); + RuntimeList result = applyBlock(codeRef, filterArgs, RuntimeContextType.SCALAR, "reduce"); accumulator = result.getFirst(); } @@ -178,11 +235,11 @@ public static RuntimeList reduce(RuntimeArray args, int ctx) { * Similar to reduce but returns intermediate values. */ public static RuntimeList reductions(RuntimeArray args, int ctx) { - if (args.size() < 2) { + if (args.size() < 1) { return new RuntimeList(); } - RuntimeScalar codeRef = args.get(0); + validateCodeRef(codeRef, "reductions"); RuntimeList values = createSubList(args, 1); RuntimeArray results = new RuntimeArray(); @@ -208,7 +265,7 @@ public static RuntimeList reductions(RuntimeArray args, int ctx) { varA.set(accumulator); varB.set(values.elements.get(i).scalar()); - RuntimeList result = RuntimeCode.apply(codeRef, filterArgs, RuntimeContextType.SCALAR); + RuntimeList result = applyBlock(codeRef, filterArgs, RuntimeContextType.SCALAR, "reductions"); accumulator = result.getFirst(); results.push(accumulator.clone()); } @@ -224,37 +281,61 @@ public static RuntimeList reductions(RuntimeArray args, int ctx) { * Returns true if any element makes the block return true. */ public static RuntimeList any(RuntimeArray args, int ctx) { - if (args.size() < 2) { + if (args.size() < 1) { return scalarFalse.getList(); } - RuntimeScalar codeRef = args.get(0); + validateCodeRef(codeRef, "any"); RuntimeList values = createSubList(args, 1); - - // Pass the caller's @_ so $-[0], $_[1] etc. are accessible in the block - return ListOperators.any(values, codeRef, getCallerArgs(), ctx); + try { + return ListOperators.any(values, codeRef, getCallerArgs(), ctx); + } catch (RuntimeException e) { + if (isUndefinedSubError(e)) { + throw new PerlCompilerException("Undefined subroutine in any"); + } + throw e; + } } /** * Returns true if all elements make the block return true. */ public static RuntimeList all(RuntimeArray args, int ctx) { - if (args.size() < 2) { + if (args.size() < 1) { return scalarTrue.getList(); } - RuntimeScalar codeRef = args.get(0); + validateCodeRef(codeRef, "all"); RuntimeList values = createSubList(args, 1); - - // Pass the caller's @_ so $_[0], $_[1] etc. are accessible in the block - return ListOperators.all(values, codeRef, getCallerArgs(), ctx); + try { + return ListOperators.all(values, codeRef, getCallerArgs(), ctx); + } catch (RuntimeException e) { + if (isUndefinedSubError(e)) { + throw new PerlCompilerException("Undefined subroutine in all"); + } + throw e; + } } /** * Returns true if no elements make the block return true. */ public static RuntimeList none(RuntimeArray args, int ctx) { - RuntimeList result = any(args, ctx); + if (args.size() < 1) { + return scalarTrue.getList(); + } + RuntimeScalar codeRef = args.get(0); + validateCodeRef(codeRef, "none"); + RuntimeList values = createSubList(args, 1); + RuntimeList result; + try { + result = ListOperators.any(values, codeRef, getCallerArgs(), ctx); + } catch (RuntimeException e) { + if (isUndefinedSubError(e)) { + throw new PerlCompilerException("Undefined subroutine in none"); + } + throw e; + } return result.getFirst().getBoolean() ? scalarFalse.getList() : scalarTrue.getList(); } @@ -262,7 +343,21 @@ public static RuntimeList none(RuntimeArray args, int ctx) { * Returns true if not all elements make the block return true. */ public static RuntimeList notall(RuntimeArray args, int ctx) { - RuntimeList result = all(args, ctx); + if (args.size() < 1) { + return scalarFalse.getList(); + } + RuntimeScalar codeRef = args.get(0); + validateCodeRef(codeRef, "notall"); + RuntimeList values = createSubList(args, 1); + RuntimeList result; + try { + result = ListOperators.all(values, codeRef, getCallerArgs(), ctx); + } catch (RuntimeException e) { + if (isUndefinedSubError(e)) { + throw new PerlCompilerException("Undefined subroutine in notall"); + } + throw e; + } return result.getFirst().getBoolean() ? scalarFalse.getList() : scalarTrue.getList(); } @@ -270,11 +365,11 @@ public static RuntimeList notall(RuntimeArray args, int ctx) { * Returns the first element where the block returns true. */ public static RuntimeList first(RuntimeArray args, int ctx) { - if (args.size() < 2) { + if (args.size() < 1) { return scalarUndef.getList(); } - RuntimeScalar codeRef = args.get(0); + validateCodeRef(codeRef, "first"); RuntimeList values = createSubList(args, 1); RuntimeScalar saveValue = getGlobalVariable("main::_"); @@ -287,7 +382,7 @@ public static RuntimeList first(RuntimeArray args, int ctx) { RuntimeScalar scalar = element.scalar(); GlobalVariable.aliasGlobalVariable("main::_", scalar); - RuntimeList result = RuntimeCode.apply(codeRef, filterArgs, RuntimeContextType.SCALAR); + RuntimeList result = applyBlock(codeRef, filterArgs, RuntimeContextType.SCALAR, "first"); if (result.getFirst().getBoolean()) { return scalar.getList(); } @@ -453,21 +548,48 @@ public static RuntimeList sample(RuntimeArray args, int ctx) { } /** - * Remove duplicate values using string comparison. + * Remove duplicate values. The undef value is distinct from the empty + * string; multiple undefs are treated as duplicates of each other. */ public static RuntimeList uniq(RuntimeArray args, int ctx) { - return uniqstr(args, ctx); + Set seen = new LinkedHashSet<>(); + boolean seenUndef = false; + RuntimeArray result = new RuntimeArray(); + for (RuntimeScalar arg : args.elements) { + if (arg == null || arg.type == RuntimeScalarType.UNDEF) { + if (!seenUndef) { + seenUndef = true; + result.push(new RuntimeScalar()); + } + } else { + String value = arg.toString(); + if (seen.add(value)) { + result.push(arg); + } + } + } + return ctx == RuntimeContextType.SCALAR ? + new RuntimeScalar(result.size()).getList() : result.getList(); } /** - * Remove duplicate values using integer comparison. + * Remove duplicate values using integer comparison. Coerces undef to 0 + * (with uninitialized-value warning) and returns integers. */ public static RuntimeList uniqint(RuntimeArray args, int ctx) { Set seen = new LinkedHashSet<>(); RuntimeArray result = new RuntimeArray(); for (RuntimeScalar arg : args.elements) { - Long value = arg.getLong(); + long value; + if (arg == null || arg.type == RuntimeScalarType.UNDEF) { + org.perlonjava.runtime.operators.WarnDie.warnWithCategory( + new RuntimeScalar("Use of uninitialized value in subroutine entry"), + RuntimeScalarCache.scalarEmptyString, "uninitialized"); + value = 0L; + } else { + value = arg.getLong(); + } if (seen.add(value)) { result.push(new RuntimeScalar(value)); } @@ -478,14 +600,22 @@ public static RuntimeList uniqint(RuntimeArray args, int ctx) { } /** - * Remove duplicate values using numerical comparison. + * Remove duplicate values using numerical comparison. Warns on undef. */ public static RuntimeList uniqnum(RuntimeArray args, int ctx) { Set seen = new LinkedHashSet<>(); RuntimeArray result = new RuntimeArray(); for (RuntimeScalar arg : args.elements) { - Double value = arg.getDouble(); + double value; + if (arg == null || arg.type == RuntimeScalarType.UNDEF) { + org.perlonjava.runtime.operators.WarnDie.warnWithCategory( + new RuntimeScalar("Use of uninitialized value in subroutine entry"), + RuntimeScalarCache.scalarEmptyString, "uninitialized"); + value = 0.0; + } else { + value = arg.getDouble(); + } if (seen.add(value)) { result.push(new RuntimeScalar(value)); } @@ -496,14 +626,23 @@ public static RuntimeList uniqnum(RuntimeArray args, int ctx) { } /** - * Remove duplicate values using string comparison. + * Remove duplicate values using string comparison. Warns on undef + * (coerces undef to empty string for comparison). */ public static RuntimeList uniqstr(RuntimeArray args, int ctx) { Set seen = new LinkedHashSet<>(); RuntimeArray result = new RuntimeArray(); for (RuntimeScalar arg : args.elements) { - String value = arg.toString(); + String value; + if (arg == null || arg.type == RuntimeScalarType.UNDEF) { + org.perlonjava.runtime.operators.WarnDie.warnWithCategory( + new RuntimeScalar("Use of uninitialized value in subroutine entry"), + RuntimeScalarCache.scalarEmptyString, "uninitialized"); + value = ""; + } else { + value = arg.toString(); + } if (seen.add(value)) { result.push(new RuntimeScalar(value)); } @@ -517,8 +656,8 @@ public static RuntimeList uniqstr(RuntimeArray args, int ctx) { * Returns the first elements from a list. */ public static RuntimeList head(RuntimeArray args, int ctx) { - if (args.size() < 2) { - return new RuntimeList(); + if (args.isEmpty()) { + throw new PerlCompilerException("Not enough arguments for List::Util::head"); } int size = args.get(0).getInt(); @@ -540,8 +679,8 @@ public static RuntimeList head(RuntimeArray args, int ctx) { * Returns the last elements from a list. */ public static RuntimeList tail(RuntimeArray args, int ctx) { - if (args.size() < 2) { - return new RuntimeList(); + if (args.isEmpty()) { + throw new PerlCompilerException("Not enough arguments for List::Util::tail"); } int size = args.get(0).getInt(); @@ -565,9 +704,12 @@ public static RuntimeList tail(RuntimeArray args, int ctx) { /** * Returns a list of array references from pairs. + * Since List::Util 1.39, pairs are blessed into List::Util::_Pair so + * they provide ->key / ->value / ->TO_JSON methods. */ public static RuntimeList pairs(RuntimeArray args, int ctx) { RuntimeArray result = new RuntimeArray(); + RuntimeScalar pairClass = new RuntimeScalar("List::Util::_Pair"); for (int i = 0; i < args.size(); i += 2) { RuntimeArray pair = new RuntimeArray(); @@ -577,7 +719,9 @@ public static RuntimeList pairs(RuntimeArray args, int ctx) { } else { pair.push(scalarUndef); } - result.push(pair.createReference()); + RuntimeScalar pairRef = pair.createReference(); + org.perlonjava.runtime.operators.ReferenceOperators.bless(pairRef, pairClass); + result.push(pairRef); } return result.getList(); @@ -592,8 +736,10 @@ public static RuntimeList unpairs(RuntimeArray args, int ctx) { for (RuntimeScalar pairRef : args.elements) { if (pairRef.type == RuntimeScalarType.ARRAYREFERENCE) { RuntimeArray pair = (RuntimeArray) pairRef.value; - if (pair.size() >= 1) result.push(pair.get(0)); - if (pair.size() >= 2) result.push(pair.get(1)); + // Always emit exactly two values (key, value), padding with undef + // when the input arrayref has fewer than two elements. + result.push(pair.size() >= 1 ? pair.get(0) : scalarUndef); + result.push(pair.size() >= 2 ? pair.get(1) : scalarUndef); } } @@ -627,39 +773,49 @@ public static RuntimeList pairvalues(RuntimeArray args, int ctx) { } /** - * Maps over pairs with a block. + * Maps over pairs with a block. Aliases $a and $b in the caller's + * package to the source elements (matching Perl 5 XS semantics). */ public static RuntimeList pairmap(RuntimeArray args, int ctx) { - if (args.size() < 2) { + if (args.size() < 1) { return new RuntimeList(); } - RuntimeScalar codeRef = args.get(0); + validateCodeRef(codeRef, "pairmap"); RuntimeList kvlist = createSubList(args, 1); String callerPkg = getCodeRefPackage(codeRef); - RuntimeScalar varA = getGlobalVariable(callerPkg + "::a"); - RuntimeScalar varB = getGlobalVariable(callerPkg + "::b"); - RuntimeScalar saveA = varA.clone(); - RuntimeScalar saveB = varB.clone(); + String aName = callerPkg + "::a"; + String bName = callerPkg + "::b"; + RuntimeScalar saveA = getGlobalVariable(aName); + RuntimeScalar saveB = getGlobalVariable(bName); + + // Warn on odd-sized list (matches Perl 5 behaviour) + if ((kvlist.size() & 1) == 1) { + org.perlonjava.runtime.operators.WarnDie.warn( + new RuntimeScalar("Odd number of elements in pairmap at "), + scalarUndef); + } RuntimeArray result = new RuntimeArray(); try { - // Get caller's @_ so $_[0], $_[1] etc. are accessible in the block RuntimeArray outerArgs = getCallerArgs(); RuntimeArray filterArgs = outerArgs != null ? outerArgs : new RuntimeArray(); - + for (int i = 0; i < kvlist.size(); i += 2) { - varA.set(kvlist.elements.get(i).scalar()); - varB.set(i + 1 < kvlist.size() ? kvlist.elements.get(i + 1).scalar() : scalarUndef); + GlobalVariable.aliasGlobalVariable(aName, kvlist.elements.get(i).scalar()); + RuntimeScalar bVal = i + 1 < kvlist.size() + ? kvlist.elements.get(i + 1).scalar() + : new RuntimeScalar(); + GlobalVariable.aliasGlobalVariable(bName, bVal); - RuntimeList blockResult = RuntimeCode.apply(codeRef, filterArgs, RuntimeContextType.LIST); + RuntimeList blockResult = applyBlock(codeRef, filterArgs, RuntimeContextType.LIST, "pairmap"); blockResult.addToArray(result); } } finally { - varA.set(saveA); - varB.set(saveB); + GlobalVariable.aliasGlobalVariable(aName, saveA); + GlobalVariable.aliasGlobalVariable(bName, saveB); } return ctx == RuntimeContextType.SCALAR ? @@ -667,48 +823,53 @@ public static RuntimeList pairmap(RuntimeArray args, int ctx) { } /** - * Filters pairs with a block. + * Filters pairs with a block. Aliases $a and $b to the source elements. */ public static RuntimeList pairgrep(RuntimeArray args, int ctx) { - if (args.size() < 2) { + if (args.size() < 1) { return new RuntimeList(); } - RuntimeScalar codeRef = args.get(0); + validateCodeRef(codeRef, "pairgrep"); RuntimeList kvlist = createSubList(args, 1); String callerPkg = getCodeRefPackage(codeRef); - RuntimeScalar varA = getGlobalVariable(callerPkg + "::a"); - RuntimeScalar varB = getGlobalVariable(callerPkg + "::b"); - RuntimeScalar saveA = varA.clone(); - RuntimeScalar saveB = varB.clone(); + String aName = callerPkg + "::a"; + String bName = callerPkg + "::b"; + RuntimeScalar saveA = getGlobalVariable(aName); + RuntimeScalar saveB = getGlobalVariable(bName); + + if ((kvlist.size() & 1) == 1) { + org.perlonjava.runtime.operators.WarnDie.warn( + new RuntimeScalar("Odd number of elements in pairgrep at "), + scalarUndef); + } RuntimeArray result = new RuntimeArray(); int pairs = 0; try { - // Get caller's @_ so $_[0], $_[1] etc. are accessible in the block RuntimeArray outerArgs = getCallerArgs(); RuntimeArray filterArgs = outerArgs != null ? outerArgs : new RuntimeArray(); - - for (int i = 0; i < kvlist.size(); i += 2) { - varA.set(kvlist.elements.get(i).scalar()); - varB.set(i + 1 < kvlist.size() ? kvlist.elements.get(i + 1).scalar() : scalarUndef); - RuntimeList blockResult = RuntimeCode.apply(codeRef, filterArgs, RuntimeContextType.SCALAR); + for (int i = 0; i < kvlist.size(); i += 2) { + RuntimeScalar aVal = kvlist.elements.get(i).scalar(); + RuntimeScalar bVal = i + 1 < kvlist.size() + ? kvlist.elements.get(i + 1).scalar() + : new RuntimeScalar(); + GlobalVariable.aliasGlobalVariable(aName, aVal); + GlobalVariable.aliasGlobalVariable(bName, bVal); + + RuntimeList blockResult = applyBlock(codeRef, filterArgs, RuntimeContextType.SCALAR, "pairgrep"); if (blockResult.getFirst().getBoolean()) { - result.push(kvlist.elements.get(i).scalar()); - if (i + 1 < kvlist.size()) { - result.push(kvlist.elements.get(i + 1).scalar()); - } else { - result.push(scalarUndef); - } + result.push(aVal); + result.push(bVal); pairs++; } } } finally { - varA.set(saveA); - varB.set(saveB); + GlobalVariable.aliasGlobalVariable(aName, saveA); + GlobalVariable.aliasGlobalVariable(bName, saveB); } return ctx == RuntimeContextType.SCALAR ? @@ -716,50 +877,49 @@ public static RuntimeList pairgrep(RuntimeArray args, int ctx) { } /** - * Returns the first pair where the block returns true. + * Returns the first pair where the block returns true. Aliases $a/$b. */ public static RuntimeList pairfirst(RuntimeArray args, int ctx) { - if (args.size() < 2) { + if (args.size() < 1) { return ctx == RuntimeContextType.SCALAR ? scalarFalse.getList() : new RuntimeList(); } - RuntimeScalar codeRef = args.get(0); + validateCodeRef(codeRef, "pairfirst"); RuntimeList kvlist = createSubList(args, 1); String callerPkg = getCodeRefPackage(codeRef); - RuntimeScalar varA = getGlobalVariable(callerPkg + "::a"); - RuntimeScalar varB = getGlobalVariable(callerPkg + "::b"); - RuntimeScalar saveA = varA.clone(); - RuntimeScalar saveB = varB.clone(); + String aName = callerPkg + "::a"; + String bName = callerPkg + "::b"; + RuntimeScalar saveA = getGlobalVariable(aName); + RuntimeScalar saveB = getGlobalVariable(bName); try { - // Get caller's @_ so $_[0], $_[1] etc. are accessible in the block RuntimeArray outerArgs = getCallerArgs(); RuntimeArray filterArgs = outerArgs != null ? outerArgs : new RuntimeArray(); - - for (int i = 0; i < kvlist.size(); i += 2) { - varA.set(kvlist.elements.get(i).scalar()); - varB.set(i + 1 < kvlist.size() ? kvlist.elements.get(i + 1).scalar() : scalarUndef); - RuntimeList blockResult = RuntimeCode.apply(codeRef, filterArgs, RuntimeContextType.SCALAR); + for (int i = 0; i < kvlist.size(); i += 2) { + RuntimeScalar aVal = kvlist.elements.get(i).scalar(); + RuntimeScalar bVal = i + 1 < kvlist.size() + ? kvlist.elements.get(i + 1).scalar() + : new RuntimeScalar(); + GlobalVariable.aliasGlobalVariable(aName, aVal); + GlobalVariable.aliasGlobalVariable(bName, bVal); + + RuntimeList blockResult = applyBlock(codeRef, filterArgs, RuntimeContextType.SCALAR, "pairfirst"); if (blockResult.getFirst().getBoolean()) { if (ctx == RuntimeContextType.SCALAR) { return scalarTrue.getList(); } else { RuntimeArray result = new RuntimeArray(); - result.push(kvlist.elements.get(i).scalar()); - if (i + 1 < kvlist.size()) { - result.push(kvlist.elements.get(i + 1).scalar()); - } else { - result.push(scalarUndef); - } + result.push(aVal); + result.push(bVal); return result.getList(); } } } } finally { - varA.set(saveA); - varB.set(saveB); + GlobalVariable.aliasGlobalVariable(aName, saveA); + GlobalVariable.aliasGlobalVariable(bName, saveB); } return ctx == RuntimeContextType.SCALAR ? scalarFalse.getList() : new RuntimeList(); diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/ScalarUtil.java b/src/main/java/org/perlonjava/runtime/perlmodule/ScalarUtil.java index 163ab9841..4734bde4a 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/ScalarUtil.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/ScalarUtil.java @@ -27,7 +27,7 @@ public static void initialize() { ScalarUtil scalarUtil = new ScalarUtil(); scalarUtil.initializeExporter(); // Use the base class method to initialize the exporter // Set $VERSION so CPAN.pm can detect our bundled version - GlobalVariable.getGlobalVariable("Scalar::Util::VERSION").set(new RuntimeScalar("1.63")); + GlobalVariable.getGlobalVariable("Scalar::Util::VERSION").set(new RuntimeScalar("1.70")); scalarUtil.defineExport("EXPORT_OK", "blessed", "refaddr", "reftype", "weaken", "unweaken", "isweak", "dualvar", "isdual", "isvstring", "looks_like_number", "openhandle", "readonly", "set_prototype", "tainted"); @@ -52,6 +52,21 @@ public static void initialize() { } } + /** + * Triggers FETCH on a tied scalar so that get-magic is fired exactly + * once for blessed/reftype/refaddr. Also unwraps READONLY_SCALAR. + */ + private static RuntimeScalar magicallyDeref(RuntimeScalar scalar) { + if (scalar == null) return scalar; + if (scalar.type == TIED_SCALAR) { + scalar = scalar.tiedFetch(); + } + if (scalar != null && scalar.type == READONLY_SCALAR) { + scalar = (RuntimeScalar) scalar.value; + } + return scalar; + } + /** * Checks if a scalar is blessed and returns the blessing information. * @@ -64,8 +79,7 @@ public static RuntimeList blessed(RuntimeArray args, int ctx) { throw new IllegalStateException("Bad number of arguments for blessed() method"); } - RuntimeScalar scalar = args.get(0); - if (scalar.type == READONLY_SCALAR) scalar = (RuntimeScalar) scalar.value; + RuntimeScalar scalar = magicallyDeref(args.get(0)); int blessId = blessedId(scalar); // Return undef for unblessed references (blessId == 0) if (blessId == 0) { @@ -89,8 +103,7 @@ public static RuntimeList refaddr(RuntimeArray args, int ctx) { if (args.size() != 1) { throw new IllegalStateException("Bad number of arguments for refaddr() method"); } - RuntimeScalar scalar = args.get(0); - if (scalar.type == READONLY_SCALAR) scalar = (RuntimeScalar) scalar.value; + RuntimeScalar scalar = magicallyDeref(args.get(0)); // refaddr returns undef for non-references // For references, return the identity hash code of the underlying referenced object switch (scalar.type) { @@ -121,8 +134,7 @@ public static RuntimeList reftype(RuntimeArray args, int ctx) { if (args.size() != 1) { throw new IllegalStateException("Bad number of arguments for reftype() method"); } - RuntimeScalar scalar = args.get(0); - if (scalar.type == READONLY_SCALAR) scalar = (RuntimeScalar) scalar.value; + RuntimeScalar scalar = magicallyDeref(args.get(0)); String type = switch (scalar.type) { case REFERENCE -> { // Inspect the referent to distinguish SCALAR refs from REF (ref-to-ref) diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/SubUtil.java b/src/main/java/org/perlonjava/runtime/perlmodule/SubUtil.java index 911ba6755..b549dc81f 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/SubUtil.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/SubUtil.java @@ -24,7 +24,7 @@ public static void initialize() { SubUtil subUtil = new SubUtil(); subUtil.initializeExporter(); // Set $VERSION so CPAN.pm can detect our bundled version - GlobalVariable.getGlobalVariable("Sub::Util::VERSION").set(new RuntimeScalar("1.63")); + GlobalVariable.getGlobalVariable("Sub::Util::VERSION").set(new RuntimeScalar("1.70")); subUtil.defineExport("EXPORT_OK", "prototype", "set_prototype", "subname", "set_subname"); try { subUtil.registerMethod("prototype", "$"); diff --git a/src/main/perl/lib/List/Util.pm b/src/main/perl/lib/List/Util.pm index b83f1dce5..0923c2846 100644 --- a/src/main/perl/lib/List/Util.pm +++ b/src/main/perl/lib/List/Util.pm @@ -1,7 +1,10 @@ package List::Util; use strict; use warnings; -our $VERSION = '1.63'; + +our $VERSION = '1.70'; +our $XS_VERSION = $VERSION; +$VERSION =~ tr/_//d; require Exporter; our @ISA = qw(Exporter); @@ -15,6 +18,27 @@ our @EXPORT_OK = qw( ); use XSLoader; -XSLoader::load('List::Util', $VERSION); +XSLoader::load('List::Util', $XS_VERSION); + +# Used by shuffle() +our $RAND; + +sub import +{ + my $pkg = caller; + + # (RT88848) Touch the caller's $a and $b, to avoid the "Name used only + # once: possible typo" warning. + no strict 'refs'; + ${"${pkg}::a"} = ${"${pkg}::a"}; + ${"${pkg}::b"} = ${"${pkg}::b"}; + + goto &Exporter::import; +} + +# For objects returned by pairs() +sub List::Util::_Pair::key { shift->[0] } +sub List::Util::_Pair::value { shift->[1] } +sub List::Util::_Pair::TO_JSON { [ @{+shift} ] } 1; diff --git a/src/main/perl/lib/Scalar/Util.pm b/src/main/perl/lib/Scalar/Util.pm index eadb9ed17..d43a44f93 100644 --- a/src/main/perl/lib/Scalar/Util.pm +++ b/src/main/perl/lib/Scalar/Util.pm @@ -1,7 +1,7 @@ package Scalar::Util; use strict; use warnings; -our $VERSION = '1.63'; +our $VERSION = '1.70'; use XSLoader; XSLoader::load('Scalar::Util', $VERSION); diff --git a/src/main/perl/lib/Sub/Util.pm b/src/main/perl/lib/Sub/Util.pm index 3f5aea44a..7349c3a13 100644 --- a/src/main/perl/lib/Sub/Util.pm +++ b/src/main/perl/lib/Sub/Util.pm @@ -1,7 +1,7 @@ package Sub::Util; use strict; use warnings; -our $VERSION = '1.63'; +our $VERSION = '1.70'; use XSLoader; XSLoader::load('Sub::Util', $VERSION);