[svn:parrot] r29590 - in trunk: languages/perl6/src/classes languages/perl6/src/parser runtime/parrot/library t/library

[jonathan]

Author: jonathan
Date: Fri Jul 18 09:46:36 2008
New Revision: 29590

Modified:
   trunk/languages/perl6/src/classes/Any.pir
   trunk/languages/perl6/src/parser/actions.pm
   trunk/runtime/parrot/library/P6object.pir
   trunk/t/library/p6object.t

Log:
[rakudo] [p6object] Make isa and can in the metaclass take the object to test 
as a first parameter, as specified in recent-ish S12 updates.

Modified: trunk/languages/perl6/src/classes/Any.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Any.pir   (original)
+++ trunk/languages/perl6/src/classes/Any.pir   Fri Jul 18 09:46:36 2008
@@ -30,7 +30,7 @@
 .sub 'can' :method
     .param pmc x
     $P0 = self.'HOW'()
-    .return $P0.'can'(x)
+    .return $P0.'can'(self, x)
 .end
 
 =item isa($x)
@@ -40,7 +40,7 @@
 .sub 'isa' :method
     .param pmc x
     $P0 = self.'HOW'()
-    .return $P0.'isa'(x)
+    .return $P0.'isa'(self, x)
 .end
 
 =back

Modified: trunk/languages/perl6/src/parser/actions.pm
==============================================================================
--- trunk/languages/perl6/src/parser/actions.pm (original)
+++ trunk/languages/perl6/src/parser/actions.pm Fri Jul 18 09:46:36 2008
@@ -2450,7 +2450,7 @@
             :node($/)
         );
         my $rhs := $( $/[1] );
-        if $rhs.HOW().isa(PAST::Op) && $rhs.pasttype() eq 'call' {
+        if $rhs.HOW().isa($rhs, PAST::Op) && $rhs.pasttype() eq 'call' {
             # Make sure we only have one initialization value.
             if +@($rhs) > 2 {
                 $/.panic("Role initialization can only supply a value for one 
attribute");

Modified: trunk/runtime/parrot/library/P6object.pir
==============================================================================
--- trunk/runtime/parrot/library/P6object.pir   (original)
+++ trunk/runtime/parrot/library/P6object.pir   Fri Jul 18 09:46:36 2008
@@ -164,11 +164,12 @@
 =cut
 
 .sub 'isa' :method
+    .param pmc obj
     .param pmc x
 
     .local pmc parrotclass
     parrotclass = self.'get_parrotclass'(x)
-    $P0 = self.'WHAT'()
+    $P0 = obj.'WHAT'()
     $I0 = isa $P0, parrotclass
     .return ($I0)
 .end
@@ -180,9 +181,9 @@
 =cut
 
 .sub 'can' :method
+    .param pmc obj
     .param string x
-    .local pmc parrotclass
-    $P0 = self.'WHAT'()
+    $P0 = obj.'WHAT'()
     $I0 = can $P0, x
     .return ($I0)
 .end

Modified: trunk/t/library/p6object.t
==============================================================================
--- trunk/t/library/p6object.t  (original)
+++ trunk/t/library/p6object.t  Fri Jul 18 09:46:36 2008
@@ -114,10 +114,10 @@
     is($S0, 'ABC', 'typeof ABC proto eq "ABC"')
     $P0 = abcproto.'HOW'()
     isa_ok($P0, 'P6metaclass', 'ABC proto .HOW')
-    $I0 = $P0.'can'('foo')
-    ok($I0, "ABC.HOW.can('foo')")
-    $I0 = $P0.'can'('bar')
-    nok($I0, "ABC.HOW.can('bar')")
+    $I0 = $P0.'can'(abcproto, 'foo')
+    ok($I0, "ABC.HOW.can(ABC, 'foo')")
+    $I0 = $P0.'can'(abcproto, 'bar')
+    nok($I0, "ABC.HOW.can(ABC, 'bar')")
     $I0 = defined metaproto
     nok($I0, 'ABC proto undefined')