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