In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/9902086f9aab16b3a5a8d14e8fb7f99c53549dc1?hp=21c01741f7906ac8801dc4d13087c6243af2de47>
- Log ----------------------------------------------------------------- commit 9902086f9aab16b3a5a8d14e8fb7f99c53549dc1 Author: James E Keenan <[email protected]> Date: Wed Jul 10 04:13:10 2013 +0200 Convert lib/FileHandle.t to use of Test::More; provide descriptions. Previously, file used hand-coded 'print "ok"' statements and no tests had descriptions (a.k.a. labels or names). Convert to use of Test::More functions and provide descriptions for all individual tests. Previously, file used global variables extensively and did not 'use strict' (except 'use strict subs'). The globals have been converted to lexicals where appropriate and the file now runs fully under strictures. Other than that, no attempt was made to improve the design of the file or the quality of the tests. (That can be done in a later RT, if desired.) Thanks to Peter Martini for guidance, Dagfinn Ilmari Mannsåker for guidance and code review on list and Tony Cook for additional review. For: RT #118883 ----------------------------------------------------------------------- Summary of changes: lib/FileHandle.t | 115 ++++++++++++++++++++++++++++--------------------------- 1 file changed, 59 insertions(+), 56 deletions(-) diff --git a/lib/FileHandle.t b/lib/FileHandle.t index aeae754..f4a8800 100644 --- a/lib/FileHandle.t +++ b/lib/FileHandle.t @@ -10,84 +10,87 @@ BEGIN { } } +use strict; use FileHandle; -use strict subs; - autoflush STDOUT 1; +use Test::More (tests => 12); +my $TB = Test::More->builder; -$mystdout = new_from_fd FileHandle 1,"w"; +my $mystdout = new_from_fd FileHandle 1,"w"; $| = 1; autoflush $mystdout; -print "1..12\n"; - -print $mystdout "ok ".fileno($mystdout)."\n"; -$fh = (new FileHandle "./TEST", O_RDONLY - or new FileHandle "TEST", O_RDONLY) - and print "ok 2\n"; +print $mystdout "ok ".fileno($mystdout), + " - ", "create new handle from file descriptor", "\n"; +$TB->current_test($TB->current_test + 1); +my $fh = (new FileHandle "./TEST", O_RDONLY + or new FileHandle "TEST", O_RDONLY); +ok(defined($fh), "create new handle O_RDONLY"); -$buffer = <$fh>; -print $buffer eq "#!./perl\n" ? "ok 3\n" : "not ok 3\n"; - +my $buffer = <$fh>; +is($buffer, "#!./perl\n", "Got expected first line via handle"); ungetc $fh ord 'A'; +my $buf; CORE::read($fh, $buf,1); -print $buf eq 'A' ? "ok 4\n" : "not ok 4\n"; - +is($buf, 'A', "Got expected ordinal value via ungetc in handle's input stream"); close $fh; $fh = new FileHandle; - -print "not " unless ($fh->open("< TEST") && <$fh> eq $buffer); -print "ok 5\n"; +ok(($fh->open("< TEST") && <$fh> eq $buffer), + "FileHandle open() method created handle, which got expected first line"); $fh->seek(0,0); -print "#possible mixed CRLF/LF in t/TEST\nnot " unless (<$fh> eq $buffer); -print "ok 6\n"; +ok((<$fh> eq $buffer), "Averted possible mixed CRLF/LF in t/TEST"); $fh->seek(0,2); -$line = <$fh>; -print "not " if (defined($line) || !$fh->eof); -print "ok 7\n"; +my $line = <$fh>; +ok(! (defined($line) || !$fh->eof), "FileHandle seek() and eof() methods"); -print "not " unless ($fh->open("TEST","r") && !$fh->tell && $fh->close); -print "ok 8\n"; +ok(($fh->open("TEST","r") && !$fh->tell && $fh->close), + "FileHandle open(), tell() and close() methods"); autoflush STDOUT 0; - -print "not " if ($|); -print "ok 9\n"; +ok(! $|, "handle not auto-flushing current output channel"); autoflush STDOUT 1; +ok($|, "handle auto-flushing current output channel"); + +SKIP: { + skip "No fork or pipe on DOS", 1 if ($^O eq 'dos'); + + my ($rd,$wr) = FileHandle::pipe; + my $non_forking = ( + $^O eq 'VMS' || $^O eq 'os2' || $^O eq 'amigaos' || + $^O eq 'MSWin32' || $^O eq 'NetWare' || $Config{d_fork} ne 'define' + ); + my $content = "Writing to one end of a pipe, reading from the other\n"; + if ($non_forking) { + $wr->autoflush; + $wr->print($content); + is($rd->getline, $content, + "Read content from pipe on non-forking platform"); + } + else { + my $child; + if ($child = fork) { + # parent + $wr->close; + is($rd->getline, $content, + "Read content from pipe on forking platform"); + } + elsif (defined $child) { + # child + $rd->close; + $wr->print($content); + exit(0); + } + else { + die "fork failed: $!"; + } + } -print "not " unless ($|); -print "ok 10\n"; - -if ($^O eq 'dos') -{ - printf("ok %d\n",11); - exit(0); -} - -($rd,$wr) = FileHandle::pipe; - -if ($^O eq 'VMS' || $^O eq 'os2' || $^O eq 'amigaos' || $^O eq 'MSWin32' || $^O eq 'NetWare' || - $Config{d_fork} ne 'define') { - $wr->autoflush; - $wr->printf("ok %d\n",11); - print $rd->getline; -} -else { - if (fork) { - $wr->close; - print $rd->getline; - } - else { - $rd->close; - $wr->printf("ok %d\n",11); - exit(0); - } -} +} # END: SKIP for dos -print FileHandle->new('','r') ? "not ok 12\n" : "ok 12\n"; +ok(!FileHandle->new('', 'r'), "Can't open empty filename"); -- Perl5 Master Repository
