cvsuser 04/12/08 06:09:55
Modified: classes retcontinuation.pmc
src exceptions.c
t/pmc exception.t
Log:
pushmark, popmark, pushaction 2 - run action handlers
Revision Changes Path
1.24 +18 -1 parrot/classes/retcontinuation.pmc
Index: retcontinuation.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/retcontinuation.pmc,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -r1.23 -r1.24
--- retcontinuation.pmc 7 Nov 2004 15:29:58 -0000 1.23
+++ retcontinuation.pmc 8 Dec 2004 14:09:51 -0000 1.24
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: retcontinuation.pmc,v 1.23 2004/11/07 15:29:58 leo Exp $
+$Id: retcontinuation.pmc,v 1.24 2004/12/08 14:09:51 leo Exp $
=head1 NAME
@@ -76,6 +76,23 @@
void* invoke (void* next) {
Stack_Chunk_t *stack_p;
+ Stack_Chunk_t *ctr_stack, *stack_now;
+ /*
+ * unwind control stack
+ */
+ stack_now = interpreter->ctx.control_stack;
+ ctr_stack = PMC_cont(SELF)->ctx.control_stack;
+ while (stack_now != ctr_stack) {
+ if (!stack_now || !ctr_stack)
+ internal_exception(1, "Control stack damaged");
+ /*
+ * this automagically runs all pushed action
+ * handler during pop - see cleanup stuff
+ * in stack_pop
+ */
+ (void)stack_pop(interpreter, &stack_now,
+ NULL, NO_STACK_ENTRY_TYPE);
+ }
stack_p = interpreter->ctx.reg_stack;
next = SUPER(next);
1.67 +11 -1 parrot/src/exceptions.c
Index: exceptions.c
===================================================================
RCS file: /cvs/public/parrot/src/exceptions.c,v
retrieving revision 1.66
retrieving revision 1.67
diff -u -r1.66 -r1.67
--- exceptions.c 8 Dec 2004 13:20:45 -0000 1.66
+++ exceptions.c 8 Dec 2004 14:09:54 -0000 1.67
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: exceptions.c,v 1.66 2004/12/08 13:20:45 leo Exp $
+$Id: exceptions.c,v 1.67 2004/12/08 14:09:54 leo Exp $
=head1 NAME
@@ -160,6 +160,10 @@
static void
run_cleanup_action(Interp *interpreter, Stack_Entry_t *e)
{
+ /*
+ * this is called during normal stack_pop of the control
+ * stack - run the action subroutine with an INTVAL arg of 0
+ */
PMC *sub = UVal_pmc(e->entry);
Parrot_runops_fromc_args(interpreter, sub, "vI", 0);
}
@@ -225,7 +229,13 @@
if (!e)
break;
if (e->entry_type == STACK_ENTRY_ACTION) {
+ /*
+ * Clear automatic cleanup routine run in stack_pop
+ * and run the action sburoutine with an INTVAL argument
+ * of 1
+ */
PMC *sub = UVal_pmc(e->entry);
+ e->cleanup = STACK_CLEANUP_NULL;
Parrot_runops_fromc_args(interpreter, sub, "vI", 1);
}
(void)stack_pop(interpreter, &interpreter->ctx.control_stack,
1.16 +107 -68 parrot/t/pmc/exception.t
Index: exception.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/exception.t,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -r1.15 -r1.16
--- exception.t 8 Dec 2004 13:20:47 -0000 1.15
+++ exception.t 8 Dec 2004 14:09:55 -0000 1.16
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: exception.t,v 1.15 2004/12/08 13:20:47 leo Exp $
+# $Id: exception.t,v 1.16 2004/12/08 14:09:55 leo Exp $
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-use Parrot::Test tests => 28;
+use Parrot::Test tests => 30;
use Test::More;
output_is(<<'CODE', <<'OUTPUT', "push_eh - clear_eh");
@@ -318,36 +318,6 @@
back in 2
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "throw from a sub");
- print "main\n"
- newsub P20, .Exception_Handler, _handler
- set_eh P20
- newsub P0, .Sub, _sub
- invokecc
- print "back in main\n"
- end
-
-_sub:
- new P30, .Exception
- set P30["_message"], "something happend"
- throw P30
- print "back in sub\n"
- invoke P1
-_handler:
- print "catched it\n"
- set S0, P5["_message"]
- print S0
- print "\n"
- set P2, P5["_invoke_cc"] # the return continuation
- invoke P2
-CODE
-main
-catched it
-something happend
-back in sub
-back in main
-OUTPUT
-
output_is(<<'CODE', <<OUT, "die_hard");
newsub P0, .Exception_Handler, _handler
set_eh P0
@@ -416,40 +386,6 @@
/
OUT
-output_is(<<'CODE', <<'OUTPUT', "rethrow");
- print "main\n"
- newsub P20, .Exception_Handler, _handler1
- set_eh P20
- newsub P21, .Exception_Handler, _handler2
- set_eh P21
-
- new P30, .Exception
- set P30["_message"], "something happend"
- throw P30
- print "back in main\n"
- end
-_handler1:
- print "catched it in 1\n"
- set S0, P5["_message"]
- print S0
- print "\n"
- set P2, P5["_invoke_cc"] # the return continuation
- invoke P2
-_handler2:
- print "catched it in 2\n"
- set S0, P5["_message"]
- print S0
- print "\n"
- rethrow P5
-CODE
-main
-catched it in 2
-something happend
-catched it in 1
-something happend
-back in main
-OUTPUT
-
output_is(<<'CODE', <<'OUTPUT', "clear_eh, set_eh again");
# bug reported by Jos Visser
@@ -625,11 +561,114 @@
print "ok 3\n"
end
.pcc_sub action:
- print "in action\n"
+ print "in action I5 = "
+ print I5
+ print "\n"
+ returncc
+CODE
+ok 1
+ok 2
+in action I5 = 0
+ok 3
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "pushaction, throw");
+ push_eh handler
+ print "ok 1\n"
+ .const .Sub P10 = "action"
+ pushaction P10
+ print "ok 2\n"
+ new P10, .Exception
+ throw P10
+ print "never\n"
+handler:
+ print "ok 3\n"
+ end
+.pcc_sub action:
+ print "in action I5 = "
+ print I5
+ print "\n"
returncc
CODE
ok 1
ok 2
-in action
+in action I5 = 1
ok 3
OUTPUT
+
+pir_output_is(<<'CODE', <<'OUTPUT', "pushaction, sub exit");
+.sub main
+ print "main\n"
+ foo()
+ print "back\n"
+.end
+
+.sub foo
+ .const .Sub ac = "action"
+ pushaction ac
+ print "foo\n"
+.end
+
+.sub action
+ .param int i
+ print "in action I5 = "
+ print i
+ print "\n"
+.end
+CODE
+main
+foo
+in action I5 = 0
+back
+OUTPUT
+
+pir_output_is(<<'CODE', <<'OUTPUT', "pushaction, sub exit - capture CC");
+.sub main
+ print "main\n"
+ foo()
+ print "back\n"
+.end
+
+.sub foo
+ .const .Sub ac = "action"
+ pushaction ac
+ .include "interpinfo.pasm"
+ .local pmc cc
+ cc = interpinfo .INTERPINFO_CURRENT_CONT
+ print "foo\n"
+.end
+
+.sub action
+ print "never\n"
+.end
+CODE
+main
+foo
+back
+OUTPUT
+
+pir_output_is(<<'CODE', <<'OUTPUT', "pushaction, sub exit - capture CC,
ret");
+.sub main
+ print "main\n"
+ foo()
+ print "back\n"
+.end
+
+.sub foo
+ .const .Sub ac = "action"
+ pushaction ac
+ .include "interpinfo.pasm"
+ .local pmc cc
+ cc = interpinfo .INTERPINFO_CURRENT_CONT
+ print "foo\n"
+ invoke cc
+.end
+
+.sub action
+ print "never\n"
+.end
+CODE
+main
+foo
+back
+OUTPUT
