Refactor BUILD to be more in line with the spec. This should resolve …

…the most common issues people run into.
rakudo · Jun 3, 2009 · a17b297 · a17b297
1 parent 05a4a1c
commit a17b297
Show file tree

Hide file tree

Showing 2 changed files with 14 additions and 9 deletions.
diff --git a/src/builtins/op.pir b/src/builtins/op.pir
@@ -471,7 +471,9 @@ src/builtins/op.pir - Perl 6 builtin operators
     rebless_subclass var, derived
 
     # We need to set any initial attribute values up.
-    new_proto.'BUILD'(var)
+    .lex '$CLASS', new_proto
+    $P0 = find_method new_proto, 'BUILD'
+    $P0(var)
 
     # If we were given something to initialize with, do so.
     unless have_init_value goto no_init

diff --git a/src/classes/Object.pir b/src/classes/Object.pir
@@ -273,20 +273,20 @@ the object's type and address.
 
 
 .sub 'BUILD' :method
-    .param pmc candidate
     .param pmc attrinit        :slurpy :named
 
-    .local pmc p6meta, parrotclass, attributes, it
+    .local pmc p6meta, parentproto, parrotclass, attributes, it
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
-    parrotclass = p6meta.'get_parrotclass'(self)
+    parentproto = find_caller_lex '$CLASS'
+    parrotclass = p6meta.'get_parrotclass'(parentproto)
     attributes = inspect parrotclass, 'attributes'
     it = iter attributes
   attrinit_loop:
     unless it goto attrinit_done
     .local string attrname, keyname
     .local pmc attr, attrhash
     attrname = shift it
-    attr = getattribute candidate, parrotclass, attrname
+    attr = getattribute self, parrotclass, attrname
     attrhash = attributes[attrname]
     $I0 = index attrname, '!'
     if $I0 < 0 goto attrinit_loop
@@ -296,12 +296,12 @@ the object's type and address.
     unless null $P0 goto attrinit_assign
     $P0 = attrhash['init_value']
     if null $P0 goto attrinit_loop
-    $P0 = $P0(candidate, attr)
+    $P0 = $P0(self, attr)
   attrinit_assign:
     'infix:='(attr, $P0)
     goto attrinit_loop
   attrinit_done:
-    .return (candidate)
+    .return (self)
 .end
 
 
@@ -330,6 +330,7 @@ the object's type and address.
     parentproto = $P0.'WHAT'()
     $I0 = can parentproto, 'BUILD'
     unless $I0 goto parents_loop
+    .lex '$CLASS', parentproto
     # Look through posargs for a corresponding protoobject
     # with a WHENCE property.  If found, that WHENCE property
     # is used as the arguments to the parent class BUILD.
@@ -342,10 +343,12 @@ the object's type and address.
     ne_addr $P0, $P1, posargs_loop
     $P0 = argproto.'WHENCE'()
     if null $P0 goto posargs_done
-    parentproto.'BUILD'(candidate, $P0 :flat :named)
+    $P1 = find_method parentproto, 'BUILD'
+    $P1(candidate, $P0 :flat :named)
     goto parents_loop
   posargs_done:
-    parentproto.'BUILD'(candidate, attrinit :flat :named)
+    $P1 = find_method parentproto, 'BUILD'
+    $P1(candidate, attrinit :flat :named)
     goto parents_loop
   parents_done:
     .return (candidate)