import perl-5.30.1-451.module+el8.3.0+6961+31ca2e7a
This commit is contained in:
commit
178f452286
1
.gitignore
vendored
Normal file
1
.gitignore
vendored
Normal file
@ -0,0 +1 @@
|
||||
SOURCES/perl-5.30.1.tar.xz
|
1
.perl.metadata
Normal file
1
.perl.metadata
Normal file
@ -0,0 +1 @@
|
||||
4bc190b6ac368f573e6a028f91430f831d40d30a SOURCES/perl-5.30.1.tar.xz
|
41
SOURCES/Pod-Html-license-clarification
Normal file
41
SOURCES/Pod-Html-license-clarification
Normal 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
SOURCES/gendep.macros
Normal file
2076
SOURCES/gendep.macros
Normal file
File diff suppressed because it is too large
Load Diff
158
SOURCES/macros.perl
Normal file
158
SOURCES/macros.perl
Normal 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
SOURCES/perl-5.10.0-libresolv.patch
Normal file
12
SOURCES/perl-5.10.0-libresolv.patch
Normal 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
SOURCES/perl-5.10.0-x86_64-io-test-failure.patch
Normal file
12
SOURCES/perl-5.10.0-x86_64-io-test-failure.patch
Normal 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
SOURCES/perl-5.14.1-offtest.patch
Normal file
17
SOURCES/perl-5.14.1-offtest.patch
Normal 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;
|
@ -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
|
||||
|
@ -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
SOURCES/perl-5.16.3-create_libperl_soname.patch
Normal file
57
SOURCES/perl-5.16.3-create_libperl_soname.patch
Normal 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
|
||||
'') ;;
|
@ -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
|
||||
|
@ -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
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
SOURCES/perl-5.28.0-Pass-CFLAGS-to-dtrace.patch
Normal file
63
SOURCES/perl-5.28.0-Pass-CFLAGS-to-dtrace.patch
Normal 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
|
||||
|
@ -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=7vno3fVuppO8RoQO7l$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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
SOURCES/perl-5.30.0-pp.c-Add-two-UNLIKELY-s.patch
Normal file
42
SOURCES/perl-5.30.0-pp.c-Add-two-UNLIKELY-s.patch
Normal 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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -0,0 +1,306 @@
|
||||
From 783ddef8fc74b00cde72898c2c3228853dc82d91 Mon Sep 17 00:00:00 2001
|
||||
From: Hugo van der Sanden <hv@crypt.org>
|
||||
Date: Sat, 11 Apr 2020 14:10:24 +0100
|
||||
Subject: [PATCH] study_chunk: avoid mutating regexp program within GOSUB
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
gh16947 and gh17743: studying GOSUB may restudy in an inner call
|
||||
(via a mix of recursion and enframing) something that an outer call
|
||||
is in the middle of looking at. Let the outer frame deal with it.
|
||||
|
||||
(CVE-2020-12723)
|
||||
|
||||
(cherry picked from commit c4033e740bd18d9fbe3456a9db2ec2053cdc5271)
|
||||
Petr Písař: Ported to 5.30.1 from
|
||||
66bbb51b93253a3f87d11c2695cfb7bdb782184a.
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
embed.fnc | 2 +-
|
||||
embed.h | 2 +-
|
||||
proto.h | 2 +-
|
||||
regcomp.c | 54 +++++++++++++++++++++++++++++++++++-------------------
|
||||
t/re/pat.t | 26 +++++++++++++++++++++++++-
|
||||
5 files changed, 63 insertions(+), 23 deletions(-)
|
||||
|
||||
diff --git a/embed.fnc b/embed.fnc
|
||||
index 1b9cf54..d0463e4 100644
|
||||
--- a/embed.fnc
|
||||
+++ b/embed.fnc
|
||||
@@ -2482,7 +2482,7 @@ Es |SSize_t|study_chunk |NN RExC_state_t *pRExC_state \
|
||||
|NULLOK struct scan_data_t *data \
|
||||
|I32 stopparen|U32 recursed_depth \
|
||||
|NULLOK regnode_ssc *and_withp \
|
||||
- |U32 flags|U32 depth
|
||||
+ |U32 flags|U32 depth|bool was_mutate_ok
|
||||
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 \
|
||||
diff --git a/embed.h b/embed.h
|
||||
index cf44011..72c2a8e 100644
|
||||
--- a/embed.h
|
||||
+++ b/embed.h
|
||||
@@ -1239,7 +1239,7 @@
|
||||
#define ssc_is_cp_posixl_init S_ssc_is_cp_posixl_init
|
||||
#define ssc_or(a,b,c) S_ssc_or(aTHX_ a,b,c)
|
||||
#define ssc_union(a,b,c) S_ssc_union(aTHX_ a,b,c)
|
||||
-#define study_chunk(a,b,c,d,e,f,g,h,i,j,k) S_study_chunk(aTHX_ a,b,c,d,e,f,g,h,i,j,k)
|
||||
+#define study_chunk(a,b,c,d,e,f,g,h,i,j,k,l) S_study_chunk(aTHX_ a,b,c,d,e,f,g,h,i,j,k,l)
|
||||
# endif
|
||||
# if defined(PERL_IN_REGCOMP_C) || defined (PERL_IN_DUMP_C)
|
||||
#define _invlist_dump(a,b,c,d) Perl__invlist_dump(aTHX_ a,b,c,d)
|
||||
diff --git a/proto.h b/proto.h
|
||||
index ee74153..9a3ce27 100644
|
||||
--- a/proto.h
|
||||
+++ b/proto.h
|
||||
@@ -5671,7 +5671,7 @@ PERL_STATIC_INLINE void S_ssc_union(pTHX_ regnode_ssc *ssc, SV* const invlist, c
|
||||
#define PERL_ARGS_ASSERT_SSC_UNION \
|
||||
assert(ssc); assert(invlist)
|
||||
#endif
|
||||
-STATIC SSize_t S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, SSize_t *minlenp, SSize_t *deltap, regnode *last, struct scan_data_t *data, I32 stopparen, U32 recursed_depth, regnode_ssc *and_withp, U32 flags, U32 depth);
|
||||
+STATIC SSize_t S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, SSize_t *minlenp, SSize_t *deltap, regnode *last, struct scan_data_t *data, I32 stopparen, U32 recursed_depth, regnode_ssc *and_withp, U32 flags, U32 depth, bool was_mutate_ok);
|
||||
#define PERL_ARGS_ASSERT_STUDY_CHUNK \
|
||||
assert(pRExC_state); assert(scanp); assert(minlenp); assert(deltap); assert(last)
|
||||
#endif
|
||||
diff --git a/regcomp.c b/regcomp.c
|
||||
index b101752..b9ea2a0 100644
|
||||
--- a/regcomp.c
|
||||
+++ b/regcomp.c
|
||||
@@ -106,6 +106,7 @@ typedef struct scan_frame {
|
||||
regnode *next_regnode; /* next node to process when last is reached */
|
||||
U32 prev_recursed_depth;
|
||||
I32 stopparen; /* what stopparen do we use */
|
||||
+ bool in_gosub; /* this or an outer frame is for GOSUB */
|
||||
|
||||
struct scan_frame *this_prev_frame; /* this previous frame */
|
||||
struct scan_frame *prev_frame; /* previous frame */
|
||||
@@ -4475,7 +4476,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
|
||||
I32 stopparen,
|
||||
U32 recursed_depth,
|
||||
regnode_ssc *and_withp,
|
||||
- U32 flags, U32 depth)
|
||||
+ U32 flags, U32 depth, bool was_mutate_ok)
|
||||
/* scanp: Start here (read-write). */
|
||||
/* deltap: Write maxlen-minlen here. */
|
||||
/* last: Stop before this one. */
|
||||
@@ -4554,6 +4555,10 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
|
||||
node length to get a real minimum (because
|
||||
the folded version may be shorter) */
|
||||
bool unfolded_multi_char = FALSE;
|
||||
+ /* avoid mutating ops if we are anywhere within the recursed or
|
||||
+ * enframed handling for a GOSUB: the outermost level will handle it.
|
||||
+ */
|
||||
+ bool mutate_ok = was_mutate_ok && !(frame && frame->in_gosub);
|
||||
/* Peephole optimizer: */
|
||||
DEBUG_STUDYDATA("Peep", data, depth, is_inf);
|
||||
DEBUG_PEEP("Peep", scan, depth, flags);
|
||||
@@ -4564,7 +4569,8 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
|
||||
* parsing code, as each (?:..) is handled by a different invocation of
|
||||
* reg() -- Yves
|
||||
*/
|
||||
- JOIN_EXACT(scan,&min_subtract, &unfolded_multi_char, 0);
|
||||
+ if (mutate_ok)
|
||||
+ 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.
|
||||
@@ -4596,7 +4602,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
|
||||
/* DEFINEP study_chunk() recursion */
|
||||
(void)study_chunk(pRExC_state, &scan, &minlen,
|
||||
&deltanext, next, &data_fake, stopparen,
|
||||
- recursed_depth, NULL, f, depth+1);
|
||||
+ recursed_depth, NULL, f, depth+1, mutate_ok);
|
||||
|
||||
scan = next;
|
||||
} else
|
||||
@@ -4664,7 +4670,8 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
|
||||
/* recurse study_chunk() for each BRANCH in an alternation */
|
||||
minnext = study_chunk(pRExC_state, &scan, minlenp,
|
||||
&deltanext, next, &data_fake, stopparen,
|
||||
- recursed_depth, NULL, f, depth+1);
|
||||
+ recursed_depth, NULL, f, depth+1,
|
||||
+ mutate_ok);
|
||||
|
||||
if (min1 > minnext)
|
||||
min1 = minnext;
|
||||
@@ -4731,9 +4738,10 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
|
||||
}
|
||||
}
|
||||
|
||||
- if (PERL_ENABLE_TRIE_OPTIMISATION &&
|
||||
- OP( startbranch ) == BRANCH )
|
||||
- {
|
||||
+ if (PERL_ENABLE_TRIE_OPTIMISATION
|
||||
+ && OP(startbranch) == BRANCH
|
||||
+ && mutate_ok
|
||||
+ ) {
|
||||
/* demq.
|
||||
|
||||
Assuming this was/is a branch we are dealing with: 'scan'
|
||||
@@ -5188,6 +5196,9 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
|
||||
newframe->stopparen = stopparen;
|
||||
newframe->prev_recursed_depth = recursed_depth;
|
||||
newframe->this_prev_frame= frame;
|
||||
+ newframe->in_gosub = (
|
||||
+ (frame && frame->in_gosub) || OP(scan) == GOSUB
|
||||
+ );
|
||||
|
||||
DEBUG_STUDYDATA("frame-new", data, depth, is_inf);
|
||||
DEBUG_PEEP("fnew", scan, depth, flags);
|
||||
@@ -5345,7 +5356,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
|
||||
|
||||
/* This temporary node can now be turned into EXACTFU, and
|
||||
* must, as regexec.c doesn't handle it */
|
||||
- if (OP(next) == EXACTFU_S_EDGE) {
|
||||
+ if (OP(next) == EXACTFU_S_EDGE && mutate_ok) {
|
||||
OP(next) = EXACTFU;
|
||||
}
|
||||
|
||||
@@ -5353,8 +5364,9 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
|
||||
&& isALPHA_A(* STRING(next))
|
||||
&& ( OP(next) == EXACTFAA
|
||||
|| ( OP(next) == EXACTFU
|
||||
- && ! HAS_NONLATIN1_SIMPLE_FOLD_CLOSURE(* STRING(next)))))
|
||||
- {
|
||||
+ && ! HAS_NONLATIN1_SIMPLE_FOLD_CLOSURE(* STRING(next))))
|
||||
+ && mutate_ok
|
||||
+ ) {
|
||||
/* These differ in just one bit */
|
||||
U8 mask = ~ ('A' ^ 'a');
|
||||
|
||||
@@ -5441,7 +5453,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
|
||||
(mincount == 0
|
||||
? (f & ~SCF_DO_SUBSTR)
|
||||
: f)
|
||||
- ,depth+1);
|
||||
+ , depth+1, mutate_ok);
|
||||
|
||||
if (flags & SCF_DO_STCLASS)
|
||||
data->start_class = oclass;
|
||||
@@ -5507,7 +5519,9 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
|
||||
if ( OP(oscan) == CURLYX && data
|
||||
&& data->flags & SF_IN_PAR
|
||||
&& !(data->flags & SF_HAS_EVAL)
|
||||
- && !deltanext && minnext == 1 ) {
|
||||
+ && !deltanext && minnext == 1
|
||||
+ && mutate_ok
|
||||
+ ) {
|
||||
/* Try to optimize to CURLYN. */
|
||||
regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS;
|
||||
regnode * const nxt1 = nxt;
|
||||
@@ -5557,10 +5571,10 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
|
||||
&& !(data->flags & SF_HAS_EVAL)
|
||||
&& !deltanext /* atom is fixed width */
|
||||
&& minnext != 0 /* CURLYM can't handle zero width */
|
||||
-
|
||||
/* Nor characters whose fold at run-time may be
|
||||
* multi-character */
|
||||
&& ! (RExC_seen & REG_UNFOLDED_MULTI_SEEN)
|
||||
+ && mutate_ok
|
||||
) {
|
||||
/* XXXX How to optimize if data == 0? */
|
||||
/* Optimize to a simpler form. */
|
||||
@@ -5613,7 +5627,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
|
||||
/* recurse study_chunk() on optimised CURLYX => CURLYM */
|
||||
study_chunk(pRExC_state, &nxt1, minlenp, &deltanext, nxt,
|
||||
NULL, stopparen, recursed_depth, NULL, 0,
|
||||
- depth+1);
|
||||
+ depth+1, mutate_ok);
|
||||
}
|
||||
else
|
||||
oscan->flags = 0;
|
||||
@@ -6018,7 +6032,8 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n",
|
||||
/* recurse study_chunk() for lookahead body */
|
||||
minnext = study_chunk(pRExC_state, &nscan, minlenp, &deltanext,
|
||||
last, &data_fake, stopparen,
|
||||
- recursed_depth, NULL, f, depth+1);
|
||||
+ recursed_depth, NULL, f, depth+1,
|
||||
+ mutate_ok);
|
||||
if (scan->flags) {
|
||||
if ( deltanext < 0
|
||||
|| deltanext > (I32) U8_MAX
|
||||
@@ -6123,7 +6138,7 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n",
|
||||
*minnextp = study_chunk(pRExC_state, &nscan, minnextp,
|
||||
&deltanext, last, &data_fake,
|
||||
stopparen, recursed_depth, NULL,
|
||||
- f, depth+1);
|
||||
+ f, depth+1, mutate_ok);
|
||||
if (scan->flags) {
|
||||
assert(0); /* This code has never been tested since this
|
||||
is normally not compiled */
|
||||
@@ -6291,7 +6306,8 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n",
|
||||
/* optimise study_chunk() for TRIE */
|
||||
minnext = study_chunk(pRExC_state, &scan, minlenp,
|
||||
&deltanext, (regnode *)nextbranch, &data_fake,
|
||||
- stopparen, recursed_depth, NULL, f, depth+1);
|
||||
+ stopparen, recursed_depth, NULL, f, depth+1,
|
||||
+ mutate_ok);
|
||||
}
|
||||
if (nextbranch && PL_regkind[OP(nextbranch)]==BRANCH)
|
||||
nextbranch= regnext((regnode*)nextbranch);
|
||||
@@ -8084,7 +8100,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
|
||||
&data, -1, 0, NULL,
|
||||
SCF_DO_SUBSTR | SCF_WHILEM_VISITED_POS | stclass_flag
|
||||
| (restudied ? SCF_TRIE_DOING_RESTUDY : 0),
|
||||
- 0);
|
||||
+ 0, TRUE);
|
||||
|
||||
|
||||
CHECK_RESTUDY_GOTO_butfirst(LEAVE_with_name("study_chunk"));
|
||||
@@ -8213,7 +8229,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
|
||||
SCF_DO_STCLASS_AND|SCF_WHILEM_VISITED_POS|(restudied
|
||||
? SCF_TRIE_DOING_RESTUDY
|
||||
: 0),
|
||||
- 0);
|
||||
+ 0, TRUE);
|
||||
|
||||
CHECK_RESTUDY_GOTO_butfirst(NOOP);
|
||||
|
||||
diff --git a/t/re/pat.t b/t/re/pat.t
|
||||
index 6a868f4..ba89a58 100644
|
||||
--- a/t/re/pat.t
|
||||
+++ b/t/re/pat.t
|
||||
@@ -25,7 +25,7 @@ BEGIN {
|
||||
skip_all('no re module') unless defined &DynaLoader::boot_DynaLoader;
|
||||
skip_all_without_unicode_tables();
|
||||
|
||||
-plan tests => 864; # Update this when adding/deleting tests.
|
||||
+plan tests => 868; # Update this when adding/deleting tests.
|
||||
|
||||
run_tests() unless caller;
|
||||
|
||||
@@ -2115,6 +2115,30 @@ x{0c!}\;\;îçÿ |