Copy/port code from JnthnNQP to make the attribute initialization calls.

perl6 · Sep 26, 2010 · 57ae6b3 · 57ae6b3
1 parent c51bdac
commit 57ae6b3
Showing 1 changed file with 24 additions and 4 deletions.
diff --git a/src/NQP/Actions.pm b/src/NQP/Actions.pm
@@ -492,11 +492,31 @@ method variable_declarator($/) {
     }
     if $*SCOPE eq 'has' {
         $BLOCK.symbol($name, :scope('attribute') );
-        unless $BLOCK<attributes> {
-            $BLOCK<attributes> :=
-                PAST::Op.new( :pasttype('list'), :named('attr') );
+        if $*PACKAGE-SETUP {
+            # Create and add a meta-attribute.
+            my $meta-attr-type := %*HOW-METAATTR{$*PKGDECL} || $*DEFAULT-METAATTR;
+            $*PACKAGE-SETUP.push(PAST::Op.new(
+                :pasttype('callmethod'), :name('add_attribute'),
+                PAST::Op.new(
+                    :pirop('get_how PP'),
+                    PAST::Var.new( :name('type_obj'), :scope('register') )
+                ),
+                PAST::Var.new( :name('type_obj'), :scope('register') ),
+                PAST::Op.new(
+                    :pasttype('callmethod'), :name('new'),
+                    PAST::Var.new( :name($meta-attr-type), :namespace(''), :scope('package') ),
+                    PAST::Val.new( :value($name), :named('name') )
+                )
+            ));
+        }
+        else {
+            # XXX Old way, will go away once all package types are ported.
+            unless $BLOCK<attributes> {
+                $BLOCK<attributes> :=
+                    PAST::Op.new( :pasttype('list'), :named('attr') );
+            }
+            $BLOCK<attributes>.push( $name );
         }
-        $BLOCK<attributes>.push( $name );
         $past := PAST::Stmts.new();
     }
     else {