[inseparable changes from patch to perl 5.004_04]perl-5.004_04

[editor's note: this one imported like a charm!]

 TESTS  -

Subject: Improve pragma/locale test 102 - and don't fail, just warn
From: Jarkko Hietaniemi <jhi@anna.in-berlin.de>
Files: t/pragma/locale.t

Subject: Invalid test output in t/op/taint.t in trial 1
From: Dan Sugalski <sugalsd@lbcc.cc.or.us>
Files: t/op/taint.t

    t/op/taint.t prints out invalid ok messages for tests it skips.
    Rather than printing "ok 136" it prints "136 ok".
    
    p5p-msgid: 3.0.3.32.19970919160918.00857a50@stargate.lbcc.cc.or.us

 UTILITIES  -

Subject: Perldoc tiny patch to avoid $0
From: Ilya Zakharevich <ilya@math.ohio-state.edu>
Files: utils/perldoc.PL
Msg-ID: 199709122141.RAA16846@monk.mps.ohio-state.edu

    (applied based on p5p patch as commit 0b166b6635cf199f072db516b2a523ee659394d5)

Subject: h2ph broken in 5.004_02
From: David Mazieres <dm@reeducation-labor.lcs.mit.edu>
Files: utils/h2ph.PL
Msg-ID: 199708201700.KAA02621@www.chapin.edu

    (applied based on p5p patch as commit 4a8e146e38ec2045f1f817a7cb578e1b1f80f39f)

Subject: add key_t caddr_t to h2ph
From: Tony Sanders <sanders@bsdi.com>
Files: eg/sysvipc/ipcsem utils/h2ph.PL
Msg-ID: 199708272301.RAA12803@austin.bsdi.com

    (applied based on p5p patch as commit 0806a92ffc3a74ca70aa81051cdf2a306cd0a8af)

Subject: perldoc search ., lib and blib/* if -f 'Makefile.PL'
From: Tim Bunce <Tim.Bunce@ig.co.uk>
Files: utils/perldoc.PL

    Subject: perldoc finds wrong pod2man
    
    (from perldoc source)
    
        # We must look both in @INC for library modules and in PATH
        # for executables, like h2xs or perldoc itself.
    
    Unfortunately, searching PATH for installed perl executables like
    pod2man is INCORRECT.  perldoc should start by searching the
    directory it was executed from, which might not be in the PATH
    at all.
    
    Credited: Joseph "Moof-in'" Hall <joseph@cscaper.com>
    
    p5p-msgid: 199708251732.KAA19299@gadget.cscaper.com

Subject: 5.004m4t1: perlbug: NIS domainname gets into wrong places
From: Andreas J. Koenig <koenig@anna.mind.de>
Files: utils/perlbug.PL
Msg-ID: sfcg1qy38as.fsf@anna.in-berlin.de

    (applied based on p5p patch as commit 41f926b844140b7f7eaa9302113e45df3a9f9ff4)

Subject: add better local patch info to perlbug
From: Tim Bunce <Tim.Bunce@ig.co.uk>
Files: utils/perlbug.PL

Subject: perldoc - suggest modules if requested module not found
From: Anthony David <adavid@netinfo.com.au>
Files: utils/perldoc.PL

    private-msgid: 3439CD83.6969@netinfo.com.au

Subject: perldoc mail::foo tries to read binary /usr/ucb/mail
From: Tim Bunce <Tim.Bunce@ig.co.uk>
Files: utils/perldoc.PL

    Subject: perldoc weirdness
    
    perldoc mail::imap yields:
    
    {joseph}:79% perldoc mail::foo
    can't open /usr/ucb/mail: Permission denied at ./pod2man line 362.
    
    Credited: Joseph "Moof-in'" Hall <joseph@cscaper.com>
    
    p5p-msgid: 199710082014.NAA00808@gadget.cscaper.com

Subject: perldoc -f setpwent (for example) returns no descriptive text
From: Tim Bunce <Tim.Bunce@ig.co.uk>
Files: utils/perldoc.PL

Subject: perldoc diffs: don't search auto - much faster
From: "Joseph N. Hall" <joseph@5sigma.com>
Files: utils/perldoc.PL
Msg-ID: MailDrop1.2d7dPPC.971012211957@screechy.cscaper.com

    (applied based on p5p patch as commit 62b753c6ae4ab9bf22fbb6ec7ceac820bcef8fe4)

16 files changed, 494 insertions, 336 deletions

diff --git a/lib/AutoLoader.pm b/lib/AutoLoader.pm
index c45483b02d..2773a90f10 100644
--- a/lib/AutoLoader.pm
+++ b/lib/AutoLoader.pm
@@ -1,6 +1,5 @@
 package AutoLoader;
 
-use Carp;
 use vars qw(@EXPORT @EXPORT_OK);
 
 BEGIN {
@@ -42,7 +41,9 @@ AUTOLOAD {
 	    }
 	    if ($@){
 		$@ =~ s/ at .*\n//;
-		croak $@;
+		my $error = $@;
+		require Carp;
+		Carp::croak($error);
 	    }
 	}
     }
@@ -83,7 +84,11 @@ sub import {
 	    $path ="auto/$calldir/autosplit.ix";
 	    eval { require $path; };
 	}
-	carp $@ if ($@);  
+	if ($@) {
+	    my $error = $@;
+	    require Carp;
+	    Carp::carp($error);
+	}
     } 
 }
 
@@ -169,6 +174,7 @@ Instead, they should define their own AUTOLOAD subroutines along these
 lines:
 
     use AutoLoader;
+    use Carp;
 
     sub AUTOLOAD {
         my $constname;
@@ -183,7 +189,7 @@ lines:
                 croak "Your vendor has not defined constant $constname";
             }
         }
-        eval "sub $AUTOLOAD { $val }";
+	*$AUTOLOAD = sub { $val }; # same as: eval "sub $AUTOLOAD { $val }";
         goto &$AUTOLOAD;
     }
 
diff --git a/lib/Carp.pm b/lib/Carp.pm
index 351f83bdf5..685a7933d0 100644
--- a/lib/Carp.pm
+++ b/lib/Carp.pm
@@ -53,7 +53,7 @@ $MaxArgLen = 64;        # How much of each argument to print. 0 = all.
 $MaxArgNums = 8;        # How many arguments to print. 0 = all.
 
 require Exporter;
-@ISA = Exporter;
+@ISA = ('Exporter');
 @EXPORT = qw(confess croak carp);
 @EXPORT_OK = qw(cluck verbose);
 @EXPORT_FAIL = qw(verbose);	# hook to enable verbose mode
diff --git a/lib/Cwd.pm b/lib/Cwd.pm
index efcfeca261..3bd0085c73 100644
--- a/lib/Cwd.pm
+++ b/lib/Cwd.pm
@@ -26,14 +26,22 @@ The getcwd() function re-implements the getcwd(3) (or getwd(3)) functions
 in Perl.
 
 The fastcwd() function looks the same as getcwd(), but runs faster.
-It's also more dangerous because you might conceivably chdir() out of a
-directory that you can't chdir() back into.
+It's also more dangerous because it might conceivably chdir() you out
+of a directory that it can't chdir() you back into.  If fastcwd
+encounters a problem it will return undef but will probably leave you
+in a different directory.  For a measure of extra security, if
+everything appears to have worked, the fastcwd() function will check
+that it leaves you in the same directory that it started in. If it has
+changed it will C<die> with the message "Unstable directory path,
+current directory changed unexpectedly". That should never happen.
 
 The cwd() function looks the same as getcwd and fastgetcwd but is
 implemented using the most natural and safe form for the current
 architecture. For most systems it is identical to `pwd` (but without
-the trailing line terminator). It is recommended that cwd (or another
-*cwd() function) is used in I<all> code to ensure portability.
+the trailing line terminator).
+
+It is recommended that cwd (or another *cwd() function) is used in
+I<all> code to ensure portability.
 
 If you ask to override your chdir() built-in function, then your PWD
 environment variable will be kept up to date.  (See
@@ -101,7 +109,7 @@ sub getcwd
 	}
 	if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
 	{
-	    $dir = '';
+	    $dir = undef;
 	}
 	else
 	{
@@ -125,9 +133,9 @@ sub getcwd
 	    while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
 		   $tst[1] != $pst[1]);
 	}
-	$cwd = "$dir/$cwd";
+	$cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
 	closedir(PARENT);
-    } while ($dir);
+    } while (defined $dir);
     chop($cwd) unless $cwd eq '/'; # drop the trailing /
     $cwd;
 }
@@ -140,33 +148,45 @@ sub getcwd
 #
 # This is a faster version of getcwd.  It's also more dangerous because
 # you might chdir out of a directory that you can't chdir back into.
+    
+# List of metachars taken from do_exec() in doio.c
+my $quoted_shell_meta = quotemeta('$&*(){}[]";\\|?<>~`'."'\n");
 
 sub fastcwd {
     my($odev, $oino, $cdev, $cino, $tdev, $tino);
     my(@path, $path);
     local(*DIR);
 
-    ($cdev, $cino) = stat('.');
+    my($orig_cdev, $orig_cino) = stat('.');
+    ($cdev, $cino) = ($orig_cdev, $orig_cino);
     for (;;) {
 	my $direntry;
 	($odev, $oino) = ($cdev, $cino);
-	chdir('..');
+	chdir('..') || return undef;
 	($cdev, $cino) = stat('.');
 	last if $odev == $cdev && $oino == $cino;
-	opendir(DIR, '.');
+	opendir(DIR, '.') || return undef;
 	for (;;) {
 	    $direntry = readdir(DIR);
+	    last unless defined $direntry;
 	    next if $direntry eq '.';
 	    next if $direntry eq '..';
 
-	    last unless defined $direntry;
 	    ($tdev, $tino) = lstat($direntry);
 	    last unless $tdev != $odev || $tino != $oino;
 	}
 	closedir(DIR);
+	return undef unless defined $direntry; # should never happen
 	unshift(@path, $direntry);
     }
-    chdir($path = '/' . join('/', @path));
+    $path = '/' . join('/', @path);
+    # At this point $path may be tainted (if tainting) and chdir would fail.
+    # To be more useful we untaint it then check that we landed where we started.
+    $path = $1 if $path =~ /^(.*)$/;	# untaint
+    chdir($path) || return undef;
+    ($cdev, $cino) = stat('.');
+    die "Unstable directory path, current directory changed unexpectedly"
+	if $cdev != $orig_cdev || $cino != $orig_cino;
     $path;
 }
 
diff --git a/lib/English.pm b/lib/English.pm
index 0cf62bd3b6..bbb6bd7b28 100644
--- a/lib/English.pm
+++ b/lib/English.pm
@@ -92,7 +92,7 @@ sub import {
 	*OSNAME
 );
 
-# The ground of all being.
+# The ground of all being. @ARG is deprecated (5.005 makes @_ lexical)
 
 	*ARG					= *_	;
 
diff --git a/lib/ExtUtils/Install.pm b/lib/ExtUtils/Install.pm
index ff5dbf1517..4400858e89 100644
--- a/lib/ExtUtils/Install.pm
+++ b/lib/ExtUtils/Install.pm
@@ -34,6 +34,7 @@ sub install {
     use File::Copy qw(copy);
     use File::Find qw(find);
     use File::Path qw(mkpath);
+    use File::Compare qw(compare);
 
     my(%hash) = %$hash;
     my(%pack, %write, $dir, $warn_permissions);
@@ -96,7 +97,7 @@ sub install {
 	    my $diff = 0;
 	    if ( -f $targetfile && -s _ == $size) {
 		# We have a good chance, we can skip this one
-		$diff = my_cmp($_,$targetfile);
+		$diff = compare($_,$targetfile);
 	    } else {
 		print "$_ differs\n" if $verbose>1;
 		$diff++;
@@ -166,32 +167,6 @@ sub install_default {
 	  },1,0,0);
 }
 
-sub my_cmp {
-    my($one,$two) = @_;
-    local(*F,*T);
-    my $diff = 0;
-    open T, $two or return 1;
-    open F, $one or Carp::croak("Couldn't open $one: $!");
-    my($fr, $tr, $fbuf, $tbuf, $size);
-    $size = 1024;
-    # print "Reading $one\n";
-    while ( $fr = read(F,$fbuf,$size)) {
-	unless (
-		$tr = read(T,$tbuf,$size) and 
-		$tbuf eq $fbuf
-	       ){
-	    # print "diff ";
-	    $diff++;
-	    last;
-	}
-	# print "$fr/$tr ";
-    }
-    # print "\n";
-    close F;
-    close T;
-    $diff;
-}
-
 sub uninstall {
     my($fil,$verbose,$nonono) = @_;
     die "no packlist file found: $fil" unless -f $fil;
@@ -226,7 +201,7 @@ sub inc_uninstall {
 	my $diff = 0;
 	if ( -f $targetfile && -s _ == -s $file) {
 	    # We have a good chance, we can skip this one
-	    $diff = my_cmp($file,$targetfile);
+	    $diff = compare($file,$targetfile);
 	} else {
 	    print "#$file and $targetfile differ\n" if $verbose>1;
 	    $diff++;
@@ -253,6 +228,7 @@ sub pm_to_blib {
     use File::Basename qw(dirname);
     use File::Copy qw(copy);
     use File::Path qw(mkpath);
+    use File::Compare qw(compare);
     use AutoSplit;
     # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
     # require $my_req; # Hairy, but for the first
@@ -272,7 +248,7 @@ sub pm_to_blib {
     mkpath($autodir,0,0755);
     foreach (keys %$fromto) {
 	next if -f $fromto->{$_} && -M $fromto->{$_} < -M $_;
-	unless (my_cmp($_,$fromto->{$_})){
+	unless (compare($_,$fromto->{$_})){
 	    print "Skip $fromto->{$_} (unchanged)\n";
 	    next;
 	}
diff --git a/lib/ExtUtils/Liblist.pm b/lib/ExtUtils/Liblist.pm
index fed25ae13b..d821e83729 100644
--- a/lib/ExtUtils/Liblist.pm
+++ b/lib/ExtUtils/Liblist.pm
@@ -24,7 +24,7 @@ sub _unix_os2_ext {
 	$potential_libs .= $Config{libs};
     }
     return ("", "", "", "") unless $potential_libs;
-    print STDOUT "Potential libraries are '$potential_libs':\n" if $verbose;
+    warn "Potential libraries are '$potential_libs':\n" if $verbose;
 
     my($so)   = $Config{'so'};
     my($libs) = $Config{'libs'};
@@ -34,7 +34,6 @@ sub _unix_os2_ext {
     # compute $extralibs, $bsloadlibs and $ldloadlibs from
     # $potential_libs
     # this is a rewrite of Andy Dougherty's extliblist in perl
-    # its home is in <distribution>/ext/util
 
     my(@searchpath); # from "-L/path" entries in $potential_libs
     my(@libpath) = split " ", $Config{'libpth'};
@@ -49,12 +48,12 @@ sub _unix_os2_ext {
 	if ($thislib =~ s/^(-[LR])//){	# save path flag type
 	    my($ptype) = $1;
 	    unless (-d $thislib){
-		print STDOUT "$ptype$thislib ignored, directory does not exist\n"
+		warn "$ptype$thislib ignored, directory does not exist\n"
 			if $verbose;
 		next;
 	    }
 	    unless ($self->file_name_is_absolute($thislib)) {
-	      print STDOUT "Warning: $ptype$thislib changed to $ptype$pwd/$thislib\n";
+	      warn "Warning: $ptype$thislib changed to $ptype$pwd/$thislib\n";
 	      $thislib = $self->catdir($pwd,$thislib);
 	    }
 	    push(@searchpath, $thislib);
@@ -65,7 +64,7 @@ sub _unix_os2_ext {
 
 	# Handle possible library arguments.
 	unless ($thislib =~ s/^-l//){
-	  print STDOUT "Unrecognized argument in LIBS ignored: '$thislib'\n";
+	  warn "Unrecognized argument in LIBS ignored: '$thislib'\n";
 	  next;
 	}
 
@@ -125,10 +124,10 @@ sub _unix_os2_ext {
 		 #
 		 # , the compilation tools expand the environment variables.)
 	    } else {
-		print STDOUT "$thislib not found in $thispth\n" if $verbose;
+		warn "$thislib not found in $thispth\n" if $verbose;
 		next;
 	    }
-	    print STDOUT "'-l$thislib' found at $fullname\n" if $verbose;
+	    warn "'-l$thislib' found at $fullname\n" if $verbose;
 	    my($fullnamedir) = dirname($fullname);
 	    push @ld_run_path, $fullnamedir unless $ld_run_path_seen{$fullnamedir}++;
 	    $found++;
@@ -174,7 +173,7 @@ sub _unix_os2_ext {
 	    }
 	    last;	# found one here so don't bother looking further
 	}
-	print STDOUT "Note (probably harmless): "
+	warn "Note (probably harmless): "
 		     ."No library found for -l$thislib\n"
 	    unless $found_lib>0;
     }
@@ -202,7 +201,7 @@ sub _win32_ext {
 	$potential_libs .= " " if $potential_libs;
 	$potential_libs .= $libs;
     }
-    print STDOUT "Potential libraries are '$potential_libs':\n" if $verbose;
+    warn "Potential libraries are '$potential_libs':\n" if $verbose;
 
     # compute $extralibs from $potential_libs
 
@@ -218,13 +217,13 @@ sub _win32_ext {
 
 	# Handle possible linker path arguments.
 	if ($thislib =~ s/^-L// and not -d $thislib) {
-	    print STDOUT "-L$thislib ignored, directory does not exist\n"
+	    warn "-L$thislib ignored, directory does not exist\n"
 		if $verbose;
 	    next;
 	}
 	elsif (-d $thislib) {
 	    unless ($self->file_name_is_absolute($thislib)) {
-	      print STDOUT "Warning: -L$thislib changed to -L$pwd/$thislib\n";
+	      warn "Warning: -L$thislib changed to -L$pwd/$thislib\n";
 	      $thislib = $self->catdir($pwd,$thislib);
 	    }
 	    push(@searchpath, $thislib);
@@ -238,22 +237,22 @@ sub _win32_ext {
 	my($found_lib)=0;
 	foreach $thispth (@searchpath, @libpath){
 	    unless (-f ($fullname="$thispth\\$thislib")) {
-		print STDOUT "$thislib not found in $thispth\n" if $verbose;
+		warn "$thislib not found in $thispth\n" if $verbose;
 		next;
 	    }
-	    print STDOUT "'$thislib' found at $fullname\n" if $verbose;
+	    warn "'$thislib' found at $fullname\n" if $verbose;
 	    $found++;
 	    $found_lib++;
 	    push(@extralibs, $fullname);
 	    last;
 	}
-	print STDOUT "Note (probably harmless): "
+	warn "Note (probably harmless): "
 		     ."No library found for '$thislib'\n"
 	    unless $found_lib>0;
     }
     return ('','','','') unless $found;
     $lib = join(' ',@extralibs);
-    print "Result: $lib\n" if $verbose;
+    warn "Result: $lib\n" if $verbose;
     wantarray ? ($lib, '', $lib, '') : $lib;
 }
 
@@ -275,7 +274,7 @@ sub _vms_ext {
                  'Xmu' => 'DECW$XMULIBSHR');
   if ($Config{'vms_cc_type'} ne 'decc') { $libmap{'curses'} = 'VAXCCURSE'; }
 
-  print STDOUT "Potential libraries are '$potential_libs'\n" if $verbose;
+  warn "Potential libraries are '$potential_libs'\n" if $verbose;
 
   # First, sort out directories and library names in the input
   foreach $lib (split ' ',$potential_libs) {
@@ -292,11 +291,11 @@ sub _vms_ext {
   # path in a logical name.)
   foreach $dir (@dirs) {
     unless (-d $dir) {
-      print STDOUT "Skipping nonexistent Directory $dir\n" if $verbose > 1;
+      warn "Skipping nonexistent Directory $dir\n" if $verbose > 1;
       $dir = '';
       next;
     }
-    print STDOUT "Resolving directory $dir\n" if $verbose;
+    warn "Resolving directory $dir\n" if $verbose;
     if ($self->file_name_is_absolute($dir)) { $dir = $self->fixpath($dir,1); }
     else                                    { $dir = $self->catdir($cwd,$dir); }
   }
@@ -321,24 +320,24 @@ sub _vms_ext {
       push(@variants,"lib$lib") if $lib !~ /[:>\]]/;
     }
     push(@variants,$lib);
-    print STDOUT "Looking for $lib\n" if $verbose;
+    warn "Looking for $lib\n" if $verbose;
     foreach $variant (@variants) {
       foreach $dir (@dirs) {
         my($type);
 
         $name = "$dir$variant";
-        print "\tChecking $name\n" if $verbose > 2;
+        warn "\tChecking $name\n" if $verbose > 2;
         if (-f ($test = VMS::Filespec::rmsexpand($name))) {
           # It's got its own suffix, so we'll have to figure out the type
           if    ($test =~ /(?:$so|exe)$/i)      { $type = 'sh'; }
           elsif ($test =~ /(?:$lib_ext|olb)$/i) { $type = 'olb'; }
           elsif ($test =~ /(?:$obj_ext|obj)$/i) {
-            print STDOUT "Note (probably harmless): "
+            warn "Note (probably harmless): "
 			 ."Plain object file $test found in library list\n";
             $type = 'obj';
           }
           else {
-            print STDOUT "Note (probably harmless): "
+            warn "Note (probably harmless): "
 			 ."Unknown library type for $test; assuming shared\n";
             $type = 'sh';
           }
@@ -357,7 +356,7 @@ sub _vms_ext {
         elsif (not length($ctype) and  # If we've got a lib already, don't bother
                ( -f ($test = VMS::Filespec::rmsexpand($name,$obj_ext)) or
                  -f ($test = VMS::Filespec::rmsexpand($name,'.obj'))))  {
-          print STDOUT "Note (probably harmless): "
+          warn "Note (probably harmless): "
 		       ."Plain object file $test found in library list\n";
           $type = 'obj';
           $name = $test unless $test =~ /obj;?\d*$/i;
@@ -370,11 +369,11 @@ sub _vms_ext {
       if ($ctype) { 
         eval '$' . $ctype . "{'$cand'}++";
         die "Error recording library: $@" if $@;
-        print STDOUT "\tFound as $cand (really $test), type $ctype\n" if $verbose > 1;
+        warn "\tFound as $cand (really $test), type $ctype\n" if $verbose > 1;
         next LIB;
       }
     }
-    print STDOUT "Note (probably harmless): "
+    warn "Note (probably harmless): "
 		 ."No library found for $lib\n";
   }
 
@@ -387,7 +386,7 @@ sub _vms_ext {
   push(@libs, map { "$_/Library" } sort keys %olb);
   push(@libs, map { "$_/Share"   } sort keys %sh);
   $lib = join(' ',@libs);
-  print "Result: $lib\n" if $verbose;
+  warn "Result: $lib\n" if $verbose;
   wantarray ? ($lib, '', $lib, '') : $lib;
 }
 
diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm
index 85b0c1bbe5..4f7a9e8137 100644
--- a/lib/ExtUtils/MM_Unix.pm
+++ b/lib/ExtUtils/MM_Unix.pm
@@ -1127,7 +1127,12 @@ sub fixin { # stolen from the pink Camel book, more or less
 
 	# Now look (in reverse) for interpreter in absolute PATH (unless perl).
 	if ($cmd eq "perl") {
-	    $interpreter = $Config{perlpath};
+            if ($Config{startperl} =~ m,^\#!.*/perl,) {
+                $interpreter = $Config{startperl};
+                $interpreter =~ s,^\#!,,;
+            } else {
+                $interpreter = $Config{perlpath};
+            }
 	} else {
 	    my(@absdirs) = reverse grep {$self->file_name_is_absolute} $self->path;
 	    $interpreter = '';
@@ -2935,11 +2940,13 @@ sub test {
     if (!$tests && -d 't') {
 	$tests = $Is_Win32 ? join(' ', <t\\*.t>) : 't/*.t';
     }
+    # note: 'test.pl' name is also hardcoded in init_dirscan()
     my(@m);
     push(@m,"
 TEST_VERBOSE=0
 TEST_TYPE=test_\$(LINKTYPE)
 TEST_FILE = test.pl
+TEST_FILES = $tests
 TESTDB_SW = -d
 
 testdb :: testdb_\$(LINKTYPE)
@@ -2953,8 +2960,8 @@ test :: \$(TEST_TYPE)
     push(@m, "\n");
 
     push(@m, "test_dynamic :: pure_all\n");
-    push(@m, $self->test_via_harness('$(FULLPERL)', $tests)) if $tests;
-    push(@m, $self->test_via_script('$(FULLPERL)', 'test.pl')) if -f "test.pl";
+    push(@m, $self->test_via_harness('$(FULLPERL)', '$(TEST_FILES)')) if $tests;
+    push(@m, $self->test_via_script('$(FULLPERL)', '$(TEST_FILE)')) if -f "test.pl";
     push(@m, "\n");
 
     push(@m, "testdb_dynamic :: pure_all\n");
@@ -2966,8 +2973,8 @@ test :: \$(TEST_TYPE)
 
     if ($self->needs_linking()) {
 	push(@m, "test_static :: pure_all \$(MAP_TARGET)\n");
-	push(@m, $self->test_via_harness('./$(MAP_TARGET)', $tests)) if $tests;
-	push(@m, $self->test_via_script('./$(MAP_TARGET)', 'test.pl')) if -f "test.pl";
+	push(@m, $self->test_via_harness('./$(MAP_TARGET)', '$(TEST_FILES)')) if $tests;
+	push(@m, $self->test_via_script('./$(MAP_TARGET)', '$(TEST_FILE)')) if -f "test.pl";
 	push(@m, "\n");
 	push(@m, "testdb_static :: pure_all \$(MAP_TARGET)\n");
 	push(@m, $self->test_via_script('./$(MAP_TARGET) $(TESTDB_SW)', '$(TEST_FILE)'));
diff --git a/lib/File/DosGlob.pm b/lib/File/DosGlob.pm
index e0887d122c..4597c71564 100644
--- a/lib/File/DosGlob.pm
+++ b/lib/File/DosGlob.pm
@@ -100,16 +100,55 @@ sub doglob {
 }
 
 #
-# this can be used to override CORE::glob
-# by saying C<use File::DosGlob 'glob';>.
+# this can be used to override CORE::glob in a specific
+# package by saying C<use File::DosGlob 'glob';> in that
+# namespace.
 #
-sub glob { doglob(1,@_) }
+
+# context (keyed by second cxix arg provided by core)
+my %iter;
+my %entries;
+
+sub glob {
+    my $pat = shift;
+    my $cxix = shift;
+
+    # glob without args defaults to $_
+    $pat = $_ unless defined $pat;
+
+    # assume global context if not provided one
+    $cxix = '_G_' unless defined $cxix;
+    $iter{$cxix} = 0 unless exists $iter{$cxix};
+
+    # if we're just beginning, do it all first
+    if ($iter{$cxix} == 0) {
+	$entries{$cxix} = [doglob(1,$pat)];
+    }
+
+    # chuck it all out, quick or slow
+    if (wantarray) {
+	delete $iter{$cxix};
+	return @{delete $entries{$cxix}};
+    }
+    else {
+	if ($iter{$cxix} = scalar @{$entries{$cxix}}) {
+	    return shift @{$entries{$cxix}};
+	}
+	else {
+	    # return undef for EOL
+	    delete $iter{$cxix};
+	    delete $entries{$cxix};
+	    return undef;
+	}
+    }
+}
 
 sub import {
     my $pkg = shift;
     my $callpkg = caller(0);
     my $sym = shift;
-    *{$callpkg.'::'.$sym} = \&{$pkg.'::'.$sym} if $sym eq 'glob';
+    *{$callpkg.'::'.$sym} = \&{$pkg.'::'.$sym}
+	if defined($sym) and $sym eq 'glob';
 }
 
 1;
@@ -125,11 +164,14 @@ perlglob.bat - a more capable perlglob.exe replacement
 =head1 SYNOPSIS
 
     require 5.004;
-    use File::DosGlob 'glob';  # override CORE::glob
+    
+    # override CORE::glob in current package
+    use File::DosGlob 'glob';
+    
     @perlfiles = glob  "..\\pe?l/*.p?";
     print <..\\pe?l/*.p?>;
     
-    # from the command line
+    # from the command line (overrides only in main::)
     > perl -MFile::DosGlob=glob -e "print <../pe*/*p?>"
     
     > perlglob ../pe*/*p?
@@ -155,7 +197,10 @@ to standard output.
 While one may replace perlglob.exe with this, usage by overriding
 CORE::glob via importation should be much more efficient, because
 it avoids launching a separate process, and is therefore strongly
-recommended.
+recommended.  Note that it is currently possible to override
+builtins like glob() only on a per-package basis, not "globally".
+Thus, every namespace that wants to override glob() must explicitly
+request the override.  See L<perlsub>.
 
 Extending it to csh patterns is left as an exercise to the reader.
 
@@ -178,6 +223,10 @@ Gurusamy Sarathy <gsar@umich.edu>
 
 =item *
 
+Scalar context, independent iterator context fixes (GSAR 15-SEP-97)
+
+=item *
+
 A few dir-vs-file optimizations result in glob importation being
 10 times faster than using perlglob.exe, and using perlglob.bat is
 only twice as slow as perlglob.exe (GSAR 28-MAY-97)
diff --git a/lib/Math/Complex.pm b/lib/Math/Complex.pm
index 33c60231aa..64477fa7f3 100644
--- a/lib/Math/Complex.pm
+++ b/lib/Math/Complex.pm
@@ -1,26 +1,29 @@
-# $RCSFile$
 #
 # Complex numbers and associated mathematical functions
-# -- Raphael Manfredi, September 1996
-# -- Jarkko Hietaniemi, March-April 1997
+# -- Raphael Manfredi	September 1996
+# -- Jarkko Hietaniemi	March-October 1997
+# -- Daniel S. Lewart	September-October 1997
+#
 
 require Exporter;
 package Math::Complex;
 
+$VERSION = 1.05;
+
+# $Id: Complex.pm,v 1.2 1997/10/15 10:08:39 jhi Exp $
+
 use strict;
 
 use vars qw($VERSION @ISA
 	    @EXPORT %EXPORT_TAGS
 	    $package $display
-	    $i $logn %logn);
+	    $i $ip2 $logn %logn);
 
 @ISA = qw(Exporter);
 
-$VERSION = 1.01;
-
 my @trig = qw(
 	      pi
-	      sin cos tan
+	      tan
 	      csc cosec sec cot cotan
 	      asin acos atan
 	      acsc acosec asec acot acotan
@@ -32,7 +35,7 @@ my @trig = qw(
 
 @EXPORT = (qw(
 	     i Re Im arg
-	     sqrt exp log ln
+	     sqrt log ln
 	     log10 logn cbrt root
 	     cplx cplxe
 	     ),
@@ -99,8 +102,11 @@ sub make {
 sub emake {
 	my $self = bless {}, shift;
 	my ($rho, $theta) = @_;
-	$theta += pi() if $rho < 0;
-	$self->{'polar'} = [abs($rho), $theta];
+	if ($rho < 0) {
+	    $rho   = -$rho;
+	    $theta = ($theta <= 0) ? $theta + pi() : $theta - pi();
+	}
+	$self->{'polar'} = [$rho, $theta];
 	$self->{p_dirty} = 0;
 	$self->{c_dirty} = 1;
 	return $self;
@@ -133,18 +139,30 @@ sub cplxe {
 #
 # pi
 #
-# The number defined as 2 * pi = 360 degrees
+# The number defined as pi = 180 degrees
 #
-
 use constant pi => 4 * atan2(1, 1);
 
 #
-# log2inv
+# pit2
 #
-# Used in log10().
+# The full circle
+#
+use constant pit2 => 2 * pi;
+
 #
+# pip2
+#
+# The quarter circle
+#
+use constant pip2 => pi / 2;
 
-use constant log10inv => 1 / log(10);
+#
+# uplog10
+#
+# Used in log10().
+#
+use constant uplog10 => 1 / log(10);
 
 #
 # i
@@ -155,7 +173,7 @@ sub i () {
         return $i if ($i);
 	$i = bless {};
 	$i->{'cartesian'} = [0, 1];
-	$i->{'polar'}     = [1, pi/2];
+	$i->{'polar'}     = [1, pip2];
 	$i->{c_dirty} = 0;
 	$i->{p_dirty} = 0;
 	return $i;
@@ -242,15 +260,28 @@ sub minus {
 # Computes z1*z2.
 #
 sub multiply {
-	my ($z1, $z2, $regular) = @_;
-	my ($r1, $t1) = @{$z1->polar};
-	$z2 = cplxe(abs($z2), $z2 >= 0 ? 0 : pi) unless ref $z2;
-	my ($r2, $t2) = @{$z2->polar};
-	unless (defined $regular) {
-		$z1->set_polar([$r1 * $r2, $t1 + $t2]);
+        my ($z1, $z2, $regular) = @_;
+	if ($z1->{p_dirty} == 0 and ref $z2 and $z2->{p_dirty} == 0) {
+	    # if both polar better use polar to avoid rounding errors
+	    my ($r1, $t1) = @{$z1->polar};
+	    my ($r2, $t2) = @{$z2->polar};
+	    my $t = $t1 + $t2;
+	    if    ($t >   pi()) { $t -= pit2 }
+	    elsif ($t <= -pi()) { $t += pit2 }
+	    unless (defined $regular) {
+		$z1->set_polar([$r1 * $r2, $t]);
 		return $z1;
+	    }
+	    return (ref $z1)->emake($r1 * $r2, $t);
+	} else {
+	    my ($x1, $y1) = @{$z1->cartesian};
+	    if (ref $z2) {
+		my ($x2, $y2) = @{$z2->cartesian};
+		return (ref $z1)->make($x1*$x2-$y1*$y2, $x1*$y2+$y1*$x2);
+	    } else {
+		return (ref $z1)->make($x1*$z2, $y1*$z2);
+	    }
 	}
-	return (ref $z1)->emake($r1 * $r2, $t1 + $t2);
 }
 
 #
@@ -268,7 +299,7 @@ sub _divbyzero {
     }
 
     my @up = caller(1);
-    
+
     $mess .= "Died at $up[1] line $up[2].\n";
 
     die $mess;
@@ -281,20 +312,45 @@ sub _divbyzero {
 #
 sub divide {
 	my ($z1, $z2, $inverted) = @_;
-	my ($r1, $t1) = @{$z1->polar};
-	$z2 = cplxe(abs($z2), $z2 >= 0 ? 0 : pi) unless ref $z2;
-	my ($r2, $t2) = @{$z2->polar};
-	unless (defined $inverted) {
-		_divbyzero "$z1/0" if ($r2 == 0);
-		$z1->set_polar([$r1 / $r2, $t1 - $t2]);
-		return $z1;
-	}
-	if ($inverted) {
+	if ($z1->{p_dirty} == 0 and ref $z2 and $z2->{p_dirty} == 0) {
+	    # if both polar better use polar to avoid rounding errors
+	    my ($r1, $t1) = @{$z1->polar};
+	    my ($r2, $t2) = @{$z2->polar};
+	    my $t;
+	    if ($inverted) {
 		_divbyzero "$z2/0" if ($r1 == 0);
-		return (ref $z1)->emake($r2 / $r1, $t2 - $t1);
-	} else {
+		$t = $t2 - $t1;
+		if    ($t >   pi()) { $t -= pit2 }
+		elsif ($t <= -pi()) { $t += pit2 }
+		return (ref $z1)->emake($r2 / $r1, $t);
+	    } else {
 		_divbyzero "$z1/0" if ($r2 == 0);
-		return (ref $z1)->emake($r1 / $r2, $t1 - $t2);
+		$t = $t1 - $t2;
+		if    ($t >   pi()) { $t -= pit2 }
+		elsif ($t <= -pi()) { $t += pit2 }
+		return (ref $z1)->emake($r1 / $r2, $t);
+	    }
+	} else {
+	    my ($d, $x2, $y2);
+	    if ($inverted) {
+		($x2, $y2) = @{$z1->cartesian};
+		$d = $x2*$x2 + $y2*$y2;
+		_divbyzero "$z2/0" if $d == 0;
+		return (ref $z1)->make(($x2*$z2)/$d, -($y2*$z2)/$d);
+	    } else {
+		my ($x1, $y1) = @{$z1->cartesian};
+		if (ref $z2) {
+		    ($x2, $y2) = @{$z2->cartesian};
+		    $d = $x2*$x2 + $y2*$y2;
+		    _divbyzero "$z1/0" if $d == 0;
+		    my $u = ($x1*$x2 + $y1*$y2)/$d;
+		    my $v = ($y1*$x2 - $x1*$y2)/$d;
+		    return (ref $z1)->make($u, $v);
+		} else {
+		    _divbyzero "$z1/0" if $z2 == 0;
+		    return (ref $z1)->make($x1/$z2, $y1/$z2);
+		}
+	    }
 	}
 }
 
@@ -307,7 +363,7 @@ sub _zerotozero {
     my $mess = "The zero raised to the zeroth power is not defined.\n";
 
     my @up = caller(1);
-    
+
     $mess .= "Died at $up[1] line $up[2].\n";
 
     die $mess;
@@ -330,14 +386,7 @@ sub power {
 	    return 0 if ($z1z);
 	    return 1 if ($z2z or $z1 == 1);
 	}
-	$z2 = cplx($z2) unless ref $z2;
-	unless (defined $inverted) {
-		my $z3 = exp($z2 * log $z1);
-		$z1->set_cartesian([@{$z3->cartesian}]);
-		return $z1;
-	}
-	return exp($z2 * log $z1) unless $inverted;
-	return exp($z1 * log $z2);
+	return $inverted ? exp($z1 * log $z2) : exp($z2 * log $z1);
 }
 
 #
@@ -364,7 +413,8 @@ sub negate {
 	my ($z) = @_;
 	if ($z->{c_dirty}) {
 		my ($r, $t) = @{$z->polar};
-		return (ref $z)->emake($r, pi + $t);
+		$t = ($t <= 0) ? $t + pi : $t - pi;
+		return (ref $z)->emake($r, $t);
 	}
 	my ($re, $im) = @{$z->cartesian};
 	return (ref $z)->make(-$re, -$im);
@@ -392,9 +442,8 @@ sub conjugate {
 #
 sub abs {
 	my ($z) = @_;
-	return abs($z) unless ref $z;
 	my ($r, $t) = @{$z->polar};
-	return abs($r);
+	return $r;
 }
 
 #
@@ -406,6 +455,8 @@ sub arg {
 	my ($z) = @_;
 	return ($z < 0 ? pi : 0) unless ref $z;
 	my ($r, $t) = @{$z->polar};
+	if    ($t >   pi()) { $t -= pit2 }
+	elsif ($t <= -pi()) { $t += pit2 }
 	return $t;
 }
 
@@ -416,7 +467,9 @@ sub arg {
 #
 sub sqrt {
 	my ($z) = @_;
-	$z = cplx($z, 0) unless ref $z;
+	return $z >= 0 ? sqrt($z) : cplx(0, sqrt(-$z)) unless ref $z;
+	my ($re, $im) = @{$z->cartesian};
+	return cplx($re < 0 ? (0, sqrt(-$re)) : (sqrt($re), 0)) if $im == 0;
 	my ($r, $t) = @{$z->polar};
 	return (ref $z)->emake(sqrt($r), $t/2);
 }
@@ -428,9 +481,10 @@ sub sqrt {
 #
 sub cbrt {
 	my ($z) = @_;
-	return cplx($z, 0) ** (1/3) unless ref $z;
+	return $z < 0 ? -exp(log(-$z)/3) : ($z > 0 ? exp(log($z)/3): 0)
+	    unless ref $z;
 	my ($r, $t) = @{$z->polar};
-	return (ref $z)->emake($r**(1/3), $t/3);
+	return (ref $z)->emake(exp(log($r)/3), $t/3);
 }
 
 #
@@ -442,7 +496,7 @@ sub _rootbad {
     my $mess = "Root $_[0] not defined, root must be positive integer.\n";
 
     my @up = caller(1);
-    
+
     $mess .= "Died at $up[1] line $up[2].\n";
 
     die $mess;
@@ -464,7 +518,7 @@ sub root {
 	my ($r, $t) = ref $z ? @{$z->polar} : (abs($z), $z >= 0 ? 0 : pi);
 	my @root;
 	my $k;
-	my $theta_inc = 2 * pi / $n;
+	my $theta_inc = pit2 / $n;
 	my $rho = $r ** (1/$n);
 	my $theta;
 	my $complex = ref($z) || $package;
@@ -505,7 +559,6 @@ sub Im {
 #
 sub exp {
 	my ($z) = @_;
-	$z = cplx($z, 0) unless ref $z;
 	my ($x, $y) = @{$z->cartesian};
 	return (ref $z)->emake(exp($x), $y);
 }
@@ -513,7 +566,7 @@ sub exp {
 #
 # _logofzero
 #
-# Die on division by zero.
+# Die on logarithm of zero.
 #
 sub _logofzero {
     my $mess = "$_[0]: Logarithm of zero.\n";
@@ -525,7 +578,7 @@ sub _logofzero {
     }
 
     my @up = caller(1);
-    
+
     $mess .= "Died at $up[1] line $up[2].\n";
 
     die $mess;
@@ -538,11 +591,14 @@ sub _logofzero {
 #
 sub log {
 	my ($z) = @_;
-	$z = cplx($z, 0) unless ref $z;
-	my ($x, $y) = @{$z->cartesian};
+	unless (ref $z) {
+	    _logofzero("log") if $z == 0;
+	    return $z > 0 ? log($z) : cplx(log(-$z), pi);
+	}
 	my ($r, $t) = @{$z->polar};
-	$t -= 2 * pi if ($t >  pi() and $x < 0);
-	$t += 2 * pi if ($t < -pi() and $x < 0);
+	_logofzero("log") if $r == 0;
+	if    ($t >   pi()) { $t -= pit2 }
+	elsif ($t <= -pi()) { $t += pit2 }
 	return (ref $z)->make(log($r), $t);
 }
 
@@ -560,11 +616,7 @@ sub ln { Math::Complex::log(@_) }
 #
 
 sub log10 {
-	my ($z) = @_;
-
-	return log(cplx($z, 0)) * log10inv unless ref $z;
-	my ($r, $t) = @{$z->polar};
-	return (ref $z)->make(log($r) * log10inv, $t * log10inv);
+	return Math::Complex::log($_[0]) * uplog10;
 }
 
 #
@@ -587,7 +639,6 @@ sub logn {
 #
 sub cos {
 	my ($z) = @_;
-	$z = cplx($z, 0) unless ref $z;
 	my ($x, $y) = @{$z->cartesian};
 	my $ey = exp($y);
 	my $ey_1 = 1 / $ey;
@@ -602,7 +653,6 @@ sub cos {
 #
 sub sin {
 	my ($z) = @_;
-	$z = cplx($z, 0) unless ref $z;
 	my ($x, $y) = @{$z->cartesian};
 	my $ey = exp($y);
 	my $ey_1 = 1 / $ey;
@@ -656,7 +706,7 @@ sub cosec { Math::Complex::csc(@_) }
 #
 # cot
 #
-# Computes cot(z) = 1 / tan(z).
+# Computes cot(z) = cos(z) / sin(z).
 #
 sub cot {
 	my ($z) = @_;
@@ -678,21 +728,20 @@ sub cotan { Math::Complex::cot(@_) }
 # Computes the arc cosine acos(z) = -i log(z + sqrt(z*z-1)).
 #
 sub acos {
-	my ($z) = @_;
-	$z = cplx($z, 0) unless ref $z;
-	my ($re, $im) = @{$z->cartesian};
-	return atan2(sqrt(1 - $re * $re), $re)
-	    if ($im == 0 and abs($re) <= 1.0);
-	my $acos = ~i * log($z + sqrt($z*$z - 1));
-	if ($im == 0 ||
-	    (abs($re) < 1 && abs($im) < 1) ||
-	    (abs($re) > 1 && abs($im) > 1
-	     && !($re >  1 && $im >  1)
-	     && !($re < -1 && $im < -1))) {
-	    # this rule really, REALLY, must be simpler
-	    return -$acos;
-	}
-	return $acos;
+	my $z = $_[0];
+	return atan2(sqrt(1-$z*$z), $z) if (! ref $z) && abs($z) <= 1;
+	my ($x, $y) = ref $z ? @{$z->cartesian} : ($z, 0);
+	my $t1 = sqrt(($x+1)*($x+1) + $y*$y);
+	my $t2 = sqrt(($x-1)*($x-1) + $y*$y);
+	my $alpha = ($t1 + $t2)/2;
+	my $beta  = ($t1 - $t2)/2;
+	$alpha = 1 if $alpha < 1;
+	if    ($beta >  1) { $beta =  1 }
+	elsif ($beta < -1) { $beta = -1 }
+	my $u = atan2(sqrt(1-$beta*$beta), $beta);
+	my $v = log($alpha + sqrt($alpha*$alpha-1));
+	$v = -$v if $y > 0 || ($y == 0 && $x < -1);
+	return $package->make($u, $v);
 }
 
 #
@@ -701,12 +750,20 @@ sub acos {
 # Computes the arc sine asin(z) = -i log(iz + sqrt(1-z*z)).
 #
 sub asin {
-	my ($z) = @_;
-	$z = cplx($z, 0) unless ref $z;
-	my ($re, $im) = @{$z->cartesian};
-	return atan2($re, sqrt(1 - $re * $re))
-	    if ($im == 0 and abs($re) <= 1.0);
-	return ~i * log(i * $z + sqrt(1 - $z*$z));
+	my $z = $_[0];
+	return atan2($z, sqrt(1-$z*$z)) if (! ref $z) && abs($z) <= 1;
+	my ($x, $y) = ref $z ? @{$z->cartesian} : ($z, 0);
+	my $t1 = sqrt(($x+1)*($x+1) + $y*$y);
+	my $t2 = sqrt(($x-1)*($x-1) + $y*$y);
+	my $alpha = ($t1 + $t2)/2;
+	my $beta  = ($t1 - $t2)/2;
+	$alpha = 1 if $alpha < 1;
+	if    ($beta >  1) { $beta =  1 }
+	elsif ($beta < -1) { $beta = -1 }
+	my $u =  atan2($beta, sqrt(1-$beta*$beta));
+	my $v = -log($alpha + sqrt($alpha*$alpha-1));
+	$v = -$v if $y > 0 || ($y == 0 && $x < -1);
+	return $package->make($u, $v);
 }
 
 #
@@ -716,10 +773,12 @@ sub asin {
 #
 sub atan {
 	my ($z) = @_;
-	$z = cplx($z, 0) unless ref $z;
+	return atan2($z, 1) unless ref $z;
 	_divbyzero "atan(i)"  if ( $z == i);
 	_divbyzero "atan(-i)" if (-$z == i);
-	return i/2*log((i + $z) / (i - $z));
+	my $log = log((i + $z) / (i - $z));
+	$ip2 = 0.5 * i unless defined $ip2;
+	return $ip2 * $log;
 }
 
 #
@@ -730,16 +789,7 @@ sub atan {
 sub asec {
 	my ($z) = @_;
 	_divbyzero "asec($z)", $z if ($z == 0);
-	$z = cplx($z, 0) unless ref $z;
-	my ($re, $im) = @{$z->cartesian};
-	if ($im == 0 && abs($re) >= 1.0) {
-	    my $ire = 1 / $re;
-	    return atan2(sqrt(1 - $ire * $ire), $ire);
-	}
-	my $asec = acos(1 / $z);
-	return ~$asec if $re < 0 && $re > -1 && $im == 0;
-	return -$asec if $im && !($re > 0 && $im > 0) && !($re < 0 && $im < 0);
-	return $asec;
+	return acos(1 / $z);
 }
 
 #
@@ -750,15 +800,7 @@ sub asec {
 sub acsc {
 	my ($z) = @_;
 	_divbyzero "acsc($z)", $z if ($z == 0);
-	$z = cplx($z, 0) unless ref $z;
-	my ($re, $im) = @{$z->cartesian};
-	if ($im == 0 && abs($re) >= 1.0) {
-	    my $ire = 1 / $re;
-	    return atan2($ire, sqrt(1 - $ire * $ire));
-	}
-	my $acsc = asin(1 / $z);
-	return ~$acsc if $re < 0 && $re > -1 && $im == 0;
-	return $acsc;
+	return asin(1 / $z);
 }
 
 #
@@ -775,8 +817,7 @@ sub acosec { Math::Complex::acsc(@_) }
 #
 sub acot {
 	my ($z) = @_;
-	_divbyzero "acot($z)"           if ($z == 0);
-	$z = cplx($z, 0) unless ref $z;
+	return ($z >= 0) ? atan2(1, $z) : atan2(-1, -$z) unless ref $z;
 	_divbyzero "acot(i)", if ( $z == i);
 	_divbyzero "acot(-i)" if (-$z == i);
 	return atan(1 / $z);
@@ -796,15 +837,14 @@ sub acotan { Math::Complex::acot(@_) }
 #
 sub cosh {
 	my ($z) = @_;
-	my $real;
+	my $ex;
 	unless (ref $z) {
-	    $z = cplx($z, 0);
-	    $real = 1;
+	    $ex = exp($z);
+	    return ($ex + 1/$ex)/2;
 	}
 	my ($x, $y) = @{$z->cartesian};
-	my $ex = exp($x);
+	$ex = exp($x);
 	my $ex_1 = 1 / $ex;
-	return cplx(0.5 * ($ex + $ex_1), 0) if $real;
 	return (ref $z)->make(cos($y) * ($ex + $ex_1)/2,
 			      sin($y) * ($ex - $ex_1)/2);
 }
@@ -816,15 +856,14 @@ sub cosh {
 #
 sub sinh {
 	my ($z) = @_;
-	my $real;
+	my $ex;
 	unless (ref $z) {
-	    $z = cplx($z, 0);
-	    $real = 1;
+	    $ex = exp($z);
+	    return ($ex - 1/$ex)/2;
 	}
 	my ($x, $y) = @{$z->cartesian};
-	my $ex = exp($x);
+	$ex = exp($x);
 	my $ex_1 = 1 / $ex;
-	return cplx(0.5 * ($ex - $ex_1), 0) if $real;
 	return (ref $z)->make(cos($y) * ($ex - $ex_1)/2,
 			      sin($y) * ($ex + $ex_1)/2);
 }
@@ -894,14 +933,19 @@ sub cotanh { Math::Complex::coth(@_) }
 #
 # acosh
 #
-# Computes the arc hyperbolic cosine acosh(z) = log(z +- sqrt(z*z-1)).
+# Computes the arc hyperbolic cosine acosh(z) = log(z + sqrt(z*z-1)).
 #
 sub acosh {
 	my ($z) = @_;
-	$z = cplx($z, 0) unless ref $z;
+	unless (ref $z) {
+	    return log($z + sqrt($z*$z-1)) if $z >= 1;
+	    $z = cplx($z, 0);
+	}
 	my ($re, $im) = @{$z->cartesian};
-	return log($re + sqrt(cplx($re*$re - 1, 0)))
-	    if ($im == 0 && $re < 0);
+	if ($im == 0) {
+	    return cplx(log($re + sqrt($re*$re - 1)), 0) if $re >= 1;
+	    return cplx(0, atan2(sqrt(1-$re*$re), $re)) if abs($re) <= 1;
+	}
 	return log($z + sqrt($z*$z - 1));
 }
 
@@ -912,7 +956,6 @@ sub acosh {
 #
 sub asinh {
 	my ($z) = @_;
-	$z = cplx($z, 0) unless ref $z;
 	return log($z + sqrt($z*$z + 1));
 }
 
@@ -923,14 +966,13 @@ sub asinh {
 #
 sub atanh {
 	my ($z) = @_;
+	unless (ref $z) {
+	    return log((1 + $z)/(1 - $z))/2 if abs($z) < 1;
+	    $z = cplx($z, 0);
+	}
 	_divbyzero 'atanh(1)',  "1 - $z" if ($z ==  1);
 	_logofzero 'atanh(-1)'           if ($z == -1);
-	$z = cplx($z, 0) unless ref $z;
-	my ($re, $im) = @{$z->cartesian};
-	if ($im == 0 && $re > 1) {
-	    return cplx(atanh(1 / $re), pi/2);
-	}
-	return log((1 + $z) / (1 - $z)) / 2;
+	return 0.5 * log((1 + $z) / (1 - $z));
 }
 
 #
@@ -941,12 +983,6 @@ sub atanh {
 sub asech {
 	my ($z) = @_;
 	_divbyzero 'asech(0)', $z if ($z == 0);
-	$z = cplx($z, 0) unless ref $z;
-	my ($re, $im) = @{$z->cartesian};
-	if ($im == 0 && $re < 0) {
-	    my $ire = 1 / $re;
-	    return log($ire + sqrt(cplx($ire*$ire - 1, 0)));
-	}
 	return acosh(1 / $z);
 }
 
@@ -975,13 +1011,12 @@ sub acosech { Math::Complex::acsch(@_) }
 #
 sub acoth {
 	my ($z) = @_;
+	unless (ref $z) {
+	    return log(($z + 1)/($z - 1))/2 if abs($z) > 1;
+	    $z = cplx($z, 0);
+	}
 	_divbyzero 'acoth(1)', "$z - 1" if ($z ==  1);
 	_logofzero 'acoth(-1)'          if ($z == -1);
-	$z = cplx($z, 0) unless ref $z;
-	my ($re, $im) = @{$z->cartesian};
-	if ($im == 0 and abs($re) < 1) {
-	    return cplx(acoth(1/$re) , pi/2);
-	}
 	return log((1 + $z) / ($z - 1)) / 2;
 }
 
@@ -999,17 +1034,23 @@ sub acotanh { Math::Complex::acoth(@_) }
 #
 sub atan2 {
 	my ($z1, $z2, $inverted) = @_;
-	my ($re1, $im1) = ref $z1 ? @{$z1->cartesian} : ($z1, 0);
-	my ($re2, $im2) = ref $z2 ? @{$z2->cartesian} : ($z2, 0);
-	my $tan;
-	if (defined $inverted && $inverted) {	# atan(z2/z1)
-		return pi * ($re2 > 0 ? 1 : -1) if $re1 == 0 && $im1 == 0;
-		$tan = $z2 / $z1;
+	my ($re1, $im1, $re2, $im2);
+	if ($inverted) {
+	    ($re1, $im1) = ref $z2 ? @{$z2->cartesian} : ($z2, 0);
+	    ($re2, $im2) = @{$z1->cartesian};
 	} else {
-		return pi * ($re1 > 0 ? 1 : -1) if $re2 == 0 && $im2 == 0;
-		$tan = $z1 / $z2;
+	    ($re1, $im1) = @{$z1->cartesian};
+	    ($re2, $im2) = ref $z2 ? @{$z2->cartesian} : ($z2, 0);
+	}
+	if ($im2 == 0) {
+	    return cplx(atan2($re1, $re2), 0) if $im1 == 0;
+	    return cplx(($im1<=>0) * pip2, 0) if $re2 == 0;
 	}
-	return atan($tan);
+	my $w = atan($z1/$z2);
+	my ($u, $v) = ref $w ? @{$w->cartesian} : ($w, 0);
+	$u += pi   if $re2 < 0;
+	$u -= pit2 if $u > pi;
+	return cplx($u, $v);
 }
 
 #
@@ -1017,7 +1058,7 @@ sub atan2 {
 # ->display_format
 #
 # Set (fetch if no argument) display format for all complex numbers that
-# don't happen to have overrriden it via ->display_format
+# don't happen to have overridden it via ->display_format
 #
 # When called as a method, this actually sets the display format for
 # the current object.
@@ -1076,16 +1117,17 @@ sub stringify_cartesian {
 	my $z  = shift;
 	my ($x, $y) = @{$z->cartesian};
 	my ($re, $im);
+	my $eps = 1e-14;
 
-	$x = int($x + ($x < 0 ? -1 : 1) * 1e-14)
-		if int(abs($x)) != int(abs($x) + 1e-14);
-	$y = int($y + ($y < 0 ? -1 : 1) * 1e-14)
-		if int(abs($y)) != int(abs($y) + 1e-14);
+	$x = int($x + ($x < 0 ? -1 : 1) * $eps)
+		if int(abs($x)) != int(abs($x) + $eps);
+	$y = int($y + ($y < 0 ? -1 : 1) * $eps)
+		if int(abs($y)) != int(abs($y) + $eps);
 
-	$re = "$x" if abs($x) >= 1e-14;
-	if ($y == 1)				{ $im = 'i' }
-	elsif ($y == -1)			{ $im = '-i' }
-	elsif (abs($y) >= 1e-14)	{ $im = $y . "i" }
+	$re = "$x" if abs($x) >= $eps;
+        if ($y == 1)                           { $im = 'i' }
+        elsif ($y == -1)                       { $im = '-i' }
+        elsif (abs($y) >= $eps)                { $im = $y . "i" }
 
 	my $str = '';
 	$str = $re if defined $re;
@@ -1110,10 +1152,9 @@ sub stringify_polar {
 
 	return '[0,0]' if $r <= $eps;
 
-	my $tpi = 2 * pi;
-	my $nt = $t / $tpi;
-	$nt = ($nt - int($nt)) * $tpi;
-	$nt += $tpi if $nt < 0;			# Range [0, 2pi]
+	my $nt = $t / pit2;
+	$nt = ($nt - int($nt)) * pit2;
+	$nt += pit2 if $nt < 0;			# Range [0, 2pi]
 
 	if (abs($nt) <= $eps)		{ $theta = 0 }
 	elsif (abs(pi-$nt) <= $eps)	{ $theta = 'pi' }
@@ -1131,9 +1172,9 @@ sub stringify_polar {
 	# Okay, number is not a real. Try to identify pi/n and friends...
 	#
 
-	$nt -= $tpi if $nt > pi;
+	$nt -= pit2 if $nt > pi;
 	my ($n, $k, $kpi);
-	
+
 	for ($k = 1, $kpi = pi; $k < 10; $k++, $kpi += pi) {
 		$n = int($kpi / $nt + ($nt > 0 ? 1 : -1) * 0.5);
 		if (abs($kpi/$n - $nt) <= $eps) {
@@ -1164,7 +1205,7 @@ Math::Complex - complex numbers and associated mathematical functions
 =head1 SYNOPSIS
 
 	use Math::Complex;
-	
+
 	$z = Math::Complex->make(5, 6);
 	$t = 4 - 3*i + $z;
 	$j = cplxe(1, 2*pi/3);
@@ -1241,7 +1282,7 @@ between this form and the cartesian form C<a + bi> is immediate:
 
 which is also expressed by this formula:
 
-	z = rho * exp(i * theta) = rho * (cos theta + i * sin theta) 
+	z = rho * exp(i * theta) = rho * (cos theta + i * sin theta)
 
 In other words, it's the projection of the vector onto the I<x> and I<y>
 axes. Mathematicians call I<rho> the I<norm> or I<modulus> and I<theta>
@@ -1251,8 +1292,8 @@ noted C<abs(z)>.
 The polar notation (also known as the trigonometric
 representation) is much more handy for performing multiplications and
 divisions of complex numbers, whilst the cartesian notation is better
-suited for additions and substractions. Real numbers are on the I<x>
-axis, and therefore I<theta> is zero.
+suited for additions and subtractions. Real numbers are on the I<x>
+axis, and therefore I<theta> is zero or I<pi>.
 
 All the common operations that can be performed on a real number have
 been defined to work on complex numbers as well, and are merely
@@ -1261,8 +1302,8 @@ they keep their natural meaning when there is no imaginary part, provided
 the number is within their definition set.
 
 For instance, the C<sqrt> routine which computes the square root of
-its argument is only defined for positive real numbers and yields a
-positive real number (it is an application from B<R+> to B<R+>).
+its argument is only defined for non-negative real numbers and yields a
+non-negative real number (it is an application from B<R+> to B<R+>).
 If we allow it to return a complex number, then it can be extended to
 negative real numbers to become an application from B<R> to B<C> (the
 set of complex numbers):
@@ -1275,10 +1316,9 @@ the following definition:
 
 	sqrt(z = [r,t]) = sqrt(r) * exp(i * t/2)
 
-Indeed, a negative real number can be noted C<[x,pi]>
-(the modulus I<x> is always positive, so C<[x,pi]> is really C<-x>, a
-negative number)
-and the above definition states that
+Indeed, a negative real number can be noted C<[x,pi]> (the modulus
+I<x> is always non-negative, so C<[x,pi]> is really C<-x>, a negative
+number) and the above definition states that
 
 	sqrt([x,pi]) = sqrt(x) * exp(i*pi/2) = [sqrt(x),pi/2] = sqrt(x)*i
 
@@ -1342,7 +1382,6 @@ the following (overloaded) operations are supported on complex numbers:
 	log(z1) = log(r1) + i*t1
 	sin(z1) = 1/2i (exp(i * z1) - exp(-i * z1))
 	cos(z1) = 1/2 (exp(i * z1) + exp(-i * z1))
-	abs(z1) = r1
 	atan2(z1, z2) = atan(z1/z2)
 
 The following extra operations are supported on both real and complex
@@ -1363,7 +1402,7 @@ numbers:
 	cot(z) = 1 / tan(z)
 
 	asin(z) = -i * log(i*z + sqrt(1-z*z))
-	acos(z) = -i * log(z + sqrt(z*z-1))
+	acos(z) = -i * log(z + i*sqrt(1-z*z))
 	atan(z) = i/2 * log((i+z) / (i-z))
 
 	acsc(z) = asin(1 / z)
@@ -1377,7 +1416,7 @@ numbers:
 	csch(z) = 1 / sinh(z)
 	sech(z) = 1 / cosh(z)
 	coth(z) = 1 / tanh(z)
-	
+
 	asinh(z) = log(z + sqrt(z*z+1))
 	acosh(z) = log(z + sqrt(z*z-1))
 	atanh(z) = 1/2 * log((1+z) / (1-z))
@@ -1423,21 +1462,21 @@ if you know the cartesian form of the number, or
 
 	$z = 3 + 4*i;
 
-if you like. To create a number using the trigonometric form, use either:
+if you like. To create a number using the polar form, use either:
 
 	$z = Math::Complex->emake(5, pi/3);
 	$x = cplxe(5, pi/3);
 
 instead. The first argument is the modulus, the second is the angle
-(in radians, the full circle is 2*pi).  (Mnmemonic: C<e> is used as a
-notation for complex numbers in the trigonometric form).
+(in radians, the full circle is 2*pi).  (Mnemonic: C<e> is used as a
+notation for complex numbers in the polar form).
 
 It is possible to write:
 
 	$x = cplxe(-3, pi/4);
 
 but that will be silently converted into C<[3,-3pi/4]>, since the modulus
-must be positive (it represents the distance to the origin in the complex
+must be non-negative (it represents the distance to the origin in the complex
 plane).
 
 =head1 STRINGIFICATION
@@ -1534,17 +1573,8 @@ argument cannot be I<pi/2 + k * pi>, where I<k> is any integer.
 =head1 BUGS
 
 Saying C<use Math::Complex;> exports many mathematical routines in the
-caller environment and even overrides some (C<sin>, C<cos>, C<sqrt>,
-C<log>, C<exp>).  This is construed as a feature by the Authors,
-actually... ;-)
-
-The code is not optimized for speed, although we try to use the cartesian
-form for addition-like operators and the trigonometric form for all
-multiplication-like operators.
-
-The arg() routine does not ensure the angle is within the range [-pi,+pi]
-(a side effect caused by multiplication and division using the trigonometric
-representation).
+caller environment and even overrides some (C<sqrt>, C<log>).
+This is construed as a feature by the Authors, actually... ;-)
 
 All routines expect to be given real or complex numbers. Don't attempt to
 use BigFloat, since Perl has currently no rule to disambiguate a '+'
@@ -1555,6 +1585,8 @@ operation (for instance) between two overloaded entities.
 Raphael Manfredi <F<Raphael_Manfredi@grenoble.hp.com>> and
 Jarkko Hietaniemi <F<jhi@iki.fi>>.
 
+Extensive patches by Daniel S. Lewart <F<d-lewart@uiuc.edu>>.
+
 =cut
 
 # eof
diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm
index 24e9148ff2..f5fc3d8cc5 100644
--- a/lib/Test/Harness.pm
+++ b/lib/Test/Harness.pm
@@ -19,11 +19,11 @@ $VERSION = "1.1502";
 
 format STDOUT_TOP =
 Failed Test  Status Wstat Total Fail  Failed  List of failed
-------------------------------------------------------------------------------
+-------------------------------------------------------------------------------
 .
 
 format STDOUT =
-@<<<<<<<<<<<<<< @>> @>>>> @>>>> @>>> ^##.##%  @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+@<<<<<<<<<<<<<< @>> @>>>> @>>>> @>>> ^##.##%  ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 { $curtest->{name},
                 $curtest->{estat},
                     $curtest->{wstat},
@@ -32,6 +32,8 @@ format STDOUT =
                                      $curtest->{percent},
                                               $curtest->{canon}
 }
+~~                                            ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                                              $curtest->{canon}
 .
 
 
@@ -110,7 +112,8 @@ sub runtests {
 		       : $wstatus >> 8);
 	if ($wstatus) {
 	    my ($failed, $canon, $percent) = ('??', '??');
-	    print "dubious\n\tTest returned status $estatus (wstat $wstatus)\n";
+	    printf "dubious\n\tTest returned status $estatus (wstat %d, 0x%x)\n",
+		    $wstatus,$wstatus;
 	    print "\t\t(VMS status is $estatus)\n" if $^O eq 'VMS';
 	    if (corestatus($wstatus)) { # until we have a wait module
 		if ($have_devel_corestack) {
@@ -321,6 +324,10 @@ The global variable $Test::Harness::verbose is exportable and can be
 used to let runtests() display the standard output of the script
 without altering the behavior otherwise.
 
+The global variable $Test::Harness::switches is exportable and can be
+used to set perl command line options used for running the test
+script(s). The default value is C<-w>.
+
 =head1 EXPORT
 
 C<&runtests> is exported by Test::Harness per default.
diff --git a/lib/autouse.pm b/lib/autouse.pm
index a15d08abc5..ab95a19d8a 100644
--- a/lib/autouse.pm
+++ b/lib/autouse.pm
@@ -49,9 +49,9 @@ sub import {
 	}
 
 	my $load_sub = sub {
-	    unless ($INC{pm}) {
-		require $pm;
-		die $@ if $@;
+	    unless ($INC{$pm}) {
+		eval {require $pm};
+		die if $@;
 		vet_import $module;
 	    }
 	    *$closure_import_func = \&{"${module}::$closure_func"};
@@ -73,7 +73,7 @@ sub vet_import ($) {
     my $module = shift;
     if (my $import = $module->can('import')) {
 	croak "autoused module has unique import() method"
-	    unless defined(\&Exporter::import)
+	    unless defined(&Exporter::import)
 		   && $import == \&Exporter::import;
     }
 }
diff --git a/lib/base.pm b/lib/base.pm
index e69de29bb2..e20a64bc9a 100644
--- a/lib/base.pm
+++ b/lib/base.pm
@@ -0,0 +1,49 @@
+=head1 NAME
+
+base - Establish IS-A relationship with base class at compile time
+
+=head1 SYNOPSIS
+
+    package Baz;
+
+    use base qw(Foo Bar);
+
+=head1 DESCRIPTION
+
+Roughly similar in effect to
+
+    BEGIN {
+	require Foo;
+	require Bar;
+	push @ISA, qw(Foo Bar);
+    }
+
+This module was introduced with Perl 5.004_04.
+
+=head1 BUGS
+
+Needs proper documentation!
+
+=cut
+
+package base;
+
+sub import {
+    my $class = shift;
+
+    foreach my $base (@_) {
+	unless (defined %{"$base\::"}) {
+	    eval "require $base";
+	    unless (defined %{"$base\::"}) {
+		require Carp;
+		Carp::croak("Base class package \"$base\" is empty.\n",
+			    "\t(Perhaps you need to 'use' the module ",
+			    "which defines that package first.)");
+	    }
+	}
+    }
+    
+    push @{caller(0) . '::ISA'}, @_;
+}
+
+1;
diff --git a/lib/blib.pm b/lib/blib.pm
index 2dd7802f4b..9e0f6c07c3 100644
--- a/lib/blib.pm
+++ b/lib/blib.pm
@@ -47,7 +47,6 @@ sub import
  my $dir = getcwd;
  if (@_)
   {
-   print join(',',@_),"\n";
    $dir = shift;
    $dir =~ s/blib$//;
    $dir =~ s,/+$,,;
diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm
index 10016f3bb7..78bf4457cb 100644
--- a/lib/diagnostics.pm
+++ b/lib/diagnostics.pm
@@ -175,6 +175,8 @@ if ($^O eq 'VMS') {
 @trypod = ("$archlib/pod/perldiag.pod",
 	   "$privlib/pod/perldiag-$].pod",
 	   "$privlib/pod/perldiag.pod");
+# handy for development testing of new warnings etc
+unshift @trypod, "./pod/perldiag.pod" if -e "pod/perldiag.pod";
 ($PODFILE) = ((grep { -e } @trypod), $trypod[$#trypod])[0];
 
 $DEBUG ||= 0;
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 469ebff023..d5dbfbdd68 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -2,7 +2,7 @@ package DB;
 
 # Debugger for Perl 5.00x; perl5db.pl patch level:
 
-$VERSION = 1.00;
+$VERSION = 1.01;
 $header = "perl5db.pl version $VERSION";
 
 # Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich)
@@ -808,9 +808,11 @@ sub DB {
 			last CMD; };
 		    $cmd =~ /^c\b\s*([\w:]*)\s*$/ && do {
 		        end_report(), next CMD if $finished and $level <= 1;
-			$i = $1;
+			$subname = $i = $1;
 			if ($i =~ /\D/) { # subroutine name
-			    ($file,$i) = (find_sub($i) =~ /^(.*):(.*)$/);
+			    $subname = $package."::".$subname 
+			        unless $subname =~ /::/;
+			    ($file,$i) = (find_sub($subname) =~ /^(.*):(.*)$/);
 			    $i += 0;
 			    if ($i) {
 			        $filename = $file;
@@ -1128,7 +1130,11 @@ sub sub {
 	  $doret = -2 if $doret eq $#stack or $frame & 16;
 	@ret;
     } else {
-	$ret = &$sub;
+        if (defined wantarray) {
+	    $ret = &$sub;
+        } else {
+            &$sub; undef $ret;
+        };
 	$single |= pop(@stack);
 	($frame & 4 
 	 ? ( (print $LINEINFO ' ' x $#stack, "out "), 
@@ -1178,8 +1184,8 @@ sub postponed_sub {
     my $offset = $1 || 0;
     # Filename below can contain ':'
     my ($file,$i) = (find_sub($subname) =~ /^(.*):(\d+)-.*$/);
-    $i += $offset;
     if ($i) {
+      $i += $offset;
       local *dbline = $main::{'_<' . $file};
       local $^W = 0;		# != 0 is magical below
       $had_breakpoints{$file}++;
@@ -1822,18 +1828,15 @@ sub dbwarn {
   local $doret = -2;
   local $SIG{__WARN__} = '';
   local $SIG{__DIE__} = '';
-  eval { require Carp };	# If error/warning during compilation,
-                                # require may be broken.
-  warn(@_, "\nPossible unrecoverable error"), warn("\nTry to decrease warnLevel `O'ption!\n"), return
-    unless defined &Carp::longmess;
-  #&warn("Entering dbwarn\n");
+  eval { require Carp } if defined $^S;	# If error/warning during compilation,
+                                        # require may be broken.
+  warn(@_, "\nCannot print stack trace, load with -MCarp option to see stack"),
+    return unless defined &Carp::longmess;
   my ($mysingle,$mytrace) = ($single,$trace);
   $single = 0; $trace = 0;
   my $mess = Carp::longmess(@_);
   ($single,$trace) = ($mysingle,$mytrace);
-  #&warn("Warning in dbwarn\n");
   &warn($mess); 
-  #&warn("Exiting dbwarn\n");
 }
 
 sub dbdie {
@@ -1842,28 +1845,24 @@ sub dbdie {
   local $SIG{__DIE__} = '';
   local $SIG{__WARN__} = '';
   my $i = 0; my $ineval = 0; my $sub;
-  #&warn("Entering dbdie\n");
-  if ($dieLevel != 2) {
-    while ((undef,undef,undef,$sub) = caller(++$i)) {
-      $ineval = 1, last if $sub eq '(eval)';
-    }
-    {
+  if ($dieLevel > 2) {
       local $SIG{__WARN__} = \&dbwarn;
-      &warn(@_) if $dieLevel > 2; # Ineval is false during destruction?
-    }
-    #&warn("dieing quietly in dbdie\n") if $ineval and $dieLevel < 2;
-    die @_ if $ineval and $dieLevel < 2;
+      &warn(@_);		# Yell no matter what
+      return;
+  }
+  if ($dieLevel < 2) {
+    die @_ if $^S;		# in eval propagate
   }
-  eval { require Carp };	# If error/warning during compilation,
-                                # require may be broken.
-  die(@_, "\nUnrecoverable error") unless defined &Carp::longmess;
+  eval { require Carp } if defined $^S;	# If error/warning during compilation,
+                                	# require may be broken.
+  die(@_, "\nCannot print stack trace, load with -MCarp option to see stack")
+    unless defined &Carp::longmess;
   # We do not want to debug this chunk (automatic disabling works
   # inside DB::DB, but not in Carp).
   my ($mysingle,$mytrace) = ($single,$trace);
   $single = 0; $trace = 0;
   my $mess = Carp::longmess(@_);
   ($single,$trace) = ($mysingle,$mytrace);
-  #&warn("dieing loudly in dbdie\n");
   die $mess;
 }
 
diff --git a/lib/vars.pm b/lib/vars.pm
index e007baa7b9..5723ac6c2c 100644
--- a/lib/vars.pm
+++ b/lib/vars.pm
@@ -1,5 +1,39 @@
 package vars;
 
+require 5.002;
+
+# The following require can't be removed during maintenance
+# releases, sadly, because of the risk of buggy code that does
+# require Carp; Carp::croak "..."; without brackets dying
+# if Carp hasn't been loaded in earlier compile time. :-(
+# We'll let those bugs get found on the development track.
+require Carp if $] < 5.00450;
+
+sub import {
+    my $callpack = caller;
+    my ($pack, @imports, $sym, $ch) = @_;
+    foreach $sym (@imports) {
+	if ($sym =~ /::/) {
+	    require Carp;
+	    Carp::croak("Can't declare another package's variables");
+	}
+        ($ch, $sym) = unpack('a1a*', $sym);
+        *{"${callpack}::$sym"} =
+          (  $ch eq "\$" ? \$   {"${callpack}::$sym"}
+           : $ch eq "\@" ? \@   {"${callpack}::$sym"}
+           : $ch eq "\%" ? \%   {"${callpack}::$sym"}
+           : $ch eq "\*" ? \*   {"${callpack}::$sym"}
+           : $ch eq "\&" ? \&   {"${callpack}::$sym"}
+           : do {
+		require Carp;
+		Carp::croak("'$ch$sym' is not a valid variable name\n");
+	     });
+    }
+};
+
+1;
+__END__
+
 =head1 NAME
 
 vars - Perl pragma to predeclare global variable names
@@ -30,24 +64,3 @@ later-loaded routines.
 See L<perlmod/Pragmatic Modules>.
 
 =cut
-
-require 5.002;
-use Carp;
-
-sub import {
-    my $callpack = caller;
-    my ($pack, @imports, $sym, $ch) = @_;
-    foreach $sym (@imports) {
-	croak "Can't declare another package's variables" if $sym =~ /::/;
-        ($ch, $sym) = unpack('a1a*', $sym);
-        *{"${callpack}::$sym"} =
-          (  $ch eq "\$" ? \$   {"${callpack}::$sym"}
-           : $ch eq "\@" ? \@   {"${callpack}::$sym"}
-           : $ch eq "\%" ? \%   {"${callpack}::$sym"}
-           : $ch eq "\*" ? \*   {"${callpack}::$sym"}
-           : $ch eq "\&" ? \&   {"${callpack}::$sym"}
-           : croak "'$ch$sym' is not a valid variable name\n");
-    }
-};
-
-1;