Commit | Line | Data |
952306ac |
1 | #!./perl -w |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
5 | @INC = '../lib'; |
6 | require './test.pl'; |
7 | } |
8 | |
9 | use strict; |
712d05cf |
10 | use feature "state"; |
952306ac |
11 | |
5d1e1362 |
12 | plan tests => 23; |
952306ac |
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' ); |
5d1e1362 |
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 | } |