This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove now-erroneous comment about 'test.pl' from version's tests.
[perl5.git] / lib / FileHandle.t
... / ...
CommitLineData
1#!./perl
2
3BEGIN {
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 if ($^O eq 'mpeix') {
12 print "1..0 # Skip: broken on MPE/iX\n";
13 exit 0;
14 }
15}
16
17use FileHandle;
18use strict subs;
19
20autoflush STDOUT 1;
21
22$mystdout = new_from_fd FileHandle 1,"w";
23$| = 1;
24autoflush $mystdout;
25print "1..12\n";
26
27print $mystdout "ok ".fileno($mystdout)."\n";
28
29$fh = (new FileHandle "./TEST", O_RDONLY
30 or new FileHandle "TEST", O_RDONLY)
31 and print "ok 2\n";
32
33
34$buffer = <$fh>;
35print $buffer eq "#!./perl\n" ? "ok 3\n" : "not ok 3\n";
36
37
38ungetc $fh ord 'A';
39CORE::read($fh, $buf,1);
40print $buf eq 'A' ? "ok 4\n" : "not ok 4\n";
41
42close $fh;
43
44$fh = new FileHandle;
45
46print "not " unless ($fh->open("< TEST") && <$fh> eq $buffer);
47print "ok 5\n";
48
49$fh->seek(0,0);
50print "#possible mixed CRLF/LF in t/TEST\nnot " unless (<$fh> eq $buffer);
51print "ok 6\n";
52
53$fh->seek(0,2);
54$line = <$fh>;
55print "not " if (defined($line) || !$fh->eof);
56print "ok 7\n";
57
58print "not " unless ($fh->open("TEST","r") && !$fh->tell && $fh->close);
59print "ok 8\n";
60
61autoflush STDOUT 0;
62
63print "not " if ($|);
64print "ok 9\n";
65
66autoflush STDOUT 1;
67
68print "not " unless ($|);
69print "ok 10\n";
70
71if ($^O eq 'dos')
72{
73 printf("ok %d\n",11);
74 exit(0);
75}
76
77($rd,$wr) = FileHandle::pipe;
78
79if ($^O eq 'VMS' || $^O eq 'os2' || $^O eq 'amigaos' || $^O eq 'MSWin32' || $^O eq 'NetWare' ||
80 $Config{d_fork} ne 'define') {
81 $wr->autoflush;
82 $wr->printf("ok %d\n",11);
83 print $rd->getline;
84}
85else {
86 if (fork) {
87 $wr->close;
88 print $rd->getline;
89 }
90 else {
91 $rd->close;
92 $wr->printf("ok %d\n",11);
93 exit(0);
94 }
95}
96
97print FileHandle->new('','r') ? "not ok 12\n" : "ok 12\n";