Add a required attr to Attributes

If "is required" is present, set the attr. not yet enforced
rakudo · Jun 17, 2015 · 212c0c0 · 212c0c0
1 parent 2c58ee1
commit 212c0c0
Show file tree

Hide file tree

Showing 3 changed files with 10 additions and 0 deletions.
diff --git a/src/Perl6/Metamodel/BOOTSTRAP.nqp b/src/Perl6/Metamodel/BOOTSTRAP.nqp
@@ -1083,6 +1083,7 @@ BEGIN {
     Attribute.HOW.add_attribute(Attribute, BOOTSTRAPATTR.new(:name<$!name>, :type(str), :package(Attribute)));
     Attribute.HOW.add_attribute(Attribute, BOOTSTRAPATTR.new(:name<$!rw>, :type(int), :package(Attribute)));
     Attribute.HOW.add_attribute(Attribute, BOOTSTRAPATTR.new(:name<$!ro>, :type(int), :package(Attribute)));
+    Attribute.HOW.add_attribute(Attribute, BOOTSTRAPATTR.new(:name<$!required>, :type(int), :package(Attribute)));
     Attribute.HOW.add_attribute(Attribute, BOOTSTRAPATTR.new(:name<$!has_accessor>, :type(int), :package(Attribute)));
     Attribute.HOW.add_attribute(Attribute, BOOTSTRAPATTR.new(:name<$!type>, :type(Mu), :package(Attribute)));
     Attribute.HOW.add_attribute(Attribute, BOOTSTRAPATTR.new(:name<$!container_descriptor>, :type(Mu), :package(Attribute)));
@@ -1162,6 +1163,11 @@ BEGIN {
                 Attribute, '$!ro', 1);
             nqp::p6bool(1)
         }));
+    Attribute.HOW.add_method(Attribute, 'set_required', nqp::getstaticcode(sub ($self) {
+            nqp::bindattr_i(nqp::decont($self),
+                Attribute, '$!required', 1);
+            nqp::p6bool(1)
+        }));
     Attribute.HOW.add_method(Attribute, 'default_to_rw', nqp::getstaticcode(sub ($self) {
             my $dcself := nqp::decont($self);
             unless nqp::getattr_i($dcself, Attribute, '$!ro') {

diff --git a/src/core/Attribute.pm b/src/core/Attribute.pm
@@ -12,6 +12,7 @@ my class Attribute { # declared in BOOTSTRAP
     #     has int $!positional_delegate;
     #     has int $!associative_delegate;
     #     has Mu $!why;
+    #     has int $!required;
 
     method compose(Mu $package) {
         # Generate accessor method, if we're meant to have one.

diff --git a/src/core/traits.pm b/src/core/traits.pm
@@ -111,6 +111,9 @@ multi sub trait_mod:<is>(Attribute:D $attr, :$readonly!) {
     $attr.set_readonly();
     warn "useless use of 'is readonly' on $attr.name()" unless $attr.has_accessor;
 }
+multi sub trait_mod:<is>(Attribute $attr, :$required!) {
+    $attr.set_required();
+}
 multi sub trait_mod:<is>(Attribute:D $attr, :$box_target!) {
     $attr.set_box_target();
 }