cvsuser 03/12/05 06:37:11
Modified: classes parrotclass.pmc parrotobject.pmc
src objects.c
t/pmc objects.t
Log:
objects-4
* fixed add_attribute code
* INTVAL attrib accessor for objects
Revision Changes Path
1.12 +8 -10 parrot/classes/parrotclass.pmc
Index: parrotclass.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/parrotclass.pmc,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -w -r1.11 -r1.12
--- parrotclass.pmc 5 Dec 2003 12:07:38 -0000 1.11
+++ parrotclass.pmc 5 Dec 2003 14:37:06 -0000 1.12
@@ -1,7 +1,7 @@
/* parrotclass.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: parrotclass.pmc,v 1.11 2003/12/05 12:07:38 leo Exp $
+ * $Id: parrotclass.pmc,v 1.12 2003/12/05 14:37:06 leo Exp $
* Overview:
* These are the vtable functions for the ParrotClass base class
* Data Structure and Algorithms:
@@ -56,9 +56,8 @@
}
/*
- * attribute access meths
+ * attrib count
*/
-
INTVAL elements() {
PMC* class_array = (PMC*) PMC_data(SELF);
PMC* attr_hash = VTABLE_get_pmc_keyed_int(interpreter,
@@ -70,18 +69,17 @@
return SELF.elements();
}
+ /*
+ * attribute access meths
+ */
+
INTVAL get_integer_keyed_str (STRING* attr) {
PMC* class_array = (PMC*) PMC_data(SELF);
PMC* attr_hash = VTABLE_get_pmc_keyed_int(interpreter,
class_array, PCD_ATTRIBUTES);
- STRING *class_name = VTABLE_get_string(interpreter,
- VTABLE_get_pmc_keyed_int(interpreter,
- class_array, PCD_CLASS_NAME));
- STRING *full_attr_name = Parrot_sprintf_c(interpreter, "%S%s%S",
- class_name, PARROT_NAMESPACE_SEPARATOR, attr);
- if (VTABLE_exists_keyed_str(interpreter, attr_hash, full_attr_name))
+ if (VTABLE_exists_keyed_str(interpreter, attr_hash, attr))
return VTABLE_get_integer_keyed_str(interpreter,
- attr_hash, full_attr_name);
+ attr_hash, attr);
return -1;
}
1.12 +45 -1 parrot/classes/parrotobject.pmc
Index: parrotobject.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/parrotobject.pmc,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -w -r1.11 -r1.12
--- parrotobject.pmc 5 Dec 2003 12:07:38 -0000 1.11
+++ parrotobject.pmc 5 Dec 2003 14:37:06 -0000 1.12
@@ -1,7 +1,7 @@
/* parrotobject.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: parrotobject.pmc,v 1.11 2003/12/05 12:07:38 leo Exp $
+ * $Id: parrotobject.pmc,v 1.12 2003/12/05 14:37:06 leo Exp $
* Overview:
* These are the vtable functions for the ParrotObject base class
* Data Structure and Algorithms:
@@ -59,5 +59,49 @@
INTVAL get_integer() {
return SELF.elements();
+ }
+
+ /*
+ * attribute access
+ */
+
+ INTVAL get_integer_keyed_int (INTVAL idx) {
+ PMC* data_array = (PMC*) PMC_data(SELF);
+ return VTABLE_get_integer_keyed_int(interpreter, data_array,
+ idx - SELF->cache.int_val);
+ }
+
+ INTVAL get_integer_keyed_str (STRING* attr) {
+ PMC* data_array = (PMC*) PMC_data(SELF);
+ PMC *class = VTABLE_get_pmc_keyed_int(interpreter, data_array,
+ POD_CLASS);
+ INTVAL idx = VTABLE_get_integer_keyed_str(interpreter, class, attr);
+ if (idx < 0)
+ internal_exception(1, "No such attribute");
+ return SELF.get_integer_keyed_int(idx);
+ }
+
+ INTVAL get_integer_keyed (PMC* attr) {
+ return SELF.get_integer_keyed_str(key_string(interpreter, attr));
+ }
+
+ void set_integer_keyed_int (INTVAL idx, INTVAL value) {
+ PMC* data_array = (PMC*) PMC_data(SELF);
+ VTABLE_set_integer_keyed_int(interpreter, data_array,
+ idx - SELF->cache.int_val, value);
+ }
+
+ void set_integer_keyed_str (STRING* attr, INTVAL value) {
+ PMC* data_array = (PMC*) PMC_data(SELF);
+ PMC *class = VTABLE_get_pmc_keyed_int(interpreter, data_array,
+ POD_CLASS);
+ INTVAL idx = VTABLE_get_integer_keyed_str(interpreter, class, attr);
+ if (idx < 0)
+ internal_exception(1, "No such attribute");
+ SELF.set_integer_keyed_int(idx, value);
+ }
+
+ void set_integer_keyed (PMC* attr, INTVAL value) {
+ SELF.set_integer_keyed_str(key_string(interpreter, attr), value);
}
}
1.25 +10 -3 parrot/src/objects.c
Index: objects.c
===================================================================
RCS file: /cvs/public/parrot/src/objects.c,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -w -r1.24 -r1.25
--- objects.c 5 Dec 2003 12:08:06 -0000 1.24
+++ objects.c 5 Dec 2003 14:37:09 -0000 1.25
@@ -1,7 +1,7 @@
/* objects.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: objects.c,v 1.24 2003/12/05 12:08:06 leo Exp $
+ * $Id: objects.c,v 1.25 2003/12/05 14:37:09 leo Exp $
* Overview:
* Handles class and object manipulation
* Data Structure and Algorithms:
@@ -455,8 +455,15 @@
}
attr_hash = VTABLE_get_pmc_keyed_int(interpreter,
class_array, PCD_ATTRIBUTES);
- full_attr_name = Parrot_sprintf_c(interpreter, "%S%s%S",
- class_name, PARROT_NAMESPACE_SEPARATOR, attr),
+ full_attr_name = Parrot_sprintf_c(interpreter, "%Ss%Ss%Ss",
+ class_name,
+ string_from_cstring(interpreter, PARROT_NAMESPACE_SEPARATOR,
+ PARROT_NAMESPACE_SEPARATOR_LENGTH),
+ attr);
+ /*
+ * TODO check if someone is trying to add attributes to a parent class
+ * while there are already child class attrs
+ */
idx = VTABLE_elements(interpreter, attr_hash);
assert(class->cache.int_val == idx);
VTABLE_set_integer_keyed_str(interpreter, attr_hash,
1.11 +75 -5 parrot/t/pmc/objects.t
Index: objects.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/objects.t,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -w -r1.10 -r1.11
--- objects.t 5 Dec 2003 12:08:14 -0000 1.10
+++ objects.t 5 Dec 2003 14:37:11 -0000 1.11
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 16;
+use Parrot::Test tests => 19;
use Test::More;
output_is(<<'CODE', <<'OUTPUT', "findclass (base class)");
@@ -332,13 +332,13 @@
output_is(<<'CODE', <<'OUTPUT', "addattrib subclass - get idx");
newclass P1, "Foo"
addattrib I1, P1, "foo_i"
- set I2, P1["Foo\x0foo_i"]
+ set I2, P1["Foo\x00foo_i"]
eq I1, I2, ok1
print "not "
ok1:
print "ok 1\n"
addattrib I1, P1, "foo_j"
- set I2, P1["Foo\x0foo_j"]
+ set I2, P1["Foo\x00foo_j"]
eq I1, I2, ok2
print "not "
ok2:
@@ -346,13 +346,13 @@
subclass P2, P1, "Bar"
addattrib I1, P2, "bar_i"
- set I2, P2["Bar\x0bar_i"]
+ set I2, P2["Bar\x00bar_i"]
eq I1, I2, ok3
print "not "
ok3:
print "ok 3\n"
addattrib I1, P2, "bar_j"
- set I2, P2["Bar\x0bar_j"]
+ set I2, P2["Bar\x00bar_j"]
eq I1, I2, ok4
print "not "
ok4:
@@ -384,3 +384,73 @@
2
OUTPUT
+output_is(<<'CODE', <<'OUTPUT', "object attribs 1");
+ newclass P1, "Foo"
+ addattrib I1, P1, "i"
+ addattrib I1, P1, "j"
+
+ find_type I0, "Foo"
+ new P2, I0
+ new P3, I0
+
+ set P2["Foo\x00i"], 10
+ set P3["Foo\x00i"], 20
+ set I2, P2["Foo\x00i"]
+ set I3, P3["Foo\x00i"]
+ print I2
+ print "\n"
+ print I3
+ print "\n"
+ end
+CODE
+10
+20
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "object attribs 2");
+ newclass P1, "Foo"
+ addattrib I1, P1, "i"
+ addattrib I1, P1, "j"
+
+ find_type I0, "Foo"
+ new P2, I0
+ new P3, I0
+
+ set P2["Foo\x00i"], 10
+ set P3["Foo\x00i"], 20
+ set P2["Foo\x00j"], 30
+ set P3["Foo\x00j"], 40
+ set I4, P2["Foo\x00j"]
+ set I5, P3["Foo\x00j"]
+ set I2, P2["Foo\x00i"]
+ set I3, P3["Foo\x00i"]
+ print I2
+ print "\n"
+ print I3
+ print "\n"
+ print I4
+ print "\n"
+ print I5
+ print "\n"
+ end
+ end
+CODE
+10
+20
+30
+40
+OUTPUT
+
+output_like(<<'CODE', <<'OUTPUT', "object attribs 3");
+ newclass P1, "Foo"
+ addattrib I1, P1, "i"
+
+ find_type I0, "Foo"
+ new P2, I0
+
+ set P2["Foo\x00no_such"], 10
+ print "never\n"
+ end
+CODE
+/No such attribute/
+OUTPUT
