This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Mark some new study tests as TODO
[perl5.git] / t / op / studytied.t
CommitLineData
9b0c7426
RGS
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6}
7
8use strict;
9use warnings;
10
11use 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
25for 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/
db95ebb4
RGS
44 TODO: {
45 local $TODO = $do_study ? 'not yet fixed' : 0;
46 ok( $x =~ /n/, qq{"next" matches /n/} );
47 }
9b0c7426
RGS
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
db95ebb4
RGS
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} );
9b0c7426 56}