Refactor BUILDPLAN construction so that it respects the desires of di…

…fferent contributing metaclasses.
rakudo · Sep 1, 2012 · 54f813b · 54f813b
1 parent e8c76ce
commit 54f813b
Showing 1 changed file with 50 additions and 43 deletions.
diff --git a/src/Perl6/Metamodel/BUILDPLAN.pm b/src/Perl6/Metamodel/BUILDPLAN.pm
@@ -11,59 +11,66 @@ role Perl6::Metamodel::BUILDPLAN {
     #   1 class name attr_name = try to find initialization value
     #   2 class attr_name code = call default value closure if needed
     method create_BUILDPLAN($obj) {
-        # Get MRO, then work from least derived to most derived.
-        my @all_plan;
+        # First, we'll create the build plan for just this class.
         my @plan;
-        my @mro := self.mro($obj);
-        my $i := +@mro;
-        while $i > 0 {
-            # Get current class to consider and its attrs.
-            $i := $i - 1;
-            my $class := @mro[$i];
-            my @attrs := $class.HOW.attributes($class, :local(1));
-
-            # Does it have its own BUILD?
-            my $build := $class.HOW.find_method($class, 'BUILD', :no_fallback(1));
-            if !nqp::isnull($build) && $build {
-                # We'll call the custom one.
-                my $entry := [0, $build];
-                @all_plan[+@all_plan] := $entry;
-                if $i == 0 {
-                    @plan[+@plan] := $entry;
-                }
+        my @attrs := $obj.HOW.attributes($obj, :local(1));
+
+        # Does it have its own BUILD?
+        my $build := $obj.HOW.find_method($obj, 'BUILD', :no_fallback(1));
+        if !nqp::isnull($build) && $build {
+            # We'll call the custom one.
+            my $entry := [0, $build];
+            @all_plan[+@all_plan] := $entry;
+            if $i == 0 {
+                @plan[+@plan] := $entry;
             }
-            else {
-                # No custom BUILD. Rather than having an actual BUILD
-                # in Mu, we produce ops here per attribute that may
-                # need initializing.
-                for @attrs {
-                    if $_.has_accessor {
-                        my $attr_name := $_.name;
-                        my $name      := nqp::substr($attr_name, 2);
-                        my $entry     := [1, $class, $name, $attr_name];
-                        @all_plan[+@all_plan] := $entry;
-                        if $i == 0 {
-                            @plan[+@plan] := $entry;
-                        }
+        }
+        else {
+            # No custom BUILD. Rather than having an actual BUILD
+            # in Mu, we produce ops here per attribute that may
+            # need initializing.
+            for @attrs {
+                if $_.has_accessor {
+                    my $attr_name := $_.name;
+                    my $name      := nqp::substr($attr_name, 2);
+                    my $entry     := [1, $obj, $name, $attr_name];
+                    @all_plan[+@all_plan] := $entry;
+                    if $i == 0 {
+                        @plan[+@plan] := $entry;
                     }
                 }
             }
-            
-            # Check if there's any default values to put in place.
-            for @attrs {
-                if nqp::can($_, 'build') {
-                    my $default := $_.build;
-                    if !nqp::isnull($default) && $default {
-                        my $entry := [2, $class, $_.name, $default];
-                        @all_plan[+@all_plan] := $entry;
-                        if $i == 0 {
-                            @plan[+@plan] := $entry;
-                        }
+        }
+
+        # Check if there's any default values to put in place.
+        for @attrs {
+            if nqp::can($_, 'build') {
+                my $default := $_.build;
+                if !nqp::isnull($default) && $default {
+                    my $entry := [2, $obj, $_.name, $default];
+                    @all_plan[+@all_plan] := $entry;
+                    if $i == 0 {
+                        @plan[+@plan] := $entry;
                     }
                 }
             }
         }
+
+        # Install plan for this class.
         @!BUILDPLAN := @plan;
+
+        # Now create the full plan by getting the MRO, and working from
+        # least derived to most derived, copying the plans.
+        my @all_plan;
+        my @mro := self.mro($obj);
+        my $i := +@mro;
+        while $i > 0 {
+            $i := $i - 1;
+            my $class := @mro[$i];
+            for $class.HOW.BUILDPLAN($class) {
+                nqp::push(@all_plan, $_);
+            }
+        }
         @!BUILDALLPLAN := @all_plan;
     }