cvsuser 04/02/25 15:34:19
Modified: src objects.c
t/pmc objects.t
Log:
Oh, so *very* close...
Revision Changes Path
1.42 +27 -14 parrot/src/objects.c
Index: objects.c
===================================================================
RCS file: /cvs/public/parrot/src/objects.c,v
retrieving revision 1.41
retrieving revision 1.42
diff -u -w -r1.41 -r1.42
--- objects.c 25 Feb 2004 21:15:37 -0000 1.41
+++ objects.c 25 Feb 2004 23:34:17 -0000 1.42
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: objects.c,v 1.41 2004/02/25 21:15:37 dan Exp $
+$Id: objects.c,v 1.42 2004/02/25 23:34:17 dan Exp $
=head1 NAME
@@ -104,7 +104,7 @@
/* Note the current offset as where this class'
attributes start */
VTABLE_set_integer_keyed_str(interpreter,
- attr_offset_hash,
+ class_offset_hash,
parent_name, cur_offset);
partial_name = string_concat(interpreter, parent_name,
string_from_cstring(interpreter, "\0",
1),
@@ -127,7 +127,7 @@
child class works better */
classname = VTABLE_get_string_keyed_int(interpreter, obj_array,
PCD_CLASS_NAME);
- VTABLE_set_integer_keyed_str(interpreter, attr_offset_hash, classname,
+ VTABLE_set_integer_keyed_str(interpreter, class_offset_hash, classname,
cur_offset);
{
PMC *attribs;
@@ -141,7 +141,7 @@
partial_name = string_concat(interpreter, classname,
string_from_cstring(interpreter, "\0", 1),
0);
-
+ if (attr_count) {
for (offset = 0; offset < attr_count; offset++) {
STRING *attr_name;
STRING *full_name;
@@ -152,6 +152,7 @@
}
}
}
+ }
/* And replace what was in there with the new ones */
VTABLE_set_pmc_keyed_int(interpreter, obj_array, PCD_ATTRIBUTES,
@@ -159,15 +160,14 @@
VTABLE_set_pmc_keyed_int(interpreter, obj_array, PCD_ATTRIB_OFFS,
class_offset_hash);
/* And note the totals */
- class->cache.int_val = cur_offset;
-
+ class->cache.int_val = cur_offset - POD_FIRST_ATTRIB;
return;
}
/*
=item C<PMC *
-Parrot_single_subclass(Parrot_Interp interpreter, PMC *base_class,
+Parrot_single_subclass(Parrot_Interp ointerpreter, PMC *base_class,
STRING *child_class_name)>
Subclass a class. Single parent class, nice and straightforward. If
@@ -258,6 +258,8 @@
Parrot_class_register(interpreter, child_class_name, child_class);
+ rebuild_attrib_stuff(interpreter, child_class);
+
return child_class;
}
@@ -302,6 +304,7 @@
classname_pmc);
Parrot_class_register(interpreter, class_name, class);
+ rebuild_attrib_stuff(interpreter, class);
}
/*
@@ -810,7 +813,12 @@
{
PMC *attrib_array;
if (PObj_is_object_TEST(object)) {
+ INTVAL attrib_count;
attrib_array = PMC_data(object);
+ attrib_count = VTABLE_elements(interpreter, attrib_array);
+ if (attrib > attrib_count || attrib < 0) {
+ internal_exception(OUT_OF_BOUNDS, "No such attribute");
+ }
return VTABLE_get_pmc_keyed_int(interpreter, attrib_array, attrib);
}
else {
@@ -823,7 +831,12 @@
Parrot_set_attrib_by_num(Parrot_Interp interpreter, PMC *object, INTVAL attrib, PMC
*value) {
PMC *attrib_array;
if (PObj_is_object_TEST(object)) {
+ INTVAL attrib_count;
attrib_array = PMC_data(object);
+ attrib_count = VTABLE_elements(interpreter, attrib_array);
+ if (attrib > attrib_count || attrib < 0) {
+ internal_exception(OUT_OF_BOUNDS, "No such attribute");
+ }
VTABLE_set_pmc_keyed_int(interpreter, attrib_array, attrib, value);
}
else {
1.20 +3 -3 parrot/t/pmc/objects.t
Index: objects.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/objects.t,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -w -r1.19 -r1.20
--- objects.t 25 Feb 2004 21:57:29 -0000 1.19
+++ objects.t 25 Feb 2004 23:34:19 -0000 1.20
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: objects.t,v 1.19 2004/02/25 21:57:29 scog Exp $
+# $Id: objects.t,v 1.20 2004/02/25 23:34:19 dan Exp $
=head1 NAME
@@ -401,7 +401,7 @@
find_type I0, "Foo"
new P2, I0
new P3, .PerlInt
- setattribute P2, 0, P3
+ setattribute P2, 8, P3
end
CODE
/No such attribute/
@@ -411,7 +411,7 @@
newclass P1, "Foo"
find_type I0, "Foo"
new P2, I0
- getattribute P3, P2, 0
+ getattribute P3, P2, 8
end
CODE
/No such attribute/
