cvsuser 04/06/22 07:31:47
Modified: classes parrotinterpreter.pmc sub.pmc
include/parrot interpreter.h
src inter_create.c
t/pmc exception.t
Log:
Pie-thon 1 - recursion limit
Revision Changes Path
1.31 +15 -1 parrot/classes/parrotinterpreter.pmc
Index: parrotinterpreter.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/parrotinterpreter.pmc,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -w -r1.30 -r1.31
--- parrotinterpreter.pmc 22 Jun 2004 10:57:09 -0000 1.30
+++ parrotinterpreter.pmc 22 Jun 2004 14:31:37 -0000 1.31
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: parrotinterpreter.pmc,v 1.30 2004/06/22 10:57:09 leo Exp $
+$Id: parrotinterpreter.pmc,v 1.31 2004/06/22 14:31:37 leo Exp $
=head1 NAME
@@ -241,6 +241,14 @@
(INTVAL) IGLOBALS_INTERPRETER, self);
}
+static int
+recursion_limit(Parrot_Interp interpreter, int l)
+{
+ int ret = interpreter->recursion_limit;
+ interpreter->recursion_limit = l;
+ return ret;
+}
+
pmclass ParrotInterpreter need_ext {
/*
@@ -285,6 +293,12 @@
F2DPTR(pt_thread_detach), "detach", "vi");
enter_nci_method(INTERP, typ,
F2DPTR(pt_thread_kill), "kill", "vi");
+
+ /*
+ * misc functions
+ */
+ enter_nci_method(INTERP, typ,
+ F2DPTR(recursion_limit), "recursion_limit", "iIi");
}
}
1.44 +5 -1 parrot/classes/sub.pmc
Index: sub.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/sub.pmc,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -w -r1.43 -r1.44
--- sub.pmc 25 Mar 2004 13:36:51 -0000 1.43
+++ sub.pmc 22 Jun 2004 14:31:37 -0000 1.44
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: sub.pmc,v 1.43 2004/03/25 13:36:51 leo Exp $
+$Id: sub.pmc,v 1.44 2004/06/22 14:31:37 leo Exp $
=head1 NAME
@@ -200,6 +200,10 @@
void* invoke (void* next) {
struct Parrot_Sub * sub = (struct Parrot_Sub *)PMC_sub(SELF);
interpreter->ctx.warns = sub->ctx.warns;
+ if (++interpreter->ctx.recursion_depth > interpreter->recursion_limit) {
+ real_exception(interpreter, next, 100,
+ "maximum recursion depth exceeded");
+ }
if (Interp_flags_TEST(interpreter, PARROT_TRACE_FLAG)) {
print_sub_name(interpreter, SELF);
}
1.139 +3 -1 parrot/include/parrot/interpreter.h
Index: interpreter.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/interpreter.h,v
retrieving revision 1.138
retrieving revision 1.139
diff -u -w -r1.138 -r1.139
--- interpreter.h 22 Jun 2004 10:57:16 -0000 1.138
+++ interpreter.h 22 Jun 2004 14:31:41 -0000 1.139
@@ -1,7 +1,7 @@
/* interpreter.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: interpreter.h,v 1.138 2004/06/22 10:57:16 leo Exp $
+ * $Id: interpreter.h,v 1.139 2004/06/22 14:31:41 leo Exp $
* Overview:
* The interpreter api handles running the operations
* Data Structure and Algorithms:
@@ -143,6 +143,7 @@
Buffer * errors; /* fatals that can be turned off */
UINTVAL current_class_offset; /* Offset into the class array of the
currently found method */
+ UINTVAL recursion_depth; /* Sub call resursion depth */
} parrot_context_t;
@@ -276,6 +277,7 @@
struct parrot_exception_t *exceptions; /* internal exception stack */
struct parrot_exception_t *exc_free_list; /* and free list */
struct _Thread_data *thread_data; /* thread specific items */
+ UINTVAL recursion_limit; /* Sub call resursion limit */
} Interp;
typedef enum {
1.3 +2 -1 parrot/src/inter_create.c
Index: inter_create.c
===================================================================
RCS file: /cvs/public/parrot/src/inter_create.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- inter_create.c 22 Jun 2004 10:57:23 -0000 1.2
+++ inter_create.c 22 Jun 2004 14:31:44 -0000 1.3
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: inter_create.c,v 1.2 2004/06/22 10:57:23 leo Exp $
+$Id: inter_create.c,v 1.3 2004/06/22 14:31:44 leo Exp $
=head1 NAME
@@ -116,6 +116,7 @@
SET_NULL(interpreter->lo_var_ptr);
}
interpreter->resume_flag = RESUME_INITIAL;
+ interpreter->recursion_limit = 1000;
interpreter->DOD_block_level = 1;
interpreter->GC_block_level = 1;
1.9 +71 -2 parrot/t/pmc/exception.t
Index: exception.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/exception.t,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -w -r1.8 -r1.9
--- exception.t 8 Mar 2004 00:20:09 -0000 1.8
+++ exception.t 22 Jun 2004 14:31:47 -0000 1.9
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: exception.t,v 1.8 2004/03/08 00:20:09 chromatic Exp $
+# $Id: exception.t,v 1.9 2004/06/22 14:31:47 leo Exp $
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-use Parrot::Test tests => 22;
+use Parrot::Test tests => 24;
use Test::More;
output_is(<<'CODE', <<'OUTPUT', "set_eh - clear_eh");
@@ -524,5 +524,74 @@
print "not reached\n"
end
CODE
+
+output_is(<<'CODE', <<'OUTPUT', "recursion limit RuntimeException");
+##PIR##
+.sub main @MAIN
+ .local int n
+ sweepoff # XXX DOD troubles
+ n = b11(0)
+ print "ok 1\n"
+ print n
+ print "\n"
+.end
+.sub b11
+ .param int n
+ .local int n1
+ n1 = n + 1
+ newsub $P0, .Exception_Handler, _catch
+ set_eh $P0
+ n = P0(n1)
+ clear_eh
+ .pcc_begin_return
+ .return n
+ .pcc_end_return
+.end
+.sub _catch
+ set P2, P5["_invoke_cc"]
+ invoke P2
+.end
+CODE
+ok 1
+1000
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "set recursion limit, method call ");
+##PIR##
+.sub main @MAIN
+ .local int n
+ sweepoff # XXX DOD troubles
+ $P0 = getinterp
+ $P0."recursion_limit"(100)
+ newclass $P0, "b"
+ $I0 = find_type "b"
+ $P0 = new $I0
+ n = $P0."b11"(0)
+ print "ok 1\n"
+ print n
+ print "\n"
+.end
+.namespace ["b"]
+.sub b11 method
+ .param int n
+ .local int n1
+ n1 = n + 1
+ newsub $P0, .Exception_Handler, _catch
+ set_eh $P0
+ n = self."b11"(n1)
+ clear_eh
+ .pcc_begin_return
+ .return n
+ .pcc_end_return
+.end
+.sub _catch
+ set P2, P5["_invoke_cc"]
+ invoke P2
+.end
+CODE
+ok 1
+100
+OUTPUT
+
1;
