Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

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