contrib/perl5/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
  26        or new FileHandle "TEST", O_RDONLY)
  27   and print "ok 2\n";
  28
  29
  30 $buffer = <$fh>;
  31 print $buffer eq "#!./perl\n" ? "ok 3\n" : "not ok 3\n";
  32
  33
  34 ungetc $fh ord 'A';
  35 CORE::read($fh, $buf,1);
  36 print $buf eq 'A' ? "ok 4\n" : "not ok 4\n";
  37
  38 close $fh;
  39
  40 $fh = new FileHandle;
  41
  42 print "not " unless ($fh->open("< TEST") && <$fh> eq $buffer);
  43 print "ok 5\n";
  44
  45 $fh->seek(0,0);
  46 print "#possible mixed CRLF/LF in t/TEST\nnot " unless (<$fh> eq $buffer);
  47 print "ok 6\n";
  48
  49 $fh->seek(0,2);
  50 $line = <$fh>;
  51 print "not " if (defined($line) || !$fh->eof);
  52 print "ok 7\n";
  53
  54 print "not " unless ($fh->open("TEST","r") && !$fh->tell && $fh->close);
  55 print "ok 8\n";
  56
  57 autoflush STDOUT 0;
  58
  59 print "not " if ($|);
  60 print "ok 9\n";
  61
  62 autoflush STDOUT 1;
  63
  64 print "not " unless ($|);
  65 print "ok 10\n";
  66
  67 if ($^O eq 'dos')
  68 {
  69     printf("ok %d\n",11);
  70     exit(0);
  71 }
  72
  73 ($rd,$wr) = FileHandle::pipe;
  74
  75 if ($^O eq 'VMS' || $^O eq 'os2' || $^O eq 'amigaos' || $^O eq 'MSWin32') {
  76   $wr->autoflush;
  77   $wr->printf("ok %d\n",11);
  78   print $rd->getline;
  79 }
  80 else {
  81   if (fork) {
  82    $wr->close;
  83    print $rd->getline;
  84   }
  85   else {
  86    $rd->close;
  87    $wr->printf("ok %d\n",11);
  88    exit(0);
  89   }
  90 }