basebuilder_pel7ppc64bebuilder0
6 years ago
38 changed files with 7418 additions and 0 deletions
@ -0,0 +1,153 @@
@@ -0,0 +1,153 @@
|
||||
# Sensible Perl-specific RPM build macros. |
||||
# |
||||
# Note that these depend on the generic filtering system being in place in |
||||
# rpm core; but won't cause a build to fail if they're not present. |
||||
# |
||||
# Chris Weyl <cweyl@alumni.drew.edu> 2009 |
||||
# Marcela Mašláňová <mmaslano@redhat.com> 2011 |
||||
|
||||
# This macro unsets several common vars used to control how Makefile.PL (et |
||||
# al) build and install packages. We also set a couple to help some of the |
||||
# common systems be less interactive. This was blatantly stolen from |
||||
# cpanminus, and helps building rpms locally when one makes extensive use of |
||||
# local::lib, etc. |
||||
# |
||||
# Usage, in %build, before "%{__perl} Makefile.PL ..." |
||||
# |
||||
# %{?perl_ext_env_unset} |
||||
|
||||
%perl_ext_env_unset %{expand: |
||||
unset PERL_MM_OPT MODULEBUILDRC PERL5INC |
||||
export PERL_AUTOINSTALL="--defaultdeps" |
||||
export PERL_MM_USE_DEFAULT=1 |
||||
} |
||||
|
||||
############################################################################# |
||||
# Filtering macro incantations |
||||
|
||||
# keep track of what "revision" of the filtering we're at. Each time we |
||||
# change the filter we should increment this. |
||||
|
||||
%perl_default_filter_revision 3 |
||||
|
||||
# Perl provides/requeries are generated by external generators. |
||||
%global __perl_provides /usr/lib/rpm/perl.prov |
||||
%global __perl_requires /usr/lib/rpm/perl.req |
||||
|
||||
# By default, for perl packages we want to filter all files in _docdir from |
||||
# req/prov scanning, as well as filtering out any provides caused by private |
||||
# libs in vendorarch/archlib (vendor/core). |
||||
# |
||||
# Note that this must be invoked in the spec file, preferably as |
||||
# "%{?perl_default_filter}", before any %description block. |
||||
|
||||
%perl_default_filter %{expand: \ |
||||
%global __provides_exclude_from %{perl_vendorarch}/auto/.*\\\\.so$|%{perl_archlib}/.*\\\\.so$|%{_docdir} |
||||
%global __requires_exclude_from %{_docdir} |
||||
%global __provides_exclude perl\\\\(VMS|perl\\\\(Win32|perl\\\\(DB\\\\)|perl\\\\(UNIVERSAL\\\\) |
||||
%global __requires_exclude perl\\\\(VMS|perl\\\\(Win32 |
||||
} |
||||
|
||||
############################################################################# |
||||
# Macros to assist with generating a "-tests" subpackage in a semi-automatic |
||||
# manner. |
||||
# |
||||
# The following macros are still in a highly experimental stage and users |
||||
# should be aware that the interface and behaviour may change. |
||||
# |
||||
# PLEASE, PLEASE CONDITIONALIZE THESE MACROS IF YOU USE THEM. |
||||
# |
||||
# See http://gist.github.com/284409 |
||||
|
||||
# These macros should be invoked as above, right before the first %description |
||||
# section, and conditionalized. e.g., for the common case where all our tests |
||||
# are located under t/, the correct usage is: |
||||
# |
||||
# %{?perl_default_subpackage_tests} |
||||
# |
||||
# If custom files/directories need to be specified, this can be done as such: |
||||
# |
||||
# %{?perl_subpackage_tests:%perl_subpackage_tests t/ one/ three.sql} |
||||
# |
||||
# etc, etc. |
||||
|
||||
%perl_version %(eval "`%{__perl} -V:version`"; echo $version) |
||||
%perl_testdir %{_libexecdir}/perl5-tests |
||||
%cpan_dist_name %(eval echo %{name} | %{__sed} -e 's/^perl-//') |
||||
|
||||
# easily mark something as required by -tests and BR to the main package |
||||
%tests_req() %{expand:\ |
||||
BuildRequires: %*\ |
||||
%%tests_subpackage_requires %*\ |
||||
} |
||||
|
||||
# fixup (and create if needed) the shbang lines in tests, so they work and |
||||
# rpmlint doesn't (correctly) have a fit |
||||
%fix_shbang_line() \ |
||||
TMPHEAD=`mktemp`\ |
||||
TMPBODY=`mktemp`\ |
||||
for file in %* ; do \ |
||||
head -1 $file > $TMPHEAD\ |
||||
tail -n +2 $file > $TMPBODY\ |
||||
%{__perl} -pi -e '$f = /^#!/ ? "" : "#!%{__perl}$/"; $_="$f$_"' $TMPHEAD\ |
||||
cat $TMPHEAD $TMPBODY > $file\ |
||||
done\ |
||||
%{__perl} -MExtUtils::MakeMaker -e "ExtUtils::MM_Unix->fixin(qw{%*})"\ |
||||
%{__rm} $TMPHEAD $TMPBODY\ |
||||
%{nil} |
||||
|
||||
# additional -tests subpackage requires, if any |
||||
%tests_subpackage_requires() %{expand: \ |
||||
%global __tests_spkg_req %{?__tests_spkg_req} %* \ |
||||
} |
||||
|
||||
# additional -tests subpackage provides, if any |
||||
%tests_subpackage_provides() %{expand: \ |
||||
%global __tests_spkg_prov %{?__tests_spkg_prov} %* \ |
||||
} |
||||
|
||||
# |
||||
# Runs after the body of %check completes. |
||||
# |
||||
|
||||
%__perl_check_pre %{expand: \ |
||||
%{?__spec_check_pre} \ |
||||
pushd %{buildsubdir} \ |
||||
%define perl_br_testdir %{buildroot}%{perl_testdir}/%{cpan_dist_name} \ |
||||
%{__mkdir_p} %{perl_br_testdir} \ |
||||
%{__tar} -cf - %{__perl_test_dirs} | ( cd %{perl_br_testdir} && %{__tar} -xf - ) \ |
||||
find . -maxdepth 1 -type f -name '*META*' -exec %{__cp} -vp {} %{perl_br_testdir} ';' \ |
||||
find %{perl_br_testdir} -type f -exec %{__chmod} -c -x {} ';' \ |
||||
T_FILES=`find %{perl_br_testdir} -type f -name '*.t'` \ |
||||
%fix_shbang_line $T_FILES \ |
||||
%{__chmod} +x $T_FILES \ |
||||
%{_fixperms} %{perl_br_testdir} \ |
||||
popd \ |
||||
} |
||||
|
||||
# |
||||
# The actual invoked macro |
||||
# |
||||
|
||||
%perl_subpackage_tests() %{expand: \ |
||||
%global __perl_package 1\ |
||||
%global __perl_test_dirs %* \ |
||||
%global __spec_check_pre %{expand:%{__perl_check_pre}} \ |
||||
%package tests\ |
||||
Summary: Test suite for package %{name}\ |
||||
Group: Development/Debug\ |
||||
Requires: %{name} = %{?epoch:%{epoch}:}%{version}-%{release}\ |
||||
Requires: /usr/bin/prove \ |
||||
%{?__tests_spkg_req:Requires: %__tests_spkg_req}\ |
||||
%{?__tests_spkg_prov:Provides: %__tests_spkg_prov}\ |
||||
AutoReqProv: 0 \ |
||||
%description tests\ |
||||
This package provides the test suite for package %{name}.\ |
||||
%files tests\ |
||||
%defattr(-,root,root,-)\ |
||||
%{perl_testdir}\ |
||||
} |
||||
|
||||
# shortcut sugar |
||||
%perl_default_subpackage_tests %perl_subpackage_tests t/ |
||||
|
@ -0,0 +1,12 @@
@@ -0,0 +1,12 @@
|
||||
diff -up perl-5.10.0/Configure.didi perl-5.10.0/Configure |
||||
--- perl-5.10.0/Configure.didi 2007-12-18 11:47:07.000000000 +0100 |
||||
+++ perl-5.10.0/Configure 2008-07-21 10:51:16.000000000 +0200 |
||||
@@ -1327,7 +1327,7 @@ libswanted_uselargefiles='' |
||||
: set usesocks on the Configure command line to enable socks. |
||||
: List of libraries we want. |
||||
: If anyone needs extra -lxxx, put those in a hint file. |
||||
-libswanted="sfio socket bind inet nsl nm ndbm gdbm dbm db malloc dl dld ld sun" |
||||
+libswanted="sfio socket resolv inet nsl nm ndbm gdbm dbm db malloc dl dld ld sun" |
||||
libswanted="$libswanted m crypt sec util c cposix posix ucb bsd BSD" |
||||
: We probably want to search /usr/shlib before most other libraries. |
||||
: This is only used by the lib/ExtUtils/MakeMaker.pm routine extliblist. |
@ -0,0 +1,12 @@
@@ -0,0 +1,12 @@
|
||||
diff -up perl-5.10.0/t/io/fs.t.BAD perl-5.10.0/t/io/fs.t |
||||
--- perl-5.10.0/t/io/fs.t.BAD 2008-01-30 13:36:43.000000000 -0500 |
||||
+++ perl-5.10.0/t/io/fs.t 2008-01-30 13:41:27.000000000 -0500 |
||||
@@ -227,7 +227,7 @@ isnt($atime, 500000000, 'atime'); |
||||
isnt($mtime, 500000000 + $delta, 'mtime'); |
||||
|
||||
SKIP: { |
||||
- skip "no futimes", 4 unless ($Config{d_futimes} || "") eq "define"; |
||||
+ skip "no futimes", 4; |
||||
open(my $fh, "<", 'b'); |
||||
$foo = (utime 500000000,500000000 + $delta, $fh); |
||||
is($foo, 1, "futime"); |
@ -0,0 +1,17 @@
@@ -0,0 +1,17 @@
|
||||
diff -up perl-5.14.1/cpan/File-Temp/t/fork.t.off perl-5.14.1/cpan/File-Temp/t/fork.t |
||||
--- perl-5.14.1/cpan/File-Temp/t/fork.t.off 2011-04-13 13:36:34.000000000 +0200 |
||||
+++ perl-5.14.1/cpan/File-Temp/t/fork.t 2011-06-20 10:29:31.536282611 +0200 |
||||
@@ -12,12 +12,8 @@ BEGIN { |
||||
$Config::Config{useithreads} and |
||||
$Config::Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/ |
||||
); |
||||
- if ( $can_fork ) { |
||||
- print "1..8\n"; |
||||
- } else { |
||||
- print "1..0 # Skip No fork available\n"; |
||||
+ print "1..0 # Skip Koji doesn't work with Perl fork tests\n"; |
||||
exit; |
||||
- } |
||||
} |
||||
|
||||
use File::Temp; |
@ -0,0 +1,60 @@
@@ -0,0 +1,60 @@
|
||||
From 915ceb2f33469eeffd28cfb81ca52a05e1301f15 Mon Sep 17 00:00:00 2001 |
||||
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com> |
||||
Date: Fri, 14 Sep 2012 13:17:29 +0200 |
||||
Subject: [PATCH] Override the Pod::Simple::parse_file |
||||
|
||||
This sets output_fh to STDOUT if it's not already set. |
||||
This resolves CPANRT#77530 and RHBZ#826872 and is fixed in podlators-2.4.1. |
||||
Ported to perl-5.14.2. |
||||
--- |
||||
cpan/podlators/lib/Pod/Man.pm | 11 +++++++++++ |
||||
cpan/podlators/lib/Pod/Text.pm | 11 +++++++++++ |
||||
2 files changed, 22 insertions(+) |
||||
|
||||
diff --git a/cpan/podlators/lib/Pod/Man.pm b/cpan/podlators/lib/Pod/Man.pm |
||||
index 96f3fcc..ad5e5ac 100644 |
||||
--- a/cpan/podlators/lib/Pod/Man.pm |
||||
+++ b/cpan/podlators/lib/Pod/Man.pm |
||||
@@ -1302,6 +1302,17 @@ sub parse_from_filehandle { |
||||
$self->parse_from_file (@_); |
||||
} |
||||
|
||||
+# Pod::Simple's parse_file doesn't set output_fh. Wrap the call and do so |
||||
+# ourself unless it was already set by the caller, since our documentation has |
||||
+# always said that this should work. |
||||
+sub parse_file { |
||||
+ my ($self, $in) = @_; |
||||
+ unless (defined $$self{output_fh}) { |
||||
+ $self->output_fh (\*STDOUT); |
||||
+ } |
||||
+ return $self->SUPER::parse_file ($in); |
||||
+} |
||||
+ |
||||
############################################################################## |
||||
# Translation tables |
||||
############################################################################## |
||||
diff --git a/cpan/podlators/lib/Pod/Text.pm b/cpan/podlators/lib/Pod/Text.pm |
||||
index cc02820..1a8b0bf 100644 |
||||
--- a/cpan/podlators/lib/Pod/Text.pm |
||||
+++ b/cpan/podlators/lib/Pod/Text.pm |
||||
@@ -679,6 +679,17 @@ sub parse_from_filehandle { |
||||
$self->parse_from_file (@_); |
||||
} |
||||
|
||||
+# Pod::Simple's parse_file doesn't set output_fh. Wrap the call and do so |
||||
+# ourself unless it was already set by the caller, since our documentation has |
||||
+# always said that this should work. |
||||
+sub parse_file { |
||||
+ my ($self, $in) = @_; |
||||
+ unless (defined $$self{output_fh}) { |
||||
+ $self->output_fh (\*STDOUT); |
||||
+ } |
||||
+ return $self->SUPER::parse_file ($in); |
||||
+} |
||||
+ |
||||
############################################################################## |
||||
# Module return value and documentation |
||||
############################################################################## |
||||
-- |
||||
1.7.11.4 |
||||
|
@ -0,0 +1,13 @@
@@ -0,0 +1,13 @@
|
||||
diff -up a/x2p/find2perl.PL b/x2p/find2perl.PL |
||||
--- a/x2p/find2perl.PL 2010-12-30 03:07:17.000000000 +0100 |
||||
+++ b/x2p/find2perl.PL 2012-05-29 10:18:11.697683643 +0200 |
||||
@@ -681,7 +681,8 @@ sub tab () { |
||||
sub fileglob_to_re ($) { |
||||
my $x = shift; |
||||
$x =~ s#([./^\$()+])#\\$1#g; |
||||
- $x =~ s#([?*])#.$1#g; |
||||
+ $x =~ s#\*#.*#g; |
||||
+ $x =~ s#\?#.#g; |
||||
"^$x\\z"; |
||||
} |
||||
|
@ -0,0 +1,94 @@
@@ -0,0 +1,94 @@
|
||||
From 78787052b6a68c0f54cfa983a69c44276de9daa4 Mon Sep 17 00:00:00 2001 |
||||
From: Jesse Luehrs <doy@tozt.net> |
||||
Date: Tue, 26 Jun 2012 00:13:54 -0500 |
||||
Subject: [PATCH] use a less broken test for locale radix in atof [perl #109318] |
||||
|
||||
--- |
||||
lib/locale.t | 33 +++++++++++++++++++++++++++++++++ |
||||
numeric.c | 25 +++++++++++++++---------- |
||||
2 files changed, 48 insertions(+), 10 deletions(-) |
||||
|
||||
diff --git a/lib/locale.t b/lib/locale.t |
||||
index dfc6d2b..26a7bd4 100644 |
||||
--- a/lib/locale.t |
||||
+++ b/lib/locale.t |
||||
@@ -1247,6 +1247,39 @@ foreach $Locale (@Locale) { |
||||
print "# failed $locales_test_number locale '$Locale' characters @f\n" |
||||
} |
||||
} |
||||
+ |
||||
+ # [perl #109318] |
||||
+ { |
||||
+ my @f = (); |
||||
+ ++$locales_test_number; |
||||
+ $test_names{$locales_test_number} = 'Verify atof with locale radix and negative exponent'; |
||||
+ |
||||
+ my $radix = POSIX::localeconv()->{decimal_point}; |
||||
+ my @nums = ( |
||||
+ "3.14e+9", "3${radix}14e+9", "3.14e-9", "3${radix}14e-9", |
||||
+ "-3.14e+9", "-3${radix}14e+9", "-3.14e-9", "-3${radix}14e-9", |
||||
+ ); |
||||
+ |
||||
+ if (! $is_utf8_locale) { |
||||
+ use locale; |
||||
+ for my $num (@nums) { |
||||
+ push @f, $num |
||||
+ unless sprintf("%g", $num) =~ /3.+14/; |
||||
+ } |
||||
+ } |
||||
+ else { |
||||
+ use locale ':not_characters'; |
||||
+ for my $num (@nums) { |
||||
+ push @f, $num |
||||
+ unless sprintf("%g", $num) =~ /3.+14/; |
||||
+ } |
||||
+ } |
||||
+ |
||||
+ tryneoalpha($Locale, $locales_test_number, @f == 0); |
||||
+ if (@f) { |
||||
+ print "# failed $locales_test_number locale '$Locale' numbers @f\n" |
||||
+ } |
||||
+ } |
||||
} |
||||
|
||||
my $final_locales_test_number = $locales_test_number; |
||||
diff --git a/numeric.c b/numeric.c |
||||
index be86f3a..3eb8a0e 100644 |
||||
--- a/numeric.c |
||||
+++ b/numeric.c |
||||
@@ -847,17 +847,22 @@ Perl_my_atof(pTHX_ const char* s) |
||||
|
||||
PERL_ARGS_ASSERT_MY_ATOF; |
||||
|
||||
- if (PL_numeric_local && IN_SOME_LOCALE_FORM) { |
||||
- NV y; |
||||
+ if (PL_numeric_local && PL_numeric_radix_sv && IN_SOME_LOCALE_FORM) { |
||||
+ char *standard = NULL, *local = NULL; |
||||
+ bool use_standard_radix; |
||||
|
||||
- /* Scan the number twice; once using locale and once without; |
||||
- * choose the larger result (in absolute value). */ |
||||
- Perl_atof2(s, x); |
||||
- SET_NUMERIC_STANDARD(); |
||||
- Perl_atof2(s, y); |
||||
- SET_NUMERIC_LOCAL(); |
||||
- if ((y < 0.0 && y < x) || (y > 0.0 && y > x)) |
||||
- return y; |
||||
+ standard = strchr(s, '.'); |
||||
+ local = strstr(s, SvPV_nolen(PL_numeric_radix_sv)); |
||||
+ |
||||
+ use_standard_radix = standard && (!local || standard < local); |
||||
+ |
||||
+ if (use_standard_radix) |
||||
+ SET_NUMERIC_STANDARD(); |
||||
+ |
||||
+ Perl_atof2(s, x); |
||||
+ |
||||
+ if (use_standard_radix) |
||||
+ SET_NUMERIC_LOCAL(); |
||||
} |
||||
else |
||||
Perl_atof2(s, x); |
||||
-- |
||||
1.7.4.1 |
||||
|
@ -0,0 +1,46 @@
@@ -0,0 +1,46 @@
|
||||
From a3ff80c12c16886edf9acdd3d172798e50defdb3 Mon Sep 17 00:00:00 2001 |
||||
From: Eric Brine <ikegami@adaelis.com> |
||||
Date: Mon, 18 Jun 2012 14:56:32 -0400 |
||||
Subject: [PATCH] RT#113730 - $@ should be cleared on "do" IO error. |
||||
|
||||
--- |
||||
pp_ctl.c | 1 + |
||||
t/op/do.t | 12 ++++++++++++ |
||||
2 files changed, 13 insertions(+) |
||||
|
||||
diff --git a/pp_ctl.c b/pp_ctl.c |
||||
index b414e81..437bc8f 100644 |
||||
--- a/pp_ctl.c |
||||
+++ b/pp_ctl.c |
||||
@@ -3928,6 +3928,7 @@ PP(pp_require) |
||||
DIE(aTHX_ "Can't locate %s", name); |
||||
} |
||||
|
||||
+ CLEAR_ERRSV(); |
||||
RETPUSHUNDEF; |
||||
} |
||||
else |
||||
diff --git a/t/op/do.t b/t/op/do.t |
||||
index 93d3f73..c5a5905 100644 |
||||
--- a/t/op/do.t |
||||
+++ b/t/op/do.t |
||||
@@ -286,4 +286,16 @@ SKIP: { |
||||
is($w, undef, 'do STRING does not propagate warning hints'); |
||||
} |
||||
|
||||
+# RT#113730 - $@ should be cleared on IO error. |
||||
+{ |
||||
+ $@ = "should not see"; |
||||
+ $! = 0; |
||||
+ my $rv = do("some nonexistent file"); |
||||
+ my $saved_error = $@; |
||||
+ my $saved_errno = $!; |
||||
+ ok(!$rv, "do returns false on io errror"); |
||||
+ ok(!$saved_error, "\$\@ not set on io error"); |
||||
+ ok($saved_errno, "\$! set on io error"); |
||||
+} |
||||
+ |
||||
done_testing(); |
||||
-- |
||||
1.7.11.4 |
||||
|
@ -0,0 +1,116 @@
@@ -0,0 +1,116 @@
|
||||
From d546938a7c8b111c463b733910db885b24724b42 Mon Sep 17 00:00:00 2001 |
||||
From: Father Chrysostomos <sprout@cpan.org> |
||||
Date: Thu, 20 Sep 2012 06:24:25 -0700 |
||||
Subject: [PATCH] require 1 << 2 |
||||
MIME-Version: 1.0 |
||||
Content-Type: text/plain; charset=UTF-8 |
||||
Content-Transfer-Encoding: 8bit |
||||
|
||||
Port to 5.16.1: |
||||
|
||||
commit c31f6d3b869d78bbd101e694fd3b384b47a77f6d |
||||
Author: Father Chrysostomos <sprout@cpan.org> |
||||
Date: Thu Sep 20 06:24:25 2012 -0700 |
||||
|
||||
[perl #105924] require 1 << 2 |
||||
|
||||
Setting PL_expect after force_next has no effect, as force_next |
||||
(called by force_version and force_word) picks up the current value of |
||||
PL_expect and arranges for it to be reset thereto after the forced |
||||
token is force-fed to the parser. |
||||
|
||||
The KEY_require case should be setting PL_expect to XTERM (as it |
||||
already does) when there is no forced token (version or bareword), |
||||
because we expect a term after ‘require’, but to XOPERATOR when |
||||
there is a forced token, because we expect an operator after that |
||||
forced token. |
||||
|
||||
Since the PL_expect assignment has no effect after force_next, we can |
||||
set it to XOPERATOR before calling potentially calling force_next, and |
||||
then to XTERM afterwards. |
||||
|
||||
Loop exits had the same bug, so this fixes them all. |
||||
--- |
||||
t/base/lex.t | 10 +++++++++- |
||||
toke.c | 6 ++++++ |
||||
2 files changed, 15 insertions(+), 1 deletion(-) |
||||
|
||||
diff --git a/t/base/lex.t b/t/base/lex.t |
||||
index ce16ef1..c2a6cc3 100644 |
||||
--- a/t/base/lex.t |
||||
+++ b/t/base/lex.t |
||||
@@ -1,6 +1,6 @@ |
||||
#!./perl |
||||
|
||||
-print "1..57\n"; |
||||
+print "1..63\n"; |
||||
|
||||
$x = 'x'; |
||||
|
||||
@@ -273,3 +273,11 @@ $test++; |
||||
@a = (1,2,3); |
||||
print "not " unless($a[~~2] == 3); |
||||
print "ok 57\n"; |
||||
+ |
||||
+$test = 58; |
||||
+for(qw< require goto last next redo dump >) { |
||||
+ eval "sub { $_ foo << 2 }"; |
||||
+ print "not " if $@; |
||||
+ print "ok ", $test++, " - [perl #105924] $_ WORD << ...\n"; |
||||
+ print "# $@" if $@; |
||||
+} |
||||
diff --git a/toke.c b/toke.c |
||||
index 1d18550..aa2c3b6 100644 |
||||
--- a/toke.c |
||||
+++ b/toke.c |
||||
@@ -7344,6 +7344,7 @@ Perl_yylex(pTHX) |
||||
UNI(OP_DBMCLOSE); |
||||
|
||||
case KEY_dump: |
||||
+ PL_expect = XOPERATOR; |
||||
s = force_word(s,WORD,TRUE,FALSE,FALSE); |
||||
LOOPX(OP_DUMP); |
||||
|
||||
@@ -7476,6 +7477,7 @@ Perl_yylex(pTHX) |
||||
LOP(OP_GREPSTART, XREF); |
||||
|
||||
case KEY_goto: |
||||
+ PL_expect = XOPERATOR; |
||||
s = force_word(s,WORD,TRUE,FALSE,FALSE); |
||||
LOOPX(OP_GOTO); |
||||
|
||||
@@ -7598,6 +7600,7 @@ Perl_yylex(pTHX) |
||||
LOP(OP_KILL,XTERM); |
||||
|
||||
case KEY_last: |
||||
+ PL_expect = XOPERATOR; |
||||
s = force_word(s,WORD,TRUE,FALSE,FALSE); |
||||
LOOPX(OP_LAST); |
||||
|
||||
@@ -7695,6 +7698,7 @@ Perl_yylex(pTHX) |
||||
OPERATOR(MY); |
||||
|
||||
case KEY_next: |
||||
+ PL_expect = XOPERATOR; |
||||
s = force_word(s,WORD,TRUE,FALSE,FALSE); |
||||
LOOPX(OP_NEXT); |
||||
|
||||
@@ -7880,6 +7884,7 @@ Perl_yylex(pTHX) |
||||
|
||||
case KEY_require: |
||||
s = SKIPSPACE1(s); |
||||
+ PL_expect = XOPERATOR; |
||||
if (isDIGIT(*s)) { |
||||
s = force_version(s, FALSE); |
||||
} |
||||
@@ -7911,6 +7916,7 @@ Perl_yylex(pTHX) |
||||
UNI(OP_RESET); |
||||
|
||||
case KEY_redo: |
||||
+ PL_expect = XOPERATOR; |
||||
s = force_word(s,WORD,TRUE,FALSE,FALSE); |
||||
LOOPX(OP_REDO); |
||||
|
||||
-- |
||||
1.7.11.4 |
||||
|
@ -0,0 +1,32 @@
@@ -0,0 +1,32 @@
|
||||
From f9344c91a4ca48288bba30dc94a2d712d0659670 Mon Sep 17 00:00:00 2001 |
||||
From: Oleg Nesterov <oleg@redhat.com> |
||||
Date: Wed, 4 Jul 2012 08:21:15 -0700 |
||||
Subject: [PATCH] [perl #113980] pp_syscall: "I32 retval" truncates the |
||||
returned value |
||||
|
||||
I noticed today that syscall(9, ...) (mmap) doesn't work for me. |
||||
|
||||
The problem is obvious, pp_syscall() uses I32 for retval and the |
||||
"long" address doesn't fit into "int". |
||||
|
||||
The one-liner below should fix the problem. |
||||
--- |
||||
pp_sys.c | 2 +- |
||||
1 file changed, 1 insertion(+), 1 deletion(-) |
||||
|
||||
diff --git a/pp_sys.c b/pp_sys.c |
||||
index fb93732..c5d63ac 100644 |
||||
--- a/pp_sys.c |
||||
+++ b/pp_sys.c |
||||
@@ -5456,7 +5456,7 @@ PP(pp_syscall) |
||||
register I32 items = SP - MARK; |
||||
unsigned long a[20]; |
||||
register I32 i = 0; |
||||
- I32 retval = -1; |
||||
+ IV retval = -1; |
||||
|
||||
if (PL_tainting) { |
||||
while (++MARK <= SP) { |
||||
-- |
||||
1.7.11.4 |
||||
|
@ -0,0 +1,77 @@
@@ -0,0 +1,77 @@
|
||||
From 13f27cb3dee86772eeed5d7d9b47746395ee603c Mon Sep 17 00:00:00 2001 |
||||
From: Father Chrysostomos <sprout@cpan.org> |
||||
Date: Wed, 19 Sep 2012 21:53:51 -0700 |
||||
Subject: [PATCH] Stop my vars with attrs from leaking |
||||
MIME-Version: 1.0 |
||||
Content-Type: text/plain; charset=UTF-8 |
||||
Content-Transfer-Encoding: 8bit |
||||
|
||||
Ported to 5.16.1: |
||||
|
||||
commit 9fa29fa7929b4167c5491b792c5cc7e4365a2839 |
||||
Author: Father Chrysostomos <sprout@cpan.org> |
||||
Date: Wed Sep 19 21:53:51 2012 -0700 |
||||
|
||||
[perl #114764] Stop my vars with attrs from leaking |
||||
|
||||
S_apply_attrs was creating a SV containing a stash name, that was |
||||
later to be put in a const op, which would take care of freeing it. |
||||
But it didn’t free it for a my variable, because the branch where that |
||||
const op was created didn’t apply. So move the creation of that SV |
||||
inside the branch that uses it, otherwise it leaks. This leak was the |
||||
result of commit 95f0a2f1ffc6. |
||||
--- |
||||
op.c | 4 ++-- |
||||
t/op/svleak.t | 5 ++++- |
||||
2 files changed, 6 insertions(+), 3 deletions(-) |
||||
|
||||
diff --git a/op.c b/op.c |
||||
index 24d5ecb..017580d 100644 |
||||
--- a/op.c |
||||
+++ b/op.c |
||||
@@ -2279,13 +2279,11 @@ STATIC void |
||||
S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my) |
||||
{ |
||||
dVAR; |
||||
- SV *stashsv; |
||||
|
||||
PERL_ARGS_ASSERT_APPLY_ATTRS; |
||||
|
||||
/* fake up C<use attributes $pkg,$rv,@attrs> */ |
||||
ENTER; /* need to protect against side-effects of 'use' */ |
||||
- stashsv = stash ? newSVhek(HvNAME_HEK(stash)) : &PL_sv_no; |
||||
|
||||
#define ATTRSMODULE "attributes" |
||||
#define ATTRSMODULE_PM "attributes.pm" |
||||
@@ -2300,6 +2298,8 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my) |
||||
newSVpvs(ATTRSMODULE), NULL); |
||||
} |
||||
else { |
||||
+ SV * const stashsv = |
||||
+ stash ? newSVhek(HvNAME_HEK(stash)) : &PL_sv_no; |
||||
Perl_load_module(aTHX_ PERL_LOADMOD_IMPORT_OPS, |
||||
newSVpvs(ATTRSMODULE), |
||||
NULL, |
||||
diff --git a/t/op/svleak.t b/t/op/svleak.t |
||||
index df10953..6cfee2e 100644 |
||||
--- a/t/op/svleak.t |
||||
+++ b/t/op/svleak.t |
||||
@@ -13,7 +13,7 @@ BEGIN { |
||||
or skip_all("XS::APItest not available"); |
||||
} |
||||
|
||||
-plan tests => 21; |
||||
+plan tests => 22; |
||||
|
||||
# run some code N times. If the number of SVs at the end of loop N is |
||||
# greater than (N-1)*delta at the end of loop 1, we've got a leak |
||||
@@ -160,3 +160,6 @@ leak(2, 0, |
||||
} |
||||
|
||||
leak(2,0,sub { !$^V }, '[perl #109762] version object in boolean context'); |
||||
+ |
||||
+# [perl #114764] Attributes leak scalars |
||||
+leak(2, 0, sub { eval 'my $x : shared' }, 'my $x :shared used to leak'); |
||||
-- |
||||
1.7.11.4 |
||||
|
@ -0,0 +1,76 @@
@@ -0,0 +1,76 @@
|
||||
From a6636b43dc409e4b49f369c18fedd34332fdb9ab Mon Sep 17 00:00:00 2001 |
||||
From: Father Chrysostomos <sprout@cpan.org> |
||||
Date: Thu, 20 Sep 2012 14:25:38 -0700 |
||||
Subject: [PATCH] [perl #114984] Glob.xs: Extend stack when returning |
||||
|
||||
If a pattern passed to File::Glob consists of a space-separated list |
||||
of patterns, the stack will only be extended by doglob() enough for |
||||
the list returned by each subpattern. So iterate() needs to extend |
||||
the stack before copying the list of files from an AV to the stack. |
||||
|
||||
This fixes a regression introduced in 5.16.0. |
||||
--- |
||||
MANIFEST | 1 + |
||||
ext/File-Glob/Glob.xs | 1 + |
||||
ext/File-Glob/t/rt114984.t | 25 +++++++++++++++++++++++++ |
||||
3 files changed, 27 insertions(+) |
||||
create mode 100644 ext/File-Glob/t/rt114984.t |
||||
|
||||
diff --git a/MANIFEST b/MANIFEST |
||||
index a7935fc..cceb00e 100644 |
||||
--- a/MANIFEST |
||||
+++ b/MANIFEST |
||||
@@ -3748,6 +3748,7 @@ ext/File-Glob/t/basic.t See if File::Glob works |
||||
ext/File-Glob/t/case.t See if File::Glob works |
||||
ext/File-Glob/t/global.t See if File::Glob works |
||||
ext/File-Glob/TODO File::Glob extension todo list |
||||
+ext/File-Glob/t/rt114984.t See if File::Glob works |
||||
ext/File-Glob/t/taint.t See if File::Glob works |
||||
ext/GDBM_File/GDBM_File.pm GDBM extension Perl module |
||||
ext/GDBM_File/GDBM_File.xs GDBM extension external subroutines |
||||
diff --git a/ext/File-Glob/Glob.xs b/ext/File-Glob/Glob.xs |
||||
index 3ea0590..d74e7a4 100644 |
||||
--- a/ext/File-Glob/Glob.xs |
||||
+++ b/ext/File-Glob/Glob.xs |
||||
@@ -93,6 +93,7 @@ iterate(pTHX_ bool(*globber)(pTHX_ AV *entries, SV *patsv)) |
||||
/* chuck it all out, quick or slow */ |
||||
if (gimme == G_ARRAY) { |
||||
if (!on_stack) { |
||||
+ EXTEND(SP, AvFILLp(entries)+1); |
||||
Copy(AvARRAY(entries), SP+1, AvFILLp(entries)+1, SV *); |
||||
SP += AvFILLp(entries)+1; |
||||
} |
||||
diff --git a/ext/File-Glob/t/rt114984.t b/ext/File-Glob/t/rt114984.t |
||||
new file mode 100644 |
||||
index 0000000..4229c6b |
||||
--- /dev/null |
||||
+++ b/ext/File-Glob/t/rt114984.t |
||||
@@ -0,0 +1,25 @@ |
||||
+use strict; |
||||
+use warnings; |
||||
+use v5.16.0; |
||||
+use File::Temp 'tempdir'; |
||||
+use File::Spec::Functions; |
||||
+use Test::More tests => 1; |
||||
+ |
||||
+my @md = (1..305); |
||||
+my @mp = (1000..1205); |
||||
+ |
||||
+my $path = tempdir uc cleanup => 1; |
||||
+ |
||||
+foreach (@md) { |
||||
+ open(my $f, ">", catfile $path, "md_$_.dat"); |
||||
+ close $f; |
||||
+} |
||||
+ |
||||
+foreach (@mp) { |
||||
+ open(my $f, ">", catfile $path, "mp_$_.dat"); |
||||
+ close $f; |
||||
+} |
||||
+my @b = glob(qq{$path/mp_[0123456789]*.dat |
||||
+ $path/md_[0123456789]*.dat}); |
||||
+is scalar(@b), @md+@mp, |
||||
+ 'File::Glob extends the stack when returning a long list'; |
||||
-- |
||||
1.7.11.4 |
||||
|
@ -0,0 +1,75 @@
@@ -0,0 +1,75 @@
|
||||
Ported to 5.16.1: |
||||
|
||||
From 4505a31f43ca4e1a0e9203b389f6d4bebab9d899 Mon Sep 17 00:00:00 2001 |
||||
From: Father Chrysostomos <sprout@cpan.org> |
||||
Date: Tue, 9 Oct 2012 20:47:18 -0700 |
||||
Subject: [PATCH] =?UTF-8?q?[perl=20#115206]=20Don=E2=80=99t=20crash=20when=20?= |
||||
=?UTF-8?q?vivifying=20$|?= |
||||
MIME-Version: 1.0 |
||||
Content-Type: text/plain; charset=UTF-8 |
||||
Content-Transfer-Encoding: 8bit |
||||
|
||||
It was trying to read the currently-selected handle without checking |
||||
whether it was selected. It is actually not necessary to initialise |
||||
the variable this way, as the next use of get-magic on it will clobber |
||||
the cached value. |
||||
|
||||
This initialisation was originally added in commit d8ce0c9a45. The |
||||
bug it was fixing was probably caused by missing FETCH calls that are |
||||
no longer missing. |
||||
--- |
||||
gv.c | 5 +---- |
||||
t/op/magic.t | 5 ++++- |
||||
2 files changed, 5 insertions(+), 5 deletions(-) |
||||
|
||||
diff --git a/gv.c b/gv.c |
||||
index f352452..cf02ca4 100644 |
||||
--- a/gv.c |
||||
+++ b/gv.c |
||||
@@ -1913,10 +1913,6 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, |
||||
Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), |
||||
"$%c is no longer supported", *name); |
||||
break; |
||||
- case '|': /* $| */ |
||||
- sv_setiv(GvSVn(gv), (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0); |
||||
- goto magicalize; |
||||
- |
||||
case '\010': /* $^H */ |
||||
{ |
||||
HV *const hv = GvHVn(gv); |
||||
@@ -1957,6 +1953,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, |
||||
case '>': /* $> */ |
||||
case '\\': /* $\ */ |
||||
case '/': /* $/ */ |
||||
+ case '|': /* $| */ |
||||
case '$': /* $$ */ |
||||
case '\001': /* $^A */ |
||||
case '\003': /* $^C */ |
||||
diff --git a/t/op/magic.t b/t/op/magic.t |
||||
index 3fb1ea1..1bcfbd9 100644 |
||||
--- a/t/op/magic.t |
||||
+++ b/t/op/magic.t |
||||
@@ -5,7 +5,7 @@ BEGIN { |
||||
chdir 't' if -d 't'; |
||||
@INC = '../lib'; |
||||
require './test.pl'; |
||||
- plan (tests => 156); |
||||
+ plan (tests => 157); |
||||
} |
||||
|
||||
# Test that defined() returns true for magic variables created on the fly, |
||||
@@ -581,6 +581,11 @@ SKIP: { |
||||
} |
||||
} |
||||
|
||||
+# $| |
||||
+fresh_perl_is |
||||
+ 'select f; undef *f; ${q/|/}; print STDOUT qq|ok\n|', "ok\n", {}, |
||||
+ '[perl #115206] no crash when vivifying $| while *{+select}{IO} is undef'; |
||||
+ |
||||
# ^^^^^^^^^ New tests go here ^^^^^^^^^ |
||||
|
||||
SKIP: { |
||||
-- |
||||
1.7.7.6 |
||||
|
@ -0,0 +1,80 @@
@@ -0,0 +1,80 @@
|
||||
From a6a40029a3cbad2c7d9b39cec86b9dc4baf428a9 Mon Sep 17 00:00:00 2001 |
||||
From: Dominic Hargreaves <dom@earth.li> |
||||
Date: Tue, 20 Dec 2011 22:19:45 +0000 |
||||
Subject: [PATCH 1/4] cpan/CPAN: add NAME headings in modules with POD |
||||
|
||||
This fixes the Debian Lintian warning about missing NAME sections in |
||||
manpages. |
||||
|
||||
Bug-Debian: http://bugs.debian.org/650448 |
||||
|
||||
Patch-Name: fixes/manpage_name_CPAN.diff |
||||
--- |
||||
cpan/CPAN/lib/CPAN/Debug.pm | 4 ++++ |
||||
cpan/CPAN/lib/CPAN/HandleConfig.pm | 6 ++++++ |
||||
cpan/CPAN/lib/CPAN/Queue.pm | 4 ++++ |
||||
cpan/CPAN/lib/CPAN/Tarzip.pm | 4 ++++ |
||||
4 files changed, 18 insertions(+), 0 deletions(-) |
||||
|
||||
diff --git a/cpan/CPAN/lib/CPAN/Debug.pm b/cpan/CPAN/lib/CPAN/Debug.pm |
||||
index 23c4a36..48e394b 100644 |
||||
--- a/cpan/CPAN/lib/CPAN/Debug.pm |
||||
+++ b/cpan/CPAN/lib/CPAN/Debug.pm |
||||
@@ -71,6 +71,10 @@ sub debug { |
||||
|
||||
__END__ |
||||
|
||||
+=head1 NAME |
||||
+ |
||||
+CPAN::Debug - internal debugging for CPAN.pm |
||||
+ |
||||
=head1 LICENSE |
||||
|
||||
This program is free software; you can redistribute it and/or |
||||
diff --git a/cpan/CPAN/lib/CPAN/HandleConfig.pm b/cpan/CPAN/lib/CPAN/HandleConfig.pm |
||||
index 58ccbe5..bab607d 100644 |
||||
--- a/cpan/CPAN/lib/CPAN/HandleConfig.pm |
||||
+++ b/cpan/CPAN/lib/CPAN/HandleConfig.pm |
||||
@@ -6,6 +6,12 @@ use File::Spec (); |
||||
use File::Basename (); |
||||
use Carp (); |
||||
|
||||
+=head1 NAME |
||||
+ |
||||
+CPAN::HandleConfig - internal configuration handling for CPAN.pm |
||||
+ |
||||
+=cut |
||||
+ |
||||
$VERSION = "5.5003"; # see also CPAN::Config::VERSION at end of file |
||||
|
||||
%can = ( |
||||
diff --git a/cpan/CPAN/lib/CPAN/Queue.pm b/cpan/CPAN/lib/CPAN/Queue.pm |
||||
index e5d88ce..1222b37 100644 |
||||
--- a/cpan/CPAN/lib/CPAN/Queue.pm |
||||
+++ b/cpan/CPAN/lib/CPAN/Queue.pm |
||||
@@ -201,6 +201,10 @@ sub reqtype_of { |
||||
|
||||
__END__ |
||||
|
||||
+=head1 NAME |
||||
+ |
||||
+CPAN::Queue - internal queue support for CPAN.pm |
||||
+ |
||||
=head1 LICENSE |
||||
|
||||
This program is free software; you can redistribute it and/or |
||||
diff --git a/cpan/CPAN/lib/CPAN/Tarzip.pm b/cpan/CPAN/lib/CPAN/Tarzip.pm |
||||
index 972df6c..cf8aad4 100644 |
||||
--- a/cpan/CPAN/lib/CPAN/Tarzip.pm |
||||
+++ b/cpan/CPAN/lib/CPAN/Tarzip.pm |
||||
@@ -450,6 +450,10 @@ END |
||||
|
||||
__END__ |
||||
|
||||
+=head1 NAME |
||||
+ |
||||
+CPAN::Tarzip - internal handling of tar archives for CPAN.pm |
||||
+ |
||||
=head1 LICENSE |
||||
|
||||
This program is free software; you can redistribute it and/or |
@ -0,0 +1,73 @@
@@ -0,0 +1,73 @@
|
||||
From 49bc120dcaeb68e2a870e7d92cf3f217e3487fe5 Mon Sep 17 00:00:00 2001 |
||||
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com> |
||||
Date: Thu, 2 Jul 2015 11:15:28 +0200 |
||||
Subject: [PATCH] Benchmark.t: remove CPU-speed-sensitive test |
||||
MIME-Version: 1.0 |
||||
Content-Type: text/plain; charset=UTF-8 |
||||
Content-Transfer-Encoding: 8bit |
||||
|
||||
This is upstream commit ported to 5.16.3: |
||||
|
||||
commit 9eba9e102c2f8c2ec41a50f4bbe6b09a64dddd31 |
||||
Author: David Mitchell <davem@iabyn.com> |
||||
Date: Fri Jul 19 23:10:50 2013 +0100 |
||||
|
||||
Benchmark.t: remove CPU-speed-sensitive test |
||||
|
||||
Benchmark.t has been randomly failing test 15 in smokes for ages. |
||||
This is the one that checks that a loop run 3*N times burns approximately |
||||
3 times more CPU than when run just N times. |
||||
|
||||
For the last month the test has included a calibration loop and test, |
||||
which does much the same thing, but without using any code from |
||||
Benchmark.pm. This has failed just as much, which confirms that its an |
||||
issue with the smoke host (such as a variable speed CPU or whatever), |
||||
rather than any flaw in the Benchmark.pm library logic. |
||||
|
||||
So just remove the calibration loop and the dodgy test. |
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com> |
||||
--- |
||||
lib/Benchmark.t | 19 +------------------ |
||||
1 file changed, 1 insertion(+), 18 deletions(-) |
||||
|
||||
diff --git a/lib/Benchmark.t b/lib/Benchmark.t |
||||
index 004092e..62bc1a6 100644 |
||||
--- a/lib/Benchmark.t |
||||
+++ b/lib/Benchmark.t |
||||
@@ -8,7 +8,7 @@ BEGIN { |
||||
use warnings; |
||||
use strict; |
||||
use vars qw($foo $bar $baz $ballast); |
||||
-use Test::More tests => 196; |
||||
+use Test::More tests => 195; |
||||
|
||||
use Benchmark qw(:all); |
||||
|
||||
@@ -86,23 +86,6 @@ my $in_onesec_adj = $in_onesec; |
||||
$in_onesec_adj *= (1/$cpu1); # adjust because may not have run for exactly 1s |
||||
print "# in_onesec_adj=$in_onesec_adj adjusted iterations\n"; |
||||
|
||||
-{ |
||||
- my $difference = $in_onesec_adj - $estimate; |
||||
- my $actual = abs ($difference / $in_onesec_adj); |
||||
- cmp_ok($actual, '<=', $delta, "is $in_onesec_adj within $delta of estimate ($estimate)") |
||||
- or do { |
||||
- diag(" in_threesecs = $in_threesecs"); |
||||
- diag(" in_threesecs_adj = $in_threesecs_adj"); |
||||
- diag(" cpu3 = $cpu3"); |
||||
- diag(" sys3 = $sys3"); |
||||
- diag(" estimate = $estimate"); |
||||
- diag(" in_onesec = $in_onesec"); |
||||
- diag(" in_onesec_adj = $in_onesec_adj"); |
||||
- diag(" cpu1 = $cpu1"); |
||||
- diag(" sys1 = $sys1"); |
||||
- }; |
||||
-} |
||||
- |
||||
# I found that the eval'ed version was 3 times faster than the coderef. |
||||
# (now it has a different ballast value) |
||||
$baz = 0; |
||||
-- |
||||
2.4.3 |
||||
|
@ -0,0 +1,233 @@
@@ -0,0 +1,233 @@
|
||||
From d309a2f4f975429871da44c33b83e651be0dc83e Mon Sep 17 00:00:00 2001 |
||||
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com> |
||||
Date: Fri, 6 Jun 2014 14:31:59 +0200 |
||||
Subject: [PATCH] Destroy {GDBM,NDBM,ODBM,SDBM}_File objects only from original |
||||
thread context |
||||
MIME-Version: 1.0 |
||||
Content-Type: text/plain; charset=UTF-8 |
||||
Content-Transfer-Encoding: 8bit |
||||
|
||||
This patch fixes a crash when destroing a hash tied to a *_File |
||||
database after spawning a thread: |
||||
|
||||
use Fcntl; |
||||
use SDBM_File; |
||||
use threads; |
||||
tie(my %dbtest, 'SDBM_File', "test.db", O_RDWR|O_CREAT, 0666); |
||||
threads->new(sub {})->join; |
||||
|
||||
This crashed or paniced depending on how perl was configured. |
||||
|
||||
Closes RT#61912. |
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com> |
||||
--- |
||||
ext/GDBM_File/GDBM_File.xs | 16 ++++++++++------ |
||||
ext/NDBM_File/NDBM_File.xs | 16 ++++++++++------ |
||||
ext/ODBM_File/ODBM_File.xs | 18 +++++++++++------- |
||||
ext/SDBM_File/SDBM_File.xs | 4 +++- |
||||
t/lib/dbmt_common.pl | 35 +++++++++++++++++++++++++++++++++++ |
||||
5 files changed, 69 insertions(+), 20 deletions(-) |
||||
|
||||
diff --git a/ext/GDBM_File/GDBM_File.xs b/ext/GDBM_File/GDBM_File.xs |
||||
index afb361c..e7a3808 100644 |
||||
--- a/ext/GDBM_File/GDBM_File.xs |
||||
+++ b/ext/GDBM_File/GDBM_File.xs |
||||
@@ -13,6 +13,7 @@ |
||||
#define store_value 3 |
||||
|
||||
typedef struct { |
||||
+ tTHX owner; |
||||
GDBM_FILE dbp ; |
||||
SV * filter[4]; |
||||
int filtering ; |
||||
@@ -78,6 +79,7 @@ gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func = (FATALFUNC)croak) |
||||
RETVAL = NULL ; |
||||
if ((dbp = gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func))) { |
||||
RETVAL = (GDBM_File)safecalloc(1, sizeof(GDBM_File_type)) ; |
||||
+ RETVAL->owner = aTHX; |
||||
RETVAL->dbp = dbp ; |
||||
} |
||||
|
||||
@@ -98,12 +100,14 @@ gdbm_DESTROY(db) |
||||
PREINIT: |
||||
int i = store_value; |
||||
CODE: |
||||
- gdbm_close(db); |
||||
- do { |
||||
- if (db->filter[i]) |
||||
- SvREFCNT_dec(db->filter[i]); |
||||
- } while (i-- > 0); |
||||
- safefree(db); |
||||
+ if (db && db->owner == aTHX) { |
||||
+ gdbm_close(db); |
||||
+ do { |
||||
+ if (db->filter[i]) |
||||
+ SvREFCNT_dec(db->filter[i]); |
||||
+ } while (i-- > 0); |
||||
+ safefree(db); |
||||
+ } |
||||
|
||||
#define gdbm_FETCH(db,key) gdbm_fetch(db->dbp,key) |
||||
datum_value |
||||
diff --git a/ext/NDBM_File/NDBM_File.xs b/ext/NDBM_File/NDBM_File.xs |
||||
index 52e60fc..af223e5 100644 |
||||
--- a/ext/NDBM_File/NDBM_File.xs |
||||
+++ b/ext/NDBM_File/NDBM_File.xs |
||||
@@ -33,6 +33,7 @@ END_EXTERN_C |
||||
#define store_value 3 |
||||
|
||||
typedef struct { |
||||
+ tTHX owner; |
||||
DBM * dbp ; |
||||
SV * filter[4]; |
||||
int filtering ; |
||||
@@ -71,6 +72,7 @@ ndbm_TIEHASH(dbtype, filename, flags, mode) |
||||
RETVAL = NULL ; |
||||
if ((dbp = dbm_open(filename, flags, mode))) { |
||||
RETVAL = (NDBM_File)safecalloc(1, sizeof(NDBM_File_type)); |
||||
+ RETVAL->owner = aTHX; |
||||
RETVAL->dbp = dbp ; |
||||
} |
||||
|
||||
@@ -84,12 +86,14 @@ ndbm_DESTROY(db) |
||||
PREINIT: |
||||
int i = store_value; |
||||
CODE: |
||||
- dbm_close(db->dbp); |
||||
- do { |
||||
- if (db->filter[i]) |
||||
- SvREFCNT_dec(db->filter[i]); |
||||
- } while (i-- > 0); |
||||
- safefree(db); |
||||
+ if (db && db->owner == aTHX) { |
||||
+ dbm_close(db->dbp); |
||||
+ do { |
||||
+ if (db->filter[i]) |
||||
+ SvREFCNT_dec(db->filter[i]); |
||||
+ } while (i-- > 0); |
||||
+ safefree(db); |
||||
+ } |
||||
|
||||
#define ndbm_FETCH(db,key) dbm_fetch(db->dbp,key) |
||||
datum_value |
||||
diff --git a/ext/ODBM_File/ODBM_File.xs b/ext/ODBM_File/ODBM_File.xs |
||||
index d1ece7f..f7e00a0 100644 |
||||
--- a/ext/ODBM_File/ODBM_File.xs |
||||
+++ b/ext/ODBM_File/ODBM_File.xs |
||||
@@ -45,6 +45,7 @@ datum nextkey(datum key); |
||||
#define store_value 3 |
||||
|
||||
typedef struct { |
||||
+ tTHX owner; |
||||
void * dbp ; |
||||
SV * filter[4]; |
||||
int filtering ; |
||||
@@ -112,6 +113,7 @@ odbm_TIEHASH(dbtype, filename, flags, mode) |
||||
} |
||||
dbp = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0); |
||||
RETVAL = (ODBM_File)safecalloc(1, sizeof(ODBM_File_type)); |
||||
+ RETVAL->owner = aTHX; |
||||
RETVAL->dbp = dbp ; |
||||
} |
||||
OUTPUT: |
||||
@@ -124,13 +126,15 @@ DESTROY(db) |
||||
dMY_CXT; |
||||
int i = store_value; |
||||
CODE: |
||||
- dbmrefcnt--; |
||||
- dbmclose(); |
||||
- do { |
||||
- if (db->filter[i]) |
||||
- SvREFCNT_dec(db->filter[i]); |
||||
- } while (i-- > 0); |
||||
- safefree(db); |
||||
+ if (db && db->owner == aTHX) { |
||||
+ dbmrefcnt--; |
||||
+ dbmclose(); |
||||
+ do { |
||||
+ if (db->filter[i]) |
||||
+ SvREFCNT_dec(db->filter[i]); |
||||
+ } while (i-- > 0); |
||||
+ safefree(db); |
||||
+ } |
||||
|
||||
datum_value |
||||
odbm_FETCH(db, key) |
||||
diff --git a/ext/SDBM_File/SDBM_File.xs b/ext/SDBM_File/SDBM_File.xs |
||||
index 291e41b..0bdae9a 100644 |
||||
--- a/ext/SDBM_File/SDBM_File.xs |
||||
+++ b/ext/SDBM_File/SDBM_File.xs |
||||
@@ -10,6 +10,7 @@ |
||||
#define store_value 3 |
||||
|
||||
typedef struct { |
||||
+ tTHX owner; |
||||
DBM * dbp ; |
||||
SV * filter[4]; |
||||
int filtering ; |
||||
@@ -43,6 +44,7 @@ sdbm_TIEHASH(dbtype, filename, flags, mode) |
||||
RETVAL = NULL ; |
||||
if ((dbp = sdbm_open(filename,flags,mode))) { |
||||
RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type)); |
||||
+ RETVAL->owner = aTHX; |
||||
RETVAL->dbp = dbp ; |
||||
} |
||||
|
||||
@@ -54,7 +56,7 @@ void |
||||
sdbm_DESTROY(db) |
||||
SDBM_File db |
||||
CODE: |
||||
- if (db) { |
||||
+ if (db && db->owner == aTHX) { |
||||
int i = store_value; |
||||
sdbm_close(db->dbp); |
||||
do { |
||||
diff --git a/t/lib/dbmt_common.pl b/t/lib/dbmt_common.pl |
||||
index 5d4098c..a0a4d52 100644 |
||||
--- a/t/lib/dbmt_common.pl |
||||
+++ b/t/lib/dbmt_common.pl |
||||
@@ -511,5 +511,40 @@ unlink <Op_dbmx*>, $Dfile; |
||||
unlink <Op1_dbmx*>; |
||||
} |
||||
|
||||
+{ |
||||
+ # Check DBM back-ends do not destroy objects from then-spawned threads. |
||||
+ # RT#61912. |
||||
+ SKIP: { |
||||
+ my $threads_count = 2; |
||||
+ skip 'Threads are disabled', 3 + 2 * $threads_count |
||||
+ unless $Config{usethreads}; |
||||
+ use_ok('threads'); |
||||
+ |
||||
+ my %h; |
||||
+ unlink <Op1_dbmx*>; |
||||
+ |
||||
+ my $db = tie %h, $DBM_Class, 'Op1_dbmx', $create, 0640; |
||||
+ isa_ok($db, $DBM_Class); |
||||
+ |
||||
+ for (1 .. 2) { |
||||
+ ok(threads->create( |
||||
+ sub { |
||||
+ $SIG{'__WARN__'} = sub { fail(shift) }; # debugging perl panics |
||||
+ # report it by spurious TAP line |
||||
+ 1; |
||||
+ }), "Thread $_ created"); |
||||
+ } |
||||
+ for (threads->list) { |
||||
+ is($_->join, 1, "A thread exited successfully"); |
||||
+ } |
||||
+ |
||||
+ pass("Tied object survived exiting threads"); |
||||
+ |
||||
+ undef $db; |
||||
+ untie %h; |
||||
+ unlink <Op1_dbmx*>; |
||||
+ } |
||||
+} |
||||
+ |
||||
done_testing(); |
||||
1; |
||||
-- |
||||
1.9.3 |
||||
|
@ -0,0 +1,60 @@
@@ -0,0 +1,60 @@
|
||||
From 677ffc8fe97148750054b11e7fbd21c98f860ee1 Mon Sep 17 00:00:00 2001 |
||||
From: Father Chrysostomos <sprout@cpan.org> |
||||
Date: Fri, 21 Sep 2012 18:23:20 -0700 |
||||
Subject: [PATCH] =?UTF-8?q?Don=E2=80=99t=20leak=20deleted=20iterator=20whe?= |
||||
=?UTF-8?q?n=20tying=20hash?= |
||||
MIME-Version: 1.0 |
||||
Content-Type: text/plain; charset=UTF-8 |
||||
Content-Transfer-Encoding: 8bit |
||||
|
||||
Petr Pisar: ported to 5.16.3 |
||||
--- |
||||
pp_sys.c | 7 +++++++ |
||||
t/op/tie.t | 13 +++++++++++++ |
||||
2 files changed, 20 insertions(+) |
||||
|
||||
diff --git a/pp_sys.c b/pp_sys.c |
||||
index 034a2d0..0e35d59 100644 |
||||
--- a/pp_sys.c |
||||
+++ b/pp_sys.c |
||||
@@ -852,9 +852,16 @@ PP(pp_tie) |
||||
|
||||
switch(SvTYPE(varsv)) { |
||||
case SVt_PVHV: |
||||
+ { |
||||
+ HE *entry; |
||||
methname = "TIEHASH"; |
||||
+ if (HvLAZYDEL(varsv) && (entry = HvEITER((HV *)varsv))) { |
||||
+ HvLAZYDEL_off(varsv); |
||||
+ hv_free_ent((HV *)varsv, entry); |
||||
+ } |
||||
HvEITER_set(MUTABLE_HV(varsv), 0); |
||||
break; |
||||
+ } |
||||
case SVt_PVAV: |
||||
methname = "TIEARRAY"; |
||||
if (!AvREAL(varsv)) { |
||||
diff --git a/t/op/tie.t b/t/op/tie.t |
||||
index 9301bb3..5a536b8 100644 |
||||
--- a/t/op/tie.t |
||||
+++ b/t/op/tie.t |
||||
@@ -1259,3 +1259,16 @@ $h{i}{j} = 'k'; |
||||
print $h{i}{j}, "\n"; |
||||
EXPECT |
||||
k |
||||
+######## |
||||
+ |
||||
+# NAME Test that tying a hash does not leak a deleted iterator |
||||
+# This produced unbalanced string table warnings under |
||||
+# PERL_DESTRUCT_LEVEL=2. |
||||
+package l { |
||||
+ sub TIEHASH{bless[]} |
||||
+} |
||||
+$h = {foo=>0}; |
||||
+each %$h; |
||||
+delete $$h{foo}; |
||||
+tie %$h, 'l'; |
||||
+EXPECT |
||||
-- |
||||
1.8.1.4 |
||||
|
@ -0,0 +1,109 @@
@@ -0,0 +1,109 @@
|
||||
From f5488561bdaab57380bf07e8e66778503a41aca3 Mon Sep 17 00:00:00 2001 |
||||
From: Father Chrysostomos <sprout@cpan.org> |
||||
Date: Sun, 23 Sep 2012 12:42:15 -0700 |
||||
Subject: [PATCH] =?UTF-8?q?Don=E2=80=99t=20leak=20if=20hh=20copying=20dies?= |
||||
MIME-Version: 1.0 |
||||
Content-Type: text/plain; charset=UTF-8 |
||||
Content-Transfer-Encoding: 8bit |
||||
|
||||
When %^H is copied on entering a new scope, if it happens to have been |
||||
tied it can die. This was resulting in leaks, because no protections |
||||
were added to handle that case. |
||||
|
||||
The two things that were leaking were the new hash in hv_copy_hints_hv |
||||
and the new value (for an element) in newSVsv. |
||||
|
||||
By fixing newSVsv itself, this also fixes any potential leaks when |
||||
other pieces of code call newSVsv on explosive values. |
||||
|
||||
Petr Pisar: Ported to 5.16.3 |
||||
--- |
||||
hv.c | 6 ++++++ |
||||
sv.c | 7 ++++--- |
||||
t/op/svleak.t | 22 +++++++++++++++++++++- |
||||
3 files changed, 31 insertions(+), 4 deletions(-) |
||||
|
||||
diff --git a/hv.c b/hv.c |
||||
index 3c35341..29d6352 100644 |
||||
--- a/hv.c |
||||
+++ b/hv.c |
||||
@@ -1440,6 +1440,9 @@ Perl_hv_copy_hints_hv(pTHX_ HV *const ohv) |
||||
const I32 riter = HvRITER_get(ohv); |
||||
HE * const eiter = HvEITER_get(ohv); |
||||
|
||||
+ ENTER; |
||||
+ SAVEFREESV(hv); |
||||
+ |
||||
while (hv_max && hv_max + 1 >= hv_fill * 2) |
||||
hv_max = hv_max / 2; |
||||
HvMAX(hv) = hv_max; |
||||
@@ -1461,6 +1464,9 @@ Perl_hv_copy_hints_hv(pTHX_ HV *const ohv) |
||||
} |
||||
HvRITER_set(ohv, riter); |
||||
HvEITER_set(ohv, eiter); |
||||
+ |
||||
+ SvREFCNT_inc_simple_void_NN(hv); |
||||
+ LEAVE; |
||||
} |
||||
hv_magic(hv, NULL, PERL_MAGIC_hints); |
||||
return hv; |
||||
diff --git a/sv.c b/sv.c |
||||
index a43feac..597d71b 100644 |
||||
--- a/sv.c |
||||
+++ b/sv.c |
||||
@@ -8764,11 +8764,12 @@ Perl_newSVsv(pTHX_ register SV *const old) |
||||
Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), "semi-panic: attempt to dup freed string"); |
||||
return NULL; |
||||
} |
||||
+ /* Do this here, otherwise we leak the new SV if this croaks. */ |
||||
+ SvGETMAGIC(old); |
||||
new_SV(sv); |
||||
- /* SV_GMAGIC is the default for sv_setv() |
||||
- SV_NOSTEAL prevents TEMP buffers being, well, stolen, and saves games |
||||
+ /* SV_NOSTEAL prevents TEMP buffers being, well, stolen, and saves games |
||||
with SvTEMP_off and SvTEMP_on round a call to sv_setsv. */ |
||||
- sv_setsv_flags(sv, old, SV_GMAGIC | SV_NOSTEAL); |
||||
+ sv_setsv_flags(sv, old, SV_NOSTEAL); |
||||
return sv; |
||||
} |
||||
|
||||
diff --git a/t/op/svleak.t b/t/op/svleak.t |
||||
index 2f09af3..011c184 100644 |
||||
--- a/t/op/svleak.t |
||||
+++ b/t/op/svleak.t |
||||
@@ -13,7 +13,7 @@ BEGIN { |
||||
or skip_all("XS::APItest not available"); |
||||
} |
||||
|
||||
-plan tests => 23; |
||||
+plan tests => 24; |
||||
|
||||
# run some code N times. If the number of SVs at the end of loop N is |
||||
# greater than (N-1)*delta at the end of loop 1, we've got a leak |
||||
@@ -176,3 +176,23 @@ leak(2, 0, sub { |
||||
each %$h; |
||||
undef $h; |
||||
}, 'tied hash iteration does not leak'); |
||||
+ |
||||
+# [perl #107000] |
||||
+package hhtie { |
||||
+ sub TIEHASH { bless [] } |
||||
+ sub STORE { $_[0][0]{$_[1]} = $_[2] } |
||||
+ sub FETCH { die if $explosive; $_[0][0]{$_[1]} } |
||||
+ sub FIRSTKEY { keys %{$_[0][0]}; each %{$_[0][0]} } |
||||
+ sub NEXTKEY { each %{$_[0][0]} } |
||||
+} |
||||
+leak(2,!!$Config{mad}, sub { |
||||
+ eval q` |
||||
+ BEGIN { |
||||
+ $hhtie::explosive = 0; |
||||
+ tie %^H, hhtie; |
||||
+ $^H{foo} = bar; |
||||
+ $hhtie::explosive = 1; |
||||
+ } |
||||
+ { 1; } |
||||
+ `; |
||||
+}, 'hint-hash copying does not leak'); |
||||
-- |
||||
1.8.1.4 |
||||
|
@ -0,0 +1,177 @@
@@ -0,0 +1,177 @@
|
||||
From faa03ffb8ccbf754d38d041570fcf2ce8816f36b Mon Sep 17 00:00:00 2001 |
||||
From: =?UTF-8?q?Petr=20=C5=A0abata?= <contyk@redhat.com> |
||||
Date: Wed, 2 Sep 2015 16:24:58 +0200 |
||||
Subject: [PATCH] File::Glob: Dup glob state in CLONE() |
||||
MIME-Version: 1.0 |
||||
Content-Type: text/plain; charset=UTF-8 |
||||
Content-Transfer-Encoding: 8bit |
||||
|
||||
File::Glob: Dup glob state in CLONE() |
||||
|
||||
This solves [perl #119897] and [perl #117823], and restores the |
||||
behavior of glob() in conjunction with threads of 5.14 and older. |
||||
|
||||
Since 5.16, code that used glob() inside a thread had been |
||||
unintentionally sharing state between threads, which lead to things |
||||
like this crashing and failing assertions: |
||||
|
||||
./perl -Ilib -Mthreads -e 'scalar glob("*"); threads->create(sub { glob("*") })->join();' |
||||
|
||||
Signed-off-by: Petr Šabata <contyk@redhat.com> |
||||
--- |
||||
MANIFEST | 1 + |
||||
ext/File-Glob/Glob.xs | 33 ++++++++++++++++++++++ |
||||
ext/File-Glob/t/threads.t | 71 +++++++++++++++++++++++++++++++++++++++++++++++ |
||||
3 files changed, 105 insertions(+) |
||||
create mode 100644 ext/File-Glob/t/threads.t |
||||
|
||||
diff --git a/MANIFEST b/MANIFEST |
||||
index 181bb3f..9771022 100644 |
||||
--- a/MANIFEST |
||||
+++ b/MANIFEST |
||||
@@ -3683,6 +3683,7 @@ ext/File-Glob/t/global.t See if File::Glob works |
||||
ext/File-Glob/TODO File::Glob extension todo list |
||||
ext/File-Glob/t/rt114984.t See if File::Glob works |
||||
ext/File-Glob/t/taint.t See if File::Glob works |
||||
+ext/File-Glob/t/threads.t See if File::Glob + threads works |
||||
ext/GDBM_File/GDBM_File.pm GDBM extension Perl module |
||||
ext/GDBM_File/GDBM_File.xs GDBM extension external subroutines |
||||
ext/GDBM_File/hints/sco.pl Hint for GDBM_File for named architecture |
||||
diff --git a/ext/File-Glob/Glob.xs b/ext/File-Glob/Glob.xs |
||||
index d74e7a4..6c69aa6 100644 |
||||
--- a/ext/File-Glob/Glob.xs |
||||
+++ b/ext/File-Glob/Glob.xs |
||||
@@ -9,6 +9,9 @@ |
||||
#define MY_CXT_KEY "File::Glob::_guts" XS_VERSION |
||||
|
||||
typedef struct { |
||||
+#ifdef USE_ITHREADS |
||||
+ tTHX interp; |
||||
+#endif |
||||
int x_GLOB_ERROR; |
||||
HV * x_GLOB_ENTRIES; |
||||
} my_cxt_t; |
||||
@@ -380,6 +383,33 @@ PPCODE: |
||||
iterate(aTHX_ doglob_iter_wrapper); |
||||
SPAGAIN; |
||||
|
||||
+#ifdef USE_ITHREADS |
||||
+ |
||||
+void |
||||
+CLONE(...) |
||||
+INIT: |
||||
+ HV *glob_entries_clone = NULL; |
||||
+CODE: |
||||
+ PERL_UNUSED_ARG(items); |
||||
+ { |
||||
+ dMY_CXT; |
||||
+ if ( MY_CXT.x_GLOB_ENTRIES ) { |
||||
+ CLONE_PARAMS param; |
||||
+ param.stashes = NULL; |
||||
+ param.flags = 0; |
||||
+ param.proto_perl = MY_CXT.interp; |
||||
+ |
||||
+ glob_entries_clone = MUTABLE_HV(sv_dup_inc((SV*)MY_CXT.x_GLOB_ENTRIES, ¶m)); |
||||
+ } |
||||
+ } |
||||
+ { |
||||
+ MY_CXT_CLONE; |
||||
+ MY_CXT.x_GLOB_ENTRIES = glob_entries_clone; |
||||
+ MY_CXT.interp = aTHX; |
||||
+ } |
||||
+ |
||||
+#endif |
||||
+ |
||||
BOOT: |
||||
{ |
||||
#ifndef PERL_EXTERNAL_GLOB |
||||
@@ -394,6 +424,9 @@ BOOT: |
||||
{ |
||||
dMY_CXT; |
||||
MY_CXT.x_GLOB_ENTRIES = NULL; |
||||
+#ifdef USE_ITHREADS |
||||
+ MY_CXT.interp = aTHX; |
||||
+#endif |
||||
} |
||||
} |
||||
|
||||
diff --git a/ext/File-Glob/t/threads.t b/ext/File-Glob/t/threads.t |
||||
new file mode 100644 |
||||
index 0000000..141450a |
||||
--- /dev/null |
||||
+++ b/ext/File-Glob/t/threads.t |
||||
@@ -0,0 +1,71 @@ |
||||
+#!./perl |
||||
+ |
||||
+BEGIN { |
||||
+ chdir 't' if -d 't'; |
||||
+ @INC = '../lib'; |
||||
+ require Config; import Config; |
||||
+ if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) { |
||||
+ print "1..0\n"; |
||||
+ exit 0; |
||||
+ } |
||||
+} |
||||
+use strict; |
||||
+use warnings; |
||||
+# Test::More needs threads pre-loaded |
||||
+use if $Config{useithreads}, 'threads'; |
||||
+use Test::More; |
||||
+ |
||||
+BEGIN { |
||||
+ if (! $Config{'useithreads'}) { |
||||
+ plan skip_all => "Perl not compiled with 'useithreads'"; |
||||
+ } |
||||
+} |
||||
+ |
||||
+use File::Temp qw(tempdir); |
||||
+use File::Spec qw(); |
||||
+use File::Glob qw(csh_glob); |
||||
+ |
||||
+my($dir) = tempdir(CLEANUP => 1) |
||||
+ or die "Could not create temporary directory"; |
||||
+ |
||||
+my @temp_files = qw(1_file 2_file 3_file); |
||||
+for my $file (@temp_files) { |
||||
+ open my $fh, ">", File::Spec->catfile($dir, $file) |
||||
+ or die "Could not create file $dir/$file: $!"; |
||||
+ close $fh; |
||||
+} |
||||
+my $cwd = Cwd::cwd(); |
||||
+chdir $dir |
||||
+ or die "Could not chdir to $dir: $!"; |
||||
+ |
||||
+sub do_glob { scalar csh_glob("*") } |
||||
+# Stablish some glob state |
||||
+my $first_file = do_glob(); |
||||
+is($first_file, $temp_files[0]); |
||||
+ |
||||
+my @files; |
||||
+push @files, threads->create(\&do_glob)->join() for 1..5; |
||||
+is_deeply( |
||||
+ \@files, |
||||
+ [($temp_files[1]) x 5], |
||||
+ "glob() state is cloned for new threads" |
||||
+); |
||||
+ |
||||
+@files = threads->create({'context' => 'list'}, |
||||
+ sub { |
||||
+ return do_glob(), threads->create(\&do_glob)->join() |
||||
+ })->join(); |
||||
+ |
||||
+is_deeply( |
||||
+ \@files, |
||||
+ [@temp_files[1,2]], |
||||
+ "..and for new threads inside threads" |
||||
+); |
||||
+ |
||||
+my $second_file = do_glob(); |
||||
+is($second_file, $temp_files[1], "state doesn't leak from threads"); |
||||
+ |
||||
+chdir $cwd |
||||
+ or die "Could not chdir back to $cwd: $!"; |
||||
+ |
||||
+done_testing; |
||||
-- |
||||
2.4.3 |
||||
|
@ -0,0 +1,38 @@
@@ -0,0 +1,38 @@
|
||||
From 7c8b0c1259db2bdd372cc1bdb63bf5b89a969a4a Mon Sep 17 00:00:00 2001 |
||||
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com> |
||||
Date: Tue, 27 Oct 2015 16:33:43 +0100 |
||||
Subject: [PATCH] Fix incorrect handling of CRLF in Net::FTP |
||||
MIME-Version: 1.0 |
||||
Content-Type: text/plain; charset=UTF-8 |
||||
Content-Transfer-Encoding: 8bit |
||||
|
||||
libnet upstream commit ported to perl-5.16.3: |
||||
|
||||
From 24eb8619451c3d8529d903d9133d03a7f447488f Mon Sep 17 00:00:00 2001 |
||||
From: Steve Hay <steve.m.hay@googlemail.com> |
||||
Date: Fri, 3 Jan 2014 17:41:55 +0000 |
||||
Subject: [PATCH] Fix incorrect handling of CRLF in Net::FTP |
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com> |
||||
--- |
||||
cpan/libnet/Net/FTP/A.pm | 4 ++-- |
||||
1 file changed, 2 insertions(+), 2 deletions(-) |
||||
|
||||
diff --git a/cpan/libnet/Net/FTP/A.pm b/cpan/libnet/Net/FTP/A.pm |
||||
index 427d02b..886d252 100644 |
||||
--- a/cpan/libnet/Net/FTP/A.pm |
||||
+++ b/cpan/libnet/Net/FTP/A.pm |
||||
@@ -77,8 +77,8 @@ sub write { |
||||
my $timeout = @_ ? shift: $data->timeout; |
||||
|
||||
my $nr = (my $tmp = substr($buf, 0, $size)) =~ tr/\r\n/\015\012/; |
||||
- $tmp =~ s/([^\015])\012/$1\015\012/sg if $nr; |
||||
- $tmp =~ s/^\012/\015\012/ unless ${*$data}{'net_ftp_outcr'}; |
||||
+ $tmp =~ s/(?<!\015)\012/\015\012/sg if $nr; |
||||
+ $tmp =~ s/^\015// if ${*$data}{'net_ftp_outcr'}; |
||||
${*$data}{'net_ftp_outcr'} = substr($tmp, -1) eq "\015"; |
||||
|
||||
# If the remote server has closed the connection we will be signal'd |
||||
-- |
||||
2.4.3 |
||||
|
@ -0,0 +1,78 @@
@@ -0,0 +1,78 @@
|
||||
From 316518b545904d368d703005f1622fde03349567 Mon Sep 17 00:00:00 2001 |
||||
From: Father Chrysostomos <sprout@cpan.org> |
||||
Date: Fri, 21 Sep 2012 22:01:19 -0700 |
||||
Subject: [PATCH] Free iterator when freeing tied hash |
||||
|
||||
The current iterator was leaking when a tied hash was freed or |
||||
undefined. |
||||
|
||||
Since we already have a mechanism, namely HvLAZYDEL, for freeing |
||||
HvEITER when not referenced elsewhere, we can use that. |
||||
|
||||
Petr Pisar: Ported to 5.16.3. |
||||
--- |
||||
hv.c | 3 +++ |
||||
t/op/svleak.t | 15 ++++++++++++++- |
||||
2 files changed, 17 insertions(+), 1 deletion(-) |
||||
|
||||
diff --git a/hv.c b/hv.c |
||||
index a031703..3c35341 100644 |
||||
--- a/hv.c |
||||
+++ b/hv.c |
||||
@@ -2346,6 +2346,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) |
||||
if (entry) { |
||||
sv_setsv(key, HeSVKEY_force(entry)); |
||||
SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */ |
||||
+ HeSVKEY_set(entry, NULL); |
||||
} |
||||
else { |
||||
char *k; |
||||
@@ -2353,6 +2354,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) |
||||
|
||||
/* one HE per MAGICAL hash */ |
||||
iter->xhv_eiter = entry = new_HE(); /* HvEITER(hv) = new_HE() */ |
||||
+ HvLAZYDEL_on(hv); /* make sure entry gets freed */ |
||||
Zero(entry, 1, HE); |
||||
Newxz(k, HEK_BASESIZE + sizeof(const SV *), char); |
||||
hek = (HEK*)k; |
||||
@@ -2369,6 +2371,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) |
||||
Safefree(HeKEY_hek(entry)); |
||||
del_HE(entry); |
||||
iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */ |
||||
+ HvLAZYDEL_off(hv); |
||||
return NULL; |
||||
} |
||||
} |
||||
diff --git a/t/op/svleak.t b/t/op/svleak.t |
||||
index 6cfee2e..2f09af3 100644 |
||||
--- a/t/op/svleak.t |
||||
+++ b/t/op/svleak.t |
||||
@@ -13,7 +13,7 @@ BEGIN { |
||||
or skip_all("XS::APItest not available"); |
||||
} |
||||
|
||||
-plan tests => 22; |
||||
+plan tests => 23; |
||||
|
||||
# run some code N times. If the number of SVs at the end of loop N is |
||||
# greater than (N-1)*delta at the end of loop 1, we've got a leak |
||||
@@ -163,3 +163,16 @@ leak(2,0,sub { !$^V }, '[perl #109762] version object in boolean context'); |
||||
|
||||
# [perl #114764] Attributes leak scalars |
||||
leak(2, 0, sub { eval 'my $x : shared' }, 'my $x :shared used to leak'); |
||||
+ |
||||
+# Tied hash iteration was leaking if the hash was freed before itera- |
||||
+# tion was over. |
||||
+package t { |
||||
+ sub TIEHASH { bless [] } |
||||
+ sub FIRSTKEY { 0 } |
||||
+} |
||||
+leak(2, 0, sub { |
||||
+ my $h = {}; |
||||
+ tie %$h, t; |
||||
+ each %$h; |
||||
+ undef $h; |
||||
+}, 'tied hash iteration does not leak'); |
||||
-- |
||||
1.8.1.4 |
||||
|
@ -0,0 +1,154 @@
@@ -0,0 +1,154 @@
|
||||
From a1e8f04634112d64383f0079421cf9cf5a154c0e Mon Sep 17 00:00:00 2001 |
||||
From: Vincent Pit <perl@profvince.com> |
||||
Date: Fri, 28 Aug 2015 14:17:00 -0300 |
||||
Subject: [PATCH] Properly duplicate PerlIO::encoding objects |
||||
MIME-Version: 1.0 |
||||
Content-Type: text/plain; charset=UTF-8 |
||||
Content-Transfer-Encoding: 8bit |
||||
|
||||
Upstream commit ported to 5.16.3: |
||||
|
||||
commit 0ee3fa26f660ac426e3e082f77d806c9d1471f93 |
||||
Author: Vincent Pit <perl@profvince.com> |
||||
Date: Fri Aug 28 14:17:00 2015 -0300 |
||||
|
||||
Properly duplicate PerlIO::encoding objects |
||||
|
||||
PerlIO::encoding objects are usually initialized by calling Perl methods, |
||||
essentially from the pushed() and getarg() callbacks. During cloning, the |
||||
PerlIO API will by default call these methods to initialize the duplicate |
||||
struct when the PerlIOBase parent struct is itself duplicated. This does |
||||
not behave so well because the perl interpreter is not ready to call |
||||
methods at this point, for the stacks are not set up yet. |
||||
|
||||
The proper way to duplicate the PerlIO::encoding object is to call sv_dup() |
||||
on its members from the dup() PerlIO callback. So the only catch is to make |
||||
the getarg() and pushed() calls implied by the duplication of the underlying |
||||
PerlIOBase object aware that they are called during cloning, and make them |
||||
wait that the control flow returns to the dup() callback. Fortunately, |
||||
getarg() knows since its param argument is then non-null, and its return |
||||
value is passed immediately to pushed(), so it is enough to tag this |
||||
returned value with a custom magic so that pushed() can see it is being |
||||
called during cloning. |
||||
|
||||
This fixes [RT #31923]. |
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com> |
||||
--- |
||||
MANIFEST | 1 + |
||||
ext/PerlIO-encoding/encoding.xs | 25 +++++++++++++++++++++++-- |
||||
ext/PerlIO-encoding/t/threads.t | 35 +++++++++++++++++++++++++++++++++++ |
||||
3 files changed, 59 insertions(+), 2 deletions(-) |
||||
create mode 100644 ext/PerlIO-encoding/t/threads.t |
||||
|
||||
diff --git a/MANIFEST b/MANIFEST |
||||
index 02e8234..5caa981 100644 |
||||
--- a/MANIFEST |
||||
+++ b/MANIFEST |
||||
@@ -3791,6 +3791,7 @@ ext/PerlIO-encoding/MANIFEST PerlIO::encoding list of files |
||||
ext/PerlIO-encoding/t/encoding.t See if PerlIO encoding conversion works |
||||
ext/PerlIO-encoding/t/fallback.t See if PerlIO fallbacks work |
||||
ext/PerlIO-encoding/t/nolooping.t Tests for PerlIO::encoding |
||||
+ext/PerlIO-encoding/t/threads.t Tests PerlIO::encoding and threads |
||||
ext/PerlIO-mmap/mmap.pm PerlIO layer for memory maps |
||||
ext/PerlIO-mmap/mmap.xs PerlIO layer for memory maps |
||||
ext/PerlIO-scalar/scalar.pm PerlIO layer for scalars |
||||
diff --git a/ext/PerlIO-encoding/encoding.xs b/ext/PerlIO-encoding/encoding.xs |
||||
index 98d89e9..d5efb62 100644 |
||||
--- a/ext/PerlIO-encoding/encoding.xs |
||||
+++ b/ext/PerlIO-encoding/encoding.xs |
||||
@@ -49,13 +49,23 @@ typedef struct { |
||||
|
||||
#define NEEDS_LINES 1 |
||||
|
||||
+static const MGVTBL PerlIOEncode_tag = { 0, 0, 0, 0, 0, 0, 0, 0 }; |
||||
+ |
||||
SV * |
||||
PerlIOEncode_getarg(pTHX_ PerlIO * f, CLONE_PARAMS * param, int flags) |
||||
{ |
||||
PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode); |
||||
- SV *sv = &PL_sv_undef; |
||||
- PERL_UNUSED_ARG(param); |
||||
+ SV *sv; |
||||
PERL_UNUSED_ARG(flags); |
||||
+ /* During cloning, return an undef token object so that _pushed() knows |
||||
+ * that it should not call methods and wait for _dup() to actually dup the |
||||
+ * encoding object. */ |
||||
+ if (param) { |
||||
+ sv = newSV(0); |
||||
+ sv_magicext(sv, NULL, PERL_MAGIC_ext, &PerlIOEncode_tag, 0, 0); |
||||
+ return sv; |
||||
+ } |
||||
+ sv = &PL_sv_undef; |
||||
if (e->enc) { |
||||
dSP; |
||||
/* Not 100% sure stack swap is right thing to do during dup ... */ |
||||
@@ -86,6 +96,14 @@ PerlIOEncode_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg, PerlIO_funcs * |
||||
IV code = PerlIOBuf_pushed(aTHX_ f, mode, Nullsv,tab); |
||||
SV *result = Nullsv; |
||||
|
||||
+ if (SvTYPE(arg) >= SVt_PVMG |
||||
+ && mg_findext(arg, PERL_MAGIC_ext, &PerlIOEncode_tag)) { |
||||
+ e->enc = NULL; |
||||
+ e->chk = NULL; |
||||
+ e->inEncodeCall = 0; |
||||
+ return code; |
||||
+ } |
||||
+ |
||||
PUSHSTACKi(PERLSI_MAGIC); |
||||
SPAGAIN; |
||||
|
||||
@@ -558,6 +576,9 @@ PerlIOEncode_dup(pTHX_ PerlIO * f, PerlIO * o, |
||||
if (oe->enc) { |
||||
fe->enc = PerlIO_sv_dup(aTHX_ oe->enc, params); |
||||
} |
||||
+ if (oe->chk) { |
||||
+ fe->chk = PerlIO_sv_dup(aTHX_ oe->chk, params); |
||||
+ } |
||||
} |
||||
return f; |
||||
} |
||||
diff --git a/ext/PerlIO-encoding/t/threads.t b/ext/PerlIO-encoding/t/threads.t |
||||
new file mode 100644 |
||||
index 0000000..64f0e55 |
||||
--- /dev/null |
||||
+++ b/ext/PerlIO-encoding/t/threads.t |
||||
@@ -0,0 +1,35 @@ |
||||
+#!perl |
||||
+ |
||||
+use strict; |
||||
+use warnings; |
||||
+ |
||||
+BEGIN { |
||||
+ use Config; |
||||
+ if ($Config{extensions} !~ /\bEncode\b/) { |
||||
+ print "1..0 # Skip: no Encode\n"; |
||||
+ exit 0; |
||||
+ } |
||||
+ unless ($Config{useithreads}) { |
||||
+ print "1..0 # Skip: no threads\n"; |
||||
+ exit 0; |
||||
+ } |
||||
+} |
||||
+ |
||||
+use threads; |
||||
+ |
||||
+use Test::More tests => 3 + 1; |
||||
+ |
||||
+binmode *STDOUT, ':encoding(UTF-8)'; |
||||
+ |
||||
+SKIP: { |
||||
+ local $@; |
||||
+ my $ret = eval { |
||||
+ my $thread = threads->create(sub { pass 'in thread'; return 1 }); |
||||
+ skip 'test thread could not be spawned' => 3 unless $thread; |
||||
+ $thread->join; |
||||
+ }; |
||||
+ is $@, '', 'thread did not croak'; |
||||
+ is $ret, 1, 'thread returned the right value'; |
||||
+} |
||||
+ |
||||
+pass 'passes at least one test'; |
||||
-- |
||||
2.5.5 |
||||
|
@ -0,0 +1,148 @@
@@ -0,0 +1,148 @@
|
||||
From 13716dc35cd0869b98bd30cebbdeb8d48ab07a8b Mon Sep 17 00:00:00 2001 |
||||
From: Nicholas Clark <nick@ccl4.org> |
||||
Date: Sat, 14 Apr 2012 15:51:33 +0200 |
||||
Subject: [PATCH] Remove PERL_ASYNC_CHECK() from Perl_leave_scope(). |
||||
|
||||
PERL_ASYNC_CHECK() was added to Perl_leave_scope() as part of commit |
||||
f410a2119920dd04, which moved signal dispatch from the runloop to |
||||
control flow ops, to mitigate nearly all of the speed cost of safe |
||||
signals. |
||||
|
||||
The assumption was that scope exit was a safe place to dispatch signals. |
||||
However, this is not true, as parts of the regex engine call |
||||
leave_scope(), the regex engine stores some state in per-interpreter |
||||
variables, and code called within signal handlers can change these |
||||
values. |
||||
|
||||
Hence remove the call to PERL_ASYNC_CHECK() from Perl_leave_scope(), and |
||||
add it explicitly in the various OPs which were relying on their call to |
||||
leave_scope() to dispatch any pending signals. Also add a |
||||
PERL_ASYNC_CHECK() to the exit of the runloop, which ensures signals |
||||
still dispatch from S_sortcv() and S_sortcv_stacked(), as well as |
||||
addressing one of the concerns in the commit message of |
||||
f410a2119920dd04: |
||||
|
||||
Subtle bugs might remain - there might be constructions that enter |
||||
the runloop (where signals used to be dispatched) but don't contain |
||||
any PERL_ASYNC_CHECK() calls themselves. |
||||
|
||||
Finally, move the PERL_ASYNC_CHECK(); added by that commit to pp_goto to |
||||
the end of the function, to be consistent with the positioning of all |
||||
other PERL_ASYNC_CHECK() calls - at the beginning or end of OP |
||||
functions, hence just before the return to or just after the call from |
||||
the runloop, and hence effectively at the same point as the previous |
||||
location of PERL_ASYNC_CHECK() in the runloop. |
||||
--- |
||||
dump.c | 1 + |
||||
pp_ctl.c | 11 ++++++++++- |
||||
run.c | 1 + |
||||
scope.c | 2 -- |
||||
4 files changed, 12 insertions(+), 3 deletions(-) |
||||
|
||||
diff --git a/dump.c b/dump.c |
||||
index b238ee0..d770a65 100644 |
||||
--- a/dump.c |
||||
+++ b/dump.c |
||||
@@ -2118,6 +2118,7 @@ Perl_runops_debug(pTHX) |
||||
} |
||||
} while ((PL_op = PL_op->op_ppaddr(aTHX))); |
||||
DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n")); |
||||
+ PERL_ASYNC_CHECK(); |
||||
|
||||
TAINT_NOT; |
||||
return 0; |
||||
diff --git a/pp_ctl.c b/pp_ctl.c |
||||
index fd92efa..6206a25 100644 |
||||
--- a/pp_ctl.c |
||||
+++ b/pp_ctl.c |
||||
@@ -377,6 +377,7 @@ PP(pp_substcont) |
||||
TAINT_NOT; |
||||
LEAVE_SCOPE(cx->sb_oldsave); |
||||
POPSUBST(cx); |
||||
+ PERL_ASYNC_CHECK(); |
||||
RETURNOP(pm->op_next); |
||||
/* NOTREACHED */ |
||||
} |
||||
@@ -2732,6 +2733,7 @@ PP(pp_next) |
||||
if (PL_scopestack_ix < inner) |
||||
leave_scope(PL_scopestack[PL_scopestack_ix]); |
||||
PL_curcop = cx->blk_oldcop; |
||||
+ PERL_ASYNC_CHECK(); |
||||
return (cx)->blk_loop.my_op->op_nextop; |
||||
} |
||||
|
||||
@@ -2774,6 +2776,7 @@ PP(pp_redo) |
||||
LEAVE_SCOPE(oldsave); |
||||
FREETMPS; |
||||
PL_curcop = cx->blk_oldcop; |
||||
+ PERL_ASYNC_CHECK(); |
||||
return redo_op; |
||||
} |
||||
|
||||
@@ -2978,6 +2981,7 @@ PP(pp_goto) |
||||
PUTBACK; |
||||
(void)(*CvXSUB(cv))(aTHX_ cv); |
||||
LEAVE; |
||||
+ PERL_ASYNC_CHECK(); |
||||
return retop; |
||||
} |
||||
else { |
||||
@@ -3049,6 +3053,7 @@ PP(pp_goto) |
||||
} |
||||
} |
||||
} |
||||
+ PERL_ASYNC_CHECK(); |
||||
RETURNOP(CvSTART(cv)); |
||||
} |
||||
} |
||||
@@ -3209,6 +3214,7 @@ PP(pp_goto) |
||||
PL_do_undump = FALSE; |
||||
} |
||||
|
||||
+ PERL_ASYNC_CHECK(); |
||||
RETURNOP(retop); |
||||
} |
||||
|
||||
@@ -5129,10 +5135,13 @@ PP(pp_leavewhen) |
||||
leave_scope(PL_scopestack[PL_scopestack_ix]); |
||||
PL_curcop = cx->blk_oldcop; |
||||
|
||||
+ PERL_ASYNC_CHECK(); |
||||
return cx->blk_loop.my_op->op_nextop; |
||||
} |
||||
- else |
||||
+ else { |
||||
+ PERL_ASYNC_CHECK(); |
||||
RETURNOP(cx->blk_givwhen.leave_op); |
||||
+ } |
||||
} |
||||
|
||||
PP(pp_continue) |
||||
diff --git a/run.c b/run.c |
||||
index 7c1d0aa..774852d 100644 |
||||
--- a/run.c |
||||
+++ b/run.c |
||||
@@ -40,6 +40,7 @@ Perl_runops_standard(pTHX) |
||||
register OP *op = PL_op; |
||||
while ((PL_op = op = op->op_ppaddr(aTHX))) { |
||||
} |
||||
+ PERL_ASYNC_CHECK(); |
||||
|
||||
TAINT_NOT; |
||||
return 0; |
||||
diff --git a/scope.c b/scope.c |
||||
index ffd0552..121d1f7 100644 |
||||
--- a/scope.c |
||||
+++ b/scope.c |
||||
@@ -1168,8 +1168,6 @@ Perl_leave_scope(pTHX_ I32 base) |
||||
} |
||||
|
||||
PL_tainted = was; |
||||
- |
||||
- PERL_ASYNC_CHECK(); |
||||
} |
||||
|
||||
void |
||||
-- |
||||
1.8.1.4 |
||||
|
@ -0,0 +1,191 @@
@@ -0,0 +1,191 @@
|
||||
From 9b9923c633797a232ac871903c3c14833036aa28 Mon Sep 17 00:00:00 2001 |
||||
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com> |
||||
Date: Sun, 9 Jun 2013 14:14:24 -0400 |
||||
Subject: [PATCH] Synchronize pod2html usage output and its POD text |
||||
|
||||
|
||||
Petr Pisar: Port to perl-5.16.3. |
||||
|
||||
diff --git a/ext/Pod-Html/bin/pod2html b/ext/Pod-Html/bin/pod2html |
||||
index c422ebf..b022859 100644 |
||||
--- a/ext/Pod-Html/bin/pod2html |
||||
+++ b/ext/Pod-Html/bin/pod2html |
||||
@@ -6,10 +6,14 @@ pod2html - convert .pod files to .html files |
||||
|
||||
=head1 SYNOPSIS |
||||
|
||||
- pod2html --help --htmlroot=<name> --infile=<name> --outfile=<name> |
||||
+ pod2html --help --htmldir=<name> --htmlroot=<URL> |
||||
+ --infile=<name> --outfile=<name> |
||||
--podpath=<name>:...:<name> --podroot=<name> |
||||
- --recurse --norecurse --verbose |
||||
- --index --noindex --title=<name> |
||||
+ --cachedir=<name> --flush --recurse --norecurse |
||||
+ --quiet --noquiet --verbose --noverbose |
||||
+ --index --noindex --backlink --nobacklink |
||||
+ --header --noheader --poderrors --nopoderrors |
||||
+ --css=<URL> --title=<name> |
||||
|
||||
=head1 DESCRIPTION |
||||
|
||||
@@ -27,12 +31,27 @@ pod2html takes the following arguments: |
||||
|
||||
Displays the usage message. |
||||
|
||||
+=item htmldir |
||||
+ |
||||
+ --htmldir=name |
||||
+ |
||||
+Sets the directory to which all cross references in the resulting HTML file |
||||
+will be relative. Not passing this causes all links to be absolute since this |
||||
+is the value that tells Pod::Html the root of the documentation tree. |
||||
+ |
||||
+Do not use this and --htmlroot in the same call to pod2html; they are mutually |
||||
+exclusive. |
||||
+ |
||||
=item htmlroot |
||||
|
||||
- --htmlroot=name |
||||
+ --htmlroot=URL |
||||
+ |
||||
+Sets the base URL for the HTML files. When cross-references are made, the |
||||
+HTML root is prepended to the URL. |
||||
+ |
||||
+Do not use this if relative links are desired: use --htmldir instead. |
||||
|
||||
-Sets the base URL for the HTML files. When cross-references are made, |
||||
-the HTML root is prepended to the URL. |
||||
+Do not pass both this and --htmldir to pod2html; they are mutually exclusive. |
||||
|
||||
=item infile |
||||
|
||||
@@ -61,6 +80,59 @@ Specify the base directory for finding library pods. |
||||
Specify which subdirectories of the podroot contain pod files whose |
||||
HTML converted forms can be linked-to in cross-references. |
||||
|
||||
+=item cachedir |
||||
+ |
||||
+ --cachedir=name |
||||
+ |
||||
+Specify which directory is used for storing cache. Default directory is the |
||||
+current working directory. |
||||
+ |
||||
+=item flush |
||||
+ |
||||
+ --flush |
||||
+ |
||||
+Flush the cache. |
||||
+ |
||||
+=item backlink |
||||
+ |
||||
+ --backlink |
||||
+ |
||||
+Turn =head1 directives into links pointing to the top of the HTML file. |
||||
+ |
||||
+=item nobacklink |
||||
+ |
||||
+ --nobacklink |
||||
+ |
||||
+Do not turn =head1 directives into links pointing to the top of the HTML file |
||||
+(default behaviour). |
||||
+ |
||||
+=item header |
||||
+ |
||||
+ --header |
||||
+ |
||||
+Create header and footer blocks containing the text of the "NAME" section. |
||||
+ |
||||
+=item noheader |
||||
+ |
||||
+ --noheader |
||||
+ |
||||
+Do not create header and footer blocks containing the text of the "NAME" |
||||
+section (default behaviour). |
||||
+ |
||||
+=item poderrors |
||||
+ |
||||
+ --poderrors |
||||
+ |
||||
+Include a "POD ERRORS" section in the outfile if there were any POD errors in |
||||
+the infile (default behaviour). |
||||
+ |
||||
+=item nopoderrors |
||||
+ |
||||
+ --nopoderrors |
||||
+ |
||||
+Do not include a "POD ERRORS" section in the outfile if there were any POD |
||||
+errors in the infile. |
||||
+ |
||||
=item index |
||||
|
||||
--index |
||||
@@ -86,18 +158,44 @@ Recurse into subdirectories specified in podpath (default behaviour). |
||||
|
||||
Do not recurse into subdirectories specified in podpath. |
||||
|
||||
+=item css |
||||
+ |
||||
+ --css=URL |
||||
+ |
||||
+Specify the URL of cascading style sheet to link from resulting HTML file. |
||||
+Default is none style sheet. |
||||
+ |
||||
=item title |
||||
|
||||
--title=title |
||||
|
||||
Specify the title of the resulting HTML file. |
||||
|
||||
+=item quiet |
||||
+ |
||||
+ --quiet |
||||
+ |
||||
+Don't display mostly harmless warning messages. |
||||
+ |
||||
+=item noquiet |
||||
+ |
||||
+ --noquiet |
||||
+ |
||||
+Display mostly harmless warning messages (default behaviour). But this is not |
||||
+the same as "verbose" mode. |
||||
+ |
||||
=item verbose |
||||
|
||||
--verbose |
||||
|
||||
Display progress messages. |
||||
|
||||
+=item noverbose |
||||
+ |
||||
+ --noverbose |
||||
+ |
||||
+Do not display progress messages (default behaviour). |
||||
+ |
||||
=back |
||||
|
||||
=head1 AUTHOR |
||||
diff --git a/ext/Pod-Html/lib/Pod/Html.pm b/ext/Pod-Html/lib/Pod/Html.pm |
||||
index 72b37c2..3feb812 100644 |
||||
--- a/ext/Pod-Html/lib/Pod/Html.pm |
||||
+++ b/ext/Pod-Html/lib/Pod/Html.pm |
||||
@@ -447,9 +447,14 @@ sub usage { |
||||
my $podfile = shift; |
||||
warn "$0: $podfile: @_\n" if @_; |
||||
die <<END_OF_USAGE; |
||||
-Usage: $0 --help --htmlroot=<name> --infile=<name> --outfile=<name> |
||||
- --podpath=<name>:...:<name> --podroot=<name> --cachedir=<name> |
||||
- --recurse --verbose --index --norecurse --noindex |
||||
+Usage: $0 --help --htmldir=<name> --htmlroot=<URL> |
||||
+ --infile=<name> --outfile=<name> |
||||
+ --podpath=<name>:...:<name> --podroot=<name> |
||||
+ --cachedir=<name> --flush --recurse --norecurse |
||||
+ --quiet --noquiet --verbose --noverbose |
||||
+ --index --noindex --backlink --nobacklink |
||||
+ --header --noheader --poderrors --nopoderrors |
||||
+ --css=<URL> --title=<name> |
||||
|
||||
--[no]backlink - turn =head1 directives into links pointing to the top of |
||||
the page (off by default). |
||||
-- |
||||
1.8.1.4 |
||||
|
@ -0,0 +1,51 @@
@@ -0,0 +1,51 @@
|
||||
From 5984f005f7a08feca52509658cff1c56d768e057 Mon Sep 17 00:00:00 2001 |
||||
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com> |
||||
Date: Mon, 1 Dec 2014 15:28:36 +0100 |
||||
Subject: [PATCH] t/op/taint.t: Perform SHA-256 algorithm by crypt() if default |
||||
one is disabled |
||||
MIME-Version: 1.0 |
||||
Content-Type: text/plain; charset=UTF-8 |
||||
Content-Transfer-Encoding: 8bit |
||||
|
||||
The crypt(3) call may return NULL. This is the case on FIPS-enabled |
||||
platforms. Then "tainted crypt" test would fail. |
||||
|
||||
See RT#121591 for similar fix in t/op/crypt.t. |
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com> |
||||
|
||||
Petr Pisar: Ported to 5.16.3. |
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com> |
||||
--- |
||||
t/op/taint.t | 14 +++++++++++++- |
||||
1 file changed, 13 insertions(+), 1 deletion(-) |
||||
|
||||
diff --git a/t/op/taint.t b/t/op/taint.t |
||||
index 9cea740..478e574 100644 |
||||
--- a/t/op/taint.t |
||||
+++ b/t/op/taint.t |
||||
@@ -1868,7 +1868,19 @@ foreach my $ord (78, 163, 256) { |
||||
|
||||
{ |
||||
# 59998 |
||||
- sub cr { my $x = crypt($_[0], $_[1]); $x } |
||||
+ sub cr { |
||||
+ # On platforms implementing FIPS mode, using a weak algorithm |
||||
+ # (including the default triple-DES algorithm) causes crypt(3) to |
||||
+ # return a null pointer, which Perl converts into undef. We assume |
||||
+ # for now that all such platforms support glibc-style selection of |
||||
+ # a different hashing algorithm. |
||||
+ my $alg = ''; # Use default algorithm |
||||
+ if ( !defined(crypt("ab", "cd")) ) { |
||||
+ $alg = '$5$'; # Use SHA-256 |
||||
+ } |
||||
+ my $x = crypt($_[0], $alg . $_[1]); |
||||
+ $x |
||||
+ } |
||||
sub co { my $x = ~$_[0]; $x } |
||||
my ($a, $b); |
||||
$a = cr('hello', 'foo' . $TAINT); |
||||
-- |
||||
1.9.3 |
||||
|
@ -0,0 +1,81 @@
@@ -0,0 +1,81 @@
|
||||
From 1735f6f53ca19f99c6e9e39496c486af323ba6a8 Mon Sep 17 00:00:00 2001 |
||||
From: Brian Carlson <brian.carlson@cpanel.net> |
||||
Date: Wed, 28 Nov 2012 08:54:33 -0500 |
||||
Subject: [PATCH] Fix misparsing of maketext strings. |
||||
|
||||
Case 61251: This commit fixes a misparse of maketext strings that could |
||||
lead to arbitrary code execution. Basically, maketext was compiling |
||||
bracket notation into functions, but neglected to escape backslashes |
||||
inside the content or die on fully-qualified method names when |
||||
generating the code. This change escapes all such backslashes and dies |
||||
when a method name with a colon or apostrophe is specified. |
||||
--- |
||||
AUTHORS | 1 + |
||||
dist/Locale-Maketext/lib/Locale/Maketext.pm | 24 ++++++++---------------- |
||||
2 files changed, 9 insertions(+), 16 deletions(-) |
||||
|
||||
diff --git a/AUTHORS b/AUTHORS |
||||
index 70734b0..009dea0 100644 |
||||
--- a/AUTHORS |
||||
+++ b/AUTHORS |
||||
@@ -154,6 +154,7 @@ Breno G. de Oliveira <garu@cpan.org> |
||||
Brent Dax <brentdax@cpan.org> |
||||
Brooks D Boyd |
||||
Brian Callaghan <callagh@itginc.com> |
||||
+Brian Carlson <brian.carlson@cpanel.net> |
||||
Brian Clarke <clarke@appliedmeta.com> |
||||
brian d foy <brian.d.foy@gmail.com> |
||||
Brian Fraser <fraserbn@gmail.com> |
||||
diff --git a/dist/Locale-Maketext/lib/Locale/Maketext.pm b/dist/Locale-Maketext/lib/Locale/Maketext.pm |
||||
index 4822027..63e5fba 100644 |
||||
--- a/dist/Locale-Maketext/lib/Locale/Maketext.pm |
||||
+++ b/dist/Locale-Maketext/lib/Locale/Maketext.pm |
||||
@@ -625,21 +625,9 @@ sub _compile { |
||||
# 0-length method name means to just interpolate: |
||||
push @code, ' ('; |
||||
} |
||||
- elsif($m =~ /^\w+(?:\:\:\w+)*$/s |
||||
- and $m !~ m/(?:^|\:)\d/s |
||||
- # exclude starting a (sub)package or symbol with a digit |
||||
+ elsif($m =~ /^\w+$/s |
||||
+ # exclude anything fancy, especially fully-qualified module names |
||||
) { |
||||
- # Yes, it even supports the demented (and undocumented?) |
||||
- # $obj->Foo::bar(...) syntax. |
||||
- $target->_die_pointing( |
||||
- $string_to_compile, q{Can't use "SUPER::" in a bracket-group method}, |
||||
- 2 + length($c[-1]) |
||||
- ) |
||||
- if $m =~ m/^SUPER::/s; |
||||
- # Because for SUPER:: to work, we'd have to compile this into |
||||
- # the right package, and that seems just not worth the bother, |
||||
- # unless someone convinces me otherwise. |
||||
- |
||||
push @code, ' $_[0]->' . $m . '('; |
||||
} |
||||
else { |
||||
@@ -693,7 +681,9 @@ sub _compile { |
||||
elsif(substr($1,0,1) ne '~') { |
||||
# it's stuff not containing "~" or "[" or "]" |
||||
# i.e., a literal blob |
||||
- $c[-1] .= $1; |
||||
+ my $text = $1; |
||||
+ $text =~ s/\\/\\\\/g; |
||||
+ $c[-1] .= $text; |
||||
|
||||
} |
||||
elsif($1 eq '~~') { # "~~" |
||||
@@ -731,7 +721,9 @@ sub _compile { |
||||
else { |
||||
# It's a "~X" where X is not a special character. |
||||
# Consider it a literal ~ and X. |
||||
- $c[-1] .= $1; |
||||
+ my $text = $1; |
||||
+ $text =~ s/\\/\\\\/g; |
||||
+ $c[-1] .= $text; |
||||
} |
||||
} |
||||
} |
||||
-- |
||||
1.7.11.7 |
||||
|
@ -0,0 +1,48 @@
@@ -0,0 +1,48 @@
|
||||
From 4da80956418bbe1fdc23cad0b1cbb24cd7b87609 Mon Sep 17 00:00:00 2001 |
||||
From: =?UTF-8?q?Patrik=20H=C3=A4gglund?= <patrik.h.hagglund@ericsson.com> |
||||
Date: Sat, 2 Feb 2013 20:21:05 +0100 |
||||
Subject: [PATCH] PATCH [perl #106212] Add PL_perlio_mutex to |
||||
atfork_lock/unlock |
||||
|
||||
Using threads + fork() on Linux, and IO operations in the threads, the |
||||
PL_perlio_mutex may be left in a locked state at the call of fork(), |
||||
potentially leading to deadlock in the child process at subsequent IO |
||||
operations. (Threads are pre-empted and not continued in the child |
||||
process after the fork.) |
||||
|
||||
Therefore, ensure that the PL_perlio_mutex is unlocked in the child |
||||
process, right after fork(), by using atfork_lock/unlock. |
||||
|
||||
(The RT text gives ways to reproduce the problem, but are not easily |
||||
added to Perl's test suite) |
||||
--- |
||||
util.c | 6 ++++++ |
||||
1 file changed, 6 insertions(+) |
||||
|
||||
diff --git a/util.c b/util.c |
||||
index 5c695b8..75381f1 100644 |
||||
--- a/util.c |
||||
+++ b/util.c |
||||
@@ -2798,6 +2798,9 @@ Perl_atfork_lock(void) |
||||
dVAR; |
||||
#if defined(USE_ITHREADS) |
||||
/* locks must be held in locking order (if any) */ |
||||
+# ifdef USE_PERLIO |
||||
+ MUTEX_LOCK(&PL_perlio_mutex); |
||||
+# endif |
||||
# ifdef MYMALLOC |
||||
MUTEX_LOCK(&PL_malloc_mutex); |
||||
# endif |
||||
@@ -2812,6 +2815,9 @@ Perl_atfork_unlock(void) |
||||
dVAR; |
||||
#if defined(USE_ITHREADS) |
||||
/* locks must be released in same order as in atfork_lock() */ |
||||
+# ifdef USE_PERLIO |
||||
+ MUTEX_UNLOCK(&PL_perlio_mutex); |
||||
+# endif |
||||
# ifdef MYMALLOC |
||||
MUTEX_UNLOCK(&PL_malloc_mutex); |
||||
# endif |
||||
-- |
||||
1.8.1.4 |
||||
|
@ -0,0 +1,30 @@
@@ -0,0 +1,30 @@
|
||||
From 862c89c81d26dae0dcef138e19df8b45615e69c9 Mon Sep 17 00:00:00 2001 |
||||
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com> |
||||
Date: Mon, 2 Dec 2013 10:10:56 +0100 |
||||
Subject: [PATCH] Document Math::BigInt::CalcEmu requires Math::BigInt |
||||
MIME-Version: 1.0 |
||||
Content-Type: text/plain; charset=UTF-8 |
||||
Content-Transfer-Encoding: 8bit |
||||
|
||||
<https://rt.cpan.org/Public/Bug/Display.html?id=85015> |
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com> |
||||
--- |
||||
dist/Math-BigInt/lib/Math/BigInt/CalcEmu.pm | 1 + |
||||
1 file changed, 1 insertion(+) |
||||
|
||||
diff --git a/dist/Math-BigInt/lib/Math/BigInt/CalcEmu.pm b/dist/Math-BigInt/lib/Math/BigInt/CalcEmu.pm |
||||
index c82e153..0c0b496 100644 |
||||
--- a/dist/Math-BigInt/lib/Math/BigInt/CalcEmu.pm |
||||
+++ b/dist/Math-BigInt/lib/Math/BigInt/CalcEmu.pm |
||||
@@ -290,6 +290,7 @@ Math::BigInt::CalcEmu - Emulate low-level math with BigInt code |
||||
|
||||
=head1 SYNOPSIS |
||||
|
||||
+ use Math::BigInt; |
||||
use Math::BigInt::CalcEmu; |
||||
|
||||
=head1 DESCRIPTION |
||||
-- |
||||
1.8.3.1 |
||||
|
@ -0,0 +1,54 @@
@@ -0,0 +1,54 @@
|
||||
From 8de0fd45cde4826951842f80b6ce109988d47f4f Mon Sep 17 00:00:00 2001 |
||||
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com> |
||||
Date: Mon, 7 Apr 2014 12:31:28 +0200 |
||||
Subject: [PATCH] t/op/crypt.t: Perform SHA-256 algorithm if default one is |
||||
disabled |
||||
MIME-Version: 1.0 |
||||
Content-Type: text/plain; charset=UTF-8 |
||||
Content-Transfer-Encoding: 8bit |
||||
|
||||
The crypt(3) call may return NULL. This is the case of FIPS-enabled |
||||
platforms. Then "salt makes a difference" test would fail. |
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com> |
||||
--- |
||||
t/op/crypt.t | 14 ++++++++++---- |
||||
1 file changed, 10 insertions(+), 4 deletions(-) |
||||
|
||||
diff --git a/t/op/crypt.t b/t/op/crypt.t |
||||
index 27c878f..6c43992 100644 |
||||
--- a/t/op/crypt.t |
||||
+++ b/t/op/crypt.t |
||||
@@ -28,19 +28,25 @@ BEGIN { |
||||
# bets, given alternative encryption/hashing schemes like MD5, |
||||
# C2 (or higher) security schemes, and non-UNIX platforms. |
||||
|
||||
+# Platforms implementing FIPS mode return undef on weak crypto algorithms. |
||||
+my $alg = ''; # Use default algorithm |
||||
+if ( !defined(crypt("ab", "cd")) ) { |
||||
+ $alg = '$5$'; # Use SHA-256 |
||||
+} |
||||
+ |
||||
SKIP: { |
||||
skip ("VOS crypt ignores salt.", 1) if ($^O eq 'vos'); |
||||
- ok(substr(crypt("ab", "cd"), 2) ne substr(crypt("ab", "ce"), 2), "salt makes a difference"); |
||||
+ ok(substr(crypt("ab", $alg . "cd"), 2) ne substr(crypt("ab", $alg. "ce"), 2), "salt makes a difference"); |
||||
} |
||||
|
||||
$a = "a\xFF\x{100}"; |
||||
|
||||
-eval {$b = crypt($a, "cd")}; |
||||
+eval {$b = crypt($a, $alg . "cd")}; |
||||
like($@, qr/Wide character in crypt/, "wide characters ungood"); |
||||
|
||||
chop $a; # throw away the wide character |
||||
|
||||
-eval {$b = crypt($a, "cd")}; |
||||
+eval {$b = crypt($a, $alg . "cd")}; |
||||
is($@, '', "downgrade to eight bit characters"); |
||||
-is($b, crypt("a\xFF", "cd"), "downgrade results agree"); |
||||
+is($b, crypt("a\xFF", $alg . "cd"), "downgrade results agree"); |
||||
|
||||
-- |
||||
1.9.0 |
||||
|
@ -0,0 +1,38 @@
@@ -0,0 +1,38 @@
|
||||
From fe89bf70817551c30bcacaef25578ffeb7d71eb1 Mon Sep 17 00:00:00 2001 |
||||
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com> |
||||
Date: Sun, 9 Jun 2013 14:01:49 -0400 |
||||
Subject: [PATCH] Synchronize h2ph POD text with usage output |
||||
|
||||
--- |
||||
utils/h2ph.PL | 8 +++++++- |
||||
1 file changed, 7 insertions(+), 1 deletion(-) |
||||
|
||||
diff --git a/utils/h2ph.PL b/utils/h2ph.PL |
||||
index a2d737b..9a8b14d 100644 |
||||
--- a/utils/h2ph.PL |
||||
+++ b/utils/h2ph.PL |
||||
@@ -866,7 +866,8 @@ h2ph - convert .h C header files to .ph Perl header files |
||||
|
||||
=head1 SYNOPSIS |
||||
|
||||
-B<h2ph [-d destination directory] [-r | -a] [-l] [headerfiles]> |
||||
+B<h2ph [-d destination directory] [-r | -a] [-l] [-h] [-e] [-D] [-Q] |
||||
+[headerfiles]> |
||||
|
||||
=head1 DESCRIPTION |
||||
|
||||
@@ -932,6 +933,11 @@ you will see the slightly more helpful |
||||
|
||||
However, the B<.ph> files almost double in size when built using B<-h>. |
||||
|
||||
+=item -e |
||||
+ |
||||
+If an error is encountered during conversion, output file will be removed and |
||||
+a warning emitted instead of terminating the conversion immediately. |
||||
+ |
||||
=item -D |
||||
|
||||
Include the code from the B<.h> file as a comment in the B<.ph> file. |
||||
-- |
||||
1.8.1.4 |
||||
|
@ -0,0 +1,33 @@
@@ -0,0 +1,33 @@
|
||||
From 8d89c0509dd5eb1de58dc6617f6e08599eb24792 Mon Sep 17 00:00:00 2001 |
||||
From: Tony Cook <tony@develop-help.com> |
||||
Date: Mon, 10 Aug 2015 13:37:26 +0100 |
||||
Subject: [PATCH] [PATCH] [perl #123786] don't leak the temp utf8 copy of |
||||
namepv |
||||
MIME-Version: 1.0 |
||||
Content-Type: text/plain; charset=UTF-8 |
||||
Content-Transfer-Encoding: 8bit |
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com> |
||||
--- |
||||
pad.c | 4 +++- |
||||
1 file changed, 3 insertions(+), 1 deletion(-) |
||||
|
||||
diff --git a/pad.c b/pad.c |
||||
index fed2892..f22c3c5 100644 |
||||
--- a/pad.c |
||||
+++ b/pad.c |
||||
@@ -976,8 +976,10 @@ Perl_pad_findmy_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags) |
||||
|
||||
if (is_utf8) |
||||
flags |= padadd_UTF8_NAME; |
||||
- else |
||||
+ else { |
||||
flags &= ~padadd_UTF8_NAME; |
||||
+ SAVEFREEPV(namepv); |
||||
+ } |
||||
} |
||||
|
||||
offset = pad_findlex(namepv, namelen, flags, |
||||
-- |
||||
2.4.3 |
||||
|
@ -0,0 +1,46 @@
@@ -0,0 +1,46 @@
|
||||
--- perl-5.8.0/Configure.orig 2002-09-09 11:31:19.000000000 -0400 |
||||
+++ perl-5.8.0/Configure 2002-09-09 11:40:37.000000000 -0400 |
||||
@@ -6458,8 +6458,8 @@ |
||||
: Reproduce behavior of 5.005 and earlier, maybe drop that in 5.7. |
||||
case "$installstyle" in |
||||
'') case "$prefix" in |
||||
- *perl*) dflt='lib';; |
||||
- *) dflt='lib/perl5' ;; |
||||
+ *perl*) dflt='lib64';; |
||||
+ *) dflt='lib64/perl5' ;; |
||||
esac |
||||
;; |
||||
*) dflt="$installstyle" ;; |
||||
@@ -6475,8 +6475,8 @@ |
||||
: /opt/perl/lib/perl5... would be redundant. |
||||
: The default "style" setting is made in installstyle.U |
||||
case "$installstyle" in |
||||
-*lib/perl5*) set dflt privlib lib/$package/$version ;; |
||||
-*) set dflt privlib lib/$version ;; |
||||
+*lib64/perl5*) set dflt privlib lib64/$package/$version ;; |
||||
+*) set dflt privlib lib64/$version ;; |
||||
esac |
||||
eval $prefixit |
||||
$cat <<EOM |
||||
@@ -6934,8 +6934,8 @@ |
||||
prog=`echo $package | $sed 's/-*[0-9.]*$//'` |
||||
case "$sitelib" in |
||||
'') case "$installstyle" in |
||||
- *lib/perl5*) dflt=$siteprefix/lib/$package/site_$prog/$version ;; |
||||
- *) dflt=$siteprefix/lib/site_$prog/$version ;; |
||||
+ *lib64/perl5*) dflt=$siteprefix/lib64/$package/site_$prog/$version ;; |
||||
+ *) dflt=$siteprefix/lib64/site_$prog/$version ;; |
||||
esac |
||||
;; |
||||
*) dflt="$sitelib" |
||||
@@ -7061,8 +7061,8 @@ |
||||
'') |
||||
prog=`echo $package | $sed 's/-*[0-9.]*$//'` |
||||
case "$installstyle" in |
||||
- *lib/perl5*) dflt=$vendorprefix/lib/$package/vendor_$prog/$version ;; |
||||
- *) dflt=$vendorprefix/lib/vendor_$prog/$version ;; |
||||
+ *lib64/perl5*) dflt=$vendorprefix/lib64/$package/vendor_$prog/$version ;; |
||||
+ *) dflt=$vendorprefix/lib64/vendor_$prog/$version ;; |
||||
esac |
||||
;; |
||||
*) dflt="$vendorlib" |
@ -0,0 +1,109 @@
@@ -0,0 +1,109 @@
|
||||
diff -up perl-5.14.0/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm.usem perl-5.14.0/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm |
||||
--- perl-5.14.0/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm.usem 2011-05-08 05:10:08.000000000 +0200 |
||||
+++ perl-5.14.0/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm 2011-05-17 11:14:22.169115984 +0200 |
||||
@@ -88,6 +88,11 @@ libraries. LD_RUN_PATH is a colon separ |
||||
in LDLOADLIBS. It is passed as an environment variable to the process |
||||
that links the shared library. |
||||
|
||||
+Fedora extension: This generation of LD_RUN_PATH is disabled by default. |
||||
+To use the generated LD_RUN_PATH for all links, set the USE_MM_LD_RUN_PATH |
||||
+MakeMaker object attribute / argument, (or set the $USE_MM_LD_RUN_PATH |
||||
+environment variable). |
||||
+ |
||||
=head2 BSLOADLIBS |
||||
|
||||
List of those libraries that are needed but can be linked in |
||||
diff -up perl-5.14.0/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm.usem perl-5.14.0/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm |
||||
--- perl-5.14.0/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm.usem 2011-05-08 05:10:08.000000000 +0200 |
||||
+++ perl-5.14.0/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm 2011-05-17 13:39:26.912586030 +0200 |
||||
@@ -278,7 +278,7 @@ sub full_setup { |
||||
PERL_SRC PERM_DIR PERM_RW PERM_RWX |
||||
PL_FILES PM PM_FILTER PMLIBDIRS PMLIBPARENTDIRS POLLUTE PPM_INSTALL_EXEC |
||||
PPM_INSTALL_SCRIPT PREREQ_FATAL PREREQ_PM PREREQ_PRINT PRINT_PREREQ |
||||
- SIGN SKIP TYPEMAPS VERSION VERSION_FROM XS XSOPT XSPROTOARG |
||||
+ SIGN SKIP TYPEMAPS USE_MM_LD_RUN_PATH VERSION VERSION_FROM XS XSOPT XSPROTOARG |
||||
XS_VERSION clean depend dist dynamic_lib linkext macro realclean |
||||
tool_autosplit |
||||
|
||||
@@ -422,7 +422,27 @@ sub new { |
||||
# PRINT_PREREQ is RedHatism. |
||||
if ("@ARGV" =~ /\bPRINT_PREREQ\b/) { |
||||
$self->_PRINT_PREREQ; |
||||
- } |
||||
+ } |
||||
+ |
||||
+ # USE_MM_LD_RUN_PATH - another RedHatism to disable automatic RPATH generation |
||||
+ if ( ( ! $self->{USE_MM_LD_RUN_PATH} ) |
||||
+ &&( ("@ARGV" =~ /\bUSE_MM_LD_RUN_PATH(=([01]))?\b/) |
||||
+ ||( exists( $ENV{USE_MM_LD_RUN_PATH} ) |
||||
+ &&( $ENV{USE_MM_LD_RUN_PATH} =~ /([01])?$/ ) |
||||
+ ) |
||||
+ ) |
||||
+ ) |
||||
+ { |
||||
+ my $v = $1; |
||||
+ if( $v ) |
||||
+ { |
||||
+ $v = ($v=~/=([01])$/)[0]; |
||||
+ }else |
||||
+ { |
||||
+ $v = 1; |
||||
+ }; |
||||
+ $self->{USE_MM_LD_RUN_PATH}=$v; |
||||
+ }; |
||||
|
||||
print STDOUT "MakeMaker (v$VERSION)\n" if $Verbose; |
||||
if (-f "MANIFEST" && ! -f "Makefile" && ! $ENV{PERL_CORE}){ |
||||
@@ -2352,6 +2372,40 @@ precedence. A typemap in the current di |
||||
precedence, even if it isn't listed in TYPEMAPS. The default system |
||||
typemap has lowest precedence. |
||||
|
||||
+=item USE_MM_LD_RUN_PATH |
||||
+ |
||||
+boolean |
||||
+The Fedora perl MakeMaker distribution differs from the standard |
||||
+upstream release in that it disables use of the MakeMaker generated |
||||
+LD_RUN_PATH by default, UNLESS this attribute is specified , or the |
||||
+USE_MM_LD_RUN_PATH environment variable is set during the MakeMaker run. |
||||
+ |
||||
+The upstream MakeMaker will set the ld(1) environment variable LD_RUN_PATH |
||||
+to the concatenation of every -L ld(1) option directory in which a -l ld(1) |
||||
+option library is found, which is used as the ld(1) -rpath option if none |
||||
+is specified. This means that, if your application builds shared libraries |
||||
+and your MakeMaker application links to them, that the absolute paths of the |
||||
+libraries in the build tree will be inserted into the RPATH header of all |
||||
+MakeMaker generated binaries, and that such binaries will be unable to link |
||||
+to these libraries if they do not still reside in the build tree directories |
||||
+(unlikely) or in the system library directories (/lib or /usr/lib), regardless |
||||
+of any LD_LIBRARY_PATH setting. So if you specified -L../mylib -lmylib , and |
||||
+ your 'libmylib.so' gets installed into /some_directory_other_than_usr_lib, |
||||
+ your MakeMaker application will be unable to link to it, even if LD_LIBRARY_PATH |
||||
+is set to include /some_directory_other_than_usr_lib, because RPATH overrides |
||||
+LD_LIBRARY_PATH. |
||||
+ |
||||
+So for Fedora MakeMaker builds LD_RUN_PATH is NOT generated by default for |
||||
+every link. You can still use explicit -rpath ld options or the LD_RUN_PATH |
||||
+environment variable during the build to generate an RPATH for the binaries. |
||||
+ |
||||
+You can set the USE_MM_LD_RUN_PATH attribute to 1 on the MakeMaker command |
||||
+line or in the WriteMakefile arguments to enable generation of LD_RUN_PATH |
||||
+for every link command. |
||||
+ |
||||
+USE_MM_LD_RUN_PATH will default to 1 (LD_RUN_PATH will be used) IF the |
||||
+$USE_MM_LD_RUN_PATH environment variable is set during a MakeMaker run. |
||||
+ |
||||
=item VENDORPREFIX |
||||
|
||||
Like PERLPREFIX, but only for the vendor install locations. |
||||
diff -up perl-5.14.0/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm.usem perl-5.14.0/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm |
||||
--- perl-5.14.0/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm.usem 2011-05-08 05:10:08.000000000 +0200 |
||||
+++ perl-5.14.0/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm 2011-05-17 11:14:22.172115972 +0200 |
||||
@@ -944,7 +944,7 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $ |
||||
} |
||||
|
||||
my $ld_run_path_shell = ""; |
||||
- if ($self->{LD_RUN_PATH} ne "") { |
||||
+ if (($self->{LD_RUN_PATH} ne "") && ($self->{USE_MM_LD_RUN_PATH})) { |
||||
$ld_run_path_shell = 'LD_RUN_PATH="$(LD_RUN_PATH)" '; |
||||
} |
||||
|
@ -0,0 +1,12 @@
@@ -0,0 +1,12 @@
|
||||
diff -up perl-5.12.0/cpan/libnet/Net/Config.pm.disable perl-5.12.0/cpan/libnet/Net/Config.pm |
||||
--- perl-5.12.0/cpan/libnet/Net/Config.pm.disable 2010-01-18 19:52:49.000000000 +0100 |
||||
+++ perl-5.12.0/cpan/libnet/Net/Config.pm 2010-04-13 16:03:50.090770813 +0200 |
||||
@@ -29,7 +29,7 @@ eval { local $SIG{__DIE__}; require Net: |
||||
ftp_firewall => undef, |
||||
ftp_ext_passive => 1, |
||||
ftp_int_passive => 1, |
||||
- test_hosts => 1, |
||||
+ test_hosts => 0, |
||||
test_exist => 1, |
||||
); |
||||
|
@ -0,0 +1,21 @@
@@ -0,0 +1,21 @@
|
||||
diff -up perl-5.16.0-RC2/utils/perlbug.PL.fedora perl-5.16.0-RC2/utils/perlbug.PL |
||||
--- perl-5.16.0-RC2/utils/perlbug.PL.fedora 2012-05-16 16:15:51.000000000 +0200 |
||||
+++ perl-5.16.0-RC2/utils/perlbug.PL 2012-05-16 16:18:36.018894464 +0200 |
||||
@@ -271,17 +271,6 @@ sub Init { |
||||
$ok = ''; |
||||
if ($opt{o}) { |
||||
if ($opt{o} eq 'k' or $opt{o} eq 'kay') { |
||||
- my $age = time - $patchlevel_date; |
||||
- if ($opt{o} eq 'k' and $age > 60 * 24 * 60 * 60 ) { |
||||
- my $date = localtime $patchlevel_date; |
||||
- print <<"EOF"; |
||||
-"perlbug -ok" and "perlbug -nok" do not report on Perl versions which |
||||
-are more than 60 days old. This Perl version was constructed on |
||||
-$date. If you really want to report this, use |
||||
-"perlbug -okay" or "perlbug -nokay". |
||||
-EOF |
||||
- exit(); |
||||
- } |
||||
# force these options |
||||
unless ($opt{n}) { |
||||
$opt{S} = 1; # don't prompt for send |
@ -0,0 +1,39 @@
@@ -0,0 +1,39 @@
|
||||
/* |
||||
This probe will fire when the perl script enters a subroutine. |
||||
*/ |
||||
|
||||
probe perl.sub.call = process("LIBRARY_PATH").mark("sub__entry") |
||||
{ |
||||
|
||||
sub = user_string($arg1) |
||||
filename = user_string($arg2) |
||||
lineno = $arg3 |
||||
package = user_string($arg4) |
||||
|
||||
} |
||||
|
||||
/* |
||||
This probe will fire when the return from a subroutine has been |
||||
hit. |
||||
*/ |
||||
|
||||
probe perl.sub.return = process("LIBRARY_PATH").mark("sub__return") |
||||
{ |
||||
|
||||
sub = user_string($arg1) |
||||
filename = user_string($arg2) |
||||
lineno = $arg3 |
||||
package = user_string($arg4) |
||||
|
||||
} |
||||
|
||||
/* |
||||
This probe will fire when the Perl interperter changes state. |
||||
*/ |
||||
|
||||
probe perl.phase.change = process("LIBRARY_PATH").mark("phase__change") |
||||
{ |
||||
newphase = user_string($arg1) |
||||
oldphase = user_string($arg2) |
||||
|
||||
} |
@ -0,0 +1,26 @@
@@ -0,0 +1,26 @@
|
||||
diff -up perl-5.16.0-RC2/t/porting/known_pod_issues.dat.pody perl-5.16.0-RC2/t/porting/known_pod_issues.dat |
||||
--- perl-5.16.0-RC2/t/porting/known_pod_issues.dat.pody 2012-05-14 21:49:22.000000000 +0200 |
||||
+++ perl-5.16.0-RC2/t/porting/known_pod_issues.dat 2012-05-16 14:21:00.000000000 +0200 |
||||
@@ -1,4 +1,4 @@ |
||||
-# This file is the data file for porting/podcheck.t. |
||||
+# This file is the data file for t/porting/podcheck.t. |
||||
# There are three types of lines. |
||||
# Comment lines are white-space only or begin with a '#', like this one. Any |
||||
# changes you make to the comment lines will be lost when the file is |
||||
@@ -217,6 +217,7 @@ pod/perlbook.pod Verbatim line length in |
||||
pod/perlcall.pod Verbatim line length including indents exceeds 79 by 2 |
||||
pod/perlce.pod Verbatim line length including indents exceeds 79 by 2 |
||||
pod/perlclib.pod Verbatim line length including indents exceeds 79 by 3 |
||||
+pod/perlcn.pod Verbatim line length including indents exceeds 79 by 1 |
||||
pod/perlcygwin.pod Verbatim line length including indents exceeds 79 by 25 |
||||
pod/perldbmfilter.pod Verbatim line length including indents exceeds 79 by 1 |
||||
pod/perldebguts.pod Verbatim line length including indents exceeds 79 by 68 |
||||
@@ -248,6 +249,8 @@ pod/perliol.pod Verbatim line length inc |
||||
pod/perlipc.pod Apparent broken link 1 |
||||
pod/perlipc.pod Verbatim line length including indents exceeds 79 by 19 |
||||
pod/perlirix.pod Verbatim line length including indents exceeds 79 by 4 |
||||
+pod/perljp.pod Verbatim line length including indents exceeds 79 by 1 |
||||
+pod/perlko.pod Verbatim line length including indents exceeds 79 by 22 |
||||
pod/perllol.pod Verbatim line length including indents exceeds 79 by 4 |
||||
pod/perlmacosx.pod Verbatim line length including indents exceeds 79 by 3 |
||||
pod/perlmod.pod Verbatim line length including indents exceeds 79 by 2 |
Loading…
Reference in new issue