develooper Front page | perl.cvs.parrot | Postings from January 2009

[svn:parrot] r35129 - in trunk: src/pmc t/op

From:
jonathan
Date:
January 7, 2009 08:02
Subject:
[svn:parrot] r35129 - in trunk: src/pmc t/op
Message ID:
20090107160208.B54D0CB9F9@x12.develooper.com
Author: jonathan
Date: Wed Jan  7 08:02:08 2009
New Revision: 35129

Modified:
   trunk/src/pmc/exception.pmc
   trunk/t/op/annotate.t

Log:
[core] Implement backtrace method on Exception class, and add some tests for it.

Modified: trunk/src/pmc/exception.pmc
==============================================================================
--- trunk/src/pmc/exception.pmc	(original)
+++ trunk/src/pmc/exception.pmc	Wed Jan  7 08:02:08 2009
@@ -729,6 +729,64 @@
         RETURN(PMC *result);
     }
 
+
+/*
+
+=item C<PMC *backtrace>
+
+Gets a representation of the backtrace at the point that this exception was
+thrown. Returns an array of hashes. Each array element represents a caller in
+the backtrace, the most recent caller first. The hash has two keys: C<sub>,
+which holds the PMC representing the sub, and C<annotations> which is a hash
+of the annotations at the point where the exception was thrown for the current
+sub, or for the point of the call a level deeper for the rest.
+
+=cut
+
+*/
+
+    METHOD PMC *backtrace() {
+        PMC *result = pmc_new(interp, enum_class_ResizablePMCArray);
+        PMC *resume;
+
+        /* Get starting context, then loop over them. */
+        GET_ATTR_resume(interp, SELF, resume);
+        if (!PMC_IS_NULL(resume)) {
+            Parrot_cont *cont = PMC_cont(resume);
+            Parrot_Context *cur_ctx = cont->to_ctx;
+            while (cur_ctx) {
+                PMC *frame = pmc_new(interp, enum_class_Hash);
+                PMC *annotations;
+
+                /* Get sub and put it in the hash. */
+                PMC *sub = cur_ctx->current_sub;
+                if (sub == NULL)
+                    sub = PMCNULL;
+                VTABLE_set_pmc_keyed_str(interp, frame, CONST_STRING(interp, "sub"), sub);
+
+                /* Look up any annotations and put them in the hash. */
+                if (!PMC_IS_NULL(sub) && sub->vtable->base_type == enum_class_Sub &&
+                        PMC_sub(sub)->seg->annotations) {
+                    PackFile_ByteCode *seg = PMC_sub(sub)->seg;
+                    opcode_t *pc = cur_ctx == cont->to_ctx ? cont->address : cur_ctx->current_pc;
+                    annotations = PackFile_Annotations_lookup(interp,  seg->annotations,
+                        pc - seg->base.data, NULL);
+                }
+                else {
+                    annotations = pmc_new(interp, enum_class_Hash);
+                }
+                VTABLE_set_pmc_keyed_str(interp, frame, CONST_STRING(interp, "annotations"), annotations);
+
+                /* Push frame and go to next caller. */
+                VTABLE_push_pmc(interp, result, frame);
+                cur_ctx = cur_ctx->caller_ctx;
+            }
+        }
+
+        RETURN(PMC *result);
+    }
+
+
 /*
 
 =back

Modified: trunk/t/op/annotate.t
==============================================================================
--- trunk/t/op/annotate.t	(original)
+++ trunk/t/op/annotate.t	Wed Jan  7 08:02:08 2009
@@ -19,11 +19,12 @@
 .sub main :main
     .include 'include/test_more.pir'
 
-    plan(15)
+    plan(25)
 
     'no_annotations'()
     'annotations_exception'()
-    'annotations_ops'()
+    'annotations_ops'()
+    'backtrace_annotations'()
 .end
 
 
@@ -96,6 +97,70 @@
     is ($I1, 2, 'annotations_p op gave back correct hash')
 .end
 
+
+.sub 'backtrace_annotations'
+    push_eh failed
+    'foo'()
+
+  failed:
+    .local pmc exception, bt, frame, ann
+    .get_results (exception)
+    bt = exception.'backtrace'()
+    $I0 = elements bt
+    $I0 = $I0 > 3
+    ok ($I0, 'backtrace has enough elements')
+
+    frame = bt[0]
+    $S0 = frame["sub"]
+    is ($S0, 'baz', 'frame 0 has right sub name')
+    ann = frame["annotations"]
+    $S0 = ann["file"]
+    is ($S0, 'baz.pm', 'frame 0 has right file annotation')
+    $I0 = ann["line"]
+    is ($I0, 2, 'frame 0 has right line annotation')
+
+    frame = bt[1]
+    $S0 = frame["sub"]
+    is ($S0, 'bar', 'frame 1 has right sub name')
+    ann = frame["annotations"]
+    $S0 = ann["file"]
+    is ($S0, 'foo.p6', 'frame 1 has right file annotation')
+    $I0 = ann["line"]
+    is ($I0, 5, 'frame 1 has right line annotation')
+
+    frame = bt[2]
+    $S0 = frame["sub"]
+    is ($S0, 'foo', 'frame 2 has right sub name')
+    ann = frame["annotations"]
+    $S0 = ann["file"]
+    is ($S0, 'foo.p6', 'frame 2 has right file annotation')
+    $I0 = ann["line"]
+    is ($I0, 2, 'frame 2 has right line annotation')
+.end
+
+# Test subs for backtrace_annotations
+.sub 'foo'
+    .annotate 'file', 'foo.p6'
+    .annotate 'line', 1
+    noop
+    .annotate 'line', 2
+    'bar'()
+    .annotate 'line', 3
+.end
+.sub 'bar'
+    .annotate 'line', 4
+    noop
+    .annotate 'line', 5
+    'baz'()
+.end
+.sub 'baz'
+    .annotate 'file', 'baz.pm'
+    .annotate 'line', 1
+    noop
+   .annotate 'line', 2
+   die "LOL HALP I HAZ A FAIL"
+.end
+
 
 # Local Variables:
 #   mode: pir 



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About