Commit | Line | Data |
---|---|---|
9b0c7426 RGS |
1 | #!./perl |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
0214bff6 | 6 | require './test.pl'; |
9b0c7426 RGS |
7 | } |
8 | ||
9 | use strict; | |
10 | use warnings; | |
11 | ||
0214bff6 | 12 | plan tests => 14; |
9b0c7426 RGS |
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 | ||
ea25a9b2 | 26 | for my $do_study (0,1) { |
9b0c7426 RGS |
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/ | |
a4f4e906 | 45 | ok( $x =~ /n/, qq{"next" matches /n/} ); |
9b0c7426 RGS |
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 | |
bd473224 NC |
49 | ok( $x =~ /t/, qq{"next" matches /t/} ); |
50 | is( index( $x, 't' ), 3, qq{"next" contains "t" at pos 3} ); | |
9b0c7426 | 51 | } |