1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 @INC = '../lib'; 6 require './test.pl'; 7} 8 9use strict; 10use warnings; 11 12plan 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 26for my $do_study qw( 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} 52