diff --git a/src/main/java/org/perlonjava/core/Configuration.java b/src/main/java/org/perlonjava/core/Configuration.java index 1d4acc845..e5f940598 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 = "82c10284e"; + public static final String gitCommitId = "ff1da2bbb"; /** * 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 29 2026 13:31:56"; + public static final String buildTimestamp = "Apr 29 2026 13:59:18"; // Prevent instantiation private Configuration() { diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/XSLoader.java b/src/main/java/org/perlonjava/runtime/perlmodule/XSLoader.java index a0347de45..12dba7108 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/XSLoader.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/XSLoader.java @@ -223,6 +223,16 @@ public static RuntimeList load(RuntimeArray args, int ctx) { if (inc != null && inc.exists(ppKey).getBoolean()) { return scalarTrue.getList(); } + // Last-ditch fallback: if PerlOnJava bundles a pure-Perl shim + // for this module under jar:PERL5LIB (src/main/perl/lib/...), + // eval it now. The shim is responsible for installing the subs + // the XS bootstrap would normally have provided. This is how + // we support XS-only CPAN modules whose dist .pm sits earlier + // in @INC and calls XSLoader::load before defining anything + // (e.g. Class::C3::XS). + if (loadJarShimOverrides(moduleName)) { + return scalarTrue.getList(); + } // Error message matches pattern /object version|loadable object/ that many // CPAN modules (DateTime, JSON::XS, etc.) expect for pure Perl fallback return WarnDie.die( @@ -322,12 +332,13 @@ public static RuntimeList bootstrap_inherit(RuntimeArray args, int ctx) { * which installs any subroutine definitions into the already-loaded package namespace. * * @param moduleName The fully qualified Perl module name (e.g., "Template::Stash::XS") + * @return true if a jar shim was found and successfully eval'd, false otherwise. */ - private static void loadJarShimOverrides(String moduleName) { + private static boolean loadJarShimOverrides(String moduleName) { // Guard against recursion: the shim code may call XSLoader::load() again // for the same module (e.g. Clone.pm's eval { XSLoader::load('Clone') }) if (!shimLoadingInProgress.add(moduleName)) { - return; // Already loading this module's shim — break the cycle + return false; // Already loading this module's shim — break the cycle } try { // Convert module name to file path: Template::Stash::XS -> Template/Stash/XS.pm @@ -337,7 +348,7 @@ private static void loadJarShimOverrides(String moduleName) { // Check if a jar: version exists InputStream is = Jar.openInputStream(jarPath); if (is == null) { - return; // No jar: shim for this module + return false; // No jar: shim for this module } // Read the content @@ -350,8 +361,10 @@ private static void loadJarShimOverrides(String moduleName) { // Eval the code to install any method overrides into the package EvalStringHandler.evalString(code, new RuntimeBase[0], jarPath, 1); + return true; } catch (Exception e) { // Silently ignore - the module works via inheritance anyway + return false; } finally { shimLoadingInProgress.remove(moduleName); } diff --git a/src/main/perl/lib/Class/C3/XS.pm b/src/main/perl/lib/Class/C3/XS.pm new file mode 100644 index 000000000..4d22bda4b --- /dev/null +++ b/src/main/perl/lib/Class/C3/XS.pm @@ -0,0 +1,139 @@ +package Class::C3::XS; + +# PerlOnJava: pure-Perl shim for the XS-only Class::C3::XS module. +# +# Class::C3::XS provides XS speedups for Class::C3. PerlOnJava can't +# load XS, but core mro (always available on perl >= 5.9.5) provides +# equivalent functionality, so we implement the four functions that +# Class::C3::XS exposes as pure-Perl wrappers over core mro and the +# symbol table. The dist's own lib/Class/C3/XS.pm sits earlier in +# @INC, calls XSLoader::load("Class::C3::XS") in its body, and then +# defines next::can / next::method / maybe::next::method on top of +# Class::C3::XS::_nextcan. PerlOnJava's XSLoader intercepts the load +# call, evals this file to install the four subs, and returns success +# so the dist's pm finishes wiring up next::*. + +use strict; +use warnings; +use mro; + +our $VERSION = '0.15'; + +# Class::C3::XS::calculateMRO($class) -- returns the C3 linearisation +# as a list. Trivially backed by core mro. +sub calculateMRO { + my ($class) = @_; + return @{ mro::get_linear_isa($class, 'c3') }; +} + +# Class::C3::XS::_plsubgen() -- returns a method-cache generation +# counter. Real Perl exposes PL_sub_generation, which is bumped any +# time a sub is (re-)defined. Class::C3 only consults this value to +# detect when its cached method-dispatch tables need invalidation, so +# returning a strictly increasing integer is sufficient. +{ + my $gen = 0; + sub _plsubgen { ++$gen } +} + +# Class::C3::XS::_calculate_method_dispatch_table($class, $merge_cache) +# -- Class::C3 only calls this on a perl that lacks core c3 mro. With +# core mro available (PerlOnJava reports 5.40+), c3 dispatch is handled +# by the interpreter itself, so this can be a no-op. This matches the +# early-return in Class::C3 0.34's pure-Perl +# _calculate_method_dispatch_table when $C3_IN_CORE is true. +sub _calculate_method_dispatch_table { + return; +} + +# Class::C3::XS::_nextcan($self_or_class, $wantsub) +# +# Locate the next method in C3 MRO order, starting from the method +# that is currently executing (identified via caller()). Returns a +# code ref, or undef when nothing is found and $wantsub is false. +# When $wantsub is true and nothing is found, croaks with the same +# wording the XS implementation uses, which several CPAN test suites +# match against. +sub _nextcan { + my ($self, $wantsub) = @_; + my $class = ref($self) || $self; + + # Walk up the call stack past the next:: / maybe::next:: dispatch + # subs (and any user shim that goto'd into them) to the real + # method we are "next-ing" out of. + my $level = 1; + my $caller_sub; + while (1) { + my @c = caller($level); + last unless @c; + my $sub = $c[3]; + if (defined $sub + && $sub ne '(eval)' + && $sub !~ /^(?:next|maybe::next)::/) + { + $caller_sub = $sub; + last; + } + $level++; + } + + unless (defined $caller_sub) { + return undef unless $wantsub; + require Carp; + Carp::croak("Can't determine calling sub for next::method on $class"); + } + + my ($caller_pkg, $method) = $caller_sub =~ /^(.+)::([^:]+)$/; + unless (defined $method) { + return undef unless $wantsub; + require Carp; + Carp::croak("Can't extract method name from $caller_sub"); + } + + no strict 'refs'; + my $found = 0; + for my $pkg (@{ mro::get_linear_isa($class) }) { + if (!$found) { + $found = 1 if $pkg eq $caller_pkg; + next; + } + if (defined &{"${pkg}::${method}"}) { + return \&{"${pkg}::${method}"}; + } + } + + return undef unless $wantsub; + require Carp; + Carp::croak("No next::method '$method' found for $class"); +} + +# Mirror the next::* / maybe::next::* dispatch subs the dist's +# lib/Class/C3/XS.pm installs after XSLoader::load returns. PerlOnJava's +# MakeMaker shim skips installing the dist's .pm (it's superseded by the +# bundled jar shim), so we have to define these ourselves. Real Perl's +# next::method / next::can are also re-defined here in regular Perl; +# replacing them is the whole point of loading Class::C3::XS, and tests +# such as t/36_next_goto.t rely on `goto &next::can` resolving to a real +# coderef, which the core implementation does not provide. +package # hide me from PAUSE + next; + +sub can { Class::C3::XS::_nextcan($_[0], 0) } + +sub method { + my $method = Class::C3::XS::_nextcan($_[0], 1); + goto &$method; +} + +package # hide me from PAUSE + maybe::next; + +sub method { + my $method = Class::C3::XS::_nextcan($_[0], 0); + goto &$method if defined $method; + return; +} + +package Class::C3::XS; + +1;