Front page | perl.cvs.parrot |
Postings from January 2009
[svn:parrot] r35440 - in trunk: src/pmc t/op
From:
jonathan
Date:
January 12, 2009 07:01
Subject:
[svn:parrot] r35440 - in trunk: src/pmc t/op
Message ID:
20090112150117.0963FCB9F9@x12.develooper.com
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