[svn:parrot] r35632 - in trunk: src/pmc t/oo

Author: Whiteknight
Date: Fri Jan 16 08:32:10 2009
New Revision: 35632

Modified:
   trunk/src/pmc/object.pmc
   trunk/t/oo/vtableoverride.t

Log:
[morph] Update the morph vtable override to take a class PMC instead. This is how it will be in the final version, so make the API match the intended behavior and cleanup the internals later. Also, update the test for this.

Modified: trunk/src/pmc/object.pmc
==============================================================================
--- trunk/src/pmc/object.pmc	(original)
+++ trunk/src/pmc/object.pmc	Fri Jan 16 08:32:10 2009
@@ -855,8 +855,8 @@
                 classobj, meth_name);
 
         if (!PMC_IS_NULL(method)) {
-            STRING *typename = string_copy(interp, interp->vtables[type]->whoami);
-            Parrot_run_meth_fromc_args(interp, method, SELF, meth_name, "vS", typename);
+            PMC * const class = Parrot_oo_get_class_str(interp, interp->vtables[type]->whoami);
+            Parrot_run_meth_fromc_args(interp, method, SELF, meth_name, "vP", class);
         }
         else
             SUPER(type);

Modified: trunk/t/oo/vtableoverride.t
==============================================================================
--- trunk/t/oo/vtableoverride.t	(original)
+++ trunk/t/oo/vtableoverride.t	Fri Jan 16 08:32:10 2009
@@ -18,33 +18,53 @@
 
 .sub main :main
     .include 'test_more.pir'
-    plan(2)
-    $P0 = newclass "MyObject"
-    $P1 = new $P0
+    plan(4)
+    
+    $P1 = new 'MyObject'
     
     # Test get_string
     $S0 = $P1
     is($S0, "[MyObject]", "get_string VTABLE override")
+    $P0 = getattribute $P1, "message"
+    $S0 = $P0
+    is($S0, "[MyObject]", "attribute sideeffect of get_string")
     
     # Test morph (doesn't actually perform a morph)
     morph $P1, "String"
-
+    $P0 = getattribute $P1, "message"
+    $S0 = $P0
+    is($S0, "Morphing [MyObject] to type String", "Morph VTABLE override 1")
+    
+    morph $P1, "Integer"
+    $P0 = getattribute $P1, "message"
+    $S0 = $P0
+    is($S0, "Morphing [MyObject] to type Integer", "Morph VTABLE override 1")
 .end
 
 .namespace [ 'MyObject' ]
 
+.sub '__onload' :anon :init
+    $P0 = newclass "MyObject"
+    addattribute $P0, "message"
+.end
+
 .sub 'get_string' :vtable
     $S0 = "[MyObject]"
+    $P0 = box $S0
+    setattribute self, "message", $P0
     .return($S0)
 .end
 
 .sub 'morph' :vtable
-    .param string type
+    .param pmc class
+    .local string type
     $S0 = self
     $S1 = "Morphing " . $S0
     $S1 = $S1 . " to type "
+    type = class.'name'()
     $S1 = $S1 . type
-    is($S1, "Morphing [MyObject] to type String", "Morph vtable override")
+    $P0 = box $S1
+    setattribute self, "message", $P0
 .end