lib/FileHandle.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     if ($^O eq 'mpeix') {
  12         print "1..0 # Skip: broken on MPE/iX\n";
  13         exit 0;
  14     }
  15 }
  16
  17 use FileHandle;
  18 use strict subs;
  19
  20 autoflush STDOUT 1;
  21
  22 $mystdout = new_from_fd FileHandle 1,"w";
  23 $| = 1;
  24 autoflush $mystdout;
  25 print "1..11\n";
  26
  27 print $mystdout "ok ".fileno($mystdout)."\n";
  28
  29 $fh = (new FileHandle "./TEST", O_RDONLY
  30        or new FileHandle "TEST", O_RDONLY)
  31   and print "ok 2\n";
  32
  33
  34 $buffer = <$fh>;
  35 print $buffer eq "#!./perl\n" ? "ok 3\n" : "not ok 3\n";
  36
  37
  38 ungetc $fh ord 'A';
  39 CORE::read($fh, $buf,1);
  40 print $buf eq 'A' ? "ok 4\n" : "not ok 4\n";
  41
  42 close $fh;
  43
  44 $fh = new FileHandle;
  45
  46 print "not " unless ($fh->open("< TEST") && <$fh> eq $buffer);
  47 print "ok 5\n";
  48
  49 $fh->seek(0,0);
  50 print "#possible mixed CRLF/LF in t/TEST\nnot " unless (<$fh> eq $buffer);
  51 print "ok 6\n";
  52
  53 $fh->seek(0,2);
  54 $line = <$fh>;
  55 print "not " if (defined($line) || !$fh->eof);
  56 print "ok 7\n";
  57
  58 print "not " unless ($fh->open("TEST","r") && !$fh->tell && $fh->close);
  59 print "ok 8\n";
  60
  61 autoflush STDOUT 0;
  62
  63 print "not " if ($|);
  64 print "ok 9\n";
  65
  66 autoflush STDOUT 1;
  67
  68 print "not " unless ($|);
  69 print "ok 10\n";
  70
  71 if ($^O eq 'dos')
  72 {
  73     printf("ok %d\n",11);
  74     exit(0);
  75 }
  76
  77 ($rd,$wr) = FileHandle::pipe;
  78
  79 if ($^O eq 'VMS' || $^O eq 'os2' || $^O eq 'amigaos' || $^O eq 'MSWin32' || $^O eq 'NetWare' ||
  80     $Config{d_fork} ne 'define') {
  81   $wr->autoflush;
  82   $wr->printf("ok %d\n",11);
  83   print $rd->getline;
  84 }
  85 else {
  86   if (fork) {
  87    $wr->close;
  88    print $rd->getline;
  89   }
  90   else {
  91    $rd->close;
  92    $wr->printf("ok %d\n",11);
  93    exit(0);
  94   }
  95 }