Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 302 lines (262 sloc) 7.612 kb
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
1 use v6;
2
3 use Test;
4
034f56bc »
2010-04-27 [t/spec] turn an example of state variables by TimToady++ into a test
5 plan 38;
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
6
7 # L<S04/The Relationship of Blocks and Declarations/There is a new state declarator that introduces>
8
71e2e0b7 »
2009-06-29 [t/spec] Test for RT #67040
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
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
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
16da25b9 »
2009-11-06 [t/spec] fix more smartlinks and comments
37 # L<S04/Phasers/"semantics to any initializer, so this also works">
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
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
be909352 »
2009-03-17 [t/spec] Tests for impure RHS of state variable initialization as sug…
67 # state with arrays.
5d023835 »
2011-02-15 Fudge S04-declarations/state for niecza
68 #?niecza skip "not working"
be909352 »
2009-03-17 [t/spec] Tests for impure RHS of state variable initialization as sug…
69 {
70 my @bar = 1,2,3;
71 sub swatest {
72 state (@foo) = @bar;
6d9b707c »
2009-03-17 [t/spec] don't rely on exact .perl value
73 my $x = @foo.join('|');
be909352 »
2009-03-17 [t/spec] Tests for impure RHS of state variable initialization as sug…
74 @foo[0]++;
75 return $x
76 }
6d9b707c »
2009-03-17 [t/spec] don't rely on exact .perl value
77 is swatest(), '1|2|3', 'array state initialized correctly';
78 is swatest(), '2|2|3', 'array state retained between calls';
be909352 »
2009-03-17 [t/spec] Tests for impure RHS of state variable initialization as sug…
79 }
80
81 # state with arrays.
5d023835 »
2011-02-15 Fudge S04-declarations/state for niecza
82 #?niecza skip "not working"
be909352 »
2009-03-17 [t/spec] Tests for impure RHS of state variable initialization as sug…
83 {
84 sub swainit_sub { 1,2,3 }
85 sub swatest2 {
86 state (@foo) = swainit_sub();
6d9b707c »
2009-03-17 [t/spec] don't rely on exact .perl value
87 my $x = @foo.join('|');
be909352 »
2009-03-17 [t/spec] Tests for impure RHS of state variable initialization as sug…
88 @foo[0]++;
89 return $x
90 }
6d9b707c »
2009-03-17 [t/spec] don't rely on exact .perl value
91 is swatest2(), '1|2|3', 'array state initialized from call correctly';
92 is swatest2(), '2|2|3', 'array state retained between calls';
be909352 »
2009-03-17 [t/spec] Tests for impure RHS of state variable initialization as sug…
93 }
94
0eaa0ad3 »
2009-03-17 [t/spec] Test difference between state @foo = @bar and (state @foo) = @…
95 # (state @foo) = @bar differs from state @foo = @bar
96 {
97 my @bar = 1,2,3;
98 sub swatest3 {
99 (state @foo) = @bar;
6d9b707c »
2009-03-17 [t/spec] don't rely on exact .perl value
100 my $x = @foo.join('|');
0eaa0ad3 »
2009-03-17 [t/spec] Test difference between state @foo = @bar and (state @foo) = @…
101 @foo[0]++;
102 return $x
103 }
6d9b707c »
2009-03-17 [t/spec] don't rely on exact .perl value
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';
0eaa0ad3 »
2009-03-17 [t/spec] Test difference between state @foo = @bar and (state @foo) = @…
106 }
107
be909352 »
2009-03-17 [t/spec] Tests for impure RHS of state variable initialization as sug…
108 # RHS of state is only run once per init
109 {
110 my $rhs_calls = 0;
111 sub impure_rhs {
8dc7d4b8 »
2010-07-15 [t/spec] mark various tests that intentionally declare things that ar…
112 state $x = do { $rhs_calls++ } #OK not used
be909352 »
2009-03-17 [t/spec] Tests for impure RHS of state variable initialization as sug…
113 }
114 impure_rhs() for 1..3;
115 is $rhs_calls, 1, 'RHS of state $x = ... only called once';
116 }
117
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
118 # state will first {...}
119 #?pugs eval "parse error"
e054f01c »
2009-04-20 [t/spec] Skip a test that we todo'd before; got away with that when w…
120 #?rakudo skip 'will first { ... }'
5d023835 »
2011-02-15 Fudge S04-declarations/state for niecza
121 #?niecza skip 'will first { ... }'
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
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
b4ea1c22 »
2008-07-16 [spec] clean up :todo that's now handled by a fudge
132 is $b, 44, 'state will first {...} works';
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
133 }
134
135 # Return of a reference to a state() var
a2694178 »
2009-03-17 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass hal…
136 #?rakudo skip 'references'
5d023835 »
2011-02-15 Fudge S04-declarations/state for niecza
137 #?niecza skip '\\'
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
138 {
139 my $gen = {
140 state $svar = 42;
141 \$svar;
142 };
143
144 my $svar_ref = $gen();
145 $$svar_ref++; $$svar_ref++;
146
ed95f2ab »
2009-03-07 [t/spec] more small improvements (STD++, TimToady++)
147 $svar_ref = $gen();
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
148 #?pugs todo "state bug"
149 is $$svar_ref, 44, "reference to a state() var";
150 }
151
152 # Anonymous state vars
153 # L<http://groups.google.de/group/perl.perl6.language/msg/07aefb88f5fc8429>
154 #?pugs todo 'anonymous state vars'
a2694178 »
2009-03-17 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass hal…
155 #?rakudo skip 'references and anonymous state vars'
5d023835 »
2011-02-15 Fudge S04-declarations/state for niecza
156 #?niecza skip '\\'
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
157 {
158 # XXX -- currently this is parsed as \&state()
159 my $gen = eval '{ try { \state } }';
160 $gen //= sub { my $x; \$x };
161
162 my $svar_ref = $gen(); # $svar == 0
163 try { $$svar_ref++; $$svar_ref++ }; # $svar == 2
164
ed95f2ab »
2009-03-07 [t/spec] more small improvements (STD++, TimToady++)
165 $svar_ref = $gen(); # $svar == 2
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
166 is try { $$svar_ref }, 2, "anonymous state() vars";
167 }
168
169 # L<http://www.nntp.perl.org/group/perl.perl6.language/20888>
170 # ("Re: Declaration and definition of state() vars" from Larry)
171 #?pugs eval 'Parse error'
172 {
173 my ($a, $b);
174 my $gen = {
175 (state $svar) = 42;
176 my $ret = { $svar++ };
177 };
178
956af61b »
2008-07-24 remove accidental non-breakable spaces
179 $a = $gen(); # $svar == 42
180 $a(); $a(); # $svar == 44
181 $b = $gen()(); # $svar == 42
182 is $b, 42, "state() and parens"; # svar == 43
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
183 }
184
185 # state() inside regular expressions
a2694178 »
2009-03-17 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass hal…
186 #?rakudo skip 'embedded closures in regexen'
5d023835 »
2011-02-15 Fudge S04-declarations/state for niecza
187 #?niecza skip ':Perl5'
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
188 {
189 my $str = "abc";
190
191 my $re = {
192 # Perl 5 RE, as we don't want to force people to install Parrot ATM. (The
193 # test passes when using the Perl 6 RE, too.)
194 $str ~~ s:Perl5/^(.)/{
195 state $svar;
196 ++$svar;
197 }/;
198 };
199 $re();
200 $re();
201 $re();
202 is +$str, 3, "state() inside regular expressions works";
203 }
204
205 # state() inside subs, chained declaration
206 {
207 sub step () {
208 state $svar = state $svar2 = 42;
a2694178 »
2009-03-17 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass hal…
209 $svar++;
210 $svar2--;
211 return (+$svar, +$svar2);
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
212 };
213
6d9b707c »
2009-03-17 [t/spec] don't rely on exact .perl value
214 is(step().join('|'), "43|41", "chained state (#1)");
215 is(step().join('|'), "44|40", "chained state (#2)");
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
216 }
217
218 # state in cloned closures
219 {
220 for <first second> {
221 my $code = {
222 state $foo = 42;
223 ++$foo;
224 };
225
226 is $code(), 43, "state was initialized properly ($_ time)";
227 is $code(), 44, "state keeps its value across calls ($_ time)";
228 }
229 }
230
1b4a67a7 »
2009-03-17 [t/spec] State/cloned closure interaction tests; based of bug report …
231 # state with multiple explicit calls to clone - a little bit subtle
5d023835 »
2011-02-15 Fudge S04-declarations/state for niecza
232 #?niecza skip "there is no Sub.clone"
1b4a67a7 »
2009-03-17 [t/spec] State/cloned closure interaction tests; based of bug report …
233 {
234 my $i = 0;
235 my $func = { state $x = $i++; $x };
236 my ($a, $b) = $func.clone, $func.clone;
237 is $a(), 0, 'state was initialized correctly for clone 1';
238 is $b(), 1, 'state was initialized correctly for clone 2';
239 is $a(), 0, 'state between clones is independent';
240 }
241
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
242 # recursive state with list assignment initialization happens only first time
5d023835 »
2011-02-15 Fudge S04-declarations/state for niecza
243 #?niecza skip 'Int'
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
244 {
245 my $seensize;
a2694178 »
2009-03-17 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass hal…
246 my sub fib (Int $n) {
247 state @seen = 0,1,1;
248 $seensize = +@seen;
249 @seen[$n] //= fib($n-1) + fib($n-2);
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
250 }
fc37ee65 »
2009-03-17 [t/spec] Unfudge various tests relating to //=, ||= and &&= for Rakudo.
251 is fib(10), 55, "fib 10 works";
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
252 is $seensize, 11, "list assignment state in fib memoizes";
253 }
254
255 # recursive state with [list] assignment initialization happens only first time
a2694178 »
2009-03-17 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass hal…
256 #?rakudo skip '@$foo syntax'
5d023835 »
2011-02-15 Fudge S04-declarations/state for niecza
257 #?niecza skip 'Int'
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
258 {
259 my $seensize;
a2694178 »
2009-03-17 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass hal…
260 my sub fib (Int $n) {
261 state $seen = [0,1,1];
262 $seensize = +@$seen;
263 $seen[$n] //= fib($n-1) + fib($n-2);
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
264 }
265 is fib(10), 55, "fib 2 works";
266 is $seensize, 11, "[list] assignment state in fib memoizes";
267 }
21f6acce »
2009-03-22 [t/spec]
268
5d023835 »
2011-02-15 Fudge S04-declarations/state for niecza
269 #?niecza skip 'subset'
21f6acce »
2009-03-22 [t/spec]
270 {
271 # now we're just being plain evil:
272 subset A of Int where { $_ < state $x++ };
273 my A $y = -4;
274 # the compiler could have done some checks somehwere, so
275 # pick a reasonably high number
276 dies_ok { $y = 900000 }, 'growing subset types rejects too high values';
277 lives_ok { $y = 1 }, 'the state variable in subset types works (1)';
278 lives_ok { $y = 2 }, 'the state variable in subset types works (2)';
279 lives_ok { $y = 3 }, 'the state variable in subset types works (3)';
280 }
281
a261d6b7 »
2009-06-30 [t/spec] Move state-rt67058.t into state.t
282 # Test for RT #67058
8dc7d4b8 »
2010-07-15 [t/spec] mark various tests that intentionally declare things that ar…
283 sub bughunt1 { (state $svar) } #OK not used
a261d6b7 »
2009-06-30 [t/spec] Move state-rt67058.t into state.t
284 {
ea4d2357 »
2009-08-14 [t/spec] begin cleansing of eval and todos that should skip
285 sub bughunt2 { state $x //= 17; ++$x }
286 is bughunt2(), 18,
287 'a state variable in parens works with a state variable with //= init';
a261d6b7 »
2009-06-30 [t/spec] Move state-rt67058.t into state.t
288 }
289
034f56bc »
2010-04-27 [t/spec] turn an example of state variables by TimToady++ into a test
290 {
291 # http://irclog.perlgeek.de/perl6/2010-04-27#i_2269848
292 my @tracker;
293 for (1..3) {
294 my $x = sub { state $s++; @tracker.push: $s }
295 $x();
296 };
297 is @tracker.join('|'), '1|1|1',
298 'state var in anonymous closure in loop is not shared';
299 }
300
21f6acce »
2009-03-22 [t/spec]
301 # vim: ft=perl6
Something went wrong with that request. Please try again.