This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
t/op/lc.t: Fix bareword warning
[perl5.git] / t / op / studytied.t
CommitLineData
9b0c7426
RGS
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
0214bff6 5 require './test.pl';
624c42e2 6 set_up_inc('../lib');
9b0c7426
RGS
7}
8
9use strict;
10use warnings;
11
0214bff6 12plan 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 26for 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}