Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 337 lines (293 sloc) 8.305 kb
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
1 use v6;
2
3 use Test;
4
bf187bc @moritz fix plan in state.t
moritz authored
5 plan 42;
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
0836cea @coke nom fudging
coke authored
31 is(inc(), 1, "state() works inside subs (first)");
32 is(inc(), 2, "state() works inside subs (second)");
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
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">
0836cea @coke nom fudging
coke authored
38 #?DOES 1
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
39 {
40 my $gen = {
41 # Note: The following line is only executed once, because it's equivalent
42 # to
43 # state $svar will first { 42 };
44 state $svar = 42;
45 my $ret = { $svar++ };
46 };
47
48 my $a = $gen(); # $svar == 42
49 $a(); $a(); # $svar == 44
50 my $b = $gen(); # $svar == 44
51
52 is $b(), 44, "state() works inside coderefs";
53 }
54
55 # state() inside for-loops
56 {
57 for 1,2,3 -> $val {
58 state $svar;
59 $svar++;
60
61 # Only check on last run
62 if $val == 3 {
63 is $svar, 3, "state() works inside for-loops";
64 }
65 }
66 }
67
be90935 [t/spec] Tests for impure RHS of state variable initialization as sug…
jnthn authored
68 # state with arrays.
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';
0836cea @coke nom fudging
coke authored
78 #?rakudo todo 'nom regression'
6d9b707 [t/spec] don't rely on exact .perl value
moritz authored
79 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
80 }
81
82 # state with arrays.
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';
0836cea @coke nom fudging
coke authored
92 #?rakudo todo 'nom regression'
6d9b707 [t/spec] don't rely on exact .perl value
moritz authored
93 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
94 }
95
0eaa0ad [t/spec] Test difference between state @foo = @bar and (state @foo) =…
jnthn authored
96 # (state @foo) = @bar differs from state @foo = @bar
97 {
98 my @bar = 1,2,3;
99 sub swatest3 {
100 (state @foo) = @bar;
6d9b707 [t/spec] don't rely on exact .perl value
moritz authored
101 my $x = @foo.join('|');
0eaa0ad [t/spec] Test difference between state @foo = @bar and (state @foo) =…
jnthn authored
102 @foo[0]++;
103 return $x
104 }
6d9b707 [t/spec] don't rely on exact .perl value
moritz authored
105 is swatest3(), '1|2|3', '(state @foo) = @bar is not state @foo = @bar';
106 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
107 }
108
be90935 [t/spec] Tests for impure RHS of state variable initialization as sug…
jnthn authored
109 # RHS of state is only run once per init
110 {
111 my $rhs_calls = 0;
112 sub impure_rhs {
8dc7d4b [t/spec] mark various tests that intentionally declare things that ar…
lwall authored
113 state $x = do { $rhs_calls++ } #OK not used
be90935 [t/spec] Tests for impure RHS of state variable initialization as sug…
jnthn authored
114 }
115 impure_rhs() for 1..3;
116 is $rhs_calls, 1, 'RHS of state $x = ... only called once';
117 }
118
4bae023 @sorear Many state unfudges for niecza, fix fib recursion count, fix will fir…
sorear authored
119 # state will start {...}
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
120 #?pugs eval "parse error"
4bae023 @sorear Many state unfudges for niecza, fix fib recursion count, fix will fir…
sorear authored
121 #?rakudo skip 'will start { ... }'
0836cea @coke nom fudging
coke authored
122 #?DOES 1
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
123 {
124 my ($a, $b);
125 my $gen = {
01f6069 @sorear S04-declarations/state: fix will start { 42 } fossil (TimToady)
sorear authored
126 state $svar will start { $_ = 42 };
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
127 -> { $svar++ };
128 }
129 $a = $gen(); # $svar == 42
130 $a(); $a(); # $svar == 44
131 $b = $gen()(); # $svar == 44
132
4bae023 @sorear Many state unfudges for niecza, fix fib recursion count, fix will fir…
sorear authored
133 is $b, 44, 'state will start {...} works';
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
134 }
135
136 # Return of a reference to a state() var
a269417 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass hal…
jnthn authored
137 #?rakudo skip 'references'
0836cea @coke nom fudging
coke authored
138 #?DOES 1
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
139 {
140 my $gen = {
141 state $svar = 42;
142 \$svar;
143 };
144
145 my $svar_ref = $gen();
146 $$svar_ref++; $$svar_ref++;
147
ed95f2a [t/spec] more small improvements (STD++, TimToady++)
moritz authored
148 $svar_ref = $gen();
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
149 #?pugs todo "state bug"
150 is $$svar_ref, 44, "reference to a state() var";
151 }
152
153 # Anonymous state vars
154 # 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
155 # fudged a bit on syntax
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
156 #?pugs todo 'anonymous state vars'
a269417 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass hal…
jnthn authored
157 #?rakudo skip 'references and anonymous state vars'
0836cea @coke nom fudging
coke authored
158 #?DOES 1
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
159 {
9055b81 @sorear S04-declatations/state: test two niecza regressions, fix \(state $) test
sorear authored
160 my $gen = sub { \(state $ ) };
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
161
162 my $svar_ref = $gen(); # $svar == 0
163 try { $$svar_ref++; $$svar_ref++ }; # $svar == 2
164
ed95f2a [t/spec] more small improvements (STD++, TimToady++)
moritz authored
165 $svar_ref = $gen(); # $svar == 2
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
166 is try { $$svar_ref }, 2, "anonymous state() vars";
167 }
168
0836cea @coke nom fudging
coke authored
169 #?rakudo todo 'nom regression'
9055b81 @sorear S04-declatations/state: test two niecza regressions, fix \(state $) test
sorear authored
170 eval_lives_ok 'if 0 { \(state $) }', '$) not misinterpreted in capterm';
171
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
172 # L<http://www.nntp.perl.org/group/perl.perl6.language/20888>
173 # ("Re: Declaration and definition of state() vars" from Larry)
174 #?pugs eval 'Parse error'
175 {
176 my ($a, $b);
177 my $gen = {
178 (state $svar) = 42;
179 my $ret = { $svar++ };
180 };
181
956af61 remove accidental non-breakable spaces
lwall authored
182 $a = $gen(); # $svar == 42
183 $a(); $a(); # $svar == 44
184 $b = $gen()(); # $svar == 42
185 is $b, 42, "state() and parens"; # svar == 43
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
186 }
187
188 # state() inside regular expressions
a269417 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass hal…
jnthn authored
189 #?rakudo skip 'embedded closures in regexen'
5d02383 @sorear Fudge S04-declarations/state for niecza
sorear authored
190 #?niecza skip ':Perl5'
0836cea @coke nom fudging
coke authored
191 #?DOES 1
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
192 {
193 my $str = "abc";
194
195 my $re = {
196 # Perl 5 RE, as we don't want to force people to install Parrot ATM. (The
197 # test passes when using the Perl 6 RE, too.)
198 $str ~~ s:Perl5/^(.)/{
199 state $svar;
200 ++$svar;
201 }/;
202 };
203 $re();
204 $re();
205 $re();
206 is +$str, 3, "state() inside regular expressions works";
207 }
208
209 # state() inside subs, chained declaration
210 {
211 sub step () {
212 state $svar = state $svar2 = 42;
a269417 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass hal…
jnthn authored
213 $svar++;
214 $svar2--;
215 return (+$svar, +$svar2);
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
216 };
217
0836cea @coke nom fudging
coke authored
218 is(step().join('|'), "43|41", "chained state (1)");
219 is(step().join('|'), "44|40", "chained state (2)");
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
220 }
221
222 # state in cloned closures
0836cea @coke nom fudging
coke authored
223 #?DOES 4
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
224 {
225 for <first second> {
226 my $code = {
227 state $foo = 42;
228 ++$foo;
229 };
230
231 is $code(), 43, "state was initialized properly ($_ time)";
232 is $code(), 44, "state keeps its value across calls ($_ time)";
233 }
234 }
235
1b4a67a [t/spec] State/cloned closure interaction tests; based of bug report …
jnthn authored
236 # state with multiple explicit calls to clone - a little bit subtle
0836cea @coke nom fudging
coke authored
237 #?DOES 3
1b4a67a [t/spec] State/cloned closure interaction tests; based of bug report …
jnthn authored
238 {
239 my $i = 0;
240 my $func = { state $x = $i++; $x };
241 my ($a, $b) = $func.clone, $func.clone;
242 is $a(), 0, 'state was initialized correctly for clone 1';
47d8f39 @coke niecza (auto)unfudge
coke authored
243 #?niecza todo 'state was initialized correctly for clone 2'
1b4a67a [t/spec] State/cloned closure interaction tests; based of bug report …
jnthn authored
244 is $b(), 1, 'state was initialized correctly for clone 2';
245 is $a(), 0, 'state between clones is independent';
246 }
247
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
248 # recursive state with list assignment initialization happens only first time
0836cea @coke nom fudging
coke authored
249 #?rakudo skip 'parse error'
250 #?DOES 2
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
251 {
252 my $seensize;
a269417 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass hal…
jnthn authored
253 my sub fib (Int $n) {
254 state @seen = 0,1,1;
255 $seensize = +@seen;
256 @seen[$n] //= fib($n-1) + fib($n-2);
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
257 }
fc37ee6 [t/spec] Unfudge various tests relating to //=, ||= and &&= for Rakudo.
jnthn authored
258 is fib(10), 55, "fib 10 works";
4bae023 @sorear Many state unfudges for niecza, fix fib recursion count, fix will fir…
sorear authored
259 is $seensize, 10, "list assignment state in fib memoizes";
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
260 }
261
262 # 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
263 #?rakudo skip '@$foo syntax'
0836cea @coke nom fudging
coke authored
264 #?DOES 2
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
265 {
266 my $seensize;
a269417 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass hal…
jnthn authored
267 my sub fib (Int $n) {
268 state $seen = [0,1,1];
269 $seensize = +@$seen;
270 $seen[$n] //= fib($n-1) + fib($n-2);
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
271 }
272 is fib(10), 55, "fib 2 works";
4bae023 @sorear Many state unfudges for niecza, fix fib recursion count, fix will fir…
sorear authored
273 is $seensize, 10, "[list] assignment state in fib memoizes";
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
274 }
21f6acc [t/spec]
moritz authored
275
836cfff @moritz start to fudge state.t for rakudo
moritz authored
276 #?rakudo skip 'parse error'
0836cea @coke nom fudging
coke authored
277 #?DOES 4
21f6acc [t/spec]
moritz authored
278 {
279 # now we're just being plain evil:
280 subset A of Int where { $_ < state $x++ };
281 my A $y = -4;
282 # the compiler could have done some checks somehwere, so
283 # pick a reasonably high number
284 dies_ok { $y = 900000 }, 'growing subset types rejects too high values';
285 lives_ok { $y = 1 }, 'the state variable in subset types works (1)';
286 lives_ok { $y = 2 }, 'the state variable in subset types works (2)';
287 lives_ok { $y = 3 }, 'the state variable in subset types works (3)';
288 }
289
a261d6b [t/spec] Move state-rt67058.t into state.t
kyle authored
290 # Test for RT #67058
8dc7d4b [t/spec] mark various tests that intentionally declare things that ar…
lwall authored
291 sub bughunt1 { (state $svar) } #OK not used
a261d6b [t/spec] Move state-rt67058.t into state.t
kyle authored
292 {
ea4d235 [t/spec] begin cleansing of eval and todos that should skip
kyle authored
293 sub bughunt2 { state $x //= 17; ++$x }
294 is bughunt2(), 18,
295 'a state variable in parens works with a state variable with //= init';
a261d6b [t/spec] Move state-rt67058.t into state.t
kyle authored
296 }
297
836cfff @moritz start to fudge state.t for rakudo
moritz authored
298 #?rakudo skip 'parse error'
0836cea @coke nom fudging
coke authored
299 #?DOES 1
034f56b [t/spec] turn an example of state variables by TimToady++ into a test
moritz authored
300 {
301 # http://irclog.perlgeek.de/perl6/2010-04-27#i_2269848
302 my @tracker;
303 for (1..3) {
304 my $x = sub { state $s++; @tracker.push: $s }
305 $x();
306 };
307 is @tracker.join('|'), '1|1|1',
308 'state var in anonymous closure in loop is not shared';
309 }
310
9055b81 @sorear S04-declatations/state: test two niecza regressions, fix \(state $) test
sorear authored
311 # niecza regression: state not working at top level
312 eval_lives_ok 'state $x; $x', 'state outside control structure';
313
633e3c3 @moritz test state var initialization when the first run of the routine does …
moritz authored
314 #?rakudo todo 'initialization happens only on first call(?)'
315 {
316 sub f($x) {
317 return if $x;
318 state $y = 5;
319 $y;
320 }
321 f(1);
322 is f(0), 5, 'initialization not reached on first run of the functions';
323 }
324
7bbd58b @moritz state vars with list assignment initializers
moritz authored
325 #?rakudo todo 'state vars in list assignment'
326 {
327 sub r {
328 state ($a, $b) = (5, 42);
329 $a++; $b--;
330 "$a $b"
331 }
332 r();
333 is r(), '7 40', 'state vars and list assignment mixes';
334 }
335
21f6acc [t/spec]
moritz authored
336 # vim: ft=perl6
Something went wrong with that request. Please try again.