diff options
Diffstat (limited to 'contrib/perl5/t/io')
-rwxr-xr-x | contrib/perl5/t/io/argv.t | 127 | ||||
-rwxr-xr-x | contrib/perl5/t/io/dup.t | 40 | ||||
-rwxr-xr-x | contrib/perl5/t/io/fs.t | 210 | ||||
-rwxr-xr-x | contrib/perl5/t/io/inplace.t | 36 | ||||
-rwxr-xr-x | contrib/perl5/t/io/iprefix.t | 36 | ||||
-rwxr-xr-x | contrib/perl5/t/io/nargv.t | 63 | ||||
-rwxr-xr-x | contrib/perl5/t/io/open.t | 291 | ||||
-rwxr-xr-x | contrib/perl5/t/io/openpid.t | 82 | ||||
-rwxr-xr-x | contrib/perl5/t/io/pipe.t | 176 | ||||
-rwxr-xr-x | contrib/perl5/t/io/print.t | 34 | ||||
-rwxr-xr-x | contrib/perl5/t/io/read.t | 26 | ||||
-rwxr-xr-x | contrib/perl5/t/io/tell.t | 94 |
12 files changed, 0 insertions, 1215 deletions
diff --git a/contrib/perl5/t/io/argv.t b/contrib/perl5/t/io/argv.t deleted file mode 100755 index 2b8f23b..0000000 --- a/contrib/perl5/t/io/argv.t +++ /dev/null @@ -1,127 +0,0 @@ -#!./perl - -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; -} - -print "1..21\n"; - -use File::Spec; - -my $devnull = File::Spec->devnull; - -open(try, '>Io_argv1.tmp') || (die "Can't open temp file: $!"); -print try "a line\n"; -close try; - -if ($^O eq 'MSWin32') { - $x = `.\\perl -e "while (<>) {print \$.,\$_;}" Io_argv1.tmp Io_argv1.tmp`; -} -else { - $x = `./perl -e 'while (<>) {print \$.,\$_;}' Io_argv1.tmp Io_argv1.tmp`; -} -if ($x eq "1a line\n2a line\n") {print "ok 1\n";} else {print "not ok 1\n";} - -if ($^O eq 'MSWin32') { - $x = `.\\perl -le "print 'foo'" | .\\perl -e "while (<>) {print \$_;}" Io_argv1.tmp -`; -} -else { - $x = `echo foo|./perl -e 'while (<>) {print $_;}' Io_argv1.tmp -`; -} -if ($x eq "a line\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";} - -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_argv1.tmp', 'Io_argv1.tmp', $devnull, 'Io_argv1.tmp'); -while (<>) { - $y .= $. . $_; - if (eof()) { - if ($. == 3) {print "ok 4\n";} else {print "not ok 4\n";} - } -} - -if ($y eq "1a line\n2a line\n3a line\n") - {print "ok 5\n";} -else - {print "not ok 5\n";} - -open(try, '>Io_argv1.tmp') or die "Can't open temp file: $!"; -close try; -open(try, '>Io_argv2.tmp') or die "Can't open temp file: $!"; -close try; -@ARGV = ('Io_argv1.tmp', 'Io_argv2.tmp'); -$^I = '.bak'; -$/ = undef; -my $i = 6; -while (<>) { - s/^/ok $i\n/; - ++$i; - print; -} -open(try, '<Io_argv1.tmp') or die "Can't open temp file: $!"; -print while <try>; -open(try, '<Io_argv2.tmp') or die "Can't open temp file: $!"; -print while <try>; -close try; -undef $^I; - -eof try or print 'not '; -print "ok 8\n"; - -eof NEVEROPENED or print 'not '; -print "ok 9\n"; - -open STDIN, 'Io_argv1.tmp' or die $!; -@ARGV = (); -!eof() or print 'not '; -print "ok 10\n"; - -<> eq "ok 6\n" or print 'not '; -print "ok 11\n"; - -open STDIN, $devnull or die $!; -@ARGV = (); -eof() or print 'not '; -print "ok 12\n"; - -@ARGV = ('Io_argv1.tmp'); -!eof() or print 'not '; -print "ok 13\n"; - -@ARGV = ($devnull, $devnull); -!eof() or print 'not '; -print "ok 14\n"; - -close ARGV or die $!; -eof() or print 'not '; -print "ok 15\n"; - -{ - local $/; - open F, 'Io_argv1.tmp' or die; - <F>; # set $. = 1 - print "not " if defined(<F>); # should hit eof - print "ok 16\n"; - open F, $devnull or die; - print "not " unless defined(<F>); - print "ok 17\n"; - print "not " if defined(<F>); - print "ok 18\n"; - print "not " if defined(<F>); - print "ok 19\n"; - open F, $devnull or die; # restart cycle again - print "not " unless defined(<F>); - print "ok 20\n"; - print "not " if defined(<F>); - print "ok 21\n"; - close F; -} - -END { unlink 'Io_argv1.tmp', 'Io_argv1.tmp.bak', 'Io_argv2.tmp', 'Io_argv2.tmp.bak' } diff --git a/contrib/perl5/t/io/dup.t b/contrib/perl5/t/io/dup.t deleted file mode 100755 index af13d4d..0000000 --- a/contrib/perl5/t/io/dup.t +++ /dev/null @@ -1,40 +0,0 @@ -#!./perl - -# $RCSfile: dup.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:27 $ - -print "1..6\n"; - -print "ok 1\n"; - -open(dupout,">&STDOUT"); -open(duperr,">&STDERR"); - -open(STDOUT,">Io.dup") || die "Can't open stdout"; -open(STDERR,">&STDOUT") || die "Can't open stderr"; - -select(STDERR); $| = 1; -select(STDOUT); $| = 1; - -print STDOUT "ok 2\n"; -print STDERR "ok 3\n"; -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); - -open(STDOUT,">&dupout"); -open(STDERR,">&duperr"); - -if ($^O eq 'MSWin32') { print `type Io.dup` } -else { system 'cat Io.dup' } -unlink 'Io.dup'; - -print STDOUT "ok 6\n"; - diff --git a/contrib/perl5/t/io/fs.t b/contrib/perl5/t/io/fs.t deleted file mode 100755 index 8170b33..0000000 --- a/contrib/perl5/t/io/fs.t +++ /dev/null @@ -1,210 +0,0 @@ -#!./perl - -# $RCSfile: fs.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:28 $ - -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; -} - -use Config; - -$Is_Dosish = ($^O eq 'MSWin32' or $^O eq 'dos' or - $^O eq 'os2' or $^O eq 'mint'); - -if (defined &Win32::IsWinNT && Win32::IsWinNT()) { - $Is_Dosish = '' if Win32::FsType() eq 'NTFS'; -} - -print "1..29\n"; - -$wd = (($^O eq 'MSWin32') ? `cd` : `pwd`); -chop($wd); - -if ($^O eq 'MSWin32') { `rmdir /s /q tmp 2>nul`; `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'; - -umask(022); - -if ($^O eq 'MSWin32') { print "ok 1 # skipped: bogus umask()\n"; } -elsif ((umask(0)&0777) == 022) {print "ok 1\n";} else {print "not ok 1\n";} -open(fh,'>x') || die "Can't create x"; -close(fh); -open(fh,'>a') || die "Can't create a"; -close(fh); - -if ($Is_Dosish) {print "ok 2 # skipped: no link\n";} -elsif (eval {link('a','b')}) {print "ok 2\n";} -else {print "not ok 2\n";} - -if ($Is_Dosish) {print "ok 3 # skipped: no link\n";} -elsif (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 ($Config{dont_use_nlink} || $Is_Dosish) - {print "ok 4 # skipped: no link\n";} -elsif ($nlink == 3) - {print "ok 4\n";} -else {print "not ok 4\n";} - -if ($^O eq 'amigaos' || $Is_Dosish) - {print "ok 5 # skipped: no link\n";} -elsif (($mode & 0777) == 0666) - {print "ok 5\n";} -else {print "not ok 5\n";} - -$newmode = $^O eq 'MSWin32' ? 0444 : 0777; -if ((chmod $newmode,'a') == 1) {print "ok 6\n";} else {print "not ok 6\n";} - -($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, - $blksize,$blocks) = stat('c'); -if ($Is_Dosish) {print "ok 7 # skipped: no link\n";} -elsif (($mode & 0777) == $newmode) {print "ok 7\n";} -else {print "not ok 7\n";} - -$newmode = 0700; -if ($^O eq 'MSWin32') { - chmod 0444, 'x'; - $newmode = 0666; -} - -if ($Is_Dosish) {print "ok 8 # skipped: no link\n";} -elsif ((chmod $newmode,'c','x') == 2) {print "ok 8\n";} -else {print "not ok 8\n";} - -($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, - $blksize,$blocks) = stat('c'); -if ($Is_Dosish) {print "ok 9 # skipped: no link\n";} -elsif (($mode & 0777) == $newmode) {print "ok 9\n";} -else {print "not ok 9\n";} - -($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, - $blksize,$blocks) = stat('x'); -if ($Is_Dosish) {print "ok 10 # skipped: no link\n";} -elsif (($mode & 0777) == $newmode) {print "ok 10\n";} -else {print "not ok 10\n";} - -if ($Is_Dosish) {print "ok 11 # skipped: no link\n"; unlink 'b','x'; } -elsif ((unlink 'b','x') == 2) {print "ok 11\n";} -else {print "not ok 11\n";} -($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, - $blksize,$blocks) = stat('b'); -if ($ino == 0) {print "ok 12\n";} else {print "not ok 12\n";} -($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, - $blksize,$blocks) = stat('x'); -if ($ino == 0) {print "ok 13\n";} else {print "not ok 13\n";} - -if (rename('a','b')) {print "ok 14\n";} else {print "not ok 14\n";} -($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, - $blksize,$blocks) = stat('a'); -if ($ino == 0) {print "ok 15\n";} else {print "not ok 15\n";} -$delta = $Is_Dosish ? 2 : 1; # Granularity of time on the filesystem -chmod 0777, 'b'; -$foo = (utime 500000000,500000000 + $delta,'b'); -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 ($^O eq 'MSWin32') { print "ok 17 # skipped: bogus (stat)[1]\n"; } -elsif ($ino) {print "ok 17\n";} else {print "not ok 17\n";} -if ($wd =~ m#/afs/# || $^O eq 'amigaos' || $^O eq 'dos' || $^O eq 'MSWin32') - {print "ok 18 # skipped: granularity of the filetime\n";} -elsif ($atime == 500000000 && $mtime == 500000000 + $delta) - {print "ok 18\n";} -elsif ($^O =~ /\blinux\b/i) { - # Maybe stat() cannot get the correct atime, as happens via NFS on linux? - $foo = (utime 400000000,500000000 + 2*$delta,'b'); - my ($new_atime, $new_mtime) = (stat('b'))[8,9]; - if ($new_atime == $atime && $new_mtime - $mtime == $delta) - {print "ok 18 # accounted for possible NFS/glibc2.2 bug on linux\n";} - else - {print "not ok 18 $atime/$new_atime $mtime/$new_mtime\n";} -} else - {print "not ok 18 $atime $mtime\n";} - -if ((unlink 'b') == 1) {print "ok 19\n";} else {print "not ok 19\n";} -($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, - $blksize,$blocks) = stat('b'); -if ($ino == 0) {print "ok 20\n";} else {print "not ok 20\n";} -unlink 'c'; - -chdir $wd || die "Can't cd back to $wd"; - -unlink 'c'; -if ($^O ne 'MSWin32' and `ls -l perl 2>/dev/null` =~ /^l.*->/) { - # we have symbolic links - system("cp TEST TEST$$"); - # we have to copy because e.g. GNU grep gets huffy if we have - # a symlink forest to another disk (it complains about too many - # levels of symbolic links, even if we have only two) - if (symlink("TEST$$","c")) {print "ok 21\n";} else {print "not ok 21\n";} - $foo = `grep perl c 2>&1`; - if ($foo) {print "ok 22\n";} else {print "not ok 22\n";} - unlink 'c'; - unlink("TEST$$"); -} -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"; - binmode FH; - { select FH; $| = 1; select STDOUT } - { - use strict; - print FH "x\n" x 200; - truncate(FH, 200) or die "Can't truncate FH: $!"; - } - if ($^O eq 'dos' - # Not needed on HPFS, but needed on HPFS386 ?! - or $^O eq 'os2') - { - close (FH); open (FH, ">>Iofs.tmp") or die "Can't reopen Iofs.tmp"; - } - if (-s "Iofs.tmp" == 200) {print "ok 25\n"} else {print "not ok 25\n"} - truncate FH, 0; - if ($^O eq 'dos' - # Not needed on HPFS, but needed on HPFS386 ?! - or $^O eq 'os2') - { - close (FH); open (FH, ">>Iofs.tmp") or die "Can't reopen Iofs.tmp"; - } - if (-z "Iofs.tmp") {print "ok 26\n"} else {print "not ok 26\n"} - close FH; -} - -# check if rename() can be used to just change case of filename -chdir './tmp'; -open(fh,'>x') || die "Can't create x"; -close(fh); -rename('x', 'X'); -print 'not ' unless -e 'X'; -print "ok 27\n"; -unlink 'X'; -chdir $wd || die "Can't cd back to $wd"; - -# check if rename() works on directories -rename 'tmp', 'tmp1' or print "not "; -print "ok 28\n"; --d 'tmp1' or print "not "; -print "ok 29\n"; - -END { rmdir 'tmp1'; unlink "Iofs.tmp"; } diff --git a/contrib/perl5/t/io/inplace.t b/contrib/perl5/t/io/inplace.t deleted file mode 100755 index ff410a7..0000000 --- a/contrib/perl5/t/io/inplace.t +++ /dev/null @@ -1,36 +0,0 @@ -#!./perl - -$^I = $^O eq 'VMS' ? '_bak' : '.bak'; - -# $RCSfile: inplace.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:29 $ - -print "1..2\n"; - -@ARGV = ('.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`; -} -elsif ($^O eq 'VMS') { - $CAT = 'MCR []perl. -e "print<>"'; - `MCR []perl. -le "print 'foo'" > ./.a`; - `MCR []perl. -le "print 'foo'" > ./.b`; - `MCR []perl. -le "print 'foo'" > ./.c`; -} -else { - $CAT = 'cat'; - `echo foo | tee .a .b .c`; -} -while (<>) { - s/foo/bar/; -} -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$^I .b$^I .c$^I` eq "foo\nfoo\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";} - -unlink '.a', '.b', '.c', ".a$^I", ".b$^I", ".c$^I"; diff --git a/contrib/perl5/t/io/iprefix.t b/contrib/perl5/t/io/iprefix.t deleted file mode 100755 index 10a5c5f..0000000 --- a/contrib/perl5/t/io/iprefix.t +++ /dev/null @@ -1,36 +0,0 @@ -#!./perl - -$^I = 'bak*'; - -# Modified from the original inplace.t to test adding prefixes - -print "1..2\n"; - -@ARGV = ('.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`; -} -elsif ($^O eq 'VMS') { - $CAT = 'MCR []perl. -e "print<>"'; - `MCR []perl. -le "print 'foo'" > ./.a`; - `MCR []perl. -le "print 'foo'" > ./.b`; - `MCR []perl. -le "print 'foo'" > ./.c`; -} -else { - $CAT = 'cat'; - `echo foo | tee .a .b .c`; -} -while (<>) { - s/foo/bar/; -} -continue { - print; -} - -if (`$CAT .a .b .c` eq "bar\nbar\nbar\n") {print "ok 1\n";} else {print "not ok 1\n";} -if (`$CAT bak.a bak.b bak.c` eq "foo\nfoo\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";} - -unlink '.a', '.b', '.c', 'bak.a', 'bak.b', 'bak.c'; diff --git a/contrib/perl5/t/io/nargv.t b/contrib/perl5/t/io/nargv.t deleted file mode 100755 index fb13857..0000000 --- a/contrib/perl5/t/io/nargv.t +++ /dev/null @@ -1,63 +0,0 @@ -#!./perl - -print "1..5\n"; - -my $j = 1; -for $i ( 1,2,5,4,3 ) { - $file = mkfiles($i); - open(FH, "> $file") || die "can't create $file: $!"; - print FH "not ok " . $j++ . "\n"; - close(FH) || die "Can't close $file: $!"; -} - - -{ - local *ARGV; - local $^I = '.bak'; - local $_; - @ARGV = mkfiles(1..3); - $n = 0; - while (<>) { - print STDOUT "# initial \@ARGV: [@ARGV]\n"; - if ($n++ == 2) { - other(); - } - show(); - } -} - -$^I = undef; -@ARGV = mkfiles(1..3); -$n = 0; -while (<>) { - print STDOUT "#final \@ARGV: [@ARGV]\n"; - if ($n++ == 2) { - other(); - } - show(); -} - -sub show { - #warn "$ARGV: $_"; - s/^not //; - print; -} - -sub other { - print STDOUT "# Calling other\n"; - local *ARGV; - local *ARGVOUT; - local $_; - @ARGV = mkfiles(5, 4); - while (<>) { - print STDOUT "# inner \@ARGV: [@ARGV]\n"; - show(); - } -} - -sub mkfiles { - my @files = map { "scratch$_" } @_; - return wantarray ? @files : $files[-1]; -} - -END { unlink map { ($_, "$_.bak") } mkfiles(1..5) } diff --git a/contrib/perl5/t/io/open.t b/contrib/perl5/t/io/open.t deleted file mode 100755 index 0e2d57c..0000000 --- a/contrib/perl5/t/io/open.t +++ /dev/null @@ -1,291 +0,0 @@ -#!./perl - -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; -} - -# $RCSfile$ -$| = 1; -use warnings; -$Is_VMS = $^O eq 'VMS'; -$Is_Dos = $^O eq 'dos'; - -print "1..66\n"; - -my $test = 1; - -sub ok { print "ok $test\n"; $test++ } - -# my $file tests - -# 1..9 -{ - unlink("afile") if -f "afile"; - print "$!\nnot " unless open(my $f,"+>afile"); - ok; - binmode $f; - print "not " unless -f "afile"; - ok; - print "not " unless print $f "SomeData\n"; - ok; - print "not " unless tell($f) == 9; - ok; - print "not " unless seek($f,0,0); - ok; - $b = <$f>; - print "not " unless $b eq "SomeData\n"; - ok; - print "not " unless -f $f; - ok; - eval { die "Message" }; - # warn $@; - print "not " unless $@ =~ /<\$f> line 1/; - ok; - print "not " unless close($f); - ok; - unlink("afile"); -} - -# 10..12 -{ - print "# \$!='$!'\nnot " unless open(my $f,'>', 'afile'); - ok; - print $f "a row\n"; - print "not " unless close($f); - ok; - print "not " unless -s 'afile' < 10; - ok; -} - -# 13..15 -{ - print "# \$!='$!'\nnot " unless open(my $f,'>>', 'afile'); - ok; - print $f "a row\n"; - print "not " unless close($f); - ok; - print "not " unless -s 'afile' > 10; - ok; -} - -# 16..18 -{ - print "# \$!='$!'\nnot " unless open(my $f, '<', 'afile'); - ok; - @rows = <$f>; - print "not " unless @rows == 2; - ok; - print "not " unless close($f); - ok; -} - -# 19..23 -{ - print "not " unless -s 'afile' < 20; - ok; - print "# \$!='$!'\nnot " unless open(my $f, '+<', 'afile'); - ok; - @rows = <$f>; - print "not " unless @rows == 2; - ok; - seek $f, 0, 1; - print $f "yet another row\n"; - print "not " unless close($f); - ok; - print "not " unless -s 'afile' > 20; - ok; - - unlink("afile"); -} - -# 24..26 -if ($Is_VMS) { - for (24..26) { print "ok $_ # skipped: not Unix fork\n"; $test++;} -} -else { - print "# \$!='$!'\nnot " unless open(my $f, '-|', <<'EOC'); - ./perl -e "print qq(a row\n); print qq(another row\n)" -EOC - ok; - @rows = <$f>; - print "not " unless @rows == 2; - ok; - print "not " unless close($f); - ok; -} - -# 27..30 -if ($Is_VMS) { - for (27..30) { print "ok $_ # skipped: not Unix fork\n"; $test++;} -} -else { - print "# \$!='$!'\nnot " unless open(my $f, '|-', <<'EOC'); - ./perl -pe "s/^not //" -EOC - ok; - @rows = <$f>; - print $f "not ok $test\n"; $test++; - print $f "not ok $test\n"; $test++; - print "#\nnot " unless close($f); - sleep 1; - ok; -} - -# 31..32 -eval <<'EOE' and print "not "; -open my $f, '<&', 'afile'; -1; -EOE -ok; -$@ =~ /Unknown open\(\) mode \'<&\'/ or print "not "; -ok; - -# local $file tests - -# 33..41 -{ - unlink("afile") if -f "afile"; - print "$!\nnot " unless open(local $f,"+>afile"); - ok; - binmode $f; - print "not " unless -f "afile"; - ok; - print "not " unless print $f "SomeData\n"; - ok; - print "not " unless tell($f) == 9; - ok; - print "not " unless seek($f,0,0); - ok; - $b = <$f>; - print "not " unless $b eq "SomeData\n"; - ok; - print "not " unless -f $f; - ok; - eval { die "Message" }; - # warn $@; - print "not " unless $@ =~ /<\$f> line 1/; - ok; - print "not " unless close($f); - ok; - unlink("afile"); -} - -# 42..44 -{ - print "# \$!='$!'\nnot " unless open(local $f,'>', 'afile'); - ok; - print $f "a row\n"; - print "not " unless close($f); - ok; - print "not " unless -s 'afile' < 10; - ok; -} - -# 45..47 -{ - print "# \$!='$!'\nnot " unless open(local $f,'>>', 'afile'); - ok; - print $f "a row\n"; - print "not " unless close($f); - ok; - print "not " unless -s 'afile' > 10; - ok; -} - -# 48..50 -{ - print "# \$!='$!'\nnot " unless open(local $f, '<', 'afile'); - ok; - @rows = <$f>; - print "not " unless @rows == 2; - ok; - print "not " unless close($f); - ok; -} - -# 51..55 -{ - print "not " unless -s 'afile' < 20; - ok; - print "# \$!='$!'\nnot " unless open(local $f, '+<', 'afile'); - ok; - @rows = <$f>; - print "not " unless @rows == 2; - ok; - seek $f, 0, 1; - print $f "yet another row\n"; - print "not " unless close($f); - ok; - print "not " unless -s 'afile' > 20; - ok; - - unlink("afile"); -} - -# 56..58 -if ($Is_VMS) { - for (56..58) { print "ok $_ # skipped: not Unix fork\n"; $test++;} -} -else { - print "# \$!='$!'\nnot " unless open(local $f, '-|', <<'EOC'); - ./perl -e "print qq(a row\n); print qq(another row\n)" -EOC - ok; - @rows = <$f>; - print "not " unless @rows == 2; - ok; - print "not " unless close($f); - ok; -} - -# 59..62 -if ($Is_VMS) { - for (59..62) { print "ok $_ # skipped: not Unix fork\n"; $test++;} -} -else { - print "# \$!='$!'\nnot " unless open(local $f, '|-', <<'EOC'); - ./perl -pe "s/^not //" -EOC - ok; - @rows = <$f>; - print $f "not ok $test\n"; $test++; - print $f "not ok $test\n"; $test++; - print "#\nnot " unless close($f); - sleep 1; - ok; -} - -# 63..64 -eval <<'EOE' and print "not "; -open local $f, '<&', 'afile'; -1; -EOE -ok; -$@ =~ /Unknown open\(\) mode \'<&\'/ or print "not "; -ok; - -# 65..66 -{ - local *F; - for (1..2) { - if ($Is_Dos) { - open(F, "echo \\#foo|") or print "not "; - } else { - open(F, "echo #foo|") or print "not "; - } - print <F>; - close F; - } - ok; - for (1..2) { - if ($Is_Dos) { - open(F, "-|", "echo \\#foo") or print "not "; - } else { - open(F, "-|", "echo #foo") or print "not "; - } - print <F>; - close F; - } - ok; -} diff --git a/contrib/perl5/t/io/openpid.t b/contrib/perl5/t/io/openpid.t deleted file mode 100755 index 7c04a29..0000000 --- a/contrib/perl5/t/io/openpid.t +++ /dev/null @@ -1,82 +0,0 @@ -#!./perl - -##################################################################### -# -# Test for process id return value from open -# Ronald Schmidt (The Software Path) RonaldWS@software-path.com -# -##################################################################### - -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; - if ($^O eq 'dos') { - print "1..0 # Skip: no multitasking\n"; - exit 0; - } -} - -use Config; -$| = 1; -$SIG{PIPE} = 'IGNORE'; - -print "1..10\n"; - -$perl = qq[$^X "-I../lib"]; - -# -# commands run 4 perl programs. Two of these programs write a -# short message to STDOUT and exit. Two of these programs -# read from STDIN. One reader never exits and must be killed. -# the other reader reads one line, waits a few seconds and then -# exits to test the waitpid function. -# -$cmd1 = qq/$perl -e "\$|=1; print qq[first process\\n]; sleep 30;"/; -$cmd2 = qq/$perl -e "\$|=1; print qq[second process\\n]; sleep 30;"/; -$cmd3 = qq/$perl -e "print <>;"/; # hangs waiting for end of STDIN -$cmd4 = qq/$perl -e "print scalar <>;"/; - -#warn "#$cmd1\n#$cmd2\n#$cmd3\n#$cmd4\n"; - -# start the processes -$pid1 = open(FH1, "$cmd1 |") or print "not "; -print "ok 1\n"; -$pid2 = open(FH2, "$cmd2 |") or print "not "; -print "ok 2\n"; -$pid3 = open(FH3, "| $cmd3") or print "not "; -print "ok 3\n"; -$pid4 = open(FH4, "| $cmd4") or print "not "; -print "ok 4\n"; - -print "# pids were $pid1, $pid2, $pid3, $pid4\n"; - -my $killsig = 'HUP'; -$killsig = 1 unless $Config{sig_name} =~ /\bHUP\b/; - -# get message from first process and kill it -chomp($from_pid1 = scalar(<FH1>)); -print "# child1 returned [$from_pid1]\nnot " - unless $from_pid1 eq 'first process'; -print "ok 5\n"; -$kill_cnt = kill $killsig, $pid1; -print "not " unless $kill_cnt == 1; -print "ok 6\n"; - -# get message from second process and kill second process and reader process -chomp($from_pid2 = scalar(<FH2>)); -print "# child2 returned [$from_pid2]\nnot " - unless $from_pid2 eq 'second process'; -print "ok 7\n"; -$kill_cnt = kill $killsig, $pid2, $pid3; -print "not " unless $kill_cnt == 2; -print "ok 8\n"; - -# send one expected line of text to child process and then wait for it -select(FH4); $| = 1; select(STDOUT); - -print FH4 "ok 9\n"; -print "# waiting for process $pid4 to exit\n"; -$reap_pid = waitpid $pid4, 0; -print "# reaped pid $reap_pid != $pid4\nnot " - unless $reap_pid == $pid4; -print "ok 10\n"; diff --git a/contrib/perl5/t/io/pipe.t b/contrib/perl5/t/io/pipe.t deleted file mode 100755 index 96935e3..0000000 --- a/contrib/perl5/t/io/pipe.t +++ /dev/null @@ -1,176 +0,0 @@ -#!./perl - -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; - require Config; import Config; - unless ($Config{'d_fork'}) { - print "1..0 # Skip: no fork\n"; - exit 0; - } -} - -$| = 1; -print "1..15\n"; - -# External program 'tr' assumed. -open(PIPE, "|-") || (exec 'tr', 'YX', 'ko'); -print PIPE "Xk 1\n"; -print PIPE "oY 2\n"; -close PIPE; - -if ($^O eq 'vmesa') { - # Doesn't work, yet. - for (3..6) { - print "ok $_ # skipped\n"; - } -} else { - if (open(PIPE, "-|")) { - while(<PIPE>) { - s/^not //; - print; - } - close PIPE; # avoid zombies which disrupt test 12 - } - else { - # External program 'echo' assumed. - print STDOUT "not ok 3\n"; - exec 'echo', 'not ok 4'; - } - - pipe(READER,WRITER) || die "Can't open pipe"; - - if ($pid = fork) { - close WRITER; - while(<READER>) { - s/^not //; - y/A-Z/a-z/; - print; - } - close READER; # avoid zombies which disrupt test 12 - } - else { - die "Couldn't fork" unless defined $pid; - close READER; - print WRITER "not ok 5\n"; - open(STDOUT,">&WRITER") || die "Can't dup WRITER to STDOUT"; - close WRITER; - # External program 'echo' assumed. - exec 'echo', 'not ok 6'; - } -} -wait; # Collect from $pid - -pipe(READER,WRITER) || die "Can't open pipe"; -close READER; - -$SIG{'PIPE'} = 'broken_pipe'; - -sub broken_pipe { - $SIG{'PIPE'} = 'IGNORE'; # loop preventer - print "ok 7\n"; -} - -print WRITER "not ok 7\n"; -close WRITER; -sleep 1; -print "ok 8\n"; - -# VMS doesn't like spawning subprocesses that are still connected to -# STDOUT. Someone should modify tests #9 to #12 to work with VMS. - -if ($^O eq 'VMS') { - print "ok 9 # skipped\n"; - print "ok 10 # skipped\n"; - print "ok 11 # skipped\n"; - print "ok 12 # skipped\n"; - exit; -} - -if ($Config{d_sfio} || $^O eq 'machten' || $^O eq 'beos' || $^O eq 'posix-bc') { - # 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. - # BeOS will not write to broken pipes, either. - # Nor does POSIX-BC. - print "ok 9 # skipped\n"; -} -else { - local $SIG{PIPE} = 'IGNORE'; - open NIL, '|true' or die "open failed: $!"; - sleep 5; - print NIL 'foo' or die "print failed: $!"; - if (close NIL) { - print "not ok 9\n"; - } - else { - print "ok 9\n"; - } -} - -if ($^O eq 'vmesa') { - # These don't work, yet. - print "ok 10 # skipped\n"; - print "ok 11 # skipped\n"; - print "ok 12 # skipped\n"; - exit; -} - -# 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"; -} - -if ($^O eq 'mpeix') { - print "ok 11 # skipped\n"; - print "ok 12 # skipped\n"; -} else { - # check that status for the correct process is collected - my $zombie = fork or exit 37; - my $pipe = open *FH, "sleep 2;exit 13|" or die "Open: $!\n"; - $SIG{ALRM} = sub { return }; - alarm(1); - my $close = close FH; - if ($? == 13*256 && ! length $close && ! $!) { - print "ok 11\n"; - } else { - print "not ok 11\n# close $close\$?=$? \$!=", $!+0, ":$!\n"; - }; - my $wait = wait; - if ($? == 37*256 && $wait == $zombie && ! $!) { - print "ok 12\n"; - } else { - print "not ok 12\n# pid=$wait first=$pid pipe=$pipe zombie=$zombie me=$$ \$?=$? \$!=", $!+0, ":$!\n"; - } -} - -# Test new semantics for missing command in piped open -# 19990114 M-J. Dominus mjd@plover.com -{ local *P; - print (((open P, "| " ) ? "not " : ""), "ok 13\n"); - print (((open P, " |" ) ? "not " : ""), "ok 14\n"); -} - -# check that status is unaffected by implicit close -{ - local(*NIL); - open NIL, '|exit 23;' or die "fork failed: $!"; - $? = 42; - # NIL implicitly closed here -} -if ($? != 42) { - print "# status $?, expected 42\nnot "; -} -print "ok 15\n"; -$? = 0; diff --git a/contrib/perl5/t/io/print.t b/contrib/perl5/t/io/print.t deleted file mode 100755 index 0578ee6..0000000 --- a/contrib/perl5/t/io/print.t +++ /dev/null @@ -1,34 +0,0 @@ -#!./perl - -print "1..18\n"; - -$foo = 'STDOUT'; -print $foo "ok 1\n"; - -print "ok 2\n","ok 3\n","ok 4\n"; -print STDOUT "ok 5\n"; - -open(foo,">-"); -print foo "ok 6\n"; - -printf "ok %d\n",7; -printf("ok %d\n",8); - -@a = ("ok %d%c",9,ord("\n")); -printf @a; - -$a[1] = 10; -printf STDOUT @a; - -$, = ' '; -$\ = "\n"; - -print "ok","11"; - -@x = ("ok","12\nok","13\nok"); -@y = ("15\nok","16"); -print @x,"14\nok",@y; -{ - local $\ = "ok 17\n# null =>[\000]\nok 18\n"; - print ""; -} diff --git a/contrib/perl5/t/io/read.t b/contrib/perl5/t/io/read.t deleted file mode 100755 index b27fde1..0000000 --- a/contrib/perl5/t/io/read.t +++ /dev/null @@ -1,26 +0,0 @@ -#!./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/contrib/perl5/t/io/tell.t b/contrib/perl5/t/io/tell.t deleted file mode 100755 index c840c92..0000000 --- a/contrib/perl5/t/io/tell.t +++ /dev/null @@ -1,94 +0,0 @@ -#!./perl - -# $RCSfile: tell.t,v $$Revision$$Date$ - -print "1..23\n"; - -$TST = 'tst'; - -$Is_Dosish = ($^O eq 'MSWin32' or $^O eq 'dos' or - $^O eq 'os2' or $^O eq 'mint' or $^O eq 'cygwin'); - -open($TST, 'harness') || (die "Can't open harness"); -binmode $TST if $Is_Dosish; -if (eof(tst)) { print "not ok 1\n"; } else { print "ok 1\n"; } - -$firstline = <$TST>; -$secondpos = tell; - -$x = 0; -while (<tst>) { - if (eof) {$x++;} -} -if ($x == 1) { print "ok 2\n"; } else { print "not ok 2\n"; } - -$lastpos = tell; - -unless (eof) { print "not ok 3\n"; } else { print "ok 3\n"; } - -if (seek($TST,0,0)) { print "ok 4\n"; } else { print "not ok 4\n"; } - -if (eof) { print "not ok 5\n"; } else { print "ok 5\n"; } - -if ($firstline eq <tst>) { print "ok 6\n"; } else { print "not ok 6\n"; } - -if ($secondpos == tell) { print "ok 7\n"; } else { print "not ok 7\n"; } - -if (seek(tst,0,1)) { print "ok 8\n"; } else { print "not ok 8\n"; } - -if (eof($TST)) { print "not ok 9\n"; } else { print "ok 9\n"; } - -if ($secondpos == tell) { print "ok 10\n"; } else { print "not ok 10\n"; } - -if (seek(tst,0,2)) { print "ok 11\n"; } else { print "not ok 11\n"; } - -if ($lastpos == tell) { print "ok 12\n"; } else { print "not ok 12\n"; } - -unless (eof) { print "not ok 13\n"; } else { print "ok 13\n"; } - -if ($. == 0) { print "not ok 14\n"; } else { print "ok 14\n"; } - -$curline = $.; -open(other, 'harness') || (die "Can't open harness: $!"); -binmode other if $^O eq 'MSWin32'; - -{ - local($.); - - if ($. == 0) { print "not ok 15\n"; } else { print "ok 15\n"; } - - tell other; - if ($. == 0) { print "ok 16\n"; } else { print "not ok 16\n"; } - - $. = 5; - scalar <other>; - if ($. == 6) { print "ok 17\n"; } else { print "not ok 17\n"; } -} - -if ($. == $curline) { print "ok 18\n"; } else { print "not ok 18\n"; } - -{ - local($.); - - scalar <other>; - if ($. == 7) { print "ok 19\n"; } else { print "not ok 19\n"; } -} - -if ($. == $curline) { print "ok 20\n"; } else { print "not ok 20\n"; } - -{ - local($.); - - tell other; - if ($. == 7) { print "ok 21\n"; } else { print "not ok 21\n"; } -} - -close(other); -if (tell(other) == -1) { print "ok 22\n"; } else { print "not ok 22\n"; } - -if (tell(ether) == -1) { print "ok 23\n"; } else { print "not ok 23\n"; } - -# ftell(STDIN) (or any std streams) is undefined, it can return -1 or -# something else. ftell() on pipes, fifos, and sockets is defined to -# return -1. - |