2a78c8c2e24a34c97308aaaea88907a2e823f071
[perl.git] / 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     TODO: {
45         local $TODO = $do_study ? 'not yet fixed' : 0;
46         ok( $x =~ /n/,              qq{"next" matches /n/} );
47     }
48     is( index( $x, 'n' ), 0,    qq{"next" contains "n" at pos 0} );
49
50     # The letter "t" is in both, but in different positions
51     TODO: {
52         local $TODO = $do_study ? 'not yet fixed' : 0;
53         ok( $x =~ /t/,              qq{"next" matches /t/} );
54     }
55     is( index( $x, 't' ), 3,    qq{"next" contains "t" at pos 3} );
56 }