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 }
  12
  13 use strict;
  14 use FileHandle;
  15 autoflush STDOUT 1;
  16 use Test::More (tests => 12);
  17 my $TB = Test::More->builder;
  18
  19 my $mystdout = new_from_fd FileHandle 1,"w";
  20 $| = 1;
  21 autoflush $mystdout;
  22
  23 print $mystdout "ok ".fileno($mystdout),
  24     " - ", "create new handle from file descriptor", "\n";
  25 $TB->current_test($TB->current_test + 1);
  26
  27 my $fh = (new FileHandle "./TEST", O_RDONLY
  28        or new FileHandle "TEST", O_RDONLY);
  29 ok(defined($fh), "create new handle O_RDONLY");
  30
  31 my $buffer = <$fh>;
  32 is($buffer, "#!./perl\n", "Got expected first line via handle");
  33
  34 ungetc $fh ord 'A';
  35 my $buf;
  36 CORE::read($fh, $buf,1);
  37 is($buf, 'A', "Got expected ordinal value via ungetc in handle's input stream");
  38 close $fh;
  39
  40 $fh = new FileHandle;
  41 ok(($fh->open("< TEST") && <$fh> eq $buffer),
  42     "FileHandle open() method created handle, which got expected first line");
  43
  44 $fh->seek(0,0);
  45 ok((<$fh> eq $buffer), "Averted possible mixed CRLF/LF in t/TEST");
  46
  47 $fh->seek(0,2);
  48 my $line = <$fh>;
  49 ok(! (defined($line) || !$fh->eof), "FileHandle seek() and eof() methods");
  50
  51 ok(($fh->open("TEST","r") && !$fh->tell && $fh->close),
  52     "FileHandle open(), tell() and close() methods");
  53
  54 autoflush STDOUT 0;
  55 ok(! $|, "handle not auto-flushing current output channel");
  56
  57 autoflush STDOUT 1;
  58 ok($|, "handle auto-flushing current output channel");
  59
  60 SKIP: {
  61     skip "No fork or pipe on DOS", 1 if ($^O eq 'dos');
  62
  63     my ($rd,$wr) = FileHandle::pipe;
  64     my $non_forking = (
  65         $^O eq 'VMS' || $^O eq 'os2' || $^O eq 'amigaos' ||
  66         $^O eq 'MSWin32' || $^O eq 'NetWare' || $Config{d_fork} ne 'define'
  67     );
  68     my $content = "Writing to one end of a pipe, reading from the other\n";
  69     if ($non_forking) {
  70         $wr->autoflush;
  71         $wr->print($content);
  72         is($rd->getline, $content,
  73             "Read content from pipe on non-forking platform");
  74     }
  75     else {
  76         my $child;
  77         if ($child = fork) {
  78             # parent
  79             $wr->close;
  80             is($rd->getline, $content,
  81                 "Read content from pipe on forking platform");
  82         }
  83         elsif (defined $child) {
  84             # child
  85             $rd->close;
  86             $wr->print($content);
  87             exit(0);
  88         }
  89         else {
  90             die "fork failed: $!";
  91         }
  92     }
  93
  94 } # END: SKIP for dos
  95
  96 ok(!FileHandle->new('', 'r'), "Can't open empty filename");