Correct handling of attributes during the compile so we don't lose or…

…dering, thus dealing with the intermittent instance.t fejls.
rakudo · Mar 26, 2010 · e8b8da3 · e8b8da3
1 parent 4b7dbf3
commit e8b8da3
Show file tree

Hide file tree

Showing 3 changed files with 45 additions and 29 deletions.
diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm
@@ -823,13 +823,17 @@ sub declare_variable($/, $past, $sigil, $twigil, $desigilname, $trait_list) {
         # Find the current package and add the attribute.
         my $attrname := ~$sigil ~ '!' ~ $desigilname;
         our @PACKAGE;
-        unless +@PACKAGE { $/.CURSOR.panic("Can not declare attribute outside of a package"); }
-        my %attr_table := @PACKAGE[0].attributes;
-        if %attr_table{$attrname} { $/.CURSOR.panic("Can not re-declare attribute " ~ $attrname); }
-        %attr_table{$attrname} := Q:PIR { %r = root_new ['parrot';'Hash'] };
-        %attr_table{$attrname}<name>     := $attrname;
-        %attr_table{$attrname}<accessor> := $twigil eq '.' ?? 1 !! 0;
-        %attr_table{$attrname}<rw>       := $trait_list && has_compiler_trait_with_val($trait_list, '&trait_mod:<is>', 'rw') ?? 1 !! 0;
+        unless +@PACKAGE {
+            $/.CURSOR.panic("Can not declare an attribute outside of a package");
+        }
+        if @PACKAGE[0].has_attribute($attrname) {
+            $/.CURSOR.panic("Can not re-declare attribute " ~ $attrname);
+        }
+        my %attr_info;
+        %attr_info<name>      := $attrname;
+        %attr_info<accessor> := $twigil eq '.' ?? 1 !! 0;
+        %attr_info<rw>        := $trait_list && has_compiler_trait_with_val($trait_list, '&trait_mod:<is>', 'rw') ?? 1 !! 0;
+        @PACKAGE[0].attributes.push(%attr_info);
 
         # If no twigil, note $foo is an alias to $!foo.
         if $twigil eq '' {
@@ -839,7 +843,7 @@ sub declare_variable($/, $past, $sigil, $twigil, $desigilname, $trait_list) {
         # Nothing to emit here; just hand  back an empty node, but also
         # annotate it with the attribute table.
         $past := PAST::Stmts.new( );
-        $past<attribute_data> := %attr_table{$attrname};
+        $past<attribute_data> := %attr_info;
     }
     else {
         # Not an attribute - need to emit delcaration here.

diff --git a/src/Perl6/Compiler/Package.pm b/src/Perl6/Compiler/Package.pm
@@ -18,7 +18,7 @@ has $!methods;
 # Table of methods we're adding to the meta model
 has $!meta_methods;
 
-# Table of attributes meta-data hashes. Maps name to hash.
+# List attributes meta-data hashes. Should be Attribute class instances one day.
 has $!attributes;
 
 # List of traits.
@@ -63,12 +63,24 @@ method meta_methods() {
     $!meta_methods
 }
 
-# Accessor for attributes hash.
+# Accessor for attributes list.
 method attributes() {
-    unless $!attributes { $!attributes := Q:PIR { %r = root_new ['parrot';'Hash'] } }
+    unless $!attributes { $!attributes := PAST::Node.new() }
     $!attributes
 }
 
+# Checks if there is already an attribute with the given name.
+method has_attribute($name) {
+    if $!attributes {
+        for @($!attributes) {
+            if $_<name> eq $name {
+                return 1;
+            }
+        }
+    }
+    0
+}
+
 # Accessor for traits list.
 method traits() {
     unless $!traits { $!traits := PAST::Node.new() }
@@ -146,19 +158,19 @@ method finish($block) {
     }
 
     # Attributes.
-    my %attrs := $!attributes;
-    for %attrs {
+    my $attr_list := self.attributes();
+    for @($attr_list) {
         my $attr := PAST::Op.new(
             :pasttype('callmethod'),
             :name('new'),
-            PAST::Var.new( :name('Attribute'), :namespace(''), :scope('package') ),
-            PAST::Val.new( :value(~$_),                  :named('name') ),
-            PAST::Val.new( :value(%attrs{$_}<accessor>), :named('has_accessor') ),
-            PAST::Val.new( :value(%attrs{$_}<rw>),       :named('rw') )
+            PAST::Var.new( :name('Attribute'),   :namespace(''), :scope('package') ),
+            PAST::Val.new( :value($_<name>),     :named('name') ),
+            PAST::Val.new( :value($_<accessor>), :named('has_accessor') ),
+            PAST::Val.new( :value($_<rw>),       :named('rw') )
         );
-        if %attrs{$_}<build> {
-            %attrs{$_}<build>.named('build');
-            $attr.push(%attrs{$_}<build>);
+        if $_<build> {
+            $_<build>.named('build');
+            $attr.push($_<build>);
         }
         $decl.push(PAST::Op.new(
             :pasttype('callmethod'),

diff --git a/src/Perl6/Compiler/Role.pm b/src/Perl6/Compiler/Role.pm
@@ -77,19 +77,19 @@ method finish($block) {
     }
 
     # Attributes.
-    my %attrs := self.attributes;
-    for %attrs {
+    my $attr_list := self.attributes();
+    for @($attr_list) {
         my $attr := PAST::Op.new(
             :pasttype('callmethod'),
             :name('new'),
-            PAST::Var.new( :name('Attribute'), :namespace(''), :scope('package') ),
-            PAST::Val.new( :value(~$_),                  :named('name') ),
-            PAST::Val.new( :value(%attrs{$_}<accessor>), :named('has_accessor') ),
-            PAST::Val.new( :value(%attrs{$_}<rw>),       :named('rw') ),
+            PAST::Var.new( :name('Attribute'),   :namespace(''), :scope('package') ),
+            PAST::Val.new( :value($_<name>),     :named('name') ),
+            PAST::Val.new( :value($_<accessor>), :named('has_accessor') ),
+            PAST::Val.new( :value($_<rw>),       :named('rw') )
         );
-        if %attrs{$_}<build> {
-            %attrs{$_}<build>.named('build');
-            $attr.push(%attrs{$_}<build>);
+        if $_<build> {
+            $_<build>.named('build');
+            $attr.push($_<build>);
         }
         $decl.push(PAST::Op.new(
             :pasttype('callmethod'),