This patch fixes two find_exception_handler bugs, and identifies a
third, all related to executing pushaction subs:
1. It is necessary to wait until after popping the action before
calling it, lest the signalling of another error during action execution
causes you to lose, and lose, and lose, . . .
2. Even without an error, it seems that actions could sometimes be
run twice because stack_pop compared entry->cleanup to 0 instead of
STACK_CLEANUP_NULL. (I can't reproduce this now, so it probably
depended on something else as well.)
3. Actions are not run at all if the context is skipped by calling a
continuation. This is a deeper problem, so I've just added a TODO test
in order to document it as a known problem; I hope to fix this in the
course of implementing dynamic binding.
TIA,
-- Bob Rogers
http://rgrjr.dyndns.org/
Index: src/exceptions.c
===================================================================
--- src/exceptions.c (revision 10896)
+++ src/exceptions.c (working copy)
@@ -220,22 +220,28 @@
*/
message = VTABLE_get_string_keyed_int(interpreter, exception, 0);
do {
+ PMC *cleanup_sub = NULL;
Stack_Entry_t *e = stack_entry(interpreter,
CONTEXT(interpreter->ctx)->control_stack, 0);
+
if (!e)
break;
if (e->entry_type == STACK_ENTRY_ACTION) {
/*
- * Clear automatic cleanup routine run in stack_pop
- * and run the action subroutine with an INTVAL argument.
- * of 1
+ * Disable automatic cleanup routine execution in stack_pop so that
+ * we can run the action subroutine manually with an INTVAL
argument
+ * of 1. Note that we have to run the sub AFTER it has been
popped,
+ * lest a new error in the sub cause an infinite loop.
*/
- PMC *sub = UVal_pmc(e->entry);
+ cleanup_sub = UVal_pmc(e->entry);
e->cleanup = STACK_CLEANUP_NULL;
- Parrot_runops_fromc_args(interpreter, sub, "vI", 1);
}
(void)stack_pop(interpreter, &CONTEXT(interpreter->ctx)->control_stack,
NULL, e->entry_type);
+ if (cleanup_sub) {
+ /* Now it's safe to run. */
+ Parrot_runops_fromc_args(interpreter, cleanup_sub, "vI", 1);
+ }
if (e->entry_type == STACK_ENTRY_PMC) {
/*
* During interpreter creation there is an initial context
Index: src/stacks.c
===================================================================
--- src/stacks.c (revision 10896)
+++ src/stacks.c (working copy)
@@ -308,7 +308,7 @@
}
/* Cleanup routine? */
- if (entry->cleanup) {
+ if (entry->cleanup != STACK_CLEANUP_NULL) {
(*entry->cleanup) (interpreter, entry);
}
Index: t/pmc/exception.t
===================================================================
--- t/pmc/exception.t (revision 10896)
+++ t/pmc/exception.t (working copy)
@@ -6,7 +6,7 @@
use warnings;
use lib qw( . lib ../lib ../../lib );
use Test::More;
-use Parrot::Test tests => 24;
+use Parrot::Test tests => 26;
=head1 NAME
@@ -464,3 +464,130 @@
CODE
1 2
OUTPUT
+
+{
+local $TODO = 'bug';
+
+## this is broken; continuation calling does not execute actions when
unwinding.
+pir_output_is(<<'CODE', <<'OUTPUT', 'cleanup global: continuation');
+.sub main :main
+ .local pmc outer, cont
+ outer = new String
+ outer = "Outer value\n"
+ store_global "Foo::Bar", "test", outer
+ new cont, .Continuation
+ set_addr cont, endcont
+ store_global "Foo::Bar", "exit", cont
+ show_value()
+ test1()
+ print "skipped.\n"
+endcont:
+ show_value()
+.end
+.sub test1
+ .local pmc test1_binding, old_value, cleanup
+ .lex "old_value", old_value
+ test1_binding = new String
+ test1_binding = "Inner value\n"
+ old_value = find_global "Foo::Bar", "test"
+ .const .Sub test1_cleanup_sub = "test1_cleanup"
+ cleanup = newclosure test1_cleanup_sub
+ pushaction cleanup
+ store_global "Foo::Bar", "test", test1_binding
+ show_value()
+ test2()
+ show_value()
+.end
+.sub test1_cleanup :outer(test1)
+ .local pmc old_value
+ print "[in test1_cleanup]\n"
+ find_lex old_value, "old_value"
+ store_global "Foo::Bar", "test", old_value
+.end
+.sub test2
+ .local pmc test2_binding, exit
+ test2_binding = new String
+ test2_binding = "Innerer value\n"
+ store_global "Foo::Bar", "test", test2_binding
+ show_value()
+ exit = find_global "Foo::Bar", "exit"
+ exit()
+.end
+.sub show_value
+ .local pmc value
+ value = find_global "Foo::Bar", "test"
+ print value
+.end
+CODE
+Outer value
+Inner value
+Innerer value
+[in test1_cleanup]
+Outer value
+OUTPUT
+
+$TODO++; # suppress warning.
+}
+
+pir_output_is(<<'CODE', <<'OUTPUT', 'cleanup global: throw');
+.sub main :main
+ .local pmc outer
+ outer = new String
+ outer = "Outer value\n"
+ store_global "Foo::Bar", "test", outer
+ push_eh eh
+ show_value()
+ test1()
+ print "skipped.\n"
+eh:
+ .local pmc exception
+ .get_results (exception)
+ print "Error: "
+ print exception
+ print "\n"
+last:
+ show_value()
+.end
+.sub test1
+ .local pmc test1_binding, old_value, cleanup
+ .lex "old_value", old_value
+ test1_binding = new String
+ test1_binding = "Inner value\n"
+ old_value = find_global "Foo::Bar", "test"
+ .const .Sub test1_cleanup_sub = "test1_cleanup"
+ cleanup = newclosure test1_cleanup_sub
+ pushaction cleanup
+ store_global "Foo::Bar", "test", test1_binding
+ show_value()
+ test2()
+ show_value()
+.end
+.sub test1_cleanup :outer(test1)
+ .local pmc old_value
+ print "[in test1_cleanup]\n"
+ find_lex old_value, "old_value"
+ store_global "Foo::Bar", "test", old_value
+.end
+.sub test2
+ .local pmc test2_binding, exit
+ test2_binding = new String
+ test2_binding = "Innerer value\n"
+ store_global "Foo::Bar", "test", test2_binding
+ show_value()
+ exit = new Exception
+ exit["_message"] = "something happened"
+ throw exit
+.end
+.sub show_value
+ .local pmc value
+ value = find_global "Foo::Bar", "test"
+ print value
+.end
+CODE
+Outer value
+Inner value
+Innerer value
+[in test1_cleanup]
+Error: something happened
+Outer value
+OUTPUT
