From 8a4bfbfef9bca237d9087f8f3035d724b1074bf1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C5=A0t=C4=9Bp=C3=A1n=20Kasal?= Date: Fri, 10 Jul 2009 18:38:10 +0000 Subject: [PATCH] - 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 | 141 +++ perl-skip-prereq.patch | 24 + perl-update-Scalar-List-Utils.patch | 1520 +++++++++++++++++++++++++++ perl.spec | 27 +- 4 files changed, 1709 insertions(+), 3 deletions(-) create mode 100644 perl-bz509676.patch create mode 100644 perl-skip-prereq.patch create mode 100644 perl-update-Scalar-List-Utils.patch diff --git a/perl-bz509676.patch b/perl-bz509676.patch new file mode 100644 index 0000000..6699190 --- /dev/null +++ b/perl-bz509676.patch @@ -0,0 +1,141 @@ +commit 345d607e7958b7f31d5f0c780e86d1cc3e658d99 +Author: Niko Tyni +Date: Tue Apr 14 22:55:34 2009 +0300 + + Squelch 'Constant subroutine ... undefined' warnings from .ph files + + As reported by Christopher Zimmermann in , + 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 +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 + #import "sys/ioctl.h" + #include_next ++#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*//) { diff --git a/perl-skip-prereq.patch b/perl-skip-prereq.patch new file mode 100644 index 0000000..3fec041 --- /dev/null +++ b/perl-skip-prereq.patch @@ -0,0 +1,24 @@ +--- 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 => {}, diff --git a/perl-update-Scalar-List-Utils.patch b/perl-update-Scalar-List-Utils.patch new file mode 100644 index 0000000..4c03a63 --- /dev/null +++ b/perl-update-Scalar-List-Utils.patch @@ -0,0 +1,1520 @@ +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 ], ++ 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 . 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 -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 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 if the XS was not compiled. ++ ++=head1 SEE ALSO ++ ++L, L, L ++ ++=head1 COPYRIGHT ++ ++Copyright (c) 2008 Graham Barr . 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 . All rights reserved. ++# Copyright (c) 1997-2009 Graham Barr . 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 produce an identity value, then ++make sure that you always pass that identity value as the first argument to prevent ++C 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 produce an identity of 0, then ++make sure that you always pass C<0> as the first argument to prevent ++C being returned ++ ++ $foo = sum 0, @values; ++ + =back + + =head1 KNOWN BUGS +@@ -274,7 +226,7 @@ + + =head1 COPYRIGHT + +-Copyright (c) 1997-2006 Graham Barr . All rights reserved. ++Copyright (c) 1997-2007 Graham Barr . 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 . 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 -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 . All rights reserved. ++# Copyright (c) 1997-2007 Graham Barr . 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: 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 or C 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 you will need to use a newer release of perl. ++ ++=item C is only available with the XS version of Scalar::Util ++ ++C 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 . All rights reserved. ++Copyright (c) 1997-2007 Graham Barr . 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})); diff --git a/perl.spec b/perl.spec index 51085ce..f4c61f5 100644 --- a/perl.spec +++ b/perl.spec @@ -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 - 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 - 4:5.10.0-73 - re-enable tests