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' );