rpms/perl
7
0
Fork 0
Code Issues Pull Requests Releases Activity

import sources

Browse Source
This commit is contained in:
Adam Samalik 2023-05-05 22:13:53 +02:00
commit 00a8196cff
74 changed files with 14302 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitignore vendored Normal file
View File

@ -0,0 +1,2 @@
/perl-5.30.1-study_chunk-avoid-mutating-regexp-program-within-GOS.patch
/perl-5.30.1.tar.xz

41
Pod-Html-license-clarification Normal file
View File

@ -0,0 +1,41 @@
Date: Sun, 15 Mar 2015 21:22:10 -0600
Subject: Re: Pod::Html license
From: Tom Christiansen <tchrist53147@gmail.com>
To: Petr Šabata <contyk@redhat.com>
Cc: Tom Christiansen <tchrist@perl.com>, marcgreen@cpan.org,
jplesnik@redhat.com
MIME-Version: 1.0
Content-Transfer-Encoding: 8bit
Content-Type: text/plain; charset=utf-8
Yes, it was supposed to be licensed just like the rest of Perl.
Sent from my Sprint phone
Petr Šabata <contyk@redhat.com> wrote:
>Marc, Tom,
>
>I'm reviewing licensing of our perl package in Fedora and
>noticed Pod::HTML and its pod2html script are licensed under
>the Artistic license (only).
>
>This is an issue for us as this license isn't considered free by
>FSF [0]. Unless the license of this core component changes, we
>will have to drop it from the tarball and remove support for it
>from all the modules we ship that use it, such as Module::Build
>or Module::Install.
>
>What I've seen in the past is authors originally claiming their
>module was released under Artistic while what they actually meant
>was the common `the same as perl itself', i.e. `GPL+/Aristic' [1],
>an FSF free license. Is it possible this is also the case
>of Pod::Html?
>
>Thanks,
>Petr
>
>(also CC'ing Jitka, the primary package maintainer in Fedora)
>
>[0] https://www.gnu.org/licenses/license-list.html#ArtisticLicense
>[1] https://www.gnu.org/licenses/license-list.html#PerlLicense

2076
gendep.macros Normal file
View File

File diff suppressed because it is too large Load Diff

158
macros.perl Normal file
View File

@ -0,0 +1,158 @@
# 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
}
#############################################################################
# Perl specific macros, no longer part of rpm >= 4.15
%perl_vendorarch %(eval "`%{__perl} -V:installvendorarch`"; echo $installvendorarch)
%perl_vendorlib %(eval "`%{__perl} -V:installvendorlib`"; echo $installvendorlib)
%perl_archlib %(eval "`%{__perl} -V:installarchlib`"; echo $installarchlib)
%perl_privlib %(eval "`%{__perl} -V:installprivlib`"; echo $installprivlib)
#############################################################################
# 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
# By default, for perl packages we want to filter all files in _docdir from
# req/prov scanning.
# Filtering out any provides caused by private libs in vendorarch/archlib
# (vendor/core) is done by rpmbuild since Fedora 20
# <https://fedorahosted.org/fpc/ticket/353>.
#
# 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 %{?__provides_exclude_from:%__provides_exclude_from|}^%{_docdir}
%global __requires_exclude_from %{?__requires_exclude_from:%__requires_exclude_from|}^%{_docdir}
%global __provides_exclude %{?__provides_exclude:%__provides_exclude|}^perl\\\\(VMS|^perl\\\\(Win32|^perl\\\\(DB\\\\)|^perl\\\\(UNIVERSAL\\\\)
%global __requires_exclude %{?__requires_exclude:%__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/

12
perl-5.10.0-libresolv.patch Normal file
View File

@ -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
@@ -1483,7 +1483,7 @@ archname=''
usereentrant='undef'
: List of libraries we want.
: If anyone needs extra -lxxx, put those in a hint file.
-libswanted="cl pthread socket bind inet nsl ndbm gdbm dbm db malloc dl ld"
+libswanted="cl pthread socket resolv inet nsl ndbm gdbm dbm db malloc dl ld"
libswanted="$libswanted sun 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.

12
perl-5.10.0-x86_64-io-test-failure.patch Normal file
View File

@ -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
@@ -257,7 +257,7 @@ isnt($atime, 500000000, 'atime');
isnt($mtime, $ut + $delta, 'mtime: utime called with two undefs');
SKIP: {
- skip "no futimes", 6 unless ($Config{d_futimes} || "") eq "define";
+ skip "no futimes", 6;
note("check futimes");
open(my $fh, "<", 'b');
$foo = (utime $ut,$ut + $delta, $fh);

17
perl-5.14.1-offtest.patch Normal file
View File

@ -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;

65
perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch Normal file
View File

@ -0,0 +1,65 @@
From b598ba3f2d4b8347c6621cff022b8e2329b79ea5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
Date: Wed, 3 Jul 2013 11:01:02 +0200
Subject: [PATCH] Link XS modules to libperl.so with EU::CBuilder on Linux
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
<https://bugzilla.redhat.com/show_bug.cgi?id=960048>
<http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=327585#50>
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
MANIFEST | 1 +
.../lib/ExtUtils/CBuilder/Platform/linux.pm | 26 ++++++++++++++++++++++
2 files changed, 27 insertions(+)
create mode 100644 dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/linux.pm
diff --git a/MANIFEST b/MANIFEST
index 397252a..d7c519b 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -3424,6 +3424,7 @@ dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/aix.pm CBuilder methods fo
dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/cygwin.pm CBuilder methods for cygwin
dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/darwin.pm CBuilder methods for darwin
dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/dec_osf.pm CBuilder methods for OSF
+dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/linux.pm CBuilder methods for Linux
dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/os2.pm CBuilder methods for OS/2
dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Unix.pm CBuilder methods for Unix
dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/VMS.pm CBuilder methods for VMS
diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/linux.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/linux.pm
new file mode 100644
index 0000000..e3251c4
--- /dev/null
+++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/linux.pm
@@ -0,0 +1,26 @@
+package ExtUtils::CBuilder::Platform::linux;
+
+use strict;
+use ExtUtils::CBuilder::Platform::Unix;
+use File::Spec;
+
+use vars qw($VERSION @ISA);
+$VERSION = '0.280206';
+@ISA = qw(ExtUtils::CBuilder::Platform::Unix);
+
+sub link {
+ my ($self, %args) = @_;
+ my $cf = $self->{config};
+
+ # Link XS modules to libperl.so explicitly because multiple
+ # dlopen(, RTLD_LOCAL) hides libperl symbols from XS module.
+ local $cf->{lddlflags} = $cf->{lddlflags};
+ if ($ENV{PERL_CORE}) {
+ $cf->{lddlflags} .= ' -L' . $self->perl_inc();
+ }
+ $cf->{lddlflags} .= ' -lperl';
+
+ return $self->SUPER::link(%args);
+}
+
+1;
--
1.8.1.4

52
perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-MM-on-Linux.patch Normal file
View File

@ -0,0 +1,52 @@
From fc1f8ac36c34c35bad84fb7b99a26ab83c9ba075 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
Date: Wed, 3 Jul 2013 12:59:09 +0200
Subject: [PATCH] Link XS modules to libperl.so with EU::MM on Linux
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
<https://bugzilla.redhat.com/show_bug.cgi?id=960048>
<http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=327585#50>
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm | 8 +++++++-
1 file changed, 7 insertions(+), 1 deletion(-)
diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm
index a8b172f..a3fbce2 100644
--- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm
+++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm
@@ -30,6 +30,7 @@ BEGIN {
$Is{IRIX} = $^O eq 'irix';
$Is{NetBSD} = $^O eq 'netbsd';
$Is{Interix} = $^O eq 'interix';
+ $Is{Linux} = $^O eq 'linux';
$Is{SunOS4} = $^O eq 'sunos';
$Is{Solaris} = $^O eq 'solaris';
$Is{SunOS} = $Is{SunOS4} || $Is{Solaris};
@@ -1028,7 +1029,7 @@ sub xs_make_dynamic_lib {
push(@m," \$(RM_F) \$\@\n");
my $libs = '$(LDLOADLIBS)';
- if (($Is{NetBSD} || $Is{Interix} || $Is{Android}) && $Config{'useshrplib'} eq 'true') {
+ if (($Is{Linux} || $Is{NetBSD} || $Is{Interix} || $Is{Android}) && $Config{'useshrplib'} eq 'true') {
# Use nothing on static perl platforms, and to the flags needed
# to link against the shared libperl library on shared perl
# platforms. We peek at lddlflags to see if we need -Wl,-R
@@ -1041,6 +1042,11 @@ sub xs_make_dynamic_lib {
# The Android linker will not recognize symbols from
# libperl unless the module explicitly depends on it.
$libs .= ' "-L$(PERL_INC)" -lperl';
+ } else {
+ if ($ENV{PERL_CORE}) {
+ $libs .= ' "-L$(PERL_INC)"';
+ }
+ $libs .= ' -lperl';
}
}
--
1.8.1.4

57
perl-5.16.3-create_libperl_soname.patch Normal file
View File

@ -0,0 +1,57 @@
From fa2f0dd5a7767223df10149d3f16d7ed7013e16f Mon Sep 17 00:00:00 2001
From: Torsten Veller <tove@gentoo.org>
Date: Sat, 14 Apr 2012 13:49:18 +0200
Subject: Set libperl soname
Bug-Gentoo: https://bugs.gentoo.org/286840
Patch-Name: gentoo/create_libperl_soname.diff
---
Makefile.SH | 9 +++++++--
1 file changed, 7 insertions(+), 2 deletions(-)
diff --git a/Makefile.SH b/Makefile.SH
index d1da0a0..7733a32 100755
--- a/Makefile.SH
+++ b/Makefile.SH
@@ -70,11 +70,11 @@ true)
${revision}.${patchlevel}.${subversion}"
case "$osvers" in
1[5-9]*|[2-9]*)
- shrpldflags="$shrpldflags -install_name `pwd`/\$@ -Xlinker -headerpad_max_install_names"
+ shrpldflags="$shrpldflags -install_name `pwd`/libperl.${revision}.${patchlevel}.dylib -Xlinker -headerpad_max_install_names"
exeldflags="-Xlinker -headerpad_max_install_names"
;;
*)
- shrpldflags="$shrpldflags -install_name \$(shrpdir)/\$@"
+ shrpldflags="$shrpldflags -install_name \$(shrpdir)/libperl.${revision}.${patchlevel}.dylib"
;;
esac
;;
@@ -76,13 +76,15 @@ true)
;;
sunos*)
linklibperl="-lperl"
+ shrpldflags="$shrpldflags -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}"
;;
netbsd*|freebsd[234]*|openbsd*|dragonfly*|bitrig*)
linklibperl="-L. -lperl"
+ shrpldflags="$shrpldflags -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}"
;;
interix*)
linklibperl="-L. -lperl"
- shrpldflags="$shrpldflags -Wl,--image-base,0x57000000"
+ shrpldflags="$shrpldflags -Wl,--image-base,0x57000000 -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}"
;;
aix*)
case "$cc" in
@@ -120,6 +122,9 @@ true)
linklibperl='libperl.x'
DPERL_EXTERNAL_GLOB=''
;;
+ linux*)
+ shrpldflags="$shrpldflags -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}"
+ ;;
esac
case "$ldlibpthname" in
'') ;;

233
perl-5.18.2-Destroy-GDBM-NDBM-ODBM-SDBM-_File-objects-only-from-.patch Normal file
View File

@ -0,0 +1,233 @@
From f793042f2bac2ace9a5c0030b47b41c4db561a5b 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 33e08e2..7160f54 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 ;
@@ -98,6 +99,7 @@ gdbm_TIEHASH(dbtype, name, read_write, m
}
if (dbp) {
RETVAL = (GDBM_File)safecalloc(1, sizeof(GDBM_File_type));
+ RETVAL->owner = aTHX;
RETVAL->dbp = dbp;
} else {
RETVAL = NULL;
@@ -118,12 +120,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
@@ -49,6 +49,7 @@ datum nextkey(datum key);
#define store_value 3
typedef struct {
+ tTHX owner;
void * dbp ;
SV * filter[4];
int filtering ;
@@ -137,6 +138,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:
@@ -149,13 +151,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 ;
@@ -51,6 +52,7 @@ sdbm_TIEHASH(dbtype, filename, flags, mode)
}
if (dbp) {
RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type));
+ RETVAL->owner = aTHX;
RETVAL->dbp = dbp ;
}
@@ -62,7 +64,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
@@ -510,5 +510,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

61
perl-5.22.0-Install-libperl.so-to-shrpdir-on-Linux.patch Normal file
View File

@ -0,0 +1,61 @@
From 9644657c4 10326749fd321d9c24944ec25afad2f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
Date: Thu, 20 Jun 2013 15:22:53 +0200
Subject: [PATCH] Install libperl.so to shrpdir on Linux
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
Configure | 7 ++++---
Makefile.SH | 2 +-
2 files changed, 5 insertions(+), 4 deletions(-)
diff --git a/Configure b/Configure
index 2f30261..825496e 100755
--- a/Configure
+++ b/Configure
@@ -8762,7 +8762,9 @@ esac
# Detect old use of shrpdir via undocumented Configure -Dshrpdir
case "$shrpdir" in
-'') ;;
+'')
+shrpdir=$archlibexp/CORE
+;;
*) $cat >&4 <<EOM
WARNING: Use of the shrpdir variable for the installation location of
the shared $libperl is not supported. It was never documented and
@@ -8792,7 +8794,6 @@ esac
# Add $xxx to ccdlflags.
# If we can't figure out a command-line option, use $shrpenv to
# set env LD_RUN_PATH. The main perl makefile uses this.
-shrpdir=$archlibexp/CORE
xxx=''
tmp_shrpenv=''
if "$useshrplib"; then
@@ -8807,7 +8808,7 @@ if "$useshrplib"; then
xxx="-Wl,-R$shrpdir"
;;
bsdos|linux|irix*|dec_osf|gnu*|haiku)
- xxx="-Wl,-rpath,$shrpdir"
+ # We want standard path
;;
hpux*)
# hpux doesn't like the default, either.
diff --git a/Makefile.SH b/Makefile.SH
index 7733a32..a481183 100755
--- a/Makefile.SH
+++ b/Makefile.SH
@@ -288,7 +288,7 @@ ranlib = $ranlib
# installman commandline.
bin = $installbin
scriptdir = $scriptdir
-shrpdir = $archlibexp/CORE
+shrpdir = $shrpdir
privlib = $installprivlib
man1dir = $man1dir
man1ext = $man1ext
--
1.8.1.4

110
perl-5.22.1-Provide-ExtUtils-MM-methods-as-standalone-ExtUtils-M.patch Normal file
View File

@ -0,0 +1,110 @@
From 9575301256f67116eccdbb99b38fc804ba3dcf53 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
Date: Mon, 18 Apr 2016 16:24:03 +0200
Subject: [PATCH] Provide ExtUtils::MM methods as standalone
ExtUtils::MM::Utils
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
If you cannot afford depending on ExtUtils::MakeMaker, you can
depend on ExtUtils::MM::Utils instead.
<https://bugzilla.redhat.com/show_bug.cgi?id=1129443>
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
MANIFEST | 1 +
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM/Utils.pm | 68 ++++++++++++++++++++++++
2 files changed, 69 insertions(+)
create mode 100644 cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM/Utils.pm
diff --git a/MANIFEST b/MANIFEST
index 6af238c..d4f0c56 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -784,6 +784,7 @@ cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm MakeMaker methods for OS/2
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm MakeMaker methods for OS/2
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm MakeMaker methods for QNX
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm MakeMaker methods for Unix
+cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM/Utils.pm Independed MM methods
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_UWIN.pm MakeMaker methods for U/WIN
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm MakeMaker methods for VMS
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VOS.pm MakeMaker methods for VOS
diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM/Utils.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM/Utils.pm
new file mode 100644
index 0000000..6bbc0d8
--- /dev/null
+++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM/Utils.pm
@@ -0,0 +1,68 @@
+package ExtUtils::MM::Utils;
+
+require 5.006;
+
+use strict;
+use vars qw($VERSION);
+$VERSION = '7.11_06';
+$VERSION = eval $VERSION; ## no critic [BuiltinFunctions::ProhibitStringyEval]
+
+=head1 NAME
+
+ExtUtils::MM::Utils - ExtUtils::MM methods without dependency on ExtUtils::MakeMaker
+
+=head1 SYNOPSIS
+
+ require ExtUtils::MM::Utils;
+ MM->maybe_command($file);
+
+=head1 DESCRIPTION
+
+This is a collection of L<ExtUtils::MM> subroutines that are used by many
+other modules but that do not need full-featured L<ExtUtils::MakeMaker>. The
+issue with L<ExtUtils::MakeMaker> is it pulls in Perl header files and that is
+an overkill for small subroutines.
+
+An example is the L<IPC::Cmd> that caused installing GCC just because of
+three-line I<maybe_command()> from L<ExtUtils::MM_Unix>.
+
+The intentions is to use L<ExtUtils::MM::Utils> instead of
+L<ExtUtils::MakeMaker> for these trivial methods. You can still call them via
+L<MM> class name.
+
+=head1 METHODS
+
+=over 4
+
+=item maybe_command
+
+Returns true, if the argument is likely to be a command.
+
+=cut
+
+if (!exists $INC{'ExtUtils/MM.pm'}) {
+ *MM::maybe_command = *ExtUtils::MM::maybe_command = \&maybe_command;
+}
+
+sub maybe_command {
+ my($self,$file) = @_;
+ return $file if -x $file && ! -d $file;
+ return;
+}
+
+1;
+
+=back
+
+=head1 BUGS
+
+These methods are copied from L<ExtUtils::MM_Unix>. Other operating systems
+are not supported yet. The reason is this
+L<a hack for Linux
+distributions|https://bugzilla.redhat.com/show_bug.cgi?id=1129443>.
+
+=head1 SEE ALSO
+
+L<ExtUtils::MakeMaker>, L<ExtUtils::MM>
+
+=cut
--
2.5.5

34
perl-5.22.1-Replace-EU-MM-dependnecy-with-EU-MM-Utils-in-IPC-Cmd.patch Normal file
View File

@ -0,0 +1,34 @@
From 216ddd39adb0043930acad70ff242c30a1b0c6cf Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
Date: Mon, 18 Apr 2016 16:39:32 +0200
Subject: [PATCH] Replace EU::MM dependnecy with EU::MM::Utils in IPC::Cmd
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
This allows to free from a run-time dependency on fat
ExtUtils::MakeMaker.
<https://bugzilla.redhat.com/show_bug.cgi?id=1129443>
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
cpan/IPC-Cmd/lib/IPC/Cmd.pm | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/cpan/IPC-Cmd/lib/IPC/Cmd.pm b/cpan/IPC-Cmd/lib/IPC/Cmd.pm
index 6a82bdf..b6cd7ef 100644
--- a/cpan/IPC-Cmd/lib/IPC/Cmd.pm
+++ b/cpan/IPC-Cmd/lib/IPC/Cmd.pm
@@ -232,7 +232,7 @@ sub can_run {
}
require File::Spec;
- require ExtUtils::MakeMaker;
+ require ExtUtils::MM::Utils;
my @possibles;
--
2.5.5

61
perl-5.27.8-hints-linux-Add-lphtread-to-lddlflags.patch Normal file
View File

@ -0,0 +1,61 @@
From f6bc8fb3d26892ba1a84ba2df76beedd51998dd2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
Date: Mon, 29 Jan 2018 16:34:17 +0100
Subject: [PATCH] hints/linux: Add -lphtread to lddlflags
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Passing -z defs to linker flags causes perl to fail to build if threads are
enabled:
gcc -shared -Wl,-z,relro -Wl,-z,defs -specs=/usr/lib/rpm/redhat/redhat-hardened-ld -L/usr/local/lib -fstack-protector-strong Bzip2.o -o ../../lib/auto/Compress/Raw/Bzip2/Bzip2.so \
-L/usr/lib64 -lbz2 "-L../.." -lperl \
Bzip2.o: In function `deRef':
/builddir/build/BUILD/perl-5.26.1/cpan/Compress-Raw-Bzip2/Bzip2.xs:256: undefined reference to `pthread_getspecific'
The reason is Bzip2.xs calls dTHX macro included from thread.h via perl.h that
expands to pthread_getspecific() function call that is defined in pthread
library. But the pthread library is not explicitly linked to Bzip.so (see the
gcc command). This is exactly what -z defs linker flag enforces.
Underlinking ELFs can be dangerous because in case of versioned
symbols it can cause run-time binding to an improper version symbol or
even to an symbold from different library.
This patch fixes hints for Linux by adding -lpthreads to lddlflags. It
also adds -shared there because Configure.sh adds it only hints return
lddlflags empty.
<https://lists.fedoraproject.org/archives/list/devel@lists.fedoraproject.org/message/3RHZEHLRUHJFF2XGHI5RB6YPDNLDR4HG/>
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
hints/linux.sh | 4 ++++
1 file changed, 4 insertions(+)
diff --git a/hints/linux.sh b/hints/linux.sh
index 3f38ea07f1..9ec3bc02ef 100644
--- a/hints/linux.sh
+++ b/hints/linux.sh
@@ -353,12 +353,16 @@ if [ -f /etc/synoinfo.conf -a -d /usr/syno ]; then
echo "$libswanted" >&4
fi
+# Flags needed to produce shared libraries.
+lddlflags='-shared'
+
# This script UU/usethreads.cbu will get 'called-back' by Configure
# after it has prompted the user for whether to use threads.
cat > UU/usethreads.cbu <<'EOCBU'
case "$usethreads" in
$define|true|[yY]*)
ccflags="-D_REENTRANT -D_GNU_SOURCE $ccflags"
+ lddlflags="-lpthread $lddlflags"
if echo $libswanted | grep -v pthread >/dev/null
then
set `echo X "$libswanted "| sed -e 's/ c / pthread c /'`
--
2.13.6

63
perl-5.28.0-Pass-CFLAGS-to-dtrace.patch Normal file
View File

@ -0,0 +1,63 @@
Subject: [PATCH] Pass CFLAGS to dtrace
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
Makefile.SH | 8 +++++---
cflags.SH | 5 ++++-
2 files changed, 9 insertions(+), 4 deletions(-)
diff --git a/Makefile.SH b/Makefile.SH
index 5fc6d1c..e89ad70 100755
--- a/Makefile.SH
+++ b/Makefile.SH
@@ -462,6 +462,8 @@ CCCMD = sh $(shellflags) cflags "optimize='$(OPTIMIZE)'" $@
CCCMDSRC = sh $(shellflags) cflags "optimize='$(OPTIMIZE)'" $<
+DTRACEFLAGS = sh $(shellflags) cflags "optimize='$(OPTIMIZE)'" $@
+
CONFIGPM_FROM_CONFIG_SH = lib/Config.pm lib/Config_heavy.pl
CONFIGPM = $(CONFIGPM_FROM_CONFIG_SH) lib/Config_git.pl
@@ -895,19 +897,19 @@ $(DTRACE_MINI_O): perldtrace.d $(miniperl_objs_nodt)
-rm -rf mpdtrace
mkdir mpdtrace
cp $(miniperl_objs_nodt) mpdtrace/
- $(DTRACE) -G -s perldtrace.d -o $(DTRACE_MINI_O) $(miniperl_dtrace_objs)
+ CFLAGS="`$(DTRACEFLAGS)`" $(DTRACE) -G -s perldtrace.d -o $(DTRACE_MINI_O) $(miniperl_dtrace_objs)
$(DTRACE_PERLLIB_O): perldtrace.d $(perllib_objs_nodt)
-rm -rf libpdtrace
mkdir libpdtrace
cp $(perllib_objs_nodt) libpdtrace/
- $(DTRACE) -G -s perldtrace.d -o $(DTRACE_PERLLIB_O) $(perllib_dtrace_objs)
+ CFLAGS="`$(DTRACEFLAGS)`" $(DTRACE) -G -s perldtrace.d -o $(DTRACE_PERLLIB_O) $(perllib_dtrace_objs)
$(DTRACE_MAIN_O): perldtrace.d perlmain$(OBJ_EXT)
-rm -rf maindtrace
mkdir maindtrace
cp perlmain$(OBJ_EXT) maindtrace/
- $(DTRACE) -G -s perldtrace.d -o $(DTRACE_MAIN_O) $(perlmain_dtrace_objs) || \
+ CFLAGS="`$(DTRACEFLAGS)`" $(DTRACE) -G -s perldtrace.d -o $(DTRACE_MAIN_O) $(perlmain_dtrace_objs) || \
( $(ECHO) "No probes in perlmain$(OBJ_EXT), generating a dummy $(DTRACE_MAIN_O)" && \
$(ECHO) >dtrace_main.c && \
`$(CCCMD)` $(PLDLFLAGS) dtrace_main.c && \
diff --git a/cflags.SH b/cflags.SH
index 3af1e97..b845127 100755
--- a/cflags.SH
+++ b/cflags.SH
@@ -519,7 +519,10 @@ for file do
toke) optimize=-O0 ;;
esac
- echo "$cc -c -DPERL_CORE $ccflags $stdflags $optimize $warn $extra"
+ case "$file" in
+ dtrace_*) echo "$ccflags $stdflags $optimize $warn $extra";;
+ *) echo "$cc -c -DPERL_CORE $ccflags $stdflags $optimize $warn $extra";;
+ esac
. $TOP/config.sh
--
2.17.1

389
perl-5.30.0-PATCH-perl-134329-Use-after-free-in-regcomp.c.patch Normal file
View File

@ -0,0 +1,389 @@
From fd30a7c49a661aecfb361045646da264cdadea8f Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Fri, 23 Aug 2019 12:40:24 -0600
Subject: [PATCH] PATCH: [perl #134329] Use after free in regcomp.c
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
A compiled regex is composed of nodes, forming a linked list, with
normally a maximum of 16 bits used to specify the offset of the next
link. For patterns that require more space than this, the nodes that
jump around are replaced with ones that have wider offsets. Most nodes
are unaffected, as they just contain the offset of the next node, and
that number is always small. The jump nodes are the ones affected.
When compiling a pattern, the 16 bit mechanism is used, until it
overflows, at which point the pattern is recompiled with the long jumps
instead.
When I rewrote the compiler last year to make it generally one pass, I
noticed a lot of the cases where a node was added didn't check if the
result overflowed (the function that does this returns FALSE in that
case). I presumed the prior authors knew better, and did not change
things, except to put in a bogus value in the link (offset) field that
should cause a crash if it were used. That's what's happening in this
ticket.
But seeing this example, it's clear that the return value should be
checked every time, because you can reach the limit at any time. This
commit changes to do that, and to require the function's return value to
not be ignored, to guard against future changes.
My guess is that the reason it generally worked when there were multiple
passes is that the first pass didn't do anything except count space, and
that at some point before the end of the pass the return value did get
checked, so by the time the nodes were allocated for real, it knew
enough to use the long jumps.
Petr Písař: Ported to 5.30.0 from
3b2e5620ed4a6b341f97ffd1d4b6466cc2c4bc5b.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
MANIFEST | 1 +
embed.fnc | 4 +-
proto.h | 8 ++-
regcomp.c | 109 ++++++++++++++++++++++++++++-----------
t/re/bigfuzzy_not_utf8.t | Bin 0 -> 36399 bytes
5 files changed, 88 insertions(+), 34 deletions(-)
create mode 100644 t/re/bigfuzzy_not_utf8.t
diff --git a/MANIFEST b/MANIFEST
index 10e2cc0..cc24cd7 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5839,6 +5839,7 @@ t/porting/test_bootstrap.t Test that the instructions for test bootstrapping are
t/porting/utils.t Check that utility scripts still compile
t/re/alpha_assertions.t See if things like '(*postive_lookahed:...) work properly
t/re/anyof.t See if bracketed char classes [...] compile properly
+t/re/bigfuzzy_not_utf8.t Big and ugly tests not storable as UTF-8
t/re/charset.t See if regex modifiers like /d, /u work properly
t/re/fold_grind.pl Core file to see if regex case folding works properly
t/re/fold_grind_8.t Wrapper for fold_grind.pl for /l testing with a UTF-8 locale
diff --git a/embed.fnc b/embed.fnc
index c977d39..c2c5f16 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -2427,7 +2427,7 @@ Es |void |reginsert |NN RExC_state_t *pRExC_state \
|const U8 op \
|const regnode_offset operand \
|const U32 depth
-Es |bool |regtail |NN RExC_state_t * pRExC_state \
+EsR |bool |regtail |NN RExC_state_t * pRExC_state \
|NN const regnode_offset p \
|NN const regnode_offset val \
|const U32 depth
@@ -2561,7 +2561,7 @@ Es |void |dump_trie_interim_list|NN const struct _reg_trie_data *trie\
Es |void |dump_trie_interim_table|NN const struct _reg_trie_data *trie\
|NULLOK HV* widecharmap|NN AV *revcharmap\
|U32 next_alloc|U32 depth
-Es |bool |regtail_study |NN RExC_state_t *pRExC_state \
+EsR |bool |regtail_study |NN RExC_state_t *pRExC_state \
|NN regnode_offset p|NN const regnode_offset val|U32 depth
# endif
#endif
diff --git a/proto.h b/proto.h
index e0ea55b..2ef7ce2 100644
--- a/proto.h
+++ b/proto.h
@@ -4457,9 +4457,11 @@ PERL_CALLCONV int Perl_re_indentf(pTHX_ const char *fmt, U32 depth, ...);
assert(fmt)
STATIC void S_regdump_extflags(pTHX_ const char *lead, const U32 flags);
STATIC void S_regdump_intflags(pTHX_ const char *lead, const U32 flags);
-STATIC bool S_regtail_study(pTHX_ RExC_state_t *pRExC_state, regnode_offset p, const regnode_offset val, U32 depth);
+STATIC bool S_regtail_study(pTHX_ RExC_state_t *pRExC_state, regnode_offset p, const regnode_offset val, U32 depth)
+ __attribute__warn_unused_result__;
#define PERL_ARGS_ASSERT_REGTAIL_STUDY \
assert(pRExC_state); assert(p); assert(val)
+
# endif
# if defined(PERL_IN_REGEXEC_C)
STATIC void S_debug_start_match(pTHX_ const REGEXP *prog, const bool do_utf8, const char *start, const char *end, const char *blurb);
@@ -5599,9 +5601,11 @@ STATIC regnode_offset S_regnode_guts(pTHX_ RExC_state_t *pRExC_state, const U8 o
STATIC regnode_offset S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth);
#define PERL_ARGS_ASSERT_REGPIECE \
assert(pRExC_state); assert(flagp)
-STATIC bool S_regtail(pTHX_ RExC_state_t * pRExC_state, const regnode_offset p, const regnode_offset val, const U32 depth);
+STATIC bool S_regtail(pTHX_ RExC_state_t * pRExC_state, const regnode_offset p, const regnode_offset val, const U32 depth)
+ __attribute__warn_unused_result__;
#define PERL_ARGS_ASSERT_REGTAIL \
assert(pRExC_state); assert(p); assert(val)
+
STATIC void S_scan_commit(pTHX_ const RExC_state_t *pRExC_state, struct scan_data_t *data, SSize_t *minlenp, int is_inf);
#define PERL_ARGS_ASSERT_SCAN_COMMIT \
assert(pRExC_state); assert(data); assert(minlenp)
diff --git a/regcomp.c b/regcomp.c
index dfc22bc..b93fbe7 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -11307,10 +11307,15 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth)
return 0;
}
- REGTAIL(pRExC_state, ret, atomic);
+ if (! REGTAIL(pRExC_state, ret, atomic)) {
+ REQUIRE_BRANCHJ(flagp, 0);
+ }
- REGTAIL(pRExC_state, atomic,
- reg_node(pRExC_state, SRCLOSE));
+ if (! REGTAIL(pRExC_state, atomic, reg_node(pRExC_state,
+ SRCLOSE)))
+ {
+ REQUIRE_BRANCHJ(flagp, 0);
+ }
RExC_in_script_run = 0;
return ret;
@@ -11769,7 +11774,9 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth)
RExC_flags & RXf_PMf_COMPILETIME
);
FLAGS(REGNODE_p(ret)) = 2;
- REGTAIL(pRExC_state, ret, eval);
+ if (! REGTAIL(pRExC_state, ret, eval)) {
+ REQUIRE_BRANCHJ(flagp, 0);
+ }
/* deal with the length of this later - MJD */
return ret;
}
@@ -11822,7 +11829,9 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth)
tail = reg(pRExC_state, 1, &flag, depth+1);
RETURN_FAIL_ON_RESTART(flag, flagp);
- REGTAIL(pRExC_state, ret, tail);
+ if (! REGTAIL(pRExC_state, ret, tail)) {
+ REQUIRE_BRANCHJ(flagp, 0);
+ }
goto insert_if;
}
else if ( RExC_parse[0] == '<' /* (?(<NAME>)...) */
@@ -11914,15 +11923,22 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth)
}
nextchar(pRExC_state);
insert_if:
- REGTAIL(pRExC_state, ret, reganode(pRExC_state, IFTHEN, 0));
+ if (! REGTAIL(pRExC_state, ret, reganode(pRExC_state,
+ IFTHEN, 0)))
+ {
+ REQUIRE_BRANCHJ(flagp, 0);
+ }
br = regbranch(pRExC_state, &flags, 1, depth+1);
if (br == 0) {
RETURN_FAIL_ON_RESTART(flags,flagp);
FAIL2("panic: regbranch returned failure, flags=%#" UVxf,
(UV) flags);
} else
- REGTAIL(pRExC_state, br, reganode(pRExC_state,
- LONGJMP, 0));
+ if (! REGTAIL(pRExC_state, br, reganode(pRExC_state,
+ LONGJMP, 0)))
+ {
+ REQUIRE_BRANCHJ(flagp, 0);
+ }
c = UCHARAT(RExC_parse);
nextchar(pRExC_state);
if (flags&HASWIDTH)
@@ -11939,7 +11955,9 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth)
FAIL2("panic: regbranch returned failure, flags=%#" UVxf,
(UV) flags);
}
- REGTAIL(pRExC_state, ret, lastbr);
+ if (! REGTAIL(pRExC_state, ret, lastbr)) {
+ REQUIRE_BRANCHJ(flagp, 0);
+ }
if (flags&HASWIDTH)
*flagp |= HASWIDTH;
c = UCHARAT(RExC_parse);
@@ -11954,16 +11972,26 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth)
vFAIL("Switch (?(condition)... contains too many branches");
}
ender = reg_node(pRExC_state, TAIL);
- REGTAIL(pRExC_state, br, ender);
+ if (! REGTAIL(pRExC_state, br, ender)) {
+ REQUIRE_BRANCHJ(flagp, 0);
+ }
if (lastbr) {
- REGTAIL(pRExC_state, lastbr, ender);
- REGTAIL(pRExC_state, REGNODE_OFFSET(
- NEXTOPER(
- NEXTOPER(REGNODE_p(lastbr)))),
- ender);
+ if (! REGTAIL(pRExC_state, lastbr, ender)) {
+ REQUIRE_BRANCHJ(flagp, 0);
+ }
+ if (! REGTAIL(pRExC_state,
+ REGNODE_OFFSET(
+ NEXTOPER(
+ NEXTOPER(REGNODE_p(lastbr)))),
+ ender))
+ {
+ REQUIRE_BRANCHJ(flagp, 0);
+ }
}
else
- REGTAIL(pRExC_state, ret, ender);
+ if (! REGTAIL(pRExC_state, ret, ender)) {
+ REQUIRE_BRANCHJ(flagp, 0);
+ }
#if 0 /* Removing this doesn't cause failures in the test suite -- khw */
RExC_size++; /* XXX WHY do we need this?!!
For large programs it seems to be required
@@ -12113,7 +12141,9 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth)
*flagp |= flags&SIMPLE;
}
if (is_open) { /* Starts with OPEN. */
- REGTAIL(pRExC_state, ret, br); /* OPEN -> first. */
+ if (! REGTAIL(pRExC_state, ret, br)) { /* OPEN -> first. */
+ REQUIRE_BRANCHJ(flagp, 0);
+ }
}
else if (paren != '?') /* Not Conditional */
ret = br;
@@ -12121,12 +12151,15 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth)
lastbr = br;
while (*RExC_parse == '|') {
if (RExC_use_BRANCHJ) {
+ bool shut_gcc_up;
+
ender = reganode(pRExC_state, LONGJMP, 0);
/* Append to the previous. */
- REGTAIL(pRExC_state,
- REGNODE_OFFSET(NEXTOPER(NEXTOPER(REGNODE_p(lastbr)))),
- ender);
+ shut_gcc_up = REGTAIL(pRExC_state,
+ REGNODE_OFFSET(NEXTOPER(NEXTOPER(REGNODE_p(lastbr)))),
+ ender);
+ PERL_UNUSED_VAR(shut_gcc_up);
}
nextchar(pRExC_state);
if (freeze_paren) {
@@ -12237,9 +12270,10 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth)
is_nothing= 0;
}
else if (op == BRANCHJ) {
- REGTAIL_STUDY(pRExC_state,
- REGNODE_OFFSET(NEXTOPER(NEXTOPER(br))),
- ender);
+ bool shut_gcc_up = REGTAIL_STUDY(pRExC_state,
+ REGNODE_OFFSET(NEXTOPER(NEXTOPER(br))),
+ ender);
+ PERL_UNUSED_VAR(shut_gcc_up);
/* for now we always disable this optimisation * /
if ( OP(NEXTOPER(NEXTOPER(br))) != NOTHING
|| regnext(NEXTOPER(NEXTOPER(br))) != REGNODE_p(ender))
@@ -12551,7 +12585,9 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
const regnode_offset w = reg_node(pRExC_state, WHILEM);
FLAGS(REGNODE_p(w)) = 0;
- REGTAIL(pRExC_state, ret, w);
+ if (! REGTAIL(pRExC_state, ret, w)) {
+ REQUIRE_BRANCHJ(flagp, 0);
+ }
if (RExC_use_BRANCHJ) {
reginsert(pRExC_state, LONGJMP, ret, depth+1);
reginsert(pRExC_state, NOTHING, ret, depth+1);
@@ -12566,7 +12602,11 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
if (RExC_use_BRANCHJ)
NEXT_OFF(REGNODE_p(ret)) = 3; /* Go over NOTHING to
LONGJMP. */
- REGTAIL(pRExC_state, ret, reg_node(pRExC_state, NOTHING));
+ if (! REGTAIL(pRExC_state, ret, reg_node(pRExC_state,
+ NOTHING)))
+ {
+ REQUIRE_BRANCHJ(flagp, 0);
+ }
RExC_whilem_seen++;
MARK_NAUGHTY_EXP(1, 4); /* compound interest */
}
@@ -12638,16 +12678,22 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
if (*RExC_parse == '?') {
nextchar(pRExC_state);
reginsert(pRExC_state, MINMOD, ret, depth+1);
- REGTAIL(pRExC_state, ret, ret + NODE_STEP_REGNODE);
+ if (! REGTAIL(pRExC_state, ret, ret + NODE_STEP_REGNODE)) {
+ REQUIRE_BRANCHJ(flagp, 0);
+ }
}
else if (*RExC_parse == '+') {
regnode_offset ender;
nextchar(pRExC_state);
ender = reg_node(pRExC_state, SUCCEED);
- REGTAIL(pRExC_state, ret, ender);
+ if (! REGTAIL(pRExC_state, ret, ender)) {
+ REQUIRE_BRANCHJ(flagp, 0);
+ }
reginsert(pRExC_state, SUSPEND, ret, depth+1);
ender = reg_node(pRExC_state, TAIL);
- REGTAIL(pRExC_state, ret, ender);
+ if (! REGTAIL(pRExC_state, ret, ender)) {
+ REQUIRE_BRANCHJ(flagp, 0);
+ }
}
if (ISMULT2(RExC_parse)) {
@@ -19815,8 +19861,8 @@ S_regtail(pTHX_ RExC_state_t * pRExC_state,
}
else {
if (val - scan > U16_MAX) {
- /* Since not all callers check the return value, populate this with
- * something that won't loop and will likely lead to a crash if
+ /* Populate this with something that won't loop and will likely
+ * lead to a crash if the caller ignores the failure return, and
* execution continues */
NEXT_OFF(REGNODE_p(scan)) = U16_MAX;
return FALSE;
@@ -19927,6 +19973,9 @@ S_regtail_study(pTHX_ RExC_state_t *pRExC_state, regnode_offset p,
}
else {
if (val - scan > U16_MAX) {
+ /* Populate this with something that won't loop and will likely
+ * lead to a crash if the caller ignores the failure return, and
+ * execution continues */
NEXT_OFF(REGNODE_p(scan)) = U16_MAX;
return FALSE;
}
diff --git a/t/re/bigfuzzy_not_utf8.t b/t/re/bigfuzzy_not_utf8.t
new file mode 100644
index 0000000000000000000000000000000000000000..b4dfd150a9297172af5d8e7811357fd68931f8d7
GIT binary patch
literal 36399
zcmeI5y>Ht_6u>V)vj`|)bnw`ot)P-@MMCTpNTQ@6nzlsHpvaKGfa6%8#FNC9CKZxu
z;)Jf$YRJ%zoeHDqo_|0?hWr89EXQ;I1&?0XN7}J$MN%l4pVm7V_T9aA@8fqzil1_F
zE|;$}O->{eN&28B=@fnhT2nU|t*9E+ShXPw8fDMw8q;-2Rj9#qL#IYfFlbp&QU)zC
zsvD}tL@Ma?;e+olU(13qL4mf$Xi2KlMpfR-(n>>?sal~`K`RMWM$0up6UqkD^enA1
zg=vB;ZywbQuvXdxGnK~k=b({GBpSNyN0Z7%!KptLG(}RXdLfa}8zrhWl%f+Fv@e<T
z7QF(MZ@%O2{zzXWD3o$dlr)+$QdFwY%c5N?I0B75X-E+19aX7F)dH0^>Z)eEZ=O;~
z<?^<VTwP8TfX(4J=(JPOnNc)URn{G8|1eoC_e<>oje1d1%IQ=tmzSkdDoay2=T|Pz
zo*8+Kr80%Y79{wyR4)RabV^adFWpeZh73a5P-K`EDzb{C0J1N?-Bg5osvt7$#*LDy
z8pU1*;Hb;O`}w=|H2|VCNgvil!C)|-F!4`oOre4(0@l39WM)9+aK3^6G2ryE+cJd2
zG%)O}9%o(Xh5+npOk+9dJvA{f4-S<VFd0eu$X<3dd1d+P^3wIkj=-L!jZMnkKb#l4
zS%FnoE840>Nl&MqX!&&dnrWK5-2KkXUdJ@kJhZYzBs1%)nFU8yw#)YRc86bC;+Jl5
zgy&7Z`^Fw(?OiZUet&)S)$APMGYhtb_713ZrNwu<++Ih39!HYq+wJzw?PH0VT{$4+
zz%lmLw7_MJYpy#@2q4sQ7fUP%j9esxG8j3)cOk6*w(m~R0TQqY5H30#e)2t(Pe1U0
zo7x9RuwyuZKZc9WF8Sr`COoz9_eZT+t&ggp!nq?r$P9^7Qf{`Z-{X`J#)<@xfTsj3
zt7*Z}u%|ZB*f}Q9ILEnRY6A%n(u&6pLLV6Zhn*Je^046bHe3TpU@8gBV?hE)AbtcU
z+*`#j(Lf`1Pqq2ly)J6Thrs2aLgj*Tgns-Zu;!m>A1&i8UmxMd)HGfL@L=Np^}xmu
z6KnnbWTw9d+eiQj_)Fjmf6b$HBoG*ZvmFNFos+;OYFZqXdWnYd{P*jg`)Jij({(%|
z`6Q@2v~b4IiYzkMz+$L)vsWgF{`mxB#u(y$sg7Y3RpU)yZB+QhQ9`d|Ekc6YFM1X7
zv7KL!Yu;A|z5IoJ9um0Yp{;0|@_teFTYTByaiWdaEl<FRQ}wer1&gsF0VEJ%0z*Cq
zPFzulaPT39=F90?E5wAR)%Dpf=7vno3fVuppO8Ro&#5QO7l$E%7!gQ^8*6kwlia=^
z7B0VddLMEq9(*#931rOF{~Aj_u33(iBr5k4z;mpAB2(G^Zz{9Kq>+G^1Vp#S{&b=E
zj|&}JWy0IK6Ap73lq)qn<QR$RqGeqiso;SyjOXJ#2pdfx0VLp>z?y5#A&T&w<H48c
zUiJx|1$vwg0zrO}lpkL`u+~3K_<CVK5ue+x_nNLxR(uXP3g#_eo?nPUW*EaL0(kl}
zicZin*SoHPf#Jg+1F=k5r(avNUv|&?^aT4NA<j}5>#6r1;mt7IkM<dnBRjm-J$jnL
zl=}L=Xoe&f=@$t@+-3rNH|>W2eFfxdF(5w^x}jvkffEfIvgHNTjXV5+K%<*L3ET_R
z+c|c&wLM;PQ@lgr#v_H=NB{{Sfw2f&z<1F4c?Err>gK7){ur^11cD`i`-xzApY~Qf
z-Soco%zKmLS;Xfudc5$tj2??=s^NXSD9!fSp38_*Cb5m>t!bHAQk&zN(xREQTJ4>c
zC4OI8w7BN_>Y<Q`P|Yl)JEqC+?<=onyWQ@36FPXvI!i<{<A|?8t9(>=zWZjEyWg?)
z-~n%be|`1U>>S}U3wvP0@z9kP-|cdH9RYeANt%btP&>Dm_#=s#T{$4+fFnF_9>oX|
zooo&c`N+|sIY^}|4akg;3*^W-WYBK!OJAAU-%N9Mt_49ZzRWCquG}WPRkz@uPUllu
jIzOMKFSg+CqdL=Mn!K`nb$RLf<M~V>L7{9Vwi5pX0LDXb
literal 0
HcmV?d00001
--
2.21.0

75
perl-5.30.0-Remove-undefined-behavior-from-IV-shifting.patch Normal file
View File

@ -0,0 +1,75 @@
From 7e5b390a008ccad094a39c350f385d58e8a5102a Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Fri, 3 May 2019 13:57:47 -0600
Subject: [PATCH] Remove undefined behavior from IV shifting
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
It is undefined behavior to shift a negative integer to the left. This
commit avoids that by treating the value as unsigned, then casting back
to integer for return.
Petr Písař: Ported to 5.30.0 from
814735a391b874af8f00eaf89469e5ec7f38cd4aa.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
asan_ignore | 5 -----
pp.c | 21 ++++++++++++++++++++-
2 files changed, 20 insertions(+), 6 deletions(-)
diff --git a/asan_ignore b/asan_ignore
index e0f5685..f520546 100644
--- a/asan_ignore
+++ b/asan_ignore
@@ -18,11 +18,6 @@
fun:Perl_pp_i_*
-# Perl's << is defined as using the underlying C's << operator, with the
-# same undefined behaviour for shifts greater than the word size.
-# (UVs normally, IVs with 'use integer')
-
-fun:Perl_pp_left_shift
# this function numifies the field width in eg printf "%10f".
# It has its own overflow detection, so don't warn about it
diff --git a/pp.c b/pp.c
index 7afb090..3ca04e1 100644
--- a/pp.c
+++ b/pp.c
@@ -1991,10 +1991,29 @@ static IV S_iv_shift(IV iv, int shift, bool left)
shift = -shift;
left = !left;
}
+
if (UNLIKELY(shift >= IV_BITS)) {
return iv < 0 && !left ? -1 : 0;
}
- return left ? iv << shift : iv >> shift;
+ /* For left shifts, perl 5 has chosen to treat the value as unsigned for
+ * the * purposes of shifting, then cast back to signed. This is very
+ * different from perl 6:
+ *
+ * $ perl6 -e 'say -2 +< 5'
+ * -64
+ *
+ * $ ./perl -le 'print -2 << 5'
+ * 18446744073709551552
+ * */
+ if (left) {
+ if (iv == IV_MIN) { /* Casting this to a UV is undefined behavior */
+ return 0;
+ }
+ return (IV) (((UV) iv) << shift);
+ }
+
+ /* Here is right shift */
+ return iv >> shift;
}
#define UV_LEFT_SHIFT(uv, shift) S_uv_shift(uv, shift, TRUE)
--
2.20.1

191
perl-5.30.0-perl-134221-support-append-mode-for-open-.-undef.patch Normal file
View File

@ -0,0 +1,191 @@
From 8e9cf86aa69cb79c91edf5ff0586f87bfe4c91bd Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 2 Jul 2019 14:16:35 +1000
Subject: [PATCH] (perl #134221) support append mode for open .. undef
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Petr Písař: Ported to 5.30.0 from
45b29440d38be155c5177c8d6f9a5d4e7c2c098c.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
doio.c | 15 +++++++++++++++
embed.fnc | 1 +
perlio.c | 26 +++++++++++++++++++++-----
perlio.h | 3 +++
proto.h | 5 +++++
t/io/perlio_open.t | 14 ++++++++++++--
6 files changed, 57 insertions(+), 7 deletions(-)
diff --git a/doio.c b/doio.c
index 05a0696..424e0e3 100644
--- a/doio.c
+++ b/doio.c
@@ -265,6 +265,21 @@ Perl_my_mkstemp_cloexec(char *templte)
#endif
}
+int
+Perl_my_mkostemp_cloexec(char *templte, int flags)
+{
+ dVAR;
+ PERL_ARGS_ASSERT_MY_MKOSTEMP_CLOEXEC;
+#if defined(O_CLOEXEC)
+ DO_ONEOPEN_EXPERIMENTING_CLOEXEC(
+ PL_strategy_mkstemp,
+ Perl_my_mkostemp(templte, flags | O_CLOEXEC),
+ Perl_my_mkostemp(templte, flags));
+#else
+ DO_ONEOPEN_THEN_CLOEXEC(Perl_my_mkostemp(templte, flags));
+#endif
+}
+
#ifdef HAS_PIPE
int
Perl_PerlProc_pipe_cloexec(pTHX_ int *pipefd)
diff --git a/embed.fnc b/embed.fnc
index 259affd..c977d39 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -476,6 +476,7 @@ p |int |PerlLIO_dup2_cloexec|int oldfd|int newfd
pR |int |PerlLIO_open_cloexec|NN const char *file|int flag
pR |int |PerlLIO_open3_cloexec|NN const char *file|int flag|int perm
pnoR |int |my_mkstemp_cloexec|NN char *templte
+pnoR |int |my_mkostemp_cloexec|NN char *templte|int flags
#ifdef HAS_PIPE
pR |int |PerlProc_pipe_cloexec|NN int *pipefd
#endif
diff --git a/perlio.c b/perlio.c
index 904d47a..5a0cd36 100644
--- a/perlio.c
+++ b/perlio.c
@@ -1490,7 +1490,9 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
int imode, int perm, PerlIO *f, int narg, SV **args)
{
if (!f && narg == 1 && *args == &PL_sv_undef) {
- if ((f = PerlIO_tmpfile())) {
+ int imode = PerlIOUnix_oflags(mode);
+
+ if (imode != -1 && (f = PerlIO_tmpfile_flags(imode))) {
if (!layers || !*layers)
layers = Perl_PerlIO_context_layers(aTHX_ mode);
if (layers && *layers)
@@ -5048,6 +5050,15 @@ PerlIO_stdoutf(const char *fmt, ...)
#undef PerlIO_tmpfile
PerlIO *
PerlIO_tmpfile(void)
+{
+ return PerlIO_tmpfile_flags(0);
+}
+
+#define MKOSTEMP_MODES ( O_RDWR | O_CREAT | O_EXCL )
+#define MKOSTEMP_MODE_MASK ( O_ACCMODE | O_CREAT | O_EXCL | O_TRUNC )
+
+PerlIO *
+PerlIO_tmpfile_flags(int imode)
{
#ifndef WIN32
dTHX;
@@ -5063,27 +5074,32 @@ PerlIO_tmpfile(void)
const char * const tmpdir = TAINTING_get ? NULL : PerlEnv_getenv("TMPDIR");
SV * sv = NULL;
int old_umask = umask(0177);
+ imode &= ~MKOSTEMP_MODE_MASK;
if (tmpdir && *tmpdir) {
/* if TMPDIR is set and not empty, we try that first */
sv = newSVpv(tmpdir, 0);
sv_catpv(sv, tempname + 4);
- fd = Perl_my_mkstemp_cloexec(SvPVX(sv));
+ fd = Perl_my_mkostemp_cloexec(SvPVX(sv), imode);
}
if (fd < 0) {
SvREFCNT_dec(sv);
sv = NULL;
/* else we try /tmp */
- fd = Perl_my_mkstemp_cloexec(tempname);
+ fd = Perl_my_mkostemp_cloexec(tempname, imode);
}
if (fd < 0) {
/* Try cwd */
sv = newSVpvs(".");
sv_catpv(sv, tempname + 4);
- fd = Perl_my_mkstemp_cloexec(SvPVX(sv));
+ fd = Perl_my_mkostemp_cloexec(SvPVX(sv), imode);
}
umask(old_umask);
if (fd >= 0) {
- f = PerlIO_fdopen(fd, "w+");
+ /* fdopen() with a numeric mode */
+ char mode[8];
+ int writing = 1;
+ (void)PerlIO_intmode2str(imode | MKOSTEMP_MODES, mode, &writing);
+ f = PerlIO_fdopen(fd, mode);
if (f)
PerlIOBase(f)->flags |= PERLIO_F_TEMP;
PerlLIO_unlink(sv ? SvPVX_const(sv) : tempname);
diff --git a/perlio.h b/perlio.h
index d515020..ee16ab8 100644
--- a/perlio.h
+++ b/perlio.h
@@ -286,6 +286,9 @@ PERL_CALLCONV SSize_t PerlIO_get_bufsiz(PerlIO *);
#ifndef PerlIO_tmpfile
PERL_CALLCONV PerlIO *PerlIO_tmpfile(void);
#endif
+#ifndef PerlIO_tmpfile_flags
+PERL_CALLCONV PerlIO *PerlIO_tmpfile_flags(int flags);
+#endif
#ifndef PerlIO_stdin
PERL_CALLCONV PerlIO *PerlIO_stdin(void);
#endif
diff --git a/proto.h b/proto.h
index 74a8e46..e0ea55b 100644
--- a/proto.h
+++ b/proto.h
@@ -2270,6 +2270,11 @@ PERL_CALLCONV Pid_t Perl_my_fork(void);
PERL_CALLCONV I32 Perl_my_lstat(pTHX);
#endif
PERL_CALLCONV I32 Perl_my_lstat_flags(pTHX_ const U32 flags);
+PERL_CALLCONV int Perl_my_mkostemp_cloexec(char *templte, int flags)
+ __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_MY_MKOSTEMP_CLOEXEC \
+ assert(templte)
+
PERL_CALLCONV int Perl_my_mkstemp_cloexec(char *templte)
__attribute__warn_unused_result__;
#define PERL_ARGS_ASSERT_MY_MKSTEMP_CLOEXEC \
diff --git a/t/io/perlio_open.t b/t/io/perlio_open.t
index 99d7e51..56c354b 100644
--- a/t/io/perlio_open.t
+++ b/t/io/perlio_open.t
@@ -11,7 +11,7 @@ BEGIN {
use strict;
use warnings;
-plan tests => 6;
+plan tests => 10;
use Fcntl qw(:seek);
@@ -31,6 +31,16 @@ use Fcntl qw(:seek);
is($data, "the right read stuff", "found the right stuff");
}
-
+SKIP:
+{
+ ok((open my $fh, "+>>", undef), "open my \$fh, '+>>', undef")
+ or skip "can't open temp for append: $!", 3;
+ print $fh "abc";
+ ok(seek($fh, 0, SEEK_SET), "seek to zero");
+ print $fh "xyz";
+ ok(seek($fh, 0, SEEK_SET), "seek to zero again");
+ my $data = <$fh>;
+ is($data, "abcxyz", "check the second write appended");
+}
--
2.20.1

102
perl-5.30.0-perl-134266-make-sure-is-writable-when-we-write-to-i.patch Normal file
View File

@ -0,0 +1,102 @@
From 3f8dbf40138bd2bcb569b23c88888a41ede9c355 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 5 Aug 2019 15:23:45 +1000
Subject: [PATCH] (perl #134266) make sure $@ is writable when we write to it
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
when unwinding.
Since except_sv might be ERRSV we try to preserve it's value,
if not the actual SV (which we have an extra refcount on if it is
except_sv).
Petr Písař: Ported to 5.30.0 from
933e3e630076d4fdbe32a101eeb5f12e37ec4ac2.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
perl.h | 17 +++++++++++++++++
pp_ctl.c | 10 ++++++++--
t/lib/croak/pp_ctl | 8 ++++++++
3 files changed, 33 insertions(+), 2 deletions(-)
diff --git a/perl.h b/perl.h
index e5a5585..383487c 100644
--- a/perl.h
+++ b/perl.h
@@ -1357,6 +1357,23 @@ EXTERN_C char *crypt(const char *, const char *);
} \
} STMT_END
+/* contains inlined gv_add_by_type */
+#define SANE_ERRSV() STMT_START { \
+ SV ** const svp = &GvSV(PL_errgv); \
+ if (!*svp) { \
+ *svp = newSVpvs(""); \
+ } else if (SvREADONLY(*svp)) { \
+ SV *dupsv = newSVsv(*svp); \
+ SvREFCNT_dec_NN(*svp); \
+ *svp = dupsv; \
+ } else { \
+ SV *const errsv = *svp; \
+ if (SvMAGICAL(errsv)) { \
+ mg_free(errsv); \
+ } \
+ } \
+ } STMT_END
+
#ifdef PERL_CORE
# define DEFSV (0 + GvSVn(PL_defgv))
diff --git a/pp_ctl.c b/pp_ctl.c
index a38b9c1..1f2d812 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1720,9 +1720,13 @@ Perl_die_unwind(pTHX_ SV *msv)
* perls 5.13.{1..7} which had late setting of $@ without this
* early-setting hack.
*/
- if (!(in_eval & EVAL_KEEPERR))
+ if (!(in_eval & EVAL_KEEPERR)) {
+ /* remove any read-only/magic from the SV, so we don't
+ get infinite recursion when setting ERRSV */
+ SANE_ERRSV();
sv_setsv_flags(ERRSV, exceptsv,
(SV_GMAGIC|SV_DO_COW_SVSETSV|SV_NOSTEAL));
+ }
if (in_eval & EVAL_KEEPERR) {
Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "\t(in cleanup) %" SVf,
@@ -1784,8 +1788,10 @@ Perl_die_unwind(pTHX_ SV *msv)
*/
S_pop_eval_context_maybe_croak(aTHX_ cx, exceptsv, 2);
- if (!(in_eval & EVAL_KEEPERR))
+ if (!(in_eval & EVAL_KEEPERR)) {
+ SANE_ERRSV();
sv_setsv(ERRSV, exceptsv);
+ }
PL_restartjmpenv = restartjmpenv;
PL_restartop = restartop;
JMPENV_JUMP(3);
diff --git a/t/lib/croak/pp_ctl b/t/lib/croak/pp_ctl
index b1e754c..de0221b 100644
--- a/t/lib/croak/pp_ctl
+++ b/t/lib/croak/pp_ctl
@@ -51,3 +51,11 @@ use 5.01;
default{}
EXPECT
Can't "default" outside a topicalizer at - line 2.
+########
+# NAME croak with read only $@
+eval '"a" =~ /${*@=\_})/';
+die;
+# this would previously recurse infinitely in the eval
+EXPECT
+Unmatched ) in regex; marked by <-- HERE in m/_) <-- HERE / at (eval 1) line 1.
+ ...propagated at - line 2.
--
2.21.0

42
perl-5.30.0-pp.c-Add-two-UNLIKELY-s.patch Normal file
View File

@ -0,0 +1,42 @@
From 4f0ded009bf6de2da6a2a2022bec03576dcb80ca Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Wed, 1 May 2019 10:41:38 -0600
Subject: [PATCH] pp.c: Add two UNLIKELY()s
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
It should be uncommon to shift beyond a full word
Signed-off-by: Ported to 5.30.0 from
bae047b68c92622bb4bb04499e36cdaa48138909.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
pp.c | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/pp.c b/pp.c
index 90db3a0..7afb090 100644
--- a/pp.c
+++ b/pp.c
@@ -1979,7 +1979,7 @@ static UV S_uv_shift(UV uv, int shift, bool left)
shift = -shift;
left = !left;
}
- if (shift >= IV_BITS) {
+ if (UNLIKELY(shift >= IV_BITS)) {
return 0;
}
return left ? uv << shift : uv >> shift;
@@ -1991,7 +1991,7 @@ static IV S_iv_shift(IV iv, int shift, bool left)
shift = -shift;
left = !left;
}
- if (shift >= IV_BITS) {
+ if (UNLIKELY(shift >= IV_BITS)) {
return iv < 0 && !left ? -1 : 0;
}
return left ? iv << shift : iv >> shift;
--
2.20.1

47
perl-5.30.1-handle-s-being-updated-without-len-being-updated.patch Normal file
View File

@ -0,0 +1,47 @@
From a0148bb8496444302b087bc0ffcf8dad42f8e475 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 11 Nov 2019 14:43:42 +1100
Subject: [PATCH] handle s being updated without len being updated
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
fix #17279
Petr Písař: Ported to 5.30.1 from
e56dfd967ce460481a9922d14e931b438548093d.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
numeric.c | 2 +-
t/lib/croak/regcomp | 4 ++++
2 files changed, 5 insertions(+), 1 deletion(-)
diff --git a/numeric.c b/numeric.c
index d6ce53e..35adebe 100644
--- a/numeric.c
+++ b/numeric.c
@@ -1552,7 +1552,7 @@ Perl_my_atof3(pTHX_ const char* orig, NV* value, const STRLEN len)
/* strtold() accepts 0x-prefixed hex and in POSIX implementations,
0b-prefixed binary numbers, which is backward incompatible
*/
- if ((len == 0 || len >= 2) && *s == '0' &&
+ if ((len == 0 || len - (s-orig) >= 2) && *s == '0' &&
(isALPHA_FOLD_EQ(s[1], 'x') || isALPHA_FOLD_EQ(s[1], 'b'))) {
*value = 0;
return (char *)s+1;
diff --git a/t/lib/croak/regcomp b/t/lib/croak/regcomp
index 0ba705e..c0c2710 100644
--- a/t/lib/croak/regcomp
+++ b/t/lib/croak/regcomp
@@ -70,3 +70,7 @@ qr/((a))/;
EXPECT
Too many nested open parens in regex; marked by <-- HERE in m/(( <-- HERE a))/ at - line 3.
########
+# NAME numeric parsing buffer overflow in numeric.c
+0=~/\p{nV:-0}/
+EXPECT
+Can't find Unicode property definition "nV:-0" in regex; marked by <-- HERE in m/\p{nV:-0} <-- HERE / at - line 1.
--
2.21.0

116
perl-5.30.1-perl-125557-correctly-handle-overload-for-bin-oct-fl.patch Normal file
View File

@ -0,0 +1,116 @@
From b061e315b4eac4d82edb3ca14581805417a68936 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 11 Sep 2019 11:50:23 +1000
Subject: [PATCH] (perl #125557) correctly handle overload for bin/oct floats
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
The hexfp code doesn't check that the shift is 4, and so also
accepts binary and octal fp numbers.
Unfortunately the call to S_new_constant() always passed a prefix
of 0x, so overloading would be trying to parse the wrong number.
Another option is to simply allow only hex floats, though some work
was done in 131894 to improve oct/bin float support.
Petr Písař: Ported to 5.30.1 from
2cb5a7e8af11acb0eca22421ec5a4df7ef18e2a9.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
t/op/hexfp.t | 16 +++++++++++++++-
toke.c | 21 ++++++++++++++++-----
2 files changed, 31 insertions(+), 6 deletions(-)
diff --git a/t/op/hexfp.t b/t/op/hexfp.t
index 64f8136..0f239d4 100644
--- a/t/op/hexfp.t
+++ b/t/op/hexfp.t
@@ -10,7 +10,7 @@ use strict;
use Config;
-plan(tests => 123);
+plan(tests => 125);
# Test hexfloat literals.
@@ -277,6 +277,20 @@ is(0b1p0, 1);
is(0b10p0, 2);
is(0b1.1p0, 1.5);
+# previously these would pass "0x..." to the overload instead of the appropriate
+# "0b" or "0" prefix.
+fresh_perl_is(<<'CODE', "1", {}, "overload binary fp");
+use overload;
+BEGIN { overload::constant float => sub { return eval $_[0]; }; }
+print 0b0.1p1;
+CODE
+
+fresh_perl_is(<<'CODE', "1", {}, "overload octal fp");
+use overload;
+BEGIN { overload::constant float => sub { return eval $_[0]; }; }
+print 00.1p3;
+CODE
+
# sprintf %a/%A testing is done in sprintf2.t,
# trickier than necessary because of long doubles,
# and because looseness of the spec.
diff --git a/toke.c b/toke.c
index 03c4f2b..3fa20dc 100644
--- a/toke.c
+++ b/toke.c
@@ -10966,6 +10966,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
const char *lastub = NULL; /* position of last underbar */
static const char* const number_too_long = "Number too long";
bool warned_about_underscore = 0;
+ I32 shift; /* shift per digit for hex/oct/bin, hoisted here for fp */
#define WARN_ABOUT_UNDERSCORE() \
do { \
if (!warned_about_underscore) { \
@@ -11012,8 +11013,6 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
{
/* variables:
u holds the "number so far"
- shift the power of 2 of the base
- (hex == 4, octal == 3, binary == 1)
overflowed was the number more than we can hold?
Shift is used when we add a digit. It also serves as an "are
@@ -11022,7 +11021,6 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
*/
NV n = 0.0;
UV u = 0;
- I32 shift;
bool overflowed = FALSE;
bool just_zero = TRUE; /* just plain 0 or binary number? */
static const NV nvshift[5] = { 1.0, 2.0, 4.0, 8.0, 16.0 };
@@ -11369,8 +11367,21 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
if (hexfp) {
floatit = TRUE;
*d++ = '0';
- *d++ = 'x';
- s = start + 2;
+ switch (shift) {
+ case 4:
+ *d++ = 'x';
+ s = start + 2;
+ break;
+ case 3:
+ s = start + 1;
+ break;
+ case 1:
+ *d++ = 'b';
+ s = start + 2;
+ break;
+ default:
+ NOT_REACHED; /* NOTREACHED */
+ }
}
/* read next group of digits and _ and copy into d */
--
2.21.0

39
perl-5.30.2-regcomp-use-long-jumps-if-there-is-any-possibility-o.patch Normal file
View File

@ -0,0 +1,39 @@
From 3295b48defa0f8570114877b063fe546dd348b3c Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Thu, 20 Feb 2020 17:49:36 +0000
Subject: [PATCH 2/2] regcomp: use long jumps if there is any possibility of
overflow
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
(CVE-2020-10878) Be conservative for backporting, we'll aim to do
something more aggressive for bleadperl.
(cherry picked from commit 9d7759db46f3b31b1d3f79c44266b6ba42a47fc6)
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
regcomp.c | 7 +++++++
1 file changed, 7 insertions(+)
diff --git a/regcomp.c b/regcomp.c
index 4ba2980db6..73c35a6702 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -7762,6 +7762,13 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
/* We have that number in RExC_npar */
RExC_total_parens = RExC_npar;
+
+ /* XXX For backporting, use long jumps if there is any possibility of
+ * overflow */
+ if (RExC_size > U16_MAX && ! RExC_use_BRANCHJ) {
+ RExC_use_BRANCHJ = TRUE;
+ flags |= RESTART_PARSE;
+ }
}
else if (! MUST_RESTART(flags)) {
ReREFCNT_dec(Rx);
--
2.25.4

39
perl-5.30.2-regcomp.c-Prevent-integer-overflow-from-nested-regex.patch Normal file
View File

@ -0,0 +1,39 @@
From 897d1f7fd515b828e4b198d8b8bef76c6faf03ed Mon Sep 17 00:00:00 2001
From: John Lightsey <jd@cpanel.net>
Date: Wed, 20 Nov 2019 20:02:45 -0600
Subject: [PATCH] regcomp.c: Prevent integer overflow from nested regex
quantifiers.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
(CVE-2020-10543) On 32bit systems the size calculations for nested regular
expression quantifiers could overflow causing heap memory corruption.
Fixes: Perl/perl5-security#125
(cherry picked from commit bfd31397db5dc1a5c5d3e0a1f753a4f89a736e71)
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
regcomp.c | 6 ++++++
1 file changed, 6 insertions(+)
diff --git a/regcomp.c b/regcomp.c
index 93c8d98fbb..5f86be8086 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -5489,6 +5489,12 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
RExC_precomp)));
}
+ if ( ( minnext > 0 && mincount >= SSize_t_MAX / minnext )
+ || min >= SSize_t_MAX - minnext * mincount )
+ {
+ FAIL("Regexp out of space");
+ }
+
min += minnext * mincount;
is_inf_internal |= deltanext == SSize_t_MAX
|| (maxcount == REG_INFTY && minnext + deltanext > 0);
--
2.25.4

155
perl-5.30.2-study_chunk-extract-rck_elide_nothing.patch Normal file
View File

@ -0,0 +1,155 @@
From 0a320d753fe7fca03df259a4dfd8e641e51edaa8 Mon Sep 17 00:00:00 2001
From: Hugo van der Sanden <hv@crypt.org>
Date: Tue, 18 Feb 2020 13:51:16 +0000
Subject: [PATCH 1/2] study_chunk: extract rck_elide_nothing
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
(CVE-2020-10878)
(cherry picked from commit 93dee06613d4e1428fb10905ce1c3c96f53113dc)
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
embed.fnc | 1 +
embed.h | 1 +
proto.h | 3 +++
regcomp.c | 70 ++++++++++++++++++++++++++++++++++---------------------
4 files changed, 48 insertions(+), 27 deletions(-)
diff --git a/embed.fnc b/embed.fnc
index aedb4baef1..d7cd04d3fc 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -2481,6 +2481,7 @@ Es |SSize_t|study_chunk |NN RExC_state_t *pRExC_state \
|I32 stopparen|U32 recursed_depth \
|NULLOK regnode_ssc *and_withp \
|U32 flags|U32 depth
+Es |void |rck_elide_nothing|NN regnode *node
EsR |SV * |get_ANYOFM_contents|NN const regnode * n
EsRn |U32 |add_data |NN RExC_state_t* const pRExC_state \
|NN const char* const s|const U32 n
diff --git a/embed.h b/embed.h
index 75c91f77f4..356a8b98d9 100644
--- a/embed.h
+++ b/embed.h
@@ -1208,6 +1208,7 @@
#define parse_lparen_question_flags(a) S_parse_lparen_question_flags(aTHX_ a)
#define parse_uniprop_string(a,b,c,d,e,f,g,h,i) Perl_parse_uniprop_string(aTHX_ a,b,c,d,e,f,g,h,i)
#define populate_ANYOF_from_invlist(a,b) S_populate_ANYOF_from_invlist(aTHX_ a,b)
+#define rck_elide_nothing(a) S_rck_elide_nothing(aTHX_ a)
#define reg(a,b,c,d) S_reg(aTHX_ a,b,c,d)
#define reg2Lanode(a,b,c,d) S_reg2Lanode(aTHX_ a,b,c,d)
#define reg_node(a,b) S_reg_node(aTHX_ a,b)
diff --git a/proto.h b/proto.h
index 141ddbaee6..f316fe134e 100644
--- a/proto.h
+++ b/proto.h
@@ -5543,6 +5543,9 @@ PERL_CALLCONV SV * Perl_parse_uniprop_string(pTHX_ const char * const name, cons
STATIC void S_populate_ANYOF_from_invlist(pTHX_ regnode *node, SV** invlist_ptr);
#define PERL_ARGS_ASSERT_POPULATE_ANYOF_FROM_INVLIST \
assert(node); assert(invlist_ptr)
+STATIC void S_rck_elide_nothing(pTHX_ regnode *node);
+#define PERL_ARGS_ASSERT_RCK_ELIDE_NOTHING \
+ assert(node)
PERL_STATIC_NO_RET void S_re_croak2(pTHX_ bool utf8, const char* pat1, const char* pat2, ...)
__attribute__noreturn__;
#define PERL_ARGS_ASSERT_RE_CROAK2 \
diff --git a/regcomp.c b/regcomp.c
index 5f86be8086..4ba2980db6 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -4450,6 +4450,44 @@ S_unwind_scan_frames(pTHX_ const void *p)
} while (f);
}
+/* Follow the next-chain of the current node and optimize away
+ all the NOTHINGs from it.
+ */
+STATIC void
+S_rck_elide_nothing(pTHX_ regnode *node)
+{
+ dVAR;
+
+ PERL_ARGS_ASSERT_RCK_ELIDE_NOTHING;
+
+ if (OP(node) != CURLYX) {
+ const int max = (reg_off_by_arg[OP(node)]
+ ? I32_MAX
+ /* I32 may be smaller than U16 on CRAYs! */
+ : (I32_MAX < U16_MAX ? I32_MAX : U16_MAX));
+ int off = (reg_off_by_arg[OP(node)] ? ARG(node) : NEXT_OFF(node));
+ int noff;
+ regnode *n = node;
+
+ /* Skip NOTHING and LONGJMP. */
+ while (
+ (n = regnext(n))
+ && (
+ (PL_regkind[OP(n)] == NOTHING && (noff = NEXT_OFF(n)))
+ || ((OP(n) == LONGJMP) && (noff = ARG(n)))
+ )
+ && off + noff < max
+ ) {
+ off += noff;
+ }
+ if (reg_off_by_arg[OP(node)])
+ ARG(node) = off;
+ else
+ NEXT_OFF(node) = off;
+ }
+ return;
+}
+
/* the return from this sub is the minimum length that could possibly match */
STATIC SSize_t
S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
@@ -4550,28 +4588,10 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
*/
JOIN_EXACT(scan,&min_subtract, &unfolded_multi_char, 0);
- /* Follow the next-chain of the current node and optimize
- away all the NOTHINGs from it. */
- if (OP(scan) != CURLYX) {
- const int max = (reg_off_by_arg[OP(scan)]
- ? I32_MAX
- /* I32 may be smaller than U16 on CRAYs! */
- : (I32_MAX < U16_MAX ? I32_MAX : U16_MAX));
- int off = (reg_off_by_arg[OP(scan)] ? ARG(scan) : NEXT_OFF(scan));
- int noff;
- regnode *n = scan;
-
- /* Skip NOTHING and LONGJMP. */
- while ((n = regnext(n))
- && ((PL_regkind[OP(n)] == NOTHING && (noff = NEXT_OFF(n)))
- || ((OP(n) == LONGJMP) && (noff = ARG(n))))
- && off + noff < max)
- off += noff;
- if (reg_off_by_arg[OP(scan)])
- ARG(scan) = off;
- else
- NEXT_OFF(scan) = off;
- }
+ /* Follow the next-chain of the current node and optimize
+ away all the NOTHINGs from it.
+ */
+ rck_elide_nothing(scan);
/* The principal pseudo-switch. Cannot be a switch, since we
look into several different things. */
@@ -5745,11 +5765,7 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n",
if (data && (fl & SF_HAS_EVAL))
data->flags |= SF_HAS_EVAL;
optimize_curly_tail:
- if (OP(oscan) != CURLYX) {
- while (PL_regkind[OP(next = regnext(oscan))] == NOTHING
- && NEXT_OFF(next))
- NEXT_OFF(oscan) += NEXT_OFF(next);
- }
+ rck_elide_nothing(oscan);
continue;
default:
--
2.25.4

85
perl-5.31.0-CAPTURE_ALL-was-intended-to-be-an-alias-for-make-it-.patch Normal file
View File

@ -0,0 +1,85 @@
From 1a1d29aaa2e0c668f9a8c960d52b516415f28983 Mon Sep 17 00:00:00 2001
From: Vickenty Fesunov <kent@setattr.net>
Date: Fri, 22 Sep 2017 19:00:46 -0400
Subject: [PATCH] %{^CAPTURE_ALL} was intended to be an alias for %-; make it
so.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
For: RT #131867
Add Vickenty Fesunov to AUTHORS.
Signed-off-by: Ported to 5.30 from 1a1d29aaa2e0c668f9a8c960d52b516415f28983.
---
AUTHORS | 1 +
ext/Tie-Hash-NamedCapture/NamedCapture.xs | 5 ++++-
ext/Tie-Hash-NamedCapture/t/tiehash.t | 11 ++++++++---
diff --git a/AUTHORS b/AUTHORS
index 0091100600..c920d52e96 100644
--- a/AUTHORS
+++ b/AUTHORS
@@ -1265,6 +1265,7 @@ Unicode Consortium <unicode.org>
Vadim Konovalov <vkonovalov@lucent.com>
Valeriy E. Ushakov <uwe@ptc.spbu.ru>
Vernon Lyon <vlyon@cpan.org>
+Vickenty Fesunov <kent@setattr.net>
Victor Adam <victor@drawall.cc>
Victor Efimov <victor@vsespb.ru>
Viktor Turskyi <koorchik@gmail.com>
diff --git a/ext/Tie-Hash-NamedCapture/NamedCapture.xs b/ext/Tie-Hash-NamedCapture/NamedCapture.xs
index 7eaae5614d..a607c10090 100644
--- a/ext/Tie-Hash-NamedCapture/NamedCapture.xs
+++ b/ext/Tie-Hash-NamedCapture/NamedCapture.xs
@@ -25,8 +25,11 @@ _tie_it(SV *sv)
GV * const gv = (GV *)sv;
HV * const hv = GvHVn(gv);
SV *rv = newSV_type(SVt_RV);
+ const char *gv_name = GvNAME(gv);
CODE:
- SvRV_set(rv, newSVuv(*GvNAME(gv) == '-' ? RXapif_ALL : RXapif_ONE));
+ SvRV_set(rv, newSVuv(
+ strEQ(gv_name, "-") || strEQ(gv_name, "\003APTURE_ALL")
+ ? RXapif_ALL : RXapif_ONE));
SvROK_on(rv);
sv_bless(rv, GvSTASH(CvGV(cv)));
diff --git a/ext/Tie-Hash-NamedCapture/t/tiehash.t b/ext/Tie-Hash-NamedCapture/t/tiehash.t
index 3ebc81ad68..962754085f 100644
--- a/ext/Tie-Hash-NamedCapture/t/tiehash.t
+++ b/ext/Tie-Hash-NamedCapture/t/tiehash.t
@@ -3,7 +3,12 @@ use strict;
use Test::More;
-my %hashes = ('+' => \%+, '-' => \%-);
+my %hashes = (
+ '+' => \%+,
+ '-' => \%-,
+ '{^CAPTURE}' => \%{^CAPTURE},
+ '{^CAPTURE_ALL}' => \%{^CAPTURE_ALL},
+);
foreach (['plus1'],
['minus1', all => 1],
@@ -20,12 +25,12 @@ foreach (['plus1'],
is("abcdef" =~ /(?<foo>[ab])*(?<bar>c)(?<foo>d)(?<bar>[ef]*)/, 1,
"We matched");
-foreach my $name (qw(+ plus1 plus2 plus3)) {
+foreach my $name (qw(+ {^CAPTURE} plus1 plus2 plus3)) {
my $hash = $hashes{$name};
is_deeply($hash, { foo => 'b', bar => 'c' }, "%$name is as expected");
}
-foreach my $name (qw(- minus1 minus2)) {
+foreach my $name (qw(- {^CAPTURE_ALL} minus1 minus2)) {
my $hash = $hashes{$name};
is_deeply($hash, { foo => [qw(b d)], bar => [qw(c ef)] },
"%$name is as expected");
--
2.20.1

181
perl-5.31.0-Create-fcn-for-lossless-conversion-of-NV-to-IV.patch Normal file
View File

@ -0,0 +1,181 @@
From 3a019afd6f6291c3249c254b5c01e244e4ec83ab Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Sun, 28 Apr 2019 17:42:44 -0600
Subject: [PATCH 1/3] Create fcn for lossless conversion of NV to IV
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Essentially the same code was being used in three places, and had
undefined C behavior for some inputs.
This consolidates the code into one inline function, and rewrites it to
avoid undefined behavior.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
embed.fnc | 1 +
embed.h | 3 +++
inline.h | 34 ++++++++++++++++++++++++++++++++++
pp.c | 20 ++++----------------
pp_hot.c | 10 ++--------
proto.h | 7 +++++++
6 files changed, 51 insertions(+), 24 deletions(-)
diff --git a/embed.fnc b/embed.fnc
index 45597f67b6..259affded0 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -2272,6 +2272,7 @@ sR |SV* |refto |NN SV* sv
: Used in pp_hot.c
pRxo |GV* |softref2xv |NN SV *const sv|NN const char *const what \
|const svtype type|NN SV ***spp
+inR |bool |lossless_NV_to_IV|const NV nv|NN IV * ivp
#endif
#if defined(PERL_IN_PP_PACK_C)
diff --git a/embed.h b/embed.h
index 75c91f77f4..9178c51e92 100644
--- a/embed.h
+++ b/embed.h
@@ -1924,6 +1924,9 @@
#define do_delete_local() S_do_delete_local(aTHX)
#define refto(a) S_refto(aTHX_ a)
# endif
+# if defined(PERL_IN_PP_C) || defined(PERL_IN_PP_HOT_C)
+#define lossless_NV_to_IV S_lossless_NV_to_IV
+# endif
# if defined(PERL_IN_PP_CTL_C)
#define check_type_and_open(a) S_check_type_and_open(aTHX_ a)
#define destroy_matcher(a) S_destroy_matcher(aTHX_ a)
diff --git a/inline.h b/inline.h
index 654f801b75..de1e33e8ce 100644
--- a/inline.h
+++ b/inline.h
@@ -1913,6 +1913,40 @@ S_should_warn_nl(const char *pv) {
#endif
+#if defined(PERL_IN_PP_C) || defined(PERL_IN_PP_HOT_C)
+
+PERL_STATIC_INLINE bool
+S_lossless_NV_to_IV(const NV nv, IV *ivp)
+{
+ /* This function determines if the input NV 'nv' may be converted without
+ * loss of data to an IV. If not, it returns FALSE taking no other action.
+ * But if it is possible, it does the conversion, returning TRUE, and
+ * storing the converted result in '*ivp' */
+
+ PERL_ARGS_ASSERT_LOSSLESS_NV_TO_IV;
+
+# if defined(Perl_isnan)
+
+ if (UNLIKELY(Perl_isnan(nv))) {
+ return FALSE;
+ }
+
+# endif
+
+ if (UNLIKELY(nv < IV_MIN) || UNLIKELY(nv > IV_MAX)) {
+ return FALSE;
+ }
+
+ if ((IV) nv != nv) {
+ return FALSE;
+ }
+
+ *ivp = (IV) nv;
+ return TRUE;
+}
+
+#endif
+
/* ------------------ pp.c, regcomp.c, toke.c, universal.c ------------ */
#define MAX_CHARSET_NAME_LENGTH 2
diff --git a/pp.c b/pp.c
index c89cb7198c..0956121b27 100644
--- a/pp.c
+++ b/pp.c
@@ -1268,16 +1268,10 @@ PP(pp_multiply)
NV nr = SvNVX(svr);
NV result;
- if (
-#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
- !Perl_isnan(nl) && nl == (NV)(il = (IV)nl)
- && !Perl_isnan(nr) && nr == (NV)(ir = (IV)nr)
-#else
- nl == (NV)(il = (IV)nl) && nr == (NV)(ir = (IV)nr)
-#endif
- )
+ if (lossless_NV_to_IV(nl, &il) && lossless_NV_to_IV(nr, &ir)) {
/* nothing was lost by converting to IVs */
goto do_iv;
+ }
SP--;
result = nl * nr;
# if defined(__sgi) && defined(USE_LONG_DOUBLE) && LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE && NVSIZE == 16
@@ -1849,16 +1843,10 @@ PP(pp_subtract)
NV nl = SvNVX(svl);
NV nr = SvNVX(svr);
- if (
-#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
- !Perl_isnan(nl) && nl == (NV)(il = (IV)nl)
- && !Perl_isnan(nr) && nr == (NV)(ir = (IV)nr)
-#else
- nl == (NV)(il = (IV)nl) && nr == (NV)(ir = (IV)nr)
-#endif
- )
+ if (lossless_NV_to_IV(nl, &il) && lossless_NV_to_IV(nr, &ir)) {
/* nothing was lost by converting to IVs */
goto do_iv;
+ }
SP--;
TARGn(nl - nr, 0); /* args not GMG, so can't be tainted */
SETs(TARG);
diff --git a/pp_hot.c b/pp_hot.c
index 7d5ffc02fd..2df5df8303 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1435,16 +1435,10 @@ PP(pp_add)
NV nl = SvNVX(svl);
NV nr = SvNVX(svr);
- if (
-#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
- !Perl_isnan(nl) && nl == (NV)(il = (IV)nl)
- && !Perl_isnan(nr) && nr == (NV)(ir = (IV)nr)
-#else
- nl == (NV)(il = (IV)nl) && nr == (NV)(ir = (IV)nr)
-#endif
- )
+ if (lossless_NV_to_IV(nl, &il) && lossless_NV_to_IV(nr, &ir)) {
/* nothing was lost by converting to IVs */
goto do_iv;
+ }
SP--;
TARGn(nl + nr, 0); /* args not GMG, so can't be tainted */
SETs(TARG);
diff --git a/proto.h b/proto.h
index 0f8feed187..74a8e46ab7 100644
--- a/proto.h
+++ b/proto.h
@@ -5224,6 +5224,13 @@ STATIC SV* S_refto(pTHX_ SV* sv)
#endif
#if defined(PERL_IN_PP_C) || defined(PERL_IN_PP_HOT_C)
+#ifndef PERL_NO_INLINE_FUNCTIONS
+PERL_STATIC_INLINE bool S_lossless_NV_to_IV(const NV nv, IV * ivp)
+ __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_LOSSLESS_NV_TO_IV \
+ assert(ivp)
+#endif
+
PERL_CALLCONV GV* Perl_softref2xv(pTHX_ SV *const sv, const char *const what, const svtype type, SV ***spp)
__attribute__warn_unused_result__;
#define PERL_ARGS_ASSERT_SOFTREF2XV \
--
2.20.1

87
perl-5.31.0-Don-t-use-PL_check-op_type-to-check-for-filetets-ops.patch Normal file
View File

@ -0,0 +1,87 @@
From 1d31efef7dd4388fd606972e67bda3318e8838fe Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Dagfinn=20Ilmari=20Manns=C3=A5ker?= <ilmari@ilmari.org>
Date: Tue, 21 May 2019 17:34:49 +0100
Subject: [PATCH] Don't use PL_check[op_type] to check for filetets ops to
stack
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
This breaks hooking the filetest ops' check function by modules like
bareword::filehandles. Instead use the OP_IS_FILETEST() macro to decide
check for filetest ops. Also add an OP_IS_STAT() macro for when we want
to check for (l)stat as well as the filetest ops.
c.f. https://rt.cpan.org/Ticket/Display.html?id=127073
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
op.c | 11 ++++-------
op.h | 2 ++
regen/opcodes | 1 +
3 files changed, 7 insertions(+), 7 deletions(-)
diff --git a/op.c b/op.c
index 29181ba731..dba7ac7fea 100644
--- a/op.c
+++ b/op.c
@@ -991,8 +991,7 @@ Perl_op_clear(pTHX_ OP *o)
o->op_targ = 0;
break;
default:
- if (!(o->op_flags & OPf_REF)
- || (PL_check[o->op_type] != Perl_ck_ftst))
+ if (!(o->op_flags & OPf_REF) || !OP_IS_STAT(o->op_type))
break;
/* FALLTHROUGH */
case OP_GVSV:
@@ -4413,8 +4412,7 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
/* [20011101.069 (#7861)] File test operators interpret OPf_REF to mean that
their argument is a filehandle; thus \stat(".") should not set
it. AMS 20011102 */
- if (type == OP_REFGEN &&
- PL_check[o->op_type] == Perl_ck_ftst)
+ if (type == OP_REFGEN && OP_IS_STAT(o->op_type))
return o;
if (type != OP_LEAVESUBLV)
@@ -11696,9 +11694,8 @@ Perl_ck_ftst(pTHX_ OP *o)
scalar((OP *) kid);
if ((PL_hints & HINT_FILETEST_ACCESS) && OP_IS_FILETEST_ACCESS(o->op_type))
o->op_private |= OPpFT_ACCESS;
- if (type != OP_STAT && type != OP_LSTAT
- && PL_check[kidtype] == Perl_ck_ftst
- && kidtype != OP_STAT && kidtype != OP_LSTAT
+ if (OP_IS_FILETEST(type)
+ && OP_IS_FILETEST(kidtype)
) {
o->op_private |= OPpFT_STACKED;
kid->op_private |= OPpFT_STACKING;
diff --git a/op.h b/op.h
index c9f05b2271..ad6cf7fe49 100644
--- a/op.h
+++ b/op.h
@@ -1021,6 +1021,8 @@ C<sib> is non-null. For a higher-level interface, see C<L</op_sibling_splice>>.
#define OP_TYPE_ISNT_AND_WASNT(o, type) \
( (o) && OP_TYPE_ISNT_AND_WASNT_NN(o, type) )
+/* should match anything that uses ck_ftst in regen/opcodes */
+#define OP_IS_STAT(op) (OP_IS_FILETEST(op) || (op) == OP_LSTAT || (op) == OP_STAT)
# define OpHAS_SIBLING(o) (cBOOL((o)->op_moresib))
# define OpSIBLING(o) (0 + (o)->op_moresib ? (o)->op_sibparent : NULL)
diff --git a/regen/opcodes b/regen/opcodes
index b4bf904fdc..4e8236947a 100644
--- a/regen/opcodes
+++ b/regen/opcodes
@@ -397,6 +397,7 @@ getsockname getsockname ck_fun is% Fs
getpeername getpeername ck_fun is% Fs
# Stat calls. OP_IS_FILETEST wants them consecutive.
+# Also needs to match OP_IS_STAT() in op.h
lstat lstat ck_ftst u- F?
stat stat ck_ftst u- F?
--
2.20.1

75
perl-5.31.0-PATCH-perl-134059-panic-outputting-a-warning.patch Normal file
View File

@ -0,0 +1,75 @@
From cc16d262eb72677cdda2aa9395e943818b85ba38 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Mon, 29 Apr 2019 15:24:18 -0600
Subject: [PATCH] PATCH: [perl #134059] panic outputting a warning
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
This was due to a logic error on my part. We need to save and restore a
value. Instead, it was getting restored to the wrong value.
This particular instance of the bug was outputting a fatal error
message, so that the only harm is not giving the user the correct info,
and creating unnecessary work for them and us when it gets reported.
But this bug could manifest itself when trying to output just a warning
that the program otherwise would carry on from.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
regcomp.c | 12 ++++++++++--
t/re/reg_mesg.t | 1 +
2 files changed, 11 insertions(+), 2 deletions(-)
diff --git a/regcomp.c b/regcomp.c
index 3ad09c52b2..1c54fe3f38 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -131,6 +131,8 @@ struct RExC_state_t {
char *parse; /* Input-scan pointer. */
char *copy_start; /* start of copy of input within
constructed parse string */
+ char *save_copy_start; /* Provides one level of saving
+ and restoring 'copy_start' */
char *copy_start_in_input; /* Position in input string
corresponding to copy_start */
SSize_t whilem_seen; /* number of WHILEM in this expr */
@@ -229,6 +231,7 @@ struct RExC_state_t {
#define RExC_precomp (pRExC_state->precomp)
#define RExC_copy_start_in_input (pRExC_state->copy_start_in_input)
#define RExC_copy_start_in_constructed (pRExC_state->copy_start)
+#define RExC_save_copy_start_in_constructed (pRExC_state->save_copy_start)
#define RExC_precomp_end (pRExC_state->precomp_end)
#define RExC_rx_sv (pRExC_state->rx_sv)
#define RExC_rx (pRExC_state->rx)
@@ -821,8 +824,13 @@ static const scan_data_t zero_scan_data = {
} STMT_END
/* Setting this to NULL is a signal to not output warnings */
-#define TURN_OFF_WARNINGS_IN_SUBSTITUTE_PARSE RExC_copy_start_in_constructed = NULL
-#define RESTORE_WARNINGS RExC_copy_start_in_constructed = RExC_precomp
+#define TURN_OFF_WARNINGS_IN_SUBSTITUTE_PARSE \
+ STMT_START { \
+ RExC_save_copy_start_in_constructed = RExC_copy_start_in_constructed;\
+ RExC_copy_start_in_constructed = NULL; \
+ } STMT_END
+#define RESTORE_WARNINGS \
+ RExC_copy_start_in_constructed = RExC_save_copy_start_in_constructed
/* Since a warning can be generated multiple times as the input is reparsed, we
* output it the first time we come to that point in the parse, but suppress it
diff --git a/t/re/reg_mesg.t b/t/re/reg_mesg.t
index c5c79f0323..d10fa2c09a 100644
--- a/t/re/reg_mesg.t
+++ b/t/re/reg_mesg.t
@@ -318,6 +318,7 @@ my @death =
'/\p{Is_Other_Alphabetic=F}/ ' => 'Can\'t find Unicode property definition "Is_Other_Alphabetic=F" {#} m/\p{Is_Other_Alphabetic=F}{#}/',
'/\x{100}(?(/' => 'Unknown switch condition (?(...)) {#} m/\\x{100}(?({#}/', # [perl #133896]
'/(?[\N{KEYCAP DIGIT NINE}/' => '\N{} in inverted character class or as a range end-point is restricted to one character {#} m/(?[\\N{U+39.FE0F.20E3{#}}/', # [perl #133988]
+ '/0000000000000000[\N{U+0.00}0000/' => 'Unmatched [ {#} m/0000000000000000[{#}\N{U+0.00}0000/', # [perl #134059]
);
# These are messages that are death under 'use re "strict"', and may or may
--
2.20.1

49
perl-5.31.0-S_scan_const-Properly-test-if-need-to-grow.patch Normal file
View File

@ -0,0 +1,49 @@
From 89f69032d6a71f41b96ae6becbf3df4e2f9509a5 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Sat, 27 Apr 2019 13:56:39 -0600
Subject: [PATCH] S_scan_const() Properly test if need to grow
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
As we parse the input, creating a string constant, we may have to grow
the destination if it fills up as we go along. It allocates space in an
SV and populates the string, but it doesn' update the SvCUR until the
end, so in single stepping the debugger through the code, the SV looks
empty until the end. It turns out that as a result SvEND also doesn't
get updated and still points to the beginning of the string until SvCUR
is finally set. That means that the test changed by this commit was
always succeeding, because it was using SvEND that didn't get updated,
so it would attempt to grow each time through the loop. By moving a
couple of statements earlier, and using SvLEN instead, which does always
have the correct value, those extra growth attempts are avoided.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
toke.c | 10 ++++++----
1 file changed, 6 insertions(+), 4 deletions(-)
diff --git a/toke.c b/toke.c
index 68eea0cae6..03c4f2ba26 100644
--- a/toke.c
+++ b/toke.c
@@ -4097,10 +4097,12 @@ S_scan_const(pTHX_ char *start)
goto default_action; /* Redo, having upgraded so both are UTF-8 */
}
else { /* UTF8ness matters: convert this non-UTF8 source char to
- UTF-8 for output. It will occupy 2 bytes */
- if (d + 2 >= SvEND(sv)) {
- const STRLEN extra = 2 + (send - s - 1) + 1;
- const STRLEN off = d - SvPVX_const(sv);
+ UTF-8 for output. It will occupy 2 bytes, but don't include
+ the input byte since we haven't incremented 's' yet. See
+ Note on sizing above. */
+ const STRLEN off = d - SvPVX(sv);
+ const STRLEN extra = 2 + (send - s - 1) + 1;
+ if (off + extra > SvLEN(sv)) {
d = off + SvGROW(sv, off + extra);
}
*d++ = UTF8_EIGHT_BIT_HI(*s);
--
2.20.1

70
perl-5.31.0-perl-122112-a-simpler-fix-for-pclose-aborted-by-a-si.patch Normal file
View File

@ -0,0 +1,70 @@
From 35608a1658fe75c79ca53d96aea6cf7cb2a98615 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Thu, 9 May 2019 09:52:30 +1000
Subject: [PATCH] (perl #122112) a simpler fix for pclose() aborted by a signal
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
This change results in a zombie child process for the lifetime of
the process, but I think that's the responsibility of the signal
handler that aborted pclose().
We could add some magic to retry (and retry and retry) waiting on
child process as we rewind (since there's no other way to remove
the zombie), but the program has chosen implicitly to abort the
wait() done by pclose() and it's best to honor that.
If we do choose to retry the wait() we might be blocking an attempt
by the process to terminate, whether by exit() or die().
If a program does need more flexible handling there's always
pipe()/fork()/exec() and/or the various event-driven frameworks on
CPAN.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
doio.c | 12 +++++++++++-
t/io/pipe.t | 2 --
2 files changed, 11 insertions(+), 3 deletions(-)
diff --git a/doio.c b/doio.c
index 0cc4e55404..05a06968dc 100644
--- a/doio.c
+++ b/doio.c
@@ -1779,7 +1779,17 @@ Perl_io_close(pTHX_ IO *io, GV *gv, bool not_implicit, bool warn_on_fail)
if (IoIFP(io)) {
if (IoTYPE(io) == IoTYPE_PIPE) {
- const int status = PerlProc_pclose(IoIFP(io));
+ PerlIO *fh = IoIFP(io);
+ int status;
+
+ /* my_pclose() can propagate signals which might bypass any code
+ after the call here if the signal handler throws an exception.
+ This would leave the handle in the IO object and try to close it again
+ when the SV is destroyed on unwind or global destruction.
+ So NULL it early.
+ */
+ IoOFP(io) = IoIFP(io) = NULL;
+ status = PerlProc_pclose(fh);
if (not_implicit) {
STATUS_NATIVE_CHILD_SET(status);
retval = (STATUS_UNIX == 0);
diff --git a/t/io/pipe.t b/t/io/pipe.t
index 1d01db6af6..fc3071300d 100644
--- a/t/io/pipe.t
+++ b/t/io/pipe.t
@@ -255,9 +255,7 @@ close \$fh;
PROG
print $prog;
my $out = fresh_perl($prog, {});
- $::TODO = "not fixed yet";
cmp_ok($out, '!~', qr/refcnt/, "no exception from PerlIO");
- undef $::TODO;
# checks that that program did something rather than failing to
# compile
cmp_ok($out, '=~', qr/Died at/, "but we did get the exception from die");
--
2.20.1

28
perl-5.31.0-perl-122112-remove-some-interfering-debug-output.patch Normal file
View File

@ -0,0 +1,28 @@
From 2fe0d7f40a94163d6c242c3e695fdcd19e387422 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 11 Jun 2019 14:59:23 +1000
Subject: [PATCH] (perl #122112) remove some interfering debug output
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
t/io/pipe.t | 1 -
1 file changed, 1 deletion(-)
diff --git a/t/io/pipe.t b/t/io/pipe.t
index fc3071300d..9f5bb3bcf8 100644
--- a/t/io/pipe.t
+++ b/t/io/pipe.t
@@ -253,7 +253,6 @@ my \$cmd = qq(\$Perl -e "sleep 3");
my \$pid = open my \$fh, "|\$cmd" or die "\$!\n";
close \$fh;
PROG
- print $prog;
my $out = fresh_perl($prog, {});
cmp_ok($out, '!~', qr/refcnt/, "no exception from PerlIO");
# checks that that program did something rather than failing to
--
2.20.1

54
perl-5.31.0-perl-122112-test-for-signal-handler-death-in-pclose.patch Normal file
View File

@ -0,0 +1,54 @@
From fb5e77103dd443cc2112ba14dc665aa5ec072ce6 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 30 May 2018 14:03:04 +1000
Subject: [PATCH] (perl #122112) test for signal handler death in pclose
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
t/io/pipe.t | 23 ++++++++++++++++++++++-
1 file changed, 22 insertions(+), 1 deletion(-)
diff --git a/t/io/pipe.t b/t/io/pipe.t
index f9ee65afe8..1d01db6af6 100644
--- a/t/io/pipe.t
+++ b/t/io/pipe.t
@@ -10,7 +10,7 @@ if (!$Config{'d_fork'}) {
skip_all("fork required to pipe");
}
else {
- plan(tests => 25);
+ plan(tests => 27);
}
my $Perl = which_perl();
@@ -241,3 +241,24 @@ SKIP: {
is($child, -1, 'child reaped if piped program cannot be executed');
}
+
+{
+ # [perl #122112] refcnt: fd -1 < 0 when a signal handler dies
+ # while a pipe close is waiting on a child process
+ my $prog = <<PROG;
+\$SIG{ALRM}=sub{die};
+alarm 1;
+\$Perl = "$Perl";
+my \$cmd = qq(\$Perl -e "sleep 3");
+my \$pid = open my \$fh, "|\$cmd" or die "\$!\n";
+close \$fh;
+PROG
+ print $prog;
+ my $out = fresh_perl($prog, {});
+ $::TODO = "not fixed yet";
+ cmp_ok($out, '!~', qr/refcnt/, "no exception from PerlIO");
+ undef $::TODO;
+ # checks that that program did something rather than failing to
+ # compile
+ cmp_ok($out, '=~', qr/Died at/, "but we did get the exception from die");
+}
--
2.20.1

73
perl-5.31.0-perl-133913-limit-numeric-format-results-to-INT_MAX.patch Normal file
View File

@ -0,0 +1,73 @@
From 027471cf1095f75f273df40310e4647fe1e8a9df Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 20 Mar 2019 16:47:49 +1100
Subject: [PATCH] (perl #133913) limit numeric format results to INT_MAX
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
The return value of v?snprintf() is int, and we pay attention to that
return value, so limit the expected size of numeric formats to
INT_MAX.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
pod/perldiag.pod | 6 ++++++
sv.c | 7 +++++++
t/op/sprintf2.t | 7 +++++++
3 files changed, 20 insertions(+)
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 1037215d44..166d29b4bb 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -4354,6 +4354,12 @@ the meantime, try using scientific notation (e.g. "1e6" instead of
a number. This happens, for example with C<\o{}>, with no number between
the braces.
+=item Numeric format result too large
+
+(F) The length of the result of a numeric format supplied to sprintf()
+or printf() would have been too large for the underlying C function to
+report. This limit is typically 2GB.
+
=item Octal number > 037777777777 non-portable
(W portable) The octal number you specified is larger than 2**32-1
diff --git a/sv.c b/sv.c
index 8fbca52eb2..8bc0af0c16 100644
--- a/sv.c
+++ b/sv.c
@@ -13085,6 +13085,13 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
if (float_need < width)
float_need = width;
+ if (float_need > INT_MAX) {
+ /* snprintf() returns an int, and we use that return value,
+ so die horribly if the expected size is too large for int
+ */
+ Perl_croak(aTHX_ "Numeric format result too large");
+ }
+
if (PL_efloatsize <= float_need) {
/* PL_efloatbuf should be at least 1 greater than
* float_need to allow a trailing \0 to be returned by
diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t
index 84259a4afd..5fee8efede 100644
--- a/t/op/sprintf2.t
+++ b/t/op/sprintf2.t
@@ -1153,4 +1153,11 @@ foreach(
is sprintf("%.0f", $_), sprintf("%-.0f", $_), "special-case %.0f on $_";
}
+# large uvsize needed so the large width is parsed properly
+# large sizesize needed so the STRLEN check doesn't
+if ($Config{intsize} == 4 && $Config{uvsize} > 4 && $Config{sizesize} > 4) {
+ eval { my $x = sprintf("%7000000000E", 0) };
+ like($@, qr/^Numeric format result too large at /,
+ "croak for very large numeric format results");
+}
done_testing();
--
2.20.1

78
perl-5.31.0-perl-133936-document-differences-between-IO-Socket-a.patch Normal file
View File

@ -0,0 +1,78 @@
From 1d9630e7857d6fbae6fddd261fbb80c9c9a8cfd6 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 18 Mar 2019 16:02:33 +1100
Subject: [PATCH] (perl #133936) document differences between IO::Socket::* and
builtin
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
dist/IO/lib/IO/Socket.pm | 43 +++++++++++++++++++++++++++++++++++++---
1 file changed, 40 insertions(+), 3 deletions(-)
diff --git a/dist/IO/lib/IO/Socket.pm b/dist/IO/lib/IO/Socket.pm
index da9e8c94d0..345ffd475d 100644
--- a/dist/IO/lib/IO/Socket.pm
+++ b/dist/IO/lib/IO/Socket.pm
@@ -434,9 +434,6 @@ corresponding built-in functions:
bind
listen
accept
- send
- recv
- peername (getpeername)
sockname (getsockname)
shutdown
@@ -517,6 +514,46 @@ SO_LINGER enabled with a zero timeout, then the peer's close() will generate
a RST segment, upon receipt of which the local TCP transitions immediately to
B<CLOSED>, and in that state, connected() I<will> return undef.
+=item send(MSG, [, FLAGS [, TO ] ])
+
+Like the built-in L<send()|perlfunc/send>, except that:
+
+=over
+
+=item *
+
+C<FLAGS> is optional and defaults to C<0>, and
+
+=item *
+
+after a successful send with C<TO>, further calls to send() without
+C<TO> will send to the same address, and C<TO> will be used as the
+result of peername().
+
+=back
+
+=item recv(BUF, LEN, [,FLAGS])
+
+Like the built-in L<recv()|perlfunc/recv>, except that:
+
+=over
+
+=item *
+
+C<FLAGS> is optional and defaults to C<0>, and
+
+=item *
+
+the cached value returned by peername() is updated with the result of
+recv().
+
+=back
+
+=item peername
+
+Returns the cached peername, possibly set by recv() or send() above.
+If not otherwise set returns (and caches) the result of getpeername().
+
=item protocol
Returns the numerical number for the protocol being used on the socket, if
--
2.20.1

107
perl-5.31.0-perl-133936-ensure-TO-is-honoured-for-UDP-sock-send.patch Normal file
View File

@ -0,0 +1,107 @@
From f1000aa2d58fbed2741dbb2887b668f872ef0cb8 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 18 Mar 2019 15:05:32 +1100
Subject: [PATCH] (perl #133936) ensure TO is honoured for UDP $sock->send()
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
dist/IO/lib/IO/Socket.pm | 7 ++++---
dist/IO/t/io_udp.t | 31 +++++++++++++++++++++++++++----
2 files changed, 31 insertions(+), 7 deletions(-)
diff --git a/dist/IO/lib/IO/Socket.pm b/dist/IO/lib/IO/Socket.pm
index 1bf57ab826..a34a10b232 100644
--- a/dist/IO/lib/IO/Socket.pm
+++ b/dist/IO/lib/IO/Socket.pm
@@ -282,9 +282,10 @@ sub send {
croak 'send: Cannot determine peer address'
unless(defined $peer);
- my $r = defined(getpeername($sock))
- ? send($sock, $_[1], $flags)
- : send($sock, $_[1], $flags, $peer);
+ my $type = $sock->socktype;
+ my $r = $type == SOCK_DGRAM || $type == SOCK_RAW
+ ? send($sock, $_[1], $flags, $peer)
+ : send($sock, $_[1], $flags);
# remember who we send to, if it was successful
${*$sock}{'io_socket_peername'} = $peer
diff --git a/dist/IO/t/io_udp.t b/dist/IO/t/io_udp.t
index d7e95a8829..571e4303bb 100644
--- a/dist/IO/t/io_udp.t
+++ b/dist/IO/t/io_udp.t
@@ -15,6 +15,8 @@ BEGIN {
skip_all($reason) if $reason;
}
+use strict;
+
sub compare_addr {
no utf8;
my $a = shift;
@@ -36,18 +38,18 @@ sub compare_addr {
"$a[0]$a[1]" eq "$b[0]$b[1]";
}
-plan(7);
+plan(15);
watchdog(15);
use Socket;
use IO::Socket qw(AF_INET SOCK_DGRAM INADDR_ANY);
-$udpa = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
+my $udpa = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
|| IO::Socket::INET->new(Proto => 'udp', LocalAddr => '127.0.0.1')
or die "$! (maybe your system does not have a localhost at all, 'localhost' or 127.0.0.1)";
ok(1);
-$udpb = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
+my $udpb = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
|| IO::Socket::INET->new(Proto => 'udp', LocalAddr => '127.0.0.1')
or die "$! (maybe your system does not have a localhost at all, 'localhost' or 127.0.0.1)";
ok(1);
@@ -56,6 +58,7 @@ $udpa->send('BORK', 0, $udpb->sockname);
ok(compare_addr($udpa->peername,$udpb->sockname, 'peername', 'sockname'));
+my $buf;
my $where = $udpb->recv($buf="", 4);
is($buf, 'BORK');
@@ -69,7 +72,27 @@ $udpb->send('FOObar', @xtra);
$udpa->recv($buf="", 6);
is($buf, 'FOObar');
-ok(! $udpa->connected);
+{
+ # check the TO parameter passed to $sock->send() is honoured for UDP sockets
+ # [perl #133936]
+ my $udpc = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
+ || IO::Socket::INET->new(Proto => 'udp', LocalAddr => '127.0.0.1')
+ or die "$! (maybe your system does not have a localhost at all, 'localhost' or 127.0.0.1)";
+ pass("created C socket");
+
+ ok($udpc->connect($udpa->sockname), "connect C to A");
+
+ ok($udpc->connected, "connected a UDP socket");
+
+ ok($udpc->send("fromctoa"), "send to a");
+
+ ok($udpa->recv($buf = "", 8), "recv it");
+ is($buf, "fromctoa", "check value received");
+
+ ok($udpc->send("fromctob", 0, $udpb->sockname), "send to non-connected socket");
+ ok($udpb->recv($buf = "", 8), "recv it");
+ is($buf, "fromctob", "check value received");
+}
exit(0);
--
2.20.1

93
perl-5.31.0-perl-133936-make-send-a-bit-saner.patch Normal file
View File

@ -0,0 +1,93 @@
From bc26d2e6b287cc6693f41e1a2d48b0dd77d2e427 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 18 Jun 2019 14:59:00 +1000
Subject: [PATCH] (perl #133936) make send() a bit saner
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
This undoes some of the effect of f1000aa2d in that TO will always
be supplied to CORE::send() if it's supplied, otherwise whether
TO is supplied to CORE::send() is based on whether the socket is
connected.
On Linux you appear to be able to sendto() to a different address on
a connected UDP socket, but this doesn't appear to be portable,
failing on darwin, and presumably on other BSDs.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
dist/IO/lib/IO/Socket.pm | 25 +++++++++++++++++--------
dist/IO/t/io_udp.t | 11 ++++++++---
2 files changed, 25 insertions(+), 11 deletions(-)
diff --git a/dist/IO/lib/IO/Socket.pm b/dist/IO/lib/IO/Socket.pm
index 345ffd475d..28fa1ec149 100644
--- a/dist/IO/lib/IO/Socket.pm
+++ b/dist/IO/lib/IO/Socket.pm
@@ -277,13 +277,22 @@ sub send {
@_ >= 2 && @_ <= 4 or croak 'usage: $sock->send(BUF, [FLAGS, [TO]])';
my $sock = $_[0];
my $flags = $_[2] || 0;
- my $peer = $_[3] || $sock->peername;
+ my $peer;
- croak 'send: Cannot determine peer address'
- unless(defined $peer);
+ if ($_[3]) {
+ # the caller explicitly requested a TO, so use it
+ # this is non-portable for "connected" UDP sockets
+ $peer = $_[3];
+ }
+ elsif (!defined getpeername($sock)) {
+ # we're not connected, so we require a peer from somewhere
+ $peer = $sock->peername;
+
+ croak 'send: Cannot determine peer address'
+ unless(defined $peer);
+ }
- my $type = $sock->socktype;
- my $r = $type == SOCK_DGRAM || $type == SOCK_RAW
+ my $r = $peer
? send($sock, $_[1], $flags, $peer)
: send($sock, $_[1], $flags);
@@ -526,9 +535,9 @@ C<FLAGS> is optional and defaults to C<0>, and
=item *
-after a successful send with C<TO>, further calls to send() without
-C<TO> will send to the same address, and C<TO> will be used as the
-result of peername().
+after a successful send with C<TO>, further calls to send() on an
+unconnected socket without C<TO> will send to the same address, and
+C<TO> will be used as the result of peername().
=back
diff --git a/dist/IO/t/io_udp.t b/dist/IO/t/io_udp.t
index 571e4303bb..2adc6a4a69 100644
--- a/dist/IO/t/io_udp.t
+++ b/dist/IO/t/io_udp.t
@@ -89,9 +89,14 @@ is($buf, 'FOObar');
ok($udpa->recv($buf = "", 8), "recv it");
is($buf, "fromctoa", "check value received");
- ok($udpc->send("fromctob", 0, $udpb->sockname), "send to non-connected socket");
- ok($udpb->recv($buf = "", 8), "recv it");
- is($buf, "fromctob", "check value received");
+ SKIP:
+ {
+ $^O eq "linux"
+ or skip "This is non-portable, known to 'work' on Linux", 3;
+ ok($udpc->send("fromctob", 0, $udpb->sockname), "send to non-connected socket");
+ ok($udpb->recv($buf = "", 8), "recv it");
+ is($buf, "fromctob", "check value received");
+ }
}
exit(0);
--
2.20.1

28
perl-5.31.0-perl-134008-an-alternative-test.patch Normal file
View File

@ -0,0 +1,28 @@
From 9dfe0a3438ae69872b71b98e4fb4f4bef084983d Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 3 Jun 2019 14:34:17 +1000
Subject: [PATCH 2/2] (perl #134008) an alternative test
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
t/op/sprintf2.t | 1 +
1 file changed, 1 insertion(+)
diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t
index 569bd8053d..84259a4afd 100644
--- a/t/op/sprintf2.t
+++ b/t/op/sprintf2.t
@@ -840,6 +840,7 @@ SKIP: {
# [rt.perl.org #134008]
is(sprintf("%.*a", -99999, 1.03125), "0x1.08p+0", "[rt.perl.org #134008]");
+ is(sprintf("%.*a", -100000,0), "0x0p+0", "negative precision ignored by format_hexfp");
# [rt.perl.org #128890]
is(sprintf("%a", 0x1.18p+0), "0x1.18p+0");
--
2.20.1

84
perl-5.31.0-perl-134072-allow-foo-bar-to-work-in-main.patch Normal file
View File

@ -0,0 +1,84 @@
From 40258daf9899686d934c460ba3630431312d7694 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 15 May 2019 15:59:49 +1000
Subject: [PATCH] (perl #134072) allow \&foo = \&bar to work in main::
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
subs in main:: are stored as a RV referring to a CV as a space
optimization, but the pp_refassign code expected to find a glob,
which made the assignment a no-op.
Fix this by upgrading the reference to a glob in the refassign check
function.
Note that this would be an issue in other packages if 1e2cfe157ca
was reverted (allowing the space savings in other packages too.)
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
op.c | 9 +++++++++
t/op/lvref.t | 15 ++++++++++++++-
2 files changed, 23 insertions(+), 1 deletion(-)
diff --git a/op.c b/op.c
index f63eeadc36..6ad192307f 100644
--- a/op.c
+++ b/op.c
@@ -12462,7 +12462,16 @@ Perl_ck_refassign(pTHX_ OP *o)
OP * const kid = cUNOPx(kidparent)->op_first;
o->op_private |= OPpLVREF_CV;
if (kid->op_type == OP_GV) {
+ SV *sv = (SV*)cGVOPx_gv(kid);
varop = kidparent;
+ if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) {
+ /* a CVREF here confuses pp_refassign, so make sure
+ it gets a GV */
+ CV *const cv = (CV*)SvRV(sv);
+ SV *name_sv = sv_2mortal(newSVhek(CvNAME_HEK(cv)));
+ (void)gv_init_sv((GV*)sv, CvSTASH(cv), name_sv, 0);
+ assert(SvTYPE(sv) == SVt_PVGV);
+ }
goto detach_and_stack;
}
if (kid->op_type != OP_PADCV) goto bad;
diff --git a/t/op/lvref.t b/t/op/lvref.t
index 3d5e952fb0..3991a53780 100644
--- a/t/op/lvref.t
+++ b/t/op/lvref.t
@@ -1,10 +1,11 @@
+#!perl
BEGIN {
chdir 't';
require './test.pl';
set_up_inc("../lib");
}
-plan 164;
+plan 167;
eval '\$x = \$y';
like $@, qr/^Experimental aliasing via reference not enabled/,
@@ -291,6 +292,18 @@ package CodeTest {
my sub bs;
\(&cs) = expect_list_cx;
is \&cs, \&ThatSub, '\(&statesub)';
+
+ package main {
+ # this is only a problem in main:: due to 1e2cfe157ca
+ sub sx { "x" }
+ sub sy { "y" }
+ is sx(), "x", "check original";
+ my $temp = \&sx;
+ \&sx = \&sy;
+ is sx(), "y", "aliased";
+ \&sx = $temp;
+ is sx(), "x", "and restored";
+ }
}
# Mixed List Assignments
--
2.20.1

59
perl-5.31.0-perl-134193-allow-CAPTURE-to-work-when-CAPTURE-comes.patch Normal file
View File

@ -0,0 +1,59 @@
From 22f05786af0b7f963440e47908cd5f35cf074c12 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Thu, 13 Jun 2019 10:05:15 +1000
Subject: [PATCH] (perl #134193) allow %{^CAPTURE} to work when @{^CAPTURE}
comes first
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
gv_magicalize() is called when the GV is created, so when the array
was mentioned first, the hash wouldn't reach this code and the magic
wouldn't be added to the hash.
This also fixes a similar problem with (%|@){^CAPTURE_ALL}, though
@{^CAPTURE_ALL} is unused at this point.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
ext/Tie-Hash-NamedCapture/t/tiehash.t | 3 +++
gv.c | 6 ++----
2 files changed, 5 insertions(+), 4 deletions(-)
diff --git a/ext/Tie-Hash-NamedCapture/t/tiehash.t b/ext/Tie-Hash-NamedCapture/t/tiehash.t
index 962754085f..cca05278f4 100644
--- a/ext/Tie-Hash-NamedCapture/t/tiehash.t
+++ b/ext/Tie-Hash-NamedCapture/t/tiehash.t
@@ -3,6 +3,9 @@ use strict;
use Test::More;
+# this would break the hash magic setup [perl #134193]
+my ($ca, $c) = ( \@{^CAPTURE_ALL}, \@{^CAPTURE} );
+
my %hashes = (
'+' => \%+,
'-' => \%-,
diff --git a/gv.c b/gv.c
index 46a32dcc20..2b83680898 100644
--- a/gv.c
+++ b/gv.c
@@ -2032,13 +2032,11 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
sv_magic(MUTABLE_SV(av), (SV*)n, PERL_MAGIC_regdata, NULL, 0);
SvREADONLY_on(av);
- if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
- require_tie_mod_s(gv, '-', "Tie::Hash::NamedCapture",0);
+ require_tie_mod_s(gv, '-', "Tie::Hash::NamedCapture",0);
} else /* %{^CAPTURE_ALL} */
if (memEQs(name, len, "\003APTURE_ALL")) {
- if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
- require_tie_mod_s(gv, '+', "Tie::Hash::NamedCapture",0);
+ require_tie_mod_s(gv, '+', "Tie::Hash::NamedCapture",0);
}
break;
case '\005': /* $^ENCODING */
--
2.20.1

36
perl-5.31.0-perl-134193-make-the-varname-match-the-names.patch Normal file
View File

@ -0,0 +1,36 @@
From d8422270033e0728e6a9cecb24cdbd123656e367 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 17 Jun 2019 11:46:00 +1000
Subject: [PATCH] (perl #134193) make the varname match the %[+-] names
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
when loading Tie/Hash/NamedCapture.pm for the long name variants
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
gv.c | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/gv.c b/gv.c
index 2b83680898..652f5e737d 100644
--- a/gv.c
+++ b/gv.c
@@ -2032,11 +2032,11 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
sv_magic(MUTABLE_SV(av), (SV*)n, PERL_MAGIC_regdata, NULL, 0);
SvREADONLY_on(av);
- require_tie_mod_s(gv, '-', "Tie::Hash::NamedCapture",0);
+ require_tie_mod_s(gv, '+', "Tie::Hash::NamedCapture",0);
} else /* %{^CAPTURE_ALL} */
if (memEQs(name, len, "\003APTURE_ALL")) {
- require_tie_mod_s(gv, '+', "Tie::Hash::NamedCapture",0);
+ require_tie_mod_s(gv, '-', "Tie::Hash::NamedCapture",0);
}
break;
case '\005': /* $^ENCODING */
--
2.20.1

65
perl-5.31.1-avoid-SEGV-with-uninit-warning-with-multideref.patch Normal file
View File

@ -0,0 +1,65 @@
From 28eabf1185634216ca335b3a24e1131b0f392ca1 Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Wed, 10 Jul 2019 12:59:06 +0100
Subject: [PATCH] avoid SEGV with uninit warning with multideref
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
RT #134275
When the 'uninitialized warning' code in S_find_uninit_var() comes
across an OP_MULTIDEREF node, it scans it to see if any part of that op
(e.g. the indices or the returned value) could have been the source of
the uninitialized value which triggered the warning. Unfortunately when
getting an AV or HV from a GV, it wasn't checking whether gp_av/gp_hv
contained a NULL value. If so, it would SEGV.
The test code is a bit contrived; you have to "pull the rug" from under
the GV at just the right moment with *foo = *bar, then trigger an uninit
warning on an op whose subtree includes an OP_MULTIDEREF.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
sv.c | 5 ++++-
t/lib/warnings/9uninit | 10 ++++++++++
2 files changed, 14 insertions(+), 1 deletion(-)
diff --git a/sv.c b/sv.c
index 83de536ad7..4315fe9b64 100644
--- a/sv.c
+++ b/sv.c
@@ -16662,8 +16662,11 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
if (agg_targ)
sv = PAD_SV(agg_targ);
- else if (agg_gv)
+ else if (agg_gv) {
sv = is_hv ? MUTABLE_SV(GvHV(agg_gv)) : MUTABLE_SV(GvAV(agg_gv));
+ if (!sv)
+ break;
+ }
else
break;
diff --git a/t/lib/warnings/9uninit b/t/lib/warnings/9uninit
index 774c6ee432..5c173fdb2a 100644
--- a/t/lib/warnings/9uninit
+++ b/t/lib/warnings/9uninit
@@ -2206,3 +2206,13 @@ use warnings 'uninitialized';
undef $0;
EXPECT
Use of uninitialized value in undef operator at - line 5.
+########
+# RT #134275
+# This was SEGVing due to the multideref code in S_find_uninit_var not
+# handling a GV with a null gp_hv slot.
+use warnings 'uninitialized';
+"" =~ /$foo{a}${*foo=*bar}$x/;
+EXPECT
+Use of uninitialized value in regexp compilation at - line 5.
+Use of uninitialized value in regexp compilation at - line 5.
+Use of uninitialized value $x in regexp compilation at - line 5.
--
2.20.1

39
perl-5.31.1-perl-122112-make-sure-SIGPIPE-is-delivered-if-we-tes.patch Normal file
View File

@ -0,0 +1,39 @@
From 293a533c53d9c0fe939e23c439f4dfc47a5736dc Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 25 Jun 2019 15:47:57 +1000
Subject: [PATCH] (perl #122112) make sure SIGPIPE is delivered if we test it
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
t/io/pipe.t | 12 ++++++++++++
1 file changed, 12 insertions(+)
diff --git a/t/io/pipe.t b/t/io/pipe.t
index 9f5bb3bcf8..bdf743c26c 100644
--- a/t/io/pipe.t
+++ b/t/io/pipe.t
@@ -125,6 +125,18 @@ wait; # Collect from $pid
pipe(READER,WRITER) || die "Can't open pipe";
close READER;
+eval {
+ # one platform at least appears to block SIGPIPE by default (see #122112)
+ # so make sure it's unblocked.
+ # The eval wrapper should ensure this does nothing if these aren't
+ # implemented.
+ require POSIX;
+ my $mask = POSIX::SigSet->new(POSIX::SIGPIPE());
+ my $old = POSIX::SigSet->new();
+ POSIX::sigprocmask(POSIX::SIG_UNBLOCK(), $mask, $old);
+ note "Yes, SIGPIPE was blocked" if $old->ismember(POSIX::SIGPIPE());
+};
+
$SIG{'PIPE'} = 'broken_pipe';
sub broken_pipe {
--
2.20.1

128
perl-5.31.1-perl-134221-support-O_APPEND-for-open-.-undef-on-VMS.patch Normal file
View File

@ -0,0 +1,128 @@
From 74b421cc877e412c4eda06757396a1e19fc756ba Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 15 Jul 2019 11:53:23 +1000
Subject: [PATCH 3/3] (perl #134221) support O_APPEND for open ..., undef on
VMS
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
VMS doesn't allow you to delete an open file like POSIXish systems
do, but you can mark a file to be deleted once it's closed, but
only when you open it.
Since VMS doesn't (yet) have mkostemp() we can add our own flag to
our mkostemp() emulation to pass the necessary magic to open() call
to delete the file on close.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
perlio.c | 10 ++++++----
util.c | 15 ++++++++++++++-
util.h | 11 +++++++++++
3 files changed, 31 insertions(+), 5 deletions(-)
diff --git a/perlio.c b/perlio.c
index 81ebc156ad..805959f840 100644
--- a/perlio.c
+++ b/perlio.c
@@ -5062,7 +5062,7 @@ PerlIO_tmpfile_flags(int imode)
const int fd = win32_tmpfd_mode(imode);
if (fd >= 0)
f = PerlIO_fdopen(fd, "w+b");
-#elif ! defined(VMS) && ! defined(OS2)
+#elif ! defined(OS2)
int fd = -1;
char tempname[] = "/tmp/PerlIO_XXXXXX";
const char * const tmpdir = TAINTING_get ? NULL : PerlEnv_getenv("TMPDIR");
@@ -5073,19 +5073,19 @@ PerlIO_tmpfile_flags(int imode)
/* if TMPDIR is set and not empty, we try that first */
sv = newSVpv(tmpdir, 0);
sv_catpv(sv, tempname + 4);
- fd = Perl_my_mkostemp_cloexec(SvPVX(sv), imode);
+ fd = Perl_my_mkostemp_cloexec(SvPVX(sv), imode | O_VMS_DELETEONCLOSE);
}
if (fd < 0) {
SvREFCNT_dec(sv);
sv = NULL;
/* else we try /tmp */
- fd = Perl_my_mkostemp_cloexec(tempname, imode);
+ fd = Perl_my_mkostemp_cloexec(tempname, imode | O_VMS_DELETEONCLOSE);
}
if (fd < 0) {
/* Try cwd */
sv = newSVpvs(".");
sv_catpv(sv, tempname + 4);
- fd = Perl_my_mkostemp_cloexec(SvPVX(sv), imode);
+ fd = Perl_my_mkostemp_cloexec(SvPVX(sv), imode | O_VMS_DELETEONCLOSE);
}
umask(old_umask);
if (fd >= 0) {
@@ -5096,7 +5096,9 @@ PerlIO_tmpfile_flags(int imode)
f = PerlIO_fdopen(fd, mode);
if (f)
PerlIOBase(f)->flags |= PERLIO_F_TEMP;
+# ifndef VMS
PerlLIO_unlink(sv ? SvPVX_const(sv) : tempname);
+# endif
}
SvREFCNT_dec(sv);
#else /* !HAS_MKSTEMP, fallback to stdio tmpfile(). */
diff --git a/util.c b/util.c
index e6863f6dfe..165d13a39e 100644
--- a/util.c
+++ b/util.c
@@ -5712,6 +5712,11 @@ S_my_mkostemp(char *templte, int flags) {
STRLEN len = strlen(templte);
int fd;
int attempts = 0;
+#ifdef VMS
+ int delete_on_close = flags & O_VMS_DELETEONCLOSE;
+
+ flags &= ~O_VMS_DELETEONCLOSE;
+#endif
if (len < 6 ||
templte[len-1] != 'X' || templte[len-2] != 'X' || templte[len-3] != 'X' ||
@@ -5725,7 +5730,15 @@ S_my_mkostemp(char *templte, int flags) {
for (i = 1; i <= 6; ++i) {
templte[len-i] = TEMP_FILE_CH[(int)(Perl_internal_drand48() * TEMP_FILE_CH_COUNT)];
}
- fd = PerlLIO_open3(templte, O_RDWR | O_CREAT | O_EXCL | flags, 0600);
+#ifdef VMS
+ if (delete_on_close) {
+ fd = open(templte, O_RDWR | O_CREAT | O_EXCL | flags, 0600, "fop=dlt");
+ }
+ else
+#endif
+ {
+ fd = PerlLIO_open3(templte, O_RDWR | O_CREAT | O_EXCL | flags, 0600);
+ }
} while (fd == -1 && errno == EEXIST && ++attempts <= 100);
return fd;
diff --git a/util.h b/util.h
index d8fa3e8396..d9df7b39c6 100644
--- a/util.h
+++ b/util.h
@@ -248,6 +248,17 @@ means arg not present, 1 is empty string/null byte */
int mkstemp(char*);
#endif
+#ifdef PERL_CORE
+# if defined(VMS)
+/* only useful for calls to our mkostemp() emulation */
+# define O_VMS_DELETEONCLOSE 0x40000000
+# ifdef HAS_MKOSTEMP
+# error 134221 will need a new solution for VMS
+# endif
+# else
+# define O_VMS_DELETEONCLOSE 0
+# endif
+#endif
#if defined(HAS_MKOSTEMP) && defined(PERL_CORE)
# define Perl_my_mkostemp(templte, flags) mkostemp(templte, flags)
#endif
--
2.20.1

76
perl-5.31.1-perl-134221-support-append-mode-temp-files-on-Win32-.patch Normal file
View File

@ -0,0 +1,76 @@
From 0424723402ef153af8ee44222315d9b6a818d1ba Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 2 Jul 2019 15:22:26 +1000
Subject: [PATCH 2/3] (perl #134221) support append mode temp files on Win32
too
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
perlio.c | 2 +-
win32/win32.c | 10 +++++++++-
win32/win32iop.h | 1 +
3 files changed, 11 insertions(+), 2 deletions(-)
diff --git a/perlio.c b/perlio.c
index a737e79e02..81ebc156ad 100644
--- a/perlio.c
+++ b/perlio.c
@@ -5059,7 +5059,7 @@ PerlIO_tmpfile_flags(int imode)
#endif
PerlIO *f = NULL;
#ifdef WIN32
- const int fd = win32_tmpfd();
+ const int fd = win32_tmpfd_mode(imode);
if (fd >= 0)
f = PerlIO_fdopen(fd, "w+b");
#elif ! defined(VMS) && ! defined(OS2)
diff --git a/win32/win32.c b/win32/win32.c
index 8104d864c2..91fdffe09b 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -2907,10 +2907,18 @@ win32_rewind(FILE *pf)
DllExport int
win32_tmpfd(void)
+{
+ return win32_tmpfd_mode(0);
+}
+
+DllExport int
+win32_tmpfd_mode(int mode)
{
char prefix[MAX_PATH+1];
char filename[MAX_PATH+1];
DWORD len = GetTempPath(MAX_PATH, prefix);
+ mode &= ~( O_ACCMODE | O_CREAT | O_EXCL );
+ mode |= O_RDWR;
if (len && len < MAX_PATH) {
if (GetTempFileName(prefix, "plx", 0, filename)) {
HANDLE fh = CreateFile(filename,
@@ -2922,7 +2930,7 @@ win32_tmpfd(void)
| FILE_FLAG_DELETE_ON_CLOSE,
NULL);
if (fh != INVALID_HANDLE_VALUE) {
- int fd = win32_open_osfhandle((intptr_t)fh, 0);
+ int fd = win32_open_osfhandle((intptr_t)fh, mode);
if (fd >= 0) {
PERL_DEB(dTHX;)
DEBUG_p(PerlIO_printf(Perl_debug_log,
diff --git a/win32/win32iop.h b/win32/win32iop.h
index 53330e5951..559e1f9cd2 100644
--- a/win32/win32iop.h
+++ b/win32/win32iop.h
@@ -64,6 +64,7 @@ DllExport int win32_fgetpos(FILE *pf,fpos_t *p);
DllExport int win32_fsetpos(FILE *pf,const fpos_t *p);
DllExport void win32_rewind(FILE *pf);
DllExport int win32_tmpfd(void);
+DllExport int win32_tmpfd_mode(int mode);
DllExport FILE* win32_tmpfile(void);
DllExport void win32_abort(void);
DllExport int win32_fstat(int fd,Stat_t *sbufptr);
--
2.20.1

38
perl-5.31.2-PerlIO-Via-check-arg-is-non-NULL-before-using-it.patch Normal file
View File

@ -0,0 +1,38 @@
From 12e1284a67e5e3404c704c3f864749fd9f04c7c4 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 7 Aug 2019 14:58:14 +1000
Subject: [PATCH] PerlIO::Via: check arg is non-NULL before using it.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
I can't find any code in core that ends up calling the _pushed handler
with arg == NULL, but PerlIO_push() is API, and there might be
CPAN or DarkPAN code out there that does, escpecially since there's
a check for arg being non-NULL further down.
CID 169261.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
ext/PerlIO-via/via.xs | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/ext/PerlIO-via/via.xs b/ext/PerlIO-via/via.xs
index d91c6855fc..8456242bc0 100644
--- a/ext/PerlIO-via/via.xs
+++ b/ext/PerlIO-via/via.xs
@@ -134,8 +134,8 @@ PerlIOVia_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
{
IV code = PerlIOBase_pushed(aTHX_ f, mode, Nullsv, tab);
- if (SvTYPE(arg) >= SVt_PVMG
- && mg_findext(arg, PERL_MAGIC_ext, &PerlIOVia_tag)) {
+ if (arg && SvTYPE(arg) >= SVt_PVMG
+ && mg_findext(arg, PERL_MAGIC_ext, &PerlIOVia_tag)) {
return code;
}
--
2.21.0

30
perl-5.31.2-Run-tests-in-ext-File-Find-t-in-series.patch Normal file
View File

@ -0,0 +1,30 @@
From 665ac6aded4b9694283d373a0f127f32a3e75b26 Mon Sep 17 00:00:00 2001
From: James E Keenan <jkeenan@cpan.org>
Date: Wed, 7 Aug 2019 09:39:56 -0400
Subject: [PATCH] Run tests in ext/File-Find/t in series
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
For: RT # 133771
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
t/harness | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/t/harness b/t/harness
index caa2a318b8..b9857fa022 100644
--- a/t/harness
+++ b/t/harness
@@ -189,7 +189,7 @@ if (@ARGV) {
# directory containing such files should be tested in serial order.
#
# Add exceptions to the above rule
- for (qw(ext/Pod-Html/t cpan/IO-Zlib/t)) {
+ for (qw(ext/Pod-Html/t cpan/IO-Zlib/t ext/File-Find/t)) {
$serials{$_} = 1;
}
--
2.21.0

37
perl-5.31.2-include-a-trailing-0-in-SVs-holding-trie-info.patch Normal file
View File

@ -0,0 +1,37 @@
From 1d84a25665013f389ffc6fad7dd133f1c6287a08 Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Tue, 6 Aug 2019 14:36:45 +0100
Subject: [PATCH] include a trailing \0 in SVs holding trie info
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
RT #13427
TRIE_STORE_REVCHAR() was creating SvPV()s with no trailing '\0'. This
doesn't really matter given the specialised use these are put to, but
it upset valgrind et al when perl was run with -Drv which printf("%s")'s
the contents of the string.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
regcomp.c | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/regcomp.c b/regcomp.c
index 370221f72e..1117998fc8 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -2526,7 +2526,8 @@ is the recommended Unicode-aware way of saying
if (UTF) { \
SV *zlopp = newSV(UTF8_MAXBYTES); \
unsigned char *flrbbbbb = (unsigned char *) SvPVX(zlopp); \
- unsigned const char *const kapow = uvchr_to_utf8(flrbbbbb, val); \
+ unsigned char *const kapow = uvchr_to_utf8(flrbbbbb, val); \
+ *kapow = '\0'; \
SvCUR_set(zlopp, kapow - flrbbbbb); \
SvPOK_on(zlopp); \
SvUTF8_on(zlopp); \
--
2.20.1

48
perl-5.31.2-locale.c-Stop-Coverity-warning.patch Normal file
View File

@ -0,0 +1,48 @@
From 21dce8f4eb9136875a886371016aa25788f5144f Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Tue, 6 Aug 2019 21:29:22 -0600
Subject: [PATCH] locale.c: Stop Coverity warning
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Coverity is right, so re-order these clauses. This code is executed
only if some very strange error occurs.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
locale.c | 11 ++++++-----
1 file changed, 6 insertions(+), 5 deletions(-)
diff --git a/locale.c b/locale.c
index db83d993de..af7af60038 100644
--- a/locale.c
+++ b/locale.c
@@ -4349,11 +4349,6 @@ Perl__mem_collxfrm(pTHX_ const char *input_string,
return xbuf;
bad:
- Safefree(xbuf);
- if (s != input_string) {
- Safefree(s);
- }
- *xlen = 0;
# ifdef DEBUGGING
@@ -4363,6 +4358,12 @@ Perl__mem_collxfrm(pTHX_ const char *input_string,
# endif
+ Safefree(xbuf);
+ if (s != input_string) {
+ Safefree(s);
+ }
+ *xlen = 0;
+
return NULL;
}
--
2.20.1

54
perl-5.31.2-perl-134291-propagate-non-PVs-in-in-bare-die.patch Normal file
View File

@ -0,0 +1,54 @@
From 85d4e0a35b2d44cf06a9343d23a2f84b8ebb9024 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 17 Jul 2019 11:32:50 +1000
Subject: [PATCH] (perl #134291) propagate non-PVs in $@ in bare die()
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
pp_sys.c | 2 +-
t/op/die.t | 6 +++++-
2 files changed, 6 insertions(+), 2 deletions(-)
diff --git a/pp_sys.c b/pp_sys.c
index 0214367ea6..251527785e 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -498,7 +498,7 @@ PP(pp_die)
}
}
}
- else if (SvPOK(errsv) && SvCUR(errsv)) {
+ else if (SvOK(errsv) && (SvPV_nomg(errsv,len), len)) {
exsv = sv_mortalcopy(errsv);
sv_catpvs(exsv, "\t...propagated");
}
diff --git a/t/op/die.t b/t/op/die.t
index ef2b85f8f5..d6d7daffa5 100644
--- a/t/op/die.t
+++ b/t/op/die.t
@@ -6,7 +6,7 @@ BEGIN {
set_up_inc('../lib');
}
-plan tests => 20;
+plan tests => 21;
eval {
eval {
@@ -94,6 +94,10 @@ like($@, qr/\.{3}propagated at/, '... and appends a phrase');
local $SIG{__WARN__} = sub { $ok = 0 };
eval { undef $@; die };
is( $ok, 1, 'no warnings if $@ is undef' );
+
+ eval { $@ = 100; die };
+ like($@."", qr/100\t\.{3}propagated at/,
+ 'check non-PVs in $@ are propagated');
}
TODO: {
--
2.20.1

118
perl-5.31.2-perlapi-5.30-promise-not-met-change-to-5.32.patch Normal file
View File

@ -0,0 +1,118 @@
From 8b4b30c5d389983c3df51b7ff3b38e5608c7c2e2 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Sat, 3 Aug 2019 09:17:43 -0600
Subject: [PATCH] perlapi: 5.30 promise not met; change to 5.32
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
We delayed this change, but I forgot to change this documentation
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
handy.h | 24 ++++++++++++------------
1 file changed, 12 insertions(+), 12 deletions(-)
diff --git a/handy.h b/handy.h
index 24c028a638..2dfbc86125 100644
--- a/handy.h
+++ b/handy.h
@@ -609,13 +609,13 @@ future releases.
Variant C<isI<FOO>_utf8> is like C<isI<FOO>_utf8_safe>, but takes just a single
parameter, C<p>, which has the same meaning as the corresponding parameter does
in C<isI<FOO>_utf8_safe>. The function therefore can't check if it is reading
-beyond the end of the string. Starting in Perl v5.30, it will take a second
+beyond the end of the string. Starting in Perl v5.32, it will take a second
parameter, becoming a synonym for C<isI<FOO>_utf8_safe>. At that time every
program that uses it will have to be changed to successfully compile. In the
meantime, the first runtime call to C<isI<FOO>_utf8> from each call point in the
program will raise a deprecation warning, enabled by default. You can convert
your program now to use C<isI<FOO>_utf8_safe>, and avoid the warnings, and get an
-extra measure of protection, or you can wait until v5.30, when you'll be forced
+extra measure of protection, or you can wait until v5.32, when you'll be forced
to add the C<e> parameter.
Variant C<isI<FOO>_LC> is like the C<isI<FOO>_A> and C<isI<FOO>_L1> variants, but the
@@ -649,13 +649,13 @@ future releases.
Variant C<isI<FOO>_LC_utf8> is like C<isI<FOO>_LC_utf8_safe>, but takes just a single
parameter, C<p>, which has the same meaning as the corresponding parameter does
in C<isI<FOO>_LC_utf8_safe>. The function therefore can't check if it is reading
-beyond the end of the string. Starting in Perl v5.30, it will take a second
+beyond the end of the string. Starting in Perl v5.32, it will take a second
parameter, becoming a synonym for C<isI<FOO>_LC_utf8_safe>. At that time every
program that uses it will have to be changed to successfully compile. In the
meantime, the first runtime call to C<isI<FOO>_LC_utf8> from each call point in
the program will raise a deprecation warning, enabled by default. You can
convert your program now to use C<isI<FOO>_LC_utf8_safe>, and avoid the warnings,
-and get an extra measure of protection, or you can wait until v5.30, when
+and get an extra measure of protection, or you can wait until v5.32, when
you'll be forced to add the C<e> parameter.
=for apidoc Am|bool|isALPHA|char ch
@@ -897,13 +897,13 @@ implementation, and subject to change in future releases.
=for apidoc Am|UV|toUPPER_utf8|U8* p|U8* s|STRLEN* lenp
This is like C<L</toUPPER_utf8_safe>>, but doesn't have the C<e>
parameter The function therefore can't check if it is reading
-beyond the end of the string. Starting in Perl v5.30, it will take the C<e>
+beyond the end of the string. Starting in Perl v5.32, it will take the C<e>
parameter, becoming a synonym for C<toUPPER_utf8_safe>. At that time every
program that uses it will have to be changed to successfully compile. In the
meantime, the first runtime call to C<toUPPER_utf8> from each call point in the
program will raise a deprecation warning, enabled by default. You can convert
your program now to use C<toUPPER_utf8_safe>, and avoid the warnings, and get an
-extra measure of protection, or you can wait until v5.30, when you'll be forced
+extra measure of protection, or you can wait until v5.32, when you'll be forced
to add the C<e> parameter.
=for apidoc Am|U8|toFOLD|U8 ch
@@ -944,13 +944,13 @@ implementation, and subject to change in future releases.
=for apidoc Am|UV|toFOLD_utf8|U8* p|U8* s|STRLEN* lenp
This is like C<L</toFOLD_utf8_safe>>, but doesn't have the C<e>
parameter The function therefore can't check if it is reading
-beyond the end of the string. Starting in Perl v5.30, it will take the C<e>
+beyond the end of the string. Starting in Perl v5.32, it will take the C<e>
parameter, becoming a synonym for C<toFOLD_utf8_safe>. At that time every
program that uses it will have to be changed to successfully compile. In the
meantime, the first runtime call to C<toFOLD_utf8> from each call point in the
program will raise a deprecation warning, enabled by default. You can convert
your program now to use C<toFOLD_utf8_safe>, and avoid the warnings, and get an
-extra measure of protection, or you can wait until v5.30, when you'll be forced
+extra measure of protection, or you can wait until v5.32, when you'll be forced
to add the C<e> parameter.
=for apidoc Am|U8|toLOWER|U8 ch
@@ -999,13 +999,13 @@ implementation, and subject to change in future releases.
=for apidoc Am|UV|toLOWER_utf8|U8* p|U8* s|STRLEN* lenp
This is like C<L</toLOWER_utf8_safe>>, but doesn't have the C<e>
parameter The function therefore can't check if it is reading
-beyond the end of the string. Starting in Perl v5.30, it will take the C<e>
+beyond the end of the string. Starting in Perl v5.32, it will take the C<e>
parameter, becoming a synonym for C<toLOWER_utf8_safe>. At that time every
program that uses it will have to be changed to successfully compile. In the
meantime, the first runtime call to C<toLOWER_utf8> from each call point in the
program will raise a deprecation warning, enabled by default. You can convert
your program now to use C<toLOWER_utf8_safe>, and avoid the warnings, and get an
-extra measure of protection, or you can wait until v5.30, when you'll be forced
+extra measure of protection, or you can wait until v5.32, when you'll be forced
to add the C<e> parameter.
=for apidoc Am|U8|toTITLE|U8 ch
@@ -1047,13 +1047,13 @@ implementation, and subject to change in future releases.
=for apidoc Am|UV|toTITLE_utf8|U8* p|U8* s|STRLEN* lenp
This is like C<L</toLOWER_utf8_safe>>, but doesn't have the C<e>
parameter The function therefore can't check if it is reading
-beyond the end of the string. Starting in Perl v5.30, it will take the C<e>
+beyond the end of the string. Starting in Perl v5.32, it will take the C<e>
parameter, becoming a synonym for C<toTITLE_utf8_safe>. At that time every
program that uses it will have to be changed to successfully compile. In the
meantime, the first runtime call to C<toTITLE_utf8> from each call point in the
program will raise a deprecation warning, enabled by default. You can convert
your program now to use C<toTITLE_utf8_safe>, and avoid the warnings, and get an
-extra measure of protection, or you can wait until v5.30, when you'll be forced
+extra measure of protection, or you can wait until v5.32, when you'll be forced
to add the C<e> parameter.
=cut
--
2.21.0

36
perl-5.31.2-regcomp.c-Don-t-read-off-the-end-of-buffer.patch Normal file
View File

@ -0,0 +1,36 @@
From 31532982b04c20a43aa9c3d26780e3591c524fbc Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Thu, 27 Jun 2019 15:39:11 -0600
Subject: [PATCH] regcomp.c: Don't read off the end of buffer
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Until this commit, it was possible that \p{nv=3/} would cause the right
brace to be considered part of the property name.
Spotted by Hugo van der Sanden
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
regcomp.c | 4 +++-
1 file changed, 3 insertions(+), 1 deletion(-)
diff --git a/regcomp.c b/regcomp.c
index 1117998fc8..cf9246473f 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -23092,7 +23092,9 @@ Perl_parse_uniprop_string(pTHX_
}
/* Store the first real character in the denominator */
- lookup_name[j++] = name[i];
+ if (i < name_len) {
+ lookup_name[j++] = name[i];
+ }
}
}
--
2.21.0

30
perl-5.31.3-Configure-Include-stdlib.h-in-futimes-check.patch Normal file
View File

@ -0,0 +1,30 @@
From 425077e4b85509df2907be6c103d54c0687c7647 Mon Sep 17 00:00:00 2001
From: Florian Weimer <fweimer@redhat.com>
Date: Mon, 9 Sep 2019 19:35:47 +0200
Subject: [PATCH 1/2] Configure: Include <stdlib.h> in futimes check
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Needed for the exit function.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
Configure | 1 +
1 file changed, 1 insertion(+)
diff --git a/Configure b/Configure
index 818deb8378..7aa03d6aed 100755
--- a/Configure
+++ b/Configure
@@ -14091,6 +14091,7 @@ $cat >try.c <<EOCP
#include <sys/time.h>
#include <errno.h>
#include <fcntl.h>
+#include <stdlib.h>
int main ()
{
--
2.21.0

28
perl-5.31.3-Florian-Weimer-is-now-a-perl-author.patch Normal file
View File

@ -0,0 +1,28 @@
From da006e4432402cea01c9018743467314377e3c1e Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 10 Sep 2019 10:44:10 +1000
Subject: [PATCH 2/2] Florian Weimer is now a perl author
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
AUTHORS | 1 +
1 file changed, 1 insertion(+)
diff --git a/AUTHORS b/AUTHORS
index a2b6d8c15a..a554cfc045 100644
--- a/AUTHORS
+++ b/AUTHORS
@@ -418,6 +418,7 @@ Fergal Daly <fergal@esatclear.ie>
Fingle Nark <finglenark@gmail.com>
Florent Guillaume
Florian Ragwitz <rafl@debian.org>
+Florian Weimer <fweimer@redhat.com>
François Désarménien <desar@club-internet.fr>
François Perrad <francois.perrad@gadz.org>
Frank Crawford
--
2.21.0

31
perl-5.31.3-Supply-missing-right-brace-in-regex-example.patch Normal file
View File

@ -0,0 +1,31 @@
From 7ea7c4bb61d23965a7ad7041fe9c58b5075aac85 Mon Sep 17 00:00:00 2001
From: James E Keenan <jkeenan@cpan.org>
Date: Sat, 31 Aug 2019 19:18:36 -0400
Subject: [PATCH] Supply missing right brace in regex example
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
As suggested by Jim Avera in RT 134395.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
pod/perlrebackslash.pod | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/pod/perlrebackslash.pod b/pod/perlrebackslash.pod
index cfd182a7e1..4a8717346d 100644
--- a/pod/perlrebackslash.pod
+++ b/pod/perlrebackslash.pod
@@ -446,7 +446,7 @@ Mnemonic: I<g>roup.
=head3 Relative referencing
C<\g-I<N>> (starting in Perl 5.10.0) is used for relative addressing. (It can
-be written as C<\g{-I<N>>.) It refers to the I<N>th group before the
+be written as C<\g{-I<N>}>.) It refers to the I<N>th group before the
C<\g{-I<N>}>.
The big advantage of this form is that it makes it much easier to write
--
2.21.0

57
perl-5.31.3-perl-134230-don-t-interpret-0x-0b-when-numifying-str.patch Normal file
View File

@ -0,0 +1,57 @@
From 14d26b44a1d7eee67837ec0ea8fb0368ac6fe33e Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 20 Aug 2019 15:43:05 +1000
Subject: [PATCH] (perl #134230) don't interpret 0x, 0b when numifying strings
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
numeric.c | 9 +++++++++
t/op/int.t | 5 ++++-
2 files changed, 13 insertions(+), 1 deletion(-)
diff --git a/numeric.c b/numeric.c
index f5eadc8173..fae2eb3c6d 100644
--- a/numeric.c
+++ b/numeric.c
@@ -1551,6 +1551,15 @@ Perl_my_atof3(pTHX_ const char* orig, NV* value, const STRLEN len)
if ((endp = S_my_atof_infnan(aTHX_ s, negative, send, value)))
return endp;
+ /* strtold() accepts 0x-prefixed hex and in POSIX implementations,
+ 0b-prefixed binary numbers, which is backward incompatible
+ */
+ if ((len == 0 || len >= 2) && *s == '0' &&
+ (isALPHA_FOLD_EQ(s[1], 'x') || isALPHA_FOLD_EQ(s[1], 'b'))) {
+ *value = 0;
+ return (char *)s+1;
+ }
+
/* If the length is passed in, the input string isn't NUL-terminated,
* and in it turns out the function below assumes it is; therefore we
* create a copy and NUL-terminate that */
diff --git a/t/op/int.t b/t/op/int.t
index 7e936da68d..b730ab2672 100644
--- a/t/op/int.t
+++ b/t/op/int.t
@@ -7,7 +7,7 @@ BEGIN {
require Config;
}
-plan 17;
+plan 19;
# compile time evaluation
@@ -83,3 +83,6 @@ SKIP:
cmp_ok($x, "==", int($x), "check $x == int($x)");
}
}
+
+is(1+"0x10", 1, "check string '0x' prefix not treated as hex");
+is(1+"0b10", 1, "check string '0b' prefix not treated as binary");
--
2.21.0

31
perl-5.31.3-regcomp.c-Fix-wrong-limit-test.patch Normal file
View File

@ -0,0 +1,31 @@
From 8d3e0237887e7149be56d17a9448cb465edc5f76 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Thu, 22 Aug 2019 10:16:14 -0600
Subject: [PATCH] regcomp.c: Fix wrong limit test
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Spotted by Hugo van der Sanden in code reading.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
regcomp.c | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/regcomp.c b/regcomp.c
index aba6648da5..d61fd434fe 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -23132,7 +23132,7 @@ Perl_parse_uniprop_string(pTHX_
/* If the original input began with 'In' or 'Is', it could be a subroutine
* call to a user-defined property instead of a Unicode property name. */
- if ( non_pkg_begin + name_len > 2
+ if ( name_len - non_pkg_begin > 2
&& name[non_pkg_begin+0] == 'I'
&& (name[non_pkg_begin+1] == 'n' || name[non_pkg_begin+1] == 's'))
{
--
2.21.0

237
perl-5.31.4-Handle-undefined-values-correctly.patch Normal file
View File

@ -0,0 +1,237 @@
From 01aed385e6bdbdcfd13bb66e9d8b7c55d2cfc34a Mon Sep 17 00:00:00 2001
From: James E Keenan <jkeenan@cpan.org>
Date: Thu, 19 Sep 2019 23:02:54 -0400
Subject: [PATCH] Handle undefined values correctly
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
As reported by Henrik Pauli in RT 134441, the documentation's claim that
$dv->dumpValue([$x, $y]);
and
$dv->dumpValues($x, $y);
was not being sustained in the case where one of the elements in the
array (or array ref) was undefined. This was due to an insufficiently
precise specification within the dumpValues() method for determining
when the value "undef\n" should be printed.
Tests for previously untested cases have been provided in
t/rt-134441-dumpvalue.t. They were not appended to t/Dumpvalue.t (as
would normally have been the case) because the tests in that file have
accreted over the years in a sub-optimal manner: changes in attributes
of the Dumpvalue object are tested but those changes are not zeroed-out
(by, e.g., use of 'local $self->{attribute} = undef')
before additional attributes are modified and tested. As a consequence,
it's difficult to determine the state of the Dumpvalue object at any
particular point and interactions between attributes cannot be ruled
out.
Package TieOut, used to capture STDOUT during testing, has been
extracted to its own file so that it can be used by all test files.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
MANIFEST | 2 +
dist/Dumpvalue/lib/Dumpvalue.pm | 4 +-
dist/Dumpvalue/t/Dumpvalue.t | 20 +-----
dist/Dumpvalue/t/lib/TieOut.pm | 20 ++++++
dist/Dumpvalue/t/rt-134441-dumpvalue.t | 86 ++++++++++++++++++++++++++
5 files changed, 112 insertions(+), 20 deletions(-)
create mode 100644 dist/Dumpvalue/t/lib/TieOut.pm
create mode 100644 dist/Dumpvalue/t/rt-134441-dumpvalue.t
diff --git a/MANIFEST b/MANIFEST
index 7bf62d8479..8159ac8cc1 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -3455,6 +3455,8 @@ dist/Devel-SelfStubber/lib/Devel/SelfStubber.pm Generate stubs for SelfLoader.pm
dist/Devel-SelfStubber/t/Devel-SelfStubber.t See if Devel::SelfStubber works
dist/Dumpvalue/lib/Dumpvalue.pm Screen dump of perl values
dist/Dumpvalue/t/Dumpvalue.t See if Dumpvalue works
+dist/Dumpvalue/t/lib/TieOut.pm Helper module for Dumpvalue tests
+dist/Dumpvalue/t/rt-134441-dumpvalue.t See if Dumpvalue works
dist/encoding-warnings/lib/encoding/warnings.pm warn on implicit encoding conversions
dist/encoding-warnings/t/1-warning.t tests for encoding::warnings
dist/encoding-warnings/t/2-fatal.t tests for encoding::warnings
diff --git a/dist/Dumpvalue/lib/Dumpvalue.pm b/dist/Dumpvalue/lib/Dumpvalue.pm
index eef9b27157..3faf829538 100644
--- a/dist/Dumpvalue/lib/Dumpvalue.pm
+++ b/dist/Dumpvalue/lib/Dumpvalue.pm
@@ -1,7 +1,7 @@
use 5.006_001; # for (defined ref) and $#$v and our
package Dumpvalue;
use strict;
-our $VERSION = '1.18';
+our $VERSION = '1.19';
our(%address, $stab, @stab, %stab, %subs);
sub ASCII { return ord('A') == 65; }
@@ -79,7 +79,7 @@ sub dumpValues {
my $self = shift;
local %address;
local $^W=0;
- (print "undef\n"), return unless defined $_[0];
+ (print "undef\n"), return if (@_ == 1 and not defined $_[0]);
$self->unwrap(\@_,0);
}
diff --git a/dist/Dumpvalue/t/Dumpvalue.t b/dist/Dumpvalue/t/Dumpvalue.t
index 7063dd984c..ba8775126e 100644
--- a/dist/Dumpvalue/t/Dumpvalue.t
+++ b/dist/Dumpvalue/t/Dumpvalue.t
@@ -16,6 +16,8 @@ BEGIN {
our ( $foo, @bar, %baz );
+use lib ("./t/lib");
+use TieOut;
use Test::More tests => 88;
use_ok( 'Dumpvalue' );
@@ -278,21 +280,3 @@ is( $out->read, "0 0..0 'two'\n", 'dumpValues worked on array ref' );
$d->dumpValues('one', 'two');
is( $out->read, "0..1 'one' 'two'\n", 'dumpValues worked on multiple values' );
-
-package TieOut;
-use overload '"' => sub { "overloaded!" };
-
-sub TIEHANDLE {
- my $class = shift;
- bless(\( my $ref), $class);
-}
-
-sub PRINT {
- my $self = shift;
- $$self .= join('', @_);
-}
-
-sub read {
- my $self = shift;
- return substr($$self, 0, length($$self), '');
-}
diff --git a/dist/Dumpvalue/t/lib/TieOut.pm b/dist/Dumpvalue/t/lib/TieOut.pm
new file mode 100644
index 0000000000..568caedf9c
--- /dev/null
+++ b/dist/Dumpvalue/t/lib/TieOut.pm
@@ -0,0 +1,20 @@
+package TieOut;
+use overload '"' => sub { "overloaded!" };
+
+sub TIEHANDLE {
+ my $class = shift;
+ bless(\( my $ref), $class);
+}
+
+sub PRINT {
+ my $self = shift;
+ $$self .= join('', @_);
+}
+
+sub read {
+ my $self = shift;
+ return substr($$self, 0, length($$self), '');
+}
+
+1;
+
diff --git a/dist/Dumpvalue/t/rt-134441-dumpvalue.t b/dist/Dumpvalue/t/rt-134441-dumpvalue.t
new file mode 100644
index 0000000000..cc9f270f5a
--- /dev/null
+++ b/dist/Dumpvalue/t/rt-134441-dumpvalue.t
@@ -0,0 +1,86 @@
+BEGIN {
+ require Config;
+ if (($Config::Config{'extensions'} !~ m!\bList/Util\b!) ){
+ print "1..0 # Skip -- Perl configured without List::Util module\n";
+ exit 0;
+ }
+
+ # `make test` in the CPAN version of this module runs us with -w, but
+ # Dumpvalue.pm relies on all sorts of things that can cause warnings. I
+ # don't think that's worth fixing, so we just turn off all warnings
+ # during testing.
+ $^W = 0;
+}
+
+use lib ("./t/lib");
+use TieOut;
+use Test::More tests => 17;
+
+use_ok( 'Dumpvalue' );
+
+my $d;
+ok( $d = Dumpvalue->new(), 'create a new Dumpvalue object' );
+
+my $out = tie *OUT, 'TieOut';
+select(OUT);
+
+my (@foobar, $x, $y);
+
+@foobar = ('foo', 'bar');
+$d->dumpValue([@foobar]);
+$x = $out->read;
+is( $x, "0 'foo'\n1 'bar'\n", 'dumpValue worked on array ref' );
+$d->dumpValues(@foobar);
+$y = $out->read;
+is( $y, "0 'foo'\n1 'bar'\n", 'dumpValues worked on array' );
+is( $y, $x,
+ "dumpValues called on array returns same as dumpValue on array ref");
+
+@foobar = (undef, 'bar');
+$d->dumpValue([@foobar]);
+$x = $out->read;
+is( $x, "0 undef\n1 'bar'\n",
+ 'dumpValue worked on array ref, first element undefined' );
+$d->dumpValues(@foobar);
+$y = $out->read;
+is( $y, "0 undef\n1 'bar'\n",
+ 'dumpValues worked on array, first element undefined' );
+is( $y, $x,
+ "dumpValues called on array returns same as dumpValue on array ref, first element undefined");
+
+@foobar = ('bar', undef);
+$d->dumpValue([@foobar]);
+$x = $out->read;
+is( $x, "0 'bar'\n1 undef\n",
+ 'dumpValue worked on array ref, last element undefined' );
+$d->dumpValues(@foobar);
+$y = $out->read;
+is( $y, "0 'bar'\n1 undef\n",
+ 'dumpValues worked on array, last element undefined' );
+is( $y, $x,
+ "dumpValues called on array returns same as dumpValue on array ref, last element undefined");
+
+@foobar = ('', 'bar');
+$d->dumpValue([@foobar]);
+$x = $out->read;
+is( $x, "0 ''\n1 'bar'\n",
+ 'dumpValue worked on array ref, first element empty string' );
+$d->dumpValues(@foobar);
+$y = $out->read;
+is( $y, "0 ''\n1 'bar'\n",
+ 'dumpValues worked on array, first element empty string' );
+is( $y, $x,
+ "dumpValues called on array returns same as dumpValue on array ref, first element empty string");
+
+@foobar = ('bar', '');
+$d->dumpValue([@foobar]);
+$x = $out->read;
+is( $x, "0 'bar'\n1 ''\n",
+ 'dumpValue worked on array ref, last element empty string' );
+$d->dumpValues(@foobar);
+$y = $out->read;
+is( $y, "0 'bar'\n1 ''\n",
+ 'dumpValues worked on array, last element empty string' );
+is( $y, $x,
+ "dumpValues called on array returns same as dumpValue on array ref, last element empty string");
+
--
2.21.0

109
perl-5.31.5-Adapt-Configure-to-GCC-version-10.patch Normal file
View File

@ -0,0 +1,109 @@
From 913582217c96512015fd60f270f0e262824579b7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
Date: Tue, 12 Nov 2019 09:19:18 +0100
Subject: [PATCH] Adapt Configure to GCC version 10
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
I got a notice from Jeff Law <law@redhat.com>:
Your particular package fails its testsuite. This was ultimately
tracked down to a Configure problem. The perl configure script treated
gcc-10 as gcc-1 and turned on -fpcc-struct-return. This is an ABI
changing flag and caused Perl to not be able to interact properly with
the dbm libraries on the system leading to a segfault.
His proposed patch corrected only this one instance of the version
mismatch. Reading the Configure script revealed more issues. This
patch fixes all of them I found.
Please note I did not test it because I don't have GCC 10 available.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
Configure | 14 +++++++-------
cflags.SH | 2 +-
2 files changed, 8 insertions(+), 8 deletions(-)
diff --git a/Configure b/Configure
index fad1c9f2b1..706c0b64ed 100755
--- a/Configure
+++ b/Configure
@@ -4701,7 +4701,7 @@ else
fi
$rm -f try try.*
case "$gccversion" in
-1*) cpp=`./loc gcc-cpp $cpp $pth` ;;
+1.*) cpp=`./loc gcc-cpp $cpp $pth` ;;
esac
case "$gccversion" in
'') gccosandvers='' ;;
@@ -4741,7 +4741,7 @@ esac
# gcc 3.* complain about adding -Idirectories that they already know about,
# so we will take those off from locincpth.
case "$gccversion" in
-3*)
+3.*)
echo "main(){}">try.c
for incdir in $locincpth; do
warn=`$cc $ccflags -I$incdir -c try.c 2>&1 | \
@@ -5467,13 +5467,13 @@ fi
case "$hint" in
default|recommended)
case "$gccversion" in
- 1*) dflt="$dflt -fpcc-struct-return" ;;
+ 1.*) dflt="$dflt -fpcc-struct-return" ;;
esac
case "$optimize:$DEBUGGING" in
*-g*:old) dflt="$dflt -DDEBUGGING";;
esac
case "$gccversion" in
- 2*) if $test -d /etc/conf/kconfig.d &&
+ 2.*) if $test -d /etc/conf/kconfig.d &&
$contains _POSIX_VERSION $usrinc/sys/unistd.h >/dev/null 2>&1
then
# Interactive Systems (ISC) POSIX mode.
@@ -5482,7 +5482,7 @@ default|recommended)
;;
esac
case "$gccversion" in
- 1*) ;;
+ 1.*) ;;
2.[0-8]*) ;;
?*) set strict-aliasing -fno-strict-aliasing
eval $checkccflag
@@ -5600,7 +5600,7 @@ case "$cppflags" in
;;
esac
case "$gccversion" in
-1*) cppflags="$cppflags -D__GNUC__"
+1.*) cppflags="$cppflags -D__GNUC__"
esac
case "$mips_type" in
'');;
@@ -23103,7 +23103,7 @@ fi
: add -D_FORTIFY_SOURCE if feasible and not already there
case "$gccversion" in
-[456789].*) case "$optimize$ccflags" in
+[456789].*|[1-9][0-9]*) case "$optimize$ccflags" in
*-O*) case "$ccflags$cppsymbols" in
*_FORTIFY_SOURCE=*) # Don't add it again.
echo "You seem to have -D_FORTIFY_SOURCE already, not adding it." >&4
diff --git a/cflags.SH b/cflags.SH
index e60742fed1..f1bcd6c38e 100755
--- a/cflags.SH
+++ b/cflags.SH
@@ -156,7 +156,7 @@ esac
case "$gccversion" in
'') ;;
-[12]*) ;; # gcc versions 1 (gasp!) and 2 are not good for this.
+[12].*) ;; # gcc versions 1 (gasp!) and 2 are not good for this.
Intel*) ;; # # Is that you, Intel C++?
#
# NOTE 1: the -std=c89 without -pedantic is a bit pointless.
--
2.21.0

32
perl-5.31.5-Be-clearer-about-taint-s-effect-on-INC.patch Normal file
View File

@ -0,0 +1,32 @@
From a1c1fa25b1b25efb11cc8f987e007d4dd20056bc Mon Sep 17 00:00:00 2001
From: Dave Cross <dave@dave.org.uk>
Date: Wed, 23 Oct 2019 12:50:01 +0100
Subject: [PATCH] Be clearer about taint's effect on @INC.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
pod/perlsec.pod | 5 +++--
1 file changed, 3 insertions(+), 2 deletions(-)
diff --git a/pod/perlsec.pod b/pod/perlsec.pod
index 0682674143..a631981ba5 100644
--- a/pod/perlsec.pod
+++ b/pod/perlsec.pod
@@ -269,8 +269,9 @@ problem will be reported:
Insecure dependency in require while running with -T switch
On versions of Perl before 5.26, activating taint mode will also remove
-the current directory (".") from C<@INC>. Since version 5.26, the
-current directory isn't included in C<@INC>.
+the current directory (".") from the default value of C<@INC>. Since
+version 5.26, the current directory isn't included in C<@INC> by
+default.
=head2 Cleaning Up Your Path
--
2.21.0

45
perl-5.31.5-Fix-taint-mode-INC-documentation.patch Normal file
View File

@ -0,0 +1,45 @@
From f73351928dfa1d1d564d3f7b8e63c5281ed835ee Mon Sep 17 00:00:00 2001
From: Dave Cross <dave@dave.org.uk>
Date: Tue, 22 Oct 2019 14:24:13 +0100
Subject: [PATCH] Fix taint mode @INC documentation
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Explain that -T no longer removes '.' from @INC because, since
5.26, '.' isn't in @INC to start with.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
pod/perlsec.pod | 8 ++++++--
1 file changed, 6 insertions(+), 2 deletions(-)
diff --git a/pod/perlsec.pod b/pod/perlsec.pod
index b210445685..0682674143 100644
--- a/pod/perlsec.pod
+++ b/pod/perlsec.pod
@@ -245,8 +245,8 @@ Unix-like environments that support #! and setuid or setgid scripts.)
=head2 Taint mode and @INC
-When the taint mode (C<-T>) is in effect, the "." directory is removed
-from C<@INC>, and the environment variables C<PERL5LIB> and C<PERLLIB>
+When the taint mode (C<-T>) is in effect, the environment variables
+C<PERL5LIB> and C<PERLLIB>
are ignored by Perl. You can still adjust C<@INC> from outside the
program by using the C<-I> command line option as explained in
L<perlrun>. The two environment variables are ignored because
@@ -268,6 +268,10 @@ problem will be reported:
Insecure dependency in require while running with -T switch
+On versions of Perl before 5.26, activating taint mode will also remove
+the current directory (".") from C<@INC>. Since version 5.26, the
+current directory isn't included in C<@INC>.
+
=head2 Cleaning Up Your Path
For "Insecure C<$ENV{PATH}>" messages, you need to set C<$ENV{'PATH'}> to
--
2.21.0

30
perl-5.31.5-PATCH-gh-17218-memory-leak.patch Normal file
View File

@ -0,0 +1,30 @@
From 0463f3a19af7afac8b402655ad66e5b05c095bcc Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Fri, 15 Nov 2019 15:01:15 -0700
Subject: [PATCH] PATCH: gh#17218 memory leak
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Indeed, a variable's ref count was not getting decremented.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
regcomp.c | 1 +
1 file changed, 1 insertion(+)
diff --git a/regcomp.c b/regcomp.c
index 076ea350b5..7b9bf6ba7d 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -18180,6 +18180,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
/* Likewise for 'posixes' */
_invlist_union(posixes, cp_list, &cp_list);
+ SvREFCNT_dec(posixes);
/* Likewise for anything else in the range that matched only
* under UTF-8 */
--
2.21.0

77
perl-5.31.5-Tie-StdHandle-BINMODE-handle-layer-argument.patch Normal file
View File

@ -0,0 +1,77 @@
From a4e94e39cfa6852b1d57e61ee122c8083ab9d82e Mon Sep 17 00:00:00 2001
From: Hauke D <haukex@zero-g.net>
Date: Mon, 20 Nov 2017 15:31:57 +0100
Subject: [PATCH] Tie::StdHandle::BINMODE: handle layer argument
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Fixes #16262
BINMODE was not handling the LAYER argument.
Also bump the version number.
(cherry picked from commit 479d04b98e5b747e5c9ead7368d3e132f524a2b7)
Signed-off-by: Nicolas R <atoomic@cpan.org>
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
lib/Tie/Handle/stdhandle.t | 13 ++++++++++++-
lib/Tie/StdHandle.pm | 4 ++--
2 files changed, 14 insertions(+), 3 deletions(-)
diff --git a/lib/Tie/Handle/stdhandle.t b/lib/Tie/Handle/stdhandle.t
index d2f04bcc5c..6c20d90f2b 100644
--- a/lib/Tie/Handle/stdhandle.t
+++ b/lib/Tie/Handle/stdhandle.t
@@ -5,7 +5,7 @@ BEGIN {
@INC = '../lib';
}
-use Test::More tests => 27;
+use Test::More tests => 29;
use_ok('Tie::StdHandle');
@@ -72,6 +72,17 @@ is($b, "rhubarbX\n", "b eq rhubarbX");
$b = <$f>;
is($b, "89\n", "b eq 89");
+# binmode should pass through layer argument
+
+binmode $f, ':raw';
+ok !grep( $_ eq 'utf8', PerlIO::get_layers(tied(*$f)) ),
+ 'no utf8 in layers after binmode :raw';
+binmode $f, ':utf8';
+ok grep( $_ eq 'utf8', PerlIO::get_layers(tied(*$f)) ),
+ 'utf8 is in layers after binmode :utf8';
+
+# finish up
+
ok(eof($f), "eof");
ok(close($f), "close");
diff --git a/lib/Tie/StdHandle.pm b/lib/Tie/StdHandle.pm
index dfb86634f0..fb79a986c6 100644
--- a/lib/Tie/StdHandle.pm
+++ b/lib/Tie/StdHandle.pm
@@ -4,7 +4,7 @@ use strict;
use Tie::Handle;
our @ISA = 'Tie::Handle';
-our $VERSION = '4.5';
+our $VERSION = '4.6';
=head1 NAME
@@ -48,7 +48,7 @@ sub TELL { tell($_[0]) }
sub FILENO { fileno($_[0]) }
sub SEEK { seek($_[0],$_[1],$_[2]) }
sub CLOSE { close($_[0]) }
-sub BINMODE { binmode($_[0]) }
+sub BINMODE { &CORE::binmode(shift, @_) }
sub OPEN
{
--
2.21.0

48
perl-5.31.5-prevent-a-race-between-name-based-stat-and-an-open-m.patch Normal file
View File

@ -0,0 +1,48 @@
From 7c3f362035dec9b7eaec388b1f7f1619c1bd96a3 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 4 Nov 2019 09:52:22 +1100
Subject: [PATCH] prevent a race between name-based stat and an open modifying
atime
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Most linux systems rarely update atime, so it's very unlikely
for this issue to trigger there, but on a system with classic atime
behaviour this was a race between open modifying atime and time()
ticking over.
gh #17234
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
lib/File/stat.t | 6 ++++--
1 file changed, 4 insertions(+), 2 deletions(-)
diff --git a/lib/File/stat.t b/lib/File/stat.t
index c403fc4498..fc9bb12cef 100644
--- a/lib/File/stat.t
+++ b/lib/File/stat.t
@@ -133,6 +133,9 @@ SKIP: {
test_X_ops($^X, "for $^X", qr/A/);
}
+# open early so atime is consistent with the name based call
+local *STAT;
+my $canopen = open(STAT, '<', $file);
my $stat = File::stat::stat($file);
isa_ok($stat, 'File::stat', 'should build a stat object');
@@ -143,8 +146,7 @@ for (split //, "tTB") {
}
SKIP: {
- local *STAT;
- skip("Could not open file: $!", 2) unless open(STAT, '<', $file);
+ skip("Could not open file: $!", 2) unless $canopen;
isa_ok(File::stat::stat('STAT'), 'File::stat',
'... should be able to find filehandle');
--
2.21.0

78
perl-5.31.5-toke.c-Fix-bug-tr-upgrading-to-UTF-8-in-middle.patch Normal file
View File

@ -0,0 +1,78 @@
From 0c311b7c345769239f38d0139ea7738feec5ca4d Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Sat, 2 Nov 2019 13:59:38 -0600
Subject: [PATCH] toke.c: Fix bug tr/// upgrading to UTF-8 in middle
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Consider tr/\x{ff}-\x{100}/AB/.
While parsing, the code keeps an offset from the beginning of the output
to the beginning of the second number in the range. This is purely for
speed so that it wouldn't have to re-find the beginning of that value,
when it already knew it.
But the example above shows the folly of this shortcut. The second
number in the range causes the output to be upgraded to UTF-8, which
makes that offset invalid in general. Change to re-find the beginning.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
t/op/tr.t | 12 +++++++++++-
toke.c | 4 +++-
2 files changed, 14 insertions(+), 2 deletions(-)
diff --git a/t/op/tr.t b/t/op/tr.t
index 47d603d4fd..25125c5bc7 100644
--- a/t/op/tr.t
+++ b/t/op/tr.t
@@ -13,7 +13,7 @@ BEGIN {
use utf8;
-plan tests => 301;
+plan tests => 304;
# Test this first before we extend the stack with other operations.
# This caused an asan failure due to a bad write past the end of the stack.
@@ -1145,4 +1145,14 @@ for ("", nullrocow) {
'RT #133880 illegal \N{}');
}
+{
+ my $c = "\xff";
+ my $d = "\x{104}";
+ eval '$c =~ tr/\x{ff}-\x{104}/\x{100}-\x{105}/';
+ is($@, "", 'tr/\x{ff}-\x{104}/\x{100}-\x{105}/ compiled');
+ is($c, "\x{100}", 'ff -> 100');
+ eval '$d =~ tr/\x{ff}-\x{104}/\x{100}-\x{105}/';
+ is($d, "\x{105}", '104 -> 105');
+}
+
1;
diff --git a/toke.c b/toke.c
index 2995737af2..28f305c62c 100644
--- a/toke.c
+++ b/toke.c
@@ -3044,7 +3044,7 @@ S_scan_const(pTHX_ char *start)
* 'offset_to_max' is the offset in 'sv' at which the character
* (the range's maximum end point) before 'd' begins.
*/
- char * max_ptr = SvPVX(sv) + offset_to_max;
+ char * max_ptr;
char * min_ptr;
IV range_min;
IV range_max; /* last character in range */
@@ -3056,6 +3056,8 @@ S_scan_const(pTHX_ char *start)
IV real_range_max = 0;
#endif
/* Get the code point values of the range ends. */
+ max_ptr = (d_is_utf8) ? (char *) utf8_hop( (U8*) d, -1) : d - 1;
+ offset_to_max = max_ptr - SvPVX_const(sv);
if (d_is_utf8) {
/* We know the utf8 is valid, because we just constructed
* it ourselves in previous loop iterations */
--
2.21.0

48
perl-5.31.5-toke.c-comment-changes.patch Normal file
View File

@ -0,0 +1,48 @@
From d7f7b0e39a10a6e3e0bd81d15473ee522a064016 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Mon, 4 Nov 2019 21:55:53 -0700
Subject: [PATCH] toke.c: comment changes
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
These should have been included in
0c311b7c345769239f38d0139ea7738feec5ca4d
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
toke.c | 11 ++---------
1 file changed, 2 insertions(+), 9 deletions(-)
diff --git a/toke.c b/toke.c
index 3f376640ef..9c1e77f9db 100644
--- a/toke.c
+++ b/toke.c
@@ -3032,13 +3032,8 @@ S_scan_const(pTHX_ char *start)
s++; /* Skip past the hyphen */
/* d now points to where the end-range character will be
- * placed. Save it so won't have to go finding it later,
- * and drop down to get that character. (Actually we
- * instead save the offset, to handle the case where a
- * realloc in the meantime could change the actual
- * pointer). We'll finish processing the range the next
- * time through the loop */
- offset_to_max = d - SvPVX_const(sv);
+ * placed. Drop down to get that character. We'll finish
+ * processing the range the next time through the loop */
if (s_is_utf8 && UTF8_IS_ABOVE_LATIN1(*s)) {
has_above_latin1 = TRUE;
@@ -3055,8 +3050,6 @@ S_scan_const(pTHX_ char *start)
* are the range start and range end, in order.
* 'd' points to just beyond the range end in the 'sv' string,
* where we would next place something
- * 'offset_to_max' is the offset in 'sv' at which the character
- * (the range's maximum end point) before 'd' begins.
*/
char * max_ptr;
char * min_ptr;
--
2.21.0

47
perl-5.8.0-libdir64.patch Normal file
View File

@ -0,0 +1,47 @@
diff -up perl-5.28.0-RC1/Configure.orig perl-5.28.0-RC1/Configure
--- perl-5.28.0-RC1/Configure.orig 2018-05-21 12:44:04.000000000 +0200
+++ perl-5.28.0-RC1/Configure 2018-05-22 12:21:53.908599933 +0200
@@ -7269,8 +7269,8 @@ esac'
: 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" ;;
@@ -7336,8 +7336,8 @@ esac
: /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
@@ -7584,8 +7584,8 @@ siteprefixexp="$ansexp"
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"
@@ -8001,8 +8001,8 @@ case "$vendorprefix" in
'')
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"

109
perl-USE_MM_LD_RUN_PATH.patch Normal file
View File

@ -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
@@ -89,6 +89,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
@@ -317,7 +317,7 @@ sub full_setup {
PERM_DIR PERM_RW PERM_RWX MAGICXS
PL_FILES PM PM_FILTER PMLIBDIRS PMLIBPARENTDIRS POLLUTE
PREREQ_FATAL PREREQ_PM PREREQ_PRINT PRINT_PREREQ
- SIGN SKIP TEST_REQUIRES TYPEMAPS UNINST VERSION VERSION_FROM XS
+ SIGN SKIP TEST_REQUIRES TYPEMAPS UNINST USE_MM_LD_RUN_PATH VERSION VERSION_FROM XS
XSBUILD XSMULTI XSOPT XSPROTOARG XS_VERSION
clean depend dist dynamic_lib linkext macro realclean tool_autosplit
@@ -501,7 +501,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 "MakeMaker (v$VERSION)\n" if $Verbose;
if (-f "MANIFEST" && ! -f "Makefile" && ! $UNDER_CORE){
@@ -2821,6 +2841,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
@@ -1045,7 +1045,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)" ';
}

21
perl-example.stp Normal file
View File

@ -0,0 +1,21 @@
/*
Example of the perl systemtap tapset shows a nested view of perl subroutine
calls and returns across the whole system.
To run:
stap perl-example.stp (for all perl processes)
For specific perl process:
stap perl-example.stp -c COMMAND
*/
probe perl.sub.call
{
printf("%s => sub: %s, filename: %s, line: %d, package: %s\n",
thread_indent(1), sub, filename, lineno, package)
}
probe perl.sub.return
{
printf("%s <= sub: %s, filename: %s, line: %d, package: %s\n",
thread_indent(-1), sub, filename, lineno, package)
}

21
perl-perlbug-tag.patch Normal file
View File

@ -0,0 +1,21 @@
diff -up perl-5.28.0-RC1/utils/perlbug.PL.orig perl-5.28.0-RC1/utils/perlbug.PL
--- perl-5.28.0-RC1/utils/perlbug.PL.orig 2018-05-21 12:44:04.000000000 +0200
+++ perl-5.28.0-RC1/utils/perlbug.PL 2018-05-22 12:17:58.584993588 +0200
@@ -288,17 +288,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

7045
perl.spec Normal file
View File

File diff suppressed because it is too large Load Diff

71
perl.stp Normal file
View File

@ -0,0 +1,71 @@
/*
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)
}
/*
Fires when Perl has successfully loaded an individual file.
*/
probe perl.loaded.file = process("LIBRARY_PATH").mark("loaded__file")
{
filename = user_string($arg1)
}
/*
Fires when Perl is about to load an individual file.
*/
probe perl.loading.file = process("LIBRARY_PATH").mark("loading__file")
{
filename = user_string($arg1)
}
/*
Traces the execution of each opcode in the Perl runloop.
*/
probe perl.op.entry = process("LIBRARY_PATH").mark("op__entry")
{
opname = user_string($arg1)
}

2
sources Normal file
View File

@ -0,0 +1,2 @@
SHA512 (perl-5.30.1-study_chunk-avoid-mutating-regexp-program-within-GOS.patch) = 40053baf5241860a115d53e6b8af1db3b2a70ddb87605ec38d581960b7dde946440a094d651d01bc4ed6e7e0f03b1264d15ff2c6414a8030d06c208530738ac9
SHA512 (perl-5.30.1.tar.xz) = 8f3339efdcd1bb58fa58a90042181bef86bb09e4598c737e446ed43b56d2ab23d67eced5e36fb08fc61e076acfdb572a12e46a1277f5299a3f412054df0b88bf