cvsuser 03/07/10 07:07:03
Modified: . exceptions.c
t/pmc perlhash.t sub.t
Log:
exceptions-3: cleanup and more tests
Revision Changes Path
1.15 +46 -12 parrot/exceptions.c
Index: exceptions.c
===================================================================
RCS file: /cvs/public/parrot/exceptions.c,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -w -r1.14 -r1.15
--- exceptions.c 10 Jul 2003 12:42:23 -0000 1.14
+++ exceptions.c 10 Jul 2003 14:07:01 -0000 1.15
@@ -1,7 +1,7 @@
/* exceptions.c
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: exceptions.c,v 1.14 2003/07/10 12:42:23 leo Exp $
+ * $Id: exceptions.c,v 1.15 2003/07/10 14:07:01 leo Exp $
* Overview:
* define the internal interpreter exceptions
* Data Structure and Algorithms:
@@ -92,6 +92,44 @@
STACK_ENTRY_PMC, STACK_CLEANUP_NULL);
}
+static PMC *
+find_exception_handler(Parrot_Interp interpreter, PMC *exception)
+{
+ PMC *handler;
+ Stack_entry_type type;
+ STRING *message, *s;
+ PMC *key;
+ char *m;
+ /* for now, we don't check the exception class and we don't
+ * look for matching handlers
+ */
+ s = string_make(interpreter, "_message", 8, NULL,0,NULL);
+ key = key_new_string(interpreter, s);
+ message = VTABLE_get_string_keyed(interpreter, exception, key);
+ do {
+ handler =
+ stack_peek(interpreter, interpreter->ctx.control_stack, &type);
+ if (!handler)
+ break;
+ (void)stack_pop(interpreter, &interpreter->ctx.control_stack, &handler,
+ STACK_ENTRY_PMC);
+ if (type == STACK_ENTRY_PMC &&
+ handler->vtable->base_type == enum_class_Exception_Handler)
+ return handler;
+ } while (1);
+ m = string_to_cstring(interpreter, message);
+ if (m && *m) {
+ fprintf(stderr, m);
+ if (m[strlen(m-1)] != '\n')
+ fprintf(stderr, "%c", '\n');
+ }
+ else
+ fprintf(stderr, "No exception handler and no message\n");
+ Parrot_exit(1);
+
+ return NULL;
+}
+
void
pop_exception(Parrot_Interp interpreter)
{
@@ -109,29 +147,25 @@
void *
throw_exception(Parrot_Interp interpreter, PMC *exception, void *dest)
{
- Stack_entry_type type;
PMC *handler;
struct Parrot_Sub * cc;
PMC* key;
STRING *s;
Parrot_block_DOD(interpreter);
- handler = stack_peek(interpreter, interpreter->ctx.control_stack, &type);
- if (type != STACK_ENTRY_PMC ||
- handler->vtable->base_type != enum_class_Exception_Handler)
- PANIC("Tried to clear_eh a non Exception_Handler");
- (void)stack_pop(interpreter, &interpreter->ctx.control_stack, &handler,
- STACK_ENTRY_PMC);
+ handler = find_exception_handler(interpreter, exception);
cc = (struct Parrot_Sub*)PMC_data(handler);
/* preserve P5 register */
s = string_make(interpreter, "_P5", 3, NULL,0,NULL);
key = key_new_string(interpreter, s);
VTABLE_set_pmc_keyed(interpreter, exception, key, REG_PMC(5));
/* generate and place return continuation */
+ if (dest) {
s = string_make(interpreter, "_invoke_cc", 10, NULL,0,NULL);
key = key_new_string(interpreter, s);
VTABLE_set_pmc_keyed(interpreter, exception, key,
new_continuation_pmc(interpreter, dest));
+ }
/* TODO update the whole context */
cc->ctx.pad_stack = interpreter->ctx.pad_stack;
stack_mark_cow(cc->ctx.pad_stack);
1.32 +19 -1 parrot/t/pmc/perlhash.t
Index: perlhash.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/perlhash.t,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -w -r1.31 -r1.32
--- perlhash.t 7 Jul 2003 13:01:17 -0000 1.31
+++ perlhash.t 10 Jul 2003 14:07:03 -0000 1.32
@@ -1,6 +1,6 @@
#! perl
-use Parrot::Test tests => 27;
+use Parrot::Test tests => 28;
use Test::More;
output_is(<<CODE, <<OUTPUT, "Initial PerlHash tests");
@@ -832,6 +832,24 @@
CODE
Food
Sheep
+OUTPUT
+
+output_is(<<'CODE', <<OUTPUT, "Cloning PMC vals");
+ new P10, .PerlHash
+ new P1, .PerlUndef
+ set P1, "value\n"
+ set P10["str"], P1
+ new P1, .PerlUndef
+ set P1, 42
+ set P10["int"], P1
+ clone P2, P10
+ set P0, P2["int"]
+ print P0
+ set P0, P2["str"]
+ print P0
+ end
+CODE
+42value
OUTPUT
output_is(<<'CODE', <<OUTPUT, "entry types - type_keyed");
1.19 +121 -1 parrot/t/pmc/sub.t
Index: sub.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/sub.t,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -w -r1.18 -r1.19
--- sub.t 10 Jul 2003 12:42:28 -0000 1.18
+++ sub.t 10 Jul 2003 14:07:03 -0000 1.19
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 46;
+use Parrot::Test tests => 51;
use Test::More;
output_is(<<'CODE', <<'OUTPUT', "PASM subs - newsub");
@@ -630,6 +630,126 @@
42
back again
43
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "throw - no handler");
+ new P0, .Exception
+ set P0["_message"], "something happend"
+ throw P0
+ print "not reached\n"
+ end
+CODE
+something happend
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "throw - no handler, no message");
+ new P0, .Exception
+ throw P0
+ print "not reached\n"
+ end
+CODE
+No exception handler and no message
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "2 exception handlers");
+ 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 "not reached\n"
+ end
+_handler1:
+ print "catched it in 1\n"
+ set S0, P5["_message"]
+ print S0
+ print "\n"
+ end
+_handler2:
+ print "catched it in 2\n"
+ set S0, P5["_message"]
+ print S0
+ print "\n"
+ end
+CODE
+main
+catched it in 2
+something happend
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "2 exception handlers, throw next");
+ 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 "not reached\n"
+ end
+_handler1:
+ print "catched it in 1\n"
+ set S0, P5["_message"]
+ print S0
+ print "\n"
+ end
+_handler2:
+ print "catched it in 2\n"
+ set S0, P5["_message"]
+ print S0
+ print "\n"
+ throw P5 # XXX rethrow?
+ end
+CODE
+main
+catched it in 2
+something happend
+catched it in 1
+something happend
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "2 exception handlers, throw next - return");
+ 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"
+ throw P5
+ print "back in 2\n"
+ # XXX we cant return from here, the _return_cc in P5 is common
+ # to both exception handlers
+ end
+CODE
+main
+catched it in 2
+something happend
+catched it in 1
+something happend
+back in 2
OUTPUT
1;
