This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Convert lib/FileHandle.t to use of Test::More; provide descriptions.
[perl5.git] / lib / FileHandle.t
CommitLineData
c07a80fd 1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
20822f61 5 @INC = '../lib';
c07a80fd 6 require Config; import Config;
36477c24 7 if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
c07a80fd 8 print "1..0\n";
9 exit 0;
10 }
11}
12
9902086f 13use strict;
c07a80fd 14use FileHandle;
36477c24 15autoflush STDOUT 1;
9902086f
JK
16use Test::More (tests => 12);
17my $TB = Test::More->builder;
36477c24 18
9902086f 19my $mystdout = new_from_fd FileHandle 1,"w";
5ef887f5 20$| = 1;
c07a80fd 21autoflush $mystdout;
c07a80fd 22
9902086f
JK
23print $mystdout "ok ".fileno($mystdout),
24 " - ", "create new handle from file descriptor", "\n";
25$TB->current_test($TB->current_test + 1);
36477c24 26
9902086f
JK
27my $fh = (new FileHandle "./TEST", O_RDONLY
28 or new FileHandle "TEST", O_RDONLY);
29ok(defined($fh), "create new handle O_RDONLY");
36477c24 30
9902086f
JK
31my $buffer = <$fh>;
32is($buffer, "#!./perl\n", "Got expected first line via handle");
36477c24 33
9d116dd7 34ungetc $fh ord 'A';
9902086f 35my $buf;
5ef887f5 36CORE::read($fh, $buf,1);
9902086f 37is($buf, 'A', "Got expected ordinal value via ungetc in handle's input stream");
36477c24 38close $fh;
39
40$fh = new FileHandle;
9902086f
JK
41ok(($fh->open("< TEST") && <$fh> eq $buffer),
42 "FileHandle open() method created handle, which got expected first line");
36477c24 43
44$fh->seek(0,0);
9902086f 45ok((<$fh> eq $buffer), "Averted possible mixed CRLF/LF in t/TEST");
36477c24 46
47$fh->seek(0,2);
9902086f
JK
48my $line = <$fh>;
49ok(! (defined($line) || !$fh->eof), "FileHandle seek() and eof() methods");
36477c24 50
9902086f
JK
51ok(($fh->open("TEST","r") && !$fh->tell && $fh->close),
52 "FileHandle open(), tell() and close() methods");
36477c24 53
54autoflush STDOUT 0;
9902086f 55ok(! $|, "handle not auto-flushing current output channel");
36477c24 56
57autoflush STDOUT 1;
9902086f
JK
58ok($|, "handle auto-flushing current output channel");
59
60SKIP: {
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 }
36477c24 93
9902086f 94} # END: SKIP for dos
f21dc558 95
9902086f 96ok(!FileHandle->new('', 'r'), "Can't open empty filename");