Update Time-HiRes Changes for 1.9760
[perl.git] / t / op / studytied.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     require './test.pl';
6     set_up_inc('../lib');
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 }