Small optimisations, by Brandon Black
[p5sagit/p5-mst-13.2.git] / t / op / state.t
1 #!./perl -w
2 # tests state variables
3
4 BEGIN {
5     chdir 't' if -d 't';
6     @INC = '../lib';
7     require './test.pl';
8 }
9
10 use strict;
11 use feature "state";
12
13 plan tests => 46;
14
15 ok( ! defined state $uninit, q(state vars are undef by default) );
16
17 # basic functionality
18
19 sub stateful {
20     state $x;
21     state $y = 1;
22     my $z = 2;
23     state ($t) = 3;
24     return ($x++, $y++, $z++, $t++);
25 }
26
27 my ($x, $y, $z, $t) = stateful();
28 is( $x, 0, 'uninitialized state var' );
29 is( $y, 1, 'initialized state var' );
30 is( $z, 2, 'lexical' );
31 is( $t, 3, 'initialized state var, list syntax' );
32
33 ($x, $y, $z, $t) = stateful();
34 is( $x, 1, 'incremented state var' );
35 is( $y, 2, 'incremented state var' );
36 is( $z, 2, 'reinitialized lexical' );
37 is( $t, 4, 'incremented state var, list syntax' );
38
39 ($x, $y, $z, $t) = stateful();
40 is( $x, 2, 'incremented state var' );
41 is( $y, 3, 'incremented state var' );
42 is( $z, 2, 'reinitialized lexical' );
43 is( $t, 5, 'incremented state var, list syntax' );
44
45 # in a nested block
46
47 sub nesting {
48     state $foo = 10;
49     my $t;
50     { state $bar = 12; $t = ++$bar }
51     ++$foo;
52     return ($foo, $t);
53 }
54
55 ($x, $y) = nesting();
56 is( $x, 11, 'outer state var' );
57 is( $y, 13, 'inner state var' );
58
59 ($x, $y) = nesting();
60 is( $x, 12, 'outer state var' );
61 is( $y, 14, 'inner state var' );
62
63 # in a closure
64
65 sub generator {
66     my $outer;
67     # we use $outer to generate a closure
68     sub { ++$outer; ++state $x }
69 }
70
71 my $f1 = generator();
72 is( $f1->(), 1, 'generator 1' );
73 is( $f1->(), 2, 'generator 1' );
74 my $f2 = generator();
75 is( $f2->(), 1, 'generator 2' );
76 is( $f1->(), 3, 'generator 1 again' );
77 is( $f2->(), 2, 'generator 2 once more' );
78
79 # with ties
80 {
81     package countfetches;
82     our $fetchcount = 0;
83     sub TIESCALAR {bless {}};
84     sub FETCH { ++$fetchcount; 18 };
85     tie my $y, "countfetches";
86     sub foo { state $x = $y; $x++ }
87     ::is( foo(), 18, "initialisation with tied variable" );
88     ::is( foo(), 19, "increments correctly" );
89     ::is( foo(), 20, "increments correctly, twice" );
90     ::is( $fetchcount, 1, "fetch only called once" );
91 }
92
93 # state variables are shared among closures
94
95 sub gen_cashier {
96     my $amount = shift;
97     state $cash_in_store = 0;
98     return {
99         add => sub { $cash_in_store += $amount },
100         del => sub { $cash_in_store -= $amount },
101         bal => sub { $cash_in_store },
102     };
103 }
104
105 gen_cashier(59)->{add}->();
106 gen_cashier(17)->{del}->();
107 is( gen_cashier()->{bal}->(), 42, '$42 in my drawer' );
108
109 # stateless assignment to a state variable
110
111 sub stateless {
112     no warnings 'misc';
113     (state $reinitme, my $foo) = (42, 'bar');
114     ++$reinitme;
115 }
116 is( stateless(), 43, 'stateless function, first time' );
117 is( stateless(), 43, 'stateless function, second time' );
118
119 # array state vars
120
121 sub stateful_array {
122     state @x;
123     push @x, 'x';
124     return $#x;
125 }
126
127 my $xsize = stateful_array();
128 is( $xsize, 0, 'uninitialized state array' );
129
130 $xsize = stateful_array();
131 is( $xsize, 1, 'uninitialized state array after one iteration' );
132
133 sub stateful_array_init {
134     state @x = (1, 2);
135     push @x, 'x';
136     return $#x;
137 }
138
139 $xsize = stateful_array_init();
140 is( $xsize, 2, 'initialized state array' );
141
142 $xsize = stateful_array_init();
143 is( $xsize, 3, 'initialized state array after one iteration' );
144
145 # hash state vars
146
147 sub stateful_hash {
148     state %hx;
149     return $hx{foo}++;
150 }
151
152 my $xhval = stateful_hash();
153 is( $xhval, 0, 'uninitialized state hash' );
154
155 $xhval = stateful_hash();
156 is( $xhval, 1, 'uninitialized state hash after one iteration' );
157
158 sub stateful_hash_init {
159     state %hx = (foo => 10);
160     return $hx{foo}++;
161 }
162
163 $xhval = stateful_hash_init();
164 is( $xhval, 10, 'initialized state hash' );
165
166 $xhval = stateful_hash_init();
167 is( $xhval, 11, 'initialized state hash after one iteration' );
168
169 # state declaration with a list
170
171 sub statelist {
172     # note that this should be a state assignment, while (state $lager, state $stout) shouldn't
173     state($lager, $stout) = (11, 22);
174     $lager++;
175     $stout++;
176     "$lager/$stout";
177 }
178
179 my $ls = statelist();
180 is($ls, "12/23", 'list assignment to state scalars');
181 $ls = statelist();
182 is($ls, "13/24", 'list assignment to state scalars');
183
184 sub statelist2 {
185     state($sherry, $bourbon) = (1 .. 2);
186     $sherry++;
187     $bourbon++;
188     "$sherry/$bourbon";
189 }
190
191 $ls = statelist2();
192 is($ls, "2/3", 'list assignment to state scalars');
193 $ls = statelist2();
194 is($ls, "3/4", 'list assignment to state scalars');
195
196 # Recursion
197
198 sub noseworth {
199     my $level = shift;
200     state $recursed_state = 123;
201     is($recursed_state, 123, "state kept through recursion ($level)");
202     noseworth($level - 1) if $level;
203 }
204 noseworth(2);
205
206 # Assignment return value
207
208 sub pugnax { my $x = state $y = 42; $y++; $x; }
209
210 is( pugnax(), 42, 'scalar state assignment return value' );
211 is( pugnax(), 43, 'scalar state assignment return value' );