basebuilder_pel7ppc64bebuilder0
6 years ago
38 changed files with 7418 additions and 0 deletions
@ -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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
--- 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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
/* |
||||||
|
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 @@ |
|||||||
|
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