Re: [PATCH] Re: [perl #32383] DProf breaks List::Util::shuffle

Message-Id: <6CAD749E-AE29-415A-9ACB-BA8F6FB8279E@pobox.com>

p4raw-id: //depot/perl@26062

diff --git a/ext/List/Util/Util.xs b/ext/List/Util/Util.xs
index 7d7a154..3a95046 100644 (file)
--- a/ext/List/Util/Util.xs
+++ b/ext/List/Util/Util.xs
@@ -485,7 +485,16 @@ looks_like_number(sv)
        SV *sv
 PROTOTYPE: $
 CODE:
+#if (PERL_VERSION < 8) || (PERL_VERSION == 8 && PERL_SUBVERSION <5)
+  if (SvPOK(sv) || SvPOKp(sv)) {
+    RETVAL = looks_like_number(sv);
+  }
+  else {
+    RETVAL = SvFLAGS(sv) & (SVf_NOK|SVp_NOK|SVf_IOK|SVp_IOK);
+  }
+#else
   RETVAL = looks_like_number(sv);
+#endif
 OUTPUT:
   RETVAL
 

diff --git a/ext/List/Util/lib/Scalar/Util.pm b/ext/List/Util/lib/Scalar/Util.pm
index 3655164..4c34b8f 100644 (file)
--- a/ext/List/Util/lib/Scalar/Util.pm
+++ b/ext/List/Util/lib/Scalar/Util.pm
@@ -6,6 +6,8 @@
 
 package Scalar::Util;
 
+use strict;
+use vars qw(@ISA @EXPORT_OK $VERSION);
 require Exporter;
 require List::Util; # List::Util loads the XS
 
@@ -51,6 +53,7 @@ sub openhandle ($) {
 
 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
@@ -128,7 +131,7 @@ sub looks_like_number {
   local $_ = shift;
 
   # checks from perlfaq4
-  return $] < 5.008005 unless defined;
+  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);
@@ -148,7 +151,8 @@ Scalar::Util - A selection of general-utility scalar subroutines
 
 =head1 SYNOPSIS
 
-    use Scalar::Util qw(blessed dualvar isweak readonly refaddr reftype tainted weaken isvstring looks_like_number set_prototype);
+    use Scalar::Util qw(blessed dualvar isweak readonly refaddr reftype tainted
+                        weaken isvstring looks_like_number set_prototype);
 
 =head1 DESCRIPTION
 
@@ -202,6 +206,11 @@ If EXPR is a scalar which is a weak reference the result is true.
     weaken($ref);
     $weak = isweak($ref);               # true
 
+B<NOTE>: Copying a weak reference creates a normal, strong, reference.
+
+    $copy = $ref;
+    $weak = isweak($ref);               # false
+
 =item looks_like_number EXPR
 
 Returns true if perl thinks EXPR is a number. See

diff --git a/ext/List/Util/t/lln.t b/ext/List/Util/t/lln.t
index 5b9661f..4ec7719 100644 (file)
--- 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 => 12;
+use Test::More tests => 16;
 use Scalar::Util qw(looks_like_number);
 
 foreach my $num (qw(1 -1 +1 1.0 +1.0 -1.0 -1.0e-12)) {
@@ -25,6 +25,13 @@ is(!!looks_like_number("Inf"),           $] >= 5.006001,     'Inf');
 is(!!looks_like_number("Infinity"), $] >= 5.008,       'Infinity');
 is(!!looks_like_number("NaN"),     $] >= 5.008,        'NaN');
 is(!!looks_like_number("foo"),     '',                 'foo');
-is(!!looks_like_number(undef),     $] < 5.008005,      'undef');
+is(!!looks_like_number(undef),     '',                 'undef');
+is(!!looks_like_number({}),        '',                 'HASH Ref');
+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,                  'Stringified Math::BigInt');
 
 # We should copy some of perl core tests like t/base/num.t here

diff --git a/ext/List/Util/t/p_blessed.t b/ext/List/Util/t/p_blessed.t
index 2fd67b0..d594ac5 100644 (file)
--- a/ext/List/Util/t/p_blessed.t
+++ b/ext/List/Util/t/p_blessed.t
@@ -1,7 +1,7 @@
 #!./perl
 
 # force perl-only version to be tested
-sub List::Util::bootstrap {}
+$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
 
 (my $f = __FILE__) =~ s/p_//;
 do $f;

diff --git a/ext/List/Util/t/p_first.t b/ext/List/Util/t/p_first.t
index 1928ef2..676d967 100644 (file)
--- a/ext/List/Util/t/p_first.t
+++ b/ext/List/Util/t/p_first.t
@@ -1,7 +1,7 @@
 #!./perl
 
 # force perl-only version to be tested
-sub List::Util::bootstrap {}
+$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
 
 (my $f = __FILE__) =~ s/p_//;
 $::PERL_ONLY = $::PERL_ONLY = 1; # Mustn't use it only once!

diff --git a/ext/List/Util/t/p_lln.t b/ext/List/Util/t/p_lln.t
index 2fd67b0..d594ac5 100644 (file)
--- a/ext/List/Util/t/p_lln.t
+++ b/ext/List/Util/t/p_lln.t
@@ -1,7 +1,7 @@
 #!./perl
 
 # force perl-only version to be tested
-sub List::Util::bootstrap {}
+$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
 
 (my $f = __FILE__) =~ s/p_//;
 do $f;

diff --git a/ext/List/Util/t/p_max.t b/ext/List/Util/t/p_max.t
index 2fd67b0..d594ac5 100644 (file)
--- a/ext/List/Util/t/p_max.t
+++ b/ext/List/Util/t/p_max.t
@@ -1,7 +1,7 @@
 #!./perl
 
 # force perl-only version to be tested
-sub List::Util::bootstrap {}
+$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
 
 (my $f = __FILE__) =~ s/p_//;
 do $f;

diff --git a/ext/List/Util/t/p_maxstr.t b/ext/List/Util/t/p_maxstr.t
index 2fd67b0..d594ac5 100644 (file)
--- a/ext/List/Util/t/p_maxstr.t
+++ b/ext/List/Util/t/p_maxstr.t
@@ -1,7 +1,7 @@
 #!./perl
 
 # force perl-only version to be tested
-sub List::Util::bootstrap {}
+$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
 
 (my $f = __FILE__) =~ s/p_//;
 do $f;

diff --git a/ext/List/Util/t/p_min.t b/ext/List/Util/t/p_min.t
index 2fd67b0..d594ac5 100644 (file)
--- a/ext/List/Util/t/p_min.t
+++ b/ext/List/Util/t/p_min.t
@@ -1,7 +1,7 @@
 #!./perl
 
 # force perl-only version to be tested
-sub List::Util::bootstrap {}
+$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
 
 (my $f = __FILE__) =~ s/p_//;
 do $f;

diff --git a/ext/List/Util/t/p_minstr.t b/ext/List/Util/t/p_minstr.t
index 2fd67b0..d594ac5 100644 (file)
--- a/ext/List/Util/t/p_minstr.t
+++ b/ext/List/Util/t/p_minstr.t
@@ -1,7 +1,7 @@
 #!./perl
 
 # force perl-only version to be tested
-sub List::Util::bootstrap {}
+$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
 
 (my $f = __FILE__) =~ s/p_//;
 do $f;

diff --git a/ext/List/Util/t/p_openhan.t b/ext/List/Util/t/p_openhan.t
index 2fd67b0..d594ac5 100644 (file)
--- a/ext/List/Util/t/p_openhan.t
+++ b/ext/List/Util/t/p_openhan.t
@@ -1,7 +1,7 @@
 #!./perl
 
 # force perl-only version to be tested
-sub List::Util::bootstrap {}
+$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
 
 (my $f = __FILE__) =~ s/p_//;
 do $f;

diff --git a/ext/List/Util/t/p_readonly.t b/ext/List/Util/t/p_readonly.t
index 2fd67b0..d594ac5 100644 (file)
--- a/ext/List/Util/t/p_readonly.t
+++ b/ext/List/Util/t/p_readonly.t
@@ -1,7 +1,7 @@
 #!./perl
 
 # force perl-only version to be tested
-sub List::Util::bootstrap {}
+$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
 
 (my $f = __FILE__) =~ s/p_//;
 do $f;

diff --git a/ext/List/Util/t/p_reduce.t b/ext/List/Util/t/p_reduce.t
index 1928ef2..676d967 100644 (file)
--- a/ext/List/Util/t/p_reduce.t
+++ b/ext/List/Util/t/p_reduce.t
@@ -1,7 +1,7 @@
 #!./perl
 
 # force perl-only version to be tested
-sub List::Util::bootstrap {}
+$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
 
 (my $f = __FILE__) =~ s/p_//;
 $::PERL_ONLY = $::PERL_ONLY = 1; # Mustn't use it only once!

diff --git a/ext/List/Util/t/p_refaddr.t b/ext/List/Util/t/p_refaddr.t
index 2fd67b0..d594ac5 100644 (file)
--- a/ext/List/Util/t/p_refaddr.t
+++ b/ext/List/Util/t/p_refaddr.t
@@ -1,7 +1,7 @@
 #!./perl
 
 # force perl-only version to be tested
-sub List::Util::bootstrap {}
+$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
 
 (my $f = __FILE__) =~ s/p_//;
 do $f;

diff --git a/ext/List/Util/t/p_reftype.t b/ext/List/Util/t/p_reftype.t
index 2fd67b0..d594ac5 100644 (file)
--- a/ext/List/Util/t/p_reftype.t
+++ b/ext/List/Util/t/p_reftype.t
@@ -1,7 +1,7 @@
 #!./perl
 
 # force perl-only version to be tested
-sub List::Util::bootstrap {}
+$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
 
 (my $f = __FILE__) =~ s/p_//;
 do $f;

diff --git a/ext/List/Util/t/p_shuffle.t b/ext/List/Util/t/p_shuffle.t
index 2fd67b0..d594ac5 100644 (file)
--- a/ext/List/Util/t/p_shuffle.t
+++ b/ext/List/Util/t/p_shuffle.t
@@ -1,7 +1,7 @@
 #!./perl
 
 # force perl-only version to be tested
-sub List::Util::bootstrap {}
+$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
 
 (my $f = __FILE__) =~ s/p_//;
 do $f;

diff --git a/ext/List/Util/t/p_sum.t b/ext/List/Util/t/p_sum.t
index 2fd67b0..d594ac5 100644 (file)
--- a/ext/List/Util/t/p_sum.t
+++ b/ext/List/Util/t/p_sum.t
@@ -1,7 +1,7 @@
 #!./perl
 
 # force perl-only version to be tested
-sub List::Util::bootstrap {}
+$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
 
 (my $f = __FILE__) =~ s/p_//;
 do $f;

diff --git a/ext/List/Util/t/p_tainted.t b/ext/List/Util/t/p_tainted.t
index 7b00ebd..90275fd 100644 (file)
--- a/ext/List/Util/t/p_tainted.t
+++ b/ext/List/Util/t/p_tainted.t
@@ -1,7 +1,7 @@
 #!./perl -T
 
 # force perl-only version to be tested
-sub List::Util::bootstrap {}
+$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
 
 (my $f = __FILE__) =~ s/p_//;
 do "./$f";