mirror of
https://github.com/Perl/perl5.git
synced 2026-01-27 01:44:43 +00:00
9902086f9a
Previously, file used hand-coded 'print "ok"' statements and no tests had descriptions (a.k.a. labels or names). Convert to use of Test::More functions and provide descriptions for all individual tests. Previously, file used global variables extensively and did not 'use strict' (except 'use strict subs'). The globals have been converted to lexicals where appropriate and the file now runs fully under strictures. Other than that, no attempt was made to improve the design of the file or the quality of the tests. (That can be done in a later RT, if desired.) Thanks to Peter Martini for guidance, Dagfinn Ilmari Mannsåker for guidance and code review on list and Tony Cook for additional review. For: RT #118883
97 lines
2.5 KiB
Perl
97 lines
2.5 KiB
Perl
#!./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 (tests => 12);
|
|
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");
|
|
|
|
SKIP: {
|
|
skip "No fork or pipe on DOS", 1 if ($^O eq 'dos');
|
|
|
|
my ($rd,$wr) = FileHandle::pipe;
|
|
my $non_forking = (
|
|
$^O eq 'VMS' || $^O eq 'os2' || $^O eq 'amigaos' ||
|
|
$^O eq 'MSWin32' || $^O eq 'NetWare' || $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: $!";
|
|
}
|
|
}
|
|
|
|
} # END: SKIP for dos
|
|
|
|
ok(!FileHandle->new('', 'r'), "Can't open empty filename");
|