Reinstate required/default semantics on natives

Natively typed attributes "worked" with these features, albeit with somewhat questionable semantics. Retain this behavior.
rakudo · Dec 7, 2021 · 1352236 · 1352236
1 parent 71f8981
commit 1352236
Show file tree

Hide file tree

Showing 3 changed files with 81 additions and 10 deletions.
diff --git a/src/Perl6/Metamodel/BUILDPLAN.nqp b/src/Perl6/Metamodel/BUILDPLAN.nqp
@@ -28,6 +28,9 @@ role Perl6::Metamodel::BUILDPLAN {
     #   12 same as 0, but init to nqp::hash if value absent (nqp only)
     #   13 same as 0 but *bind* the received value + optional type constraint
     #   14 same as 4 but *bind* the default value + optional type constraint
+    #   15 die if a required int attribute is 0
+    #   16 die if a required num attribute is 0e0
+    #   17 die if a required str attribute is null_s (will be '' in the future)
     method create_BUILDPLAN($obj) {
         # First, we'll create the build plan for just this class.
         my @plan;
@@ -128,7 +131,10 @@ role Perl6::Metamodel::BUILDPLAN {
         # Ensure that any required attributes are set
         for @attrs {
             if nqp::can($_, 'required') && $_.required {
-                nqp::push(@plan,[8, $obj, $_.name, $_.required]);
+                my $type := $_.type;
+                my int $primspec := nqp::objprimspec($type);
+                my int $op := $primspec ?? 14 + $primspec !! 8;
+                nqp::push(@plan,[$op, $obj, $_.name, $_.required]);
                 nqp::deletekey(%attrs_untouched, $_.name);
             }
         }

diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp
@@ -3877,20 +3877,45 @@ class Perl6::World is HLL::World {
                             $!w.add_object_if_no_sc(nqp::atpos($task,3));
                         }
 
-                        # 8 = bail if opaque not yet initialized
-                        elsif $code == 8 {
-
+                        # 8 = die if opaque not yet initialized
+                        # 15 = die if int is 0
+                        # 16 = die if num is 0e0
+                        # 17 = die if str is null_s
+                        elsif $code == 8 || $code >= 15 && $code <= 17 {
 # nqp::unless(
 #   nqp::p6attrinited(nqp::getattr(self,Foo,'$!a')),
 #   X::Attribute::Required.new(name => '$!a', why => (value))
 # ),
-                            $stmts.push(
-                              QAST::Op.new( :op<unless>,
-                                QAST::Op.new( :op<p6attrinited>,
+                            my $check;
+                            if $code == 15 {
+                                $check := QAST::Op.new( :op<getattr_i>,
+                                  $!self, $class, $attr
+                                );
+                            }
+                            elsif $code == 16 {
+                                $check := QAST::Op.new( :op<getattr_n>,
+                                  $!self, $class, $attr
+                                );
+                            }
+                            elsif $code == 17 {
+                                $check := QAST::Op.new( :op<not_i>,
+                                  QAST::Op.new( :op<isnull_s>,
+                                    QAST::Op.new( :op<getattr_s>,
+                                      $!self, $class, $attr
+                                    )
+                                  )
+                                );
+                            }
+                            else {
+                                $check := QAST::Op.new( :op<p6attrinited>,
                                   QAST::Op.new( :op<getattr>,
                                     $!self, $class, $attr
                                   )
-                                ),
+                                );
+                            }
+                            $stmts.push(
+                              QAST::Op.new( :op<unless>,
+                                $check,
                                 QAST::Op.new( :op<callmethod>, :name<throw>,
                                   QAST::Op.new( :op<callmethod>, :name<new>,
                                     QAST::WVal.new(

diff --git a/src/core.c/Mu.pm6 b/src/core.c/Mu.pm6
@@ -365,8 +365,48 @@ my class Mu { # declared in BOOTSTRAP
                                       )
                                     )
                                   ),
-                                  die('Invalid ' ~ self.^name ~ ".BUILDALL plan: $code"),
-                  ))))))))))),
+
+                                  nqp::if(
+                                    nqp::iseq_i($code,15),
+                                    nqp::unless(   # 15
+                                      nqp::getattr_i(self,
+                                        nqp::atpos($task,1),
+                                        nqp::atpos($task,2)
+                                      ),
+                                      X::Attribute::Required.new(
+                                        name => nqp::atpos($task,2),
+                                        why  => nqp::atpos($task,3)
+                                      ).throw
+                                    ),
+
+                                    nqp::if(
+                                      nqp::iseq_i($code,16),
+                                      nqp::unless(   # 16
+                                        nqp::getattr_n(self,
+                                          nqp::atpos($task,1),
+                                          nqp::atpos($task,2)
+                                        ),
+                                        X::Attribute::Required.new(
+                                          name => nqp::atpos($task,2),
+                                          why  => nqp::atpos($task,3)
+                                        ).throw
+                                      ),
+
+                                      nqp::if(
+                                        nqp::iseq_i($code,17),
+                                        nqp::if(   # 17
+                                          nqp::isnull_s(nqp::getattr_s(self,
+                                            nqp::atpos($task,1),
+                                            nqp::atpos($task,2)
+                                          )),
+                                          X::Attribute::Required.new(
+                                            name => nqp::atpos($task,2),
+                                            why  => nqp::atpos($task,3)
+                                          ).throw
+                                        ),
+
+                                        die('Invalid ' ~ self.^name ~ ".BUILDALL plan: $code"),
+                  )))))))))))))),
 
                   nqp::if(                       # 0
                     nqp::existskey($init,nqp::atpos($task,3)),