cvsuser 04/03/03 06:17:34
Modified: src objects.c
t/pmc object-meths.t
Log:
call object constructor if any
Revision Changes Path
1.47 +5 -2 parrot/src/objects.c
Index: objects.c
===================================================================
RCS file: /cvs/public/parrot/src/objects.c,v
retrieving revision 1.46
retrieving revision 1.47
diff -u -w -r1.46 -r1.47
--- objects.c 1 Mar 2004 16:55:28 -0000 1.46
+++ objects.c 3 Mar 2004 14:17:27 -0000 1.47
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: objects.c,v 1.46 2004/03/01 16:55:28 dan Exp $
+$Id: objects.c,v 1.47 2004/03/03 14:17:27 leo Exp $
=head1 NAME
@@ -445,7 +445,10 @@
/* We are an object now */
PObj_is_object_SET(object);
- /* TODO We really ought to call the class init routines here... */
+ /* 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);
}
/*
1.6 +48 -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.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- object-meths.t 24 Feb 2004 15:07:23 -0000 1.5
+++ object-meths.t 3 Mar 2004 14:17:34 -0000 1.6
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: object-meths.t,v 1.5 2004/02/24 15:07:23 dan Exp $
+# $Id: object-meths.t,v 1.6 2004/03/03 14:17:34 leo Exp $
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-use Parrot::Test tests => 4;
+use Parrot::Test tests => 6;
use Test::More;
output_like(<<'CODE', <<'OUTPUT', "callmethod - unknown");
@@ -99,3 +99,49 @@
0
OUTPUT
+output_is(<<'CODE', <<'OUTPUT', "constructor");
+ newclass P1, "Foo"
+ find_global P2, "init"
+ store_global "Foo", "__init", P2
+ find_type I1, "Foo"
+ new P3, I1
+ print "ok 2\n"
+ end
+.pcc_sub init:
+ print "ok 1\n"
+ invoke P1
+CODE
+ok 1
+ok 2
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "constructor - init attr");
+ newclass P1, "Foo"
+ addattribute P1, ".i"
+ find_global P2, "Foo::init"
+ store_global "Foo", "__init", P2
+ find_global P2, "Foo::get_s"
+ store_global "Foo", "__get_string", P2
+ find_type I1, "Foo"
+ new P3, I1
+ print "ok 2\n"
+ print P3
+ print "\n"
+ end
+.pcc_sub Foo::init:
+ print "ok 1\n"
+ new P10, .PerlInt
+ set P10, 42
+ classoffset I0, P2, "Foo"
+ setattribute P2, I0, P10
+ invoke P1
+.pcc_sub Foo::get_s:
+ classoffset I0, P2, "Foo"
+ getattribute P10, P2, I0
+ set S5, P10
+ invoke P1
+CODE
+ok 1
+ok 2
+42
+OUTPUT
