Commit | Line | Data |
---|---|---|
952306ac RGS |
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 RGS |
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 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 | } |