cvsuser 04/03/10 03:47:29
Modified: classes delegate.pmc
src objects.c
t/pmc object-meths.t
Log:
call __init on all parents
Revision Changes Path
1.18 +9 -5 parrot/classes/delegate.pmc
Index: delegate.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/delegate.pmc,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -w -r1.17 -r1.18
--- delegate.pmc 10 Mar 2004 09:31:08 -0000 1.17
+++ delegate.pmc 10 Mar 2004 11:47:22 -0000 1.18
@@ -1,6 +1,6 @@
/*
Copyright: 2003 The Perl Foundation. All Rights Reserved.
-$Id: delegate.pmc,v 1.17 2004/03/10 09:31:08 leo Exp $
+$Id: delegate.pmc,v 1.18 2004/03/10 11:47:22 leo Exp $
=head1 NAME
@@ -178,10 +178,11 @@
*/
PARROT_INLINE static void
-noarg_noreturn(Parrot_Interp interpreter, PMC *obj, const char *meth, int die) {
+noarg_noreturn(Parrot_Interp interpreter, PMC *obj, PMC* class,
+ const char *meth, int die) {
struct regsave *data = save_regs(interpreter);
- PMC *method = die ? find_or_die(interpreter, obj, meth) :
- find_meth (interpreter, obj, meth);
+ PMC *method = die ? find_or_die(interpreter, class, meth) :
+ find_meth (interpreter, class, meth);
if (PMC_IS_NULL(method))
goto ret;
REG_PMC(2) = obj;
@@ -214,9 +215,12 @@
*/
void init () {
- noarg_noreturn(INTERP, SELF, PARROT_VTABLE_INIT_METHNAME, 0);
+ noarg_noreturn(INTERP, SELF, SELF, PARROT_VTABLE_INIT_METHNAME, 0);
}
+ void init_pmc (PMC* class) {
+ noarg_noreturn(INTERP, SELF, class, PARROT_VTABLE_INIT_METHNAME, 0);
+ }
}
1.54 +23 -2 parrot/src/objects.c
Index: objects.c
===================================================================
RCS file: /cvs/public/parrot/src/objects.c,v
retrieving revision 1.53
retrieving revision 1.54
diff -u -w -r1.53 -r1.54
--- objects.c 9 Mar 2004 21:36:05 -0000 1.53
+++ objects.c 10 Mar 2004 11:47:25 -0000 1.54
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: objects.c,v 1.53 2004/03/09 21:36:05 dan Exp $
+$Id: objects.c,v 1.54 2004/03/10 11:47:25 leo Exp $
=head1 NAME
@@ -456,6 +456,27 @@
return new_type;
}
+
+static void
+do_initcall(Parrot_Interp interpreter, PMC* class, PMC *object)
+{
+
+ PMC *class_data = PMC_data(class);
+ PMC *classsearch_array =
+ VTABLE_get_pmc_keyed_int(interpreter, class_data, PCD_ALL_PARENTS);
+ PMC *parent_class;
+ INTVAL i, nparents;
+
+ nparents = VTABLE_get_integer(interpreter, classsearch_array);
+ for (i = nparents - 1; i >= 0; --i) {
+ parent_class = VTABLE_get_pmc_keyed_int(interpreter,
+ classsearch_array, i);
+ Parrot_base_vtables[enum_class_delegate]->init_pmc(interpreter,
+ object, parent_class);
+ }
+ Parrot_base_vtables[enum_class_delegate]->init(interpreter, object);
+}
+
/*
=item C<void
@@ -515,7 +536,7 @@
/* We really ought to call the class init routines here...
* this assumes that an object isa delegate
*/
- Parrot_base_vtables[enum_class_delegate]->init(interpreter, object);
+ do_initcall(interpreter, class, object);
}
/*
1.8 +41 -2 parrot/t/pmc/object-meths.t
Index: object-meths.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/object-meths.t,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -w -r1.7 -r1.8
--- object-meths.t 8 Mar 2004 00:20:09 -0000 1.7
+++ object-meths.t 10 Mar 2004 11:47:29 -0000 1.8
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: object-meths.t,v 1.7 2004/03/08 00:20:09 chromatic Exp $
+# $Id: object-meths.t,v 1.8 2004/03/10 11:47:29 leo Exp $
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-use Parrot::Test tests => 6;
+use Parrot::Test tests => 7;
use Test::More;
output_like(<<'CODE', <<'OUTPUT', "callmethod - unknown");
@@ -144,4 +144,43 @@
ok 1
ok 2
42
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "constructor - parents");
+ newclass P1, "Foo"
+ find_global P12, "_foo::init"
+ store_global "Foo", "__init", P12
+ subclass P2, P1, "Bar"
+ find_global P12, "_bar::init"
+ store_global "Bar", "__init", P12
+ subclass P3, P2, "Baz"
+ find_global P12, "_baz::init"
+ store_global "Baz", "__init", P12
+ find_type I1, "Baz"
+ new P3, I1
+ find_type I1, "Bar"
+ new P3, I1
+ print "done\n"
+ end
+.pcc_sub _foo::init:
+ print "foo_init\n"
+ classname S0, P2
+ print S0
+ print "\n"
+ invoke P1
+.pcc_sub _bar::init:
+ print "bar_init\n"
+ invoke P1
+.pcc_sub _baz::init:
+ print "baz_init\n"
+ invoke P1
+CODE
+foo_init
+Baz
+bar_init
+baz_init
+foo_init
+Bar
+bar_init
+done
OUTPUT
