cvsuser 03/12/03 03:17:50
Modified: classes parrotclass.pmc parrotobject.pmc
include/parrot objects.h
src objects.c
t/pmc objects.t
Log:
fiddle around with object creation
Revision Changes Path
1.9 +16 -1 parrot/classes/parrotclass.pmc
Index: parrotclass.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/parrotclass.pmc,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -w -r1.8 -r1.9
--- parrotclass.pmc 22 Oct 2003 14:55:16 -0000 1.8
+++ parrotclass.pmc 3 Dec 2003 11:17:37 -0000 1.9
@@ -1,7 +1,7 @@
/* parrotclass.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: parrotclass.pmc,v 1.8 2003/10/22 14:55:16 dan Exp $
+ * $Id: parrotclass.pmc,v 1.9 2003/12/03 11:17:37 leo Exp $
* Overview:
* These are the vtable functions for the ParrotClass base class
* Data Structure and Algorithms:
@@ -41,6 +41,21 @@
/* And, coincidentally, data points to a PMC. Fancy that... */
PObj_flag_SET(is_PMC_ptr, SELF);
}
+
+ INTVAL isa(STRING * classname) {
+ PMC *class = Parrot_class_lookup(interpreter, classname);
+ if (PMC_IS_NULL(class))
+ return 0;
+ return Parrot_object_isa(INTERP, SELF, class);
+ }
+
+ /* Figure out which method PMC we need. By default we just defer to the
+ * system method lookup code
+ */
+ PMC* find_method(STRING* name) {
+ PMC *class = VTABLE_get_pmc_keyed_int(INTERP, (PMC *)PMC_data(SELF), 0);
+ return Parrot_find_method_with_cache(INTERP, class, name);
+ }
}
1.9 +3 -16 parrot/classes/parrotobject.pmc
Index: parrotobject.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/parrotobject.pmc,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -w -r1.8 -r1.9
--- parrotobject.pmc 3 Dec 2003 02:52:57 -0000 1.8
+++ parrotobject.pmc 3 Dec 2003 11:17:37 -0000 1.9
@@ -1,7 +1,7 @@
/* parrotobject.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: parrotobject.pmc,v 1.8 2003/12/03 02:52:57 mrjoltcola Exp $
+ * $Id: parrotobject.pmc,v 1.9 2003/12/03 11:17:37 leo Exp $
* Overview:
* These are the vtable functions for the ParrotObject base class
* Data Structure and Algorithms:
@@ -29,22 +29,9 @@
*/
-pmclass ParrotObject need_ext {
+pmclass ParrotObject extends ParrotClass need_ext {
- INTVAL type() { /* pmc2c.pl doesn't like empty classes */
- return SELF->vtable->base_type;
- }
-
- INTVAL isa(STRING * classname) {
- return Parrot_object_isa(INTERP, SELF, classname);
- }
-
- /* Figure out which method PMC we need. By default we just defer to the
- * system method lookup code
- */
- PMC* find_method(STRING* name) {
- PMC *class = VTABLE_get_pmc_keyed_int(INTERP, (PMC *)PMC_data(SELF), 0);
- return Parrot_find_method_with_cache(INTERP, class, name);
+ void init() {
}
}
1.9 +3 -3 parrot/include/parrot/objects.h
Index: objects.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/objects.h,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -w -r1.8 -r1.9
--- objects.h 1 Dec 2003 18:54:32 -0000 1.8
+++ objects.h 3 Dec 2003 11:17:41 -0000 1.9
@@ -1,7 +1,7 @@
/* objects.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: objects.h,v 1.8 2003/12/01 18:54:32 dan Exp $
+ * $Id: objects.h,v 1.9 2003/12/03 11:17:41 leo Exp $
* Overview:
* Parrot class and object header stuff
* Data Structure and Algorithms:
@@ -25,7 +25,7 @@
PMC *Parrot_add_parent(Parrot_Interp, PMC *, PMC *);
PMC *Parrot_remove_parent(Parrot_Interp, PMC *, PMC *);
PMC *Parrot_multi_subclass(Parrot_Interp, PMC *, STRING *);
-PMC *Parrot_instantiate_object(Parrot_Interp, PMC *);
+void Parrot_instantiate_object(Parrot_Interp, PMC *);
INTVAL Parrot_object_isa(Parrot_Interp interpreter, PMC *, PMC *);
PMC *Parrot_new_method_cache(Parrot_Interp);
PMC *Parrot_find_method_with_cache(Parrot_Interp, PMC *, STRING *);
1.19 +16 -20 parrot/src/objects.c
Index: objects.c
===================================================================
RCS file: /cvs/public/parrot/src/objects.c,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -w -r1.18 -r1.19
--- objects.c 2 Dec 2003 18:34:21 -0000 1.18
+++ objects.c 3 Dec 2003 11:17:47 -0000 1.19
@@ -1,7 +1,7 @@
/* objects.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: objects.c,v 1.18 2003/12/02 18:34:21 dan Exp $
+ * $Id: objects.c,v 1.19 2003/12/03 11:17:47 leo Exp $
* Overview:
* Handles class and object manipulation
* Data Structure and Algorithms:
@@ -199,14 +199,13 @@
/*=for api objects Parrot_instantiate_object
*
- * Create a new parrot object. Takes a passed-in class PMC that has
+ * Create a parrot object. Takes a passed-in class PMC that has
* sufficient information to describe the layout of the object and,
* well, makes the darned object.
*
*/
-PMC *
+void
Parrot_instantiate_object(Parrot_Interp interpreter, PMC *object) {
- PMC *new_object;
PMC *new_object_array;
INTVAL attrib_count;
PMC *class_array;
@@ -228,16 +227,13 @@
VTABLE_set_pmc_keyed_int(interpreter, new_object_array, 1,
VTABLE_get_pmc_keyed_int(interpreter, class_array, 1));
- /* Allocate the object itself */
- new_object = pmc_new(interpreter, enum_class_ParrotObject);
/* Note the number of used slots */
- new_object->cache.int_val = 2;
+ object->cache.int_val = 2;
- PMC_data(new_object) = new_object_array;
- PObj_flag_SET(is_PMC_ptr, new_object);
+ PMC_data(object) = new_object_array;
+ PObj_flag_SET(is_PMC_ptr, object);
/* We really ought to call the class init routines here... */
- return new_object;
}
PMC *
1.8 +30 -1 parrot/t/pmc/objects.t
Index: objects.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/objects.t,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -w -r1.7 -r1.8
--- objects.t 22 Oct 2003 08:07:14 -0000 1.7
+++ objects.t 3 Dec 2003 11:17:50 -0000 1.8
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 7;
+use Parrot::Test tests => 9;
use Test::More;
output_is(<<'CODE', <<'OUTPUT', "findclass (base class)");
@@ -155,3 +155,32 @@
0011
OUTPUT
+output_is(<<'CODE', <<'OUTPUT', "new object");
+ newclass P1, "Foo"
+ find_type I0, "Foo"
+ new P2, I0
+ print "ok 1\n"
+ end
+CODE
+ok 1
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "new object - type, isa");
+ newclass P1, "Foo"
+ find_type I0, "Foo"
+ new P2, I0
+ print "ok 1\n"
+ typeof I1, P2
+ eq I0, I1, ok2
+ print "not "
+ok2:
+ print "ok 2\n"
+ isa I3, P2, "Foo"
+ print I3
+ print "\n"
+ end
+CODE
+ok 1
+ok 2
+1
+OUTPUT
