Author: jonathan
Date: Fri Jun 8 07:33:25 2007
New Revision: 18878
Modified:
trunk/src/inter_misc.c
trunk/src/pmc/pmcproxy.pmc
trunk/t/pmc/pmcproxy.t
Log:
[PDD17] The non-vtable methods of PMCs can now we introspected using PMCProxy.
Added a test for this, and also a test for calling .new() on a PMCProxy, which
creates the correct PMC.
Modified: trunk/src/inter_misc.c
==============================================================================
--- trunk/src/inter_misc.c (original)
+++ trunk/src/inter_misc.c Fri Jun 8 07:33:25 2007
@@ -42,16 +42,25 @@
const char *name, const char *proto)
{
PMC * const method = pmc_new(interp, enum_class_NCI);
+ STRING * const method_name = string_make(interp, name, strlen(name),
+ NULL, PObj_constant_FLAG|PObj_external_FLAG);
+ PMC *proxy;
+
/* create call func */
VTABLE_set_pointer_keyed_str(interp, method,
string_make(interp, proto, strlen(proto), NULL,
PObj_constant_FLAG|PObj_external_FLAG),
func);
+
/* insert it into namespace */
VTABLE_set_pmc_keyed_str(interp, interp->vtables[type]->_namespace,
- string_make(interp, name, strlen(name), NULL,
- PObj_constant_FLAG|PObj_external_FLAG),
- method);
+ method_name, method);
+
+ /* Also need to list the method in the PMCProxy PMC's method list, so it
+ * can be introspected. */
+ proxy = VTABLE_get_pmc_keyed_int(interp, interp->pmc_proxies, type);
+ VTABLE_set_pmc_keyed_str(interp, PARROT_PMCPROXY(proxy)->methods,
+ method_name, method);
}
void
@@ -59,13 +68,22 @@
const char *name)
{
PMC * const method = pmc_new(interp, enum_class_NCI);
+ STRING * const method_name = string_make(interp, name, strlen(name),
+ NULL, PObj_constant_FLAG|PObj_external_FLAG);
+ PMC *proxy;
+
/* setup call func */
Parrot_NCI_nci_make_raw_nci(interp, method, func);
+
/* insert it into namespace */
VTABLE_set_pmc_keyed_str(interp, interp->vtables[type]->_namespace,
- string_make(interp, name, strlen(name), NULL,
- PObj_constant_FLAG|PObj_external_FLAG),
- method);
+ method_name, method);
+
+ /* Also need to list the method in the PMCProxy PMC's method list, so it
+ * can be introspected. */
+ proxy = VTABLE_get_pmc_keyed_int(interp, interp->pmc_proxies, type);
+ VTABLE_set_pmc_keyed_str(interp, PARROT_PMCPROXY(proxy)->methods,
+ method_name, method);
}
/*
Modified: trunk/src/pmc/pmcproxy.pmc
==============================================================================
--- trunk/src/pmc/pmcproxy.pmc (original)
+++ trunk/src/pmc/pmcproxy.pmc Fri Jun 8 07:33:25 2007
@@ -91,6 +91,7 @@
_pmc->_namespace = PMCNULL;
_pmc->parents = pmc_new(interp, enum_class_ResizablePMCArray);
_pmc->all_parents = pmc_new(interp, enum_class_ResizablePMCArray);
+ _pmc->methods = pmc_new(interp, enum_class_Hash);
/* We put ourself on the all parents list. */
VTABLE_push_pmc(interp, _pmc->all_parents, SELF);
Modified: trunk/t/pmc/pmcproxy.t
==============================================================================
--- trunk/t/pmc/pmcproxy.t (original)
+++ trunk/t/pmc/pmcproxy.t Fri Jun 8 07:33:25 2007
@@ -6,7 +6,7 @@
use warnings;
use lib qw( . lib ../lib ../../lib );
use Test::More;
-use Parrot::Test tests => 3;
+use Parrot::Test tests => 5;
=head1 NAME
@@ -90,6 +90,65 @@
ok 3 - got namespace
OUT
+pir_output_is( <<'CODE', <<'OUT', 'Proxy PMC allows introspection of methods'
);
+.sub 'test' :main
+push_eh nok_1
+ $P0 = get_class 'NameSpace'
+ clear_eh
+ goto ok_1
+nok_1:
+ print "not "
+ok_1:
+ print "ok 1 - get_class returned something\n"
+
+ $P1 = $P0.'methods'()
+ print "ok 2 - got methods\n"
+
+ $I0 = exists $P1['export_to']
+ if $I0 goto ok_3
+ print "not "
+ok_3:
+ print "ok 3 - export_to method in the list\n"
+
+ $I0 = exists $P1['get_name']
+ if $I0 goto ok_4
+ print "not "
+ok_4:
+ print "ok 4 - get_name method in the list\n"
+.end
+CODE
+ok 1 - get_class returned something
+ok 2 - got methods
+ok 3 - export_to method in the list
+ok 4 - get_name method in the list
+OUT
+
+pir_output_is( <<'CODE', <<'OUT', '.new() creates a PMC' );
+.sub 'test' :main
+push_eh nok_1
+ $P0 = get_class 'ResizablePMCArray'
+ clear_eh
+ goto ok_1
+nok_1:
+ print "not "
+ok_1:
+ print "ok 1 - get_class returned something\n"
+
+ $P1 = $P0.'new'()
+ print "ok 2 - created a PMC\n"
+
+ $I0 = isa $P1, 'ResizablePMCArray'
+ if $I0 goto ok_3
+ print "not "
+ok_3:
+ print "ok 3 - created the Right Thing\n"
+.end
+CODE
+ok 1 - get_class returned something
+ok 2 - created a PMC
+ok 3 - created the Right Thing
+OUT
+
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
