Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 246 lines (212 sloc) 5.982 kb
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
1 use v6;
2
3 use Test;
4
0eaa0ad [t/spec] Test difference between state @foo = @bar and (state @foo) = @b...
jnthn authored
5 plan 30;
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
9 # state() inside subs
10 {
11 sub inc () {
12 state $svar;
13 $svar++;
14 return $svar;
15 };
16
17 is(inc(), 1, "state() works inside subs (#1)");
18 is(inc(), 2, "state() works inside subs (#2)");
19 is(inc(), 3, "state() works inside subs (#3)");
20 }
21
22 # state() inside coderefs
23 # L<S04/Closure traits/"semantics to any initializer, so this also works">
24 {
25 my $gen = {
26 # Note: The following line is only executed once, because it's equivalent
27 # to
28 # state $svar will first { 42 };
29 state $svar = 42;
30 my $ret = { $svar++ };
31 };
32
33 my $a = $gen(); # $svar == 42
34 $a(); $a(); # $svar == 44
35 my $b = $gen(); # $svar == 44
36
37 is $b(), 44, "state() works inside coderefs";
38 }
39
40 # state() inside for-loops
41 {
42 for 1,2,3 -> $val {
43 state $svar;
44 $svar++;
45
46 # Only check on last run
47 if $val == 3 {
48 is $svar, 3, "state() works inside for-loops";
49 }
50 }
51 }
52
be90935 [t/spec] Tests for impure RHS of state variable initialization as sugges...
jnthn authored
53 # state with arrays.
54 {
55 my @bar = 1,2,3;
56 sub swatest {
57 state (@foo) = @bar;
6d9b707 [t/spec] don't rely on exact .perl value
moritz authored
58 my $x = @foo.join('|');
be90935 [t/spec] Tests for impure RHS of state variable initialization as sugges...
jnthn authored
59 @foo[0]++;
60 return $x
61 }
6d9b707 [t/spec] don't rely on exact .perl value
moritz authored
62 is swatest(), '1|2|3', 'array state initialized correctly';
63 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
64 }
65
66 # state with arrays.
67 {
68 sub swainit_sub { 1,2,3 }
69 sub swatest2 {
70 state (@foo) = swainit_sub();
6d9b707 [t/spec] don't rely on exact .perl value
moritz authored
71 my $x = @foo.join('|');
be90935 [t/spec] Tests for impure RHS of state variable initialization as sugges...
jnthn authored
72 @foo[0]++;
73 return $x
74 }
6d9b707 [t/spec] don't rely on exact .perl value
moritz authored
75 is swatest2(), '1|2|3', 'array state initialized from call correctly';
76 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
77 }
78
0eaa0ad [t/spec] Test difference between state @foo = @bar and (state @foo) = @b...
jnthn authored
79 # (state @foo) = @bar differs from state @foo = @bar
80 {
81 my @bar = 1,2,3;
82 sub swatest3 {
83 (state @foo) = @bar;
6d9b707 [t/spec] don't rely on exact .perl value
moritz authored
84 my $x = @foo.join('|');
0eaa0ad [t/spec] Test difference between state @foo = @bar and (state @foo) = @b...
jnthn authored
85 @foo[0]++;
86 return $x
87 }
6d9b707 [t/spec] don't rely on exact .perl value
moritz authored
88 is swatest3(), '1|2|3', '(state @foo) = @bar is not state @foo = @bar';
89 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
90 }
91
be90935 [t/spec] Tests for impure RHS of state variable initialization as sugges...
jnthn authored
92 # RHS of state is only run once per init
93 {
94 my $rhs_calls = 0;
95 sub impure_rhs {
96 state $x = do { $rhs_calls++ }
97 }
98 impure_rhs() for 1..3;
99 is $rhs_calls, 1, 'RHS of state $x = ... only called once';
100 }
101
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
102 # state will first {...}
103 #?pugs eval "parse error"
a269417 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass half o...
jnthn authored
104 #?rakudo todo 'will first { ... }'
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
105 {
106 my ($a, $b);
107 my $gen = {
108 state $svar will first { 42 };
109 -> { $svar++ };
110 }
111 $a = $gen(); # $svar == 42
112 $a(); $a(); # $svar == 44
113 $b = $gen()(); # $svar == 44
114
b4ea1c2 [spec] clean up :todo that's now handled by a fudge
moritz authored
115 is $b, 44, 'state will first {...} works';
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
116 }
117
118 # 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
119 #?rakudo skip 'references'
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
120 {
121 my $gen = {
122 state $svar = 42;
123 \$svar;
124 };
125
126 my $svar_ref = $gen();
127 $$svar_ref++; $$svar_ref++;
128
ed95f2a [t/spec] more small improvements (STD++, TimToady++)
moritz authored
129 $svar_ref = $gen();
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
130 #?pugs todo "state bug"
131 is $$svar_ref, 44, "reference to a state() var";
132 }
133
134 # Anonymous state vars
135 # L<http://groups.google.de/group/perl.perl6.language/msg/07aefb88f5fc8429>
136 #?pugs todo 'anonymous state vars'
a269417 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass half o...
jnthn authored
137 #?rakudo skip 'references and anonymous state vars'
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
138 {
139 # XXX -- currently this is parsed as \&state()
140 my $gen = eval '{ try { \state } }';
141 $gen //= sub { my $x; \$x };
142
143 my $svar_ref = $gen(); # $svar == 0
144 try { $$svar_ref++; $$svar_ref++ }; # $svar == 2
145
ed95f2a [t/spec] more small improvements (STD++, TimToady++)
moritz authored
146 $svar_ref = $gen(); # $svar == 2
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
147 is try { $$svar_ref }, 2, "anonymous state() vars";
148 }
149
150 # L<http://www.nntp.perl.org/group/perl.perl6.language/20888>
151 # ("Re: Declaration and definition of state() vars" from Larry)
152 #?pugs eval 'Parse error'
153 {
154 my ($a, $b);
155 my $gen = {
156 (state $svar) = 42;
157 my $ret = { $svar++ };
158 };
159
956af61 remove accidental non-breakable spaces
lwall authored
160 $a = $gen(); # $svar == 42
161 $a(); $a(); # $svar == 44
162 $b = $gen()(); # $svar == 42
163 is $b, 42, "state() and parens"; # svar == 43
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
164 }
165
166 # state() inside regular expressions
a269417 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass half o...
jnthn authored
167 #?rakudo skip 'embedded closures in regexen'
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
168 {
169 my $str = "abc";
170
171 my $re = {
172 # Perl 5 RE, as we don't want to force people to install Parrot ATM. (The
173 # test passes when using the Perl 6 RE, too.)
174 $str ~~ s:Perl5/^(.)/{
175 state $svar;
176 ++$svar;
177 }/;
178 };
179 $re();
180 $re();
181 $re();
182 is +$str, 3, "state() inside regular expressions works";
183 }
184
185 # state() inside subs, chained declaration
186 {
187 sub step () {
188 state $svar = state $svar2 = 42;
a269417 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass half o...
jnthn authored
189 $svar++;
190 $svar2--;
191 return (+$svar, +$svar2);
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
192 };
193
6d9b707 [t/spec] don't rely on exact .perl value
moritz authored
194 is(step().join('|'), "43|41", "chained state (#1)");
195 is(step().join('|'), "44|40", "chained state (#2)");
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
196 }
197
198 # state in cloned closures
199 {
200 for <first second> {
201 my $code = {
202 state $foo = 42;
203 ++$foo;
204 };
205
206 is $code(), 43, "state was initialized properly ($_ time)";
207 is $code(), 44, "state keeps its value across calls ($_ time)";
208 }
209 }
210
1b4a67a [t/spec] State/cloned closure interaction tests; based of bug report fro...
jnthn authored
211 # state with multiple explicit calls to clone - a little bit subtle
212 {
213 my $i = 0;
214 my $func = { state $x = $i++; $x };
215 my ($a, $b) = $func.clone, $func.clone;
216 is $a(), 0, 'state was initialized correctly for clone 1';
217 is $b(), 1, 'state was initialized correctly for clone 2';
218 is $a(), 0, 'state between clones is independent';
219 }
220
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
221 # 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
222 #?rakudo skip 'recurses infinitely'
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
223 {
224 my $seensize;
a269417 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass half o...
jnthn authored
225 my sub fib (Int $n) {
226 state @seen = 0,1,1;
227 $seensize = +@seen;
228 @seen[$n] //= fib($n-1) + fib($n-2);
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
229 }
230 is fib(10), 55, "fib 1 works";
231 is $seensize, 11, "list assignment state in fib memoizes";
232 }
233
234 # 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
235 #?rakudo skip '@$foo syntax'
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
236 {
237 my $seensize;
a269417 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass half o...
jnthn authored
238 my sub fib (Int $n) {
239 state $seen = [0,1,1];
240 $seensize = +@$seen;
241 $seen[$n] //= fib($n-1) + fib($n-2);
207179b [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
Auzon authored
242 }
243 is fib(10), 55, "fib 2 works";
244 is $seensize, 11, "[list] assignment state in fib memoizes";
245 }
Something went wrong with that request. Please try again.