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
1 #!./perl -w
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6     require './test.pl';
7 }
8
9 use strict;
10 use feature "state";
11
12 plan tests => 25;
13
14 ok( ! defined state $uninit, q(state vars are undef by default) );
15
16 sub stateful {
17     state $x;
18     state $y = 1;
19     my $z = 2;
20     return ($x++, $y++, $z++);
21 }
22
23 my ($x, $y, $z) = stateful();
24 is( $x, 0, 'uninitialized state var' );
25 is( $y, 1, 'initialized state var' );
26 is( $z, 2, 'lexical' );
27
28 ($x, $y, $z) = stateful();
29 is( $x, 1, 'incremented state var' );
30 is( $y, 2, 'incremented state var' );
31 is( $z, 2, 'reinitialized lexical' );
32
33 ($x, $y, $z) = stateful();
34 is( $x, 2, 'incremented state var' );
35 is( $y, 3, 'incremented state var' );
36 is( $z, 2, 'reinitialized lexical' );
37
38 sub 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();
47 is( $x, 11, 'outer state var' );
48 is( $y, 13, 'inner state var' );
49
50 ($x, $y) = nesting();
51 is( $x, 12, 'outer state var' );
52 is( $y, 14, 'inner state var' );
53
54 sub generator {
55     my $outer;
56     # we use $outer to generate a closure
57     sub { ++$outer; ++state $x }
58 }
59
60 my $f1 = generator();
61 is( $f1->(), 1, 'generator 1' );
62 is( $f1->(), 2, 'generator 1' );
63 my $f2 = generator();
64 is( $f2->(), 1, 'generator 2' );
65 is( $f1->(), 3, 'generator 1 again' );
66 is( $f2->(), 2, 'generator 2 once more' );
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 }
80
81 sub stateless {
82     # stateless assignment
83     (state $reinitme) = 42;
84     ++$reinitme;
85 }
86 is( stateless(), 43, 'stateless function, first time' );
87 is( stateless(), 43, 'stateless function, second time' );