enable ro-accessors for natively typed attributes

rakudo · Jul 25, 2011 · 512670d · 512670d
1 parent 953c714
commit 512670d
Show file tree

Hide file tree

Showing 3 changed files with 59 additions and 24 deletions.
diff --git a/NOMMAP.markdown b/NOMMAP.markdown
@@ -14,8 +14,7 @@ Things that aren't blockers but might be worth knowing about:
 * attribute := doesn't work in CORE.setting (works outside of setting, though)
   (initial digging suggets it's a BOOTSTRAPATTR issue, thus why we only see it
   in the setting)
-* 'has num $.attr' segfaults on access to .attr, because it uses the PMC form
-  of get_attribute
+* no rw-accessors for natively typed attributes (yet?)
 
 ## Lexical Multi-Part names
 For my X::Base { ... }, my Foo::Bar { ... } etc. The our-scoped ones work.

diff --git a/src/core/Attribute.pm b/src/core/Attribute.pm
@@ -7,21 +7,62 @@ my class Attribute {
             my $meth_name := nqp::substr(nqp::unbox_s($name), 2);
             unless $package.HOW.declares_method($package, $meth_name) {
                 my $dcpkg := pir::perl6_decontainerize__PP($package);
-                my $meth  := self.rw
-                    ??
-                    method (Mu $self:) is rw {
-                        nqp::getattr(
-                            pir::perl6_decontainerize__PP($self),
-                            $dcpkg,
-                            nqp::unbox_s($name))
-                    }
-                    !!
-                    method (Mu $self:) {
-                        nqp::getattr(
-                            pir::perl6_decontainerize__PP($self),
-                            $dcpkg,
-                            nqp::unbox_s($name))
-                    };
+                my $meth;
+                my int $attr_type = pir::repr_get_primitive_type_spec__IP($!type);
+                if self.rw {
+                    $meth  := nqp::p6bool(nqp::iseq_i($attr_type, 0))
+                        ??
+                        method (Mu $self:) is rw {
+                            nqp::getattr(
+                                pir::perl6_decontainerize__PP($self),
+                                $dcpkg,
+                                nqp::unbox_s($name))
+                        }
+                        !!
+                        pir::die("Cannot create rw-accessors for natively typed attribute '$name'");
+                } else {
+                    # ro accessor
+                    $meth  := nqp::p6bool(nqp::iseq_i($attr_type, 0))
+                        ??
+                        method (Mu $self:) {
+                            nqp::getattr(
+                                pir::perl6_decontainerize__PP($self),
+                                $dcpkg,
+                                nqp::unbox_s($name))
+                        }
+                        !!
+                        nqp::p6bool(nqp::iseq_i($attr_type, 1))
+                        ??
+                        method (Mu $self:) {
+                            nqp::p6box_i(
+                                nqp::getattr_i(
+                                    pir::perl6_decontainerize__PP($self),
+                                    $dcpkg,
+                                    nqp::unbox_s($name))
+                            );
+                        }
+                        !!
+                        nqp::p6bool(nqp::iseq_i($attr_type, 2))
+                        ??
+                        method (Mu $self:) {
+                            nqp::p6box_n(
+                                nqp::getattr_n(
+                                    pir::perl6_decontainerize__PP($self),
+                                    $dcpkg,
+                                    nqp::unbox_s($name))
+                            );
+                        }
+                        !!
+                        method (Mu $self:) {
+                            nqp::p6box_s(
+                                nqp::getattr_s(
+                                    pir::perl6_decontainerize__PP($self),
+                                    $dcpkg,
+                                    nqp::unbox_s($name))
+                            );
+                        }
+
+                }
                 $package.HOW.add_method($package, $meth_name, $meth);
             }
         }

diff --git a/src/core/Complex.pm b/src/core/Complex.pm
@@ -1,12 +1,7 @@
 # XXX should also be Cool
 my class Complex is Numeric {
-    has num $!re;
-    has num $!im;
-
-    # XXX should not be needed, but currently segfaults
-    # with the autogenerated accessors (has num $.re)
-    method re() { $!re }
-    method im() { $!im }
+    has num $.re;
+    has num $.im;
 
     proto method new(|$) { * }
     multi method new(Real \$re, Real \$im) {