Author: jonathan
Date: Thu Aug 14 04:30:13 2008
New Revision: 30222
Modified:
trunk/languages/perl6/src/pmc/perl6multisub.pmc
trunk/languages/perl6/t/pmc/perl6multisub-dispatch-arity.t
Log:
[rakudo] Make dispatch with slurpies work. Add tests for arity based multi
dispatch with optional and slurpies.
Modified: trunk/languages/perl6/src/pmc/perl6multisub.pmc
==============================================================================
--- trunk/languages/perl6/src/pmc/perl6multisub.pmc (original)
+++ trunk/languages/perl6/src/pmc/perl6multisub.pmc Thu Aug 14 04:30:13 2008
@@ -226,11 +226,17 @@
candidate_info *info = mem_allocate_zeroed_typed(candidate_info);
PMC *candidate = VTABLE_get_pmc_keyed_int(interp, candidates, i);
info->sub = candidate;
+
+ /* Arity. */
info->min_arity = VTABLE_get_integer(interp,
VTABLE_inspect_str(interp, candidate, CONST_STRING(interp,
"pos_required")));
- info->max_arity = info->min_arity + VTABLE_get_integer(interp,
- VTABLE_inspect_str(interp, candidate, CONST_STRING(interp,
"pos_optional")));
-/* XXX handle slurpy */
+ if (VTABLE_get_integer(interp, VTABLE_inspect_str(interp, candidate,
+ CONST_STRING(interp, "pos_slurpy"))))
+ info->max_arity = 1 << 30;
+ else
+ info->max_arity = info->min_arity + VTABLE_get_integer(interp,
+ VTABLE_inspect_str(interp, candidate, CONST_STRING(interp,
"pos_optional")));
+
/* Add it to graph node. */
graph[i] = mem_allocate_typed(candidate_graph_node);
graph[i]->info = info;
Modified: trunk/languages/perl6/t/pmc/perl6multisub-dispatch-arity.t
==============================================================================
--- trunk/languages/perl6/t/pmc/perl6multisub-dispatch-arity.t (original)
+++ trunk/languages/perl6/t/pmc/perl6multisub-dispatch-arity.t Thu Aug 14
04:30:13 2008
@@ -22,9 +22,12 @@
.include 'include/test_more.pir'
load_bytecode "perl6.pbc"
- plan(4)
+ plan(13)
'simple'()
+ 'with_optional'()
+ 'with_slurpy'()
+ 'another_with_slurpy'()
.end
@@ -66,6 +69,72 @@
.end
+.sub 'with_optional'
+ $P0 = new "Perl6MultiSub"
+ $P1 = find_global 'with_optional_1'
+ push $P0, $P1
+ $P1 = find_global 'with_optional_2'
+ push $P0, $P1
+
+ $I0 = $P0()
+ is($I0, 0, 'call with 0 args')
+ $I0 = $P0(1)
+ is($I0, 1, 'with 1 arg - optional not supplied')
+ $I0 = $P0(1, 2)
+ is($I0, 1, 'with 2 args - optional supplied')
+.end
+.sub 'with_optional_1'
+ .return (0)
+.end
+.sub 'with_optional_2'
+ .param int i
+ .param int j :optional
+ .return (1)
+.end
+
+
+.sub 'with_slurpy'
+ $P0 = new "Perl6MultiSub"
+ $P1 = find_global 'with_slurpy_1'
+ push $P0, $P1
+
+ $I0 = $P0()
+ is($I0, 42, 'call with 0 args to slurpy')
+ $I0 = $P0(1)
+ is($I0, 42, 'with 1 arg to slurpy')
+ $I0 = $P0(1, 2)
+ is($I0, 42, 'with 2 args to slurpy')
+.end
+.sub 'with_slurpy_1'
+ .param pmc params :slurpy
+ .return (42)
+.end
+
+
+.sub 'another_with_slurpy'
+ $P0 = new "Perl6MultiSub"
+ $P1 = find_global 'another_with_slurpy_1'
+ push $P0, $P1
+ $P1 = find_global 'another_with_slurpy_2'
+ push $P0, $P1
+
+ $I0 = $P0()
+ is($I0, 0, 'call with 0 args - not to slurpy')
+ $I0 = $P0(1)
+ is($I0, 1, 'with 1 arg, giving empty slurpy')
+ $I0 = $P0(1, 2, 3)
+ is($I0, 1, 'with 3 args, giving slurpy values')
+.end
+.sub 'another_with_slurpy_1'
+ .return (0)
+.end
+.sub 'another_with_slurpy_2'
+ .param int x
+ .param pmc xs :slurpy
+ .return (1)
+.end
+
+
# Local Variables:
# mode: pir
# fill-column: 100
