Configure syncup
[perl.git] / 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");