diff options
Diffstat (limited to 't/io')
| -rwxr-xr-x | t/io/argv.t | 26 | ||||
| -rwxr-xr-x | t/io/dup.t | 13 | ||||
| -rwxr-xr-x | t/io/fs.t | 57 | ||||
| -rwxr-xr-x | t/io/inplace.t | 15 | ||||
| -rwxr-xr-x | t/io/pipe.t | 56 | ||||
| -rwxr-xr-x | t/io/read.t | 26 | ||||
| -rwxr-xr-x | t/io/tell.t | 2 |
7 files changed, 173 insertions, 22 deletions
diff --git a/t/io/argv.t b/t/io/argv.t index 40ed23b373..d99865e142 100755 --- a/t/io/argv.t +++ b/t/io/argv.t @@ -8,16 +8,28 @@ open(try, '>Io.argv.tmp') || (die "Can't open temp file."); print try "a line\n"; close try; -$x = `./perl -e 'while (<>) {print \$.,\$_;}' Io.argv.tmp Io.argv.tmp`; - +if ($^O eq 'MSWin32') { + $x = `.\\perl -e "while (<>) {print \$.,\$_;}" Io.argv.tmp Io.argv.tmp`; +} +else { + $x = `./perl -e 'while (<>) {print \$.,\$_;}' Io.argv.tmp Io.argv.tmp`; +} if ($x eq "1a line\n2a line\n") {print "ok 1\n";} else {print "not ok 1\n";} -$x = `echo foo|./perl -e 'while (<>) {print $_;}' Io.argv.tmp -`; - +if ($^O eq 'MSWin32') { + $x = `.\\perl -le "print 'foo'" | .\\perl -e "while (<>) {print \$_;}" Io.argv.tmp -`; +} +else { + $x = `echo foo|./perl -e 'while (<>) {print $_;}' Io.argv.tmp -`; +} if ($x eq "a line\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";} -$x = `echo foo|./perl -e 'while (<>) {print $_;}'`; - +if ($^O eq 'MSWin32') { + $x = `.\\perl -le "print 'foo'" |.\\perl -e "while (<>) {print \$_;}"`; +} +else { + $x = `echo foo|./perl -e 'while (<>) {print $_;}'`; +} if ($x eq "foo\n") {print "ok 3\n";} else {print "not ok 3 :$x:\n";} @ARGV = ('Io.argv.tmp', 'Io.argv.tmp', '/dev/null', 'Io.argv.tmp'); @@ -33,4 +45,4 @@ if ($y eq "1a line\n2a line\n3a line\n") else {print "not ok 5\n";} -`/bin/rm -f Io.argv.tmp` if -x '/bin/rm'; +unlink 'Io.argv.tmp'; diff --git a/t/io/dup.t b/t/io/dup.t index 901642d8f6..f312671e56 100755 --- a/t/io/dup.t +++ b/t/io/dup.t @@ -17,8 +17,14 @@ select(STDOUT); $| = 1; print STDOUT "ok 2\n"; print STDERR "ok 3\n"; -system 'echo ok 4'; -system 'echo ok 5 1>&2'; +if ($^O eq 'MSWin32') { + print `echo ok 4`; + print `echo ok 5 1>&2`; # does this work? +} +else { + system 'echo ok 4'; + system 'echo ok 5 1>&2'; +} close(STDOUT); close(STDERR); @@ -26,7 +32,8 @@ close(STDERR); open(STDOUT,">&dupout"); open(STDERR,">&duperr"); -system 'cat Io.dup'; +if ($^O eq 'MSWin32') { print `type Io.dup` } +else { system 'cat Io.dup' } unlink 'Io.dup'; print STDOUT "ok 6\n"; @@ -2,12 +2,23 @@ # $RCSfile: fs.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:28 $ -print "1..22\n"; +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} + +use Config; + +# avoid win32 (for now) +do { print "1..0\n"; exit(0); } if $^O eq 'MSWin32'; -$wd = `pwd`; +print "1..26\n"; + +$wd = (($^O eq 'MSWin32') ? `cd` : `pwd`); chop($wd); -`rm -f tmp 2>/dev/null; mkdir tmp 2>/dev/null`; +if ($^O eq 'MSWin32') { `del tmp`; `mkdir tmp`; } +else { `rm -f tmp 2>/dev/null; mkdir tmp 2>/dev/null`; } chdir './tmp'; `/bin/rm -rf a b c x` if -x '/bin/rm'; @@ -26,8 +37,11 @@ if (eval {link('b','c')}) {print "ok 3\n";} else {print "not ok 3\n";} ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, $blksize,$blocks) = stat('c'); -if ($nlink == 3) {print "ok 4\n";} else {print "not ok 4\n";} -if (($mode & 0777) == 0666) {print "ok 5\n";} else {print "not ok 5\n";} +if ($Config{dont_use_nlink} || $nlink == 3) + {print "ok 4\n";} else {print "not ok 4\n";} + +if (($mode & 0777) == 0666 || $^O eq 'amigaos') + {print "ok 5\n";} else {print "not ok 5\n";} if ((chmod 0777,'a') == 1) {print "ok 6\n";} else {print "not ok 6\n";} @@ -61,7 +75,8 @@ if ($foo == 1) {print "ok 16\n";} else {print "not ok 16 $foo\n";} ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, $blksize,$blocks) = stat('b'); if ($ino) {print "ok 17\n";} else {print "not ok 17\n";} -if (($atime == 500000000 && $mtime == 500000001) || $wd =~ m#/afs/#) +if (($atime == 500000000 && $mtime == 500000001) + || $wd =~ m#/afs/# || $^O eq 'amigaos') {print "ok 18\n";} else {print "not ok 18 $atime $mtime\n";} @@ -73,13 +88,41 @@ if ($ino == 0) {print "ok 20\n";} else {print "not ok 20\n";} unlink 'c'; chdir $wd || die "Can't cd back to $wd"; +rmdir 'tmp'; unlink 'c'; -if (`ls -l perl 2>/dev/null` =~ /^l.*->/) { # we have symbolic links +if ($^O ne 'MSWin32' and `ls -l perl 2>/dev/null` =~ /^l.*->/) { + # we have symbolic links if (symlink("TEST","c")) {print "ok 21\n";} else {print "not ok 21\n";} $foo = `grep perl c`; if ($foo) {print "ok 22\n";} else {print "not ok 22\n";} + unlink 'c'; } else { print "ok 21\nok 22\n"; } + +# truncate (may not be implemented everywhere) +unlink "Iofs.tmp"; +`echo helloworld > Iofs.tmp`; +eval { truncate "Iofs.tmp", 5; }; +if ($@ =~ /not implemented/) { + print "# truncate not implemented -- skipping tests 23 through 26\n"; + for (23 .. 26) { + print "ok $_\n"; + } +} +else { + if (-s "Iofs.tmp" == 5) {print "ok 23\n"} else {print "not ok 23\n"} + truncate "Iofs.tmp", 0; + if (-z "Iofs.tmp") {print "ok 24\n"} else {print "not ok 24\n"} + open(FH, ">Iofs.tmp") or die "Can't create Iofs.tmp"; + { select FH; $| = 1; select STDOUT } + print FH "helloworld\n"; + truncate FH, 5; + if (-s "Iofs.tmp" == 5) {print "ok 25\n"} else {print "not ok 25\n"} + truncate FH, 0; + if (-z "Iofs.tmp") {print "ok 26\n"} else {print "not ok 26\n"} + close FH; +} +unlink "Iofs.tmp"; diff --git a/t/io/inplace.t b/t/io/inplace.t index 477add1942..2652c8bebe 100755 --- a/t/io/inplace.t +++ b/t/io/inplace.t @@ -7,7 +7,16 @@ $^I = '.bak'; print "1..2\n"; @ARGV = ('.a','.b','.c'); -`echo foo | tee .a .b .c`; +if ($^O eq 'MSWin32') { + $CAT = '.\perl -e "print<>"'; + `.\\perl -le "print 'foo'" > .a`; + `.\\perl -le "print 'foo'" > .b`; + `.\\perl -le "print 'foo'" > .c`; +} +else { + $CAT = 'cat'; + `echo foo | tee .a .b .c`; +} while (<>) { s/foo/bar/; } @@ -15,7 +24,7 @@ continue { print; } -if (`cat .a .b .c` eq "bar\nbar\nbar\n") {print "ok 1\n";} else {print "not ok 1\n";} -if (`cat .a.bak .b.bak .c.bak` eq "foo\nfoo\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";} +if (`$CAT .a .b .c` eq "bar\nbar\nbar\n") {print "ok 1\n";} else {print "not ok 1\n";} +if (`$CAT .a.bak .b.bak .c.bak` eq "foo\nfoo\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";} unlink '.a', '.b', '.c', '.a.bak', '.b.bak', '.c.bak'; diff --git a/t/io/pipe.t b/t/io/pipe.t index 95df4dccb6..ac149810ec 100755 --- a/t/io/pipe.t +++ b/t/io/pipe.t @@ -2,8 +2,18 @@ # $RCSfile: pipe.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:31 $ +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + require Config; import Config; + unless ($Config{'d_fork'}) { + print "1..0\n"; + exit 0; + } +} + $| = 1; -print "1..8\n"; +print "1..10\n"; open(PIPE, "|-") || (exec 'tr', 'YX', 'ko'); print PIPE "Xk 1\n"; @@ -54,3 +64,47 @@ print WRITER "not ok 7\n"; close WRITER; print "ok 8\n"; + +# VMS doesn't like spawning subprocesses that are still connected to +# STDOUT. Someone should modify tests #9 and #10 to work with VMS. + +if ($^O eq 'VMS') { + print "ok 9\n"; + print "ok 10\n"; + exit; +} + +if ($Config{d_sfio} || $^O eq machten) { + # Sfio doesn't report failure when closing a broken pipe + # that has pending output. Go figure. MachTen doesn't either, + # but won't write to broken pipes, so nothing's pending at close. + print "ok 9\n"; +} +else { + local $SIG{PIPE} = 'IGNORE'; + open NIL, '|true' or die "open failed: $!"; + sleep 2; + print NIL 'foo' or die "print failed: $!"; + if (close NIL) { + print "not ok 9\n"; + } + else { + print "ok 9\n"; + } +} + +# check that errno gets forced to 0 if the piped program exited non-zero +open NIL, '|exit 23;' or die "fork failed: $!"; +$! = 1; +if (close NIL) { + print "not ok 10\n# successful close\n"; +} +elsif ($! != 0) { + print "not ok 10\n# errno $!\n"; +} +elsif ($? == 0) { + print "not ok 10\n# status 0\n"; +} +else { + print "ok 10\n"; +} diff --git a/t/io/read.t b/t/io/read.t new file mode 100755 index 0000000000..b27fde17c7 --- /dev/null +++ b/t/io/read.t @@ -0,0 +1,26 @@ +#!./perl + +# $RCSfile$ + +print "1..1\n"; + +open(A,"+>a"); +print A "_"; +seek(A,0,0); + +$b = "abcd"; +$b = ""; + +read(A,$b,1,4); + +close(A); + +unlink("a"); + +if ($b eq "\000\000\000\000_") { + print "ok 1\n"; +} else { # Probably "\000bcd_" + print "not ok 1\n"; +} + +unlink 'a'; diff --git a/t/io/tell.t b/t/io/tell.t index 5badafeacb..83904e88bb 100755 --- a/t/io/tell.t +++ b/t/io/tell.t @@ -7,7 +7,7 @@ print "1..13\n"; $TST = 'tst'; open($TST, '../Configure') || (die "Can't open ../Configure"); - +binmode $TST if $^O eq 'MSWin32'; if (eof(tst)) { print "not ok 1\n"; } else { print "ok 1\n"; } $firstline = <$TST>; |