cvsuser 05/03/20 02:16:51
Modified: classes nci.pmc
ops core.ops
src pmc_freeze.c
t/pmc namespace.t
Log:
fix 2 segfaults
* redo changes in nci.pmc
* disable DOD in thaw
Revision Changes Path
1.33 +8 -3 parrot/classes/nci.pmc
Index: nci.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/nci.pmc,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -r1.32 -r1.33
--- nci.pmc 19 Mar 2005 16:20:05 -0000 1.32
+++ nci.pmc 20 Mar 2005 10:16:46 -0000 1.33
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: nci.pmc,v 1.32 2005/03/19 16:20:05 leo Exp $
+$Id: nci.pmc,v 1.33 2005/03/20 10:16:46 leo Exp $
=head1 NAME
@@ -125,10 +125,15 @@
Parrot_csub_t func = (Parrot_csub_t)D2FPTR(PMC_data(SELF));
PMC *obj;
/*
- * if the invocant is a class shift down arguments
+ * If the invocant is a class or there is no invocant
+ * shift down arguments.
+ * But not if it's a plain NCI function created
+ * from dlfunc.
*/
obj = REG_PMC(2);
- if (PObj_is_class_TEST(obj) || obj->vtable->class == obj) {
+ if (!(PObj_get_FLAGS(SELF) & PObj_private1_FLAG) &&
+ (PMC_IS_NULL(obj) || PObj_is_class_TEST(obj) ||
+ obj->vtable->class == obj)) {
INTVAL i, n;
REG_PMC(2) = REG_PMC(5); /* obj = 1st arg */
n = --REG_INT(3); /* argcP */
1.385 +1 -0 parrot/ops/core.ops
Index: core.ops
===================================================================
RCS file: /cvs/public/parrot/ops/core.ops,v
retrieving revision 1.384
retrieving revision 1.385
diff -u -r1.384 -r1.385
--- core.ops 19 Mar 2005 16:20:10 -0000 1.384
+++ core.ops 20 Mar 2005 10:16:47 -0000 1.385
@@ -1167,6 +1167,7 @@
else {
$1 = pmc_new(interpreter, enum_class_NCI);
$1->vtable->set_pointer_keyed_str(interpreter, $1, $4, F2DPTR(p));
+ PObj_get_FLAGS($1) |= PObj_private1_FLAG;
}
goto NEXT();
}
1.34 +8 -2 parrot/src/pmc_freeze.c
Index: pmc_freeze.c
===================================================================
RCS file: /cvs/public/parrot/src/pmc_freeze.c,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -r1.33 -r1.34
--- pmc_freeze.c 26 Jan 2005 17:13:52 -0000 1.33
+++ pmc_freeze.c 20 Mar 2005 10:16:49 -0000 1.34
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: pmc_freeze.c,v 1.33 2005/01/26 17:13:52 leo Exp $
+$Id: pmc_freeze.c,v 1.34 2005/03/20 10:16:49 leo Exp $
=head1 NAME
@@ -1475,8 +1475,14 @@
* if we are thawing a lot of PMCs, its cheaper to do
* a DOD run first and then block DOD - the limit should be
* chosen so that no more then one DOD run would be triggered
+ *
+ * XXX
+ *
+ * md5_3.imc shows a segfault during thawing the config hash
+ * info->thaw_ptr becomes invalid - seems that the hash got
+ * collected under us.
*/
- if (string_length(interpreter, image) > THAW_BLOCK_DOD_SIZE) {
+ if (1 || (string_length(interpreter, image) > THAW_BLOCK_DOD_SIZE)) {
Parrot_do_dod_run(interpreter, 1);
Parrot_block_DOD(interpreter);
Parrot_block_GC(interpreter);
1.3 +6 -6 parrot/t/pmc/namespace.t
Index: namespace.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/namespace.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- namespace.t 15 Mar 2005 10:08:30 -0000 1.2
+++ namespace.t 20 Mar 2005 10:16:51 -0000 1.3
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2005 The Perl Foundation. All Rights Reserved.
-# $Id: namespace.t,v 1.2 2005/03/15 10:08:30 leo Exp $
+# $Id: namespace.t,v 1.3 2005/03/20 10:16:51 leo Exp $
=head1 NAME
@@ -178,9 +178,7 @@
baz
OUTPUT
-TODO: {
- local $TODO = "probably wrong function called";
- pir_output_like(<<'CODE', <<'OUTPUT', "func() namespace resolution");
+pir_output_like(<<'CODE', <<'OUTPUT', "func() namespace resolution");
.sub main @MAIN
print "calling foo\n"
@@ -227,6 +225,8 @@
calling Foo::foo
Foo::foo
Foo::bar
-fie.*not found/
+ fie
+calling baz
+.*baz.*not found/
OUTPUT
-}
+
