t/op/studytied.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6 }
   7
   8 use strict;
   9 use warnings;
  10
  11 use Test::More tests => 14;
  12
  13 {
  14     package J;
  15     my $c = 0;
  16     sub reset { $c = 0 }
  17     sub TIESCALAR { bless [] }
  18     sub FETCH { $c++ ? "next" : "first" }
  19 }
  20
  21 # This test makes sure that we can't pull a fast one on study().  If we
  22 # study() a tied variable, perl should know that the studying isn't
  23 # valid on subsequent references, and should account for it.
  24
  25 for my $do_study qw( 0 1 ) {
  26     J::reset();
  27     my $x;
  28     tie $x, "J";
  29
  30     if ($do_study) {
  31         study $x;
  32         pass( "Studying..." );
  33     } else {
  34         my $first_fetch = $x;
  35         pass( "Not studying..." );
  36     }
  37
  38     # When it was studied (or first_fetched), $x was "first", but is now "next", so
  39     # should not match /f/.
  40     ok( $x !~ /f/,              qq{"next" doesn't match /f/} );
  41     is( index( $x, 'f' ), -1,   qq{"next" doesn't contain "f"} );
  42
  43     # Subsequent references to $x are "next", so should match /n/
  44     ok( $x =~ /n/,              qq{"next" matches /n/} );
  45     is( index( $x, 'n' ), 0,    qq{"next" contains "n" at pos 0} );
  46
  47     # The letter "t" is in both, but in different positions
  48     ok( $x =~ /t/,              qq{"next" matches /t/} );
  49     is( index( $x, 't' ), 3,    qq{"next" contains "t" at pos 3} );
  50 }