Fix up handling of how protos are created for the role selection mult…

…i-dispatch.
rakudo · Sep 11, 2011 · 056cf10 · 056cf10
1 parent b2e3176
commit 056cf10
Show file tree

Hide file tree

Showing 2 changed files with 19 additions and 2 deletions.
diff --git a/src/Perl6/Metamodel/BOOTSTRAP.pm b/src/Perl6/Metamodel/BOOTSTRAP.pm
@@ -716,6 +716,18 @@ Perl6::Metamodel::CurriedRoleHOW.configure_punning(
     Perl6::Metamodel::ClassHOW,
     hash( ACCEPTS => Mu ));
 
+# Need to tell parametric role groups how to create a dispatcher.
+Perl6::Metamodel::ParametricRoleGroupHOW.set_selector_creator({
+    my $sel := nqp::create(Sub);
+    my $onlystar := -> *@pos, *%named {
+        pir::perl6_enter_multi_dispatch_from_onlystar_block__P();
+    };
+    pir::perl6_associate_sub_code_object__vPP($onlystar, $sel);
+    nqp::bindattr($sel, Code, '$!dispatchees', $onlystar);
+    nqp::bindattr($sel, Code, '$!dispatchees', []);
+    $sel
+});
+
 # Similar for packages and modules, but just has methods from Any.
 Perl6::Metamodel::PackageHOW.pretend_to_be([Any, Mu]);
 Perl6::Metamodel::PackageHOW.delegate_methods_to(Any);

diff --git a/src/Perl6/Metamodel/ParametricRoleGroupHOW.pm b/src/Perl6/Metamodel/ParametricRoleGroupHOW.pm
@@ -22,8 +22,13 @@ class Perl6::Metamodel::ParametricRoleGroupHOW
         $archetypes
     }
 
-    method new_type(:$name!, :$selector!, :$repr) {
-        my $meta := self.new(:name($name), :selector($selector));
+    my $selector_creator;
+    method set_selector_creator($sc) {
+        $selector_creator := $sc;
+    }
+
+    method new_type(:$name!, :$repr) {
+        my $meta := self.new(:name($name), :selector($selector_creator));
         pir::repr_type_object_for__PPS($meta, 'Uninstantiable');
     }