Author: leo
Date: Tue Apr 19 01:36:35 2005
New Revision: 7880
Modified:
trunk/classes/default.pmc
trunk/classes/deleg_pmc.pmc
trunk/src/dod.c
trunk/t/op/gc.t
Log:
assert some GC assumptions
* throw real_exception if vtable isn't found
* add a remark WRT marking in deleg_pmc
* add error message if a PMC has metadata but isn't special
Modified: trunk/classes/default.pmc
==============================================================================
--- trunk/classes/default.pmc (original)
+++ trunk/classes/default.pmc Tue Apr 19 01:36:35 2005
@@ -54,7 +54,7 @@
static void
cant_do_method(Interp* interpreter, PMC * pmc, const char *methname)
{
- internal_exception(ILL_INHERIT,
+ real_exception(interpreter, NULL, ILL_INHERIT,
"%s() not implemented in class '%s'", methname,
caller(interpreter, pmc));
}
Modified: trunk/classes/deleg_pmc.pmc
==============================================================================
--- trunk/classes/deleg_pmc.pmc (original)
+++ trunk/classes/deleg_pmc.pmc Tue Apr 19 01:36:35 2005
@@ -96,17 +96,17 @@
*/
void init () {
- PObj_custom_mark_SET(SELF);
}
void init_pmc (PMC* class) {
- PObj_custom_mark_SET(SELF);
}
void mark() {
- SLOTTYPE *attrib_array = PMC_data(SELF);
- PMC *attr = get_attrib_num(attrib_array, POD_FIRST_ATTRIB);
- pobject_lives(INTERP, (PObj *) PMC_pmc_val(SELF));
+ /* don't pass that on
+ *
+ * NB objects have the flag PObj_data_is_PMC_array_FLAG set,
+ * marking is done internally in src/dod.c
+ */
}
void destroy() {
Modified: trunk/src/dod.c
==============================================================================
--- trunk/src/dod.c (original)
+++ trunk/src/dod.c Tue Apr 19 01:36:35 2005
@@ -215,6 +215,17 @@
if (PObj_is_special_PMC_TEST(obj)) {
mark_special(interpreter, (PMC*) obj);
}
+#ifndef NDEBUG
+ else {
+ if (PObj_is_PMC_TEST(obj)) {
+ PMC *p = (PMC*)obj;
+ if (p->pmc_ext && PMC_metadata(p)) {
+ fprintf(stderr, "GC: error obj %p (%s) has properties\n",
+ p, (char*)p->vtable->whoami->strstart);
+ }
+ }
+ }
+#endif
#if GC_VERBOSE
/* buffer GC_DEBUG stuff */
if (! GC_DEBUG(interpreter))
Modified: trunk/t/op/gc.t
==============================================================================
--- trunk/t/op/gc.t (original)
+++ trunk/t/op/gc.t Tue Apr 19 01:36:35 2005
@@ -18,7 +18,7 @@
=cut
-use Parrot::Test tests => 18;
+use Parrot::Test tests => 19;
output_is( <<'CODE', '1', "sweep 1" );
interpinfo I1, 2 # How many DOD runs have we done already?
@@ -732,3 +732,46 @@
CODE
ok
OUTPUT
+
+pir_output_is(<<'CODE', <<'OUTPUT', "verify deleg_pmc object marking");
+.sub main @MAIN
+ .local pmc cl, s, t
+ cl = subclass "String", "X"
+ addattribute cl, "o3"
+ addattribute cl, "o4"
+ s = new "X"
+ $P0 = new String
+ $S0 = "ok" . " 3\n"
+ $P0 = $S0
+ setattribute s, "X\0o3", $P0
+ $P0 = new String
+ $S0 = "ok" . " 4\n"
+ $P0 = $S0
+ setattribute s, "X\0o4", $P0
+ null $P0
+ null $S0
+ null cl
+ sweep 1
+ s = "ok 1\n"
+ print s
+ .local int i
+ i = 0
+lp:
+ t = new "X"
+ inc i
+ if i < 1000 goto lp
+ t = "ok 2\n"
+ print s
+ print t
+ $P0 = getattribute s, "X\0o3"
+ print $P0
+ $P0 = getattribute s, "X\0o4"
+ print $P0
+.end
+CODE
+ok 1
+ok 1
+ok 2
+ok 3
+ok 4
+OUTPUT
