-
Notifications
You must be signed in to change notification settings - Fork 138
/
cc_state.t
148 lines (118 loc) · 3.67 KB
/
cc_state.t
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
#! perl
# Copyright (C) 2006-2009, Parrot Foundation.
use strict;
use warnings;
use lib qw/. lib/;
use Parrot::Test tests => 15;
use Test::More;
## test description key
# A args/params R results/returns
# C: src D: dest
# I IREG S SREG P PREG N NREG
# m normal f flat
# u unnamed n named r required o optional
# m normal s slurpy E end
## the section titles below refer to the row/column designation in the state table
## A1
pcc_ok( { args => "'abc'", params => ".param pmc abc" }, 'A C:Sum D:Pur' );
## A2
pcc_ok( { args => "'abc'", params => ".param pmc abc :slurpy" }, 'A C:Pum D:Purs' );
pcc_ok( { args => "'abc', 'def'", params => ".param pmc abc :slurpy" }, 'A C:Pum D:Purs' );
pcc_ok( { args => "'123'", params => ".param pmc abc" }, 'A C:Pum D:Pur' );
## A3
pcc_ok( { args => "", params => "" } );
## A5
pcc_like(
{ args => "123", params => ".param pmc x :named('x')" },
'/positional arg found, named arg expected/',
'positional found, named expected',
todo => 'cc processor state missing',
);
## E -- not yet working
#pcc_like({args=>"x=>['123';'456'] :flat", params=>".param pmc x"},
# '/named arg found, positional param expected/',
# 'E1: named found, required param expected',
#);
#pcc_like({args=>"x=>['123';'456'] :flat", params=>".param pmc x"},
# '/named arg found, required param expected/',
# 'E2: named found, required slurpy param expected',
#);
## G
pcc_error_like(
{ params => ".param pmc abc" },
'/too few positional arguments: 0 passed, 1 \(or more\) expected/',
'G1: argument underflow: required param',
);
pcc_like(
{ params => ".param pmc abc :slurpy" },
'/argument underflow: required slurpy param expected/',
'G2: argument underflow: required slurpy param',
todo => 'failing',
);
pcc_ok( { params => ".param pmc abc :optional" }, 'G3: optional param may be empty', );
pcc_ok( { params => ".param pmc abc :optional :slurpy" },
'G4: optional slurpy param may be empty' );
pcc_error_like(
{ params => ".param pmc abc :named('x')" },
'/too few named arguments: no argument for required parameter \'x\'/',
'G5: argument underflow: named required param',
);
pcc_error_like(
{ params => ".param pmc abc :named('x') :slurpy" },
'/too few named arguments: no argument for required parameter \'x\'/',
'G6: argument underflow: named required slurpy param',
);
pcc_ok(
{ params => ".param pmc abc :named('x') :optional" },
'G7: named optional param may be empty',
);
pcc_ok(
{ params => ".param pmc abc :named('x') :optional :slurpy" },
'G8: named optional slurpy param may be empty',
);
pcc_ok( {}, 'G9: no args, no params' );
exit;
sub pcc_ok {
my ( $o, $desc, %todo ) = @_;
my $test = create(%$o);
pir_output_is( $test, "ok\n", $desc, %todo )
or !exists $todo{todo} && diag $test;
}
sub pcc_like {
my ( $o, $exp, $desc, %todo ) = @_;
my $test = create(%$o);
pir_output_like( $test, $exp, $desc, %todo )
or !exists $todo{todo} && diag $test;
}
sub pcc_error_like {
my ( $o, $exp, $desc, %todo ) = @_;
my $test = create(%$o);
pir_error_output_like( $test, $exp, $desc, %todo )
or !exists $todo{todo} && diag $test;
}
sub create {
my %o = @_;
$o{$_} ||= '' for ( qw/args params returns results/ ) ;
$o{returns} =
defined $o{returns}
? "($o{returns}) = "
: '';
my $t = <<"TEST";
.sub 'main' :main
$o{returns} 'foo'($o{args})
say 'ok'
.end
.sub 'foo'
$o{params}
$o{results}
.end
TEST
# diag($t);
return $t;
}
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4: