RHEL 9.0.0 Alpha bootstrap

The content of this branch was automatically imported from Fedora ELN
with the following as its source:
https://src.fedoraproject.org/rpms/perl#f36ef6bc94783b6bfd8b4017d7c2a7b66ef15460
This commit is contained in:
Petr Šabata 2020-10-15 23:08:03 +02:00
parent 9383b48251
commit 500a208fa3
59 changed files with 14802 additions and 0 deletions

37
.gitignore vendored
View File

@ -0,0 +1,37 @@
perl-5.12.1.tar.gz
/perl-5.12.2.tar.gz
/perl-5.12.3.tar.gz
/perl-5.14.0-RC2.tar.bz2
/perl-5.14.0.tar.bz2
/perl-5.14.0.tar.gz
/perl-5.14.1.tar.gz
/perl-5.14.2.tar.bz2
/perl-5.16.0-RC2.tar.gz
/perl-5.16.0.tar.gz
/perl-5.16.1-228.fc19.src.rpm
/perl-5.16.1.tar.gz
/perl-5.16.2.tar.gz
/perl-5.16.3.tar.bz2
/perl-5.18.0.tar.bz2
/perl-5.18.1.tar.bz2
/perl-5.18.2.tar.bz2
/perl-5.20.0.tar.bz2
/perl-5.20.1.tar.bz2
/perl-5.20.2.tar.bz2
/perl-5.22.0.tar.bz2
/perl-5.22.1.tar.bz2
/perl-5.22.2.tar.bz2
/perl-5.24.0.tar.bz2
/perl-5.24.1.tar.bz2
/perl-5.26.0.tar.bz2
/perl-5.26.1.tar.bz2
/perl-5.26.2-RC1.tar.bz2
/perl-5.26.2.tar.bz2
/perl-5.28.0.tar.xz
/perl-5.28.1.tar.xz
/perl-5.28.2.tar.xz
/perl-5.30.0.tar.xz
/perl-5.30.1.tar.xz
/perl-5.30.2.tar.xz
/perl-5.30.3.tar.xz
/perl-5.32.0.tar.xz

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

29
STAGE2-perl Normal file
View File

@ -0,0 +1,29 @@
#requires gdbm
mcd $BUILDDIR/perl
GV=$(cd $SRC; echo perl-*)
SONAME_VER=`echo $GV | cut -f2- -d'-' | sed 's/^\\([^.]*\\.[^.]*\\).*/\\1/'`
PERL_VER=`echo $GV | cut -f2- -d'-'`
cd $SRC/$GV
sh $SRC/$GV/Configure -des -Dprefix=/usr -Dlibpth="/usr/local/lib$SUFFIX /lib$SUFFIX /usr/lib$SUFFIX" -Darchlib="/usr/lib$SUFFIX/perl5" -Dsitelib="/usr/local/share/perl5" -DDEBUGGING=-g -Dcc=gcc -Dmyhostname=localhost -Dperladmin=root@localhost -Duseshrplib -Dusethreads -Duseithreads -Uusedtrace -Duselargefiles -Dd_semctl_semun -Di_db -Ui_ndbm -Di_gdbm -Di_shadow -Di_syslog -Dman3ext=3pm -Duseperlio -Dinstallusrbinperl=n -Ubincompat5005 -Uversiononly -Dd_gethostent_r_proto -Ud_endhostent_r_proto -Ud_sethostent_r_proto -Ud_endprotoent_r_proto -Ud_setprotoent_r_proto -Ud_endservent_r_proto -Ud_setservent_r_proto
BUILD_BZIP2=0
BZIP2_LIB=%{_libdir}
export BUILD_BZIP2 BZIP2_LIB
ln -sf libperl.so libperl.so.${SONAME_VER}
make
rm -f /usr/lib${SUFFIX}/perl5/CORE/libperl.so
make install
rm -f /usr/lib${SUFFIX}/libperl.so.${PERL_VER}
mv /usr/lib${SUFFIX}/perl5/CORE/libperl.so /usr/lib${SUFFIX}/libperl.so.${PERL_VER}
ln -sf libperl.so.${PERL_VER} /usr/lib${SUFFIX}/libperl.so.${SONAME_VER}
ln -sf libperl.so.${PERL_VER} /usr/lib${SUFFIX}/libperl.so
ln -sf libperl.so.${PERL_VER} /usr/lib${SUFFIX}/perl5/CORE/libperl.so

11
checkemptydirs Executable file
View File

@ -0,0 +1,11 @@
#!/bin/bash
for P in "$@"; do
echo "Empty directories in RPM package $P:"
for D in $(rpm -qlvp "$P" | \
perl -ne \
'if (/\Adrwx/) {$n=${[split /\s+/]}[8]; print qq{$n\n}}' | \
sort -f); do
test $(rpm -qlp "$P" | grep -c -F "$D/") == 0 && echo "$D";
done
done

93
checkpackageversion Executable file
View File

@ -0,0 +1,93 @@
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use RPM2;
for my $rpm_file (@ARGV) {
my $package = RPM2->open_package($rpm_file)
or die q{Could not open `} . $rpm_file . q{'.};
my $package_name = $package->tag('NAME');
my $package_version = $package->tag('VERSION');
my $module_name = $package_name;
$module_name =~ s/^([^-]+)-(.*)/$1($2)/;
$module_name =~ s/-/::/g;
my @names = $package->tag('PROVIDENAME');
my @flags = $package->tag('PROVIDEFLAGS');
my @versions = $package->tag('PROVIDEVERSION');
if (!($#names == $#flags) && ($#names == $#versions)) {
die (q{Inconsistent number of provides names, flags, and versions in `}
. $rpm_file . q{'.});
}
my $found = 0;
for my $name (@names) {
my $flag = shift @flags;
my $version = shift @versions;
if ($name eq $module_name) {
$found = 1;
if (($flag & 0x8) && (($flag & (0x2+0x4)) == 0)) {
if (!($package_version eq $version)) {
print $rpm_file . q{: Package version `} .
$package_version . q{' differs from `} .
$module_name . q{' module version `} .
$version . q{'.} . "\n";
}
last;
} else {
print $rpm_file . q{: `} . $module_name .
q{' in list of provides is not qualified (};
printf '0x%x', $flag;
print q{) as equaled.} . "\n";
}
}
}
if ($found == 0) {
print $rpm_file . q{: missing `} . $module_name .
q{' in list of provides.} . "\n";
}
}
__END__
=encoding utf8
=head1 NAME
checkpackageversion - Check a RPM package version matches main Perl module
version
=head1 SYNOPSIS
checkpackageversion RPM_PACKAGE...
It opens each RPM_PACKAGE, guesses a main Perl module from package name, finds
it in list of provides (e.g. perl-Foo-Bar → perl(Foo::Bar) and compares
versions. It reports any irregularities to standard output.
Petr Písař <ppisar@redhat.com>
=head1 COPYING
Copyright (C) 2011 Petr Písař <ppisar@redhat.com>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
=cut

39
clean-manifest.pl Normal file
View File

@ -0,0 +1,39 @@
#!/usr/bin/perl -w
use strict;
my ($arch, $patfile, $infile, $outfile, $libdir, $thread_arch) = @ARGV;
if (not $arch or not $patfile or not $infile or not $outfile or not $libdir) {
die "Usage: $0 arch thread_arch pattern-file in-file out-file libdir [ threadarch ]";
}
$thread_arch ||= '';
open IN, "<$infile"
or die "Can't open $infile: $!";
open OUT, ">$outfile"
or die "Can't open $outfile: $!";
open PATTERN, "<$patfile"
or die "Can't open $patfile: $!";
my @patterns = <PATTERN>;
chomp @patterns;
for my $p (@patterns) {
$p =~ s/%{_libdir}/$libdir/g;
$p =~ s/%{_arch}/$arch/g;
$p =~ s/%{thread_arch}/$thread_arch/g;
}
my %exclude = map { $_ => 1 } @patterns;
close PATTERN;
while(<IN>) {
chomp;
print OUT "$_\n"
unless exists $exclude{$_}
}
close IN;
close OUT;

33
diffrpms Executable file
View File

@ -0,0 +1,33 @@
#!/bin/bash
if [ "$#" != 2 ]; then
cat<<EOM
Usage: $(basename $0) OLD_RELEASE NEW_RELEASE
Compares corresponding RPM packages produced in OLD_RELASE and NEW_RELEASE.
The same version strings are assumed.
EOM
exit 1;
fi
OLD_RELEASE="$1"
NEW_RELEASE="$2"
function process_dir() {
for F in $(ls $1/* | sed -r 's/-[0-9].*//' | sort | uniq ); do
OLD_RPM=$(echo ${F}-[0-9]*-${OLD_RELEASE}.*)
NEW_RPM=$(echo ${F}-[0-9]*-${NEW_RELEASE}.*)
test \( ! -e "$OLD_RPM" \) -a \( ! -e "$NEW_RPM" \) && continue
if [ ! -e "$OLD_RPM" ]; then echo "+ Package ${F}"; continue; fi
if [ ! -e "$NEW_RPM" ]; then echo "- Package ${F}"; continue; fi
DIFF=$(rpmdiff -i S -i 5 -i T "$OLD_RPM" "$NEW_RPM" | \
grep -vE 'REQUIRES perl = | REQUIRES rpmlib\(' )
test -n "$DIFF" && printf '* %s:\n%s\n' "$F" "$DIFF"
done
}
process_dir 'x86_64'
process_dir 'noarch'

2474
gendep.macros Normal file

File diff suppressed because it is too large Load Diff

163
generatedependencies Executable file
View File

@ -0,0 +1,163 @@
#!/usr/bin/perl
use strict;
use warnings;
# Split "A B >= 1" dependencies string into ("A", "B >= 1") list.
sub appendsymbols {
my ($array, $line) = @_;
my $qualified;
my $dependency;
for my $token (split(/\s/, $line)) {
if ($token =~ /\A[<>]?=\z/) {
$qualified = 1;
$dependency .= ' ' . $token;
next;
}
if (!$qualified) {
if (defined $dependency) {
push @$array, $dependency;
}
$dependency = $token;
next;
}
if ($qualified) {
$qualified = 0;
$dependency .= ' ' . $token;
push @$array, $dependency;
$dependency = undef;
next;
}
}
if (defined $dependency) {
push @$array, $dependency;
}
}
# Return true if the argument is a Perl dependency. Otherwise return false.
sub is_perl_dependency {
my $dependency = shift;
return ($dependency =~ /\Aperl\(/);
}
my $file = shift @ARGV;
if (!defined $file) {
die "Missing an argument with an RPM build log!\n"
}
# Parse build log
open(my $log, '<', $file) or die "Could not open `$file': $!\n";
my ($package, %packages);
while (!eof($log)) {
defined($_ = <$log>) or die "Error while reading from `$file': $!\n";
chomp;
if (/\AProcessing files: ([\S]+)-[^-]+-[^-]+$/) {
$package = $1;
$packages{$package}{requires} = [];
$packages{$package}{provides} = [];
} elsif ($package && /\AProvides: (.*)\z/) {
appendsymbols($packages{$package}{provides}, $1);
} elsif ($package && /\ARequires: (.*)\z/) {
appendsymbols($packages{$package}{requires}, $1);
}
}
close($log);
# Save dependencies into file
my $filename = 'gendep.macros';
open (my $gendep, '>', $filename) or
die "Could not open `$filename' for writing: $!\n";
for my $package (sort keys %packages) {
# Macro name
my $macro = 'gendep_' . $package;
$macro =~ s/[+-]/_/g;
$gendep->print("%global $macro \\\n");
# Macro value
for my $dependency (@{$packages{$package}{requires}}) {
if (is_perl_dependency($dependency)) {
$gendep->print("Requires: $dependency \\\n");
}
}
for my $dependency (@{$packages{$package}{provides}}) {
if (is_perl_dependency($dependency)) {
$gendep->print("Provides: $dependency \\\n");
}
}
# Macro trailer
$gendep->print("%{nil}\n");
}
close($gendep) or die "Could not close `$filename': $!\n";
__END__
=encoding utf8
=head1 NAME
generatedependencies - Distil generated Perl dependencies from a build log
=head1 SYNOPSIS
B<generatedependencies> I<BUILD_LOG>
=head1 DESCRIPTION
It opens specified RPM build log I<BUILD_LOG>. It locates a protocol about
autogenerated dependencies. It stores the reported dependencies into F<./gendep.macros> file.
The output file will define macros C<gendep_I<BINARY_PACKAGE_NAME>>. A macro
for each binary package. The macro name will use underscores instead of
hyphens or other SPEC language special characters.
It will ignore non-Perl dependencies (not C<perl(*)>) as they do not come from
Perl dependency generator.
=head1 EXIT CODE
Returns zero, if no error occurred. Otherwise non-zero code is returned.
=head1 EXAMPLE
The invocation is:
$ generatedependencies .build-5.24.0-364.fc25.log
The output is:
$ grep -A5 perl_Devel_Peek gendep.macros
%global gendep_perl_Devel_Peek \
Requires: perl(Exporter) \
Requires: perl(XSLoader) \
Provides: perl(Devel::Peek) = 1.23 \
%nil{}
%global gendep_perl_Devel_SelfStubber \
The output can be used in a spec file like:
Name: perl
Source0: gendep.macros
%include %{SOURCE0}
%package Devel-Peek
%gendep_Devel_Peek
%package Devel-SelfStubber
%gendep_Devel_SelfStubber
=head1 COPYING
Copyright (C) 2016 Petr Písař <ppisar@redhat.com>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
=cut

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/

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.

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;

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

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

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
'') ;;

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

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

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

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

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

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

View File

@ -0,0 +1,49 @@
From b0d826f28ae47d22229949e754709e68afe5d83d Mon Sep 17 00:00:00 2001
From: raiph <raiph.mellor@gmail.com>
Date: Thu, 2 Jul 2020 17:30:07 +0100
Subject: [PATCH] Fix 404 and text in New Unicode properties section
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
See https://github.com/Perl/perl5/issues/17881
I found a 404, and an "old" link. I investigated.
My conclusion was UC have landed new TR18 and TR39 since text in section
New Unicode properties Identifier_Status and Identifier_Type supported
was written.
I've guessed at a suitable update.
Petr Písař: Ported from e02f7c069a8e7dd98b0ec010e9b3c6619b46baf3
upstream commmit.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
pod/perldelta.pod | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index b92ea53..bb3d1ef 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -48,12 +48,12 @@ L<perlop/Operator Precedence and Associativity>.
=head2 New Unicode properties C<Identifier_Status> and C<Identifier_Type> supported
-Unicode is in the process of revising its regular expression
-requirements: L<https://www.unicode.org/draft/reports/tr18/tr18.html>.
+Unicode has revised its regular expression requirements:
+L<https://www.unicode.org/reports/tr18/tr18-21.html>.
As part of that they are wanting more properties to be exposed, ones
that aren't part of the strict UCD (Unicode character database). These
two are used for examining inputs for security purposes. Details on
-their usage is at L<https://www.unicode.org/reports/tr39/proposed.html>.
+their usage is at L<https://www.unicode.org/reports/tr39/>.
=head2 It is now possible to write C<qr/\p{Name=...}/>, or
C<qr!\p{na=/(SMILING|GRINNING) FACE/}!>
--
2.25.4

View File

@ -0,0 +1,30 @@
From 3c53c6179afbdbef748c110abdb849cb463c2727 Mon Sep 17 00:00:00 2001
From: Todd Rinaldo <toddr@cpan.org>
Date: Thu, 30 Jul 2020 17:42:47 -0500
Subject: [PATCH] Add missing MANIFEST entry from fix for debugger
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Add on fix to #17901
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
MANIFEST | 1 +
1 file changed, 1 insertion(+)
diff --git a/MANIFEST b/MANIFEST
index 990a75ad52..12601e46b4 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4826,6 +4826,7 @@ lib/perl5db/t/symbol-table-bug Tests for the Perl debugger
lib/perl5db/t/taint Tests for the Perl debugger
lib/perl5db/t/test-a-statement-1 Tests for the Perl debugger
lib/perl5db/t/test-a-statement-2 Tests for the Perl debugger
+lib/perl5db/t/test-a-statement-3 Tests for the Perl debugger
lib/perl5db/t/test-dieLevel-option-1 Tests for the Perl debugger
lib/perl5db/t/test-frame-option-1 Tests for the Perl debugger
lib/perl5db/t/test-l-statement-1 Tests for the Perl debugger
--
2.25.4

View File

@ -0,0 +1,90 @@
From b248789b64d6bd277c52bfe608ed3192023af1bd Mon Sep 17 00:00:00 2001
From: "E. Choroba" <choroba@matfyz.cz>
Date: Fri, 26 Jun 2020 21:19:24 +0200
Subject: [PATCH] After running an action in the debugger, turn it off
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
When running with "c", there was no problem, but when running with "n"
or "s", once the action was executed, it kept executing on the
following lines, which wasn't expected. Clearing $action here prevents
this unwanted behaviour.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
lib/perl5db.pl | 3 ++-
lib/perl5db.t | 22 ++++++++++++++++++++++
lib/perl5db/t/test-a-statement-3 | 6 ++++++
3 files changed, 30 insertions(+), 1 deletion(-)
create mode 100644 lib/perl5db/t/test-a-statement-3
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 69a9bb6e64..e04a0e17fa 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -529,7 +529,7 @@ BEGIN {
use vars qw($VERSION $header);
# bump to X.XX in blead, only use X.XX_XX in maint
-$VERSION = '1.57';
+$VERSION = '1.58';
$header = "perl5db.pl version $VERSION";
@@ -2708,6 +2708,7 @@ If there are any preprompt actions, execute those as well.
# The &-call is here to ascertain the mutability of @_.
&DB::eval;
}
+ undef $action;
# Are we nested another level (e.g., did we evaluate a function
# that had a breakpoint in it at the debugger prompt)?
diff --git a/lib/perl5db.t b/lib/perl5db.t
index 421229a54a..913a301d98 100644
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -2799,6 +2799,28 @@ SKIP:
);
}
+{
+ # GitHub #17901
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'a 4 $s++',
+ ('s') x 5,
+ 'x $s',
+ 'q'
+ ],
+ prog => '../lib/perl5db/t/test-a-statement-3',
+ switches => [ '-d' ],
+ stderr => 0,
+ }
+ );
+ $wrapper->contents_like(
+ qr/^0 +2$/m,
+ 'Test that the a command runs only on the given lines.',
+ );
+}
+
{
# perl 5 RT #126735 regression bug.
local $ENV{PERLDB_OPTS} = "NonStop=0 RemotePort=non-existent-host.tld:9001";
diff --git a/lib/perl5db/t/test-a-statement-3 b/lib/perl5db/t/test-a-statement-3
new file mode 100644
index 0000000000..b188c1c5c5
--- /dev/null
+++ b/lib/perl5db/t/test-a-statement-3
@@ -0,0 +1,6 @@
+use strict; use warnings;
+
+for my $x (1 .. 2) {
+ my $y = $x + 1;
+ my $x = $x - 1;
+}
--
2.25.4

View File

@ -0,0 +1,33 @@
From 589464a875768e4b4a609d972488e3b592103097 Mon Sep 17 00:00:00 2001
From: "E. Choroba" <choroba@matfyz.cz>
Date: Mon, 27 Jul 2020 11:32:51 +0200
Subject: [PATCH] Clearing DB::action at the end is no longer needed
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
as it's cleared right after it's been run.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
lib/perl5db.pl | 4 ----
1 file changed, 4 deletions(-)
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index e04a0e17fa..af3b972da0 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -3347,10 +3347,6 @@ use B<o> I<inhibit_exit> to avoid stopping after program termination,
B<h q>, B<h R> or B<h o> to get additional info.
EOP
- # Set the DB::eval context appropriately.
- # At program termination disable any user actions.
- $DB::action = undef;
-
$DB::package = 'main';
$DB::usercontext = DB::_calc_usercontext($DB::package);
} ## end elsif ($package eq 'DB::fake')
--
2.25.4

View File

@ -0,0 +1,31 @@
From 6841cd5977c2d35ad75233734c66983a65613fce Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Wed, 12 Aug 2020 17:53:52 -0600
Subject: [PATCH] Fix leak GH #18054
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
This was a simple matter of one path failing to free the memory.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
regcomp.c | 2 ++
1 file changed, 2 insertions(+)
diff --git a/regcomp.c b/regcomp.c
index addf375450..01f297c299 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -15191,6 +15191,8 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
FAIL2("panic: loc_correspondence[%d] is 0",
(int) (s - s_start));
}
+ Safefree(locfold_buf);
+ Safefree(loc_correspondence);
}
else {
upper_fill = s - s0;
--
2.25.4

View File

@ -0,0 +1,74 @@
From 8a2562bec7cd9f8eff6812f340f99dddd028bb33 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
Date: Thu, 6 Aug 2020 10:51:56 +0200
Subject: [PATCH] IO::Handle: Fix a spurious error reported for regular file
handles
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
89341f87 fix for GH #6799 introduced a regression when calling error()
on an IO::Handle object that was opened for reading a regular file:
$ perl -e 'open my $f, q{<}, q{/etc/hosts} or die; print qq{error\n} if $f->error'
error
In case of a regular file opened for reading, IoOFP() returns NULL and
PerlIO_error(NULL) reports -1. Compare to the case of a file opened
for writing when both IoIFP() and IoOFP() return non-NULL, equaled
pointer.
This patch fixes handling the case of the NULL output stream.
GH #18019
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
dist/IO/IO.xs | 4 ++--
dist/IO/t/io_xs.t | 10 +++++++++-
2 files changed, 11 insertions(+), 3 deletions(-)
diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs
index 9158106416..fb009774c4 100644
--- a/dist/IO/IO.xs
+++ b/dist/IO/IO.xs
@@ -397,9 +397,9 @@ ferror(handle)
CODE:
if (in)
#ifdef PerlIO
- RETVAL = PerlIO_error(in) || (in != out && PerlIO_error(out));
+ RETVAL = PerlIO_error(in) || (out && in != out && PerlIO_error(out));
#else
- RETVAL = ferror(in) || (in != out && ferror(out));
+ RETVAL = ferror(in) || (out && in != out && ferror(out));
#endif
else {
RETVAL = -1;
diff --git a/dist/IO/t/io_xs.t b/dist/IO/t/io_xs.t
index a8833b0651..4657088629 100644
--- a/dist/IO/t/io_xs.t
+++ b/dist/IO/t/io_xs.t
@@ -11,7 +11,7 @@ BEGIN {
}
}
-use Test::More tests => 8;
+use Test::More tests => 10;
use IO::File;
use IO::Seekable;
@@ -69,3 +69,11 @@ SKIP: {
ok(!$fh->error, "check clearerr removed the error");
close $fh; # silently ignore the error
}
+
+{
+ # [GH #18019] IO::Handle->error misreported an error after successully
+ # opening a regular file for reading. It was a regression in GH #6799 fix.
+ ok(open(my $fh, '<', __FILE__), "a regular file opened for reading");
+ ok(!$fh->error, "no spurious error reported by error()");
+ close $fh;
+}
--
2.25.4

View File

@ -0,0 +1,80 @@
From fc5f3468dcbee38eb202cfd552a5b8dbff990c7b Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 12 May 2020 10:59:08 +1000
Subject: [PATCH 2/2] IO::Handle: clear the error on both input and output
streams
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Similarly to GH #6799 clearerr() only cleared the error status
of the input stream, so clear both.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
dist/IO/IO.xs | 14 +++++++++++---
dist/IO/t/io_xs.t | 8 +++++---
2 files changed, 16 insertions(+), 6 deletions(-)
diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs
index 99d523d2c1..9158106416 100644
--- a/dist/IO/IO.xs
+++ b/dist/IO/IO.xs
@@ -410,13 +410,21 @@ ferror(handle)
int
clearerr(handle)
- InputStream handle
+ SV * handle
+ PREINIT:
+ IO *io = sv_2io(handle);
+ InputStream in = IoIFP(io);
+ OutputStream out = IoOFP(io);
CODE:
if (handle) {
#ifdef PerlIO
- PerlIO_clearerr(handle);
+ PerlIO_clearerr(in);
+ if (in != out)
+ PerlIO_clearerr(out);
#else
- clearerr(handle);
+ clearerr(in);
+ if (in != out)
+ clearerr(out);
#endif
RETVAL = 0;
}
diff --git a/dist/IO/t/io_xs.t b/dist/IO/t/io_xs.t
index f890e92558..a8833b0651 100644
--- a/dist/IO/t/io_xs.t
+++ b/dist/IO/t/io_xs.t
@@ -11,7 +11,7 @@ BEGIN {
}
}
-use Test::More tests => 7;
+use Test::More tests => 8;
use IO::File;
use IO::Seekable;
@@ -58,12 +58,14 @@ SKIP: {
# This isn't really a Linux/BSD specific test, but /dev/full is (I
# hope) reasonably well defined on these. Patches welcome if your platform
# also supports it (or something like it)
- skip "no /dev/full or not a /dev/full platform", 2
+ skip "no /dev/full or not a /dev/full platform", 3
unless $^O =~ /^(linux|netbsd|freebsd)$/ && -c "/dev/full";
open my $fh, ">", "/dev/full"
- or skip "Could not open /dev/full: $!", 2;
+ or skip "Could not open /dev/full: $!", 3;
$fh->print("a" x 1024);
ok(!$fh->flush, "should fail to flush");
ok($fh->error, "stream should be in error");
+ $fh->clearerr;
+ ok(!$fh->error, "check clearerr removed the error");
close $fh; # silently ignore the error
}
--
2.25.4

View File

@ -0,0 +1,61 @@
From c6439962c995d4d7052af9fb3f92da93c1584b84 Mon Sep 17 00:00:00 2001
From: vividsnow <vividsnow@gmail.com>
Date: Fri, 31 Jul 2020 00:37:58 +0300
Subject: [PATCH] IO::Socket::UNIX: synchronize behavior with module
documentation (#17787)
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
* synchronize behavior with module documentation
IO::Socket docs states that passing Blocking => 0 will be set socket to non-blocking mode
* Update AUTHORS
* bump version
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
AUTHORS | 1 +
dist/IO/lib/IO/Socket/UNIX.pm | 6 +++++-
2 files changed, 6 insertions(+), 1 deletion(-)
diff --git a/AUTHORS b/AUTHORS
index 577ba7d0ee..299fdec8a8 100644
--- a/AUTHORS
+++ b/AUTHORS
@@ -1293,6 +1293,7 @@ Ville Skyttä <scop@cs132170.pp.htv.fi>
Vincent Pit <perl@profvince.com>
Vishal Bhatia <vishal@deja.com>
Vitali Peil <vitali.peil@uni-bielefeld.de>
+vividsnow <vividsnow@gmail.com>
Vlad Harchev <hvv@hippo.ru>
Vladimir Alexiev <vladimir@cs.ualberta.ca>
Vladimir Marek <vlmarek@volny.cz>
diff --git a/dist/IO/lib/IO/Socket/UNIX.pm b/dist/IO/lib/IO/Socket/UNIX.pm
index 04b36eaf74..14d0b27a8c 100644
--- a/dist/IO/lib/IO/Socket/UNIX.pm
+++ b/dist/IO/lib/IO/Socket/UNIX.pm
@@ -11,7 +11,7 @@ use IO::Socket;
use Carp;
our @ISA = qw(IO::Socket);
-our $VERSION = "1.41";
+our $VERSION = "1.42";
IO::Socket::UNIX->register_domain( AF_UNIX );
@@ -30,6 +30,10 @@ sub configure {
$sock->socket(AF_UNIX, $type, 0) or
return undef;
+ if(exists $arg->{Blocking}) {
+ $sock->blocking($arg->{Blocking}) or
+ return undef;
+ }
if(exists $arg->{Local}) {
my $addr = sockaddr_un($arg->{Local});
$sock->bind($addr) or
--
2.25.4

View File

@ -0,0 +1,32 @@
From 6c2255e0e80e0dc00c7fd96e073f1f524bbaa3e0 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Mon, 29 Jun 2020 09:21:24 -0600
Subject: [PATCH] MUTABLE_PTR() Rmv non-standard syntax
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Variables in C are beginning with an underscore are reserved for use by
the C implementation. Change this non-conformant usage.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
handy.h | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/handy.h b/handy.h
index 287e2e206d..890b2b11a2 100644
--- a/handy.h
+++ b/handy.h
@@ -54,7 +54,7 @@ Null SV pointer. (No longer available when C<PERL_CORE> is defined.)
*/
#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
-# define MUTABLE_PTR(p) ({ void *_p = (p); _p; })
+# define MUTABLE_PTR(p) ({ void *p_ = (p); p_; })
#else
# define MUTABLE_PTR(p) ((void *) (p))
#endif
--
2.25.4

View File

@ -0,0 +1,33 @@
From b26a606d84ae1a6da560c7cd71d1a33c0dc7178e Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Sun, 14 Jun 2020 12:26:02 -0600
Subject: [PATCH] Update pod for SvTRUE, to indicate single param evaluation
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
5.32 changed this macro into an inline function so that 'sv' only gets
evaluated once, but didn't update the documentation to reflect that.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
sv.h | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/sv.h b/sv.h
index 3721b2fb1b..ad8accbf1a 100644
--- a/sv.h
+++ b/sv.h
@@ -1607,7 +1607,8 @@ false. See C<L</SvOK>> for a defined/undefined test. Handles 'get' magic
unless the scalar is already C<SvPOK>, C<SvIOK> or C<SvNOK> (the public, not the
private flags).
-See C<L</SvTRUEx>> for a version which guarantees to evaluate C<sv> only once.
+As of Perl 5.32, this is guaranteed to evaluate C<sv> only once. Prior to that
+release, use C<L</SvTRUEx>> for single evaluation.
=for apidoc Am|bool|SvTRUE_nomg|SV* sv
Returns a boolean indicating whether Perl would evaluate the SV as true or
--
2.25.4

View File

@ -0,0 +1,45 @@
From 313464947382fab07299af0061f419a55540356a Mon Sep 17 00:00:00 2001
From: Tomasz Konojacki <me@xenu.pl>
Date: Mon, 27 Apr 2020 08:31:47 +0200
Subject: [PATCH] XSUB.h: fix MARK and items variables inside BOOT XSUBs
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
ax was incremented by Perl_xs_handshake() and because of that
MARK and items were off by one inside BOOT XSUBs.
fixes #17755
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
XSUB.h | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/XSUB.h b/XSUB.h
index e3147ce9fb..5f17a5acde 100644
--- a/XSUB.h
+++ b/XSUB.h
@@ -160,16 +160,16 @@ is a lexical C<$_> in scope.
PL_xsubfilename. */
#define dXSBOOTARGSXSAPIVERCHK \
I32 ax = XS_BOTHVERSION_SETXSUBFN_POPMARK_BOOTCHECK; \
- SV **mark = PL_stack_base + ax; dSP; dITEMS
+ SV **mark = PL_stack_base + ax - 1; dSP; dITEMS
#define dXSBOOTARGSAPIVERCHK \
I32 ax = XS_APIVERSION_SETXSUBFN_POPMARK_BOOTCHECK; \
- SV **mark = PL_stack_base + ax; dSP; dITEMS
+ SV **mark = PL_stack_base + ax - 1; dSP; dITEMS
/* dXSBOOTARGSNOVERCHK has no API in xsubpp to choose it so do
#undef dXSBOOTARGSXSAPIVERCHK
#define dXSBOOTARGSXSAPIVERCHK dXSBOOTARGSNOVERCHK */
#define dXSBOOTARGSNOVERCHK \
I32 ax = XS_SETXSUBFN_POPMARK; \
- SV **mark = PL_stack_base + ax; dSP; dITEMS
+ SV **mark = PL_stack_base + ax - 1; dSP; dITEMS
#define dXSTARG SV * const targ = ((PL_op->op_private & OPpENTERSUB_HASTARG) \
? PAD_SV(PL_op->op_targ) : sv_newmortal())
--
2.25.4

View File

@ -0,0 +1,38 @@
From 73b535d23d98bd3bdc31a27da26222e2e56166ac Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Tue, 30 Jun 2020 13:58:50 -0600
Subject: [PATCH] ext/XS-APItest/t/utf8_warn_base.pl: Fix a couple tests
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
These had invalid values, which didn't show up execpt on EBCDIC
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
ext/XS-APItest/t/utf8_warn_base.pl | 2 --
1 file changed, 2 deletions(-)
diff --git a/ext/XS-APItest/t/utf8_warn_base.pl b/ext/XS-APItest/t/utf8_warn_base.pl
index d86871cd0f..a0f732282e 100644
--- a/ext/XS-APItest/t/utf8_warn_base.pl
+++ b/ext/XS-APItest/t/utf8_warn_base.pl
@@ -486,7 +486,6 @@ my @tests;
: I8_to_native(
"\xff\xa7\xbf\xbf\xbf\xbf\xbf\xbf\xbf\xbf\xbf\xbf\xbf\xbf"),
0x7FFFFFFFFFFFFFFF,
- (isASCII) ? 1 : 2,
],
[ "first 64 bit code point",
(isASCII)
@@ -525,7 +524,6 @@ my @tests;
I8_to_native(
"\xff\xa0\xa0\xa0\xa0\xa0\xa1\xa0\xa0\xa0\xa0\xa0\xa0\xa0"),
0x800000000,
- 40000000
],
[ "requires at least 32 bits",
I8_to_native(
--
2.25.4

View File

@ -0,0 +1,193 @@
From b334474a337421c6643b872388245fb2c11bf995 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 30 Mar 2020 16:32:46 +1100
Subject: [PATCH] fix C<i $obj> where $obj is a lexical
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
the DB::eval function depends on the special behaviour of eval ""
within the DB package, which evaluates the string within the context
of the first non-DB sub or eval scope, working up the call stack.
The debugger refactor moved handling for the 'i' command from the
DB package to the DB::Obj package, so the eval in DB::eval was
working in the context of the DB::Obj::cmd_i function, not in the
calling scope.
Fixed by moving the handling for the i command back to DB.
Fixes #17661.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
MANIFEST | 1 +
lib/perl5db.pl | 65 +++++++++++++++++++++---------------------
lib/perl5db.t | 20 +++++++++++++
lib/perl5db/t/gh-17661 | 14 +++++++++
4 files changed, 68 insertions(+), 32 deletions(-)
create mode 100644 lib/perl5db/t/gh-17661
diff --git a/MANIFEST b/MANIFEST
index 8c71995174..96af3618bd 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4808,6 +4808,7 @@ lib/perl5db/t/eval-line-bug Tests for the Perl debugger
lib/perl5db/t/fact Tests for the Perl debugger
lib/perl5db/t/filename-line-breakpoint Tests for the Perl debugger
lib/perl5db/t/gh-17660 Tests for the Perl debugger
+lib/perl5db/t/gh-17661 Tests for the Perl debugger
lib/perl5db/t/load-modules Tests for the Perl debugger
lib/perl5db/t/lsub-n Test script used by perl5db.t
lib/perl5db/t/lvalue-bug Tests for the Perl debugger
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 96e56d559f..b647d24fb8 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -2512,6 +2512,37 @@ EOP
return;
}
+=head3 C<_DB__handle_i_command> - inheritance display
+
+Display the (nested) parentage of the module or object given.
+
+=cut
+
+sub _DB__handle_i_command {
+ my $self = shift;
+
+ my $line = $self->cmd_args;
+ require mro;
+ foreach my $isa ( split( /\s+/, $line ) ) {
+ $evalarg = "$isa";
+ # The &-call is here to ascertain the mutability of @_.
+ ($isa) = &DB::eval;
+ no strict 'refs';
+ print join(
+ ', ',
+ map {
+ "$_"
+ . (
+ defined( ${"$_\::VERSION"} )
+ ? ' ' . ${"$_\::VERSION"}
+ : undef )
+ } @{mro::get_linear_isa(ref($isa) || $isa)}
+ );
+ print "\n";
+ }
+ next CMD;
+}
+
# 't' is type.
# 'm' is method.
# 'v' is the value (i.e: method name or subroutine ref).
@@ -2531,6 +2562,7 @@ BEGIN
'W' => { t => 'm', v => '_handle_W_command', },
'c' => { t => 's', v => \&_DB__handle_c_command, },
'f' => { t => 's', v => \&_DB__handle_f_command, },
+ 'i' => { t => 's', v => \&_DB__handle_i_command, },
'm' => { t => 's', v => \&_DB__handle_m_command, },
'n' => { t => 'm', v => '_handle_n_command', },
'p' => { t => 'm', v => '_handle_p_command', },
@@ -2551,7 +2583,7 @@ BEGIN
{ t => 's', v => \&_DB__handle_restart_and_rerun_commands, },
} qw(R rerun)),
(map { $_ => {t => 'm', v => '_handle_cmd_wrapper_commands' }, }
- qw(a A b B e E h i l L M o O v w W)),
+ qw(a A b B e E h l L M o O v w W)),
);
};
@@ -5468,37 +5500,6 @@ sub cmd_h {
}
} ## end sub cmd_h
-=head3 C<cmd_i> - inheritance display
-
-Display the (nested) parentage of the module or object given.
-
-=cut
-
-sub cmd_i {
- my $cmd = shift;
- my $line = shift;
-
- require mro;
-
- foreach my $isa ( split( /\s+/, $line ) ) {
- $evalarg = $isa;
- # The &-call is here to ascertain the mutability of @_.
- ($isa) = &DB::eval;
- no strict 'refs';
- print join(
- ', ',
- map {
- "$_"
- . (
- defined( ${"$_\::VERSION"} )
- ? ' ' . ${"$_\::VERSION"}
- : undef )
- } @{mro::get_linear_isa(ref($isa) || $isa)}
- );
- print "\n";
- }
-} ## end sub cmd_i
-
=head3 C<cmd_l> - list lines (command)
Most of the command is taken up with transforming all the different line
diff --git a/lib/perl5db.t b/lib/perl5db.t
index 913a301d98..ffa659a215 100644
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -2946,6 +2946,26 @@ SKIP:
);
}
+{
+ # gh #17661
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'c',
+ 'i $obj',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/gh-17661',
+ }
+ );
+
+ $wrapper->output_like(
+ qr/C5, C1, C2, C3, C4/,
+ q/check for reasonable result/,
+ );
+}
+
SKIP:
{
$Config{usethreads}
diff --git a/lib/perl5db/t/gh-17661 b/lib/perl5db/t/gh-17661
new file mode 100644
index 0000000000..0d85977b35
--- /dev/null
+++ b/lib/perl5db/t/gh-17661
@@ -0,0 +1,14 @@
+use v5.10.0;
+
+{ package C1; sub c1 { } our @ISA = qw(C2) }
+{ package C2; sub c2 { } our @ISA = qw(C3) }
+{ package C3; sub c3 { } our @ISA = qw( ) }
+{ package C4; sub c4 { } our @ISA = qw( ) }
+{ package C5; sub c5 { } our @ISA = qw(C1 C4) }
+
+my $obj = bless {}, 'C5';
+$main::global = bless {}, 'C5';
+
+$DB::single = 1;
+
+say "Done.";
--
2.25.4

View File

@ -0,0 +1,71 @@
From 282d9dfeb4cea3c2d0335ba78faa3a9db931f1ec Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Tue, 11 Aug 2020 13:58:51 +0100
Subject: [PATCH] list assign in list context: honour LHS undef
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
GH #16685
In
@a = ($x, undef, undef) = (1))
@a should have 3 elements. v5.25.6-79-gb09ed995ad broke this and was
returning one element.
The fix is simple: that previous commit made it so that elements were
pushed back onto the stack only if they weren't immortal, so
&PL_sv_undef was getting skipped. Make it so they always are.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
pp_hot.c | 2 +-
t/op/aassign.t | 10 +++++++++-
2 files changed, 10 insertions(+), 2 deletions(-)
diff --git a/pp_hot.c b/pp_hot.c
index e9f1ffe7a4..3564dd7e12 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2743,8 +2743,8 @@ PP(pp_aassign)
if (!SvIMMORTAL(lsv)) {
sv_set_undef(lsv);
SvSETMAGIC(lsv);
- *relem++ = lsv;
}
+ *relem++ = lsv;
break;
} /* switch */
} /* while */
diff --git a/t/op/aassign.t b/t/op/aassign.t
index 9128f9fd98..aa1f2c722c 100644
--- a/t/op/aassign.t
+++ b/t/op/aassign.t
@@ -595,7 +595,7 @@ SKIP: {
}
{
- # GH #17816
+ # GH #16685
# don't use the "1-arg on LHS can't be common" optimisation
# when there are undef's there
my $x = 1;
@@ -603,5 +603,13 @@ SKIP: {
is("@a", "2 1", "GH #17816");
}
+{
+ # GH #17816
+ # honour trailing undef's in list context
+ my $x = 1;
+ my @a = (($x, undef, undef) = (1));
+ is(scalar @a, 3, "GH #17816");
+}
+
done_testing();
--
2.25.4

View File

@ -0,0 +1,76 @@
From 5b354d2a8a6fea46c62048464c6722560cb1c907 Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Tue, 11 Aug 2020 11:55:46 +0100
Subject: [PATCH] list assign in list context was over-optimising
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
GH #17816
This code:
my $x = 1;
print (($x, undef) = (2 => $x));
was printing "22" when it should have been printing "21".
An optimisation skips the 'common values on both sides' test
when the LHS of an assign only contains a single var; as the example
above shows, this is not sufficient.
This was broken by v5.23.1-202-g808ce55782
This commit fixes it by counting undef's on the LHS towards the var
count if they don't appear first.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
op.c | 10 +++++++---
t/op/aassign.t | 10 ++++++++++
2 files changed, 17 insertions(+), 3 deletions(-)
diff --git a/op.c b/op.c
index 05f6d9d1a3..49aac853d4 100644
--- a/op.c
+++ b/op.c
@@ -15679,11 +15679,15 @@ S_aassign_scan(pTHX_ OP* o, bool rhs, int *scalars_p)
goto do_next;
case OP_UNDEF:
- /* undef counts as a scalar on the RHS:
- * (undef, $x) = ...; # only 1 scalar on LHS: always safe
+ /* undef on LHS following a var is significant, e.g.
+ * my $x = 1;
+ * @a = (($x, undef) = (2 => $x));
+ * # @a shoul be (2,1) not (2,2)
+ *
+ * undef on RHS counts as a scalar:
* ($x, $y) = (undef, $x); # 2 scalars on RHS: unsafe
*/
- if (rhs)
+ if ((!rhs && *scalars_p) || rhs)
(*scalars_p)++;
flags = AAS_SAFE_SCALAR;
break;
diff --git a/t/op/aassign.t b/t/op/aassign.t
index ed904adc62..9128f9fd98 100644
--- a/t/op/aassign.t
+++ b/t/op/aassign.t
@@ -594,4 +594,14 @@ SKIP: {
is ($fill, 2, "RT #130132 array 2");
}
+{
+ # GH #17816
+ # don't use the "1-arg on LHS can't be common" optimisation
+ # when there are undef's there
+ my $x = 1;
+ my @a = (($x, undef) = (2 => $x));
+ is("@a", "2 1", "GH #17816");
+}
+
+
done_testing();
--
2.25.4

View File

@ -0,0 +1,87 @@
From 89341f87f9fc65c4d7133e497bb04586e86b8052 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 12 May 2020 10:29:17 +1000
Subject: [PATCH 1/2] make $fh->error report errors from both input and output
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
For character devices and sockets perl uses separate PerlIO objects
for input and output so they can be buffered separately.
The IO::Handle::error() method only checked the input stream, so
if a write error occurs error() would still returned false.
Change this so both the input and output streams are checked.
fixes #6799
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
dist/IO/IO.xs | 12 ++++++++----
dist/IO/t/io_xs.t | 19 ++++++++++++++++++-
2 files changed, 26 insertions(+), 5 deletions(-)
diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs
index 68b7352c38..99d523d2c1 100644
--- a/dist/IO/IO.xs
+++ b/dist/IO/IO.xs
@@ -389,13 +389,17 @@ ungetc(handle, c)
int
ferror(handle)
- InputStream handle
+ SV * handle
+ PREINIT:
+ IO *io = sv_2io(handle);
+ InputStream in = IoIFP(io);
+ OutputStream out = IoOFP(io);
CODE:
- if (handle)
+ if (in)
#ifdef PerlIO
- RETVAL = PerlIO_error(handle);
+ RETVAL = PerlIO_error(in) || (in != out && PerlIO_error(out));
#else
- RETVAL = ferror(handle);
+ RETVAL = ferror(in) || (in != out && ferror(out));
#endif
else {
RETVAL = -1;
diff --git a/dist/IO/t/io_xs.t b/dist/IO/t/io_xs.t
index 1e3c49a4a7..f890e92558 100644
--- a/dist/IO/t/io_xs.t
+++ b/dist/IO/t/io_xs.t
@@ -11,7 +11,7 @@ BEGIN {
}
}
-use Test::More tests => 5;
+use Test::More tests => 7;
use IO::File;
use IO::Seekable;
@@ -50,3 +50,20 @@ SKIP:
ok($fh->sync, "sync to a read only handle")
or diag "sync(): ", $!;
}
+
+
+SKIP: {
+ # gh 6799
+ #
+ # This isn't really a Linux/BSD specific test, but /dev/full is (I
+ # hope) reasonably well defined on these. Patches welcome if your platform
+ # also supports it (or something like it)
+ skip "no /dev/full or not a /dev/full platform", 2
+ unless $^O =~ /^(linux|netbsd|freebsd)$/ && -c "/dev/full";
+ open my $fh, ">", "/dev/full"
+ or skip "Could not open /dev/full: $!", 2;
+ $fh->print("a" x 1024);
+ ok(!$fh->flush, "should fail to flush");
+ ok($fh->error, "stream should be in error");
+ close $fh; # silently ignore the error
+}
--
2.25.4

View File

@ -0,0 +1,72 @@
From 45f235c116d4deab95c576aff77fe46d609f8553 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 15 Apr 2019 15:23:32 +1000
Subject: [PATCH] (perl #17844) don't update SvCUR until after we've done
moving
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
SvCUR() before the SvGROW() calls could result in reading beyond the
end of a buffer.
It wasn't a problem in the normal case, since sv_grow() just calls
realloc() which has its own notion of how big the memory block is, but
if the SV is SvOOK() sv_backoff() tries to move SvCUR()+1 bytes, which
might be larger than the currently allocated size of the PV.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
doop.c | 2 +-
t/op/bop.t | 11 ++++++++++-
2 files changed, 11 insertions(+), 2 deletions(-)
diff --git a/doop.c b/doop.c
index 88220092c3..c9c953212e 100644
--- a/doop.c
+++ b/doop.c
@@ -1087,7 +1087,6 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
lsave = lc;
rsave = rc;
- SvCUR_set(sv, len);
(void)SvPOK_only(sv);
if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
dc = SvPV_force_nomg_nolen(sv);
@@ -1103,6 +1102,7 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
sv_usepvn_flags(sv, dc, needlen, SV_HAS_TRAILING_NUL);
dc = SvPVX(sv); /* sv_usepvn() calls Renew() */
}
+ SvCUR_set(sv, len);
if (len >= sizeof(long)*4 &&
!(PTR2nat(dc) % sizeof(long)) &&
diff --git a/t/op/bop.t b/t/op/bop.t
index eecd90387f..07f057d0a9 100644
--- a/t/op/bop.t
+++ b/t/op/bop.t
@@ -18,7 +18,7 @@ BEGIN {
# If you find tests are failing, please try adding names to tests to track
# down where the failure is, and supply your new names as a patch.
# (Just-in-time test naming)
-plan tests => 501;
+plan tests => 502;
# numerics
ok ((0xdead & 0xbeef) == 0x9ead);
@@ -669,3 +669,12 @@ foreach my $op_info ([and => "&"], [or => "|"], [xor => "^"]) {
like $@, $expected, $description;
}
}
+
+{
+ # perl #17844 - only visible with valgrind/ASAN
+ fresh_perl_is(<<'EOS',
+formline X000n^\\0,\\0^\\0for\0,0..10
+EOS
+ '',
+ {}, "[perl #17844] access beyond end of block");
+}
--
2.25.4

View File

@ -0,0 +1,58 @@
From 81169c06a76f62ff987ed990ac910c2ae08b3f91 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Tue, 10 Mar 2020 15:19:57 -0600
Subject: [PATCH] reentr.c: Buffer sizes for asctime_r,ctime_r are small
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
The needed sizes of these are stated in the man pages, and are much
smaller than were being allocated.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
reentr.c | 4 ++--
regen/reentr.pl | 5 ++++-
2 files changed, 6 insertions(+), 3 deletions(-)
diff --git a/reentr.c b/reentr.c
index 8ddda7bfc0..8438c8f90f 100644
--- a/reentr.c
+++ b/reentr.c
@@ -52,14 +52,14 @@ Perl_reentrant_size(pTHX) {
# define REENTRANTUSUALSIZE 4096 /* Make something up. */
# ifdef HAS_ASCTIME_R
- PL_reentrant_buffer->_asctime_size = REENTRANTSMALLSIZE;
+ PL_reentrant_buffer->_asctime_size = 26;
# endif /* HAS_ASCTIME_R */
# ifdef HAS_CRYPT_R
# endif /* HAS_CRYPT_R */
# ifdef HAS_CTIME_R
- PL_reentrant_buffer->_ctime_size = REENTRANTSMALLSIZE;
+ PL_reentrant_buffer->_ctime_size = 26;
# endif /* HAS_CTIME_R */
# ifdef HAS_GETGRNAM_R
diff --git a/regen/reentr.pl b/regen/reentr.pl
index f5788c7ad9..94721e9dec 100644
--- a/regen/reentr.pl
+++ b/regen/reentr.pl
@@ -495,8 +495,11 @@ for my $func (@seenf) {
char* _${func}_buffer;
size_t _${func}_size;
EOF
+ my $size = ($func =~ /^(asctime|ctime)$/)
+ ? 26
+ : "REENTRANTSMALLSIZE";
push @size, <<EOF;
- PL_reentrant_buffer->_${func}_size = REENTRANTSMALLSIZE;
+ PL_reentrant_buffer->_${func}_size = $size;
EOF
pushinitfree $func;
pushssif $endif;
--
2.25.4

View File

@ -0,0 +1,46 @@
From 981fbfc16220a15e72457d8ece4e014988746946 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Thu, 12 Mar 2020 12:48:47 -0600
Subject: [PATCH] reentr.c: Prevent infinite looping
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
This is an easy, though paranoid hedge to prevent something that should
never happen from causing an infinite loop if it were to happen.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
reentr.c | 2 +-
regen/reentr.pl | 2 +-
2 files changed, 2 insertions(+), 2 deletions(-)
diff --git a/reentr.c b/reentr.c
index 8438c8f90f..2429aa2f5d 100644
--- a/reentr.c
+++ b/reentr.c
@@ -36,7 +36,7 @@
#define RenewDouble(data_pointer, size_pointer, type) \
STMT_START { \
- const size_t size = *(size_pointer) * 2; \
+ const size_t size = MAX(*(size_pointer), 1) * 2; \
Renew((data_pointer), (size), type); \
*(size_pointer) = size; \
} STMT_END
diff --git a/regen/reentr.pl b/regen/reentr.pl
index 94721e9dec..ba2e1c8fa6 100644
--- a/regen/reentr.pl
+++ b/regen/reentr.pl
@@ -818,7 +818,7 @@ print $c <<"EOF";
#define RenewDouble(data_pointer, size_pointer, type) \\
STMT_START { \\
- const size_t size = *(size_pointer) * 2; \\
+ const size_t size = MAX(*(size_pointer), 1) * 2; \\
Renew((data_pointer), (size), type); \\
*(size_pointer) = size; \\
} STMT_END
--
2.25.4

View File

@ -0,0 +1,31 @@
From 530e9296a21b673d7e4c2b42f18d0d52d00f35c4 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Sun, 28 Jun 2020 12:03:54 -0600
Subject: [PATCH] sv.h: Wanted UOK, but said IOK
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
I don't know the consequences of this bug
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
sv.h | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/sv.h b/sv.h
index 2f6431a826..3721b2fb1b 100644
--- a/sv.h
+++ b/sv.h
@@ -1711,7 +1711,7 @@ Like C<sv_catsv> but doesn't process magic.
#define SvNV(sv) (SvNOK_nog(sv) ? SvNVX(sv) : sv_2nv(sv))
#define SvIV_nomg(sv) (SvIOK(sv) ? SvIVX(sv) : sv_2iv_flags(sv, 0))
-#define SvUV_nomg(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv_flags(sv, 0))
+#define SvUV_nomg(sv) (SvUOK(sv) ? SvUVX(sv) : sv_2uv_flags(sv, 0))
#define SvNV_nomg(sv) (SvNOK(sv) ? SvNVX(sv) : sv_2nv_flags(sv, 0))
/* ----*/
--
2.25.4

View File

@ -0,0 +1,88 @@
From 90f66c42e4513ae5d907805fbf28b9967a90d6c5 Mon Sep 17 00:00:00 2001
From: John Lightsey <john@04755.net>
Date: Fri, 28 Aug 2020 23:39:18 -0500
Subject: [PATCH] Heap buffer overflow in regex bracket group whitespace
handling
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
The code for skipping whitespace in regex bracket character groups
was walking past the end of the regex in some cases.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
regcomp.c | 16 ++++++++--------
1 file changed, 8 insertions(+), 8 deletions(-)
diff --git a/regcomp.c b/regcomp.c
index db82c77b00..64488994fa 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -17228,10 +17228,10 @@ S_add_multi_match(pTHX_ AV* multi_char_matches, SV* multi_string, const STRLEN c
*
* There is a line below that uses the same white space criteria but is outside
* this macro. Both here and there must use the same definition */
-#define SKIP_BRACKETED_WHITE_SPACE(do_skip, p) \
+#define SKIP_BRACKETED_WHITE_SPACE(do_skip, p, stop_p) \
STMT_START { \
if (do_skip) { \
- while (isBLANK_A(UCHARAT(p))) \
+ while (p < stop_p && isBLANK_A(UCHARAT(p))) \
{ \
p++; \
} \
@@ -17406,7 +17406,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
initial_listsv_len = SvCUR(listsv);
SvTEMP_off(listsv); /* Grr, TEMPs and mortals are conflated. */
- SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse);
+ SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse, RExC_end);
assert(RExC_parse <= RExC_end);
@@ -17415,7 +17415,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
invert = TRUE;
allow_mutiple_chars = FALSE;
MARK_NAUGHTY(1);
- SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse);
+ SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse, RExC_end);
}
/* Check that they didn't say [:posix:] instead of [[:posix:]] */
@@ -17462,12 +17462,12 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
output_posix_warnings(pRExC_state, posix_warnings);
}
+ SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse, RExC_end);
+
if (RExC_parse >= stop_ptr) {
break;
}
- SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse);
-
if (UCHARAT(RExC_parse) == ']') {
break;
}
@@ -18156,7 +18156,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
}
} /* end of namedclass \blah */
- SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse);
+ SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse, RExC_end);
/* If 'range' is set, 'value' is the ending of a range--check its
* validity. (If value isn't a single code point in the case of a
@@ -18199,7 +18199,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
char* next_char_ptr = RExC_parse + 1;
/* Get the next real char after the '-' */
- SKIP_BRACKETED_WHITE_SPACE(skip_white, next_char_ptr);
+ SKIP_BRACKETED_WHITE_SPACE(skip_white, next_char_ptr, RExC_end);
/* If the '-' is at the end of the class (just before the ']',
* it is a literal minus; otherwise it is a range */
--
2.25.4

View File

@ -0,0 +1,55 @@
From 042abef72d40ab7ff39127e2afae6e34dfc66404 Mon Sep 17 00:00:00 2001
From: Nicolas R <atoomic@cpan.org>
Date: Fri, 14 Aug 2020 16:16:22 -0500
Subject: [PATCH] die_unwind(): global destruction
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Fix #18063
During global destruction make sure we preserve
the string by using mortalcopy.
This is an update on 8c86f0238ecb5f32c2e7fba36e3edfdb54069068
change which avoided sv_mortalcopy in favor of sv_2mortal.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
pp_ctl.c | 6 +++++-
t/op/die_unwind.t | 4 ++++
2 files changed, 9 insertions(+), 1 deletion(-)
diff --git a/pp_ctl.c b/pp_ctl.c
index b8cd869ee0..cc244d7ba7 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1716,7 +1716,11 @@ Perl_die_unwind(pTHX_ SV *msv)
* when unlocalising a tied var). So we do a dance with
* mortalising and SAVEFREEing.
*/
- sv_2mortal(SvREFCNT_inc_simple_NN(exceptsv));
+ if (PL_phase == PERL_PHASE_DESTRUCT) {
+ exceptsv = sv_mortalcopy(exceptsv);
+ } else {
+ exceptsv = sv_2mortal(SvREFCNT_inc_simple_NN(exceptsv));
+ }
/*
* Historically, perl used to set ERRSV ($@) early in the die
diff --git a/t/op/die_unwind.t b/t/op/die_unwind.t
index eee1ce534b..4b83ee6fac 100644
--- a/t/op/die_unwind.t
+++ b/t/op/die_unwind.t
@@ -69,4 +69,8 @@ is($uerr, "t3\n");
is($val, undef, "undefined return value from 'eval' block with 'die'");
is($err, "t3\n");
+fresh_perl_like(<<'EOS', qr/Custom Message During Global Destruction/, { switches => ['-w'], stderr => 1 } );
+package Foo; sub DESTROY { die "Custom Message During Global Destruction" }; package main; our $wut = bless [], "Foo"
+EOS
+
done_testing();
--
2.25.4

View File

@ -0,0 +1,77 @@
From 390fe0c0d09aadc66f644e9eee4aa1245221188c Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Tue, 25 Aug 2020 13:15:25 +0100
Subject: [PATCH] sort { return foo() } ...
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
GH #18081
A sub call via return in a sort block was called in void rather than
scalar context, causing the comparison result to be discarded.
This because when a sort block is called it is not a real function
call, even though a sort block can be returned from. Instead, a
CXt_NULL is pushed on the context stack. Because this isn't a sub-ish
context type (unlike CXt_SUB, CXt_EVAL etc) there is no 'caller sub'
on the context stack to be found to retrieve the caller's context
(i.e. cx->cx_gimme).
This commit fixes it by special-casing Perl_gimme_V().
Ideally at some future point, a new context type, CXt_SORT, should be
added. This would be used instead of CXt_NULL when a sort BLOCK is
called. Like other sub-ish context types, it would have an old_cxsubix
field and PL_curstackinfo->si_cxsubix would point to it. This would
eliminate needing special-case handling in places like Perl_gimme_V().
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
inline.h | 2 +-
t/op/sort.t | 12 +++++++++++-
2 files changed, 12 insertions(+), 2 deletions(-)
diff --git a/inline.h b/inline.h
index a8240efb9c..6fbd5abfea 100644
--- a/inline.h
+++ b/inline.h
@@ -2086,7 +2086,7 @@ Perl_gimme_V(pTHX)
return gimme;
cxix = PL_curstackinfo->si_cxsubix;
if (cxix < 0)
- return G_VOID;
+ return PL_curstackinfo->si_type == PERLSI_SORT ? G_SCALAR: G_VOID;
assert(cxstack[cxix].blk_gimme & G_WANT);
return (cxstack[cxix].blk_gimme & G_WANT);
}
diff --git a/t/op/sort.t b/t/op/sort.t
index f2e139dff0..8e387fb90d 100644
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -7,7 +7,7 @@ BEGIN {
set_up_inc('../lib');
}
use warnings;
-plan(tests => 203);
+plan(tests => 204);
use Tie::Array; # we need to test sorting tied arrays
# these shouldn't hang
@@ -1202,3 +1202,13 @@ SKIP:
$fillb = undef;
is $act, "01[sortb]2[fillb]";
}
+
+# GH #18081
+# sub call via return in sort block was called in void rather than scalar
+# context
+
+{
+ sub sort18081 { $a + 1 <=> $b + 1 }
+ my @a = sort { return &sort18081 } 6,1,2;
+ is "@a", "1 2 6", "GH #18081";
+}
--
2.25.4

View File

@ -0,0 +1,56 @@
From f4cd5e29bc15621f2ab8fc5d7de0e68e62d43999 Mon Sep 17 00:00:00 2001
From: Hugo van der Sanden <hv@crypt.org>
Date: Tue, 15 Sep 2020 14:02:54 +0100
Subject: [PATCH] [gh18096] assume worst-case for GOSUBs we don't analyse
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
During study_chunk, under various conditions we avoid recursing into
a GOSUB. But we must avoid giving the enclosing scope the idea that
this GOSUB would match only an empty string, since that could trigger
wrong optimizations (eg CURLYX => CURLYM in the ticket).
So we mark the construct as infinite, as in the code branch where we
_do_ recurse into it.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
regcomp.c | 7 ++++++-
t/re/re_tests | 2 ++
2 files changed, 8 insertions(+), 1 deletion(-)
diff --git a/regcomp.c b/regcomp.c
index 124ea5b90b..fae3f8079d 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -5212,7 +5212,12 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
* might result in a minlen of 1 and not of 4,
* but this doesn't make us mismatch, just try a bit
* harder than we should.
- * */
+ *
+ * However we must assume this GOSUB is infinite, to
+ * avoid wrongly applying other optimizations in the
+ * enclosing scope - see GH 18096, for example.
+ */
+ is_inf = is_inf_internal = 1;
scan= regnext(scan);
continue;
}
diff --git a/t/re/re_tests b/t/re/re_tests
index 554a7004a2..ab5a0d8012 100644
--- a/t/re/re_tests
+++ b/t/re/re_tests
@@ -2023,6 +2023,8 @@ AB\s+\x{100} AB \x{100}X y - -
/(?iaax:A? \K +)/ African_Feh c - \\K + is forbidden - matches null string many times in regex
/(?iaa:A?\K+)/ African_Feh c - \\K+ is forbidden - matches null string many times in regex
/(?iaa:A?\K*)/ African_Feh c - \\K* is forbidden - matches null string many times in regex
+^((\w|<(\s)*(?1)(?3)*>)(?:(?3)*\+(?3)*(?2))*)(?3)*\+ a + b + <c + d> y $1 a + b # [GH #18096]
+^((\w|<(\s)*(?1)(?3)*>)(?:(?3)*\+(?3)*(?2))*)(?3)*\+ a + <b> + c y $1 a + <b> # [GH #18096]
# Keep these lines at the end of the file
# pat string y/n/etc expr expected-expr skip-reason comment
# vim: softtabstop=0 noexpandtab
--
2.25.4

View File

@ -0,0 +1,31 @@
From fa353c3d2833fc326233e0eb583753b4d7887a63 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Sun, 4 Oct 2020 11:07:19 -0600
Subject: [PATCH] mro.xs: Fix compiler warning
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Fixes GH #18155
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
ext/mro/mro.xs | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/ext/mro/mro.xs b/ext/mro/mro.xs
index f21216af6e..8ce5844904 100644
--- a/ext/mro/mro.xs
+++ b/ext/mro/mro.xs
@@ -253,7 +253,7 @@ S_mro_get_linear_isa_c3(pTHX_ HV* stash, U32 level)
hierarchy is not C3-incompatible */
if(!winner) {
SV *errmsg;
- I32 i;
+ Size_t i;
errmsg = newSVpvf(
"Inconsistent hierarchy during C3 merge of class '%" HEKf "':\n\t"
--
2.25.4

View File

@ -0,0 +1,32 @@
From 5777cf812c2812ea45eeb45e48979bab544d71af Mon Sep 17 00:00:00 2001
From: TAKAI Kousuke <62541129+t-a-k@users.noreply.github.com>
Date: Thu, 8 Oct 2020 19:02:10 +0900
Subject: [PATCH] sv.c: Added missing braces in Perl_sv_inc_nomg().
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
sv.c | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/sv.c b/sv.c
index 82248e3b1f..57fd65a5b8 100644
--- a/sv.c
+++ b/sv.c
@@ -8944,9 +8944,10 @@ Perl_sv_inc_nomg(pTHX_ SV *const sv)
if (SvIsUV(sv)) {
if (SvUVX(sv) == UV_MAX)
sv_setnv(sv, UV_MAX_P1);
- else
+ else {
(void)SvIOK_only_UV(sv);
SvUV_set(sv, SvUVX(sv) + 1);
+ }
} else {
if (SvIVX(sv) == IV_MAX)
sv_setuv(sv, (UV)IV_MAX + 1);
--
2.25.4

View File

@ -0,0 +1,36 @@
From e17dadf36f7b4348e59076240c880d0c78b33fa9 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Tue, 22 Sep 2020 08:47:52 -0600
Subject: [PATCH] sv.h: sv_collxfrm didn't work properly
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
It is supposed to be a wrapper for sv_collxfrm_flags, but it was just
calling sv_cmp_flags instead. The consequences are none except under
'use locale' in which case you always got the C locale. I did not add
tests, because it is really a pain to write portable locale tests, and
this doesn't seem to be much used. In core the '_flags' form was always
used.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
sv.h | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/sv.h b/sv.h
index 19ce718ac3..44414b35a9 100644
--- a/sv.h
+++ b/sv.h
@@ -2045,7 +2045,7 @@ Like C<sv_catsv> but doesn't process magic.
#define sv_eq(sv1, sv2) sv_eq_flags(sv1, sv2, SV_GMAGIC)
#define sv_cmp(sv1, sv2) sv_cmp_flags(sv1, sv2, SV_GMAGIC)
#define sv_cmp_locale(sv1, sv2) sv_cmp_locale_flags(sv1, sv2, SV_GMAGIC)
-#define sv_collxfrm(sv, nxp) sv_cmp_flags(sv, nxp, SV_GMAGIC)
+#define sv_collxfrm(sv, nxp) sv_collxfrm_flags(sv, nxp, SV_GMAGIC)
#define sv_2bool(sv) sv_2bool_flags(sv, SV_GMAGIC)
#define sv_2bool_nomg(sv) sv_2bool_flags(sv, 0)
#define sv_insert(bigstr, offset, len, little, littlelen) \
--
2.25.4

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"

15
perl-5.8.0-libnet.cfg Normal file
View File

@ -0,0 +1,15 @@
{
'pop3_hosts' => [],
'ph_hosts' => [],
'inet_domain' => undef,
'time_hosts' => [],
'daytime_hosts' => [],
'smtp_hosts' => [],
'test_exist' => 1,
'test_hosts' => 1,
'nntp_hosts' => [],
'ftp_testhost' => undef,
'snpp_hosts' => [],
'ftp_int_passive' => 1,
'ftp_ext_passive' => 1,
}

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 PUREPERL_ONLY
- 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

7
perl.rpmlintrc Normal file
View File

@ -0,0 +1,7 @@
from Config import *
addFilter("spelling-error .* (autoloaded|awk|cacheout|closedir|decrement|exe|explicative|gdbm|getgr|gethost|getnet|getproto|getpw|getserv|globbing|gmtime|groff|ithreads|lexically|libnet|localtime|lstat|Memoizing|metapackage|ndbm|Nestable|nonprintable|odbm|opcodes|opendir|perlbug|perldoc|perlfunc|perlglob|perllocale|perldiag|perlmain|perlpod|perlsub|Pragma|prebuilt|predeclare|printables|reachability|readdir|redispatch|rewinddir|rpmbuild|sdbm|sed|splain|truncations|usr|writemain)");
addFilter("unexpanded-macro %description .* %(Extensions|INC)");
# POSIX module provides wrappers for libc functions
addFilter("missing-call-to-setgroups-before-setuid .*/auto/POSIX/POSIX.so");
# Applied with "git am"
addFilter("patch-not-applied Patch58: perl-5.30.0-PATCH-perl-134329-Use-after-free-in-regcomp.c.patch");

9043
perl.spec Normal 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)
}

1
sources Normal file
View File

@ -0,0 +1 @@
SHA512 (perl-5.32.0.tar.xz) = 1540247415893bbd94dfeede7b4fba6052688dc0bf27ced817f448246fcdc6e9a6486abc34577dec5b00bf02ed607b2d24ccd4977c3b3c51e8e6edfc0b81c760

7
system-owned-directories Normal file
View File

@ -0,0 +1,7 @@
%dir /usr
%dir /usr/bin
%dir /usr/lib
%dir /usr/share
%dir /usr/share/man
%dir /usr/share/man/man1
%dir /usr/share/man/man3