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