diff options
author | Perl 5 Porters <perl5-porters@africa.nicoh.com> | 1996-12-25 11:25:00 +1200 |
---|---|---|
committer | Chip Salzenberg <chip@atlantic.net> | 1996-12-25 11:25:00 +1200 |
commit | 7a4c00b4303a05a04564a03a88f4fa5c7a06a6e9 (patch) | |
tree | ed0b5c9815e3415ad3fb0f0239c9dbcc595f6997 /t | |
parent | b0c42ed9ba0f4415d135379bc4867084c8c23f6a (diff) | |
download | perl-7a4c00b4303a05a04564a03a88f4fa5c7a06a6e9.tar.gz |
[inseparable changes from patch from perl5.003_15 to perl5.003_16]
CORE PORTABILITY
Subject: _13: patches for unicos/unicosmk
Date: Fri, 20 Dec 1996 14:38:50 -0600
From: Dean Roehrich <roehrich@cray.com>
Files: Configure MANIFEST hints/unicos.sh hints/unicosmk.sh
private-msgid: <199612202038.OAA22805@poplar.cray.com>
LIBRARY AND EXTENSIONS
Subject: Refresh IO to 1.14
From: Graham Barr <gbarr@ti.com>
Files: MANIFEST ext/IO/IO.xs ext/IO/README ext/IO/lib/IO/File.pm ext/IO/lib/IO/Handle.pm ext/IO/lib/IO/Pipe.pm ext/IO/lib/IO/Seekable.pm ext/IO/lib/IO/Select.pm ext/IO/lib/IO/Socket.pm t/lib/io_dup.t t/lib/io_pipe.t t/lib/io_sel.t t/lib/io_sock.t t/lib/io_tell.t t/lib/io_udp.t t/lib/io_xs.t
OTHER CORE CHANGES
Subject: Fix 'foreach(@ARGV) { while (<>) { push @p,$_ } }'
From: Chip Salzenberg <chip@atlantic.net>
Files: cop.h pp_hot.c scope.c
Subject: Eliminate warnings from C< undef $x; $x OP= "foo" >
From: Chip Salzenberg <chip@atlantic.net>
Files: doop.c pp.c pp.h pp_hot.c
Subject: Try again to improve method caching
Date: Mon, 23 Dec 1996 20:13:56 -0500 (EST)
From: Ilya Zakharevich <ilya@math.ohio-state.edu>
Files: gv.c sv.c
Msg-ID: <199612240113.UAA09487@monk.mps.ohio-state.edu>
(applied based on p5p patch as commit 81c78688fe5c3927ad37ba29de14c86e38120317)
Subject: Be more careful about 'o' magic memory management
From: Chip Salzenberg <chip@atlantic.net>
Files: mg.c sv.c
Subject: Fix bad pointer refs when localized object loses magic
From: Chip Salzenberg <chip@atlantic.net>
Files: scope.c
Diffstat (limited to 't')
-rwxr-xr-x | t/lib/io_dup.t | 19 | ||||
-rwxr-xr-x | t/lib/io_pipe.t | 22 | ||||
-rwxr-xr-x | t/lib/io_sel.t | 108 | ||||
-rwxr-xr-x | t/lib/io_sock.t | 55 | ||||
-rwxr-xr-x | t/lib/io_tell.t | 26 | ||||
-rwxr-xr-x | t/lib/io_udp.t | 28 | ||||
-rwxr-xr-x | t/lib/io_xs.t | 21 |
7 files changed, 215 insertions, 64 deletions
diff --git a/t/lib/io_dup.t b/t/lib/io_dup.t index ac1768383a..f5d4544490 100755 --- a/t/lib/io_dup.t +++ b/t/lib/io_dup.t @@ -1,11 +1,20 @@ #!./perl BEGIN { - @INC = '../lib'; - require Config; import Config; - if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') { - print "1..0\n"; - exit 0; + unless(grep /blib/, @INC) { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; + } +} + +use Config; + +BEGIN { + if(-d "lib" && -f "TEST") { + if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') { + print "1..0\n"; + exit 0; + } } } diff --git a/t/lib/io_pipe.t b/t/lib/io_pipe.t index 6f9d30c82f..1d050ff4bd 100755 --- a/t/lib/io_pipe.t +++ b/t/lib/io_pipe.t @@ -1,11 +1,21 @@ #!./perl + BEGIN { - @INC = '../lib'; - require Config; import Config; - if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') { - print "1..0\n"; - exit 0; + unless(grep /blib/, @INC) { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; + } +} + +use Config; + +BEGIN { + if(-d "lib" && -f "TEST") { + if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') { + print "1..0\n"; + exit 0; + } } } @@ -35,7 +45,7 @@ elsif(defined $pid) } else { - die "# error = $!"; + die; } $pipe = new IO::Pipe; diff --git a/t/lib/io_sel.t b/t/lib/io_sel.t index e69de29bb2..44d9757093 100755 --- a/t/lib/io_sel.t +++ b/t/lib/io_sel.t @@ -0,0 +1,108 @@ +#!./perl + +BEGIN { + unless(grep /blib/, @INC) { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; + } +} + +select(STDERR); $| = 1; +select(STDOUT); $| = 1; + +print "1..21\n"; + +use IO::Select 1.09; + +my $sel = new IO::Select(\*STDIN); +$sel->add(4, 5) == 2 or print "not "; +print "ok 1\n"; + +$sel->add([\*STDOUT, 'foo']) == 1 or print "not "; +print "ok 2\n"; + +@handles = $sel->handles; +print "not " unless $sel->count == 4 && @handles == 4; +print "ok 3\n"; +#print $sel->as_string, "\n"; + +$sel->remove(\*STDIN) == 1 or print "not "; +print "ok 4\n", +; +$sel->remove(\*STDIN, 5, 6) == 1 # two of there are not present + or print "not "; +print "ok 5\n"; + +print "not " unless $sel->count == 2; +print "ok 6\n"; +#print $sel->as_string, "\n"; + +$sel->remove(1, 4); +print "not " unless $sel->count == 0 && !defined($sel->bits); +print "ok 7\n"; + +$sel = new IO::Select; +print "not " unless $sel->count == 0 && !defined($sel->bits); +print "ok 8\n"; + +$sel->remove([\*STDOUT, 5]); +print "not " unless $sel->count == 0 && !defined($sel->bits); +print "ok 9\n"; + +@a = $sel->can_read(); # should return imediately +print "not " unless @a == 0; +print "ok 10\n"; + +# we assume that we can write to STDOUT :-) +$sel->add([\*STDOUT, "ok 12\n"]); + +@a = $sel->can_write; +print "not " unless @a == 1; +print "ok 11\n"; + +my($fd, $msg) = @{shift @a}; +print $fd $msg; + +$sel->add(\*STDOUT); # update + +@a = IO::Select::select(undef, $sel, undef, 1); +print "not " unless @a == 3; +print "ok 13\n"; + +($r, $w, $e) = @a; + +print "not " unless @$r == 0 && @$w == 1 && @$e == 0; +print "ok 14\n"; + +$fd = $w->[0]; +print $fd "ok 15\n"; + +# Test new exists() method +$sel->exists(\*STDIN) and print "not "; +print "ok 16\n"; + +($sel->exists(0) || $sel->exists([\*STDERR])) and print "not "; +print "ok 17\n"; + +$fd = $sel->exists(\*STDOUT); +if ($fd) { + print $fd "ok 18\n"; +} else { + print "not ok 18\n"; +} + +$fd = $sel->exists([1, 'foo']); +if ($fd) { + print $fd "ok 19\n"; +} else { + print "not ok 19\n"; +} + +# Try self clearing +$sel->add(5,6,7,8,9,10); +print "not " unless $sel->count == 7; +print "ok 20\n"; + +$sel->remove($sel->handles); +print "not " unless $sel->count == 0 && !defined($sel->bits); +print "ok 21\n"; diff --git a/t/lib/io_sock.t b/t/lib/io_sock.t index 156f6cb78f..c3701c5655 100755 --- a/t/lib/io_sock.t +++ b/t/lib/io_sock.t @@ -1,14 +1,22 @@ #!./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; + unless(grep /blib/, @INC) { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; + } +} + +use Config; + +BEGIN { + if(-d "lib" && -f "TEST") { + if ( ($Config{'extensions'} !~ /\bSocket\b/ || + $Config{'extensions'} !~ /\bIO\b/) && + !(($^O eq 'VMS') && $Config{d_socket})) { + print "1..0\n"; + exit 0; + } } } @@ -17,24 +25,15 @@ print "1..5\n"; use IO::Socket; -srand(time); -$port = 4002 + int(rand 0xff); -print "# using port $port.\n"; -$SIG{ALRM} = sub {}; - -$pid = fork(); - -if($pid) { +$listen = IO::Socket::INET->new(Listen => 2, + Proto => 'tcp', + ) or die "$!"; - $listen = IO::Socket::INET->new(Listen => 2, - Proto => 'tcp', - LocalPort => $port - ) or die "$!"; +print "ok 1\n"; - print "ok 1\n"; +$port = $listen->sockport; - # Wake out child - kill(ALRM => $pid); +if($pid = fork()) { $sock = $listen->accept(); print "ok 2\n"; @@ -49,12 +48,8 @@ if($pid) { 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 - sleep(10); +} elsif(defined $pid) { $sock = IO::Socket::INET->new(PeerPort => $port, Proto => 'tcp', @@ -62,9 +57,13 @@ if($pid) { ) 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 index 5a706fb876..f45d21e095 100755 --- a/t/lib/io_tell.t +++ b/t/lib/io_tell.t @@ -1,14 +1,24 @@ #!./perl -# $RCSfile: tell.t,v $$Revision: 1.1 $$Date: 1996/05/01 10:52:47 $ +BEGIN { + unless(grep /blib/, @INC) { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; + $tell_file = "TEST"; + } + else { + $tell_file = "Makefile"; + } +} + +use Config; 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; + if(-d "lib" && -f "TEST") { + if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') { + print "1..0\n"; + exit 0; + } } } @@ -16,7 +26,7 @@ print "1..13\n"; use IO::File; -$tst = IO::File->new("TEST","r") || die("Can't open TEST"); +$tst = IO::File->new("$tell_file","r") || die("Can't open $tell_file"); if ($tst->eof) { print "not ok 1\n"; } else { print "ok 1\n"; } diff --git a/t/lib/io_udp.t b/t/lib/io_udp.t index e85583fdb3..d8377f6446 100755 --- a/t/lib/io_udp.t +++ b/t/lib/io_udp.t @@ -1,15 +1,23 @@ #!./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 'os2') && - !(($^O eq 'VMS') && $Config{d_socket})) { - print "1..0\n"; - exit 0; + unless(grep /blib/, @INC) { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; + } +} + +use Config; + +BEGIN { + if(-d "lib" && -f "TEST") { + if ( ($Config{'extensions'} !~ /\bSocket\b/ || + $Config{'extensions'} !~ /\bIO\b/ || + $^O eq 'os2') && + !(($^O eq 'VMS') && $Config{d_socket})) { + print "1..0\n"; + exit 0; + } } } @@ -25,7 +33,7 @@ $udpb = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost'); print "ok 1\n"; $udpa->send("ok 2\n",0,$udpb->sockname); -$rem = $udpb->recv($buf="",5); +$udpb->recv($buf="",5); print $buf; $udpb->send("ok 3\n"); $udpa->recv($buf="",5); diff --git a/t/lib/io_xs.t b/t/lib/io_xs.t index bff3d69c4c..3426ebe896 100755 --- a/t/lib/io_xs.t +++ b/t/lib/io_xs.t @@ -1,13 +1,20 @@ #!./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; + unless(grep /blib/, @INC) { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; + } +} + +use Config; + +BEGIN { + if(-d "lib" && -f "TEST") { + if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') { + print "1..0\n"; + exit 0; + } } } |