rpms/perl/devel perl-bz509676.patch, NONE, 1.1 perl-skip-prereq.patch, NONE, 1.1 perl-update-Scalar-List-Utils.patch, NONE, 1.1 perl.spec, 1.223, 1.224
Štěpán Kasal
kasal at fedoraproject.org
Fri Jul 10 18:38:10 UTC 2009
- Previous message (by thread): rpms/unetbootin/devel import.log, NONE, 1.1 unetbootin.spec, NONE, 1.1 .cvsignore, 1.1, 1.2 sources, 1.1, 1.2
- Next message (by thread): rpms/wordpress-mu/F-10 cve-2009-2334.patch, NONE, 1.1 sources, 1.3, 1.4 wordpress-mu.spec, 1.4, 1.5
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
Author: kasal
Update of /cvs/extras/rpms/perl/devel
In directory cvs1.fedora.phx.redhat.com:/tmp/cvs-serv27967
Modified Files:
perl.spec
Added Files:
perl-bz509676.patch perl-skip-prereq.patch
perl-update-Scalar-List-Utils.patch
Log Message:
- fix generated .ph files so that they no longer cause warnings (#509676)
- remove PREREQ_FATAL from Makefile.PL's processed by miniperl
- update to latest Scalar-List-Utils (#507378)
- perl-skip-prereq.patch: skip more prereq declarations in Makefile.PL files
perl-bz509676.patch:
--- NEW FILE perl-bz509676.patch ---
commit 345d607e7958b7f31d5f0c780e86d1cc3e658d99
Author: Niko Tyni <ntyni at debian.org>
Date: Tue Apr 14 22:55:34 2009 +0300
Squelch 'Constant subroutine ... undefined' warnings from .ph files
As reported by Christopher Zimmermann in <http://bugs.debian.org/379757>,
code generated from simple #undef directives by h2ph can cause
'Constant subroutine ... undefined' warnings if the undefined
function was eligible for inlining.
(cherry picked from commit c0cc52e96e988526754ef533bd76595720660db2)
commit 2d375d52dd1895b26a80209dd64a3c11b9e3b532
Author: Niko Tyni <ntyni at debian.org>
Date: Tue Apr 14 22:55:33 2009 +0300
Add tests to verify that h2ph output compiles and is warning free
The #include directives are #ifdef'd out so that running the
resulting code does not actually need the headers. We still
get the same effect from comparing with the expected h2ph output.
(cherry picked from commit c1a2df7619e7315b8fccef3b9fa56bb8d7df3845)
diff --git a/lib/h2ph.t b/lib/h2ph.t
index 7b339b3..e303406 100755
--- a/lib/h2ph.t
+++ b/lib/h2ph.t
@@ -15,7 +15,7 @@ if (!(-e $extracted_program)) {
exit 0;
}
-print "1..2\n";
+print "1..4\n";
# quickly compare two text files
sub txt_compare {
@@ -32,6 +32,14 @@ print(($ok == 0 ? "" : "not "), "ok 1\n");
$ok = txt_compare("lib/h2ph.ph", "lib/h2ph.pht");
print(($ok == 0 ? "" : "not "), "ok 2\n");
+# does the output compile?
+$ok = system($^X, "-I../lib", "lib/h2ph.pht");
+print(($ok == 0 ? "" : "not "), "ok 3\n");
+
+# is the output warning free?
+$ok = system($^X, "-w", "-I../lib", "-e", '$SIG{__WARN__} = sub { die $_[0] }; require "lib/h2ph.pht"');
+print(($ok == 0 ? "" : "not "), "ok 4\n");
+
# cleanup - should this be in an END block?
unlink("lib/h2ph.ph");
unlink("_h2ph_pre.ph");
diff --git a/t/lib/h2ph.h b/t/lib/h2ph.h
index 495789a..78429ca 100644
--- a/t/lib/h2ph.h
+++ b/t/lib/h2ph.h
@@ -26,6 +26,10 @@
#undef MAX
#define MAX(a,b) ((a) > (b) ? (a) : (b))
+/* Test #undef'ining an existing constant function */
+#define NOTTRUE 0
+#undef NOTTRUE
+
/* Test #ifdef */
#ifdef __SOME_UNIMPORTANT_PROPERTY
#define MIN(a,b) ((a) < (b) ? (a) : (b))
@@ -68,9 +72,11 @@ function Tru64_Pascal(n: Integer): Integer;
* with `use lib qw(/opt/perl5/lib/site_perl/i586-linux/linux);' or whatever
* your equivalent is...
*/
+#if 0
#include <sys/socket.h>
#import "sys/ioctl.h"
#include_next <sys/fcntl.h>
+#endif
/* typedefs should be ignored */
typedef struct a_struct {
diff --git a/t/lib/h2ph.pht b/t/lib/h2ph.pht
index 145e682..3723fca 100644
--- a/t/lib/h2ph.pht
+++ b/t/lib/h2ph.pht
@@ -1,6 +1,6 @@
require '_h2ph_pre.ph';
-no warnings 'redefine';
+no warnings qw(redefine misc);
unless(defined(&SQUARE)) {
sub SQUARE {
@@ -22,6 +22,8 @@ unless(defined(&_H2PH_H_)) {
my($a,$b) = @_;
eval q((($a) > ($b) ? ($a) : ($b)));
}' unless defined(&MAX);
+ eval 'sub NOTTRUE () {0;}' unless defined(&NOTTRUE);
+ undef(&NOTTRUE) if defined(&NOTTRUE);
if(defined(&__SOME_UNIMPORTANT_PROPERTY)) {
eval 'sub MIN {
my($a,$b) = @_;
@@ -47,15 +49,17 @@ unless(defined(&_H2PH_H_)) {
} else {
eval 'sub WHATEVER () {1000;}' unless defined(&WHATEVER);
}
- require 'sys/socket.ph';
- require 'sys/ioctl.ph';
- eval {
- my(@REM);
- my(%INCD) = map { $INC{$_} => 1 } (grep { $_ eq "sys/fcntl.ph" } keys(%INC));
- @REM = map { "$_/sys/fcntl.ph" } (grep { not exists($INCD{"$_/sys/fcntl.ph"}) and -f "$_/sys/fcntl.ph" } @INC);
- require "$REM[0]" if @REM;
- };
- warn($@) if $@;
+ if(0) {
+ require 'sys/socket.ph';
+ require 'sys/ioctl.ph';
+ eval {
+ my(@REM);
+ my(%INCD) = map { $INC{$_} => 1 } (grep { $_ eq "sys/fcntl.ph" } keys(%INC));
+ @REM = map { "$_/sys/fcntl.ph" } (grep { not exists($INCD{"$_/sys/fcntl.ph"}) and -f "$_/sys/fcntl.ph" } @INC);
+ require "$REM[0]" if @REM;
+ };
+ warn($@) if $@;
+ }
eval("sub sun () { 0; }") unless defined(&sun);
eval("sub mon () { 1; }") unless defined(&mon);
eval("sub tue () { 2; }") unless defined(&tue);
diff --git a/utils/h2ph.PL b/utils/h2ph.PL
index 6f40126..4e99a7a 100644
--- a/utils/h2ph.PL
+++ b/utils/h2ph.PL
@@ -123,7 +123,7 @@ while (defined (my $file = next_file())) {
print OUT
"require '_h2ph_pre.ph';\n\n",
- "no warnings 'redefine';\n\n";
+ "no warnings qw(redefine misc);\n\n";
while (defined (local $_ = next_line($file))) {
if (s/^\s*\#\s*//) {
perl-skip-prereq.patch:
--- NEW FILE perl-skip-prereq.patch ---
--- perl-5.10.0/ext/Math/BigInt/FastCalc/Makefile.PL 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Math/BigInt/FastCalc/Makefile.PL 2009-07-10 15:37:39.000000000 +0200
@@ -2,12 +2,18 @@
use strict;
+unless($ENV{PERL_CORE}) {
+ $ENV{PERL_CORE} = 1 if grep { $_ eq 'PERL_CORE=1' } @ARGV;
+}
+
WriteMakefile(
'NAME' => 'Math::BigInt::FastCalc',
'VERSION_FROM' => 'FastCalc.pm',
- 'PREREQ_PM' => {
- 'Math::BigInt' => 1.88,
- },
+ (
+ $ENV{PERL_CORE}
+ ? ( )
+ : ('PREREQ_PM' => { 'Math::BigInt' => 1.88, } )
+ ),
INSTALLDIRS => 'perl',
PREREQ_FATAL => 1,
MAN3PODS => {},
perl-update-Scalar-List-Utils.patch:
--- NEW FILE perl-update-Scalar-List-Utils.patch ---
Scalar-List-Utils-1.21
Makefile.PL patched to build Util.so instead of ListUtil.so
diff -urN perl-5.10.0.orig/MANIFEST perl-5.10.0/MANIFEST
--- perl-5.10.0.orig/MANIFEST 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/MANIFEST 2009-07-10 12:34:47.000000000 +0200
@@ -842,6 +842,7 @@
ext/List/Util/t/00version.t Scalar::Util
ext/List/Util/t/blessed.t Scalar::Util
ext/List/Util/t/dualvar.t Scalar::Util
+ext/List/Util/t/expfail.t Scalar::Util
ext/List/Util/t/first.t List::Util
ext/List/Util/t/isvstring.t Scalar::Util
ext/List/Util/t/lln.t Scalar::Util
@@ -850,6 +851,7 @@
ext/List/Util/t/minstr.t List::Util
ext/List/Util/t/min.t List::Util
ext/List/Util/t/openhan.t Scalar::Util
+ext/List/Util/t/p_00version.t Scalar::Util
ext/List/Util/t/p_blessed.t Scalar::Util
ext/List/Util/t/p_first.t List::Util
ext/List/Util/t/p_lln.t Scalar::Util
@@ -871,6 +873,7 @@
ext/List/Util/t/refaddr.t Scalar::Util
ext/List/Util/t/reftype.t Scalar::Util
ext/List/Util/t/shuffle.t List::Util
+ext/List/Util/t/stack-corruption.t List::Util
ext/List/Util/t/sum.t List::Util
ext/List/Util/t/tainted.t Scalar::Util
ext/List/Util/t/weak.t Scalar::Util
diff -urN perl-5.10.0.orig/ext/List/Util/Changes perl-5.10.0/ext/List/Util/Changes
--- perl-5.10.0.orig/ext/List/Util/Changes 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/List/Util/Changes 2009-07-08 17:22:59.000000000 +0200
@@ -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 -urN perl-5.10.0.orig/ext/List/Util/Makefile.PL perl-5.10.0/ext/List/Util/Makefile.PL
--- perl-5.10.0.orig/ext/List/Util/Makefile.PL 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/List/Util/Makefile.PL 2009-05-15 04:54:09.000000000 +0200
@@ -1,47 +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",
- MAN3PODS => {}, # Pods will be built by installman.
- NAME => "List::Util",
- DEFINE => "-DPERL_EXT",
+ NAME => q[List::Util],
+ ABSTRACT => q[Common Scalar and List utility subroutines],
+ AUTHOR => q[Graham Barr <gbarr at 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 => {'Util.xs' => 'Util.c'},
+ OBJECT => 'Util$(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 {
+
+ 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));
+ }
+ }
-sub xs_o {
- my($self) = shift;
- return '' unless $self->needs_linking();
-'
-
-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 -urN perl-5.10.0.orig/ext/List/Util/Util.xs perl-5.10.0/ext/List/Util/Util.xs
--- perl-5.10.0.orig/ext/List/Util/Util.xs 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/List/Util/Util.xs 2009-05-13 23:59:43.000000000 +0200
@@ -147,18 +147,38 @@
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 @@
-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 @@
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 @@
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 -urN perl-5.10.0.orig/ext/List/Util/lib/List/Util/PP.pm perl-5.10.0/ext/List/Util/lib/List/Util/PP.pm
--- perl-5.10.0.orig/ext/List/Util/lib/List/Util/PP.pm 1970-01-01 01:00:00.000000000 +0100
+++ perl-5.10.0/ext/List/Util/lib/List/Util/PP.pm 2009-07-08 17:22:59.000000000 +0200
@@ -0,0 +1,75 @@
+# List::Util::PP.pm
+#
+# Copyright (c) 1997-2009 Graham Barr <gbarr at 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;
+
+ at ISA = qw(Exporter);
+ at 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 -urN perl-5.10.0.orig/ext/List/Util/lib/List/Util/XS.pm perl-5.10.0/ext/List/Util/lib/List/Util/XS.pm
--- perl-5.10.0.orig/ext/List/Util/lib/List/Util/XS.pm 1970-01-01 01:00:00.000000000 +0100
+++ perl-5.10.0/ext/List/Util/lib/List/Util/XS.pm 2009-07-08 17:22:59.000000000 +0200
@@ -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 at 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 -urN perl-5.10.0.orig/ext/List/Util/lib/List/Util.pm perl-5.10.0/ext/List/Util/lib/List/Util.pm
--- perl-5.10.0.orig/ext/List/Util/lib/List/Util.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/List/Util/lib/List/Util.pm 2009-07-08 17:22:59.000000000 +0200
@@ -1,8 +1,10 @@
# List::Util.pm
#
-# Copyright (c) 1997-2006 Graham Barr <gbarr at pobox.com>. All rights reserved.
+# Copyright (c) 1997-2009 Graham Barr <gbarr at 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 @@
@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 @@
} 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 ∑
-
-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 @@
$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 @@
$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 @@
=head1 COPYRIGHT
-Copyright (c) 1997-2006 Graham Barr <gbarr at pobox.com>. All rights reserved.
+Copyright (c) 1997-2007 Graham Barr <gbarr at 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 -urN perl-5.10.0.orig/ext/List/Util/lib/Scalar/Util/PP.pm perl-5.10.0/ext/List/Util/lib/Scalar/Util/PP.pm
--- perl-5.10.0.orig/ext/List/Util/lib/Scalar/Util/PP.pm 1970-01-01 01:00:00.000000000 +0100
+++ perl-5.10.0/ext/List/Util/lib/Scalar/Util/PP.pm 2009-07-08 17:22:59.000000000 +0200
@@ -0,0 +1,109 @@
+# Scalar::Util::PP.pm
+#
+# Copyright (c) 1997-2009 Graham Barr <gbarr at 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);
+
+ at ISA = qw(Exporter);
+ at 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 -urN perl-5.10.0.orig/ext/List/Util/lib/Scalar/Util.pm perl-5.10.0/ext/List/Util/lib/Scalar/Util.pm
--- perl-5.10.0.orig/ext/List/Util/lib/Scalar/Util.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/List/Util/lib/Scalar/Util.pm 2009-07-08 17:22:59.000000000 +0200
@@ -1,34 +1,46 @@
# Scalar::Util.pm
#
-# Copyright (c) 1997-2006 Graham Barr <gbarr at pobox.com>. All rights reserved.
+# Copyright (c) 1997-2007 Graham Barr <gbarr at 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 @@
? $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 @@
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 @@
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 @@
=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 @@
=head1 COPYRIGHT
-Copyright (c) 1997-2006 Graham Barr <gbarr at pobox.com>. All rights reserved.
+Copyright (c) 1997-2007 Graham Barr <gbarr at 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.
@@ -331,11 +280,4 @@
This program is free software; you can redistribute it and/or modify it
under the same terms as perl itself.
-=head1 BLATANT PLUG
-
-The weaken and isweak subroutines in this module and the patch to the core Perl
-were written in connection with the APress book `Tuomas J. Lukka's Definitive
-Guide to Object-Oriented Programming in Perl', to avoid explaining why certain
-things would have to be done in cumbersome ways.
-
=cut
diff -urN perl-5.10.0.orig/ext/List/Util/t/00version.t perl-5.10.0/ext/List/Util/t/00version.t
--- perl-5.10.0.orig/ext/List/Util/t/00version.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/List/Util/t/00version.t 2009-07-08 17:22:59.000000000 +0200
@@ -15,8 +15,11 @@
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 -urN perl-5.10.0.orig/ext/List/Util/t/blessed.t perl-5.10.0/ext/List/Util/t/blessed.t
--- perl-5.10.0.orig/ext/List/Util/t/blessed.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/List/Util/t/blessed.t 2009-07-08 17:22:59.000000000 +0200
@@ -13,7 +13,7 @@
}
}
-use Test::More tests => 8;
+use Test::More tests => 11;
use Scalar::Util qw(blessed);
use vars qw($t $x);
@@ -29,3 +29,26 @@
$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 -urN perl-5.10.0.orig/ext/List/Util/t/dualvar.t perl-5.10.0/ext/List/Util/t/dualvar.t
--- perl-5.10.0.orig/ext/List/Util/t/dualvar.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/List/Util/t/dualvar.t 2009-07-08 17:22:59.000000000 +0200
@@ -42,9 +42,12 @@
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 -urN perl-5.10.0.orig/ext/List/Util/t/expfail.t perl-5.10.0/ext/List/Util/t/expfail.t
--- perl-5.10.0.orig/ext/List/Util/t/expfail.t 1970-01-01 01:00:00.000000000 +0100
+++ perl-5.10.0/ext/List/Util/t/expfail.t 2009-07-08 17:22:59.000000000 +0200
@@ -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 -urN perl-5.10.0.orig/ext/List/Util/t/lln.t perl-5.10.0/ext/List/Util/t/lln.t
--- perl-5.10.0.orig/ext/List/Util/t/lln.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/List/Util/t/lln.t 2009-07-08 17:22:59.000000000 +0200
@@ -14,7 +14,7 @@
}
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 @@
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 -urN perl-5.10.0.orig/ext/List/Util/t/max.t perl-5.10.0/ext/List/Util/t/max.t
--- perl-5.10.0.orig/ext/List/Util/t/max.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/List/Util/t/max.t 2009-07-08 17:22:59.000000000 +0200
@@ -14,7 +14,7 @@
}
use strict;
-use Test::More tests => 5;
+use Test::More tests => 8;
use List::Util qw(max);
my $v;
@@ -34,3 +34,36 @@
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 -urN perl-5.10.0.orig/ext/List/Util/t/min.t perl-5.10.0/ext/List/Util/t/min.t
--- perl-5.10.0.orig/ext/List/Util/t/min.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/List/Util/t/min.t 2009-07-08 17:22:59.000000000 +0200
@@ -14,7 +14,7 @@
}
use strict;
-use Test::More tests => 5;
+use Test::More tests => 8;
use List::Util qw(min);
my $v;
@@ -34,3 +34,36 @@
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 -urN perl-5.10.0.orig/ext/List/Util/t/openhan.t perl-5.10.0/ext/List/Util/t/openhan.t
--- perl-5.10.0.orig/ext/List/Util/t/openhan.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/List/Util/t/openhan.t 2009-07-08 17:22:59.000000000 +0200
@@ -14,16 +14,76 @@
}
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");
+}
-is(fileno(openhandle(*STDERR)), fileno(STDERR), 'fileno(STDERR)');
+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(openhandle(*CLOSED), undef, 'closed');
+ok(openhandle(\*DATA), "works for \*DATA");
+ok(openhandle(*DATA), "works for *DATA");
+ok(openhandle(*DATA{IO}), "works for *DATA{IO}");
+
+{
+ 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 -urN perl-5.10.0.orig/ext/List/Util/t/p_00version.t perl-5.10.0/ext/List/Util/t/p_00version.t
--- perl-5.10.0.orig/ext/List/Util/t/p_00version.t 1970-01-01 01:00:00.000000000 +0100
+++ perl-5.10.0/ext/List/Util/t/p_00version.t 2009-07-08 17:22:59.000000000 +0200
@@ -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 -urN perl-5.10.0.orig/ext/List/Util/t/p_tainted.t perl-5.10.0/ext/List/Util/t/p_tainted.t
--- perl-5.10.0.orig/ext/List/Util/t/p_tainted.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/List/Util/t/p_tainted.t 2009-07-08 17:24:47.000000000 +0200
@@ -6,5 +6,7 @@
$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 -urN perl-5.10.0.orig/ext/List/Util/t/reduce.t perl-5.10.0/ext/List/Util/t/reduce.t
--- perl-5.10.0.orig/ext/List/Util/t/reduce.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/List/Util/t/reduce.t 2009-07-08 17:22:59.000000000 +0200
@@ -16,7 +16,7 @@
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 @@
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 -urN perl-5.10.0.orig/ext/List/Util/t/refaddr.t perl-5.10.0/ext/List/Util/t/refaddr.t
--- perl-5.10.0.orig/ext/List/Util/t/refaddr.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/List/Util/t/refaddr.t 2009-07-08 17:22:59.000000000 +0200
@@ -14,7 +14,7 @@
}
-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 @@
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 -urN perl-5.10.0.orig/ext/List/Util/t/reftype.t perl-5.10.0/ext/List/Util/t/reftype.t
--- perl-5.10.0.orig/ext/List/Util/t/reftype.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/List/Util/t/reftype.t 2009-07-08 17:22:59.000000000 +0200
@@ -13,7 +13,7 @@
}
}
-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 @@
# 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 @@
[ 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 -urN perl-5.10.0.orig/ext/List/Util/t/stack-corruption.t perl-5.10.0/ext/List/Util/t/stack-corruption.t
--- perl-5.10.0.orig/ext/List/Util/t/stack-corruption.t 1970-01-01 01:00:00.000000000 +0100
+++ perl-5.10.0/ext/List/Util/t/stack-corruption.t 2009-07-08 17:22:59.000000000 +0200
@@ -0,0 +1,30 @@
+#!./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;
+ }
+ }
+ 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);
+use Test::More tests => 1;
+
+my $ret = "original";
+$ret = $ret . broken();
+is($ret, "originalreturn");
+
+sub broken {
+ reduce { return "bogus"; } qw/some thing/;
+ return "return";
+}
diff -urN perl-5.10.0.orig/ext/List/Util/t/sum.t perl-5.10.0/ext/List/Util/t/sum.t
--- perl-5.10.0.orig/ext/List/Util/t/sum.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/List/Util/t/sum.t 2009-07-08 17:22:59.000000000 +0200
@@ -13,7 +13,7 @@
}
}
-use Test::More tests => 6;
+use Test::More tests => 8;
use List::Util qw(sum);
@@ -37,3 +37,33 @@
$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 -urN perl-5.10.0.orig/ext/List/Util/t/weak.t perl-5.10.0/ext/List/Util/t/weak.t
--- perl-5.10.0.orig/ext/List/Util/t/weak.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/List/Util/t/weak.t 2009-07-08 17:23:27.000000000 +0200
@@ -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 @@
}
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 @@
# 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 @@
$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 @@
# Case 5: deleting a weakref before the other one
#
+my ($y,$z);
{
my $x = "foo";
$y = \$x;
@@ -170,7 +172,7 @@
$b = \$a;
ok(!isweak($b));
-$x = {};
+my $x = {};
weaken($x->{Y} = \$a);
ok(isweak($x->{Y}));
ok(!isweak($x->{Z}));
Index: perl.spec
===================================================================
RCS file: /cvs/extras/rpms/perl/devel/perl.spec,v
retrieving revision 1.223
retrieving revision 1.224
diff -u -p -r1.223 -r1.224
--- perl.spec 7 Jul 2009 13:34:40 -0000 1.223
+++ perl.spec 10 Jul 2009 18:38:10 -0000 1.224
@@ -7,7 +7,7 @@
Name: perl
Version: %{perl_version}
-Release: 73%{?dist}
+Release: 74%{?dist}
Epoch: %{perl_epoch}
Summary: Practical Extraction and Report Language
Group: Development/Languages
@@ -184,6 +184,13 @@ Patch57: 38_fix_weaken_memleak
# http://rt.perl.org/rt3/Ticket/Display.html?id=39060 (#221113)
Patch58: perl-perlio-incorrect-errno.patch
+# h2ph: generated *.ph files no longer produce warnings when processed
+Patch59: perl-bz509676.patch
+
+# With the Scalar-List-Utils update, more prereq declarations have to
+# be skipped in Makefile.PL files.
+Patch60: perl-skip-prereq.patch
+
# Update some of the bundled modules
# see http://fedoraproject.org/wiki/Perl/perl.spec for instructions
Patch100: perl-update-constant.patch
@@ -229,9 +236,11 @@ Patch118: perl-update-autodie.patch
%define autodie_version 1.999
# cpan has it under PathTools-3.30
Patch119: perl-update-FileSpec.patch
-%define File_Spec_version 3.30
+%define File_Spec_version 3.30
Patch120: perl-update-Compress_Raw_Zlib.patch
-%define Compress_Raw_Zlib 2.020
+%define Compress_Raw_Zlib 2.020
+Patch121: perl-update-Scalar-List-Utils.patch
+%define Scalar_List_Utils 1.21
# Fedora uses links instead of lynx
# patches File-Fetch and CPAN
@@ -987,6 +996,8 @@ upstream tarball from perl.org.
%patch56 -p1
%patch57 -p1
%patch58 -p1
+%patch59 -p1
+%patch60 -p1
%patch100 -p1
%patch101 -p1
@@ -1009,6 +1020,7 @@ upstream tarball from perl.org.
%patch118 -p1
%patch119 -p1
%patch120 -p1
+%patch121 -p1
%patch201 -p1
#
@@ -1256,6 +1268,8 @@ perl -x patchlevel.h \
'Fedora Patch56: Fix $? when dumping core' \
'34209 Fix a memory leak with Scalar::Util::weaken()' \
'fix RT 39060, errno incorrectly set in perlio' \
+ 'Fedora Patch59: h2ph: generated *.ph files no longer produce warnings when processed' \
+ 'Fedora Patch60: remove PREREQ_FATAL from Makefile.PLs processed by miniperl' \
'Fedora Patch100: Update module constant to %{constant_version}' \
'Fedora Patch101: Update Archive::Extract to %{Archive_Extract_version}' \
'Fedora Patch102: Update Archive::Tar to %{Archive_Tar_version}' \
@@ -1277,6 +1291,7 @@ perl -x patchlevel.h \
'Fedora Patch117: Update module autodie to %{autodie_version}' \
'Fedora Patch119: Update File::Spec to %{File_Spec_version}' \
'Fedora Patch120: Update Compress::Raw::Zlib to %{Compress_Raw_Zlib}' \
+ 'Fedora Patch121: Update Scalar-List-Utils to %{Scalar_List_Utils}' \
'Fedora Patch201: Fedora uses links instead of lynx' \
%{nil}
@@ -1902,6 +1917,12 @@ TMPDIR="$PWD/tmp" make test
# Old changelog entries are preserved in CVS.
%changelog
+* Fri Jul 10 2009 Stepan Kasal <skasal at redhat.com> - 4:5.10.0-74
+- fix generated .ph files so that they no longer cause warnings (#509676)
+- remove PREREQ_FATAL from Makefile.PL's processed by miniperl
+- update to latest Scalar-List-Utils (#507378)
+- perl-skip-prereq.patch: skip more prereq declarations in Makefile.PL files
+
* Tue Jul 7 2009 Stepan Kasal <skasal at redhat.com> - 4:5.10.0-73
- re-enable tests
- Previous message (by thread): rpms/unetbootin/devel import.log, NONE, 1.1 unetbootin.spec, NONE, 1.1 .cvsignore, 1.1, 1.2 sources, 1.1, 1.2
- Next message (by thread): rpms/wordpress-mu/F-10 cve-2009-2334.patch, NONE, 1.1 sources, 1.3, 1.4 wordpress-mu.spec, 1.4, 1.5
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
More information about the fedora-extras-commits
mailing list