Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

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