Transparently support Inline::Perl5

This allows most of the S01-perl-5-integration spec tests to pass if Inline::Perl5 is installed.
rakudo · Apr 16, 2015 · 5eff25a · 5eff25a
1 parent 67df04e
commit 5eff25a
Show file tree

Hide file tree

Showing 3 changed files with 33 additions and 2 deletions.
diff --git a/src/Perl6/ModuleLoader.nqp b/src/Perl6/ModuleLoader.nqp
@@ -16,9 +16,9 @@ class Perl6::ModuleLoader does Perl6::ModuleLoaderVMConfig {
         'NQP', nqp::gethllsym('nqp', 'ModuleLoader'),
     );
 
-    method register_language_module_loader($lang, $loader) {
+    method register_language_module_loader($lang, $loader, :$force) {
         nqp::die("Language loader already registered for $lang")
-            if nqp::existskey(%language_module_loaders, $lang);
+            if ! $force && nqp::existskey(%language_module_loaders, $lang);
         %language_module_loaders{$lang} := $loader;
     }
 

diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp
@@ -3159,4 +3159,20 @@ class Perl6::World is HLL::World {
     }
 }
 
+my class Perl5ModuleLoaderStub {
+    method load_module($module_name, %opts, *@GLOBALish, :$line, :$file) {
+        {
+            nqp::gethllsym('perl6', 'ModuleLoader').load_module('Inline::Perl5', {}, @GLOBALish, :$line, :$file);
+            CATCH {
+                nqp::die("Please install Inline::Perl5 for Perl 5 support");
+            }
+        }
+
+        # Inline::Perl5 has overwritten this module loader at this point
+        return Perl6::ModuleLoader.load_module($module_name, %opts, @GLOBALish, :$line, :$file);
+    }
+}
+
+nqp::gethllsym('perl6', 'ModuleLoader').register_language_module_loader('Perl5', Perl5ModuleLoaderStub);
+
 # vim: ft=perl6 expandtab sw=4
diff --git a/src/core/control.pm b/src/core/control.pm
@@ -195,6 +195,21 @@ multi sub warn(*@msg) is hidden-from-backtrace {
 }
 
 proto sub EVAL($, *%) {*}
+multi sub EVAL(Cool $code, Str :$lang where { ($lang // '') eq 'perl5' }, PseudoStash :$context) {
+    my $eval_ctx := nqp::getattr(nqp::decont($context // CALLER::), PseudoStash, '$!ctx');
+    my $?FILES   := 'EVAL_' ~ (state $no)++;
+    state $p5;
+    unless $p5 {
+        {
+            require Inline::Perl5;
+            CATCH {
+                X::Eval::NoSuchLang.new(:$lang).throw;
+            }
+        }
+        $p5 = ::("Inline::Perl5").default_perl5;
+    }
+    $p5.run($code);
+}
 multi sub EVAL(Cool $code, :$lang = 'perl6', PseudoStash :$context) {
     my $eval_ctx := nqp::getattr(nqp::decont($context // CALLER::), PseudoStash, '$!ctx');
     my $?FILES   := 'EVAL_' ~ (state $no)++;