t/io/data.t

   1 #!./perl
   2
   3 # tests for DATA filehandle operations
   4
   5 BEGIN {
   6     chdir 't' if -d 't';
   7     require "./test.pl";
   8     set_up_inc('../lib');
   9 }
  10
  11 $|=1;
  12
  13 # It is important that all these tests are run via fresh_perl because
  14 # that way they get written to disk in text mode and will have CR-LF
  15 # line endings on Windows.  Otherwise the failures related to Perl
  16 # code being read in binary mode will not be observed.
  17
  18 run_multiple_progs('', \*DATA);
  19
  20 done_testing();
  21
  22 __END__
  23 # http://rt.perl.org/rt3/Ticket/Display.html?id=28106#txn-82657
  24 while (<DATA>) {
  25     chomp;
  26     print "$.: '$_'\n";
  27     system();
  28 }
  29 __DATA__
  30 1
  31 2
  32 3
  33 EXPECT
  34 1: '1'
  35 2: '2'
  36 3: '3'
  37 ########
  38 # http://rt.perl.org/rt3/Ticket/Display.html?id=28106#txn-83113
  39 my $line1 = <DATA>;
  40 `echo foo`;
  41 my $line2 = <DATA>;
  42 if ($line1 eq "one\n") { print "ok 1\n" } else { print "not ok 1\n" }
  43 if ($line2 eq "two\n") { print "ok 2\n" } else { print "not ok 2\n" }
  44 __DATA__
  45 one
  46 two
  47 EXPECT
  48 ok 1
  49 ok 2
  50 ########
  51 # http://rt.perl.org/rt3/Ticket/Attachment/828796/403048/perlbug.rep.txt
  52 my @data_positions = tell(DATA);
  53 while (<DATA>){
  54     if (/^__DATA__$/) {
  55         push @data_positions, tell(DATA);
  56     }
  57 }
  58
  59 my @fh_positions;
  60 open(my $fh, '<', $0) or die;
  61 while (<$fh>){
  62     if (/^__DATA__$/) {
  63         push @fh_positions, tell($fh);
  64     }
  65 }
  66
  67 print "not " unless "@data_positions" eq "@fh_positions";
  68 print "ok";
  69
  70 __DATA__
  71 ab
  72 __DATA__
  73 ab
  74
  75 __DATA__
  76 ab
  77 __DATA__
  78 lotsa junk
  79 nothing
  80 EXPECT
  81 ok
  82 ########
  83 # Which package is __DATA__ in?
  84 package foo;
  85 BEGIN{*foo::=*bar::}
  86 print <DATA>;
  87 __DATA__
  88 123
  89 EXPECT
  90 123