← Back to branch summary

~ubuntu-branches/ubuntu/precise/rakudo/precise

« back to all changes in this revision

Viewing changes to t/pmc/perl6multisub-tiebreak.t

  • Committer: Bazaar Package Importer
  • Author(s): Ryan Niebur
  • Date: 2009-10-04 14:31:57 UTC
  • Revision ID: james.westby@ubuntu.com-20091004143157-ubq3wu0grk0f1e6a
Tags: upstream-0.1~2009.09
Import upstream version 0.1~2009.09

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/pmc/perl6multisub-tiebreak.t
 
1
#! ../../parrot
 
2
# Copyright (C) 2007-2008, The Perl Foundation.
 
3
# $Id$
 
4
 
 
5
=head1 NAME
 
6
 
 
7
t/pmc/perl6multisub-type.t - Type based dispatch tests
 
8
 
 
9
=head1 SYNOPSIS
 
10
 
 
11
    % prove t/pmc/perl6multisub-type.t
 
12
 
 
13
=head1 DESCRIPTION
 
14
 
 
15
Tests for type based dispatch using the Perl 6 MultiSub PMC.
 
16
 
 
17
=cut
 
18
 
 
19
.loadlib 'perl6_group'
 
20
 
 
21
.sub main :main
 
22
    .include 'include/test_more.pir'
 
23
    load_bytecode "perl6.pbc"
 
24
 
 
25
    plan(2)
 
26
 
 
27
    'constraint_tiebreak'()
 
28
.end
 
29
 
 
30
 
 
31
.sub 'constraint_tiebreak'
 
32
    $P0 = new "Perl6MultiSub"
 
33
    $P1 = get_global 'constraint_tiebreak_1'
 
34
    $P2 = null
 
35
    'attach_sig'($P1, $P2)
 
36
    push $P0, $P1
 
37
    $P1 = get_global 'constraint_tiebreak_2'
 
38
    $P2 = get_global 'constraint_tiebreak_2_con'
 
39
    'attach_sig'($P1, $P2)
 
40
    push $P0, $P1
 
41
 
 
42
    $P1 = new 'Int'
 
43
    $P1 = 42
 
44
    $I0 = $P0($P1)
 
45
    is($I0, 2, 'constraint tie-breaks')
 
46
    $P1 = 13
 
47
    $I0 = $P0($P1)
 
48
    is($I0, 1, 'constraint tie-breaks')
 
49
.end
 
50
.sub 'constraint_tiebreak_1'
 
51
    .param pmc a
 
52
    .return (1)
 
53
.end
 
54
.sub 'constraint_tiebreak_2'
 
55
    .param pmc a
 
56
    .return (2)
 
57
.end
 
58
.sub 'constraint_tiebreak_2_con'
 
59
    .param int i
 
60
    $I0 = i == 42
 
61
    .return ($I0)
 
62
.end
 
63
 
 
64
.sub 'attach_sig'
 
65
    .param pmc sub
 
66
    .param pmc constraints :slurpy
 
67
    
 
68
    # Make signature.
 
69
    .local pmc any, true
 
70
    any = get_hll_global 'Any'
 
71
    true = new 'Integer'
 
72
    true = 1
 
73
    $P0 = new 'Signature'
 
74
    $P1 = new 'Perl6Array'
 
75
    setattribute $P0, "@!params", $P1
 
76
    .local pmc it, con
 
77
    it = iter constraints
 
78
  param_loop:
 
79
    unless it goto param_loop_end
 
80
    con = shift it
 
81
    $P2 = new 'Perl6Hash'
 
82
    $P2["nom_type"] = any
 
83
    $P2["cons_type"] = con
 
84
    $P2["multi_invocant"] = true
 
85
    push $P1, $P2
 
86
    goto param_loop
 
87
  param_loop_end:
 
88
 
 
89
    setprop sub, '$!signature', $P0
 
90
.end
 
91
 
 
92
# Local Variables:
 
93
#   mode: pir
 
94
#   fill-column: 100
 
95
# End:
 
96
# vim: expandtab shiftwidth=4 ft=pir: