Fix for #2714

rakudo · Feb 22, 2019 · 90d81c7 · 90d81c7
1 parent d656381
commit 90d81c7
Show file tree

Hide file tree

Showing 2 changed files with 23 additions and 7 deletions.
diff --git a/src/Perl6/Metamodel/ParametricRoleGroupHOW.nqp b/src/Perl6/Metamodel/ParametricRoleGroupHOW.nqp
@@ -21,6 +21,7 @@ class Perl6::Metamodel::ParametricRoleGroupHOW
     has @!candidates;
     has $!selector;
     has @!role_typecheck_list;
+    has @!nonsignatured;
 
     my $archetypes := Perl6::Metamodel::Archetypes.new( :nominal(1), :composable(1), :inheritalizable(1), :parametric(1) );
     method archetypes() {
@@ -89,6 +90,7 @@ class Perl6::Metamodel::ParametricRoleGroupHOW
 
     method add_possibility($obj, $possible) {
         @!candidates[+@!candidates] := $possible;
+        nqp::push(@!nonsignatured, nqp::decont($possible)) unless $possible.HOW.signatured($possible);
         $!selector.add_dispatchee($possible.HOW.body_block($possible));
         self.update_role_typecheck_list($obj);
     }
@@ -131,11 +133,8 @@ class Perl6::Metamodel::ParametricRoleGroupHOW
     }
 
     method update_role_typecheck_list($obj) {
-        for @!candidates {
-            if !$_.HOW.signatured($_) {
-                @!role_typecheck_list := $_.HOW.role_typecheck_list($_);
-            }
-        }
+        my $ns := self.'!get_nonsignatured_candidate'($obj);
+        @!role_typecheck_list := $ns.HOW.role_typecheck_list($ns) unless nqp::isnull($ns);
     }
 
     method role_typecheck_list($obj) {
@@ -157,6 +156,8 @@ class Perl6::Metamodel::ParametricRoleGroupHOW
                 return 1;
             }
         }
+        my $ns := self.'!get_nonsignatured_candidate'($obj);
+        return $ns.HOW.type_check_parents($ns, $decont) unless nqp::isnull($ns);
         0;
     }
 
@@ -193,6 +194,11 @@ class Perl6::Metamodel::ParametricRoleGroupHOW
     }
 
     method !get_default_candidate($obj) {
-        @!candidates[0]
+        self.'!get_nonsignatured_candidate'($obj) || @!candidates[0]
+    }
+
+    method !get_nonsignatured_candidate($obj) {
+        return nqp::null unless +@!nonsignatured;
+        @!nonsignatured[0]
     }
 }
diff --git a/src/Perl6/Metamodel/ParametricRoleHOW.nqp b/src/Perl6/Metamodel/ParametricRoleHOW.nqp
@@ -114,6 +114,16 @@ class Perl6::Metamodel::ParametricRoleHOW
         @!role_typecheck_list
     }
 
+    # $checkee must always be decont'ed
+    method type_check_parents($obj, $checkee) {
+        for self.parents($obj, :local) -> $parent {
+            if nqp::istype($checkee, $parent) {
+                return 1;
+            }
+        }
+        0
+    }
+
     method type_check($obj, $checkee) {
         my $decont := nqp::decont($checkee);
         if $decont =:= $obj.WHAT {
@@ -132,7 +142,7 @@ class Perl6::Metamodel::ParametricRoleHOW
                 return 1;
             }
         }
-        0
+        self.type_check_parents($obj, $decont);
     }
 
     method specialize($obj, *@pos_args, *%named_args) {