Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 303 lines (261 sloc) 7.678 kB
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
1 use v6;
2
3 use Test;
4
9055b81 @sorear S04-declatations/state: test two niecza regressions, fix \(state $) test
sorear authored
5 plan 40;
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
6
7 # L<S04/The Relationship of Blocks and Declarations/There is a new state declarator that introduces>
8
71e2e0b [t/spec] Test for RT #67040
kyle authored
9 # RT #67040 -- state initialized with //= instead of =
10 # (I've put this test here since it gets buggered by later tests
11 # unless RT #67058 has been fixed.)
12 {
13 sub rt67040 {
14 state $x //= 17;
15 $x++;
16 return $x;
17 }
18
19 is rt67040(), 18, 'Assignment to state variable with //= works.';
20 is rt67040(), 19, 'Assignment to state variable with //= happens once.';
21 }
22
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
23 # state() inside subs
24 {
25 sub inc () {
26 state $svar;
27 $svar++;
28 return $svar;
29 };
30
31 is(inc(), 1, "state() works inside subs (#1)");
32 is(inc(), 2, "state() works inside subs (#2)");
33 is(inc(), 3, "state() works inside subs (#3)");
34 }
35
36 # state() inside coderefs
16da25b [t/spec] fix more smartlinks and comments
moritz authored
37 # L<S04/Phasers/"semantics to any initializer, so this also works">
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
38 {
39 my $gen = {
40 # Note: The following line is only executed once, because it's equivalent
41 # to
42 # state $svar will first { 42 };
43 state $svar = 42;
44 my $ret = { $svar++ };
45 };
46
47 my $a = $gen(); # $svar == 42
48 $a(); $a(); # $svar == 44
49 my $b = $gen(); # $svar == 44
50
51 is $b(), 44, "state() works inside coderefs";
52 }
53
54 # state() inside for-loops
55 {
56 for 1,2,3 -> $val {
57 state $svar;
58 $svar++;
59
60 # Only check on last run
61 if $val == 3 {
62 is $svar, 3, "state() works inside for-loops";
63 }
64 }
65 }
66
be90935 [t/spec] Tests for impure RHS of state variable initialization as sug…
jnthn authored
67 # state with arrays.
5d02383 @sorear Fudge S04-declarations/state for niecza
sorear authored
68 #?niecza skip "not working"
be90935 [t/spec] Tests for impure RHS of state variable initialization as sug…
jnthn authored
69 {
70 my @bar = 1,2,3;
71 sub swatest {
72 state (@foo) = @bar;
6d9b707 [t/spec] don't rely on exact .perl value
moritz authored
73 my $x = @foo.join('|');
be90935 [t/spec] Tests for impure RHS of state variable initialization as sug…
jnthn authored
74 @foo[0]++;
75 return $x
76 }
6d9b707 [t/spec] don't rely on exact .perl value
moritz authored
77 is swatest(), '1|2|3', 'array state initialized correctly';
78 is swatest(), '2|2|3', 'array state retained between calls';
be90935 [t/spec] Tests for impure RHS of state variable initialization as sug…
jnthn authored
79 }
80
81 # state with arrays.
5d02383 @sorear Fudge S04-declarations/state for niecza
sorear authored
82 #?niecza skip "not working"
be90935 [t/spec] Tests for impure RHS of state variable initialization as sug…
jnthn authored
83 {
84 sub swainit_sub { 1,2,3 }
85 sub swatest2 {
86 state (@foo) = swainit_sub();
6d9b707 [t/spec] don't rely on exact .perl value
moritz authored
87 my $x = @foo.join('|');
be90935 [t/spec] Tests for impure RHS of state variable initialization as sug…
jnthn authored
88 @foo[0]++;
89 return $x
90 }
6d9b707 [t/spec] don't rely on exact .perl value
moritz authored
91 is swatest2(), '1|2|3', 'array state initialized from call correctly';
92 is swatest2(), '2|2|3', 'array state retained between calls';
be90935 [t/spec] Tests for impure RHS of state variable initialization as sug…
jnthn authored
93 }
94
0eaa0ad [t/spec] Test difference between state @foo = @bar and (state @foo) =…
jnthn authored
95 # (state @foo) = @bar differs from state @foo = @bar
96 {
97 my @bar = 1,2,3;
98 sub swatest3 {
99 (state @foo) = @bar;
6d9b707 [t/spec] don't rely on exact .perl value
moritz authored
100 my $x = @foo.join('|');
0eaa0ad [t/spec] Test difference between state @foo = @bar and (state @foo) =…
jnthn authored
101 @foo[0]++;
102 return $x
103 }
6d9b707 [t/spec] don't rely on exact .perl value
moritz authored
104 is swatest3(), '1|2|3', '(state @foo) = @bar is not state @foo = @bar';
105 is swatest3(), '1|2|3', '(state @foo) = @bar is not state @foo = @bar';
0eaa0ad [t/spec] Test difference between state @foo = @bar and (state @foo) =…
jnthn authored
106 }
107
be90935 [t/spec] Tests for impure RHS of state variable initialization as sug…
jnthn authored
108 # RHS of state is only run once per init
109 {
110 my $rhs_calls = 0;
111 sub impure_rhs {
8dc7d4b [t/spec] mark various tests that intentionally declare things that ar…
lwall authored
112 state $x = do { $rhs_calls++ } #OK not used
be90935 [t/spec] Tests for impure RHS of state variable initialization as sug…
jnthn authored
113 }
114 impure_rhs() for 1..3;
115 is $rhs_calls, 1, 'RHS of state $x = ... only called once';
116 }
117
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
118 # state will first {...}
119 #?pugs eval "parse error"
e054f01 [t/spec] Skip a test that we todo'd before; got away with that when w…
jnthn authored
120 #?rakudo skip 'will first { ... }'
5d02383 @sorear Fudge S04-declarations/state for niecza
sorear authored
121 #?niecza skip 'will first { ... }'
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
122 {
123 my ($a, $b);
124 my $gen = {
125 state $svar will first { 42 };
126 -> { $svar++ };
127 }
128 $a = $gen(); # $svar == 42
129 $a(); $a(); # $svar == 44
130 $b = $gen()(); # $svar == 44
131
b4ea1c2 [spec] clean up :todo that's now handled by a fudge
moritz authored
132 is $b, 44, 'state will first {...} works';
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
133 }
134
135 # Return of a reference to a state() var
a269417 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass hal…
jnthn authored
136 #?rakudo skip 'references'
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
137 {
138 my $gen = {
139 state $svar = 42;
140 \$svar;
141 };
142
143 my $svar_ref = $gen();
144 $$svar_ref++; $$svar_ref++;
145
ed95f2a [t/spec] more small improvements (STD++, TimToady++)
moritz authored
146 $svar_ref = $gen();
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
147 #?pugs todo "state bug"
148 is $$svar_ref, 44, "reference to a state() var";
149 }
150
151 # Anonymous state vars
152 # L<http://groups.google.de/group/perl.perl6.language/msg/07aefb88f5fc8429>
9055b81 @sorear S04-declatations/state: test two niecza regressions, fix \(state $) test
sorear authored
153 # fudged a bit on syntax
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
154 #?pugs todo 'anonymous state vars'
a269417 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass hal…
jnthn authored
155 #?rakudo skip 'references and anonymous state vars'
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
156 {
9055b81 @sorear S04-declatations/state: test two niecza regressions, fix \(state $) test
sorear authored
157 my $gen = sub { \(state $ ) };
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
158
159 my $svar_ref = $gen(); # $svar == 0
160 try { $$svar_ref++; $$svar_ref++ }; # $svar == 2
161
ed95f2a [t/spec] more small improvements (STD++, TimToady++)
moritz authored
162 $svar_ref = $gen(); # $svar == 2
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
163 is try { $$svar_ref }, 2, "anonymous state() vars";
164 }
165
9055b81 @sorear S04-declatations/state: test two niecza regressions, fix \(state $) test
sorear authored
166 eval_lives_ok 'if 0 { \(state $) }', '$) not misinterpreted in capterm';
167
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
168 # L<http://www.nntp.perl.org/group/perl.perl6.language/20888>
169 # ("Re: Declaration and definition of state() vars" from Larry)
170 #?pugs eval 'Parse error'
171 {
172 my ($a, $b);
173 my $gen = {
174 (state $svar) = 42;
175 my $ret = { $svar++ };
176 };
177
956af61 remove accidental non-breakable spaces
lwall authored
178 $a = $gen(); # $svar == 42
179 $a(); $a(); # $svar == 44
180 $b = $gen()(); # $svar == 42
181 is $b, 42, "state() and parens"; # svar == 43
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
182 }
183
184 # state() inside regular expressions
a269417 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass hal…
jnthn authored
185 #?rakudo skip 'embedded closures in regexen'
5d02383 @sorear Fudge S04-declarations/state for niecza
sorear authored
186 #?niecza skip ':Perl5'
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
187 {
188 my $str = "abc";
189
190 my $re = {
191 # Perl 5 RE, as we don't want to force people to install Parrot ATM. (The
192 # test passes when using the Perl 6 RE, too.)
193 $str ~~ s:Perl5/^(.)/{
194 state $svar;
195 ++$svar;
196 }/;
197 };
198 $re();
199 $re();
200 $re();
201 is +$str, 3, "state() inside regular expressions works";
202 }
203
204 # state() inside subs, chained declaration
205 {
206 sub step () {
207 state $svar = state $svar2 = 42;
a269417 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass hal…
jnthn authored
208 $svar++;
209 $svar2--;
210 return (+$svar, +$svar2);
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
211 };
212
6d9b707 [t/spec] don't rely on exact .perl value
moritz authored
213 is(step().join('|'), "43|41", "chained state (#1)");
214 is(step().join('|'), "44|40", "chained state (#2)");
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
215 }
216
217 # state in cloned closures
218 {
219 for <first second> {
220 my $code = {
221 state $foo = 42;
222 ++$foo;
223 };
224
225 is $code(), 43, "state was initialized properly ($_ time)";
226 is $code(), 44, "state keeps its value across calls ($_ time)";
227 }
228 }
229
1b4a67a [t/spec] State/cloned closure interaction tests; based of bug report …
jnthn authored
230 # state with multiple explicit calls to clone - a little bit subtle
5d02383 @sorear Fudge S04-declarations/state for niecza
sorear authored
231 #?niecza skip "there is no Sub.clone"
1b4a67a [t/spec] State/cloned closure interaction tests; based of bug report …
jnthn authored
232 {
233 my $i = 0;
234 my $func = { state $x = $i++; $x };
235 my ($a, $b) = $func.clone, $func.clone;
236 is $a(), 0, 'state was initialized correctly for clone 1';
237 is $b(), 1, 'state was initialized correctly for clone 2';
238 is $a(), 0, 'state between clones is independent';
239 }
240
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
241 # recursive state with list assignment initialization happens only first time
5d02383 @sorear Fudge S04-declarations/state for niecza
sorear authored
242 #?niecza skip 'Int'
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
243 {
244 my $seensize;
a269417 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass hal…
jnthn authored
245 my sub fib (Int $n) {
246 state @seen = 0,1,1;
247 $seensize = +@seen;
248 @seen[$n] //= fib($n-1) + fib($n-2);
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
249 }
fc37ee6 [t/spec] Unfudge various tests relating to //=, ||= and &&= for Rakudo.
jnthn authored
250 is fib(10), 55, "fib 10 works";
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
251 is $seensize, 11, "list assignment state in fib memoizes";
252 }
253
254 # recursive state with [list] assignment initialization happens only first time
a269417 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass hal…
jnthn authored
255 #?rakudo skip '@$foo syntax'
5d02383 @sorear Fudge S04-declarations/state for niecza
sorear authored
256 #?niecza skip 'Int'
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
257 {
258 my $seensize;
a269417 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass hal…
jnthn authored
259 my sub fib (Int $n) {
260 state $seen = [0,1,1];
261 $seensize = +@$seen;
262 $seen[$n] //= fib($n-1) + fib($n-2);
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
263 }
264 is fib(10), 55, "fib 2 works";
265 is $seensize, 11, "[list] assignment state in fib memoizes";
266 }
21f6acc [t/spec]
moritz authored
267
268 {
269 # now we're just being plain evil:
270 subset A of Int where { $_ < state $x++ };
271 my A $y = -4;
272 # the compiler could have done some checks somehwere, so
273 # pick a reasonably high number
274 dies_ok { $y = 900000 }, 'growing subset types rejects too high values';
275 lives_ok { $y = 1 }, 'the state variable in subset types works (1)';
276 lives_ok { $y = 2 }, 'the state variable in subset types works (2)';
277 lives_ok { $y = 3 }, 'the state variable in subset types works (3)';
278 }
279
a261d6b [t/spec] Move state-rt67058.t into state.t
kyle authored
280 # Test for RT #67058
8dc7d4b [t/spec] mark various tests that intentionally declare things that ar…
lwall authored
281 sub bughunt1 { (state $svar) } #OK not used
a261d6b [t/spec] Move state-rt67058.t into state.t
kyle authored
282 {
ea4d235 [t/spec] begin cleansing of eval and todos that should skip
kyle authored
283 sub bughunt2 { state $x //= 17; ++$x }
284 is bughunt2(), 18,
285 'a state variable in parens works with a state variable with //= init';
a261d6b [t/spec] Move state-rt67058.t into state.t
kyle authored
286 }
287
034f56b [t/spec] turn an example of state variables by TimToady++ into a test
moritz authored
288 {
289 # http://irclog.perlgeek.de/perl6/2010-04-27#i_2269848
290 my @tracker;
291 for (1..3) {
292 my $x = sub { state $s++; @tracker.push: $s }
293 $x();
294 };
295 is @tracker.join('|'), '1|1|1',
296 'state var in anonymous closure in loop is not shared';
297 }
298
9055b81 @sorear S04-declatations/state: test two niecza regressions, fix \(state $) test
sorear authored
299 # niecza regression: state not working at top level
300 eval_lives_ok 'state $x; $x', 'state outside control structure';
301
21f6acc [t/spec]
moritz authored
302 # vim: ft=perl6
Something went wrong with that request. Please try again.