1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
|
#!./perl -w
# tests state variables
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
require './test.pl';
}
use strict;
use feature "state";
plan tests => 37;
ok( ! defined state $uninit, q(state vars are undef by default) );
# basic functionality
sub stateful {
state $x;
state $y //= 1;
my $z = 2;
state ($t) //= 3;
return ($x++, $y++, $z++, $t++);
}
my ($x, $y, $z, $t) = stateful();
is( $x, 0, 'uninitialized state var' );
is( $y, 1, 'initialized state var' );
is( $z, 2, 'lexical' );
is( $t, 3, 'initialized state var, list syntax' );
($x, $y, $z, $t) = stateful();
is( $x, 1, 'incremented state var' );
is( $y, 2, 'incremented state var' );
is( $z, 2, 'reinitialized lexical' );
is( $t, 4, 'incremented state var, list syntax' );
($x, $y, $z, $t) = stateful();
is( $x, 2, 'incremented state var' );
is( $y, 3, 'incremented state var' );
is( $z, 2, 'reinitialized lexical' );
is( $t, 5, 'incremented state var, list syntax' );
# in a nested block
sub nesting {
state $foo //= 10;
my $t;
{ state $bar //= 12; $t = ++$bar }
++$foo;
return ($foo, $t);
}
($x, $y) = nesting();
is( $x, 11, 'outer state var' );
is( $y, 13, 'inner state var' );
($x, $y) = nesting();
is( $x, 12, 'outer state var' );
is( $y, 14, 'inner state var' );
# in a closure
sub generator {
my $outer;
# we use $outer to generate a closure
sub { ++$outer; ++state $x }
}
my $f1 = generator();
is( $f1->(), 1, 'generator 1' );
is( $f1->(), 2, 'generator 1' );
my $f2 = generator();
is( $f2->(), 1, 'generator 2' );
is( $f1->(), 3, 'generator 1 again' );
is( $f2->(), 2, 'generator 2 once more' );
# with ties
{
package countfetches;
our $fetchcount = 0;
sub TIESCALAR {bless {}};
sub FETCH { ++$fetchcount; 18 };
tie my $y, "countfetches";
sub foo { state $x //= $y; $x++ }
::is( foo(), 18, "initialisation with tied variable" );
::is( foo(), 19, "increments correctly" );
::is( foo(), 20, "increments correctly, twice" );
::is( $fetchcount, 1, "fetch only called once" );
}
# state variables are shared among closures
sub gen_cashier {
my $amount = shift;
state $cash_in_store;
return {
add => sub { $cash_in_store += $amount },
del => sub { $cash_in_store -= $amount },
bal => sub { $cash_in_store },
};
}
gen_cashier(59)->{add}->();
gen_cashier(17)->{del}->();
is( gen_cashier()->{bal}->(), 42, '$42 in my drawer' );
# stateless assignment to a state variable
sub stateless {
state $reinitme = 42;
++$reinitme;
}
is( stateless(), 43, 'stateless function, first time' );
is( stateless(), 43, 'stateless function, second time' );
# array state vars
sub stateful_array {
state @x;
push @x, 'x';
return $#x;
}
my $xsize = stateful_array();
is( $xsize, 0, 'uninitialized state array' );
$xsize = stateful_array();
is( $xsize, 1, 'uninitialized state array after one iteration' );
# hash state vars
sub stateful_hash {
state %hx;
return $hx{foo}++;
}
my $xhval = stateful_hash();
is( $xhval, 0, 'uninitialized state hash' );
$xhval = stateful_hash();
is( $xhval, 1, 'uninitialized state hash after one iteration' );
# Recursion
sub noseworth {
my $level = shift;
state $recursed_state = 123;
is($recursed_state, 123, "state kept through recursion ($level)");
noseworth($level - 1) if $level;
}
noseworth(2);
# Assignment return value
sub pugnax { my $x = state $y = 42; $y++; $x; }
is( pugnax(), 42, 'scalar state assignment return value' );
|
