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

[bacek at svn.parrot.org]

Author: bacek
Date: Fri Dec 18 22:16:52 2009
New Revision: 43148
URL: https://trac.parrot.org/parrot/changeset/43148

Log:
Add attributes based introspection interface to Context

Modified:
   trunk/src/pmc/context.pmc
   trunk/t/pmc/context.t

Modified: trunk/src/pmc/context.pmc
==============================================================================
--- trunk/src/pmc/context.pmc	Fri Dec 18 22:02:30 2009	(r43147)
+++ trunk/src/pmc/context.pmc	Fri Dec 18 22:16:52 2009	(r43148)
@@ -153,6 +153,8 @@
     current_cont        ... return current Continuation
     current_object      ... return current Object (if in method call)
     current_namespace   ... return current Namespace
+
+Deprecated. Use attribute accessors.
 =cut
 
 */
@@ -192,6 +194,38 @@
         return STATICSELF.get_pmc_keyed_str(VTABLE_get_string(INTERP, key));
     }
 
+    VTABLE PMC *get_attr_str(STRING *key) {
+        Parrot_Context_attributes *ctx = PARROT_CONTEXT(SELF);
+
+        if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "caller_ctx")))
+            return ctx->caller_ctx;
+        else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "lex_pad")))
+            return ctx->lex_pad;
+        else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "outer_ctx")))
+            return ctx->outer_ctx;
+        else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "current_sub")))
+            return ctx->current_sub;
+        else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "current_cont")))
+            return ctx->current_cont;
+        else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "current_object")))
+            return ctx->current_object;
+        else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "current_namespace")))
+            return ctx->current_namespace;
+        else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "handlers")))
+            return ctx->handlers;
+        else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "results_signature")))
+            return ctx->results_signature;
+        else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "current_HLL")))
+            /* This function from src/hash.c. */
+            /* We probably have to move it to more suitable place */
+            return get_integer_pmc(INTERP, ctx->current_HLL);
+        else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "current_hll")))
+            return get_string_pmc(INTERP, Parrot_get_HLL_name(INTERP, ctx->current_HLL));
+
+        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ATTRIB_NOT_FOUND,
+                "No such item %Ss", key);
+    }
+
 /*
 
 =item C<PMC *backtrace>

Modified: trunk/t/pmc/context.t
==============================================================================
--- trunk/t/pmc/context.t	Fri Dec 18 22:02:30 2009	(r43147)
+++ trunk/t/pmc/context.t	Fri Dec 18 22:16:52 2009	(r43148)
@@ -58,71 +58,71 @@
 
     $P0 = getinterp
     ctx = $P0['context']
-    $I0 = defined ctx 
+    $I0 = defined ctx
     ok($I0, "Got Context")
 
     # Check current_sub first. Other tests relying on it
-    $P0 = ctx['current_sub']
+    $P0 = getattribute ctx, 'current_sub'
     is($P0, 'test_inspect', 'Got Context.current_sub')
 
-    $P0 = ctx['caller_ctx']
+    $P0 = getattribute ctx, 'caller_ctx'
     $I0 = isa $P0, 'Context'
     ok($I0, 'Got Context.caller_ctx')
-    $P0 = $P0['current_sub']
+    $P0 = getattribute $P0, 'current_sub'
     is($P0, 'main', '... from proper Sub')
 
-    $P0 = ctx['outer_ctx']
+    $P0 = getattribute ctx, 'outer_ctx'
     $I0 = isa $P0, 'Context'
     ok($I0, 'Got Context.outer_ctx')
-    $P0 = $P0['current_sub']
+    $P0 = getattribute $P0, 'current_sub'
     is($P0, 'load', '... from proper Sub')
 
-    $P0 = ctx['lex_pad']
+    $P0 = getattribute ctx, 'lex_pad'
     $I0 = isa $P0, 'LexPad'
     ok($I0, 'Got Context.lex_pad')
     $P1 = $P0['foo_ctx']
     $I0 = defined $P1
     ok($I0, '... with proper content')
 
-    $P0 = ctx['current_cont']
+    $P0 = getattribute ctx, 'current_cont'
     $I0 = isa $P0, 'Continuation'
     ok($I0, 'Got Context.current_cont')
 
-    $P0 = ctx['current_object']
+    $P0 = getattribute ctx, 'current_object'
     $I0 = isa $P0, 'Foo'
     ok($I0, 'Got Context.current_object')
 
-    $P0 = ctx['current_namespace']
+    $P0 = getattribute ctx, 'current_namespace'
     ok($P0, 'Got Context.current_namespace')
     $P1 = $P0['test_inspect']
     is($P1, 'test_inspect', '... with proper content')
 
     # Checking handlers
     push_eh done
-    $P0 = ctx['handlers']
+    $P0 = getattribute ctx, 'handlers'
     $I0 = elements $P0
 
     push_eh cought
     # Now we should have one more handler
-    $P0 = ctx['handlers']
+    $P0 = getattribute ctx, 'handlers'
     $I1 = elements $P0
     dec $I1
     is($I0, $I1, 'Got Context.handlers')
 
     # Check absurd fields
     $I0 = 1
-    $P0 = ctx['world_domination']
+    $P0 = getattribute ctx, 'world_domination'
     $I0 = 0
   cought:
     pop_eh
     ok($I0, "No world domination in this Context")
 
     # Current HLL shouldn't be zero
-    $P0 = ctx['current_HLL']
+    $P0 = getattribute ctx, 'current_HLL'
     $I0 = $P0
     ok($I0, 'Got Context.current_HLL')
-    
-    $P0 = ctx['current_hll']
+
+    $P0 = getattribute ctx, 'current_hll'
     ok($P0, 'FOO', 'Got Context.current_hll')
 
   done: