From c913ddc9736dd40b902963e748a042c0dbb490f0 Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Wed, 29 Apr 2026 14:03:33 +0200 Subject: [PATCH] feat(Class::C3::XS): pure-Perl shim so jcpan -t Class::C3::XS passes Class::C3::XS is XS-only (the dist's lib/Class/C3/XS.pm is just an XSLoader::load + a few next:: dispatch subs). Without XS, the test suite fails 12/13 with "Can't load loadable object". Provide a pure-Perl shim: src/main/perl/lib/Class/C3/XS.pm implementing the four exported subs on top of core mro: - calculateMRO -> mro::get_linear_isa($class, 'c3') - _plsubgen -> monotonically increasing counter - _calculate_method_dispatch_table -> no-op (core mro handles c3) - _nextcan -> walks caller() up past next::/maybe::next:: frames, then searches the C3 MRO from the calling package onward. Also re-define next::can / next::method / maybe::next::method to delegate to _nextcan, mirroring what the dist's pm does. PerlOnJava's MakeMaker shim skips installing the dist's pm (it's superseded by the bundled jar shim), so these definitions have to live here for tests like t/36_next_goto.t (`goto &next::can`) to work. In XSLoader.java, when the existing @ISA / ::PP fallback paths don't apply, try loading a bundled jar:PERL5LIB shim of the same name. This generalises the existing loadJarShimOverrides hook so any future XS module can be backed by dropping a .pm into src/main/perl/lib/. loadJarShimOverrides now returns boolean to signal whether a shim was found. Result: jcpan -t Class::C3::XS passes 46/46 tests across 13 files. 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/XSLoader.java | 19 ++- src/main/perl/lib/Class/C3/XS.pm | 139 ++++++++++++++++++ 3 files changed, 157 insertions(+), 5 deletions(-) create mode 100644 src/main/perl/lib/Class/C3/XS.pm 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;