t/op/studytied.t

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