# New Ticket Created by Jeff Horwitz
# Please include the string: [perl #49532]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=49532 >
After creating a new interpreter with Parrot_new(NULL) and destroying it
with Parrot_really_destroy(), a second call to Parrot_new(NULL) segfaults.
Parrot_really_destroy() should reset things so we can call Parrot_new()
without a parent interpreter again, as if we were starting from scratch.
The attached patch augments t/src/extend.t to test this condition. It
currently fails with a segfault. The backtrace follows:
Program received signal SIGSEGV, Segmentation fault.
[Switching to Thread 1081202368 (LWP 14146)]
0x401d8271 in create_class_pmc (interp=0x8228638, type=1) at src/pmc.c:496
496 if ((interp->vtables[type]->flags & VTABLE_PMC_IS_SINGLETON)
(gdb) bt
#0 0x401d8271 in create_class_pmc (interp=0x8228638, type=1) at src/pmc.c:496
#1 0x401d84a1 in Parrot_create_mro (interp=0x8228638, type=1) at src/pmc.c:566
#2 0x402e192a in Parrot_Null_class_init (interp=0x8228638, entry=1, pass=1)
at null.c:993
#3 0x4017e0b6 in Parrot_initialize_core_pmcs (interp=0x8228638)
at src/core_pmcs.c:111
#4 0x40197a60 in init_world (interp=0x8228638) at src/global_setup.c:156
#5 0x401979fc in init_world_once (interp=0x8228638) at src/global_setup.c:122
#6 0x401a0066 in make_interpreter (parent=0x0, flags=0)
at src/inter_create.c:181
#7 0x401850c2 in Parrot_new (parent=0x0) at src/embed.c:85
#8 0x080487b1 in main () at foo.c:46
Index: CREDITS
===================================================================
--- CREDITS (revision 24566)
+++ CREDITS (working copy)
@@ -626,3 +626,7 @@
N: Alek Storm
E: [EMAIL PROTECTED]
D: Fixed object vtable method overrides in PIR
+
+N: Jeff Horwitz
+E: [EMAIL PROTECTED]
+D: Various bug fixes and tests
Index: t/src/extend.t
===================================================================
--- t/src/extend.t (revision 24566)
+++ t/src/extend.t (working copy)
@@ -10,7 +10,7 @@
use Parrot::Test;
use Parrot::Config;
-plan tests => 16;
+plan tests => 17;
=head1 NAME
@@ -697,6 +697,56 @@
Result is 300.
OUTPUT
+c_output_is( <<'CODE', <<'OUTPUT', "multiple Parrot_new/Parrot_exit cycles" );
+
+#include <stdio.h>
+#include "parrot/parrot.h"
+#include "parrot/embed.h"
+
+/* this is Parrot_exit without the exit()
+ * it will call Parrot_really_destroy() as an exit handler
+ */
+void interp_cleanup(Parrot_Interp, int);
+
+void interp_cleanup(Parrot_Interp interp, int status)
+{
+ handler_node_t *node = interp->exit_handler_list;
+
+ Parrot_block_DOD(interp);
+ Parrot_block_GC(interp);
+
+ while (node) {
+ handler_node_t * const next = node->next;
+ (node->function)(interp, status, node->arg);
+ mem_sys_free(node);
+ node = next;
+ }
+}
+
+int
+main(int argc, char* argv[]) {
+ Parrot_Interp interp;
+ int i, niter = 2;
+
+ for (i = 1; i <= niter; i++) {
+ printf("Starting interp %d\n", i);
+ interp = Parrot_new(NULL);
+ Parrot_set_flag(interp, PARROT_DESTROY_FLAG);
+ if ( interp == NULL ) return 1;
+ printf("Destroying interp %d\n", i);
+ interp_cleanup(interp, 0);
+ }
+
+ return 0;
+}
+
+CODE
+Starting interp 1
+Destroying interp 1
+Starting interp 2
+Destroying interp 2
+OUTPUT
+
unlink "$temp.pasm", "$temp.pir", "$temp.pbc" unless $ENV{POSTMORTEM};
# Local Variables:
