forked from Raku/roast
/
main-usage.t
247 lines (209 loc) · 5.72 KB
/
main-usage.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
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
use v6;
use lib 't/spec/packages';
use Test;
plan 30;
use Test::Util;
# Basic functionality
is_run 'sub MAIN($x) { }; sub USAGE() { print "USAGE() called" }',
{
out => 'USAGE() called',
},
'a user-defined USAGE sub is called if MAIN dispatch fails';
is_run 'sub MAIN() { print "MAIN() called" }; sub USAGE() { print "USAGE() called" }',
{
out => 'MAIN() called',
status => 0,
},
'a user-defined USAGE sub is not called if MAIN dispatch succeeds';
is_run 'sub MAIN( $a = nosuchsub()) { }; sub USAGE { say 42 }',
{
out => '',
err => /nosuchsub/,
},
'if the MAIN dispatch results in an error, that error should be printed, not USAGE';
is_run 'sub MAIN($foo) { }',
{
err => /<< foo >>/,
out => '',
},
'auto-generated USAGE message goes to $*ERR and contains parameter name';
is_run 'sub MAIN(\bar) { }',
{
err => /<< bar >>/,
},
'auto-generated USAGE should handle sigilles parameters';
is_run 'sub MAIN($bar) { }',
{
out => /<< bar >>/,
},
:args['--help'],
'--help option sends auto-generated USAGE message to $*OUT';
is_run 'sub MAIN(Bool :$x) { say "yes" if $x }',
{
out => "yes\n",
err => '',
status => 0,
},
:args['--x'],
'boolean option +';
is_run 'sub MAIN(Bool :$x) { print "yes" if $x }',
{
out => "",
},
:args['--/x'],
'boolean option -';
is_run 'sub MAIN(:$x) { print $x }',
{
out => "23",
},
:args['--x=23'],
'option with value';
is_run 'sub MAIN(:xen(:$xin)) { print $xin }',
{
out => "23",
},
:args['--xin=23'],
'named alias (inner name)';
is_run 'sub MAIN(:xen(:$xin)) { print $xin }',
{
out => "23",
},
:args['--xen=23'],
'named alias (outer name)';
# RT #71366
is_run 'sub MAIN($a, :$var) { say "a: $a, optional: $var"; }',
{
err => /\-\-var/,
out => '',
},
:args['param', '--var'],
'Non Bool option last with no value';
is_run 'sub MAIN($a, Bool :$var) { say "a: $a, optional: $var"; }',
{
out => "a: param, optional: True\n",
},
:args['--var', 'param'],
'Bool option followed by positional value';
# Spacey options may be removed from core spec; for now, moving to end of tests
# (discussion starts at http://irclog.perlgeek.de/perl6/2011-10-17#i_4578353 )
#?rakudo todo 'nom regression RT #124664'
#?niecza todo 'copied nom regression'
is_run 'sub MAIN(:$x) { print $x }',
{
out => "23",
},
:args['--x', '23'],
'option with spacey value';
#?rakudo todo 'nom regression RT #124665'
#?niecza todo 'copied nom regression'
is_run 'sub MAIN(:xen(:$x)) { print $x }',
{
out => "23",
},
:args['--xen', '23'],
'long option with spacey value';
#?rakudo todo 'nom regression RT #124666'
#?niecza todo 'copied nom regression'
is_run 'sub MAIN(:xen(:$xin)) { print $xin }',
{
out => "23",
},
:args['--xin', '23'],
'named alias (inner name) with spacey value';
#?rakudo todo 'nom regression RT #124667'
#?niecza todo 'copied nom regression'
is_run 'sub MAIN(:xen(:$xin)) { print $xin }',
{
out => "23",
},
:args['--xen', '23'],
'named alias (outer name) with spacey value';
#?rakudo todo 'nom regression RT #124668'
#?niecza todo 'copied nom regression'
is_run 'sub MAIN(:xen(:$x)) { print $x }',
{
out => "23",
},
:args['-x', '23'],
'short option with spacey value';
is_run 'subset Command of Str where "run";
multi MAIN(Command $c) { print 1 },
multi MAIN() { print 2 }',
{ out => "2" };
# RT #92986
is_run 'multi MAIN($) { print q[Any] }; multi MAIN(Str) { print q[Str] }',
{
out => 'Str',
},
:args['foo'],
'best multi matches (not just first one)';
is_run 'sub MAIN() { print 42 }',
{
out => '',
err => rx:i/usage/,
},
:args['--foo'],
'superfluous options trigger usage message';
# RT #115744
#?niecza todo
is_run 'sub MAIN($arg) { print $arg }',
{
out => "--23"
},
:args['--', '--23'],
'Stopping option processing';
#?niecza todo
is_run 'sub MAIN($arg, Bool :$bool) { print $bool, $arg }',
{
out => 'True-option'
},
:args['--bool', '--', '-option'],
'Boolean argument with --';
#?rakudo todo 'NYI RT #124669'
#?niecza todo
is_run 'sub MAIN(:@foo) { print @foo }',
{
out => "bar"
},
:args['--foo=bar'],
'single occurence for named array param';
#?niecza todo
is_run 'sub MAIN(:@foo) { print @foo }',
{
out => "bar baz"
},
:args['--foo=bar', '--foo=baz'],
'multiple occurence for named array param';
#?niecza todo
is_run 'multi MAIN(:$foo) { print "Scalar" }; multi MAIN(:@foo) { print "Array" }',
{
out => "Scalar"
},
:args['--foo=bar'],
'correctly select Scalar candidate from Scalar and Array candidates.';
#?rakudo todo 'NYI RT #124670'
#?niecza todo
is_run 'multi MAIN(:$foo) { print "Scalar" }; multi MAIN(:@foo) { print "Array" }',
{
out => "Array"
},
:args['--foo=bar', '--foo=baz'],
'correct select Array candidate from Scalar and Array candidates.';
# RT #119001
is_run 'sub MAIN (Str $value) { print "String $value" }',
{
out => 'String 10',
err => '',
},
:args[10],
'passing an integer matches MAIN(Str)';
# RT #127977
is_run 'sub MAIN(*@arg where { False }) { }; sub USAGE { print "USAGE called" }',
{
out => 'USAGE called',
err => '',
},
"failed constraint check doesn't leak internal exception out to the user";
# RT #127621
is_run 'sub MAIN($, *%) { }', { err => '', }, :args['--help'],
'use of anon slurpy hash does not cause a crash';