new perldelta

[perl5.git] / lib / FileHandle.t

#!./perl

BEGIN {
    chdir 't' if -d 't';
    @INC = '../lib';
    require Config; import Config;
    if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
	print "1..0\n";
	exit 0;
    }
}

use strict;
use FileHandle;
autoflush STDOUT 1;
use Test::More;
my $TB = Test::More->builder;

my $mystdout = new_from_fd FileHandle 1,"w";
$| = 1;
autoflush $mystdout;

print $mystdout "ok ".fileno($mystdout),
    " - ", "create new handle from file descriptor", "\n";
$TB->current_test($TB->current_test + 1);

my $fh = (new FileHandle "./TEST", O_RDONLY
       or new FileHandle "TEST", O_RDONLY);
ok(defined($fh), "create new handle O_RDONLY");

my $buffer = <$fh>;
is($buffer, "#!./perl\n", "Got expected first line via handle");

ungetc $fh ord 'A';
my $buf;
CORE::read($fh, $buf,1);
is($buf, 'A', "Got expected ordinal value via ungetc in handle's input stream");
close $fh;

$fh = new FileHandle;
ok(($fh->open("< TEST") && <$fh> eq $buffer),
    "FileHandle open() method created handle, which got expected first line");

$fh->seek(0,0);
ok((<$fh> eq $buffer), "Averted possible mixed CRLF/LF in t/TEST");

$fh->seek(0,2);
my $line = <$fh>;
ok(! (defined($line) || !$fh->eof), "FileHandle seek() and eof() methods");

ok(($fh->open("TEST","r") && !$fh->tell && $fh->close),
    "FileHandle open(), tell() and close() methods");

autoflush STDOUT 0;
ok(! $|, "handle not auto-flushing current output channel");

autoflush STDOUT 1;
ok($|, "handle auto-flushing current output channel");

{
    my ($rd,$wr) = FileHandle::pipe;
    my $non_forking = (
        $^O eq 'VMS' || $^O eq 'os2' || $^O eq 'amigaos' ||
        $^O eq 'MSWin32' || $Config{d_fork} ne 'define'
    );
    my $content = "Writing to one end of a pipe, reading from the other\n";
    if ($non_forking) {
        $wr->autoflush;
        $wr->print($content);
        is($rd->getline, $content,
            "Read content from pipe on non-forking platform");
    }
    else {
        my $child;
        if ($child = fork) {
            # parent
            $wr->close;
            is($rd->getline, $content,
                "Read content from pipe on forking platform");
        }
        elsif (defined $child) {
            # child
            $rd->close;
            $wr->print($content);
            exit(0);
        }
        else {
            die "fork failed: $!";
        }
    }
}

ok(!FileHandle->new('', 'r'), "Can't open empty filename");

done_testing();