Merge pull request #4073 from vrurg/rakudo_1405

Fix subsets of coercions
rakudo · Nov 29, 2020 · 4e21ada · 4e21ada
2 parents 3202466 + af43ef6
commit 4e21ada
Show file tree

Hide file tree

Showing 3 changed files with 9 additions and 12 deletions.
diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp
@@ -5141,8 +5141,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
 
         # If we have a refinement, make sure it's thunked if needed. If none,
         # just always true.
-        my $refinement := make_where_block($<EXPR>, $<EXPR> ?? $<EXPR>.ast !!
-            QAST::Op.new( :op('hllbool'), QAST::IVal.new( :value(1) ) ));
+        my $refinement := $<EXPR> ?? make_where_block($<EXPR>, $<EXPR>.ast) !! nqp::null();
 
         # Create the meta-object.
         my $subset;

diff --git a/src/Perl6/Metamodel/SubsetHOW.nqp b/src/Perl6/Metamodel/SubsetHOW.nqp
@@ -20,7 +20,6 @@ class Perl6::Metamodel::SubsetHOW
         unless nqp::isconcrete($!archetypes) {
             my $refinee_archetypes := $!refinee.HOW.archetypes;
             my $generic := $refinee_archetypes.generic
-                            || $!refinement.HOW.archetypes.generic
                             || (nqp::defined($!refinement)
                                 && nqp::can($!refinement, 'is_generic')
                                 && $!refinement.is_generic);
@@ -45,7 +44,7 @@ class Perl6::Metamodel::SubsetHOW
     }
 
     method new_type(:$name = '<anon>', :$refinee!, :$refinement!) {
-        my $metasubset := self.new(:refinee($refinee), :refinement($refinement));
+        my $metasubset := self.new(:$refinee, :$refinement);
         my $type := nqp::settypehll(nqp::newtype($metasubset, 'Uninstantiable'), 'Raku');
         $metasubset.set_name($type, $name);
         $metasubset.set_language_version($metasubset, :force);
@@ -79,7 +78,7 @@ class Perl6::Metamodel::SubsetHOW
     }
 
     method refinement($obj) {
-        $!refinement
+        nqp::hllize($!refinement)
     }
 
     method isa($obj, $type) {
@@ -96,9 +95,6 @@ class Perl6::Metamodel::SubsetHOW
                 $ins_refinement := $!refinement.instantiate_generic($type_env);
             }
         }
-        elsif nqp::can($!refinement.HOW, 'instantiate_generic') {
-            $ins_refinement := $!refinement.HOW.instantiate_generic($!refinement, $type_env)
-        }
         self.new_type(:name(self.name($obj)), :refinee($ins_refinee), :refinement($ins_refinement))
     }
 
@@ -128,9 +124,11 @@ class Perl6::Metamodel::SubsetHOW
     method accepts_type($obj, $checkee) {
         nqp::hllboolfor(
             nqp::istype($checkee, $!refinee) &&
-            nqp::istrue($!refinement.ACCEPTS($checkee)),
-            "Raku"
-        )
+            (nqp::isnull($!refinement)
+             || ($!refinee.HOW.archetypes.coercive
+                    ?? nqp::istrue($!refinement.ACCEPTS($!refinee.HOW.coerce($!refinee, $checkee)))
+                    !! nqp::istrue($!refinement.ACCEPTS($checkee)))),
+            "Raku")
     }
 
     # Methods needed by Perl6::Metamodel::Nominalizable

diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp
@@ -4128,7 +4128,7 @@ class Perl6::World is HLL::World {
     # Creates a subset type meta-object/type object pair.
     method create_subset($how, $refinee, $refinement, :$name) {
         # Create the meta-object and add to root objects.
-        my %args := hash(:refinee($refinee), :refinement($refinement));
+        my %args := hash(:$refinee, :$refinement);
         if nqp::defined($name) { %args<name> := $name; }
         my $mo := $how.new_type(|%args);
         self.add_object_if_no_sc($mo);