Skip to content
Newer
Older
100644 209 lines (169 sloc) 7.88 KB
aa2e9ad [spec] simple tests for named parameters
moritz authored Jul 7, 2008
1 use v6;
2 use Test;
3
ebb8b24 [t/spec] tests for mysub(:$named_arg)
moritz authored Jan 20, 2009
4 plan 69;
aa2e9ad [spec] simple tests for named parameters
moritz authored Jul 7, 2008
5
6 # L<S06/Required parameters/"Passing a named argument that cannot be bound to
7 # a normal subroutine is also a fatal error.">
8
9 {
10 # see http://rt.perl.org/rt3/Ticket/Display.html?id=54812
11 sub a($x = 4) {
12 return $x;
13 }
14 is a(3), 3, 'Can pass positional arguments';
15 #?rakudo todo 'Named args, RT #54812'
16 eval_dies_ok('a(g=>7)', 'Dies on passing superflous arguments');
17 }
a5cd2dd [spec] more tests for named parameters, and fudged them for rakudo
moritz authored Jul 7, 2008
18
19 {
20 # see http://rt.perl.org/rt3/Ticket/Display.html?id=54808
21 sub b($x) {
22 return $x;
23 }
24
25 #?rakudo skip 'Passing positional parameters as named ones'
26 is b(:x(3)), 3, 'Can pass positional parameters as named ones';
27
28 sub c(:$w=4){
29 return $w;
30 }
31 is c(w => 3), 3, 'Named argument passes an integer, not a Pair';
ebb8b24 [t/spec] tests for mysub(:$named_arg)
moritz authored Jan 20, 2009
32 my $x = 5;
33 #?rakudo 2 skip 'colonpair calling'
34 is c(:$x), 3, 'can use :$x colonpair syntax to call named arg';
35 eval_dies_ok 'my $y; c(:$y)', 'colonpair with wrong variable name dies';
a5cd2dd [spec] more tests for named parameters, and fudged them for rakudo
moritz authored Jul 7, 2008
36 }
c6a61f5 [gsoc_spectest] moved sub_named_params.t content to S06-signature/nam…
Auzon authored Aug 15, 2008
37
38 # L<S06/Named parameters>
39
40 sub simple_pos_param($x) { $x }
41 #?rakudo 2 skip 'x => 3 does not assign to $x in sub signature'
42 is simple_pos_param(x => 3), 3, "positional param may be addressed by name (1)";
43 is simple_pos_param(:x(3)), 3, "positional param may be addressed by name (2)";
44
45 # L<S06/Named parameters/marked by a prefix>
46 sub simple_pos_params (:$x) { $x }
47
48 is(simple_pos_params( x => 4 ), 4, "simple named param");
49
50
51 sub foo (:$x = 3) { $x }
52
53 is(foo(), 3, "not specifying named params that aren't mandatory works");
54 #?rakudo todo 'using named as positional should fail'
55 #?pugs todo 'bug'
56 dies_ok({foo(4)}, "using a named as a positional fails");
57
58 is(foo( x => 5), 5, "naming named param also works");
59 is(foo( :x<5> ), 5, "naming named param adverb-style also works");
60
61 sub foo2 (:$x = 3, :$y = 5) { $x + $y }
62
63 is(foo2(), 8, "not specifying named params that aren't mandatory works (foo2)");
64 #?pugs 2 todo 'bug'
65 #?rakudo 2 todo 'using named as positional should fail'
66 dies_ok({foo2(4)}, "using a named as a positional fails (foo2)");
67 dies_ok({foo2(4, 10)}, "using a named as a positional fails (foo2)");
68 is(foo2( x => 5), 10, "naming named param x also works (foo2)");
69 is(foo2( y => 3), 6, "naming named param y also works (foo2)");
70 is(foo2( x => 10, y => 10), 20, "naming named param x & y also works (foo2)");
71 is(foo2( :x(5) ), 10, "naming named param x adverb-style also works (foo2)");
72 is(foo2( :y(3) ), 6, "naming named param y adverb-style also works (foo2)");
73 is(foo2( :x(10), :y(10) ), 20, "naming named params x & y adverb-style also works (foo2)");
74 is(foo2( x => 10, :y(10) ), 20, "mixing fat-comma and adverb naming styles also works for named params (foo2)");
75 is(foo2( :x(10), y => 10 ), 20, "mixing adverb and fat-comma naming styles also works for named params (foo2)");
76
77 sub assign_based_on_named_positional ($x, :$y = $x) { $y }
78
79
80 is(assign_based_on_named_positional(5), 5, "When we don't explicitly specify, we get the original value");
81 is(assign_based_on_named_positional(5, y => 2), 2, "When we explicitly specify, we get our value");
82 is(assign_based_on_named_positional('y'=>2), ('y'=>2), "When we explicitly specify, we get our value");
83 my $var = "y";
84 is(assign_based_on_named_positional($var => 2), ("y"=>2),
85 "When we explicitly specify, we get our value");
86
87 # L<S06/Named arguments/multiple same-named arguments>
88 #?rakudo skip 'parsefail'
89 {
90 sub named_array(:@x) { +«@x }
91
92 is(eval('named_array(:x)'), (1), 'named array taking one named arg');
93 is(eval('named_array(:x, :!x)'), (1, 0), 'named array taking two named args');
94 is(eval('named_array(:x(1), :x(2), :x(3))'), (1, 2, 3), 'named array taking three named args');
95 }
96
97 # L<S06/Named arguments/Pairs intended as positional arguments>
98 #?rakudo skip 'parsefail'
99 {
100 sub named_array2(@x, :@y) { (+«@x, 42, +«@y) }
101 # +«(:x) is (0, 1)
102
103 is(eval('named_array2(:!x, :y)'), (0, 42, 1), 'named and unnamed args - two named');
104 is(eval('named_array2(:!x, y => 1)'), (0, 42, 1), 'named and unnamed args - two named - fatarrow');
105 is(eval('named_array2(:y, :!x)'), (0, 42, 1), 'named and unnamed args - two named - backwards');
106 is(eval('named_array2(:y, (:x))'), (0, 1, 42, 1), 'named and unnamed args - one named, one pair');
107 is(eval('named_array2(1, 2)'), (1, 42), 'named and unnamed args - two unnamed');
108 is(eval('named_array2(:!y, 1)'), (1, 42, 0), 'named and unnamed args - one named, one pos');
109 is(eval('named_array2(1, :!y)'), (1, 42, 0), 'named and unnamed args - one named, one pos - backwards');
110 is(eval('named_array2(:y, 1, :!y)'), (1, 42, 1, 0), 'named and unnamed args - two named, one pos');
de076fd [t/spec] removed some obsolete usages of 'is $stuff, undef'
moritz authored Sep 15, 2008
111 ok(eval('named_array2(:y, :y)') ~~ undef, 'named and unnamed args - two named with same name');
c6a61f5 [gsoc_spectest] moved sub_named_params.t content to S06-signature/nam…
Auzon authored Aug 15, 2008
112 is(eval('named_array2(:y, (:x))'), (0, 1, 42, 1), 'named and unnamed args - passing parenthesized pair');
113 is(eval('named_array2(:y, (:y))'), (0, 1, 42, 1), 'named and unnamed args - passing parenthesized pair of same name');
114 is(eval('named_array2(:y, :z)'), (0, 1, 42, 1), 'named and unnamed args - passing pair of unrelated name');
115 is(eval('named_array2(:y, "x" => 1)'), (0, 1, 42, 1), 'named and unnamed args - passing pair with quoted fatarrow');
116 }
117
118 # L<S06/Named parameters/They are marked by a prefix>
119 # L<S06/Required parameters/declared with a trailing>
120 sub mandatory (:$param!) {
121 return $param;
122 }
123
124 is(mandatory(param => 5) , 5, "named mandatory parameter is returned");
125 eval_dies_ok('mandatory()', "not specifying a mandatory parameter fails");
126
127 #?rakudo skip 'Cannot apply trait required to parameters yet'
128 {
129 sub mandatory_by_trait (:$param is required) {
130 return $param;
131 }
132
133 is(mandatory_by_trait(param => 5) , 5, "named mandatory parameter is returned");
134 dies_ok( { mandatory_by_trait() }, "not specifying a mandatory parameter fails");
135 }
136
137
138 # L<S06/Named parameters/sub formalize>
139 sub formalize($text, :$case, :$justify) returns List {
140 return($text,$case,$justify);
141 }
142
143 #?rakudo skip 'parsefail'
144 {
145 my ($text,$case,$justify) = formalize('title', case=>'upper');
146 is($text,'title', "text param was positional");
de076fd [t/spec] removed some obsolete usages of 'is $stuff, undef'
moritz authored Sep 15, 2008
147 ok($justify ~~ undef, "justification param was not given");
c6a61f5 [gsoc_spectest] moved sub_named_params.t content to S06-signature/nam…
Auzon authored Aug 15, 2008
148 is($case, 'upper', "case param was named, and in justification param's position");
149 }
150
151 #?rakudo skip 'parsefail'
152 {
153 my ($text,$case,$justify) = formalize('title', justify=>'left');
154 is($text,'title', "text param was positional");
155 is($justify, 'left', "justify param was named");
de076fd [t/spec] removed some obsolete usages of 'is $stuff, undef'
moritz authored Sep 15, 2008
156 ok($case ~~ undef, "case was not given at all");
c6a61f5 [gsoc_spectest] moved sub_named_params.t content to S06-signature/nam…
Auzon authored Aug 15, 2008
157 }
158
159 #?rakudo skip 'parsefail'
160 {
161 my ($text,$case,$justify) = formalize("title", :justify<right>, :case<title>);
162
163 is($text,'title', "title param was positional");
164 is($justify, 'right', "justify param was named with funny syntax");
165 is($case, 'title', "case param was named with funny syntax");
166 }
167
168 {
169 sub h($a,$b,$d) { $d ?? h($b,$a,$d-1) !! $a~$b }
170
171 is(h('a','b',1),'ba',"parameters don\'t bind incorrectly");
172 }
173
174 # Slurpy Hash Params
175 {
176 sub slurpee(*%args) { return %args }
177 my %fellowship = slurpee(hobbit => 'Frodo', wizard => 'Gandalf');
178 is(%fellowship<hobbit>, 'Frodo', "hobbit arg was slurped");
179 is(%fellowship<wizard>, 'Gandalf', "wizard arg was slurped");
180 is(+%fellowship, 2, "exactly 2 arguments were slurped");
de076fd [t/spec] removed some obsolete usages of 'is $stuff, undef'
moritz authored Sep 15, 2008
181 ok(%fellowship<dwarf> ~~ undef, "dwarf arg was not given");
c6a61f5 [gsoc_spectest] moved sub_named_params.t content to S06-signature/nam…
Auzon authored Aug 15, 2008
182 }
183
184 #?rakudo skip 'parsefail on lvalue'
185 {
186 sub named_and_slurp(:$grass, *%rest) { return($grass, %rest) }
187 my ($grass, %rest) = named_and_slurp(sky => 'blue', grass => 'green', fire => 'red');
188 is($grass, 'green', "explicit named arg received despite slurpy hash");
189 is(+%rest, 2, "exactly 2 arguments were slurped");
190 is(%rest<sky>, 'blue', "sky argument was slurped");
191 is(%rest<fire>, 'red', "fire argument was slurped");
de076fd [t/spec] removed some obsolete usages of 'is $stuff, undef'
moritz authored Sep 15, 2008
192 ok(%rest<grass> ~~ undef, "grass argument was NOT slurped");
c6a61f5 [gsoc_spectest] moved sub_named_params.t content to S06-signature/nam…
Auzon authored Aug 15, 2008
193 }
194
195 #?rakudo skip 'positional value passed by name did not work'
196 {
197 my $ref;
198 sub setref($refin) {
199 $ref = $refin;
200 }
201 my $aref = [0];
202 setref(refin => $aref);
203 $aref[0]++;
204 is($aref[0], 1, "aref actually implemented");
205 is($ref[0], 1, "ref is the same as aref");
206 }
207
208 # vim: ft=perl6
Something went wrong with that request. Please try again.