Update to Scalar-List-Utils-1.21 from CPAN

(cherry picked from commit 2ff286160a117d4e93cd92474de1931baa671032)

25 files changed, 814 insertions, 243 deletions

diff --git a/ext/List-Util/Changes b/ext/List-Util/Changes
index 74c0f85aa5..737b94dd68 100644
--- a/ext/List-Util/Changes
+++ b/ext/List-Util/Changes
@@ -1,3 +1,25 @@
+1.21 -- Mon May 18 10:32:14 CDT 2009
+
+  * Change build system for perl-only install not to need to modify blib
+  * When building inside perl, tests for weaken should be always run (Alexandr Ciornii)
+
+1.20 -- Wed May 13 16:42:53 CDT 2009
+
+*** NOTE***
+This distribution now requires perl 5.6 or greater
+
+Bug Fixes
+  * Fixed stack pop issue in POP_MULTICALL
+  * Fixed error reporting in import when XS not compiled
+  * Check first argument to reduce is a CODE reference to avoid segfault
+  * Handle overloaded and tied values
+  * Fix tainted test to run on Win32
+
+Enhancements
+  * Added List::Util::XS so authors can depend on XS version
+  * Removed need for dummy methods in UNIVERSAL for perl-only code
+
+
 1.19 -- Sun Dec 10 09:58:03 CST 2006
 
 Bug Fixes
diff --git a/ext/List-Util/Util.xs b/ext/List-Util/ListUtil.xs
index 585225c5b3..c2f69a6b56 100644
--- a/ext/List-Util/Util.xs
+++ b/ext/List-Util/ListUtil.xs
@@ -147,18 +147,38 @@ CODE:
     int index;
     NV retval;
     SV *retsv;
+    int magic;
     if(!items) {
 	XSRETURN_UNDEF;
     }
     retsv = ST(0);
-    retval = slu_sv_value(retsv);
+    magic = SvAMAGIC(retsv);
+    if (!magic) {
+      retval = slu_sv_value(retsv);
+    }
     for(index = 1 ; index < items ; index++) {
 	SV *stacksv = ST(index);
-	NV val = slu_sv_value(stacksv);
-	if(val < retval ? !ix : ix) {
-	    retsv = stacksv;
-	    retval = val;
-	}
+        SV *tmpsv;
+        if ((magic || SvAMAGIC(stacksv)) && (tmpsv = amagic_call(retsv, stacksv, gt_amg, 0))) {
+             if (SvTRUE(tmpsv) ? !ix : ix) {
+                  retsv = stacksv;
+                  magic = SvAMAGIC(retsv);
+                  if (!magic) {
+                      retval = slu_sv_value(retsv);
+                  }
+             }
+        }
+        else {
+            NV val = slu_sv_value(stacksv);
+            if (magic) {
+                retval = slu_sv_value(retsv);
+                magic = 0;
+            }
+            if(val < retval ? !ix : ix) {
+                retsv = stacksv;
+                retval = val;
+            }
+        }
     }
     ST(0) = retsv;
     XSRETURN(1);
@@ -166,25 +186,49 @@ CODE:
 
 
 
-NV
+void
 sum(...)
 PROTOTYPE: @
 CODE:
 {
     SV *sv;
+    SV *retsv = NULL;
     int index;
+    int magic;
+    NV retval = 0;
     if(!items) {
 	XSRETURN_UNDEF;
     }
     sv = ST(0);
-    RETVAL = slu_sv_value(sv);
+    if (SvAMAGIC(sv)) {
+        retsv = sv_newmortal();
+        sv_setsv(retsv, sv);
+    }
+    else {
+        retval = slu_sv_value(sv);
+    }
     for(index = 1 ; index < items ; index++) {
 	sv = ST(index);
-	RETVAL += slu_sv_value(sv);
+        if (retsv || SvAMAGIC(sv)) {
+            if (!retsv) {
+                retsv = sv_newmortal();
+                sv_setnv(retsv,retval);
+            }
+            if (!amagic_call(retsv, sv, add_amg, AMGf_assign)) {
+                sv_setnv(retsv, SvNV(retsv) + SvNV(sv));
+            }
+        }
+        else {
+          retval += slu_sv_value(sv);
+        }
+    }
+    if (!retsv) {
+        retsv = sv_newmortal();
+        sv_setnv(retsv,retval);
     }
+    ST(0) = retsv;
+    XSRETURN(1);
 }
-OUTPUT:
-    RETVAL
 
 
 void
@@ -252,6 +296,9 @@ CODE:
 	XSRETURN_UNDEF;
     }
     cv = sv_2cv(block, &stash, &gv, 0);
+    if (cv == Nullcv) {
+       croak("Not a subroutine reference");
+    }
     PUSH_MULTICALL(cv);
     agv = gv_fetchpv("a", TRUE, SVt_PV);
     bgv = gv_fetchpv("b", TRUE, SVt_PV);
@@ -485,6 +532,13 @@ looks_like_number(sv)
 	SV *sv
 PROTOTYPE: $
 CODE:
+  SV *tempsv;
+  if (SvAMAGIC(sv) && (tempsv = AMG_CALLun(sv, numer))) {
+    sv = tempsv;
+  }
+  else if (SvMAGICAL(sv)) {
+      SvGETMAGIC(sv);
+  }
 #if (PERL_VERSION < 8) || (PERL_VERSION == 8 && PERL_SUBVERSION <5)
   if (SvPOK(sv) || SvPOKp(sv)) {
     RETVAL = looks_like_number(sv);
diff --git a/ext/List-Util/Makefile.PL b/ext/List-Util/Makefile.PL
index 9bc1c5adc1..1cba5abdaa 100644
--- a/ext/List-Util/Makefile.PL
+++ b/ext/List-Util/Makefile.PL
@@ -1,46 +1,86 @@
+# -*- perl -*-
+BEGIN { require 5.006; } # allow CPAN testers to get the point
+use strict;
+use warnings;
+use Config;
+use File::Spec;
 use ExtUtils::MakeMaker;
+my $PERL_CORE = grep { $_ eq 'PERL_CORE=1' } @ARGV;
+
+my $do_xs = $PERL_CORE || can_cc();
+
+for (@ARGV) {
+  /^-pm/ and $do_xs = 0;
+  /^-xs/ and $do_xs = 1;
+}
 
 WriteMakefile(
-    VERSION_FROM    => "lib/List/Util.pm",
-    NAME            => "List::Util",
-    DEFINE          => "-DPERL_EXT",
+  NAME         => q[List::Util],
+  ABSTRACT     => q[Common Scalar and List utility subroutines],
+  AUTHOR       => q[Graham Barr <gbarr@cpan.org>],
+  DEFINE       => q[-DPERL_EXT],
+  DISTNAME     => q[Scalar-List-Utils],
+  VERSION_FROM => 'lib/List/Util.pm',
+
+  # We go through the ListUtil.xs trickery to foil platforms
+  # that have the feature combination of
+  # (1) static builds
+  # (2) allowing only one object by the same name in the static library
+  # (3) the object name matching being case-blind
+  # This means that we can't have the top-level util.o
+  # and the extension-level Util.o in the same build.
+  # One such platform is the POSIX-BC BS2000 EBCDIC mainframe platform.
+  XS     => {'ListUtil.xs' => 'ListUtil.c'},
+  OBJECT => 'ListUtil$(OBJ_EXT)',
+  ( $PERL_CORE
+    ? ()
+    : (
+      INSTALLDIRS => q[perl],
+      PREREQ_PM   => {'Test::More' => 0,},
+      (eval { ExtUtils::MakeMaker->VERSION(6.31) } ? (LICENSE => 'perl') : ()),
+      ($do_xs ? () : (XS => {}, C => [], OBJECT => '')),
+      ( eval { ExtUtils::MakeMaker->VERSION(6.46) } ? (
+          META_MERGE => {
+            resources => {    ##
+              repository => 'http://github.com/gbarr/Scalar-List-Utils',
+            },
+          }
+          )
+        : ()
+      ),
+    )
+  ),
 );
 
-package MY;
 
-# We go through the ListUtil.c trickery to foil platforms
-# that have the feature combination of
-# (1) static builds
-# (2) allowing only one object by the same name in the static library
-# (3) the object name matching being case-blind
-# This means that we can't have the top-level util.o
-# and the extension-level Util.o in the same build.
-# One such platform is the POSIX-BC BS2000 EBCDIC mainframe platform.
-
-BEGIN {
-    use Config;
-    unless (defined $Config{usedl}) {
-	eval <<'__EOMM__';
-sub xs_c {
-    my($self) = shift;
-    return '' unless $self->needs_linking();
-'
-ListUtil.c:	Util.xs
-	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) Util.xs > ListUtil.xsc && $(MV) ListUtil.xsc ListUtil.c
-';
-}
+sub can_cc {
 
-sub xs_o {
-    my($self) = shift;
-    return '' unless $self->needs_linking();
-'
+    foreach my $cmd (split(/ /, $Config::Config{cc})) {
+        my $_cmd = $cmd;
+        return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
+
+        for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
+            my $abs = File::Spec->catfile($dir, $_[1]);
+            return $abs if (-x $abs or $abs = MM->maybe_command($abs));
+        }
+    }
 
-Util$(OBJ_EXT):	ListUtil.c
-	$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) ListUtil.c
-	$(MV) ListUtil$(OBJ_EXT) Util$(OBJ_EXT)
-';
+    return;
 }
 
-__EOMM__
-    }
+package MY;
+
+sub init_PM  {
+  my $self = shift;
+
+  $self->SUPER::init_PM(@_);
+
+  return if $do_xs;
+
+  my $pm = $self->{PM};
+  my $pm_file = File::Spec->catfile(qw(lib List Util XS.pm));
+
+  # When installing pure perl, install XS.pp as XS.pm
+  $self->{PM}{'XS.pp'} = delete $self->{PM}{$pm_file};
 }
+
diff --git a/ext/List-Util/XS.pp b/ext/List-Util/XS.pp
new file mode 100644
index 0000000000..6521f632cd
--- /dev/null
+++ b/ext/List-Util/XS.pp
@@ -0,0 +1,45 @@
+package List::Util::XS;
+use strict;
+use vars qw($VERSION);
+
+$VERSION = undef;
+
+sub VERSION {
+  require Carp;
+  Carp::croak("You need to install Scalar-List-Utils with a C compiler to ensure the XS is compiled")
+    if defined $_[1];
+  $VERSION;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+List::Util::XS - Indicate if List::Util was compiled with a C compiler
+
+=head1 SYNOPSIS
+
+    use List::Util::XS 1.20;
+
+=head1 DESCRIPTION
+
+B<*** This instalation does not have XS installed ***>
+
+C<List::Util::XS> can be used as a dependency to ensure List::Util was
+installed using a C compiler and that the XS version is installed.
+
+During installation C<$List::Util::XS::VERSION> will be set to
+C<undef> if the XS was not compiled.
+
+=head1 SEE ALSO
+
+L<Scalar::Util>, L<List::Util>, L<List::MoreUtils>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2008 Graham Barr <gbarr@pobox.com>. All rights reserved.
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
diff --git a/ext/List-Util/lib/List/Util.pm b/ext/List-Util/lib/List/Util.pm
index 829148c056..426a7a3b8d 100644
--- a/ext/List-Util/lib/List/Util.pm
+++ b/ext/List-Util/lib/List/Util.pm
@@ -1,8 +1,10 @@
 # List::Util.pm
 #
-# Copyright (c) 1997-2006 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# Copyright (c) 1997-2009 Graham Barr <gbarr@pobox.com>. All rights reserved.
 # This program is free software; you can redistribute it and/or
 # modify it under the same terms as Perl itself.
+#
+# This module is normally only loaded if the XS module is not available
 
 package List::Util;
 
@@ -12,7 +14,7 @@ require Exporter;
 
 @ISA        = qw(Exporter);
 @EXPORT_OK  = qw(first min max minstr maxstr reduce sum shuffle);
-$VERSION    = "1.19";
+$VERSION    = "1.21";
 $XS_VERSION = $VERSION;
 $VERSION    = eval $VERSION;
 
@@ -32,73 +34,11 @@ eval {
 } unless $TESTING_PERL_ONLY;
 
 
-# This code is only compiled if the XS did not load
-# of for perl < 5.6.0
-
-if (!defined &reduce) {
-eval <<'ESQ' 
-
-sub reduce (&@) {
-  my $code = shift;
-  no strict 'refs';
-
-  return shift unless @_ > 1;
-
-  use vars qw($a $b);
-
-  my $caller = caller;
-  local(*{$caller."::a"}) = \my $a;
-  local(*{$caller."::b"}) = \my $b;
-
-  $a = shift;
-  foreach (@_) {
-    $b = $_;
-    $a = &{$code}();
-  }
-
-  $a;
-}
-
-sub first (&@) {
-  my $code = shift;
-
-  foreach (@_) {
-    return $_ if &{$code}();
-  }
-
-  undef;
-}
-
-ESQ
-}
-
-# This code is only compiled if the XS did not load
-eval <<'ESQ' if !defined &sum;
-
-use vars qw($a $b);
-
-sub sum (@) { reduce { $a + $b } @_ }
-
-sub min (@) { reduce { $a < $b ? $a : $b } @_ }
-
-sub max (@) { reduce { $a > $b ? $a : $b } @_ }
-
-sub minstr (@) { reduce { $a lt $b ? $a : $b } @_ }
-
-sub maxstr (@) { reduce { $a gt $b ? $a : $b } @_ }
-
-sub shuffle (@) {
-  my @a=\(@_);
-  my $n;
-  my $i=@_;
-  map {
-    $n = rand($i--);
-    (${$a[$n]}, $a[$n] = $a[$i])[0];
-  } @_;
+if (!defined &sum) {
+  require List::Util::PP;
+  List::Util::PP->import;
 }
 
-ESQ
-
 1;
 
 __END__
@@ -212,6 +152,12 @@ element is returned and BLOCK is not executed.
     $foo = reduce { $a + $b } 1 .. 10               # sum
     $foo = reduce { $a . $b } @bar                  # concat
 
+If your algorithm requires that C<reduce> produce an identity value, then
+make sure that you always pass that identity value as the first argument to prevent
+C<undef> being returned
+
+  $foo = reduce { $a + $b } 0, @values;             # sum with 0 identity value
+
 =item shuffle LIST
 
 Returns the elements of LIST in a random order
@@ -231,6 +177,12 @@ This function could be implemented using C<reduce> like this
 
     $foo = reduce { $a + $b } 1..10
 
+If your algorithm requires that C<sum> produce an identity of 0, then
+make sure that you always pass C<0> as the first argument to prevent
+C<undef> being returned
+
+  $foo = sum 0, @values;
+
 =back
 
 =head1 KNOWN BUGS
@@ -274,7 +226,7 @@ L<Scalar::Util>, L<List::MoreUtils>
 
 =head1 COPYRIGHT
 
-Copyright (c) 1997-2006 Graham Barr <gbarr@pobox.com>. All rights reserved.
+Copyright (c) 1997-2007 Graham Barr <gbarr@pobox.com>. All rights reserved.
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
 
diff --git a/ext/List-Util/lib/List/Util/PP.pm b/ext/List-Util/lib/List/Util/PP.pm
new file mode 100644
index 0000000000..7fa2a55a21
--- /dev/null
+++ b/ext/List-Util/lib/List/Util/PP.pm
@@ -0,0 +1,75 @@
+# List::Util::PP.pm
+#
+# Copyright (c) 1997-2009 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package List::Util::PP;
+
+use strict;
+use warnings;
+use vars qw(@ISA @EXPORT $VERSION $a $b);
+require Exporter;
+
+@ISA     = qw(Exporter);
+@EXPORT  = qw(first min max minstr maxstr reduce sum shuffle);
+$VERSION = "1.21";
+$VERSION = eval $VERSION;
+
+sub reduce (&@) {
+  my $code = shift;
+  unless(ref($code)) {
+    require Carp;
+    Carp::croak("Not a subroutine reference");
+  }
+  no strict 'refs';
+
+  return shift unless @_ > 1;
+
+  use vars qw($a $b);
+
+  my $caller = caller;
+  local(*{$caller."::a"}) = \my $a;
+  local(*{$caller."::b"}) = \my $b;
+
+  $a = shift;
+  foreach (@_) {
+    $b = $_;
+    $a = &{$code}();
+  }
+
+  $a;
+}
+
+sub first (&@) {
+  my $code = shift;
+
+  foreach (@_) {
+    return $_ if &{$code}();
+  }
+
+  undef;
+}
+
+
+sub sum (@) { reduce { $a + $b } @_ }
+
+sub min (@) { reduce { $a < $b ? $a : $b } @_ }
+
+sub max (@) { reduce { $a > $b ? $a : $b } @_ }
+
+sub minstr (@) { reduce { $a lt $b ? $a : $b } @_ }
+
+sub maxstr (@) { reduce { $a gt $b ? $a : $b } @_ }
+
+sub shuffle (@) {
+  my @a=\(@_);
+  my $n;
+  my $i=@_;
+  map {
+    $n = rand($i--);
+    (${$a[$n]}, $a[$n] = $a[$i])[0];
+  } @_;
+}
+
+1;
diff --git a/ext/List-Util/lib/List/Util/XS.pm b/ext/List-Util/lib/List/Util/XS.pm
new file mode 100644
index 0000000000..01ad27ac12
--- /dev/null
+++ b/ext/List-Util/lib/List/Util/XS.pm
@@ -0,0 +1,45 @@
+package List::Util::XS;
+use strict;
+use vars qw($VERSION);
+use List::Util;
+
+$VERSION = "1.21";           # FIXUP
+$VERSION = eval $VERSION;    # FIXUP
+
+sub _VERSION { # FIXUP
+  require Carp;
+  Carp::croak("You need to install Scalar-List-Utils with a C compiler to ensure the XS is compiled")
+    if defined $_[1];
+  $VERSION;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+List::Util::XS - Indicate if List::Util was compiled with a C compiler
+
+=head1 SYNOPSIS
+
+    use List::Util::XS 1.20;
+
+=head1 DESCRIPTION
+
+C<List::Util::XS> can be used as a dependency to ensure List::Util was
+installed using a C compiler and that the XS version is installed.
+
+During installation C<$List::Util::XS::VERSION> will be set to
+C<undef> if the XS was not compiled.
+
+=head1 SEE ALSO
+
+L<Scalar::Util>, L<List::Util>, L<List::MoreUtils>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2008 Graham Barr <gbarr@pobox.com>. All rights reserved.
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
diff --git a/ext/List-Util/lib/Scalar/Util.pm b/ext/List-Util/lib/Scalar/Util.pm
index f947f741e7..db7b20c5c6 100644
--- a/ext/List-Util/lib/Scalar/Util.pm
+++ b/ext/List-Util/lib/Scalar/Util.pm
@@ -1,34 +1,46 @@
 # Scalar::Util.pm
 #
-# Copyright (c) 1997-2006 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# Copyright (c) 1997-2007 Graham Barr <gbarr@pobox.com>. All rights reserved.
 # This program is free software; you can redistribute it and/or
 # modify it under the same terms as Perl itself.
 
 package Scalar::Util;
 
 use strict;
-use vars qw(@ISA @EXPORT_OK $VERSION);
+use vars qw(@ISA @EXPORT_OK $VERSION @EXPORT_FAIL);
 require Exporter;
 require List::Util; # List::Util loads the XS
 
 @ISA       = qw(Exporter);
 @EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly openhandle refaddr isvstring looks_like_number set_prototype);
-$VERSION    = "1.19";
+$VERSION    = "1.21";
 $VERSION   = eval $VERSION;
 
+unless (defined &dualvar) {
+  # Load Pure Perl version if XS not loaded
+  require Scalar::Util::PP;
+  Scalar::Util::PP->import;
+  push @EXPORT_FAIL, qw(weaken isweak dualvar isvstring set_prototype);
+}
+
 sub export_fail {
+  if (grep { /dualvar/ } @EXPORT_FAIL) { # no XS loaded
+    my $pat = join("|", @EXPORT_FAIL);
+    if (my ($err) = grep { /^($pat)$/ } @_ ) {
+      require Carp;
+      Carp::croak("$err is only available with the XS version of Scalar::Util");
+    }
+  }
+
   if (grep { /^(weaken|isweak)$/ } @_ ) {
     require Carp;
     Carp::croak("Weak references are not implemented in the version of perl");
   }
+
   if (grep { /^(isvstring)$/ } @_ ) {
     require Carp;
     Carp::croak("Vstrings are not implemented in the version of perl");
   }
-  if (grep { /^(dualvar|set_prototype)$/ } @_ ) {
-    require Carp;
-    Carp::croak("$1 is only avaliable with the XS version");
-  }
 
   @_;
 }
@@ -51,96 +63,6 @@ sub openhandle ($) {
     ? $fh : undef;
 }
 
-eval <<'ESQ' unless defined &dualvar;
-
-use vars qw(@EXPORT_FAIL);
-push @EXPORT_FAIL, qw(weaken isweak dualvar isvstring set_prototype);
-
-# The code beyond here is only used if the XS is not installed
-
-# Hope nobody defines a sub by this name
-sub UNIVERSAL::a_sub_not_likely_to_be_here { ref($_[0]) }
-
-sub blessed ($) {
-  local($@, $SIG{__DIE__}, $SIG{__WARN__});
-  length(ref($_[0]))
-    ? eval { $_[0]->a_sub_not_likely_to_be_here }
-    : undef
-}
-
-sub refaddr($) {
-  my $pkg = ref($_[0]) or return undef;
-  if (blessed($_[0])) {
-    bless $_[0], 'Scalar::Util::Fake';
-  }
-  else {
-    $pkg = undef;
-  }
-  "$_[0]" =~ /0x(\w+)/;
-  my $i = do { local $^W; hex $1 };
-  bless $_[0], $pkg if defined $pkg;
-  $i;
-}
-
-sub reftype ($) {
-  local($@, $SIG{__DIE__}, $SIG{__WARN__});
-  my $r = shift;
-  my $t;
-
-  length($t = ref($r)) or return undef;
-
-  # This eval will fail if the reference is not blessed
-  eval { $r->a_sub_not_likely_to_be_here; 1 }
-    ? do {
-      $t = eval {
-	  # we have a GLOB or an IO. Stringify a GLOB gives it's name
-	  my $q = *$r;
-	  $q =~ /^\*/ ? "GLOB" : "IO";
-	}
-	or do {
-	  # OK, if we don't have a GLOB what parts of
-	  # a glob will it populate.
-	  # NOTE: A glob always has a SCALAR
-	  local *glob = $r;
-	  defined *glob{ARRAY} && "ARRAY"
-	  or defined *glob{HASH} && "HASH"
-	  or defined *glob{CODE} && "CODE"
-	  or length(ref(${$r})) ? "REF" : "SCALAR";
-	}
-    }
-    : $t
-}
-
-sub tainted {
-  local($@, $SIG{__DIE__}, $SIG{__WARN__});
-  local $^W = 0;
-  eval { kill 0 * $_[0] };
-  $@ =~ /^Insecure/;
-}
-
-sub readonly {
-  return 0 if tied($_[0]) || (ref(\($_[0])) ne "SCALAR");
-
-  local($@, $SIG{__DIE__}, $SIG{__WARN__});
-  my $tmp = $_[0];
-
-  !eval { $_[0] = $tmp; 1 };
-}
-
-sub looks_like_number {
-  local $_ = shift;
-
-  # checks from perlfaq4
-  return 0 if !defined($_) or ref($_);
-  return 1 if (/^[+-]?\d+$/); # is a +/- integer
-  return 1 if (/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/); # a C float
-  return 1 if ($] >= 5.008 and /^(Inf(inity)?|NaN)$/i) or ($] >= 5.006001 and /^Inf$/i);
-
-  0;
-}
-
-ESQ
-
 1;
 
 __END__
@@ -153,6 +75,7 @@ Scalar::Util - A selection of general-utility scalar subroutines
 
     use Scalar::Util qw(blessed dualvar isweak readonly refaddr reftype tainted
                         weaken isvstring looks_like_number set_prototype);
+                        # and other useful utils appearing below
 
 =head1 DESCRIPTION
 
@@ -209,7 +132,7 @@ If EXPR is a scalar which is a weak reference the result is true.
 B<NOTE>: Copying a weak reference creates a normal, strong, reference.
 
     $copy = $ref;
-    $weak = isweak($ref);               # false
+    $weak = isweak($copy);              # false
 
 =item looks_like_number EXPR
 
@@ -310,6 +233,32 @@ be destroyed because there is now always a strong reference to them in the
 
 =back
 
+=head1 DIAGNOSTICS
+
+Module use may give one of the following errors during import.
+
+=over
+
+=item Weak references are not implemented in the version of perl
+
+The version of perl that you are using does not implement weak references, to use
+C<isweak> or C<weaken> you will need to use a newer release of perl.
+
+=item Vstrings are not implemented in the version of perl
+
+The version of perl that you are using does not implement Vstrings, to use
+C<isvstring> you will need to use a newer release of perl.
+
+=item C<NAME> is only available with the XS version of Scalar::Util
+
+C<Scalar::Util> contains both perl and C implementations of many of its functions
+so that those without access to a C compiler may still use it. However some of the functions
+are only available when a C compiler was available to compile the XS version of the extension.
+
+At present that list is: weaken, isweak, dualvar, isvstring, set_prototype
+
+=back
+
 =head1 KNOWN BUGS
 
 There is a bug in perl5.6.0 with UV's that are >= 1<<31. This will
@@ -321,7 +270,7 @@ L<List::Util>
 
 =head1 COPYRIGHT
 
-Copyright (c) 1997-2006 Graham Barr <gbarr@pobox.com>. All rights reserved.
+Copyright (c) 1997-2007 Graham Barr <gbarr@pobox.com>. All rights reserved.
 This program is free software; you can redistribute it and/or modify it
 under the same terms as Perl itself.
 
diff --git a/ext/List-Util/lib/Scalar/Util/PP.pm b/ext/List-Util/lib/Scalar/Util/PP.pm
new file mode 100644
index 0000000000..0b7f7994ba
--- /dev/null
+++ b/ext/List-Util/lib/Scalar/Util/PP.pm
@@ -0,0 +1,109 @@
+# Scalar::Util::PP.pm
+#
+# Copyright (c) 1997-2009 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+#
+# This module is normally only loaded if the XS module is not available
+
+package Scalar::Util::PP;
+
+use strict;
+use warnings;
+use vars qw(@ISA @EXPORT $VERSION $recurse);
+require Exporter;
+use B qw(svref_2object);
+
+@ISA     = qw(Exporter);
+@EXPORT  = qw(blessed reftype tainted readonly refaddr looks_like_number);
+$VERSION = "1.21";
+$VERSION = eval $VERSION;
+
+sub blessed ($) {
+  return undef unless length(ref($_[0]));
+  my $b = svref_2object($_[0]);
+  return undef unless $b->isa('B::PVMG');
+  my $s = $b->SvSTASH;
+  return $s->isa('B::HV') ? $s->NAME : undef;
+}
+
+sub refaddr($) {
+  return undef unless length(ref($_[0]));
+
+  my $addr;
+  if(defined(my $pkg = blessed($_[0]))) {
+    $addr .= bless $_[0], 'Scalar::Util::Fake';
+    bless $_[0], $pkg;
+  }
+  else {
+    $addr .= $_[0]
+  }
+
+  $addr =~ /0x(\w+)/;
+  local $^W;
+  hex($1);
+}
+
+{
+  my %tmap = qw(
+    B::HV HASH
+    B::AV ARRAY
+    B::CV CODE
+    B::IO IO
+    B::NULL SCALAR
+    B::NV SCALAR
+    B::PV SCALAR
+    B::GV GLOB
+    B::RV REF
+    B::REGEXP REGEXP
+  );
+
+  sub reftype ($) {
+    my $r = shift;
+
+    return undef unless length(ref($r));
+
+    my $t = ref(svref_2object($r));
+
+    return
+        exists $tmap{$t} ? $tmap{$t}
+      : length(ref($$r)) ? 'REF'
+      :                    'SCALAR';
+  }
+}
+
+sub tainted {
+  local($@, $SIG{__DIE__}, $SIG{__WARN__});
+  local $^W = 0;
+  no warnings;
+  eval { kill 0 * $_[0] };
+  $@ =~ /^Insecure/;
+}
+
+sub readonly {
+  return 0 if tied($_[0]) || (ref(\($_[0])) ne "SCALAR");
+
+  local($@, $SIG{__DIE__}, $SIG{__WARN__});
+  my $tmp = $_[0];
+
+  !eval { $_[0] = $tmp; 1 };
+}
+
+sub looks_like_number {
+  local $_ = shift;
+
+  # checks from perlfaq4
+  return 0 if !defined($_);
+  if (ref($_)) {
+    require overload;
+    return overload::Overloaded($_) ? defined(0 + $_) : 0;
+  }
+  return 1 if (/^[+-]?\d+$/); # is a +/- integer
+  return 1 if (/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/); # a C float
+  return 1 if ($] >= 5.008 and /^(Inf(inity)?|NaN)$/i) or ($] >= 5.006001 and /^Inf$/i);
+
+  0;
+}
+
+
+1;
diff --git a/ext/List-Util/t/00version.t b/ext/List-Util/t/00version.t
index fad6e0f380..d475de488d 100644
--- a/ext/List-Util/t/00version.t
+++ b/ext/List-Util/t/00version.t
@@ -15,8 +15,11 @@ BEGIN {
 
 use Scalar::Util ();
 use List::Util ();
-use Test::More tests => 1;
+use List::Util::XS ();
+use Test::More tests => 2;
 
 is( $Scalar::Util::VERSION, $List::Util::VERSION, "VERSION mismatch");
-
+my $has_xs = eval { Scalar::Util->import('dualvar'); 1 };
+my $xs_version = $has_xs ? $List::Util::VERSION : undef;
+is( $List::Util::XS::VERSION, $xs_version, "XS VERSION");
 
diff --git a/ext/List-Util/t/blessed.t b/ext/List-Util/t/blessed.t
index 8002404dbb..f0a4c19b25 100644
--- a/ext/List-Util/t/blessed.t
+++ b/ext/List-Util/t/blessed.t
@@ -13,7 +13,7 @@ BEGIN {
     }
 }
 
-use Test::More tests => 8;
+use Test::More tests => 11;
 use Scalar::Util qw(blessed);
 use vars qw($t $x);
 
@@ -29,3 +29,26 @@ is(blessed($x), "ABC",	'blessed ARRAY-ref');
 
 $x = bless {}, "DEF";
 is(blessed($x), "DEF",	'blessed HASH-ref');
+
+$x = bless {}, "0";
+cmp_ok(blessed($x), "eq", "0",	'blessed HASH-ref');
+
+{
+  my $depth;
+  {
+    no warnings 'redefine';
+    *UNIVERSAL::can = sub { die "Burp!" if ++$depth > 2; blessed(shift) };
+  }
+  $x = bless {}, "DEF";
+  is(blessed($x), "DEF", 'recursion of UNIVERSAL::can');
+}
+
+{
+  package Broken;
+  sub isa { die };
+  sub can { die };
+
+  my $obj = bless [], __PACKAGE__;
+  ::is( ::blessed($obj), __PACKAGE__, "blessed on broken isa() and can()" );
+}
+
diff --git a/ext/List-Util/t/dualvar.t b/ext/List-Util/t/dualvar.t
index 652f22ede9..fab3691a32 100644
--- a/ext/List-Util/t/dualvar.t
+++ b/ext/List-Util/t/dualvar.t
@@ -42,9 +42,12 @@ $var = dualvar($numstr, "");
 
 ok( $var == $numstr,	'NV');
 
-$var = dualvar(1<<31, "");
-ok( $var == (1<<31),	'UV 1');
-ok( $var > 0,		'UV 2');
+SKIP: {
+  skip("dualvar with UV value known to fail with $]",2) if $] < 5.006_001;
+  $var = dualvar(1<<31, "");
+  ok( $var == (1<<31),	'UV 1');
+  ok( $var > 0,		'UV 2');
+}
 
 tie my $tied, 'Tied';
 $var = dualvar($tied, "ok");
diff --git a/ext/List-Util/t/expfail.t b/ext/List-Util/t/expfail.t
new file mode 100644
index 0000000000..02fc192f14
--- /dev/null
+++ b/ext/List-Util/t/expfail.t
@@ -0,0 +1,29 @@
+#!./perl
+
+BEGIN {
+    unless (-d 'blib') {
+	chdir 't' if -d 't';
+	@INC = '../lib';
+	require Config; import Config;
+	keys %Config; # Silence warning
+	if ($Config{extensions} !~ /\bList\/Util\b/) {
+	    print "1..0 # Skip: List::Util was not built\n";
+	    exit 0;
+	}
+    }
+}
+
+use Test::More tests => 3;
+use strict;
+
+$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
+require Scalar::Util;
+
+for my $func (qw(dualvar set_prototype weaken)) {
+	eval { Scalar::Util->import($func); };
+	like(
+	    $@,
+ 	    qr/$func is only available with the XS/,
+ 	    "no pure perl $func: error raised",
+	);
+}
diff --git a/ext/List-Util/t/lln.t b/ext/List-Util/t/lln.t
index 4ec77199fc..d31633be6f 100644
--- a/ext/List-Util/t/lln.t
+++ b/ext/List-Util/t/lln.t
@@ -14,7 +14,7 @@ BEGIN {
 }
 
 use strict;
-use Test::More tests => 16;
+use Test::More tests => 18;
 use Scalar::Util qw(looks_like_number);
 
 foreach my $num (qw(1 -1 +1 1.0 +1.0 -1.0 -1.0e-12)) {
@@ -31,7 +31,16 @@ is(!!looks_like_number([]),	    '',			'ARRAY Ref');
 
 use Math::BigInt;
 my $bi = Math::BigInt->new('1234567890');
-is(!!looks_like_number($bi),	    '',			'Math::BigInt');
+is(!!looks_like_number($bi),	    1,			'Math::BigInt');
 is(!!looks_like_number("$bi"),	    1,			'Stringified Math::BigInt');
 
+{ package Foo;
+sub TIEHASH { bless {} }
+sub FETCH { $_[1] }
+}
+my %foo;
+tie %foo, 'Foo';
+is(!!looks_like_number($foo{'abc'}),	    '',			'Tied');
+is(!!looks_like_number($foo{'123'}),	    1,			'Tied');
+
 # We should copy some of perl core tests like t/base/num.t here
diff --git a/ext/List-Util/t/max.t b/ext/List-Util/t/max.t
index dd25a13817..a98219897c 100644
--- a/ext/List-Util/t/max.t
+++ b/ext/List-Util/t/max.t
@@ -14,7 +14,7 @@ BEGIN {
 }
 
 use strict;
-use Test::More tests => 5;
+use Test::More tests => 8;
 use List::Util qw(max);
 
 my $v;
@@ -34,3 +34,36 @@ my @a = map { rand() } 1 .. 20;
 my @b = sort { $a <=> $b } @a;
 $v = max(@a);
 is($v, $b[-1], '20-arg random order');
+
+my $one = Foo->new(1);
+my $two = Foo->new(2);
+my $thr = Foo->new(3);
+
+$v = max($one,$two,$thr);
+is($v, 3, 'overload');
+
+$v = max($thr,$two,$one);
+is($v, 3, 'overload');
+
+{ package Foo;
+
+use overload
+  '""' => sub { ${$_[0]} },
+  '+0' => sub { ${$_[0]} },
+  fallback => 1;
+  sub new {
+    my $class = shift;
+    my $value = shift;
+    bless \$value, $class;
+  }
+}
+
+SKIP: {
+  eval { require bignum; } or skip("Need bignum for testing overloading",1);
+
+  my $v1 = 2**65;
+  my $v2 = $v1 - 1;
+  my $v3 = $v2 - 1;
+  $v = max($v1,$v2,$v1,$v3,$v1);
+  is($v, $v1, 'bigint');
+}
diff --git a/ext/List-Util/t/min.t b/ext/List-Util/t/min.t
index 5e8c234698..eb8c1b9c70 100644
--- a/ext/List-Util/t/min.t
+++ b/ext/List-Util/t/min.t
@@ -14,7 +14,7 @@ BEGIN {
 }
 
 use strict;
-use Test::More tests => 5;
+use Test::More tests => 8;
 use List::Util qw(min);
 
 my $v;
@@ -34,3 +34,36 @@ my @a = map { rand() } 1 .. 20;
 my @b = sort { $a <=> $b } @a;
 $v = min(@a);
 is($v, $b[0], '20-arg random order');
+
+my $one = Foo->new(1);
+my $two = Foo->new(2);
+my $thr = Foo->new(3);
+
+$v = min($one,$two,$thr);
+is($v, 1, 'overload');
+
+$v = min($thr,$two,$one);
+is($v, 1, 'overload');
+
+{ package Foo;
+
+use overload
+  '""' => sub { ${$_[0]} },
+  '+0' => sub { ${$_[0]} },
+  fallback => 1;
+  sub new {
+    my $class = shift;
+    my $value = shift;
+    bless \$value, $class;
+  }
+}
+
+SKIP: {
+  eval { require bignum; } or skip("Need bignum for testing overloading",1);
+
+  my $v1 = 2**65;
+  my $v2 = $v1 - 1;
+  my $v3 = $v2 - 1;
+  $v = min($v1,$v2,$v1,$v3,$v1);
+  is($v, $v3, 'bigint');
+}
diff --git a/ext/List-Util/t/openhan.t b/ext/List-Util/t/openhan.t
index 0c84074988..bf4e6c16f8 100644
--- a/ext/List-Util/t/openhan.t
+++ b/ext/List-Util/t/openhan.t
@@ -14,16 +14,76 @@ BEGIN {
 }
 
 use strict;
-use vars qw(*CLOSED);
-use Test::More tests => 4;
+
+use Test::More tests => 14;
 use Scalar::Util qw(openhandle);
 
 ok(defined &openhandle, 'defined');
 
-my $fh = \*STDERR;
-is(openhandle($fh), $fh, 'STDERR');
+{
+    my $fh = \*STDERR;
+    is(openhandle($fh), $fh, 'STDERR');
+
+    is(fileno(openhandle(*STDERR)), fileno(STDERR), 'fileno(STDERR)');
+}
+
+{
+    use vars qw(*CLOSED);
+    is(openhandle(*CLOSED), undef, 'closed');
+}
+
+SKIP: {
+    skip "3-arg open only on 5.6 or later", 1 if $]<5.006;
+
+    open my $fh, "<", $0;
+    skip "could not open $0 for reading: $!", 1 unless $fh;
+    is(openhandle($fh), $fh, "works with indirect filehandles");
+}
+
+SKIP: {
+    skip "in-memory files only on 5.8 or later", 1 if $]<5.008;
+
+    open my $fh, "<", \"in-memory file";
+    skip "could not open in-memory file: $!", 1 unless $fh;
+    is(openhandle($fh), $fh, "works with in-memory files");
+}
 
-is(fileno(openhandle(*STDERR)), fileno(STDERR), 'fileno(STDERR)');
+ok(openhandle(\*DATA), "works for \*DATA");
+ok(openhandle(*DATA), "works for *DATA");
+ok(openhandle(*DATA{IO}), "works for *DATA{IO}");
 
-is(openhandle(*CLOSED), undef, 'closed');
+{
+    require IO::Handle;
+    my $fh = IO::Handle->new_from_fd(fileno(*STDERR), 'w');
+    skip "new_from_fd(fileno(*STDERR)) failed", 1 unless $fh;
+    ok(openhandle($fh), "works for IO::Handle objects");
+
+    ok(!openhandle(IO::Handle->new), "unopened IO::Handle");
+}
+
+{
+    require IO::File;
+    my $fh = IO::File->new;
+    $fh->open("< $0")
+        or skip "could not open $0: $!", 1;
+    ok(openhandle($fh), "works for IO::File objects");
+
+    ok(!openhandle(IO::File->new), "unopened IO::File" );
+}
+
+SKIP: {
+    skip( "Tied handles only on 5.8 or later", 1) if $]<5.008;
+
+    use vars qw(*H);
+
+    package My::Tie;
+    require Tie::Handle;
+    @My::Tie::ISA = qw(Tie::Handle);
+    sub TIEHANDLE { bless {} }
+
+    package main;
+    tie *H, 'My::Tie';
+    ok(openhandle(*H), "tied handles are always ok");
+}
 
+__DATA__
diff --git a/ext/List-Util/t/p_00version.t b/ext/List-Util/t/p_00version.t
new file mode 100644
index 0000000000..0b64f9eef3
--- /dev/null
+++ b/ext/List-Util/t/p_00version.t
@@ -0,0 +1,26 @@
+#!./perl
+
+BEGIN {
+    unless (-d 'blib') {
+	chdir 't' if -d 't';
+	@INC = '../lib';
+	require Config; import Config;
+	keys %Config; # Silence warning
+	if ($Config{extensions} !~ /\bList\/Util\b/) {
+	    print "1..0 # Skip: List::Util was not built\n";
+	    exit 0;
+	}
+    }
+}
+
+use Test::More tests => 2;
+
+# force perl-only version to be tested
+$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
+
+require Scalar::Util;
+require List::Util;
+
+is( $Scalar::Util::PP::VERSION, $List::Util::VERSION, "VERSION mismatch");
+is( $List::Util::PP::VERSION, $List::Util::VERSION, "VERSION mismatch");
+
diff --git a/ext/List-Util/t/p_tainted.t b/ext/List-Util/t/p_tainted.t
index 5123a9f6c1..eda5929112 100644
--- a/ext/List-Util/t/p_tainted.t
+++ b/ext/List-Util/t/p_tainted.t
@@ -6,5 +6,7 @@ use File::Spec;
 $List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
 
 (my $f = __FILE__) =~ s/p_//;
-my $filename = File::Spec->catfile(".", $f);
+my $filename = $^O eq 'MSWin32'
+             ? File::Spec->rel2abs(File::Spec->catfile(".", $f))
+             : File::Spec->catfile(".", $f);
 do $filename; die $@ if $@;
diff --git a/ext/List-Util/t/reduce.t b/ext/List-Util/t/reduce.t
index d82580de6e..5d6e3d942c 100644
--- a/ext/List-Util/t/reduce.t
+++ b/ext/List-Util/t/reduce.t
@@ -16,7 +16,7 @@ BEGIN {
 
 use List::Util qw(reduce min);
 use Test::More;
-plan tests => ($::PERL_ONLY ? 21 : 23);
+plan tests => ($::PERL_ONLY ? 23 : 25);
 
 my $v = reduce {};
 
@@ -122,6 +122,16 @@ SKIP: {
     is(&Internals::SvREFCNT(\&mult), $refcnt, "Refcount unchanged");
 }
 
+{
+  my $ok = 'failed';
+  local $SIG{__DIE__} = sub { $ok = $_[0] =~ /Not a (subroutine|CODE) reference/ ? '' : $_[0] };
+  eval { &reduce('foo',1,2) };
+  is($ok, '', 'Not a subroutine reference');
+  $ok = 'failed';
+  eval { &reduce({},1,2) };
+  is($ok, '', 'Not a subroutine reference');
+}
+
 # The remainder of the tests are only relevant for the XS
 # implementation. The Perl-only implementation behaves differently
 # (and more flexibly) in a way that we can't emulate from XS.
diff --git a/ext/List-Util/t/refaddr.t b/ext/List-Util/t/refaddr.t
index 61a33d32ea..35ad40f620 100644
--- a/ext/List-Util/t/refaddr.t
+++ b/ext/List-Util/t/refaddr.t
@@ -14,7 +14,7 @@ BEGIN {
 }
 
 
-use Test::More tests => 29;
+use Test::More tests => 32;
 
 use Scalar::Util qw(refaddr);
 use vars qw($t $y $x *F $v $r);
@@ -58,11 +58,22 @@ foreach $r ({}, \$t, [], \*F, sub {}) {
   ok(refaddr($x{$y}));
   ok(refaddr($x{$b}));
 }
+{
+  my $z = bless {}, '0';
+  ok(refaddr($z));
+  @{"0::ISA"} = qw(FooBar);
+  my $a = {};
+  my $r = refaddr($a);
+  $z = bless $a, '0';
+  ok(refaddr($z) > 10);
+  is(refaddr($z),$r,"foo");
+}
 
 package FooBar;
 
 use overload  '0+' => sub { 10 },
-		'+' => sub { 10 + $_[1] };
+		'+' => sub { 10 + $_[1] },
+		'"' => sub { "10" };
 
 package MyTie;
 
diff --git a/ext/List-Util/t/reftype.t b/ext/List-Util/t/reftype.t
index 6cbc6d0feb..a7adafb996 100644
--- a/ext/List-Util/t/reftype.t
+++ b/ext/List-Util/t/reftype.t
@@ -13,7 +13,7 @@ BEGIN {
     }
 }
 
-use Test::More tests => 23;
+use Test::More tests => 29;
 
 use Scalar::Util qw(reftype);
 use vars qw($t $y $x *F);
@@ -21,6 +21,7 @@ use Symbol qw(gensym);
 
 # Ensure we do not trigger and tied methods
 tie *F, 'MyTie';
+my $RE = $] < 5.011 ? 'SCALAR' : 'REGEXP';
 
 @test = (
  [ undef, 1,		'number'	],
@@ -32,7 +33,8 @@ tie *F, 'MyTie';
  [ GLOB   => \*F,	'tied GLOB ref'	],
  [ GLOB   => gensym,	'GLOB ref'	],
  [ CODE   => sub {},	'CODE ref'	],
-# [ IO => *STDIN{IO} ] the internal sv_reftype returns UNKNOWN
+ [ IO     => *STDIN{IO},'IO ref'        ],
+ [ $RE    => qr/x/,     'REGEEXP'       ],
 );
 
 foreach $test (@test) {
diff --git a/ext/List-Util/t/stack-corruption.t b/ext/List-Util/t/stack-corruption.t
index 8acbb0fb2c..dff5af03c4 100644
--- a/ext/List-Util/t/stack-corruption.t
+++ b/ext/List-Util/t/stack-corruption.t
@@ -11,6 +11,10 @@ BEGIN {
 	    exit 0;
 	}
     }
+    if ($] eq "5.008009" or $] eq "5.010000" or $] le "5.006002") {
+        print "1..0 # Skip: known to fail on $]\n";
+        exit 0;
+    }
 }
 
 use List::Util qw(reduce);
diff --git a/ext/List-Util/t/sum.t b/ext/List-Util/t/sum.t
index 4860eeba9e..ef484f96c5 100644
--- a/ext/List-Util/t/sum.t
+++ b/ext/List-Util/t/sum.t
@@ -13,7 +13,7 @@ BEGIN {
     }
 }
 
-use Test::More tests => 6;
+use Test::More tests => 8;
 
 use List::Util qw(sum);
 
@@ -37,3 +37,33 @@ is( $v, 0, 'variable arg');
 $v = sum(-3.5,3);
 is( $v, -0.5, 'real numbers');
 
+my $one = Foo->new(1);
+my $two = Foo->new(2);
+my $thr = Foo->new(3);
+
+$v = sum($one,$two,$thr);
+is($v, 6, 'overload');
+
+
+{ package Foo;
+
+use overload
+  '""' => sub { ${$_[0]} },
+  '+0' => sub { ${$_[0]} },
+  fallback => 1;
+  sub new {
+    my $class = shift;
+    my $value = shift;
+    bless \$value, $class;
+  }
+}
+
+SKIP: {
+  eval { require bignum; } or skip("Need bignum for testing overloading",1);
+
+  my $v1 = 2**65;
+  my $v2 = 2**65;
+  my $v3 = $v1 + $v2;
+  $v = sum($v1,$v2);
+  is($v, $v3, 'bignum');
+}
diff --git a/ext/List-Util/t/weak.t b/ext/List-Util/t/weak.t
index d0c3dff187..f014113694 100644
--- a/ext/List-Util/t/weak.t
+++ b/ext/List-Util/t/weak.t
@@ -1,10 +1,11 @@
 #!./perl
 
+use strict;
+use Config;
 BEGIN {
     unless (-d 'blib') {
 	chdir 't' if -d 't';
 	@INC = '../lib';
-	require Config; import Config;
 	keys %Config; # Silence warning
 	if ($Config{extensions} !~ /\bList\/Util\b/) {
 	    print "1..0 # Skip: List::Util was not built\n";
@@ -14,7 +15,7 @@ BEGIN {
 }
 
 use Scalar::Util ();
-use Test::More  (grep { /weaken/ } @Scalar::Util::EXPORT_FAIL)
+use Test::More  ((grep { /weaken/ } @Scalar::Util::EXPORT_FAIL) and !$ENV{PERL_CORE})
 			? (skip_all => 'weaken requires XS version')
 			: (tests => 22);
 
@@ -94,9 +95,9 @@ print "# EXITBLOCK\n";
 # Case 3: a circular structure
 #
 
-$flag = 0;
+my $flag = 0;
 {
-	my $y = bless {}, Dest;
+	my $y = bless {}, 'Dest';
 	Dump($y);
 	print "# 1: $y\n";
 	$y->{Self} = $y;
@@ -126,8 +127,8 @@ print "# FLAGU\n";
 
 $flag = 0;
 {
-	my $y = bless {}, Dest;
-	my $x = bless {}, Dest;
+	my $y = bless {}, 'Dest';
+	my $x = bless {}, 'Dest';
 	$x->{Ref} = $y;
 	$y->{Ref} = $x;
 	$x->{Flag} = \$flag;
@@ -140,6 +141,7 @@ ok( $flag == 2 );
 # Case 5: deleting a weakref before the other one
 #
 
+my ($y,$z);
 {
 	my $x = "foo";
 	$y = \$x;
@@ -170,7 +172,7 @@ ok(isweak($b));
 $b = \$a;
 ok(!isweak($b));
 
-$x = {};
+my $x = {};
 weaken($x->{Y} = \$a);
 ok(isweak($x->{Y}));
 ok(!isweak($x->{Z}));