[svn:parrot] r36073 - in trunk: compilers/imcc t/oo t/pmc

Author: chromatic
Date: Tue Jan 27 16:23:19 2009
New Revision: 36073

Modified:
   trunk/compilers/imcc/imcc.y
   trunk/compilers/imcc/imcparser.c
   trunk/compilers/imcc/pcc.c
   trunk/compilers/imcc/symreg.h
   trunk/t/oo/vtableoverride.t
   trunk/t/pmc/namespace.t
   trunk/t/pmc/parrotobject.t

Log:
[IMCC] Make self parameter available from PIR vtable overrides (TT #103, work
done by Klass-Jan Stol).

Modified: trunk/compilers/imcc/imcc.y
==============================================================================
--- trunk/compilers/imcc/imcc.y	(original)
+++ trunk/compilers/imcc/imcc.y	Tue Jan 27 16:23:19 2009
@@ -1169,13 +1169,13 @@
 vtable:
      VTABLE_METHOD
          {
-           $$ = 0;
+           $$ = P_VTABLE;
            IMCC_INFO(interp)->cur_unit->vtable_name = NULL;
            IMCC_INFO(interp)->cur_unit->is_vtable_method = 1;
          }
    | VTABLE_METHOD '(' STRINGC ')'
          {
-           $$ = 0;
+           $$ = P_VTABLE;
            IMCC_INFO(interp)->cur_unit->vtable_name = $3;
            IMCC_INFO(interp)->cur_unit->is_vtable_method = 1;
          }

Modified: trunk/compilers/imcc/imcparser.c
==============================================================================
--- trunk/compilers/imcc/imcparser.c	(original)
+++ trunk/compilers/imcc/imcparser.c	Tue Jan 27 16:23:19 2009
@@ -3340,7 +3340,7 @@
   case 65:
 #line 1171 "compilers/imcc/imcc.y"
     {
-           (yyval.t) = 0;
+           (yyval.t) = P_VTABLE;
            IMCC_INFO(interp)->cur_unit->vtable_name = NULL;
            IMCC_INFO(interp)->cur_unit->is_vtable_method = 1;
          }
@@ -3349,7 +3349,7 @@
   case 66:
 #line 1177 "compilers/imcc/imcc.y"
     {
-           (yyval.t) = 0;
+           (yyval.t) = P_VTABLE;
            IMCC_INFO(interp)->cur_unit->vtable_name = (yyvsp[(3) - (4)].s);
            IMCC_INFO(interp)->cur_unit->is_vtable_method = 1;
          }

Modified: trunk/compilers/imcc/pcc.c
==============================================================================
--- trunk/compilers/imcc/pcc.c	(original)
+++ trunk/compilers/imcc/pcc.c	Tue Jan 27 16:23:19 2009
@@ -387,7 +387,7 @@
     SymReg      *regs[2];
 
     /* if this sub is a method, unshift 'self' as first param */
-    if ((unit->type & IMC_HAS_SELF) || (sub->pcc_sub->pragma & P_METHOD)) {
+    if ((unit->type & IMC_HAS_SELF) || (sub->pcc_sub->pragma & (P_METHOD | P_VTABLE))) {
         SymReg *self = get_sym(interp, "self");
         if (!self) {
             self       = mk_symreg(interp, "self", 'P');

Modified: trunk/compilers/imcc/symreg.h
==============================================================================
--- trunk/compilers/imcc/symreg.h	(original)
+++ trunk/compilers/imcc/symreg.h	Tue Jan 27 16:23:19 2009
@@ -443,7 +443,7 @@
 typedef enum {
     P_NONE           = 0x00,                  /* 0<<0 */
     P_NEED_LEX       = 0x01,                  /* 1<<0 */
-    /* P_XXXX        = 0x02, */               /* 1<<1 */
+    P_VTABLE         = 0x02,                  /* 1<<1 */
     P_METHOD         = 0x04,                  /* 1<<2 */
     P_ANON           = SUB_FLAG_PF_ANON,      /* 1<<3 0x8    - private3 */
     P_MAIN           = SUB_FLAG_PF_MAIN,      /* 1<<4 0x10   - private4 */

Modified: trunk/t/oo/vtableoverride.t
==============================================================================
--- trunk/t/oo/vtableoverride.t	(original)
+++ trunk/t/oo/vtableoverride.t	Tue Jan 27 16:23:19 2009
@@ -1,5 +1,5 @@
 #! parrot
-# Copyright (C) 2007, The Perl Foundation.
+# Copyright (C) 2007-2009, The Perl Foundation.
 # $Id$
 
 =head1 NAME
@@ -18,10 +18,11 @@
 
 .sub main :main
     .include 'test_more.pir'
-    plan(11)
+    plan(12)
 
     newclass_tests()
     subclass_tests()
+    vtable_implies_self_tests()
 .end
 
 .sub 'newclass_tests'
@@ -69,6 +70,12 @@
     is ($I0, 1, "inherited does")
 .end
 
+.sub 'vtable_implies_self_tests'
+  $P1 = get_class 'MyVtableObject'
+  $P2 = $P1.'new'()
+  $I0 = does $P2, 'frobulate'
+  ok( $I0, ':vtable should imply the self parameter' )
+.end
 
 .namespace [ 'MyObject' ]
 
@@ -130,8 +137,21 @@
     .return (1)
 .end
 
+.namespace [ 'MyVtableObject' ]
+
+.sub '__onload' :anon :init
+  $P1 = get_class 'String'
+  $P2 = subclass $P1, 'MyVtableObject'
+.end
 
+.sub 'does' :vtable
+    .param string what
+    eq what, 'frobulate', true
+    .return( 0 )
 
+  true:
+    .return( 1 )
+.end
 
 # Local Variables:
 #   mode: pir

Modified: trunk/t/pmc/namespace.t
==============================================================================
--- trunk/t/pmc/namespace.t	(original)
+++ trunk/t/pmc/namespace.t	Tue Jan 27 16:23:19 2009
@@ -1697,6 +1697,7 @@
 .namespace [ 'Override' ]
 
 .sub 'find_method' :vtable
+    .param string method
     say "Finding method"
 .end
 CODE

Modified: trunk/t/pmc/parrotobject.t
==============================================================================
--- trunk/t/pmc/parrotobject.t	(original)
+++ trunk/t/pmc/parrotobject.t	Tue Jan 27 16:23:19 2009
@@ -202,7 +202,7 @@
 .sub main :main
 $P0 = newclass "Foo"
 $P1 = new ['Foo']
-$P1()
+$P1($P1)   # pass the object it"self"
 say "got here"
 .end
 CODE
@@ -224,7 +224,7 @@
 .sub main :main
   $P0 = newclass "Foo"
   $P1 = new ['Foo']
-  $I0 = $P1(2)
+  $I0 = $P1($P1, 2) # pass the object it"self"
   print $I0
   print "\n"
 .end
@@ -247,7 +247,7 @@
     $P1()
 .end
 CODE
-/1 params expected/
+/2 params expected/
 OUT
 
 # '