This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
ExtUtils::Manifest fix-ups for VMS:
[perl5.git] / t / op / state.t
CommitLineData
952306ac 1#!./perl -w
ea84231e 2# tests state variables
952306ac
RGS
3
4BEGIN {
5 chdir 't' if -d 't';
6 @INC = '../lib';
7 require './test.pl';
8}
9
10use strict;
712d05cf 11use feature "state";
952306ac 12
3d2c6be3 13plan tests => 34;
952306ac
RGS
14
15ok( ! defined state $uninit, q(state vars are undef by default) );
16
ea84231e
RGS
17# basic functionality
18
952306ac
RGS
19sub stateful {
20 state $x;
21 state $y = 1;
22 my $z = 2;
23 return ($x++, $y++, $z++);
24}
25
26my ($x, $y, $z) = stateful();
27is( $x, 0, 'uninitialized state var' );
28is( $y, 1, 'initialized state var' );
29is( $z, 2, 'lexical' );
30
31($x, $y, $z) = stateful();
32is( $x, 1, 'incremented state var' );
33is( $y, 2, 'incremented state var' );
34is( $z, 2, 'reinitialized lexical' );
35
36($x, $y, $z) = stateful();
37is( $x, 2, 'incremented state var' );
38is( $y, 3, 'incremented state var' );
39is( $z, 2, 'reinitialized lexical' );
40
ea84231e
RGS
41# in a nested block
42
952306ac
RGS
43sub nesting {
44 state $foo = 10;
45 my $t;
46 { state $bar = 12; $t = ++$bar }
47 ++$foo;
48 return ($foo, $t);
49}
50
51($x, $y) = nesting();
52is( $x, 11, 'outer state var' );
53is( $y, 13, 'inner state var' );
54
55($x, $y) = nesting();
56is( $x, 12, 'outer state var' );
57is( $y, 14, 'inner state var' );
58
ea84231e
RGS
59# in a closure
60
952306ac
RGS
61sub generator {
62 my $outer;
63 # we use $outer to generate a closure
64 sub { ++$outer; ++state $x }
65}
66
67my $f1 = generator();
68is( $f1->(), 1, 'generator 1' );
69is( $f1->(), 2, 'generator 1' );
70my $f2 = generator();
71is( $f2->(), 1, 'generator 2' );
72is( $f1->(), 3, 'generator 1 again' );
73is( $f2->(), 2, 'generator 2 once more' );
5d1e1362 74
ea84231e 75# with ties
5d1e1362
RGS
76{
77 package countfetches;
78 our $fetchcount = 0;
79 sub TIESCALAR {bless {}};
80 sub FETCH { ++$fetchcount; 18 };
81 tie my $y, "countfetches";
82 sub foo { state $x = $y; $x++ }
83 ::is( foo(), 18, "initialisation with tied variable" );
84 ::is( foo(), 19, "increments correctly" );
85 ::is( foo(), 20, "increments correctly, twice" );
86 ::is( $fetchcount, 1, "fetch only called once" );
87}
aa2c6373 88
ea84231e
RGS
89# state variables are shared among closures
90
91sub gen_cashier {
92 my $amount = shift;
93 state $cash_in_store = 0;
94 return {
95 add => sub { $cash_in_store += $amount },
96 del => sub { $cash_in_store -= $amount },
97 bal => sub { $cash_in_store },
98 };
99}
100
101gen_cashier(59)->{add}->();
102gen_cashier(17)->{del}->();
103is( gen_cashier()->{bal}->(), 42, '$42 in my drawer' );
104
105# stateless assignment to a state variable
106
aa2c6373 107sub stateless {
3d2c6be3 108 no warnings 'misc';
461824dc 109 (state $reinitme, my $foo) = (42, 'bar');
aa2c6373
RGS
110 ++$reinitme;
111}
112is( stateless(), 43, 'stateless function, first time' );
113is( stateless(), 43, 'stateless function, second time' );
a5911867
RGS
114
115# array state vars
116
117sub stateful_array {
118 state @x;
119 push @x, 'x';
120 return $#x;
121}
122
123my $xsize = stateful_array();
124is( $xsize, 0, 'uninitialized state array' );
125
126$xsize = stateful_array();
127is( $xsize, 1, 'uninitialized state array after one iteration' );
128
129# hash state vars
130
131sub stateful_hash {
132 state %hx;
133 return $hx{foo}++;
134}
135
136my $xhval = stateful_hash();
137is( $xhval, 0, 'uninitialized state hash' );
138
139$xhval = stateful_hash();
140is( $xhval, 1, 'uninitialized state hash after one iteration' );
a53dbfbb
RGS
141
142# state declaration with a list
143
144sub statelist {
145 # note that this should be a state assignment, while (state $lager, state $stout) shouldn't
146 state($lager, $stout) = (11, 22);
147 $lager++;
148 $stout++;
149 "$lager/$stout";
150}
151
152my $ls = statelist();
153is($ls, "12/23", 'list assignment to state scalars');
154$ls = statelist();
461824dc 155is($ls, "13/24", 'list assignment to state scalars');
3d2c6be3
RGS
156
157sub statelist2 {
158 state($sherry, $bourbon) = (1 .. 2);
159 $sherry++;
160 $bourbon++;
161 "$sherry/$bourbon";
162}
163
164$ls = statelist2();
165is($ls, "2/3", 'list assignment to state scalars');
166$ls = statelist2();
3d2c6be3 167is($ls, "3/4", 'list assignment to state scalars');