Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

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