From: Perl 5 Porters Date: Mon, 22 Jul 1996 18:13:12 +0000 (+0000) Subject: Add tests for new IO extension X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=61f2b451fd3c78c4b8481e1a3a89cadc6e3119ae;p=p5sagit%2Fp5-mst-13.2.git Add tests for new IO extension --- diff --git a/t/lib/io_dup.t b/t/lib/io_dup.t new file mode 100644 index 0000000..ac17683 --- /dev/null +++ b/t/lib/io_dup.t @@ -0,0 +1,45 @@ +#!./perl + +BEGIN { + @INC = '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') { + print "1..0\n"; + exit 0; + } +} + +use IO::Handle; +use IO::File; + +select(STDERR); $| = 1; +select(STDOUT); $| = 1; + +print "1..6\n"; + +print "ok 1\n"; + +$dupout = IO::Handle->new->fdopen( \*STDOUT ,"w"); +$duperr = IO::Handle->new->fdopen( \*STDERR ,"w"); + +$stdout = \*STDOUT; bless $stdout, "IO::File"; # "IO::Handle"; +$stderr = \*STDERR; bless $stderr, "IO::Handle"; + +$stdout->open( "Io.dup","w") || die "Can't open stdout"; +$stderr->fdopen($stdout,"w"); + +print $stdout "ok 2\n"; +print $stderr "ok 3\n"; +system 'echo ok 4'; +system 'echo ok 5 1>&2'; + +$stderr->close; +$stdout->close; + +$stdout->fdopen($dupout,"w"); +$stderr->fdopen($duperr,"w"); + +system 'cat Io.dup'; +unlink 'Io.dup'; + +print STDOUT "ok 6\n"; diff --git a/t/lib/io_pipe.t b/t/lib/io_pipe.t new file mode 100644 index 0000000..225d04b --- /dev/null +++ b/t/lib/io_pipe.t @@ -0,0 +1,82 @@ +#!./perl + +BEGIN { + @INC = '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') { + print "1..0\n"; + exit 0; + } +} + +use IO::Pipe; + +$| = 1; +print "1..6\n"; + +$pipe = new IO::Pipe; + +$pid = fork(); + +if($pid) + { + $pipe->writer; + print $pipe "Xk 1\n"; + print $pipe "oY 2\n"; + $pipe->close; + wait; + } +elsif(defined $pid) + { + $pipe->reader; + $stdin = bless \*STDIN, "IO::Handle"; + $stdin->fdopen($pipe,"r"); + exec 'tr', 'YX', 'ko'; + } +else + { + die; + } + +$pipe = new IO::Pipe; +$pid = fork(); + +if($pid) + { + $pipe->reader; + while(<$pipe>) { + s/^not //; + print; + } + $pipe->close; + wait; + } +elsif(defined $pid) + { + $pipe->writer; + + $stdout = bless \*STDOUT, "IO::Handle"; + $stdout->fdopen($pipe,"w"); + print STDOUT "not ok 3\n"; + exec 'echo', 'not ok 4'; + } +else + { + die; + } + +$pipe = new IO::Pipe; +$pipe->writer; + +$SIG{'PIPE'} = 'broken_pipe'; + +sub broken_pipe { + print "ok 5\n"; +} + +print $pipe "not ok 5\n"; +$pipe->close; + + +print "ok 6\n"; + diff --git a/t/lib/io_sock.t b/t/lib/io_sock.t new file mode 100644 index 0000000..e888c5e --- /dev/null +++ b/t/lib/io_sock.t @@ -0,0 +1,75 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; + require Config; import Config; + if ( ($Config{'extensions'} !~ /\bSocket\b/ || + $Config{'extensions'} !~ /\bIO\b/) && + !(($^O eq 'VMS') && $Config{d_socket})) { + print "1..0\n"; + exit 0; + } +} + +$| = 1; +print "1..5\n"; + +use IO::Socket; + +$port = 4002 + int(rand(time) & 0xff); + +$pid = fork(); + +if($pid) { + + $listen = IO::Socket::INET->new(Listen => 2, + Proto => 'tcp', + LocalPort => $port + ) or die "$!"; + + print "ok 1\n"; + + # Wake out child + kill(ALRM => $pid); + + $sock = $listen->accept(); + print "ok 2\n"; + + $sock->autoflush(1); + print $sock->getline(); + + print $sock "ok 4\n"; + + $sock->close; + + waitpid($pid,0); + + print "ok 5\n"; +} elsif(defined $pid) { + + # Wait for a small pause, so that we can ensure the listen socket is setup + # the parent will awake us with a SIGALRM + + $SIG{ALRM} = sub {}; + sleep(10); + + $sock = IO::Socket::INET->new(PeerPort => $port, + Proto => 'tcp', + PeerAddr => 'localhost' + ) or die "$!"; + + $sock->autoflush(1); + print $sock "ok 3\n"; + print $sock->getline(); + $sock->close; + exit; +} else { + die; +} + + + + + + diff --git a/t/lib/io_tell.t b/t/lib/io_tell.t new file mode 100644 index 0000000..5a706fb --- /dev/null +++ b/t/lib/io_tell.t @@ -0,0 +1,54 @@ +#!./perl + +# $RCSfile: tell.t,v $$Revision: 1.1 $$Date: 1996/05/01 10:52:47 $ + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bIO\b/ && !($^O eq 'VMS')) { + print "1..0\n"; + exit 0; + } +} + +print "1..13\n"; + +use IO::File; + +$tst = IO::File->new("TEST","r") || die("Can't open TEST"); + +if ($tst->eof) { 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 ($tst->seek(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 ($tst->seek(0,1)) { print "ok 8\n"; } else { print "not ok 8\n"; } + +if ($tst->eof) { print "not ok 9\n"; } else { print "ok 9\n"; } + +if ($secondpos == tell) { print "ok 10\n"; } else { print "not ok 10\n"; } + +if ($tst->seek(0,2)) { print "ok 11\n"; } else { print "not ok 11\n"; } + +if ($lastpos == $tst->tell) { print "ok 12\n"; } else { print "not ok 12\n"; } + +unless (eof) { print "not ok 13\n"; } else { print "ok 13\n"; } diff --git a/t/lib/io_udp.t b/t/lib/io_udp.t new file mode 100644 index 0000000..84e5067 --- /dev/null +++ b/t/lib/io_udp.t @@ -0,0 +1,31 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; + require Config; import Config; + if ( ($Config{'extensions'} !~ /\bSocket\b/ || + $Config{'extensions'} !~ /\bIO\b/) && + !(($^O eq 'VMS') && $Config{d_socket})) { + print "1..0\n"; + exit 0; + } +} + +$| = 1; +print "1..3\n"; + +use Socket; +use IO::Socket qw(AF_INET SOCK_DGRAM INADDR_ANY); + +$udpa = IO::Socket::INET->new(Proto => 'udp', Addr => 'localhost'); +$udpb = IO::Socket::INET->new(Proto => 'udp', Addr => 'localhost'); + +print "ok 1\n"; + +$udpa->send("ok 2\n",0,$udpb->sockname); +$rem = $udpb->recv($buf="",5); +print $buf; +$udpb->send("ok 3\n"); +$udpa->recv($buf="",5); +print $buf; diff --git a/t/lib/io_xs.t b/t/lib/io_xs.t new file mode 100644 index 0000000..bff3d69 --- /dev/null +++ b/t/lib/io_xs.t @@ -0,0 +1,23 @@ +#!./perl +$| = 1; + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bIO\b/ && !($^O eq 'VMS')) { + print "1..0\n"; + exit 0; + } +} + +use IO::File; +use IO::Seekable; + +print "1..2\n"; +use IO::File; +$x = new_tmpfile IO::File or print "not "; +print "ok 1\n"; +print $x "ok 2\n"; +$x->seek(0,SEEK_SET); +print <$x>;