Commit | Line | Data |
9b0c7426 |
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/ |
a4f4e906 |
44 | ok( $x =~ /n/, qq{"next" matches /n/} ); |
9b0c7426 |
45 | is( index( $x, 'n' ), 0, qq{"next" contains "n" at pos 0} ); |
46 | |
47 | # The letter "t" is in both, but in different positions |
bd473224 |
48 | ok( $x =~ /t/, qq{"next" matches /t/} ); |
49 | is( index( $x, 't' ), 3, qq{"next" contains "t" at pos 3} ); |
9b0c7426 |
50 | } |