Change 26062 by [EMAIL PROTECTED] on 2005/11/09 11:56:04
Subject: Re: [PATCH] Re: [perl #32383] DProf breaks List::Util::shuffle
From: Graham Barr <[EMAIL PROTECTED]>
Date: Wed, 9 Nov 2005 06:09:48 -0600
Message-Id: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/ext/List/Util/Util.xs#35 edit
... //depot/perl/ext/List/Util/lib/Scalar/Util.pm#20 edit
... //depot/perl/ext/List/Util/t/lln.t#5 edit
... //depot/perl/ext/List/Util/t/p_blessed.t#2 edit
... //depot/perl/ext/List/Util/t/p_first.t#3 edit
... //depot/perl/ext/List/Util/t/p_lln.t#2 edit
... //depot/perl/ext/List/Util/t/p_max.t#2 edit
... //depot/perl/ext/List/Util/t/p_maxstr.t#2 edit
... //depot/perl/ext/List/Util/t/p_min.t#2 edit
... //depot/perl/ext/List/Util/t/p_minstr.t#2 edit
... //depot/perl/ext/List/Util/t/p_openhan.t#2 edit
... //depot/perl/ext/List/Util/t/p_readonly.t#2 edit
... //depot/perl/ext/List/Util/t/p_reduce.t#3 edit
... //depot/perl/ext/List/Util/t/p_refaddr.t#2 edit
... //depot/perl/ext/List/Util/t/p_reftype.t#2 edit
... //depot/perl/ext/List/Util/t/p_shuffle.t#2 edit
... //depot/perl/ext/List/Util/t/p_sum.t#2 edit
... //depot/perl/ext/List/Util/t/p_tainted.t#4 edit
Differences ...
==== //depot/perl/ext/List/Util/Util.xs#35 (text) ====
Index: perl/ext/List/Util/Util.xs
--- perl/ext/List/Util/Util.xs#34~26054~ Wed Nov 9 01:15:04 2005
+++ perl/ext/List/Util/Util.xs Wed Nov 9 03:56:04 2005
@@ -485,7 +485,16 @@
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
==== //depot/perl/ext/List/Util/lib/Scalar/Util.pm#20 (text) ====
Index: perl/ext/List/Util/lib/Scalar/Util.pm
--- perl/ext/List/Util/lib/Scalar/Util.pm#19~25953~ Wed Nov 2 04:49:54 2005
+++ perl/ext/List/Util/lib/Scalar/Util.pm Wed Nov 9 03:56:04 2005
@@ -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 @@
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 @@
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 @@
=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
@@ -201,6 +205,11 @@
$weak = isweak($ref); # false
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
==== //depot/perl/ext/List/Util/t/lln.t#5 (text) ====
Index: perl/ext/List/Util/t/lln.t
--- perl/ext/List/Util/t/lln.t#4~24551~ Mon May 23 06:49:59 2005
+++ perl/ext/List/Util/t/lln.t Wed Nov 9 03:56:04 2005
@@ -14,7 +14,7 @@
}
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("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
==== //depot/perl/ext/List/Util/t/p_blessed.t#2 (text) ====
Index: perl/ext/List/Util/t/p_blessed.t
--- perl/ext/List/Util/t/p_blessed.t#1~24465~ Fri May 13 13:42:53 2005
+++ perl/ext/List/Util/t/p_blessed.t Wed Nov 9 03:56:04 2005
@@ -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;
==== //depot/perl/ext/List/Util/t/p_first.t#3 (text) ====
Index: perl/ext/List/Util/t/p_first.t
--- perl/ext/List/Util/t/p_first.t#2~25953~ Wed Nov 2 04:49:54 2005
+++ perl/ext/List/Util/t/p_first.t Wed Nov 9 03:56:04 2005
@@ -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!
==== //depot/perl/ext/List/Util/t/p_lln.t#2 (text) ====
Index: perl/ext/List/Util/t/p_lln.t
--- perl/ext/List/Util/t/p_lln.t#1~24465~ Fri May 13 13:42:53 2005
+++ perl/ext/List/Util/t/p_lln.t Wed Nov 9 03:56:04 2005
@@ -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;
==== //depot/perl/ext/List/Util/t/p_max.t#2 (text) ====
Index: perl/ext/List/Util/t/p_max.t
--- perl/ext/List/Util/t/p_max.t#1~24465~ Fri May 13 13:42:53 2005
+++ perl/ext/List/Util/t/p_max.t Wed Nov 9 03:56:04 2005
@@ -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;
==== //depot/perl/ext/List/Util/t/p_maxstr.t#2 (text) ====
Index: perl/ext/List/Util/t/p_maxstr.t
--- perl/ext/List/Util/t/p_maxstr.t#1~24465~ Fri May 13 13:42:53 2005
+++ perl/ext/List/Util/t/p_maxstr.t Wed Nov 9 03:56:04 2005
@@ -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;
==== //depot/perl/ext/List/Util/t/p_min.t#2 (text) ====
Index: perl/ext/List/Util/t/p_min.t
--- perl/ext/List/Util/t/p_min.t#1~24465~ Fri May 13 13:42:53 2005
+++ perl/ext/List/Util/t/p_min.t Wed Nov 9 03:56:04 2005
@@ -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;
==== //depot/perl/ext/List/Util/t/p_minstr.t#2 (text) ====
Index: perl/ext/List/Util/t/p_minstr.t
--- perl/ext/List/Util/t/p_minstr.t#1~24465~ Fri May 13 13:42:53 2005
+++ perl/ext/List/Util/t/p_minstr.t Wed Nov 9 03:56:04 2005
@@ -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;
==== //depot/perl/ext/List/Util/t/p_openhan.t#2 (text) ====
Index: perl/ext/List/Util/t/p_openhan.t
--- perl/ext/List/Util/t/p_openhan.t#1~24465~ Fri May 13 13:42:53 2005
+++ perl/ext/List/Util/t/p_openhan.t Wed Nov 9 03:56:04 2005
@@ -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;
==== //depot/perl/ext/List/Util/t/p_readonly.t#2 (text) ====
Index: perl/ext/List/Util/t/p_readonly.t
--- perl/ext/List/Util/t/p_readonly.t#1~24465~ Fri May 13 13:42:53 2005
+++ perl/ext/List/Util/t/p_readonly.t Wed Nov 9 03:56:04 2005
@@ -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;
==== //depot/perl/ext/List/Util/t/p_reduce.t#3 (text) ====
Index: perl/ext/List/Util/t/p_reduce.t
--- perl/ext/List/Util/t/p_reduce.t#2~25953~ Wed Nov 2 04:49:54 2005
+++ perl/ext/List/Util/t/p_reduce.t Wed Nov 9 03:56:04 2005
@@ -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!
==== //depot/perl/ext/List/Util/t/p_refaddr.t#2 (text) ====
Index: perl/ext/List/Util/t/p_refaddr.t
--- perl/ext/List/Util/t/p_refaddr.t#1~24465~ Fri May 13 13:42:53 2005
+++ perl/ext/List/Util/t/p_refaddr.t Wed Nov 9 03:56:04 2005
@@ -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;
==== //depot/perl/ext/List/Util/t/p_reftype.t#2 (text) ====
Index: perl/ext/List/Util/t/p_reftype.t
--- perl/ext/List/Util/t/p_reftype.t#1~24465~ Fri May 13 13:42:53 2005
+++ perl/ext/List/Util/t/p_reftype.t Wed Nov 9 03:56:04 2005
@@ -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;
==== //depot/perl/ext/List/Util/t/p_shuffle.t#2 (text) ====
Index: perl/ext/List/Util/t/p_shuffle.t
--- perl/ext/List/Util/t/p_shuffle.t#1~24465~ Fri May 13 13:42:53 2005
+++ perl/ext/List/Util/t/p_shuffle.t Wed Nov 9 03:56:04 2005
@@ -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;
==== //depot/perl/ext/List/Util/t/p_sum.t#2 (text) ====
Index: perl/ext/List/Util/t/p_sum.t
--- perl/ext/List/Util/t/p_sum.t#1~24465~ Fri May 13 13:42:53 2005
+++ perl/ext/List/Util/t/p_sum.t Wed Nov 9 03:56:04 2005
@@ -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;
==== //depot/perl/ext/List/Util/t/p_tainted.t#4 (text) ====
Index: perl/ext/List/Util/t/p_tainted.t
--- perl/ext/List/Util/t/p_tainted.t#3~25953~ Wed Nov 2 04:49:54 2005
+++ perl/ext/List/Util/t/p_tainted.t Wed Nov 9 03:56:04 2005
@@ -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";
End of Patch.
