On Thu, 17 Jul 2003, Dan Sugalski wrote:
> At 9:24 AM +0200 7/17/03, Leopold Toetsch wrote:
> >Simon Glover <[EMAIL PROTECTED]> wrote:
> >
> > > .... For instance, in findclass, you have:
> >
> >> if (VTABLE_get_pmc_keyed(interpreter, interpreter->class_hash,
> >> key_new_string(interpreter, $2))) {
> >> $1 = 1;
> >> } else {
> >> $1 = 0;
> >> }
> >
> >this should be VTABLE_exists_keyed ...
>
> Point. Updated.
Of course this still doesn't work, because we never actually add anything
to the class_hash. Patch below fixes this, as well as various bugs in
Parrot_single_subclass, and adds a couple of regression tests.
Simon
--- objects.c.old Fri Jul 18 12:09:27 2003
+++ objects.c Fri Jul 18 13:30:14 2003
@@ -31,16 +31,19 @@
child_class = pmc_new(interpreter, enum_class_ParrotClass);
child_class_array = PMC_data(child_class);
+
/* We have the same number of attributes as our parent */
child_class->obj.u.int_val = base_class->obj.u.int_val;
+
/* Our parent class array has a single member in it */
temp_pmc = pmc_new(interpreter, enum_class_Array);
+ VTABLE_set_integer_native(interpreter, temp_pmc, 1);
VTABLE_set_pmc_keyed_int(interpreter, child_class_array, 0, temp_pmc);
VTABLE_set_pmc_keyed_int(interpreter, temp_pmc, 0, base_class);
/* Our penultimate parent list is a clone of our parent's parent
list, with our parent unshifted onto the beginning */
- temp_pmc = pmc_new(interpreter, enum_class_PerlUndef);
+ temp_pmc = pmc_new_noinit(interpreter, enum_class_Array);
VTABLE_clone(interpreter,
VTABLE_get_pmc_keyed_int(interpreter,
(PMC *)PMC_data(base_class), 1),
@@ -49,7 +52,7 @@
VTABLE_set_pmc_keyed_int(interpreter, child_class_array, 1, temp_pmc);
/* Our attribute list is our parent's attribute list */
- temp_pmc = pmc_new(interpreter, enum_class_PerlUndef);
+ temp_pmc = pmc_new_noinit(interpreter, enum_class_PerlHash);
VTABLE_clone(interpreter,
VTABLE_get_pmc_keyed_int(interpreter,
(PMC *)PMC_data(base_class), 2),
@@ -57,7 +60,7 @@
VTABLE_set_pmc_keyed_int(interpreter, child_class_array, 2, temp_pmc);
/* And our full keyed attribute list is our parent's */
- temp_pmc = pmc_new(interpreter, enum_class_PerlUndef);
+ temp_pmc = pmc_new_noinit(interpreter, enum_class_PerlHash);
VTABLE_clone(interpreter,
VTABLE_get_pmc_keyed_int(interpreter,
(PMC *)PMC_data(base_class), 3),
@@ -68,7 +71,13 @@
classname_pmc = pmc_new(interpreter, enum_class_PerlString);
if (child_class_name) {
VTABLE_set_string_native(interpreter, classname_pmc, child_class_name);
- } else {
+
+ /* Add ourselves to the interpreter's class hash */
+ VTABLE_set_pmc_keyed(interpreter, interpreter->class_hash,
+ key_new_string(interpreter, child_class_name),
+ child_class);
+ }
+ else {
VTABLE_set_string_native(interpreter, classname_pmc,
string_make(interpreter, "\0\0anonymous", 11, NULL, 0,
NULL));
}
@@ -106,6 +115,10 @@
VTABLE_set_string_native(interpreter, classname_pmc, class_name);
VTABLE_set_pmc_keyed_int(interpreter, new_class_array, 4, classname_pmc);
+ /* Add ourselves to the interpreter's class hash */
+ VTABLE_set_pmc_keyed(interpreter, interpreter->class_hash,
+ key_new_string(interpreter,class_name), new_class);
+
return(new_class);
}
--- /dev/null Thu Aug 30 16:30:55 2001
+++ t/pmc/objects.t Fri Jul 18 13:31:01 2003
@@ -0,0 +1,43 @@
+#! perl -w
+
+use Parrot::Test tests => 2;
+use Test::More;
+
+output_is(<<'CODE', <<'OUTPUT', "findclass (base class)");
+ newclass P1, "Foo"
+
+ findclass I0, "Foo"
+ print I0
+ print "\n"
+
+ findclass I0, "Bar"
+ print I0
+ print "\n"
+ end
+CODE
+1
+0
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "findclass (subclass)");
+ newclass P1, "Foo"
+ subclass P2, P1, "Bar"
+
+ findclass I0, "Foo"
+ print I0
+ print "\n"
+
+ findclass I0, "Bar"
+ print I0
+ print "\n"
+
+ findclass I0, "Qux"
+ print I0
+ print "\n"
+
+ end
+CODE
+1
+1
+0
+OUTPUT
