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} 12 13use strict; 14use FileHandle; 15autoflush STDOUT 1; 16use Test::More (tests => 12); 17my $TB = Test::More->builder; 18 19my $mystdout = new_from_fd FileHandle 1,"w"; 20$| = 1; 21autoflush $mystdout; 22 23print $mystdout "ok ".fileno($mystdout), 24 " - ", "create new handle from file descriptor", "\n"; 25$TB->current_test($TB->current_test + 1); 26 27my $fh = (new FileHandle "./TEST", O_RDONLY 28 or new FileHandle "TEST", O_RDONLY); 29ok(defined($fh), "create new handle O_RDONLY"); 30 31my $buffer = <$fh>; 32is($buffer, "#!./perl\n", "Got expected first line via handle"); 33 34ungetc $fh ord 'A'; 35my $buf; 36CORE::read($fh, $buf,1); 37is($buf, 'A', "Got expected ordinal value via ungetc in handle's input stream"); 38close $fh; 39 40$fh = new FileHandle; 41ok(($fh->open("< TEST") && <$fh> eq $buffer), 42 "FileHandle open() method created handle, which got expected first line"); 43 44$fh->seek(0,0); 45ok((<$fh> eq $buffer), "Averted possible mixed CRLF/LF in t/TEST"); 46 47$fh->seek(0,2); 48my $line = <$fh>; 49ok(! (defined($line) || !$fh->eof), "FileHandle seek() and eof() methods"); 50 51ok(($fh->open("TEST","r") && !$fh->tell && $fh->close), 52 "FileHandle open(), tell() and close() methods"); 53 54autoflush STDOUT 0; 55ok(! $|, "handle not auto-flushing current output channel"); 56 57autoflush STDOUT 1; 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 } 93 94} # END: SKIP for dos 95 96ok(!FileHandle->new('', 'r'), "Can't open empty filename"); 97