t/op/state.t

   1 #!./perl -w
   2 # tests state variables
   3
   4 BEGIN {
   5     chdir 't' if -d 't';
   6     @INC = '../lib';
   7     require './test.pl';
   8 }
   9
  10 use strict;
  11 use feature "state";
  12
  13 plan tests => 34;
  14
  15 ok( ! defined state $uninit, q(state vars are undef by default) );
  16
  17 # basic functionality
  18
  19 sub stateful {
  20     state $x;
  21     state $y = 1;
  22     my $z = 2;
  23     return ($x++, $y++, $z++);
  24 }
  25
  26 my ($x, $y, $z) = stateful();
  27 is( $x, 0, 'uninitialized state var' );
  28 is( $y, 1, 'initialized state var' );
  29 is( $z, 2, 'lexical' );
  30
  31 ($x, $y, $z) = stateful();
  32 is( $x, 1, 'incremented state var' );
  33 is( $y, 2, 'incremented state var' );
  34 is( $z, 2, 'reinitialized lexical' );
  35
  36 ($x, $y, $z) = stateful();
  37 is( $x, 2, 'incremented state var' );
  38 is( $y, 3, 'incremented state var' );
  39 is( $z, 2, 'reinitialized lexical' );
  40
  41 # in a nested block
  42
  43 sub nesting {
  44     state $foo = 10;
  45     my $t;
  46     { state $bar = 12; $t = ++$bar }
  47     ++$foo;
  48     return ($foo, $t);
  49 }
  50
  51 ($x, $y) = nesting();
  52 is( $x, 11, 'outer state var' );
  53 is( $y, 13, 'inner state var' );
  54
  55 ($x, $y) = nesting();
  56 is( $x, 12, 'outer state var' );
  57 is( $y, 14, 'inner state var' );
  58
  59 # in a closure
  60
  61 sub generator {
  62     my $outer;
  63     # we use $outer to generate a closure
  64     sub { ++$outer; ++state $x }
  65 }
  66
  67 my $f1 = generator();
  68 is( $f1->(), 1, 'generator 1' );
  69 is( $f1->(), 2, 'generator 1' );
  70 my $f2 = generator();
  71 is( $f2->(), 1, 'generator 2' );
  72 is( $f1->(), 3, 'generator 1 again' );
  73 is( $f2->(), 2, 'generator 2 once more' );
  74
  75 # with ties
  76 {
  77     package countfetches;
  78     our $fetchcount = 0;
  79     sub TIESCALAR {bless {}};
  80     sub FETCH { ++$fetchcount; 18 };
  81     tie my $y, "countfetches";
  82     sub foo { state $x = $y; $x++ }
  83     ::is( foo(), 18, "initialisation with tied variable" );
  84     ::is( foo(), 19, "increments correctly" );
  85     ::is( foo(), 20, "increments correctly, twice" );
  86     ::is( $fetchcount, 1, "fetch only called once" );
  87 }
  88
  89 # state variables are shared among closures
  90
  91 sub gen_cashier {
  92     my $amount = shift;
  93     state $cash_in_store = 0;
  94     return {
  95         add => sub { $cash_in_store += $amount },
  96         del => sub { $cash_in_store -= $amount },
  97         bal => sub { $cash_in_store },
  98     };
  99 }
 100
 101 gen_cashier(59)->{add}->();
 102 gen_cashier(17)->{del}->();
 103 is( gen_cashier()->{bal}->(), 42, '$42 in my drawer' );
 104
 105 # stateless assignment to a state variable
 106
 107 sub stateless {
 108     no warnings 'misc';
 109     (state $reinitme, my $foo) = (42, 'bar');
 110     ++$reinitme;
 111 }
 112 is( stateless(), 43, 'stateless function, first time' );
 113 is( stateless(), 43, 'stateless function, second time' );
 114
 115 # array state vars
 116
 117 sub stateful_array {
 118     state @x;
 119     push @x, 'x';
 120     return $#x;
 121 }
 122
 123 my $xsize = stateful_array();
 124 is( $xsize, 0, 'uninitialized state array' );
 125
 126 $xsize = stateful_array();
 127 is( $xsize, 1, 'uninitialized state array after one iteration' );
 128
 129 # hash state vars
 130
 131 sub stateful_hash {
 132     state %hx;
 133     return $hx{foo}++;
 134 }
 135
 136 my $xhval = stateful_hash();
 137 is( $xhval, 0, 'uninitialized state hash' );
 138
 139 $xhval = stateful_hash();
 140 is( $xhval, 1, 'uninitialized state hash after one iteration' );
 141
 142 # state declaration with a list
 143
 144 sub statelist {
 145     # note that this should be a state assignment, while (state $lager, state $stout) shouldn't
 146     state($lager, $stout) = (11, 22);
 147     $lager++;
 148     $stout++;
 149     "$lager/$stout";
 150 }
 151
 152 my $ls = statelist();
 153 is($ls, "12/23", 'list assignment to state scalars');
 154 $ls = statelist();
 155 is($ls, "13/24", 'list assignment to state scalars');
 156
 157 sub statelist2 {
 158     state($sherry, $bourbon) = (1 .. 2);
 159     $sherry++;
 160     $bourbon++;
 161     "$sherry/$bourbon";
 162 }
 163
 164 $ls = statelist2();
 165 is($ls, "2/3", 'list assignment to state scalars');
 166 $ls = statelist2();
 167 is($ls, "3/4", 'list assignment to state scalars');