This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
state $foo if 0 shouldn't warn. Spotted by Abigail.
[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
c5917253 13plan tests => 38;
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;
c5917253 21 state $y = 1;
952306ac 22 my $z = 2;
b708784e 23 state ($t) //= 3;
84f64f45 24 return ($x++, $y++, $z++, $t++);
952306ac
RGS
25}
26
84f64f45 27my ($x, $y, $z, $t) = stateful();
952306ac
RGS
28is( $x, 0, 'uninitialized state var' );
29is( $y, 1, 'initialized state var' );
30is( $z, 2, 'lexical' );
84f64f45 31is( $t, 3, 'initialized state var, list syntax' );
952306ac 32
84f64f45 33($x, $y, $z, $t) = stateful();
952306ac
RGS
34is( $x, 1, 'incremented state var' );
35is( $y, 2, 'incremented state var' );
36is( $z, 2, 'reinitialized lexical' );
84f64f45 37is( $t, 4, 'incremented state var, list syntax' );
952306ac 38
84f64f45 39($x, $y, $z, $t) = stateful();
952306ac
RGS
40is( $x, 2, 'incremented state var' );
41is( $y, 3, 'incremented state var' );
42is( $z, 2, 'reinitialized lexical' );
84f64f45 43is( $t, 5, 'incremented state var, list syntax' );
952306ac 44
ea84231e
RGS
45# in a nested block
46
952306ac 47sub nesting {
c5917253 48 state $foo = 10;
952306ac 49 my $t;
c5917253 50 { state $bar = 12; $t = ++$bar }
952306ac
RGS
51 ++$foo;
52 return ($foo, $t);
53}
54
55($x, $y) = nesting();
56is( $x, 11, 'outer state var' );
57is( $y, 13, 'inner state var' );
58
59($x, $y) = nesting();
60is( $x, 12, 'outer state var' );
61is( $y, 14, 'inner state var' );
62
ea84231e
RGS
63# in a closure
64
952306ac
RGS
65sub generator {
66 my $outer;
67 # we use $outer to generate a closure
68 sub { ++$outer; ++state $x }
69}
70
71my $f1 = generator();
72is( $f1->(), 1, 'generator 1' );
73is( $f1->(), 2, 'generator 1' );
74my $f2 = generator();
75is( $f2->(), 1, 'generator 2' );
76is( $f1->(), 3, 'generator 1 again' );
77is( $f2->(), 2, 'generator 2 once more' );
5d1e1362 78
ea84231e 79# with ties
5d1e1362
RGS
80{
81 package countfetches;
82 our $fetchcount = 0;
83 sub TIESCALAR {bless {}};
84 sub FETCH { ++$fetchcount; 18 };
85 tie my $y, "countfetches";
c5917253 86 sub foo { state $x = $y; $x++ }
5d1e1362
RGS
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}
aa2c6373 92
ea84231e
RGS
93# state variables are shared among closures
94
95sub gen_cashier {
96 my $amount = shift;
c5917253 97 state $cash_in_store = 0;
ea84231e
RGS
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
105gen_cashier(59)->{add}->();
106gen_cashier(17)->{del}->();
107is( gen_cashier()->{bal}->(), 42, '$42 in my drawer' );
108
109# stateless assignment to a state variable
110
aa2c6373 111sub stateless {
b708784e 112 state $reinitme = 42;
aa2c6373
RGS
113 ++$reinitme;
114}
115is( stateless(), 43, 'stateless function, first time' );
c5917253 116is( stateless(), 44, 'stateless function, second time' );
a5911867
RGS
117
118# array state vars
119
120sub stateful_array {
121 state @x;
122 push @x, 'x';
123 return $#x;
124}
125
126my $xsize = stateful_array();
127is( $xsize, 0, 'uninitialized state array' );
128
129$xsize = stateful_array();
130is( $xsize, 1, 'uninitialized state array after one iteration' );
131
132# hash state vars
133
134sub stateful_hash {
135 state %hx;
136 return $hx{foo}++;
137}
138
139my $xhval = stateful_hash();
140is( $xhval, 0, 'uninitialized state hash' );
141
142$xhval = stateful_hash();
143is( $xhval, 1, 'uninitialized state hash after one iteration' );
a53dbfbb 144
fda94784
RGS
145# Recursion
146
147sub noseworth {
148 my $level = shift;
149 state $recursed_state = 123;
150 is($recursed_state, 123, "state kept through recursion ($level)");
151 noseworth($level - 1) if $level;
152}
153noseworth(2);
84f64f45
RGS
154
155# Assignment return value
156
157sub pugnax { my $x = state $y = 42; $y++; $x; }
158
159is( pugnax(), 42, 'scalar state assignment return value' );
c5917253 160is( pugnax(), 43, 'scalar state assignment return value' );