t/lib/io_linenum.t

   1 #!./perl
   2
   3 # test added 29th April 1998 by Paul Johnson (pjcj@transeda.com)
   4
   5 BEGIN {
   6     chdir 't' if -d 't';
   7     unshift @INC, '../lib' if -d '../lib';
   8 }
   9
  10 use strict;
  11 use IO::File;
  12 use Test;
  13
  14 BEGIN { plan tests => 10, todo => [10] }
  15
  16 sub lineno
  17 {
  18   my ($f) = @_;
  19   my $l;
  20   $l .= "$. ";
  21   $l .= $f->input_line_number;
  22   $l .= " $.";
  23   $l;
  24 }
  25
  26 sub OK
  27 {
  28   my $s = select STDOUT;                     # work around a bug in Test.pm 1.04
  29   &ok;
  30   select $s;
  31 }
  32
  33 my $t;
  34
  35 open (Q, __FILE__) or die $!;
  36 my $w = IO::File->new(__FILE__) or die $!;
  37
  38 <Q> for (1 .. 10);
  39 OK(lineno($w), "10 0 10");
  40
  41 $w->getline for (1 .. 5);
  42 OK(lineno($w), "5 5 5");
  43
  44 <Q>;
  45 OK(lineno($w), "11 5 11");
  46
  47 $w->getline;
  48 OK(lineno($w), "6 6 6");
  49
  50 $t = tell Q;         # tell Q; provokes a warning - the world is full of bugs...
  51 OK(lineno($w), "11 6 11");
  52
  53 <Q>;
  54 OK(lineno($w), "12 6 12");
  55
  56 select Q;
  57 OK(lineno($w), "12 6 12");
  58
  59 <Q> for (1 .. 10);
  60 OK(lineno($w), "22 6 22");
  61
  62 $w->getline for (1 .. 5);
  63 OK(lineno($w), "11 11 11");
  64
  65 # This test doesn't work.  It probably won't until local $. does.
  66 $t = tell Q;
  67 OK(lineno($w), "22 11 22", 'waiting for local $.');