Author: particle
Date: Tue Mar 27 18:23:31 2007
New Revision: 17801
Modified:
trunk/src/pmc/exporter.pmc
trunk/t/pmc/exporter.t
Log:
[pmc] finish Exporter's 'source' and 'destination' methods
Modified: trunk/src/pmc/exporter.pmc
==============================================================================
--- trunk/src/pmc/exporter.pmc (original)
+++ trunk/src/pmc/exporter.pmc Tue Mar 27 18:23:31 2007
@@ -71,15 +71,21 @@
PCCMETHOD void source(PMC *src :optional, int got_src :opt_flag) {
Parrot_Exporter *exp = PARROT_EXPORTER(SELF);
- PMC *ret_ns_src;
/* TODO deal with non-namespace pmcs */
if (got_src) {
- exp->ns_src = VTABLE_clone(interp, src);
+ if (src->vtable->base_type != enum_class_NameSpace) {
+ real_exception(interp, NULL, 0,
+ "source must be a NameSpace PMC");
+ return;
+ }
+
+ exp->ns_src = src;
}
else {
- ret_ns_src = VTABLE_clone(interp, exp->ns_src);
- PCCRETURN(PMC *ret_ns_src);
+ PMC *tmp_ns_src;
+ tmp_ns_src = exp->ns_src;
+ PCCRETURN(PMC *tmp_ns_src);
}
}
@@ -97,15 +103,20 @@
PCCMETHOD void destination(PMC *dest :optional, int got_dest :opt_flag) {
Parrot_Exporter *exp = PARROT_EXPORTER(SELF);
- PMC *ret_ns_dest;
/* TODO deal with non-namespace pmcs */
if (got_dest) {
- exp->ns_dest = VTABLE_clone(interp, dest);
+ if (dest->vtable->base_type != enum_class_NameSpace) {
+ real_exception(interp, NULL, 0,
+ "destination must be a NameSpace PMC");
+ return;
+ }
+ exp->ns_dest = dest;
}
else {
- ret_ns_dest = VTABLE_clone(interp, exp->ns_dest);
- PCCRETURN(PMC *ret_ns_dest);
+ PMC *tmp_ns_dest;
+ tmp_ns_dest = exp->ns_dest;
+ PCCRETURN(PMC *tmp_ns_dest);
}
}
@@ -146,10 +157,12 @@
*/
- PCCMETHOD void add_global(PMC *global) {
+ PCCMETHOD void add_global(PMC *global :optional, int has_global :opt_flag)
{
Parrot_Exporter *exp = PARROT_EXPORTER(SELF);
- VTABLE_push_string(interp, exp->globals,
- VTABLE_get_string(interp, global));
+ if (has_global) {
+ VTABLE_push_string(interp, exp->globals,
+ VTABLE_get_string(interp, global));
+ }
}
Modified: trunk/t/pmc/exporter.t
==============================================================================
--- trunk/t/pmc/exporter.t (original)
+++ trunk/t/pmc/exporter.t Tue Mar 27 18:23:31 2007
@@ -41,7 +41,7 @@
OUT
-pir_output_is( <<'CODE', <<'OUT', 'source', todo => 'broken' );
+pir_output_is( <<'CODE', <<'OUT', 'source' );
.sub 'test' :main
new $P0, .Exporter
$P1 = $P0.'source'()
@@ -72,16 +72,30 @@
ok_3:
say 'ok 3 - source() with too many args fails'
+ push_eh ok_4
+ $P0.'source'('foo')
+ clear_eh
+ print 'not '
+
+ ok_4:
+ say 'ok 4 - source() with non-namespace arg throws exception'
+.end
+
+
+# TODO replace with make_namespace, when implemented
+.namespace ['Eponymous']
+.sub 'Eponymous' :anon
.end
CODE
ok 1 - source() with no args returns source namespace, which is empty at first
ok 2 - source() with args sets source namespace
ok 3 - source() with too many args fails
+ok 4 - source() with non-namespace arg throws exception
OUT
# TODO test passing non-namespace pmc
-pir_output_is( <<'CODE', <<'OUT', 'destination', todo => 'broken' );
+pir_output_is( <<'CODE', <<'OUT', 'destination' );
.sub 'test' :main
new $P0, .Exporter
$P1 = $P0.'destination'()
@@ -112,6 +126,13 @@
ok_3:
say 'ok 3 - destination() with too many args fails'
+ push_eh ok_4
+ $P0.'destination'('foo')
+ clear_eh
+ print 'not '
+
+ ok_4:
+ say 'ok 4 - destination() with non-namespace arg throws exception'
.end
@@ -123,6 +144,7 @@
ok 1 - destination() with no args returns destination namespace, which is
empty at first
ok 2 - destination() with args sets destination namespace
ok 3 - destination() with too many args fails
+ok 4 - destination() with non-namespace arg throws exception
OUT
# TODO test passing non-namespace pmc
