The function Parrot_remove_parent is used by the removeparent opcode.
The attached patch implements the remove_parent method in class.pmc,
and implement Parrot_remove_parent as a call to VTABLE_remove_parent
on the pmc supplied, thus implementing the removeparent functionality
for classes.
Don't know if will be better to remove the function and let the opcode
call directly the vtable function, but this way has lesser impact.
--
Salu2
Index: src/oo.c
===================================================================
--- src/oo.c (revisión: 27508)
+++ src/oo.c (copia de trabajo)
@@ -1148,8 +1148,7 @@
=item C<PMC * Parrot_remove_parent>
-This currently does nothing but return C<PMCNULL>.
-RT#50646
+Remove a parent class from a PMC, by invoking his remove_parent method.
=cut
@@ -1162,11 +1161,8 @@
Parrot_remove_parent(PARROT_INTERP, ARGIN(PMC *removed_class),
ARGIN(PMC *existing_class))
{
- UNUSED(interp);
- UNUSED(removed_class);
- UNUSED(existing_class);
-
- return PMCNULL;
+ VTABLE_remove_parent(interp, existing_class, removed_class);
+ return existing_class;
}
Index: src/pmc/class.pmc
===================================================================
--- src/pmc/class.pmc (revisión: 27508)
+++ src/pmc/class.pmc (copia de trabajo)
@@ -780,6 +780,67 @@
/*
+=item C<void remove_parent(PMC *parent)>
+
+Remove the supplied PMC from the list of parents for the class.
+Throws E_TypeError if parent is NULL, is not a class, or is not a parent.
+Throws INVALID_OPERATION if the class has been instantiated.
+
+=cut
+
+*/
+ VTABLE void remove_parent(PMC *parent) {
+ Parrot_Class * const _class = PARROT_CLASS(SELF);
+
+ /* get number of direct parents */
+ const int parent_count = VTABLE_elements(interp, _class->parents);
+
+ int index; /* loop iterator */
+
+ /* If we've been instantiated already, not allowed. */
+ if (_class->instantiated) {
+ real_exception(interp, NULL, INVALID_OPERATION,
+ "Modifications to classes are not allowed after instantiation.");
+ }
+
+ /* Ensure it really is a class. */
+ if (!PObj_is_class_TEST(parent)) {
+ real_exception(interp, NULL, E_TypeError, "Parent isn't a Class.");
+ return;
+ }
+
+ /* iterate over all direct parents, looking for
+ * the parent to be removed.
+ */
+ for (index = 0; index < parent_count; index++) {
+ /* get the next parent */
+ PMC * const current_parent = VTABLE_get_pmc_keyed_int(interp,
+ _class->parents, index);
+ if (current_parent == parent)
+ break;
+ }
+ if (index >= parent_count)
+ real_exception(interp, NULL, INVALID_OPERATION,
+ "Can't remove_parent: is not a parent.");
+
+ /* Move up the remaining parents on the list and pops it */
+ for (; index < parent_count - 1; index++) {
+ PMC * const current_parent = VTABLE_get_pmc_keyed_int(interp,
+ _class->parents, index + 1);
+ VTABLE_set_pmc_keyed_int(interp, _class->parents,
+ index, current_parent);
+ }
+ VTABLE_pop_pmc(interp, _class->parents);
+
+ _class->all_parents = Parrot_ComputeMRO_C3(interp, SELF);
+
+ /* Anonymous classes have no entry in the vtable array */
+ if (!CLASS_is_anon_TEST(SELF))
+ interp->vtables[VTABLE_type(interp, SELF)]->mro = _class->all_parents;
+ }
+
+/*
+
=item C<void add_role(PMC *role)>
Adds the supplied PMC to the list of roles for the class, provided there are
Index: t/oo/removeparent.t
===================================================================
--- t/oo/removeparent.t (revisión: 0)
+++ t/oo/removeparent.t (revisión: 0)
@@ -0,0 +1,123 @@
+#! parrot
+# Copyright (C) 2008, The Perl Foundation.
+# $Id: $
+
+=head1 NAME
+
+t/oo/removeparent.t - Test OO inheritance
+
+=head1 SYNOPSIS
+
+ % prove t/oo/removeparent.t
+
+=head1 DESCRIPTION
+
+Tests OO features related to the removeparent opcode.
+
+=cut
+
+.sub main :main
+ .include 'include/test_more.pir'
+
+ plan(4)
+
+ remove_1()
+ remove_2()
+ remove_Y()
+ remove_diamond()
+.end
+
+.sub remove_1
+ $P1 = newclass "Foo"
+ $P2 = newclass "Bar"
+ $I1 = isa $P2, $P1
+ if $I1, fail
+ addparent $P2, $P1
+ $I1 = isa $P2, $P1
+ unless $I1, fail
+ removeparent $P2, $P1
+ $I1 = isa $P2, $P1
+ if $I1, fail
+ $I1 = 1
+ ok( $I1, 'simple')
+fail:
+.end
+
+.sub remove_2
+ $P1 = newclass "Foo2_1"
+ $P2 = newclass "Foo2_2"
+ $P3 = newclass "Bar2"
+ $I1 = isa $P3, $P1
+ if $I1, fail
+ $I1 = isa $P3, $P2
+ if $I1, fail
+ addparent $P3, $P1
+ $I1 = isa $P3, $P1
+ unless $I1, fail
+ $I1 = isa $P3, $P2
+ if $I1, fail
+ addparent $P3, $P2
+ $I1 = isa $P3, $P2
+ unless $I1, fail
+ removeparent $P3, $P1
+ $I1 = isa $P3, $P1
+ if $I1, fail
+ $I1 = isa $P3, $P2
+ unless $I1, fail
+ removeparent $P3, $P2
+ $I1 = isa $P3, $P1
+ if $I1, fail
+ $I1 = isa $P3, $P2
+ if $I1, fail
+ $I1 = 1
+ ok( $I1, 'multiple')
+fail:
+.end
+
+.sub remove_Y
+ $P1 = newclass "FooY_1"
+ $P2 = newclass "FooY_2"
+ $P3 = newclass "BarY_1"
+ $P4 = newclass "BarY_2"
+ addparent $P3, $P1
+ addparent $P3, $P2
+ $I1 = isa $P4, $P1
+ if $I1, fail
+ $I1 = isa $P4, $P2
+ if $I1, fail
+ addparent $P4, $P3
+ $I1 = isa $P4, $P1
+ unless $I1, fail
+ $I1 = isa $P4, $P2
+ unless $I1, fail
+ removeparent $P4, $P3
+ $I1 = isa $P4, $P1
+ if $I1, fail
+ $I1 = isa $P4, $P2
+ if $I1, fail
+ $I1 = 1
+ ok( $I1, 'Y')
+fail:
+.end
+
+.sub remove_diamond
+ $P1 = newclass "FooD1"
+ $P2 = newclass "FooD2"
+ $P3 = newclass "FooD3"
+ $P4 = newclass "BarD1"
+ addparent $P2, $P1
+ addparent $P3, $P1
+ addparent $P4, $P2
+ addparent $P4, $P3
+ $I1 = isa $P4, $P1
+ unless $I1, fail
+ removeparent $P4, $P2
+ $I1 = isa $P4, $P1
+ unless $I1, fail
+ removeparent $P4, $P3
+ $I1 = isa $P4, $P1
+ if $I1, fail
+ $I1 = 1
+ ok( $I1, 'diamond')
+fail:
+.end
