This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Ensure that C<(state $x) = $y> is not a state assignment
[perl5.git] / t / op / state.t
CommitLineData
952306ac
RGS
1#!./perl -w
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6 require './test.pl';
7}
8
9use strict;
712d05cf 10use feature "state";
952306ac 11
aa2c6373 12plan tests => 25;
952306ac
RGS
13
14ok( ! defined state $uninit, q(state vars are undef by default) );
15
16sub stateful {
17 state $x;
18 state $y = 1;
19 my $z = 2;
20 return ($x++, $y++, $z++);
21}
22
23my ($x, $y, $z) = stateful();
24is( $x, 0, 'uninitialized state var' );
25is( $y, 1, 'initialized state var' );
26is( $z, 2, 'lexical' );
27
28($x, $y, $z) = stateful();
29is( $x, 1, 'incremented state var' );
30is( $y, 2, 'incremented state var' );
31is( $z, 2, 'reinitialized lexical' );
32
33($x, $y, $z) = stateful();
34is( $x, 2, 'incremented state var' );
35is( $y, 3, 'incremented state var' );
36is( $z, 2, 'reinitialized lexical' );
37
38sub nesting {
39 state $foo = 10;
40 my $t;
41 { state $bar = 12; $t = ++$bar }
42 ++$foo;
43 return ($foo, $t);
44}
45
46($x, $y) = nesting();
47is( $x, 11, 'outer state var' );
48is( $y, 13, 'inner state var' );
49
50($x, $y) = nesting();
51is( $x, 12, 'outer state var' );
52is( $y, 14, 'inner state var' );
53
54sub generator {
55 my $outer;
56 # we use $outer to generate a closure
57 sub { ++$outer; ++state $x }
58}
59
60my $f1 = generator();
61is( $f1->(), 1, 'generator 1' );
62is( $f1->(), 2, 'generator 1' );
63my $f2 = generator();
64is( $f2->(), 1, 'generator 2' );
65is( $f1->(), 3, 'generator 1 again' );
66is( $f2->(), 2, 'generator 2 once more' );
5d1e1362
RGS
67
68{
69 package countfetches;
70 our $fetchcount = 0;
71 sub TIESCALAR {bless {}};
72 sub FETCH { ++$fetchcount; 18 };
73 tie my $y, "countfetches";
74 sub foo { state $x = $y; $x++ }
75 ::is( foo(), 18, "initialisation with tied variable" );
76 ::is( foo(), 19, "increments correctly" );
77 ::is( foo(), 20, "increments correctly, twice" );
78 ::is( $fetchcount, 1, "fetch only called once" );
79}
aa2c6373
RGS
80
81sub stateless {
82 # stateless assignment
83 (state $reinitme) = 42;
84 ++$reinitme;
85}
86is( stateless(), 43, 'stateless function, first time' );
87is( stateless(), 43, 'stateless function, second time' );