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

Author: jonathan
Date: Mon Jan 12 07:01:16 2009
New Revision: 35440

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

Log:
[core] Add support for getting annotations of callers/outers to ParrotInterpreter PMC, plus tests.

Modified: trunk/src/pmc/parrotinterpreter.pmc
==============================================================================
--- trunk/src/pmc/parrotinterpreter.pmc	(original)
+++ trunk/src/pmc/parrotinterpreter.pmc	Mon Jan 12 07:01:16 2009
@@ -360,6 +360,7 @@
   "namespace"               ... return namespace PMC for this sub
   "outer"                   ... return outer sub of this closure
   "<item>"; level           ... same for caller <level>
+  "annotations"; level > 0  ... annotations at point of call <level>s down
   "outer"; "<item>"         ... same for outer level 1
   "outer"; "<item>"; level  ... same for outer <level>
   "globals"                 ... return global stash
@@ -452,6 +453,29 @@
         if (string_equal(interp, item, s) == 0)
             return VTABLE_clone(interp, ctx->current_cont);
 
+        s = CONST_STRING(interp, "annotations");
+
+        if (string_equal(interp, item, s) == 0) {
+            PMC *sub = ctx->current_sub;
+            if (ctx == CONTEXT(interp)) {
+                /* We can't know the current program counter for the currently
+                 * executing sub, so can't return annotations for that. */
+                if (ctx == CONTEXT(interp))
+                    Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+                            "Cannot get annotations at depth 0; use annotations op instead.");
+            }
+            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 = ctx->current_pc;
+                return PackFile_Annotations_lookup(interp,  seg->annotations,
+                        pc - seg->base.data, NULL);
+            }
+            else {
+                return pmc_new(interp, enum_class_Hash);
+            }
+        }
+
         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ATTRIB_NOT_FOUND,
                 "No such item %Ss", item);
     }

Modified: trunk/t/op/annotate.t
==============================================================================
--- trunk/t/op/annotate.t	(original)
+++ trunk/t/op/annotate.t	Mon Jan 12 07:01:16 2009
@@ -19,12 +19,13 @@
 .sub main :main
     .include 'include/test_more.pir'
 
-    plan(25)
+    plan(29)
 
     'no_annotations'()
     'annotations_exception'()
     'annotations_ops'()
     'backtrace_annotations'()
+    'parrotinterpreter_annotations'()
 .end
 
 
@@ -162,6 +163,36 @@
 .end
 
 
+.sub 'parrotinterpreter_annotations'
+    .annotate 'file', 'answer.p6'
+    .annotate 'line', 42
+    $P0 = new 'ParrotInterpreter'
+
+    .annotate 'line', 43
+    'test_callee'()
+.end
+
+.sub 'test_callee'
+    .annotate 'line', 100
+    $P0 = new 'ParrotInterpreter'
+    $P1 = $P0['annotations'; 1]
+    $S0 = $P1['file']
+    'is'($S0, 'answer.p6', 'annotations for caller sub returend with level 1')
+    $I0 = $P1['line']
+    'is'($I0, 43, 'annotations from caller sub returned at point of call with level 1')
+    'test_outer'()
+.end
+
+.sub 'test_outer' :outer('parrotinterpreter_annotations')
+    .annotate 'line', 101
+    $P0 = new 'ParrotInterpreter'
+    $P1 = $P0['outer'; 'annotations'; 1]
+    $S0 = $P1['file']
+    'is'($S0, 'answer.p6', 'annotations for outer sub returend with level 1')
+    $I0 = $P1['line']
+    'is'($I0, 43, 'annotations from outer sub returned at point of call with level 1')
+.end
+
 # Local Variables:
 #   mode: pir 
 #   fill-column: 100

• [svn:parrot] r35440 - in trunk: src/pmc t/op by jonathan