t/lib/filehand.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6     require Config; import Config;
   7     if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
   8         print "1..0\n";
   9         exit 0;
  10     }
  11 }
  12
  13 use FileHandle;
  14 use strict subs;
  15
  16 autoflush STDOUT 1;
  17
  18 $mystdout = new_from_fd FileHandle 1,"w";
  19 $| = 1;
  20 autoflush $mystdout;
  21 print "1..11\n";
  22
  23 print $mystdout "ok ",fileno($mystdout),"\n";
  24
  25 $fh = new FileHandle "TEST", O_RDONLY and print "ok 2\n";
  26
  27
  28 $buffer = <$fh>;
  29 print $buffer eq "#!./perl\n" ? "ok 3\n" : "not ok 3\n";
  30
  31
  32 ungetc $fh 65;
  33 CORE::read($fh, $buf,1);
  34 print $buf eq 'A' ? "ok 4\n" : "not ok 4\n";
  35
  36 close $fh;
  37
  38 $fh = new FileHandle;
  39
  40 print "not " unless ($fh->open("< TEST") && <$fh> eq $buffer);
  41 print "ok 5\n";
  42
  43 $fh->seek(0,0);
  44 print "not " unless (<$fh> eq $buffer);
  45 print "ok 6\n";
  46
  47 $fh->seek(0,2);
  48 $line = <$fh>;
  49 print "not " if (defined($line) || !$fh->eof);
  50 print "ok 7\n";
  51
  52 print "not " unless ($fh->open("TEST","r") && !$fh->tell && $fh->close);
  53 print "ok 8\n";
  54
  55 autoflush STDOUT 0;
  56
  57 print "not " if ($|);
  58 print "ok 9\n";
  59
  60 autoflush STDOUT 1;
  61
  62 print "not " unless ($|);
  63 print "ok 10\n";
  64
  65 ($rd,$wr) = FileHandle::pipe;
  66
  67 if ($^O eq 'VMS' || $^O eq 'os2' || $^O eq 'amigaos') {
  68   $wr->autoflush;
  69   $wr->printf("ok %d\n",11);
  70   print $rd->getline;
  71 }
  72 else {
  73   if (fork) {
  74    $wr->close;
  75    print $rd->getline;
  76   }
  77   else {
  78    $rd->close;
  79    $wr->printf("ok %d\n",11);
  80    exit(0);
  81   }
  82 }