I've been playing about with the new object stuff you added today, and
I've noticed a couple of problems.
Firstly, when your doing the initialization for a new ParrotClass PMC,
you create an Array to hold various other PMCs, but you don't size the
array; this means that when you later try to put things in it in
Parrot_new_class, it dies with:
Array index out of bounds!
The simplest solution is just to specify the size, as in the patch below.
------------
The other problem I noticed was that in a bunch of the ops you're using
code like:
PMC *class = VTABLE_get_pmc_keyed(interpreter,
interpreter->class_hash, key_new_string(interpreter, $2));
to get the ParrotClass PMC, and then seeing whether it's a valid class
by checking whether class is NULL. 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;
}
Unfortunately, this doesn't do what you intend. When you look up a
non-existent entry in a PerlHash, it creates and returns a PerlUndef PMC,
so the class pointer that you get is always non-NULL, even though it
isn't necessarily a ParrotClass. Consequently, in the example above,
findclass always returns true.
I'm not sure what the best fix is here.
Simon
--- classes/parrotclass.pmc Wed Jul 16 22:28:40 2003
+++ classes/parrotclass.pmc.new Wed Jul 16 22:28:35 2003
@@ -32,6 +32,8 @@
void init () {
/* Hang an array off the data pointer, empty of course */
PMC_data(SELF) = pmc_new(interpreter, enum_class_Array);
+ /* We will have five entries in this array */
+ VTABLE_set_integer_native(interpreter, (PMC*)PMC_data(SELF), (INTVAL)5);
/* No attributes to start with */
SELF->obj.u.int_val = 0;
/* But we are a class, really */
> Dan,
> Firstly, when your doing the initialization for a new ParrotClass PMC,
> you create an Array to hold various other PMCs, but you don't size the
> array; this means that when you later try to put things in it in
> Parrot_new_class, it dies with:
> Array index out of bounds!
I would use an SArray. Its simpler then an Array. Also the DOD flag is
bogus. An Array is not a buffer of PMCs. Its a ptr to a PMC in data:
PObj_is_PMC_ptr_FLAG.
> .... 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 ...
And the second find_class op should be get_class.
And s/obj\.u\.int_val/cache.int_val/g
leo
Point taken, and I've patched the patch from Simon.
>Also the DOD flag is
>bogus. An Array is not a buffer of PMCs. Its a ptr to a PMC in data:
>PObj_is_PMC_ptr_FLAG.
Gah. Thinko on my part. (I really want that thing hanging off the
data pointer to be a buffer not a PMC...)
> > .... 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.
>And the second find_class op should be get_class.
D'oh! Fixed too. (This would all be why I don't commit much code)
>And s/obj\.u\.int_val/cache.int_val/g
Ah, I see. Changed as well.
--
Dan
--------------------------------------"it's like this"-------------------
Dan Sugalski even samurai
d...@sidhe.org have teddy bears and even
teddy bears get drunk
On Thu, 17 Jul 2003, Dan Sugalski wrote:
> At 9:24 AM +0200 7/17/03, Leopold Toetsch wrote:
> >Simon Glover <sc...@amnh.org> 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
Simon
--- MANIFEST.old Fri Jul 18 13:35:04 2003
+++ MANIFEST Fri Jul 18 13:35:41 2003
@@ -1861,6 +1861,7 @@
t/pmc/managedstruct.t []
t/pmc/multiarray.t []
t/pmc/nci.t []
+t/pmc/objects.t []
t/pmc/perlarray.t []
t/pmc/perlhash.t []
t/pmc/perlint.t []
Thanks Simon. Applied.