Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 245 lines (211 sloc) 5.947 kb
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
1 use v6;
2
3 use Test;
4
0eaa0ad3 »
2009-03-17 [t/spec] Test difference between state @foo = @bar and (state @foo) = @…
5 plan 30;
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
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
be909352 »
2009-03-17 [t/spec] Tests for impure RHS of state variable initialization as sug…
53 # state with arrays.
54 {
55 my @bar = 1,2,3;
56 sub swatest {
57 state (@foo) = @bar;
6d9b707c »
2009-03-17 [t/spec] don't rely on exact .perl value
58 my $x = @foo.join('|');
be909352 »
2009-03-17 [t/spec] Tests for impure RHS of state variable initialization as sug…
59 @foo[0]++;
60 return $x
61 }
6d9b707c »
2009-03-17 [t/spec] don't rely on exact .perl value
62 is swatest(), '1|2|3', 'array state initialized correctly';
63 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…
64 }
65
66 # state with arrays.
67 {
68 sub swainit_sub { 1,2,3 }
69 sub swatest2 {
70 state (@foo) = swainit_sub();
6d9b707c »
2009-03-17 [t/spec] don't rely on exact .perl value
71 my $x = @foo.join('|');
be909352 »
2009-03-17 [t/spec] Tests for impure RHS of state variable initialization as sug…
72 @foo[0]++;
73 return $x
74 }
6d9b707c »
2009-03-17 [t/spec] don't rely on exact .perl value
75 is swatest2(), '1|2|3', 'array state initialized from call correctly';
76 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…
77 }
78
0eaa0ad3 »
2009-03-17 [t/spec] Test difference between state @foo = @bar and (state @foo) = @…
79 # (state @foo) = @bar differs from state @foo = @bar
80 {
81 my @bar = 1,2,3;
82 sub swatest3 {
83 (state @foo) = @bar;
6d9b707c »
2009-03-17 [t/spec] don't rely on exact .perl value
84 my $x = @foo.join('|');
0eaa0ad3 »
2009-03-17 [t/spec] Test difference between state @foo = @bar and (state @foo) = @…
85 @foo[0]++;
86 return $x
87 }
6d9b707c »
2009-03-17 [t/spec] don't rely on exact .perl value
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';
0eaa0ad3 »
2009-03-17 [t/spec] Test difference between state @foo = @bar and (state @foo) = @…
90 }
91
be909352 »
2009-03-17 [t/spec] Tests for impure RHS of state variable initialization as sug…
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
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
102 # state will first {...}
103 #?pugs eval "parse error"
a2694178 »
2009-03-17 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass hal…
104 #?rakudo todo 'will first { ... }'
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
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
b4ea1c22 »
2008-07-16 [spec] clean up :todo that's now handled by a fudge
115 is $b, 44, 'state will first {...} works';
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
116 }
117
118 # 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…
119 #?rakudo skip 'references'
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
120 {
121 my $gen = {
122 state $svar = 42;
123 \$svar;
124 };
125
126 my $svar_ref = $gen();
127 $$svar_ref++; $$svar_ref++;
128
ed95f2ab »
2009-03-07 [t/spec] more small improvements (STD++, TimToady++)
129 $svar_ref = $gen();
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
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'
a2694178 »
2009-03-17 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass hal…
137 #?rakudo skip 'references and anonymous state vars'
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
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
ed95f2ab »
2009-03-07 [t/spec] more small improvements (STD++, TimToady++)
146 $svar_ref = $gen(); # $svar == 2
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
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
956af61b »
2008-07-24 remove accidental non-breakable spaces
160 $a = $gen(); # $svar == 42
161 $a(); $a(); # $svar == 44
162 $b = $gen()(); # $svar == 42
163 is $b, 42, "state() and parens"; # svar == 43
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
164 }
165
166 # state() inside regular expressions
a2694178 »
2009-03-17 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass hal…
167 #?rakudo skip 'embedded closures in regexen'
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
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;
a2694178 »
2009-03-17 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass hal…
189 $svar++;
190 $svar2--;
191 return (+$svar, +$svar2);
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
192 };
193
6d9b707c »
2009-03-17 [t/spec] don't rely on exact .perl value
194 is(step().join('|'), "43|41", "chained state (#1)");
195 is(step().join('|'), "44|40", "chained state (#2)");
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
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
1b4a67a7 »
2009-03-17 [t/spec] State/cloned closure interaction tests; based of bug report …
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
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
221 # recursive state with list assignment initialization happens only first time
222 {
223 my $seensize;
a2694178 »
2009-03-17 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass hal…
224 my sub fib (Int $n) {
225 state @seen = 0,1,1;
226 $seensize = +@seen;
227 @seen[$n] //= fib($n-1) + fib($n-2);
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
228 }
fc37ee65 »
2009-03-17 [t/spec] Unfudge various tests relating to //=, ||= and &&= for Rakudo.
229 is fib(10), 55, "fib 10 works";
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
230 is $seensize, 11, "list assignment state in fib memoizes";
231 }
232
233 # 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…
234 #?rakudo skip '@$foo syntax'
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
235 {
236 my $seensize;
a2694178 »
2009-03-17 [t/spec] Fudge state.t for forthcoming Rakudo commit; we can pass hal…
237 my sub fib (Int $n) {
238 state $seen = [0,1,1];
239 $seensize = +@$seen;
240 $seen[$n] //= fib($n-1) + fib($n-2);
207179b2 »
2008-07-15 [gsoc_spectest] moved state.t into spec/ and cleaned a smartlink
241 }
242 is fib(10), 55, "fib 2 works";
243 is $seensize, 11, "[list] assignment state in fib memoizes";
244 }
Something went wrong with that request. Please try again.