diff --git a/dev/design/jcpan-critic-inline-timezone.md b/dev/design/jcpan-critic-inline-timezone.md new file mode 100644 index 000000000..e6d2edb0f --- /dev/null +++ b/dev/design/jcpan-critic-inline-timezone.md @@ -0,0 +1,75 @@ +# jcpan compiler and tooling compatibility + +## Goal + +Fix reusable PerlOnJava compiler/runtime/tooling failures encountered by +`Perl::Critic::More`, `Module::Install::InlineModule`, +`TimeZone::TimeZoneDB`, and their dependency chains without distribution +preferences. Native functionality should reuse bundled Java libraries where +possible. + +## Progress Tracking + +### Current Status: implementation and target validation complete (2026-08-10) + +### Completed Phases + +- [x] Baseline and system-Perl comparison (2026-08-10) + - Confirmed `Perl::Critic::More` and `Module::Install::InlineModule` are + runnable upstream targets. + - Confirmed the `TimeZone::TimeZoneDB` distribution test suite fails under + system Perl and its dependency metadata contains a circular chain: + `Params::Get` -> `Test::Returns` -> `Return::Set` -> `Params::Get`. +- [x] Native dependency replacement (2026-08-10) + - Added a Java-backed `Digest::JHash` implementation matching the upstream + XS signed-byte and unsigned-32-bit behavior. + - Files: `DigestJHash.java`, `Digest/JHash.pm`, bundled module tests. +- [x] CPAN and MakeMaker tooling (2026-08-10) + - CPAN's metadata fallback now runs a separate generated Makefile.PL instead + of overwriting a distribution's possibly read-only file. + - MakeMaker now emits AutoSplit subprocesses only for modules that actually + use AutoLoader, avoiding hundreds of JVM startups for POD-only modules. +- [x] Core-header and stash compatibility (2026-08-10) + - `Config.pm` materializes the standard `CORE/keywords.h` probe required by + B::Keywords. + - Startup no longer exposes nonexistent `$^B`, `$^G`, `$^J`, `$^K`, `$^Q`, + `$^U`, `$^Y`, and `$^Z` globals to stash inspection. +- [x] Weak-reference lifecycle performance (2026-08-10) + - Deferred targeted weak sweeps until temporary assignment roots are gone. + - Avoided redundant global walks after ordinary destruction and restricted + rescued-object cleanup to genuine aggregate rescue cases. +- [x] Full-suite runtime isolation (2026-08-10) + - Explicit registered-warning bits now override the broader `all` bit, so + `no warnings 'Category'` remains effective through native warning helpers. + - Virtual descriptor recycling now skips occupied descriptors and closing an + older borrowed alias cannot unregister a newer live descriptor owner. + +### Validation + +- System Perl: Digest::JHash upstream tests pass (2 files, 6 tests). +- System Perl: B::Keywords upstream tests pass (3 files, 553 tests). +- PerlOnJava: B::Keywords upstream tests pass (3 files). +- PerlOnJava: `jcpan -t Perl::Critic::More` passes (8 files, 55 tests). +- PerlOnJava: `jcpan -t Module::Install::InlineModule` passes (2 files, 1 test). +- PerlOnJava: the PPI round-trip stress test reached assertion 2,101 without a + failure before its 900-second guard. Before the reachability fixes it reached + only 82 assertions in 120 seconds; this remains a long-running dependency + test rather than a complete pass. +- Full `make` passes all compilation and unit-test shards. + +### Next Steps + +1. Continue profiling PPI if a sub-15-minute full round-trip run is required. + +### Open Questions + +- `TimeZone::TimeZoneDB` remains excluded because its upstream suite fails on + system Perl and its published prerequisites contain the circular chain + documented above. No distribution preference was added. + +## Related documentation and skills + +- `docs/reference/bundled-modules.md` +- `.agents/skills/debug-perlonjava/SKILL.md` +- `.agents/skills/profile-perlonjava/SKILL.md` +- `.agents/skills/port-cpan-module/SKILL.md` diff --git a/docs/about/changelog.md b/docs/about/changelog.md index 7b19959d9..2cdcf302c 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -4,6 +4,16 @@ Release history of PerlOnJava. See [Roadmap](roadmap.md) for future plans. ## Work in progress +- CPAN: add a Java-backed `Digest::JHash` XS replacement for CHI and + `TimeZone::TimeZoneDB` dependency chains, and make CPAN's generated + Makefile fallback work when a distribution ships a read-only Makefile.PL. +- CPAN tooling: avoid launching AutoSplit for POD-only modules, materialize + `CORE/keywords.h` for build-time probes, and expose only real control-letter + globals through `%main::` stash enumeration. +- Runtime: avoid redundant global reachability walks while releasing weak + references in large object trees, substantially reducing PPI teardown cost. +- Runtime: honor explicit custom-warning mask bits and prevent stale recycled + descriptors from replacing live borrowed-handle mappings. - Add Perl taint mode with `-T` on both JVM and interpreter backends, including external-input provenance, scalar and regex propagation, capture-based untainting, and security checks for process execution, code loading, file diff --git a/docs/reference/bundled-modules.md b/docs/reference/bundled-modules.md index 21ceadcb8..c30b99679 100644 --- a/docs/reference/bundled-modules.md +++ b/docs/reference/bundled-modules.md @@ -20,6 +20,7 @@ Recent CPAN compatibility additions include: | `Devel::LexAlias` | Perl facade over Java lexical cells | Rebinds local and captured scalar, array, and hash lexicals | | `Encode::Locale` | Pure Perl facade over bundled locale support | Provides LWP and XML::Parser with locale encoding aliases; includes `Encode::Alias` | | `Crypt::Twofish2` | Java XS bridge | BouncyCastle Twofish engine with ECB, CBC, and CFB1 compatibility | +| `Digest::JHash` | Java XS bridge | Jenkins 32-bit hash used by CHI and TimeZone::TimeZoneDB | | `B::Flags` | Pure Perl over portable `B` objects | Named OP/SV flags without access to Perl C structures | --- diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/DigestJHash.java b/src/main/java/org/perlonjava/runtime/perlmodule/DigestJHash.java new file mode 100644 index 000000000..0bc89406e --- /dev/null +++ b/src/main/java/org/perlonjava/runtime/perlmodule/DigestJHash.java @@ -0,0 +1,98 @@ +package org.perlonjava.runtime.perlmodule; + +import org.perlonjava.frontend.parser.StringParser; +import org.perlonjava.runtime.runtimetypes.GlobalVariable; +import org.perlonjava.runtime.runtimetypes.RuntimeArray; +import org.perlonjava.runtime.runtimetypes.RuntimeList; +import org.perlonjava.runtime.runtimetypes.RuntimeScalar; +import org.perlonjava.runtime.runtimetypes.RuntimeScalarType; + +import java.nio.charset.StandardCharsets; + +/** Java replacement for the small XS core of Digest::JHash. */ +public class DigestJHash extends PerlModuleBase { + private static final int GOLDEN_RATIO = 0x9e3779b9; + + public DigestJHash() { + super("Digest::JHash", false); + } + + public static void initialize() { + DigestJHash module = new DigestJHash(); + GlobalVariable.getGlobalVariable("Digest::JHash::VERSION").set(new RuntimeScalar("0.10")); + try { + module.registerMethod("jhash", "$"); + } catch (NoSuchMethodException e) { + System.err.println("Warning: Missing Digest::JHash method: " + e.getMessage()); + } + } + + public static RuntimeList jhash(RuntimeArray args, int ctx) { + if (args.isEmpty() || args.get(0).type == RuntimeScalarType.UNDEF) { + return new RuntimeScalar(0L).getList(); + } + + String value = args.get(0).toString(); + StringParser.assertNoWideCharacters(value, "jhash"); + byte[] data = value.getBytes(StandardCharsets.ISO_8859_1); + if (data.length == 0) { + return new RuntimeScalar(0L).getList(); + } + + int a = GOLDEN_RATIO; + int b = GOLDEN_RATIO; + int c = 0; + int offset = 0; + int remaining = data.length; + + while (remaining >= 12) { + a += word(data, offset); + b += word(data, offset + 4); + c += word(data, offset + 8); + int[] mixed = mix(a, b, c); + a = mixed[0]; + b = mixed[1]; + c = mixed[2]; + offset += 12; + remaining -= 12; + } + + c += data.length; + switch (remaining) { + case 11: c += data[offset + 10] << 24; + case 10: c += data[offset + 9] << 16; + case 9: c += data[offset + 8] << 8; + case 8: b += data[offset + 7] << 24; + case 7: b += data[offset + 6] << 16; + case 6: b += data[offset + 5] << 8; + case 5: b += data[offset + 4]; + case 4: a += data[offset + 3] << 24; + case 3: a += data[offset + 2] << 16; + case 2: a += data[offset + 1] << 8; + case 1: a += data[offset]; + default: break; + } + c = mix(a, b, c)[2]; + return new RuntimeScalar(Integer.toUnsignedLong(c)).getList(); + } + + private static int word(byte[] data, int offset) { + return data[offset] + + (data[offset + 1] << 8) + + (data[offset + 2] << 16) + + (data[offset + 3] << 24); + } + + private static int[] mix(int a, int b, int c) { + a -= b; a -= c; a ^= c >>> 13; + b -= c; b -= a; b ^= a << 8; + c -= a; c -= b; c ^= b >>> 13; + a -= b; a -= c; a ^= c >>> 12; + b -= c; b -= a; b ^= a << 16; + c -= a; c -= b; c ^= b >>> 5; + a -= b; a -= c; a ^= c >>> 3; + b -= c; b -= a; b ^= a << 10; + c -= a; c -= b; c ^= b >>> 15; + return new int[] {a, b, c}; + } +} diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalContext.java b/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalContext.java index a78439ec3..330672f5e 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalContext.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalContext.java @@ -69,8 +69,11 @@ public static void initializeGlobals(CompilerOptions compilerOptions) { RuntimeRegex.initialize(); // Initialize scalar variables - for (char c = 'A'; c <= 'Z'; c++) { - // Initialize $^A.. $^Z + // Only create the control-letter globals that Perl actually defines. + // Eagerly populating every $^A..$^Z makes nonexistent typeglobs visible + // through %main:: (notably to B::Keywords and other stash inspectors). + for (char c : new char[] {'A', 'C', 'D', 'E', 'F', 'H', 'I', 'L', 'M', + 'N', 'O', 'P', 'R', 'S', 'T', 'V', 'W', 'X'}) { String varName = "main::" + Character.toString(c - 'A' + 1); GlobalVariable.getGlobalVariable(varName); } diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/MortalList.java b/src/main/java/org/perlonjava/runtime/runtimetypes/MortalList.java index b2e214bc6..2f13c5038 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/MortalList.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/MortalList.java @@ -1185,7 +1185,13 @@ private static void maybeAutoSweepIfRequested() { } private static void maybeAutoSweepAtStatementBoundary(boolean topLevel) { - if (!targetedWeakSweepReferents.isEmpty()) { + // RuntimeScalar.setLargeRefCounted() flushes while protecting the old + // and new values as temporary roots. That is an assignment-internal + // flush, not a safe Perl statement boundary. Defer targeted sweeps + // until the emitted boundary flush after those roots are removed; + // otherwise every assignment of a DESTROY-able object performs a full + // root walk when any weak reference exists anywhere in the program. + if (!targetedWeakSweepReferents.isEmpty() && !hasTemporaryRoots()) { Set targets = Collections.newSetFromMap(new IdentityHashMap<>()); targets.addAll(targetedWeakSweepReferents); targetedWeakSweepReferents.clear(); diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/ReachabilityWalker.java b/src/main/java/org/perlonjava/runtime/runtimetypes/ReachabilityWalker.java index ca6e55650..055d9430f 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/ReachabilityWalker.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/ReachabilityWalker.java @@ -1514,29 +1514,27 @@ && isCapturedByWeakBackrefCode(referent)) { */ public static int sweepReleasedWeakReferents(Set referents) { if (referents == null || referents.isEmpty()) return 0; + Set pending = Collections.newSetFromMap(new IdentityHashMap<>()); + for (RuntimeBase referent : referents) { + if (referent == null || referent.currentlyDestroying) continue; + // Normal decrement-to-zero destruction already clears the + // referent's weak observers and recursively releases contained + // objects in DestroyDispatch.callDestroy(). Re-walking every + // root after that completed path is both redundant and quadratic + // for object trees such as PPI's AST. A rescued object is handled + // by the rescue-specific cleanup path after the assignment. + if (referent.destroyFired || referent.refCount == Integer.MIN_VALUE) continue; + pending.add(referent); + } + if (pending.isEmpty()) return 0; + Set live = new ReachabilityWalker().walk(); int cleared = 0; boolean releasedObjectNeedsCascade = false; - for (RuntimeBase referent : referents) { + for (RuntimeBase referent : pending) { if (referent == null || referent.currentlyDestroying) { continue; } - if (referent.destroyFired || referent.refCount == Integer.MIN_VALUE) { - // A DESTROY body may have rescued the object by storing $self - // into another live container. Rescue-specific cleanup runs - // after the undef assignment and decides whether to clear only - // the object's own weak refs or its contained graph. Starting a - // generic fixed-point cascade here clears live children first. - if (DestroyDispatch.isRescued(referent)) { - continue; - } - // An eager sweep in RuntimeScalar.undefine() may already have - // destroyed this wrapper using a liveness snapshot taken - // before its tied/container edges were released. Re-walk - // below so newly unreachable dependants are collected too. - releasedObjectNeedsCascade = true; - continue; - } if (live.contains(referent)) continue; if ((referent instanceof RuntimeHash || referent instanceof RuntimeArray) && referent.localBindingExists) { diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeHash.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeHash.java index 081163d46..f9aef5111 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeHash.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeHash.java @@ -139,7 +139,7 @@ public void clear() { } } - private boolean isPackageRootedHash() { + boolean isPackageRootedHash() { return isPackageGlobalRoot || isGlobalPackageHash; } diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeIO.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeIO.java index 2e55ab9e2..349d3661b 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeIO.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeIO.java @@ -288,21 +288,23 @@ public int assignFileno() { * Returns -1 if none available. */ private static int tryRecycleLowestFd() { - List candidates = new ArrayList<>(); + SortedSet candidates = new TreeSet<>(); Integer recycled; while ((recycled = recycledFds.poll()) != null) { - if (recycled >= 3) { + // Aliased/borrowed handles can keep a descriptor live after another + // wrapper releases it. Discard stale recycle entries rather than + // letting a new socket overwrite the current fd owner. + if (recycled >= 3 && !filenoToIO.containsKey(recycled)) { candidates.add(recycled); } } if (candidates.isEmpty()) { return -1; } - Collections.sort(candidates); - int fd = candidates.get(0); + int fd = candidates.first(); // Put back the rest - for (int i = 1; i < candidates.size(); i++) { - recycledFds.add(candidates.get(i)); + for (int candidate : candidates.tailSet(fd + 1)) { + recycledFds.add(candidate); } return fd; } @@ -336,6 +338,7 @@ public void registerExternalFd(int fd) { } filenoToIO.put(fd, this); ioToFileno.put(this, fd); + recycledFds.removeIf(candidate -> candidate == fd); // Advance nextFileno past this fd to avoid collisions nextFileno.updateAndGet(current -> Math.max(current, fd + 1)); } @@ -347,11 +350,14 @@ public void registerExternalFd(int fd) { public void unregisterFileno() { Integer fd = ioToFileno.remove(this); if (fd != null) { - filenoToIO.remove(fd); + // Only the RuntimeIO that still owns the fd mapping may release it. + // Borrowed aliases intentionally share a descriptor; closing an + // older alias must not unregister or recycle the newer live owner. + boolean released = filenoToIO.remove(fd, this); // Return fd to the recycle pool so it can be reused (POSIX: lowest available). // Descriptors 0, 1, and 2 are reserved for stdin/stdout/stderr and must // never be assigned to lazily-numbered regular filehandles. - if (fd >= 3) { + if (released && fd >= 3) { recycledFds.add(fd); } } diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java index 1d4aa2769..d5c52ad1a 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java @@ -1706,8 +1706,18 @@ private RuntimeScalar setLargeRefCounted(RuntimeScalar value) { // $source->{schema} = $self (overwriting weak ref with strong ref) // But avoids false positives from: // my $self = shift (new local variable, oldBase is null) - if (DestroyDispatch.currentDestroyTarget != null + if (thisWasWeak + && DestroyDispatch.currentDestroyTarget != null && oldBase == DestroyDispatch.currentDestroyTarget + // Package weak maps (PPI's global parent indexes are the + // common case) may briefly replace/reuse an entry while its + // target is being destroyed. That is handled by the normal + // refCount>0 resurrection path below; the special rescued- + // object lifecycle is only for an owning aggregate such as a + // DBIC ResultSource saving its Schema through a weak slot. + && containerOwner != null + && !(containerOwner instanceof RuntimeHash owner + && owner.isPackageRootedHash()) && this.value instanceof RuntimeBase base && base == DestroyDispatch.currentDestroyTarget) { DestroyDispatch.destroyTargetRescued = true; @@ -1877,7 +1887,9 @@ private RuntimeScalar setLargeRefCounted(RuntimeScalar value) { // DESTROY, clear weak refs reachable from it now so DBIC-style callbacks // observe that the user's schema lexical is gone. Do not drain all // rescued objects here; DBIC can have other live schemas pending. - if (shouldClearRescuedAfterUndefAssignment && !ModuleInitGuard.inModuleInit()) { + if (shouldClearRescuedAfterUndefAssignment + && DestroyDispatch.isRescued(oldBase) + && !ModuleInitGuard.inModuleInit()) { boolean externallyReachable = ReachabilityWalker.isReachableFromExternalRootExcludingRescued(oldBase); if (System.getenv("JPERL_PHASE_D_DBG") != null) { diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/WarningFlags.java b/src/main/java/org/perlonjava/runtime/runtimetypes/WarningFlags.java index 39baa45c6..27ed8e683 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/WarningFlags.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/WarningFlags.java @@ -409,9 +409,12 @@ public static boolean isEnabledInBits(String bits, String category) { int byteIndex = bitPos / 8; int bitInByte = bitPos % 8; - // Check the specific bit if it's within range - if (byteIndex < bits.length() && (bits.charAt(byteIndex) & (1 << bitInByte)) != 0) { - return true; + // If the mask is long enough to contain the registered category then + // its bit is authoritative. A clear bit can be an explicit + // `no warnings 'Category'` and must not be re-enabled by the broader + // `all` bit below. + if (byteIndex < bits.length()) { + return (bits.charAt(byteIndex) & (1 << bitInByte)) != 0; } // For custom categories, fall back to checking if "all" is enabled. @@ -457,9 +460,9 @@ public static boolean isFatalInBits(String bits, String category) { int byteIndex = bitPos / 8; int bitInByte = bitPos % 8; - // Check the specific bit if it's within range - if (byteIndex < bits.length() && (bits.charAt(byteIndex) & (1 << bitInByte)) != 0) { - return true; + // As for the enabled bit, an in-range clear fatal bit is explicit. + if (byteIndex < bits.length()) { + return (bits.charAt(byteIndex) & (1 << bitInByte)) != 0; } // For custom categories, fall back to checking if "all" is fatal diff --git a/src/main/perl/lib/CPAN/Distribution.pm b/src/main/perl/lib/CPAN/Distribution.pm index 046b843de..6e344d2fe 100644 --- a/src/main/perl/lib/CPAN/Distribution.pm +++ b/src/main/perl/lib/CPAN/Distribution.pm @@ -2498,8 +2498,11 @@ sub _try_perlonjava_fallback_pl { $CPAN::Frontend->myprint("PerlOnJava: Generating fallback Makefile.PL for $module_name $version\n"); - # Write fallback Makefile.PL - if (open my $fh, '>', 'Makefile.PL') { + # Do not overwrite the distribution's Makefile.PL. Generated compatibility + # files are commonly shipped read-only (Module::Build::Compat does this), + # which used to make this fallback silently fail after announcing it. + my $fallback_pl = '.perlonjava-fallback-Makefile.PL'; + if (open my $fh, '>', $fallback_pl) { print $fh $self->_perlonjava_fallback_makefile_pl($args); close $fh; } else { @@ -2513,7 +2516,7 @@ sub _try_perlonjava_fallback_pl { # target even when the module's .pm is already bundled in the PerlOnJava # JAR (otherwise MakeMaker emits a no-op skip message as the test target). local $ENV{JCPAN_RUN_BUNDLED_TESTS} = 1; - my $ret = system($^X, 'Makefile.PL'); + my $ret = system($^X, $fallback_pl); return 0 if $ret != 0; return -f "Makefile" ? 1 : 0; } diff --git a/src/main/perl/lib/Config.pm b/src/main/perl/lib/Config.pm index a558189c3..719174b48 100644 --- a/src/main/perl/lib/Config.pm +++ b/src/main/perl/lib/Config.pm @@ -85,6 +85,38 @@ _ensure_core_probe_file( _catdir($file_separator, $core_privlib, 'File', 'Find.pm'), "# PerlOnJava core-library probe marker.\n# The real File::Find is loaded from jar:PERL5LIB.\n1;\n", ); +my @core_keywords = split ' ', <<'END_CORE_KEYWORDS'; +NULL __FILE__ __LINE__ __PACKAGE__ __CLASS__ __DATA__ __END__ __SUB__ ADJUST AUTOLOAD +BEGIN UNITCHECK DESTROY END INIT CHECK abs accept alarm all and any atan2 bind binmode +bless break caller catch chdir chmod chomp chop chown chr chroot class close closedir +cmp connect continue cos crypt dbmclose dbmopen default defer defined delete die do +dump each else elsif endgrent endhostent endnetent endprotoent endpwent endservent eof +eq eval evalbytes exec exists exit exp fc fcntl field fileno finally flock for foreach +fork format formline ge getc getgrent getgrgid getgrnam gethostbyaddr gethostbyname +gethostent getlogin getnetbyaddr getnetbyname getnetent getpeername getpgrp getppid +getpriority getprotobyname getprotobynumber getprotoent getpwent getpwnam getpwuid +getservbyname getservbyport getservent getsockname getsockopt given glob gmtime goto +grep gt hex if index int ioctl isa join keys kill last lc lcfirst le length link listen +local localtime lock log lstat lt m map method mkdir msgctl msgget msgrcv msgsnd my ne +next no not oct open opendir or ord our pack package pipe pop pos print printf +prototype push q qq qr quotemeta qw qx rand read readdir readline readlink readpipe +recv redo ref rename require reset return reverse rewinddir rindex rmdir s say scalar +seek seekdir select semctl semget semop send setgrent sethostent setnetent setpgrp +setpriority setprotoent setpwent setservent setsockopt shift shmctl shmget shmread +shmwrite shutdown sin sleep socket socketpair sort splice split sprintf sqrt srand stat +state study sub substr symlink syscall sysopen sysread sysseek system syswrite tell +telldir tie tied time times tr try truncate uc ucfirst umask undef unless unlink unpack +unshift untie until use utime values vec wait waitpid wantarray warn when while write x +xor y +END_CORE_KEYWORDS +my $keyword_number = 0; +my $keywords_header = join '', map { + sprintf "#define KEY_%s\t\t%d\n", $_, $keyword_number++ +} @core_keywords; +_ensure_core_probe_file( + _catdir($file_separator, $core_archlib, 'CORE', 'keywords.h'), + $keywords_header, +) if length $keywords_header; sub _perl_os_name { my ($name) = @_; diff --git a/src/main/perl/lib/Digest/JHash.pm b/src/main/perl/lib/Digest/JHash.pm new file mode 100644 index 000000000..d2f303243 --- /dev/null +++ b/src/main/perl/lib/Digest/JHash.pm @@ -0,0 +1,39 @@ +package Digest::JHash; + +use strict; +use warnings; + +require 5.008; +require Exporter; +require XSLoader; + +our @ISA = qw(Exporter); +our @EXPORT_OK = qw(jhash); +our $VERSION = '0.10'; + +XSLoader::load('Digest::JHash', $VERSION); + +1; + +__END__ + +=head1 NAME + +Digest::JHash - 32-bit Jenkins hashing for PerlOnJava + +=head1 DESCRIPTION + +This is a PerlOnJava port of Digest::JHash. The original Perl interface is +retained and its XS implementation is replaced by an equivalent Java method. + +=head1 AUTHORS + +The JHash implementation was written by Bob Jenkins. The original Perl +extension was written by Andrew Towers, with modifications by James Freeman. + +=head1 LICENSE + +This package may be used, redistributed, and modified under the Artistic +License 2.0, matching the original distribution. + +=cut diff --git a/src/main/perl/lib/ExtUtils/MakeMaker.pm b/src/main/perl/lib/ExtUtils/MakeMaker.pm index 35aca0b5b..56d315ca2 100644 --- a/src/main/perl/lib/ExtUtils/MakeMaker.pm +++ b/src/main/perl/lib/ExtUtils/MakeMaker.pm @@ -1306,7 +1306,10 @@ sub _current_perl_path { # rather than failing the whole install. sub _shell_cp { my ($src, $dest, $autodir) = @_; - my $should_autosplit = defined($autodir) && $src =~ /\.pm\z/i && $dest =~ /\.pm\z/i; + my $should_autosplit = defined($autodir) + && $src =~ /\.pm\z/i + && $dest =~ /\.pm\z/i + && _source_uses_autoloader($src); $src =~ s/'/'\\''/g; # escape single quotes $dest =~ s/'/'\\''/g; my $autosplit = ''; @@ -1318,6 +1321,33 @@ sub _shell_cp { return "\t\@if [ -f '$src' ]; then rm -f '$dest' && cp '$src' '$dest'$autosplit; else echo 'PerlOnJava: skipping missing source: $src'; fi"; } +# AutoSplit's fourth argument performs this same source check, but doing it +# after every copy starts a fresh jperl JVM for every module containing an +# __END__ marker. Large pure-Perl distributions commonly put POD after that +# marker, so the otherwise harmless check can add many minutes to a build. +# Mirror AutoSplit's detection while the Makefile is being generated and only +# emit an autosplit command for modules that can actually need one. +sub _source_uses_autoloader { + my ($src) = @_; + return 0 unless defined $src && -f $src; + + open my $fh, '<', $src or return 0; + my $in_pod = 0; + while (my $line = <$fh>) { + $in_pod = 1 if $line =~ /^=\w/; + $in_pod = 0 if $line =~ /^=cut/; + next if $in_pod || $line =~ /^=cut/ || $line =~ /^\s*#/; + last if $line =~ /^__END__/; + if ($line =~ /^\s*(?:use|require)\s+AutoLoader\b/ + || $line =~ /\bISA\s*=.*\bAutoLoader\b/) { + close $fh; + return 1; + } + } + close $fh; + return 0; +} + # Helper: rewrite staged script shebangs such as "#!perl -w" to a shell wrapper # that execs the current jperl against a hidden copy of the original script. # Some CPAN tests execute blib/script/* directly; a plain "#!/path/to/jperl" diff --git a/src/test/resources/module/Digest-JHash/t/jhash.t b/src/test/resources/module/Digest-JHash/t/jhash.t new file mode 100644 index 000000000..f7765cc92 --- /dev/null +++ b/src/test/resources/module/Digest-JHash/t/jhash.t @@ -0,0 +1,9 @@ +use Test::More tests => 6; +use Digest::JHash qw(jhash); + +is(Digest::JHash::jhash("hello world"), 447289830, 'direct call'); +is(jhash("goodbye cruel world"), 969307542, 'exported call'); +is(jhash(undef), 0, 'undef hashes as the empty string'); +is(jhash(''), 0, 'empty string'); +is(jhash('a' x 12), 234809978, 'full 12-byte block'); +is(jhash("\x00\xff\x80"), 910699166, 'binary octets'); diff --git a/src/test/resources/unit/config_core_keywords_header.t b/src/test/resources/unit/config_core_keywords_header.t new file mode 100644 index 000000000..c58ecd774 --- /dev/null +++ b/src/test/resources/unit/config_core_keywords_header.t @@ -0,0 +1,15 @@ +use strict; +use warnings; +use Test::More tests => 3; +use Config; +use File::Spec; + +my $header = File::Spec->catfile($Config{archlibexp}, 'CORE', 'keywords.h'); +ok(-f $header, 'archlib CORE contains keywords.h'); + +open my $fh, '<', $header or die "open $header: $!"; +my $contents = do { local $/; <$fh> }; +close $fh or die "close $header: $!"; + +like($contents, qr/^#define\s+KEY___FILE__\s+\d+/m, 'header defines __FILE__ keyword'); +like($contents, qr/^#define\s+KEY_any\s+\d+/m, 'header defines any keyword'); diff --git a/src/test/resources/unit/cpan_fallback_readonly_makefile.t b/src/test/resources/unit/cpan_fallback_readonly_makefile.t new file mode 100644 index 000000000..999fd4664 --- /dev/null +++ b/src/test/resources/unit/cpan_fallback_readonly_makefile.t @@ -0,0 +1,46 @@ +use strict; +use warnings; +use Test::More; +use Cwd qw(getcwd); +use File::Temp qw(tempdir); + +use CPAN::Distribution; + +plan skip_all => 'CPAN::Distribution fallback helper unavailable' + unless CPAN::Distribution->can('_try_perlonjava_fallback_pl'); + +{ + package Local::ReadOnlyFallbackDist; + our @ISA = qw(CPAN::Distribution); + sub _perlonjava_fallback_pl_args_from_meta_files { + return { NAME => 'Local::ReadOnlyFallback', VERSION => '0.001' }; + } + + package Local::SilentFrontend; + sub myprint { return } +} + +my $cwd = getcwd(); +my $dist_dir = tempdir(CLEANUP => 1); +chdir $dist_dir or die "Could not chdir to $dist_dir: $!"; + +open my $original, '>', 'Makefile.PL' or die "Could not create Makefile.PL: $!"; +print {$original} "# original generated compatibility file\n"; +close $original; +chmod 0444, 'Makefile.PL' or die "Could not make Makefile.PL read-only: $!"; + +my $dist = bless {}, 'Local::ReadOnlyFallbackDist'; +local $CPAN::Frontend = bless {}, 'Local::SilentFrontend'; +ok($dist->_try_perlonjava_fallback_pl('ignored original command'), + 'fallback succeeds beside a read-only Makefile.PL'); +ok(-f 'Makefile', 'fallback script generated a Makefile'); +ok(-f '.perlonjava-fallback-Makefile.PL', 'fallback uses a separate script'); + +open my $unchanged, '<', 'Makefile.PL' or die "Could not reopen Makefile.PL: $!"; +is(do { local $/; <$unchanged> }, "# original generated compatibility file\n", + 'fallback preserves the distribution Makefile.PL'); +close $unchanged; +chmod 0644, 'Makefile.PL'; +chdir $cwd or die "Could not restore working directory to $cwd: $!"; + +done_testing(); diff --git a/src/test/resources/unit/makemaker_autosplit_autoloader_only.t b/src/test/resources/unit/makemaker_autosplit_autoloader_only.t new file mode 100644 index 000000000..18be88118 --- /dev/null +++ b/src/test/resources/unit/makemaker_autosplit_autoloader_only.t @@ -0,0 +1,42 @@ +use strict; +use warnings; +use Test::More; +use Cwd qw(getcwd); +use File::Path qw(make_path); +use File::Temp qw(tempdir); + +my $orig_dir = getcwd(); +my $tmpdir = tempdir(CLEANUP => 1); +END { chdir $orig_dir if defined $orig_dir } + +chdir $tmpdir or die "chdir $tmpdir: $!"; +make_path('lib/Local') or die "make_path lib/Local: $!"; + +open my $pod_pm, '>', 'lib/Local/PodOnly.pm' or die "create POD-only module: $!"; +print {$pod_pm} "package Local::PodOnly;\n1;\n__END__\n=head1 NAME\n\nLocal::PodOnly\n\n=cut\n"; +close $pod_pm or die "close POD-only module: $!"; + +open my $loader_pm, '>', 'lib/Local/Loader.pm' or die "create AutoLoader module: $!"; +print {$loader_pm} "package Local::Loader;\nuse AutoLoader;\n1;\n__END__\nsub deferred { 42 }\n"; +close $loader_pm or die "close AutoLoader module: $!"; + +use ExtUtils::MakeMaker; +WriteMakefile( + NAME => 'Local::AutosplitSelection', VERSION => '0.001', + PM => { + 'lib/Local/PodOnly.pm' => '$(INST_LIB)/Local/PodOnly.pm', + 'lib/Local/Loader.pm' => '$(INST_LIB)/Local/Loader.pm', + }, +); + +open my $mf, '<', 'Makefile' or die "open generated Makefile: $!"; +my $makefile = do { local $/; <$mf> }; +close $mf or die "close generated Makefile: $!"; + +unlike($makefile, qr/autosplit\([^\n]+Local\/PodOnly\.pm/, + 'POD-only __END__ markers do not trigger AutoSplit'); +ok($makefile =~ qr/autosplit\([^\n]+Local\/Loader\.pm/ + || $makefile =~ qr/pm_to_blib\(\{\@ARGV\}/, + 'modules using AutoLoader remain covered by the staging rule'); + +done_testing(); diff --git a/src/test/resources/unit/special_control_globals_stash.t b/src/test/resources/unit/special_control_globals_stash.t new file mode 100644 index 000000000..5dfb5bfe5 --- /dev/null +++ b/src/test/resources/unit/special_control_globals_stash.t @@ -0,0 +1,13 @@ +use strict; +use warnings; +use Test::More; + +my @absent = qw(B G J K Q U Y Z); +my %stash_keys = map { $_ => 1 } keys %main::; + +for my $letter (@absent) { + my $key = chr(ord($letter) - ord('A') + 1); + ok(!$stash_keys{$key}, "non-special \$^$letter is absent from main stash enumeration"); +} + +done_testing();