34 files changed, 709 insertions, 374 deletions
diff --git a/Changes b/Changes
index 450c44432f..856a5b57fc 100644
--- a/Changes
+++ b/Changes
@@ -9,6 +9,95 @@ releases.)
 
 
 ----------------
+Version 5.003_16
+----------------
+
+This patch is all bug fixes, library updates, and documentation
+updates.  We'll get to 5.004 RSN, I promise.  :-)
+
+ CORE LANGUAGE CHANGES
+
+  Title:  "Fix closures that are not in subroutines"
+   From:  Chip Salzenberg <chip@atlantic.net>
+  Files:  op.c
+
+ CORE PORTABILITY
+
+  Title:  "_13: patches for unicos/unicosmk"
+   From:  Dean Roehrich <roehrich@cray.com>
+ Msg-ID:  <199612202038.OAA22805@poplar.cray.com>
+   Date:  Fri, 20 Dec 1996 14:38:50 -0600
+  Files:  Configure MANIFEST hints/unicos.sh hints/unicosmk.sh
+
+ OTHER CORE CHANGES
+
+  Title:  "Fix 'foreach(@ARGV) { while (<>) { push @p,$_ } }'"
+   From:  Chip Salzenberg <chip@atlantic.net>
+  Files:  cop.h pp_hot.c scope.c
+
+  Title:  "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
+
+  Title:  "Try again to improve method caching"
+   From:  Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID:  <199612240113.UAA09487@monk.mps.ohio-state.edu>
+   Date:  Mon, 23 Dec 1996 20:13:56 -0500 (EST)
+  Files:  gv.c sv.c
+
+  Title:  "Be more careful about 'o' magic memory management"
+   From:  Chip Salzenberg <chip@atlantic.net>
+  Files:  mg.c sv.c
+
+  Title:  "Fix bad pointer refs when localized object loses magic"
+   From:  Chip Salzenberg <chip@atlantic.net>
+  Files:  scope.c
+
+ LIBRARY AND EXTENSIONS
+
+  Title:  "Refresh CPAN to 1.09"
+   From:  Andreas Koenig
+  Files:  lib/CPAN.pm
+
+  Title:  "Refresh Net::Ping to 2.02"
+   From:  Russell Mosemann <mose@ccsn.edu>
+  Files:  lib/Net/Ping.pm
+
+  Title:  "Refresh IO to 1.14"
+   From:  Graham Barr
+  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
+
+ BUILD PROCESS AND UTILITIES
+
+  Title:  "Don't recurse into subdirs twice on 'make realclean'"
+   From:  Chip Salzenberg <chip@atlantic.net>
+  Files:  Makefile.SH
+
+  Title:  "Use root EXTERN.h when compiling x2p/malloc.c."
+   From:  Paul Marquess
+  Files:  x2p/Makefile.SH
+
+  Title:  "Fix compilation errors when malloc.c used for x2p"
+   From:  Robin Barker <rmb@cise.npl.co.uk>
+  Files:  malloc.c
+
+ DOCUMENTATION
+
+  Title:  "Edit INSTALL to describe new binary compat setup"
+   From:  Chip Salzenberg <chip@atlantic.net>
+  Files:  INSTALL
+
+  Title:  "Update to perllocale.pod"
+   From:  Jarkko Hietaniemi <jhi@cc.hut.fi>
+  Files:  pod/perllocale.pod
+
+
+----------------
 Version 5.003_15
 ----------------
 
diff --git a/Configure b/Configure
index c5fe4a413d..3ae746cb41 100755
--- a/Configure
+++ b/Configure
@@ -1644,6 +1644,7 @@ EOM
 	$test -f /dnix && osname=dnix
 	$test -f /lynx.os && osname=lynxos
 	$test -f /unicos && osname=unicos && osvers=`$uname -r`
+	$test -f /unicosmk.ar && osname=unicosmk && osvers=`$uname -r`
 	$test -f /bin/mips && /bin/mips && osname=mips
 	$test -d /NextApps && set X `hostinfo | grep 'NeXT Mach.*:' | \
 		$sed -e 's/://' -e 's/\./_/'` && osname=next && osvers=$4
diff --git a/MANIFEST b/MANIFEST
index d25601043c..025bb2c088 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -108,6 +108,7 @@ ext/GDBM_File/typemap		GDBM extension interface types
 ext/IO/IO.pm			Top-level interface to IO::* classes
 ext/IO/IO.xs			IO extension external subroutines
 ext/IO/Makefile.PL		IO extension makefile writer
+ext/IO/README			IO extension maintenance notice
 ext/IO/lib/IO/File.pm		IO::File extension Perl module
 ext/IO/lib/IO/Handle.pm		IO::Handle extension Perl module
 ext/IO/lib/IO/Pipe.pm		IO::Pipe extension Perl module
@@ -257,6 +258,7 @@ hints/titanos.sh	Hints for named architecture
 hints/ultrix_4.sh	Hints for named architecture
 hints/umips.sh		Hints for named architecture
 hints/unicos.sh		Hints for named architecture
+hints/unicosmk.sh	Hints for named architecture
 hints/unisysdynix.sh	Hints for named architecture
 hints/utekv.sh		Hints for named architecture
 hints/uts.sh		Hints for named architecture
@@ -601,6 +603,7 @@ t/lib/getopt.t		See if Getopt::Std and Getopt::Long works
 t/lib/hostname.t	See if Sys::Hostname works
 t/lib/io_dup.t		See if dup()-related methods from IO work
 t/lib/io_pipe.t		See if pipe()-related methods from IO work
+t/lib/io_sel.t		See if select()-related methods from IO work
 t/lib/io_sock.t		See if INET socket-related methods from IO work
 t/lib/io_taint.t	See if the untaint method from IO works
 t/lib/io_tell.t		See if seek()/tell()-related methods from IO work
diff --git a/cop.h b/cop.h
index c062dc63e4..543c039f85 100644
--- a/cop.h
+++ b/cop.h
@@ -105,13 +105,16 @@ struct block_loop {
 	cx->blk_loop.next_op = cLOOP->op_nextop;			\
 	cx->blk_loop.last_op = cLOOP->op_lastop;			\
 	cx->blk_loop.iterlval = Nullsv;					\
-	cx->blk_loop.itervar = ivar;					\
-	if (ivar)							\
-	    cx->blk_loop.itersave = *cx->blk_loop.itervar;
+	if (cx->blk_loop.itervar = (ivar))				\
+	    cx->blk_loop.itersave = SvREFCNT_inc(*cx->blk_loop.itervar);
 
 #define POPLOOP(cx)							\
 	newsp		= stack_base + cx->blk_loop.resetsp;		\
-	SvREFCNT_dec(cx->blk_loop.iterlval)
+	SvREFCNT_dec(cx->blk_loop.iterlval);				\
+	if (cx->blk_loop.itervar) {					\
+	    SvREFCNT_dec(*cx->blk_loop.itervar);			\
+	    *cx->blk_loop.itervar = cx->blk_loop.itersave;		\
+	}
 
 /* context common to subroutines, evals and loops */
 struct block {
diff --git a/doop.c b/doop.c
index 836027ef4d..33726bf983 100644
--- a/doop.c
+++ b/doop.c
@@ -528,16 +528,20 @@ SV *right;
     register char *dc;
     STRLEN leftlen;
     STRLEN rightlen;
-    register char *lc = SvPV(left, leftlen);
-    register char *rc = SvPV(right, rightlen);
+    register char *lc;
+    register char *rc;
     register I32 len;
     I32 lensave;
-    char *lsave = lc;
-    char *rsave = rc;
+    char *lsave;
+    char *rsave;
 
+    if (sv == left && !SvOK(sv) && !SvGMAGICAL(sv) && SvTYPE(sv) <= SVt_PVMG)
+	sv_setpvn(sv, "", 0);	/* avoid warning on &= etc. */
+    lsave = lc = SvPV(left, leftlen);
+    rsave = rc = SvPV(right, rightlen);
     len = leftlen < rightlen ? leftlen : rightlen;
     lensave = len;
-    if (SvOK(sv)) {
+    if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
 	dc = SvPV_force(sv, na);
 	if (SvCUR(sv) < len) {
 	    dc = SvGROW(sv, len + 1);
diff --git a/ext/IO/IO.xs b/ext/IO/IO.xs
index 3cc3518e7e..a6eb075964 100644
--- a/ext/IO/IO.xs
+++ b/ext/IO/IO.xs
@@ -203,6 +203,7 @@ int
 untaint(handle)
        SV *	handle
     CODE:
+#ifdef IOf_UNTAINT
 	IO * io;
 	io = sv_2io(handle);
 	if (io) {
@@ -210,9 +211,12 @@ untaint(handle)
 	    RETVAL = 0;
 	}
         else {
+#endif
 	    RETVAL = -1;
 	    errno = EINVAL;
+#ifdef IOf_UNTAINT
 	}
+#endif
     OUTPUT:
 	RETVAL
 
diff --git a/ext/IO/README b/ext/IO/README
new file mode 100644
index 0000000000..e855afade4
--- /dev/null
+++ b/ext/IO/README
@@ -0,0 +1,4 @@
+This directory contains files from the IO distribution maintained by
+Graham Barr <bodg@tiuk.ti.com>. If you find that you have to modify
+any files in this directory then please forward him a patch for only
+the files in this directory.
diff --git a/ext/IO/lib/IO/File.pm b/ext/IO/lib/IO/File.pm
index 81d48b1c54..e44d77f1fe 100644
--- a/ext/IO/lib/IO/File.pm
+++ b/ext/IO/lib/IO/File.pm
@@ -1,3 +1,5 @@
+#
+
 package IO::File;
 
 =head1 NAME
@@ -91,14 +93,11 @@ L<IO::Seekable>
 
 Derived from FileHandle.pm by Graham Barr E<lt>F<bodg@tiuk.ti.com>E<gt>.
 
-=head1 REVISION
-
-$Revision: 1.5 $
-
 =cut
 
 require 5.000;
-use vars qw($VERSION @EXPORT @EXPORT_OK $AUTOLOAD);
+use strict;
+use vars qw($VERSION @EXPORT @EXPORT_OK $AUTOLOAD @ISA);
 use Carp;
 use Symbol;
 use SelectSaver;
@@ -110,7 +109,7 @@ require DynaLoader;
 
 @ISA = qw(IO::Handle IO::Seekable Exporter DynaLoader);
 
-$VERSION = sprintf("%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/);
+$VERSION = "1.06";
 
 @EXPORT = @IO::Seekable::EXPORT;
 
diff --git a/ext/IO/lib/IO/Handle.pm b/ext/IO/lib/IO/Handle.pm
index 7b8c709c78..59741c1c11 100644
--- a/ext/IO/lib/IO/Handle.pm
+++ b/ext/IO/lib/IO/Handle.pm
@@ -180,12 +180,11 @@ class from C<IO::Handle> and inherit those methods.
 
 Derived from FileHandle.pm by Graham Barr E<lt>F<bodg@tiuk.ti.com>E<gt>
 
-Version 1.1201 specialized from 1.12 for inclusion in Perl distribution
-
 =cut
 
 require 5.000;
-use vars qw($RCS $VERSION @EXPORT_OK $AUTOLOAD);
+use strict;
+use vars qw($VERSION @EXPORT_OK $AUTOLOAD @ISA);
 use Carp;
 use Symbol;
 use SelectSaver;
@@ -193,8 +192,7 @@ use SelectSaver;
 require Exporter;
 @ISA = qw(Exporter);
 
-$VERSION = "1.1201";
-$RCS = sprintf("%s", q$Revision: 1.15 $ =~ /([\d\.]+)/);
+$VERSION = "1.14";
 
 @EXPORT_OK = qw(
     autoflush
@@ -244,6 +242,7 @@ sub AUTOLOAD {
     $constname =~ s/.*:://;
     my $val = constant($constname);
     defined $val or croak "$constname is not a valid IO::Handle macro";
+    no strict 'refs';
     *$AUTOLOAD = sub { $val };
     goto &$AUTOLOAD;
 }
@@ -270,16 +269,23 @@ sub new_from_fd {
     bless $fh, $class;
 }
 
-#
-# That an IO::Handle is being destroyed does not necessarily mean
-# that the associated filehandle should be closed.  This is because
-# *FOO{FILEHANDLE} may by a synonym for *BAR{FILEHANDLE}.
-#
-# If this IO::Handle really does have the final reference to the
-# given FILEHANDLE, then Perl will close it for us automatically.
-#
-
 sub DESTROY {
+    my ($fh) = @_;
+
+    # During global object destruction, this function may be called
+    # on FILEHANDLEs as well as on the GLOBs that contains them.
+    # Thus the following trickery.  If only the CORE file operators
+    # could deal with FILEHANDLEs, it wouldn't be necessary...
+
+    if ($fh =~ /=FILEHANDLE\(/) {
+	local *TMP = $fh;
+	close(TMP)
+	    if defined fileno(TMP);
+    }
+    else {
+	close($fh)
+	    if defined fileno($fh);
+    }
 }
 
 ################################################
diff --git a/ext/IO/lib/IO/Pipe.pm b/ext/IO/lib/IO/Pipe.pm
index 9ec8b6498a..34cb0daad2 100644
--- a/ext/IO/lib/IO/Pipe.pm
+++ b/ext/IO/lib/IO/Pipe.pm
@@ -4,7 +4,7 @@ package IO::Pipe;
 
 =head1 NAME
 
-IO::Pipe - supply object methods for pipes
+IO::pipe - supply object methods for pipes
 
 =head1 SYNOPSIS
 
@@ -89,11 +89,7 @@ L<IO::Handle>
 
 =head1 AUTHOR
 
-Graham Barr E<lt>F<bodg@tiuk.ti.com>E<gt>
-
-=head1 REVISION
-
-$Revision: 1.7 $
+Graham Barr <bodg@tiuk.ti.com>
 
 =head1 COPYRIGHT
 
@@ -104,12 +100,13 @@ as Perl itself.
 =cut
 
 require 5.000;
+use     strict;
 use 	vars qw($VERSION);
 use 	Carp;
 use 	Symbol;
 require IO::Handle;
 
-$VERSION = sprintf("%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/);
+$VERSION = "1.08";
 
 sub new {
     my $type = shift;
@@ -165,9 +162,10 @@ sub reader {
     my $pid = $me->_doit(0,@_)
 	if(@_);
 
+    close(${*$me}[1]);
     bless $me, ref($fh);
-    *{*$me} = *{*$fh};		# Alias self to handle
-    bless $fh;			# Really wan't un-bless here
+    *{*$me} = *{*$fh};			# Alias self to handle
+    bless $fh, 'IO::Pipe::DeadEnd';	# Really wan't un-bless here
     ${*$me}{'io_pipe_pid'} = $pid
 	if defined $pid;
 
@@ -181,9 +179,10 @@ sub writer {
     my $pid = $me->_doit(1,@_)
 	if(@_);
 
+    close(${*$me}[0]);
     bless $me, ref($fh);
-    *{*$me} = *{*$fh};		# Alias self to handle
-    bless $fh;			# Really wan't un-bless here
+    *{*$me} = *{*$fh};			# Alias self to handle
+    bless $fh, 'IO::Pipe::DeadEnd';	# Really wan't un-bless here
     ${*$me}{'io_pipe_pid'} = $pid
 	if defined $pid;
 
diff --git a/ext/IO/lib/IO/Seekable.pm b/ext/IO/lib/IO/Seekable.pm
index 8e0f87ac18..e8a9530e80 100644
--- a/ext/IO/lib/IO/Seekable.pm
+++ b/ext/IO/lib/IO/Seekable.pm
@@ -42,14 +42,11 @@ L<IO::File>
 
 Derived from FileHandle.pm by Graham Barr E<lt>bodg@tiuk.ti.comE<gt>
 
-=head1 REVISION
-
-$Revision: 1.5 $
-
 =cut
 
 require 5.000;
 use Carp;
+use strict;
 use vars qw($VERSION @EXPORT @ISA);
 use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END);
 require Exporter;
@@ -57,7 +54,7 @@ require Exporter;
 @EXPORT = qw(SEEK_SET SEEK_CUR SEEK_END);
 @ISA = qw(Exporter);
 
-$VERSION = sprintf("%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/);
+$VERSION = "1.06";
 
 sub clearerr {
     @_ == 1 or croak 'usage: $fh->clearerr()';
diff --git a/ext/IO/lib/IO/Select.pm b/ext/IO/lib/IO/Select.pm
index 845d6b25a4..dea684a62e 100644
--- a/ext/IO/lib/IO/Select.pm
+++ b/ext/IO/lib/IO/Select.pm
@@ -1,4 +1,8 @@
 # IO::Select.pm
+#
+# Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
+# software; you can redistribute it and/or modify it under the same terms
+# as Perl itself.
 
 package IO::Select;
 
@@ -47,17 +51,30 @@ will be returned when an event occurs. C<IO::Select> keeps these values in a
 cache which is indexed by the C<fileno> of the handle, so if more than one
 handle with the same C<fileno> is specified then only the last one is cached.
 
+Each handle can be an C<IO::Handle> object, an integer or an array
+reference where the first element is a C<IO::Handle> or an integer.
+
 =item remove ( HANDLES )
 
 Remove all the given handles from the object. This method also works
 by the C<fileno> of the handles. So the exact handles that were added
 need not be passed, just handles that have an equivalent C<fileno>
 
+=item exists ( HANDLE )
+
+Returns a true value (actually the handle itself) if it is present.
+Returns undef otherwise.
+
+=item handles
+
+Return an array of all registered handles.
+
 =item can_read ( [ TIMEOUT ] )
 
-Return an array of handles that are ready for reading. C<TIMEOUT> is the maximum
-amount of time to wait before returning an empty list. If C<TIMEOUT> is
-not given then the call will block.
+Return an array of handles that are ready for reading. C<TIMEOUT> is
+the maximum amount of time to wait before returning an empty list. If
+C<TIMEOUT> is not given and any handles are registered then the call
+will block.
 
 =item can_write ( [ TIMEOUT ] )
 
@@ -65,8 +82,8 @@ Same as C<can_read> except check for handles that can be written to.
 
 =item has_error ( [ TIMEOUT ] )
 
-Same as C<can_read> except check for handles that have an error condition, for
-example EOF.
+Same as C<can_read> except check for handles that have an error
+condition, for example EOF.
 
 =item count ()
 
@@ -74,12 +91,20 @@ Returns the number of handles that the object will check for when
 one of the C<can_> methods is called or the object is passed to
 the C<select> static method.
 
+=item bits()
+
+Return the bit string suitable as argument to the core select() call.
+
+=item bits()
+
+Return the bit string suitable as argument to the core select() call.
+
 =item select ( READ, WRITE, ERROR [, TIMEOUT ] )
 
-C<select> is a static method, that is you call it with the package name
-like C<new>. C<READ>, C<WRITE> and C<ERROR> are either C<undef> or
-C<IO::Select> objects. C<TIMEOUT> is optional and has the same effect as
-before.
+C<select> is a static method, that is you call it with the package
+name like C<new>. C<READ>, C<WRITE> and C<ERROR> are either C<undef>
+or C<IO::Select> objects. C<TIMEOUT> is optional and has the same
+effect as for the core select call.
 
 The result will be an array of 3 elements, each a reference to an array
 which will hold the handles that are ready for reading, writing and have
@@ -120,10 +145,6 @@ listening for more connections on a listen socket
 
 Graham Barr E<lt>F<Graham.Barr@tiuk.ti.com>E<gt>
 
-=head1 REVISION
-
-$Revision: 1.9 $
-
 =head1 COPYRIGHT
 
 Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
@@ -136,13 +157,13 @@ use     strict;
 use     vars qw($VERSION @ISA);
 require Exporter;
 
-$VERSION = sprintf("%d.%02d", q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/);
+$VERSION = "1.10";
 
 @ISA = qw(Exporter); # This is only so we can do version checking
 
-sub VEC_BITS {0}
-sub FD_COUNT {1}
-sub FIRST_FD {2}
+sub VEC_BITS () {0}
+sub FD_COUNT () {1}
+sub FIRST_FD () {2}
 
 sub new
 {
@@ -159,39 +180,63 @@ sub new
 
 sub add
 {
+ shift->_update('add', @_);
+}
+
+
+sub remove
+{
+ shift->_update('remove', @_);
+}
+
+
+sub exists
+{
  my $vec = shift;
- my $f;
+ $vec->[$vec->_fileno(shift) + FIRST_FD];
+}
 
- $vec->[VEC_BITS] = '' unless defined $vec->[VEC_BITS];
 
- foreach $f (@_)
-  {
-   my $fn = $f =~ /^\d+$/ ? $f : fileno($f);
-   next
-    unless defined $fn;
-   vec($vec->[VEC_BITS],$fn,1) = 1;
-   $vec->[FD_COUNT] += 1
-	unless defined $vec->[$fn+FIRST_FD];
-   $vec->[$fn+FIRST_FD] = $f;
-  }
- $vec->[VEC_BITS] = undef unless $vec->count;
+sub _fileno
+{
+ my($self, $f) = @_;
+ $f = $f->[0] if ref($f) eq 'ARRAY';
+ ($f =~ /^\d+$/) ? $f : fileno($f);
 }
 
-sub remove
+sub _update
 {
  my $vec = shift;
- my $f;
+ my $add = shift eq 'add';
 
+ my $bits = $vec->[VEC_BITS];
+ $bits = '' unless defined $bits;
+
+ my $count = 0;
+ my $f;
  foreach $f (@_)
   {
-   my $fn = $f =~ /^\d+$/ ? $f : fileno($f);
-   next
-    unless defined $fn;
-   vec($vec->[VEC_BITS],$fn,1) = 0;
-   $vec->[$fn+FIRST_FD] = undef;
-   $vec->[FD_COUNT] -= 1;
+   my $fn = $vec->_fileno($f);
+   next unless defined $fn;
+   my $i = $fn + FIRST_FD;
+   if ($add) {
+     if (defined $vec->[$i]) {
+	 $vec->[$i] = $f;  # if array rest might be different, so we update
+	 next;
+     }
+     $vec->[FD_COUNT]++;
+     vec($bits, $fn, 1) = 1;
+     $vec->[$i] = $f;
+   } else {      # remove
+     next unless defined $vec->[$i];
+     $vec->[FD_COUNT]--;
+     vec($bits, $fn, 1) = 0;
+     $vec->[$i] = undef;
+   }
+   $count++;
   }
- $vec->[VEC_BITS] = undef unless $vec->count;
+ $vec->[VEC_BITS] = $vec->[FD_COUNT] ? $bits : undef;
+ $count;
 }
 
 sub can_read
@@ -201,7 +246,7 @@ sub can_read
  my $r = $vec->[VEC_BITS];
 
  defined($r) && (select($r,undef,undef,$timeout) > 0)
-    ? _handles($vec, $r)
+    ? handles($vec, $r)
     : ();
 }
 
@@ -212,7 +257,7 @@ sub can_write
  my $w = $vec->[VEC_BITS];
 
  defined($w) && (select(undef,$w,undef,$timeout) > 0)
-    ? _handles($vec, $w)
+    ? handles($vec, $w)
     : ();
 }
 
@@ -223,7 +268,7 @@ sub has_error
  my $e = $vec->[VEC_BITS];
 
  defined($e) && (select(undef,undef,$e,$timeout) > 0)
-    ? _handles($vec, $e)
+    ? handles($vec, $e)
     : ();
 }
 
@@ -233,6 +278,28 @@ sub count
  $vec->[FD_COUNT];
 }
 
+sub bits
+{
+ my $vec = shift;
+ $vec->[VEC_BITS];
+}
+
+sub as_string  # for debugging
+{
+ my $vec = shift;
+ my $str = ref($vec) . ": ";
+ my $bits = $vec->bits;
+ my $count = $vec->count;
+ $str .= defined($bits) ? unpack("b*", $bits) : "undef";
+ $str .= " $count";
+ my @handles = @$vec;
+ splice(@handles, 0, FIRST_FD);
+ for (@handles) {
+     $str .= " " . (defined($_) ? "$_" : "-");
+ }
+ $str;
+}
+
 sub _max
 {
  my($a,$b,$c) = @_;
@@ -254,8 +321,8 @@ sub select
  my @result = ();
 
  my $rb = defined $r ? $r->[VEC_BITS] : undef;
- my $wb = defined $w ? $e->[VEC_BITS] : undef;
- my $eb = defined $e ? $w->[VEC_BITS] : undef;
+ my $wb = defined $w ? $w->[VEC_BITS] : undef;
+ my $eb = defined $e ? $e->[VEC_BITS] : undef;
 
  if(select($rb,$wb,$eb,$t) > 0)
   {
@@ -282,18 +349,20 @@ sub select
  @result;
 }
 
-sub _handles
+
+sub handles
 {
  my $vec = shift;
  my $bits = shift;
  my @h = ();
  my $i;
+ my $max = scalar(@$vec) - 1;
 
- for($i = scalar(@$vec) - 1 ; $i >= FIRST_FD ; $i--)
+ for ($i = FIRST_FD; $i <= $max; $i++)
   {
    next unless defined $vec->[$i];
    push(@h, $vec->[$i])
-      if vec($bits,$i - FIRST_FD,1);
+      if !defined($bits) || vec($bits, $i - FIRST_FD, 1);
   }
  
  @h;
diff --git a/ext/IO/lib/IO/Socket.pm b/ext/IO/lib/IO/Socket.pm
index 94ae88a536..6a69c6b624 100644
--- a/ext/IO/lib/IO/Socket.pm
+++ b/ext/IO/lib/IO/Socket.pm
@@ -20,13 +20,15 @@ C<IO::Socket> only defines methods for those operations which are common to all
 types of socket. Operations which are specified to a socket in a particular 
 domain have methods defined in sub classes of C<IO::Socket>
 
+C<IO::Socket> will export all functions (and constants) defined by L<Socket>.
+
 =head1 CONSTRUCTOR
 
 =over 4
 
 =item new ( [ARGS] )
 
-Creates a C<IO::Pipe>, which is a reference to a
+Creates a C<IO::Socket>, which is a reference to a
 newly created symbol (see the C<Symbol> package). C<new>
 optionally takes arguments, these arguments are in key-value pairs.
 C<new> only looks for one key C<Domain> which tells new which domain
@@ -81,12 +83,12 @@ with one argument then getsockopt is called, otherwise setsockopt is called.
 
 =item sockdomain
 
-Returns the numerical number for the socket domain type. For example, fir
+Returns the numerical number for the socket domain type. For example, for
 a AF_INET socket the value of &AF_INET will be returned.
 
 =item socktype
 
-Returns the numerical number for the socket type. For example, fir
+Returns the numerical number for the socket type. For example, for
 a SOCK_STREAM socket the value of &SOCK_STREAM will be returned.
 
 =item protocol
@@ -107,14 +109,12 @@ use IO::Handle;
 use Socket 1.3;
 use Carp;
 use strict;
-use vars qw(@ISA @EXPORT_OK $VERSION);
+use vars qw(@ISA $VERSION);
 use Exporter;
 
 @ISA = qw(IO::Handle);
 
-# This one will turn 1.2 => 1.02 and 1.2.3 => 1.0203 and so on ...
-
-$VERSION = do{my @r=(q$Revision: 1.13 $=~/(\d+)/g);sprintf "%d."."%02d"x$#r,@r};
+$VERSION = "1.15";
 
 sub import {
     my $pkg = shift;
@@ -155,12 +155,13 @@ sub configure {
     croak 'IO::Socket: Cannot configure a generic socket'
 	unless defined $domain;
 
-    my $sub = ref(_domain2pkg($domain)) . "::configure";
+    my $class = ref(_domain2pkg($domain));
 
-    goto &{$sub}
-	if(defined &{$sub});
+    croak "IO::Socket: Cannot configure socket in domain '$domain'"
+	unless ref($fh) eq "IO::Socket";
 
-    croak "IO::Socket: Cannot configure socket in domain '$domain' $sub";
+    bless($fh, $class);
+    $fh->configure;
 }
 
 sub socket {
@@ -366,27 +367,6 @@ sub protocol {
     ${*$fh}{'io_socket_protocol'};
 }
 
-sub _addmethod {
-    my $self = shift;
-    my $name;
-
-    foreach $name (@_) {
-	my $n = $name;
-
-	no strict qw(refs);
-
-	*{$n} = sub { 
-		    my $pkg = ref(${*{$_[0]}}{'io_socket_domain'});
-		    my $sub = "${pkg}::${n}";
-		    goto &{$sub} if defined &{$sub};
-		    croak qq{Can't locate object method "$n" via package "$pkg"};
-		}
-		unless defined &{$n};
-    }
-
-}
-
-
 =head1 SUB-CLASSES
 
 =cut
@@ -398,14 +378,13 @@ sub _addmethod {
 package IO::Socket::INET;
 
 use strict;
-use vars qw(@ISA $VERSION);
+use vars qw(@ISA);
 use Socket;
 use Carp;
 use Exporter;
 
 @ISA = qw(IO::Socket);
 
-IO::Socket::INET->_addmethod( qw(sockaddr sockport sockhost peeraddr peerport peerhost));
 IO::Socket::INET->register_domain( AF_INET );
 
 my %socket_type = ( tcp => SOCK_STREAM,
@@ -417,22 +396,45 @@ my %socket_type = ( tcp => SOCK_STREAM,
 C<IO::Socket::INET> provides a constructor to create an AF_INET domain socket
 and some related methods. The constructor can take the following options
 
-    PeerAddr	Remote host address
-    PeerPort	Remote port or service
-    LocalPort	Local host bind	port
-    LocalAddr	Local host bind	address
-    Proto	Protocol name (eg tcp udp etc)
-    Type	Socket type (SOCK_STREAM etc)
+    PeerAddr	Remote host address             <hostname>[:<port>]
+    PeerPort	Remote port or service          <service>[(<no>)] | <no>
+    LocalAddr	Local host bind	address         hostname[:port]
+    LocalPort	Local host bind	port            <service>[(<no>)] | <no>
+    Proto	Protocol name                   "tcp" | "udp" | ...
+    Type	Socket type                     SOCK_STREAM | SOCK_DGRAM | ...
     Listen	Queue size for listen
+    Reuse	Set SO_REUSEADDR before binding
     Timeout	Timeout	value for various operations
 
 
-If Listen is defined then a listen socket is created, else if the socket
-type,   which is derived from the protocol, is SOCK_STREAM then a connect
-is called.
+If C<Listen> is defined then a listen socket is created, else if the
+socket type, which is derived from the protocol, is SOCK_STREAM then
+connect() is called.
+
+The C<PeerAddr> can be a hostname or the IP-address on the
+"xx.xx.xx.xx" form.  The C<PeerPort> can be a number or a symbolic
+service name.  The service name might be followed by a number in
+parenthesis which is used if the service is not known by the system.
+The C<PeerPort> specification can also be embedded in the C<PeerAddr>
+by preceding it with a ":".
+
+Only one of C<Type> or C<Proto> needs to be specified, one will be
+assumed from the other.  If you specify a symbolic C<PeerPort> port,
+then the constructor will try to derive C<Type> and C<Proto> from
+the service name.
 
-Only one of C<Type> or C<Proto> needs to be specified, one will be assumed
-from the other.
+Examples:
+
+   $sock = IO::Socket::INET->new(PeerAddr => 'www.perl.org',
+                                 PeerPort => http(80),
+                                 Proto    => 'tcp');
+
+   $sock = IO::Socket::INET->new(PeerAddr => 'localhost:smtp(25)');
+
+   $sock = IO::Socket::INET->new(Listen    => 5,
+                                 LocalAddr => 'localhost',
+                                 LocalPort => 9000,
+                                 Proto     => 'tcp');
 
 =head2 METHODS
 
@@ -469,7 +471,6 @@ peer host in a text form xx.xx.xx.xx
 
 =cut
 
-
 sub _sock_info {
   my($addr,$port,$proto) = @_;
   my @proto = ();
@@ -508,7 +509,8 @@ sub _sock_info {
 
 sub _error {
     my $fh = shift;
-    carp join("",ref($fh),": ",@_) if @_;
+    $@ = join("",ref($fh),": ",@_);
+    carp $@ if $^W;
     close($fh)
 	if(defined fileno($fh));
     return undef;
@@ -551,14 +553,19 @@ sub configure {
     ${*$fh}{'io_socket_domain'} = bless \$domain;
 
     $fh->socket(AF_INET, $type, $proto) or
-	return _error($fh);
+	return _error($fh,"$!");
+
+    if ($arg->{Reuse}) {
+	$fh->sockopt(SO_REUSEADDR,1) or
+		return _error($fh);
+    }
 
     $fh->bind($lport || 0, $laddr) or
-	return _error($fh);
+	return _error($fh,"$!");
 
     if(exists $arg->{Listen}) {
 	$fh->listen($arg->{Listen} || 5) or
-	    return _error($fh);
+	    return _error($fh,"$!");
     }
     else {
 	return _error($fh,'Cannot determine remote port')
@@ -569,7 +576,7 @@ sub configure {
 	    	unless(defined $raddr);
 
 	    $fh->connect($rport,$raddr) or
-		return _error($fh);
+		return _error($fh,"$!");
 	}
     }
 
@@ -626,7 +633,6 @@ use Exporter;
 
 @ISA = qw(IO::Socket);
 
-IO::Socket::UNIX->_addmethod(qw(hostpath peerpath));
 IO::Socket::UNIX->register_domain( AF_UNIX );
 
 =head2 IO::Socket::UNIX
@@ -645,11 +651,11 @@ and some related methods. The constructor can take the following options
 
 =item hostpath()
 
-Returns the pathname to the fifo at the local end.
+Returns the pathname to the fifo at the local end
 
 =item peerpath()
 
-Returns the pathanme to the fifo at the peer end.
+Returns the pathanme to the fifo at the peer end
 
 =back
 
@@ -688,32 +694,22 @@ sub configure {
 sub hostpath {
     @_ == 1 or croak 'usage: $fh->hostpath()';
     my $n = $_[0]->sockname || return undef;
-warn length($n);
     (sockaddr_un($n))[0];
 }
 
 sub peerpath {
     @_ == 1 or croak 'usage: $fh->peerpath()';
     my $n = $_[0]->peername || return undef;
-warn length($n);
-my @n = sockaddr_un($n);
-warn join(",",@n);
     (sockaddr_un($n))[0];
 }
 
-=head1 AUTHOR
-
-Graham Barr E<lt>F<Graham.Barr@tiuk.ti.com>E<gt>
+=head1 SEE ALSO
 
-=head1 REVISION
+L<Socket>, L<IO::Handle>
 
-$Revision: 1.13 $
-
-The VERSION is derived from the revision turning each number after the
-first dot into a 2 digit number so
+=head1 AUTHOR
 
-	Revision 1.8   => VERSION 1.08
-	Revision 1.2.3 => VERSION 1.0203
+Graham Barr E<lt>F<Graham.Barr@tiuk.ti.com>E<gt>
 
 =head1 COPYRIGHT
 
diff --git a/gv.c b/gv.c
index fed7eca3dc..6dd8ad0f3c 100644
--- a/gv.c
+++ b/gv.c
@@ -143,19 +143,20 @@ I32 level;
     if (SvTYPE(topgv) != SVt_PVGV)
 	gv_init(topgv, stash, name, len, TRUE);
 
-    if (cv=GvCV(topgv)) {
-	if (GvCVGEN(topgv) >= sub_generation)
-	    return topgv;	/* valid cached inheritance */
-	if (!GvCVGEN(topgv)) {	/* not an inheritance cache */
-	    return topgv;
-	}
-	else {
-	    /* stale cached entry, just junk it */
-	    GvCV(topgv) = cv = 0;
-	    GvCVGEN(topgv) = 0;
+    if (cv = GvCV(topgv)) {
+	if (CvXSUB(cv) || CvROOT(cv) || CvGV(cv)) { /* Not deleted, possibly autoloaded. */
+	    if (GvCVGEN(topgv) >= sub_generation)
+		return topgv;	/* valid cached inheritance */
+	    if (!GvCVGEN(topgv)) {	/* not an inheritance cache */
+		return topgv;
+	    }
 	}
+	/* stale cached entry, just junk it */
+	SvREFCNT_dec(cv);
+	GvCV(topgv) = cv = 0;
+	GvCVGEN(topgv) = 0;
     }
-    /* if cv is still set, we have to free it if we find something to cache */
+    /* Now cv = 0, and there is no cv in topgv. */
 
     gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE);
     if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) {
@@ -172,13 +173,9 @@ I32 level;
 	    }
 	    gv = gv_fetchmeth(basestash, name, len, level + 1);
 	    if (gv) {
-		if (cv) {				/* junk old undef */
-		    assert(SvREFCNT(topgv) > 1);
-		    SvREFCNT_dec(topgv);
-		    SvREFCNT_dec(cv);
-		}
 		GvCV(topgv) = GvCV(gv);			/* cache the CV */
 		GvCVGEN(topgv) = sub_generation;	/* valid for now */
+		SvREFCNT_inc(GvCV(gv));
 		return gv;
 	    }
 	}
@@ -187,13 +184,9 @@ I32 level;
     if (!level) {
 	if (lastchance = gv_stashpvn("UNIVERSAL", 9, FALSE)) {
 	    if (gv = gv_fetchmeth(lastchance, name, len, level + 1)) {
-		if (cv) {				/* junk old undef */
-		    assert(SvREFCNT(topgv) > 1);
-		    SvREFCNT_dec(topgv);
-		    SvREFCNT_dec(cv);
-		}
 		GvCV(topgv) = GvCV(gv);			/* cache the CV */
 		GvCVGEN(topgv) = sub_generation;	/* valid for now */
+		SvREFCNT_inc(GvCV(gv));
 		return gv;
 	    }
 	}
diff --git a/hints/unicos.sh b/hints/unicos.sh
index 272cb9b5d6..b864019a84 100644
--- a/hints/unicos.sh
+++ b/hints/unicos.sh
@@ -1,9 +1,7 @@
 case `uname -r` in
 6.1*) shellflags="-m+65536" ;;
 esac
-ccflags="$ccflags -DHZ=__hertz"
 optimize="-O1"
-libswanted=m
 d_setregid='undef'
 d_setreuid='undef'
 
diff --git a/hints/unicosmk.sh b/hints/unicosmk.sh
new file mode 100644
index 0000000000..90784b5b39
--- /dev/null
+++ b/hints/unicosmk.sh
@@ -0,0 +1,3 @@
+optimize="-O1"
+d_setregid='undef'
+d_setreuid='undef'
diff --git a/hv.c b/hv.c
index 806e573d5c..3208b56651 100644
--- a/hv.c
+++ b/hv.c
@@ -752,7 +752,7 @@ I32 shared;
 {
     if (!hent)
 	return;
-    if (SvTYPE(HeVAL(hent)) == SVt_PVGV)
+    if (SvTYPE(HeVAL(hent)) == SVt_PVGV && GvCV(HeVAL(hent)))
 	sub_generation++;		/* May be deletion of method? */
     SvREFCNT_dec(HeVAL(hent));
     if (HeKLEN(hent) == HEf_SVKEY) {
diff --git a/lib/strict.pm b/lib/strict.pm
index e261e92f67..8492e933fd 100644
--- a/lib/strict.pm
+++ b/lib/strict.pm
@@ -74,10 +74,11 @@ See L<perlmod/Pragmatic Modules>.
 
 sub bits {
     my $bits = 0;
+    my $sememe;
     foreach $sememe (@_) {
-	$bits |= 0x00000002 if $sememe eq 'refs';
-	$bits |= 0x00000200 if $sememe eq 'subs';
-	$bits |= 0x00000400 if $sememe eq 'vars';
+	$bits |= 0x00000002, next if $sememe eq 'refs';
+	$bits |= 0x00000200, next if $sememe eq 'subs';
+	$bits |= 0x00000400, next if $sememe eq 'vars';
     }
     $bits;
 }
diff --git a/mg.c b/mg.c
index 0225ca45c1..cffad0e08b 100644
--- a/mg.c
+++ b/mg.c
@@ -1200,6 +1200,7 @@ MAGIC* mg;
     return 0;
 }
 
+#ifdef USE_LOCALE_COLLATE
 int
 magic_setcollxfrm(sv,mg)
 SV* sv;
@@ -1209,9 +1210,14 @@ MAGIC* mg;
      * Ren� Descartes said "I think not."
      * and vanished with a faint plop.
      */
-    sv_unmagic(sv, 'o');
+    if (mg->mg_ptr) {
+	Safefree(mg->mg_ptr);
+	mg->mg_ptr = NULL;
+	mg->mg_len = -1;
+    }
     return 0;
 }
+#endif /* USE_LOCALE_COLLATE */
 
 int
 magic_set(sv,mg)
diff --git a/patchlevel.h b/patchlevel.h
index 07c9884f51..644f47c82e 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1,5 +1,5 @@
 #define PATCHLEVEL 3
-#define SUBVERSION 15
+#define SUBVERSION 16
 
 /*
 	local_patches -- list of locally applied less-than-subversion patches.
diff --git a/pod/perlnews.pod b/pod/perlnews.pod
index a624b21c17..0af4e4ea8e 100644
--- a/pod/perlnews.pod
+++ b/pod/perlnews.pod
@@ -359,6 +359,8 @@ Brand new modules:
     User/grent.pm        Object-oriented wrapper around CORE::getgr*
     User/pwent.pm        Object-oriented wrapper around CORE::getpw*
 
+    lib/Tie/RefHash.pm   Base class for tied hashes with references as keys
+
     UNIVERSAL.pm         Base class for *ALL* classes
 
 =head2 IO
@@ -643,5 +645,4 @@ Constructed by Tom Christiansen, grabbing material with permission
 from innumerable contributors, with kibitzing by more than a few Perl
 porters.
 
-Last update:
-Wed Dec 18 16:18:27 EST 1996
+Last update: Tue Dec 24 16:45:14 EST 1996
diff --git a/pp.c b/pp.c
index b07a54bdc9..e071ee3c07 100644
--- a/pp.c
+++ b/pp.c
@@ -619,7 +619,7 @@ PP(pp_pow)
 {
     dSP; dATARGET; tryAMAGICbin(pow,opASSIGN); 
     {
-      dPOPTOPnnrl;
+      dPOPTOPnnrl_ul;
       SETn( pow( left, right) );
       RETURN;
     }
@@ -629,7 +629,7 @@ PP(pp_multiply)
 {
     dSP; dATARGET; tryAMAGICbin(mult,opASSIGN); 
     {
-      dPOPTOPnnrl;
+      dPOPTOPnnrl_ul;
       SETn( left * right );
       RETURN;
     }
@@ -639,25 +639,24 @@ PP(pp_divide)
 {
     dSP; dATARGET; tryAMAGICbin(div,opASSIGN); 
     {
-      dPOPnv;
-      if (value == 0.0)
+      dPOPPOPnnrl_ul;
+      double value;
+      if (right == 0.0)
 	DIE("Illegal division by zero");
 #ifdef SLOPPYDIVIDE
       /* insure that 20./5. == 4. */
       {
-	double x;
-	I32    k;
-	x =  POPn;
-	if ((double)I_32(x)     == x &&
-	    (double)I_32(value) == value &&
-	    (k = I_32(x)/I_32(value))*I_32(value) == I_32(x)) {
+	IV k;
+	if ((double)I_V(left)  == left &&
+	    (double)I_V(right) == right &&
+	    (k = I_V(left)/I_V(right))*I_V(right) == I_V(left)) {
 	    value = k;
 	} else {
-	    value = x/value;
+	    value = left / right;
 	}
       }
 #else
-      value = POPn / value;
+      value = left / right;
 #endif
       PUSHn( value );
       RETURN;
@@ -682,7 +681,7 @@ PP(pp_modulo)
 	  SETi( left % right );
       }
       else {
-	register double left = TOPn;
+	register double left = USE_LEFT(TOPs) ? SvNV(TOPs) : 0.0;
 	if (left < 0.0)
 	  SETu( (right - (U_V(-left) - 1) % right) - 1 );
 	else
@@ -729,14 +728,19 @@ PP(pp_repeat)
 	    if (SvROK(tmpstr))
 		sv_unref(tmpstr);
 	}
-	SvSetSV(TARG, tmpstr);
-	SvPV_force(TARG, len);
-	if (count >= 1) {
-	    SvGROW(TARG, (count * len) + 1);
-	    if (count > 1)
-		repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1);
-	    SvCUR(TARG) *= count;
-	    *SvEND(TARG) = '\0';
+	if (USE_LEFT(tmpstr) || SvTYPE(tmpstr) > SVt_PVMG) {
+	    SvSetSV(TARG, tmpstr);
+	    SvPV_force(TARG, len);
+	    if (count != 1) {
+		if (count < 1)
+		    SvCUR_set(TARG, 0);
+		else {
+		    SvGROW(TARG, (count * len) + 1);
+		    repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1);
+		    SvCUR(TARG) *= count;
+		}
+		*SvEND(TARG) = '\0';
+	    }
 	    (void)SvPOK_only(TARG);
 	}
 	else
@@ -751,7 +755,7 @@ PP(pp_subtract)
 {
     dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); 
     {
-      dPOPTOPnnrl;
+      dPOPTOPnnrl_ul;
       SETn( left - right );
       RETURN;
     }
diff --git a/pp.h b/pp.h
index 56cd26cfbd..ea1fd394a7 100644
--- a/pp.h
+++ b/pp.h
@@ -107,13 +107,32 @@
 #define dTOPuv		UV value = TOPu
 #define dPOPuv		UV value = POPu
 
-#define dPOPPOPssrl	SV *right = POPs; SV *left = POPs
-#define dPOPPOPnnrl	double right = POPn; double left = POPn
-#define dPOPPOPiirl	IV right = POPi; IV left = POPi
-
-#define dPOPTOPssrl	SV *right = POPs; SV *left = TOPs
-#define dPOPTOPnnrl	double right = POPn; double left = TOPn
-#define dPOPTOPiirl	IV right = POPi; IV left = TOPi
+#define dPOPXssrl(X)	SV *right = POPs; SV *left = CAT2(X,s)
+#define dPOPXnnrl(X)	double right = POPn; double left = CAT2(X,n)
+#define dPOPXiirl(X)	IV right = POPi; IV left = CAT2(X,i)
+
+#define USE_LEFT(sv) \
+	(SvOK(sv) || SvGMAGICAL(sv) || !(op->op_flags & OPf_STACKED))
+#define dPOPXnnrl_ul(X)	\
+    double right = POPn;				\
+    SV *leftsv = CAT2(X,s);				\
+    double left = USE_LEFT(leftsv) ? SvNV(leftsv) : 0.0
+#define dPOPXiirl_ul(X) \
+    IV right = POPi;					\
+    SV *leftsv = CAT2(X,s);				\
+    IV left = USE_LEFT(leftsv) ? SvIV(leftsv) : 0
+
+#define dPOPPOPssrl	dPOPXssrl(POP)
+#define dPOPPOPnnrl	dPOPXnnrl(POP)
+#define dPOPPOPnnrl_ul	dPOPXnnrl_ul(POP)
+#define dPOPPOPiirl	dPOPXiirl(POP)
+#define dPOPPOPiirl_ul	dPOPXiirl_ul(POP)
+
+#define dPOPTOPssrl	dPOPXssrl(TOP)
+#define dPOPTOPnnrl	dPOPXnnrl(TOP)
+#define dPOPTOPnnrl_ul	dPOPXnnrl_ul(TOP)
+#define dPOPTOPiirl	dPOPXiirl(TOP)
+#define dPOPTOPiirl_ul	dPOPXiirl_ul(TOP)
 
 #define RETPUSHYES	RETURNX(PUSHs(&sv_yes))
 #define RETPUSHNO	RETURNX(PUSHs(&sv_no))
diff --git a/pp_hot.c b/pp_hot.c
index ba49535d0c..41ad9f4893 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -199,9 +199,9 @@ PP(pp_concat)
     }
     else if (SvGMAGICAL(TARG))
 	mg_get(TARG);
-    else if (!SvOK(TARG)) {
-	s = SvPV_force(TARG, len);
+    else if (!SvOK(TARG) && SvTYPE(TARG) <= SVt_PVMG) {
 	sv_setpv(TARG, "");	/* Suppress warning. */
+	s = SvPV_force(TARG, len);
     }
     s = SvPV(right,len);
     sv_catpvn(TARG,s,len);
@@ -269,7 +269,7 @@ PP(pp_add)
 {
     dSP; dATARGET; tryAMAGICbin(add,opASSIGN); 
     {
-      dPOPTOPnnrl;
+      dPOPTOPnnrl_ul;
       SETn( left + right );
       RETURN;
     }
@@ -1311,6 +1311,8 @@ PP(pp_iter)
     if (cx->blk_loop.iterix >= (av == curstack ? cx->blk_oldsp : AvFILL(av)))
 	RETPUSHNO;
 
+    SvREFCNT_dec(*cx->blk_loop.itervar);
+
     if (sv = AvARRAY(av)[++cx->blk_loop.iterix])
 	SvTEMP_off(sv);
     else
@@ -1334,7 +1336,8 @@ PP(pp_iter)
 	LvTARGLEN(lv) = 1;
 	sv = (SV*)lv;
     }
-    *cx->blk_loop.itervar = sv;
+
+    *cx->blk_loop.itervar = SvREFCNT_inc(sv);
     RETPUSHYES;
 }
 
diff --git a/proto.h b/proto.h
index fe06b488a4..c762d38723 100644
--- a/proto.h
+++ b/proto.h
@@ -64,8 +64,7 @@ void	debprofdump _((void));
 #endif
 I32	debstack _((void));
 void	deprecate _((char* s));
-OP*	die _((const char* pat,...))
-		__attribute__((format(printf,1,2),noreturn));
+OP*	die _((const char* pat,...)) __attribute__((format(printf,1,2)));
 OP*	die_where _((char* message));
 void	dounwind _((I32 cxix));
 bool	do_aexec _((SV* really, SV** mark, SV** sp));
diff --git a/scope.c b/scope.c
index afdcf44e76..2fdea90ea8 100644
--- a/scope.c
+++ b/scope.c
@@ -107,19 +107,14 @@ free_tmps()
     }
 }
 
-SV *
-save_scalar(gv)
-GV *gv;
+static SV *
+save_scalar_at(sptr)
+SV **sptr;
 {
     register SV *sv;
-    SV *osv = GvSV(gv);
-
-    SSCHECK(3);
-    SSPUSHPTR(gv);
-    SSPUSHPTR(osv);
-    SSPUSHINT(SAVEt_SV);
+    SV *osv = *sptr;
 
-    sv = GvSV(gv) = NEWSV(0,0);
+    sv = *sptr = NEWSV(0,0);
     if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) {
 	sv_upgrade(sv, SvTYPE(osv));
 	if (SvGMAGICAL(osv)) {
@@ -143,6 +138,28 @@ GV *gv;
     return sv;
 }
 
+SV *
+save_scalar(gv)
+GV *gv;
+{
+    SSCHECK(3);
+    SSPUSHPTR(gv);
+    SSPUSHPTR(GvSV(gv));
+    SSPUSHINT(SAVEt_SV);
+    return save_scalar_at(&GvSV(gv));
+}
+
+SV*
+save_svref(sptr)
+SV **sptr;
+{
+    SSCHECK(3);
+    SSPUSHPTR(sptr);
+    SSPUSHPTR(*sptr);
+    SSPUSHINT(SAVEt_SVREF);
+    return save_scalar_at(sptr);
+}
+
 void
 save_gp(gv, empty)
 GV *gv;
@@ -168,42 +185,6 @@ I32 empty;
     }
 }
 
-SV*
-save_svref(sptr)
-SV **sptr;
-{
-    register SV *sv;
-    SV *osv = *sptr;
-
-    SSCHECK(3);
-    SSPUSHPTR(*sptr);
-    SSPUSHPTR(sptr);
-    SSPUSHINT(SAVEt_SVREF);
-
-    sv = *sptr = NEWSV(0,0);
-    if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) {
-	sv_upgrade(sv, SvTYPE(osv));
-	if (SvGMAGICAL(osv)) {
-	    MAGIC* mg;
-	    bool oldtainted = tainted;
-	    mg_get(osv);
-	    if (tainting && tainted && (mg = mg_find(osv, 't'))) {
-		SAVESPTR(mg->mg_obj);
-		mg->mg_obj = osv;
-	    }
-	    SvFLAGS(osv) |= (SvFLAGS(osv) &
-		(SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
-	    tainted = oldtainted;
-	}
-	SvMAGIC(sv) = SvMAGIC(osv);
-	SvFLAGS(sv) |= SvMAGICAL(osv);
-	localizing = 1;
-	SvSETMAGIC(sv);
-	localizing = 0;
-    }
-    return sv;
-}
-
 AV *
 save_ary(gv)
 GV *gv;
@@ -450,26 +431,13 @@ I32 base;
         case SAVEt_SV:				/* scalar reference */
 	    value = (SV*)SSPOPPTR;
 	    gv = (GV*)SSPOPPTR;
-	    sv = GvSV(gv);
-	    if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) &&
-		SvTYPE(sv) != SVt_PVGV)
-	    {
-		(void)SvUPGRADE(value, SvTYPE(sv));
-		SvMAGIC(value) = SvMAGIC(sv);
-		SvFLAGS(value) |= SvMAGICAL(sv);
-		SvMAGICAL_off(sv);
-		SvMAGIC(sv) = 0;
-	    }
-            SvREFCNT_dec(sv);
-            GvSV(gv) = value;
-	    localizing = 2;
-	    SvSETMAGIC(value);
-	    localizing = 0;
-            break;
+	    ptr = &GvSV(gv);
+	    goto restore_sv;
         case SAVEt_SVREF:			/* scalar reference */
+	    value = (SV*)SSPOPPTR;
 	    ptr = SSPOPPTR;
+	restore_sv:
 	    sv = *(SV**)ptr;
-	    value = (SV*)SSPOPPTR;
 	    if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) &&
 		SvTYPE(sv) != SVt_PVGV)
 	    {
@@ -479,6 +447,14 @@ I32 base;
 		SvMAGICAL_off(sv);
 		SvMAGIC(sv) = 0;
 	    }
+	    else if (SvTYPE(value) >= SVt_PVMG && SvMAGIC(value) &&
+		     SvTYPE(value) != SVt_PVGV)
+	    {
+		SvFLAGS(value) |= (SvFLAGS(value) &
+				   (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
+		SvMAGICAL_off(value);
+		SvMAGIC(value) = 0;
+	    }
             SvREFCNT_dec(sv);
 	    *(SV**)ptr = value;
 	    localizing = 2;
@@ -694,6 +670,8 @@ CONTEXT* cx;
 	if (cx->blk_loop.itervar)
 	    PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERSAVE = 0x%lx\n",
 		(long)cx->blk_loop.itersave);
+	PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERLVAL = 0x%lx\n",
+		(long)cx->blk_loop.iterlval);
 	break;
 
     case CXt_SUBST:
diff --git a/sv.c b/sv.c
index 87a1a2d017..817da967b6 100644
--- a/sv.c
+++ b/sv.c
@@ -1949,11 +1949,14 @@ register SV *sstr;
 				    (CvROOT(cv) || CvXSUB(cv)) )
 				warn("Subroutine %s redefined",
 				    GvENAME((GV*)dstr));
-			    SvFAKE_on(cv);
+			    if (SvREFCNT(cv) == 1)
+				SvFAKE_on(cv);
 			}
 		    }
+		    sub_generation++;
 		    if (GvCV(dstr) != (CV*)sref) {
 			GvCV(dstr) = (CV*)sref;
+			GvCVGEN(dstr) = 0; /* Switch off cacheness. */
 			GvASSUMECV_on(dstr);
 		    }
 		    if (curcop->cop_stash != GvSTASH(dstr))
@@ -2897,40 +2900,42 @@ register SV *sv2;
 }
 
 #ifdef USE_LOCALE_COLLATE
-
+/*
+ * Any scalar variable may carry an 'o' magic that contains the
+ * scalar data of the variable transformed to such a format that
+ * a normal memory comparison can be used to compare the data
+ * according to the locale settings.
+ */
 char *
 sv_collxfrm(sv, nxp)
      SV *sv;
      STRLEN *nxp;
 {
-    /* Any scalar variable may carry an 'o' magic that contains the
-     * scalar data of the variable transformed to such a format that
-     * a normal memory comparison can be used to compare the data
-     * according to the locale settings. */
+    MAGIC *mg;
 
-    MAGIC *mg = NULL;
-
-    if (SvMAGICAL(sv)) {
-	mg = mg_find(sv, 'o');
-	if (mg && *(U32*)mg->mg_ptr != collation_ix)
-	    mg = NULL;
-    }
-
-    if (! mg) {
+    mg = SvMAGICAL(sv) ? mg_find(sv, 'o') : NULL;
+    if (!mg || !mg->mg_ptr || *(U32*)mg->mg_ptr != collation_ix) {
 	char *s, *xf;
 	STRLEN len, xlen;
 
+	if (mg)
+	    Safefree(mg->mg_ptr);
 	s = SvPV(sv, len);
 	if ((xf = mem_collxfrm(s, len, &xlen))) {
-	    sv_magic(sv, 0, 'o', 0, 0);
-	    if ((mg = mg_find(sv, 'o'))) {
-		mg->mg_ptr = xf;
-		mg->mg_len = xlen;
+	    if (! mg) {
+		sv_magic(sv, 0, 'o', 0, 0);
+		mg = mg_find(sv, 'o');
+		assert(mg);
 	    }
+	    mg->mg_ptr = xf;
+	    mg->mg_len = xlen;
+	}
+	else {
+	    mg->mg_ptr = NULL;
+	    mg->mg_len = -1;
 	}
     }
-
-    if (mg) {
+    if (mg && mg->mg_ptr) {
 	*nxp = mg->mg_len;
 	return mg->mg_ptr + sizeof(collation_ix);
     }
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;
+        }
     }
 }