commit
57a0b1a1fa
@ -0,0 +1 @@
|
|||||||
|
SOURCES/perl-5.32.1.tar.xz
|
@ -0,0 +1 @@
|
|||||||
|
1fb4f710d139da1e1a3e1fa4eaba201fcaa8e18e SOURCES/perl-5.32.1.tar.xz
|
@ -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
|
File diff suppressed because it is too large
Load Diff
@ -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/
|
||||||
|
|
@ -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.
|
@ -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);
|
@ -0,0 +1,17 @@
|
|||||||
|
diff -up perl-5.14.1/cpan/File-Temp/t/fork.t.off perl-5.14.1/cpan/File-Temp/t/fork.t
|
||||||
|
--- perl-5.14.1/cpan/File-Temp/t/fork.t.off 2011-04-13 13:36:34.000000000 +0200
|
||||||
|
+++ perl-5.14.1/cpan/File-Temp/t/fork.t 2011-06-20 10:29:31.536282611 +0200
|
||||||
|
@@ -12,12 +12,8 @@ BEGIN {
|
||||||
|
$Config::Config{useithreads} and
|
||||||
|
$Config::Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
|
||||||
|
);
|
||||||
|
- if ( $can_fork ) {
|
||||||
|
- print "1..8\n";
|
||||||
|
- } else {
|
||||||
|
- print "1..0 # Skip No fork available\n";
|
||||||
|
+ print "1..0 # Skip Koji doesn't work with Perl fork tests\n";
|
||||||
|
exit;
|
||||||
|
- }
|
||||||
|
}
|
||||||
|
|
||||||
|
use File::Temp;
|
@ -0,0 +1,65 @@
|
|||||||
|
From b598ba3f2d4b8347c6621cff022b8e2329b79ea5 Mon Sep 17 00:00:00 2001
|
||||||
|
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
|
||||||
|
Date: Wed, 3 Jul 2013 11:01:02 +0200
|
||||||
|
Subject: [PATCH] Link XS modules to libperl.so with EU::CBuilder on Linux
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
<https://bugzilla.redhat.com/show_bug.cgi?id=960048>
|
||||||
|
<http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=327585#50>
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
MANIFEST | 1 +
|
||||||
|
.../lib/ExtUtils/CBuilder/Platform/linux.pm | 26 ++++++++++++++++++++++
|
||||||
|
2 files changed, 27 insertions(+)
|
||||||
|
create mode 100644 dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/linux.pm
|
||||||
|
|
||||||
|
diff --git a/MANIFEST b/MANIFEST
|
||||||
|
index 397252a..d7c519b 100644
|
||||||
|
--- a/MANIFEST
|
||||||
|
+++ b/MANIFEST
|
||||||
|
@@ -3424,6 +3424,7 @@ dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/aix.pm CBuilder methods fo
|
||||||
|
dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/cygwin.pm CBuilder methods for cygwin
|
||||||
|
dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/darwin.pm CBuilder methods for darwin
|
||||||
|
dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/dec_osf.pm CBuilder methods for OSF
|
||||||
|
+dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/linux.pm CBuilder methods for Linux
|
||||||
|
dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/os2.pm CBuilder methods for OS/2
|
||||||
|
dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Unix.pm CBuilder methods for Unix
|
||||||
|
dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/VMS.pm CBuilder methods for VMS
|
||||||
|
diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/linux.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/linux.pm
|
||||||
|
new file mode 100644
|
||||||
|
index 0000000..e3251c4
|
||||||
|
--- /dev/null
|
||||||
|
+++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/linux.pm
|
||||||
|
@@ -0,0 +1,26 @@
|
||||||
|
+package ExtUtils::CBuilder::Platform::linux;
|
||||||
|
+
|
||||||
|
+use strict;
|
||||||
|
+use ExtUtils::CBuilder::Platform::Unix;
|
||||||
|
+use File::Spec;
|
||||||
|
+
|
||||||
|
+use vars qw($VERSION @ISA);
|
||||||
|
+$VERSION = '0.280206';
|
||||||
|
+@ISA = qw(ExtUtils::CBuilder::Platform::Unix);
|
||||||
|
+
|
||||||
|
+sub link {
|
||||||
|
+ my ($self, %args) = @_;
|
||||||
|
+ my $cf = $self->{config};
|
||||||
|
+
|
||||||
|
+ # Link XS modules to libperl.so explicitly because multiple
|
||||||
|
+ # dlopen(, RTLD_LOCAL) hides libperl symbols from XS module.
|
||||||
|
+ local $cf->{lddlflags} = $cf->{lddlflags};
|
||||||
|
+ if ($ENV{PERL_CORE}) {
|
||||||
|
+ $cf->{lddlflags} .= ' -L' . $self->perl_inc();
|
||||||
|
+ }
|
||||||
|
+ $cf->{lddlflags} .= ' -lperl';
|
||||||
|
+
|
||||||
|
+ return $self->SUPER::link(%args);
|
||||||
|
+}
|
||||||
|
+
|
||||||
|
+1;
|
||||||
|
--
|
||||||
|
1.8.1.4
|
||||||
|
|
@ -0,0 +1,52 @@
|
|||||||
|
From fc1f8ac36c34c35bad84fb7b99a26ab83c9ba075 Mon Sep 17 00:00:00 2001
|
||||||
|
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
|
||||||
|
Date: Wed, 3 Jul 2013 12:59:09 +0200
|
||||||
|
Subject: [PATCH] Link XS modules to libperl.so with EU::MM on Linux
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
<https://bugzilla.redhat.com/show_bug.cgi?id=960048>
|
||||||
|
<http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=327585#50>
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm | 8 +++++++-
|
||||||
|
1 file changed, 7 insertions(+), 1 deletion(-)
|
||||||
|
|
||||||
|
diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm
|
||||||
|
index a8b172f..a3fbce2 100644
|
||||||
|
--- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm
|
||||||
|
+++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm
|
||||||
|
@@ -30,6 +30,7 @@ BEGIN {
|
||||||
|
$Is{IRIX} = $^O eq 'irix';
|
||||||
|
$Is{NetBSD} = $^O eq 'netbsd';
|
||||||
|
$Is{Interix} = $^O eq 'interix';
|
||||||
|
+ $Is{Linux} = $^O eq 'linux';
|
||||||
|
$Is{SunOS4} = $^O eq 'sunos';
|
||||||
|
$Is{Solaris} = $^O eq 'solaris';
|
||||||
|
$Is{SunOS} = $Is{SunOS4} || $Is{Solaris};
|
||||||
|
@@ -1028,7 +1029,7 @@ sub xs_make_dynamic_lib {
|
||||||
|
push(@m," \$(RM_F) \$\@\n");
|
||||||
|
|
||||||
|
my $libs = '$(LDLOADLIBS)';
|
||||||
|
- if (($Is{NetBSD} || $Is{Interix} || $Is{Android}) && $Config{'useshrplib'} eq 'true') {
|
||||||
|
+ if (($Is{Linux} || $Is{NetBSD} || $Is{Interix} || $Is{Android}) && $Config{'useshrplib'} eq 'true') {
|
||||||
|
# Use nothing on static perl platforms, and to the flags needed
|
||||||
|
# to link against the shared libperl library on shared perl
|
||||||
|
# platforms. We peek at lddlflags to see if we need -Wl,-R
|
||||||
|
@@ -1041,6 +1042,11 @@ sub xs_make_dynamic_lib {
|
||||||
|
# The Android linker will not recognize symbols from
|
||||||
|
# libperl unless the module explicitly depends on it.
|
||||||
|
$libs .= ' "-L$(PERL_INC)" -lperl';
|
||||||
|
+ } else {
|
||||||
|
+ if ($ENV{PERL_CORE}) {
|
||||||
|
+ $libs .= ' "-L$(PERL_INC)"';
|
||||||
|
+ }
|
||||||
|
+ $libs .= ' -lperl';
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
--
|
||||||
|
1.8.1.4
|
||||||
|
|
@ -0,0 +1,57 @@
|
|||||||
|
From fa2f0dd5a7767223df10149d3f16d7ed7013e16f Mon Sep 17 00:00:00 2001
|
||||||
|
From: Torsten Veller <tove@gentoo.org>
|
||||||
|
Date: Sat, 14 Apr 2012 13:49:18 +0200
|
||||||
|
Subject: Set libperl soname
|
||||||
|
|
||||||
|
Bug-Gentoo: https://bugs.gentoo.org/286840
|
||||||
|
|
||||||
|
Patch-Name: gentoo/create_libperl_soname.diff
|
||||||
|
---
|
||||||
|
Makefile.SH | 9 +++++++--
|
||||||
|
1 file changed, 7 insertions(+), 2 deletions(-)
|
||||||
|
|
||||||
|
diff --git a/Makefile.SH b/Makefile.SH
|
||||||
|
index d1da0a0..7733a32 100755
|
||||||
|
--- a/Makefile.SH
|
||||||
|
+++ b/Makefile.SH
|
||||||
|
@@ -70,11 +70,11 @@ true)
|
||||||
|
${revision}.${patchlevel}.${subversion}"
|
||||||
|
case "$osvers" in
|
||||||
|
1[5-9]*|[2-9]*)
|
||||||
|
- shrpldflags="$shrpldflags -install_name `pwd`/\$@ -Xlinker -headerpad_max_install_names"
|
||||||
|
+ shrpldflags="$shrpldflags -install_name `pwd`/libperl.${revision}.${patchlevel}.dylib -Xlinker -headerpad_max_install_names"
|
||||||
|
exeldflags="-Xlinker -headerpad_max_install_names"
|
||||||
|
;;
|
||||||
|
*)
|
||||||
|
- shrpldflags="$shrpldflags -install_name \$(shrpdir)/\$@"
|
||||||
|
+ shrpldflags="$shrpldflags -install_name \$(shrpdir)/libperl.${revision}.${patchlevel}.dylib"
|
||||||
|
;;
|
||||||
|
esac
|
||||||
|
;;
|
||||||
|
@@ -76,13 +76,15 @@ true)
|
||||||
|
;;
|
||||||
|
sunos*)
|
||||||
|
linklibperl="-lperl"
|
||||||
|
+ shrpldflags="$shrpldflags -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}"
|
||||||
|
;;
|
||||||
|
netbsd*|freebsd[234]*|openbsd*|dragonfly*|bitrig*)
|
||||||
|
linklibperl="-L. -lperl"
|
||||||
|
+ shrpldflags="$shrpldflags -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}"
|
||||||
|
;;
|
||||||
|
interix*)
|
||||||
|
linklibperl="-L. -lperl"
|
||||||
|
- shrpldflags="$shrpldflags -Wl,--image-base,0x57000000"
|
||||||
|
+ shrpldflags="$shrpldflags -Wl,--image-base,0x57000000 -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}"
|
||||||
|
;;
|
||||||
|
aix*)
|
||||||
|
case "$cc" in
|
||||||
|
@@ -120,6 +122,9 @@ true)
|
||||||
|
linklibperl='libperl.x'
|
||||||
|
DPERL_EXTERNAL_GLOB=''
|
||||||
|
;;
|
||||||
|
+ linux*)
|
||||||
|
+ shrpldflags="$shrpldflags -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}"
|
||||||
|
+ ;;
|
||||||
|
esac
|
||||||
|
case "$ldlibpthname" in
|
||||||
|
'') ;;
|
@ -0,0 +1,233 @@
|
|||||||
|
From f793042f2bac2ace9a5c0030b47b41c4db561a5b Mon Sep 17 00:00:00 2001
|
||||||
|
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
|
||||||
|
Date: Fri, 6 Jun 2014 14:31:59 +0200
|
||||||
|
Subject: [PATCH] Destroy {GDBM,NDBM,ODBM,SDBM}_File objects only from original
|
||||||
|
thread context
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
This patch fixes a crash when destroing a hash tied to a *_File
|
||||||
|
database after spawning a thread:
|
||||||
|
|
||||||
|
use Fcntl;
|
||||||
|
use SDBM_File;
|
||||||
|
use threads;
|
||||||
|
tie(my %dbtest, 'SDBM_File', "test.db", O_RDWR|O_CREAT, 0666);
|
||||||
|
threads->new(sub {})->join;
|
||||||
|
|
||||||
|
This crashed or paniced depending on how perl was configured.
|
||||||
|
|
||||||
|
Closes RT#61912.
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
ext/GDBM_File/GDBM_File.xs | 16 ++++++++++------
|
||||||
|
ext/NDBM_File/NDBM_File.xs | 16 ++++++++++------
|
||||||
|
ext/ODBM_File/ODBM_File.xs | 18 +++++++++++-------
|
||||||
|
ext/SDBM_File/SDBM_File.xs | 4 +++-
|
||||||
|
t/lib/dbmt_common.pl | 35 +++++++++++++++++++++++++++++++++++
|
||||||
|
5 files changed, 69 insertions(+), 20 deletions(-)
|
||||||
|
|
||||||
|
diff --git a/ext/GDBM_File/GDBM_File.xs b/ext/GDBM_File/GDBM_File.xs
|
||||||
|
index 33e08e2..7160f54 100644
|
||||||
|
--- a/ext/GDBM_File/GDBM_File.xs
|
||||||
|
+++ b/ext/GDBM_File/GDBM_File.xs
|
||||||
|
@@ -13,6 +13,7 @@
|
||||||
|
#define store_value 3
|
||||||
|
|
||||||
|
typedef struct {
|
||||||
|
+ tTHX owner;
|
||||||
|
GDBM_FILE dbp ;
|
||||||
|
SV * filter[4];
|
||||||
|
int filtering ;
|
||||||
|
@@ -98,6 +99,7 @@ gdbm_TIEHASH(dbtype, name, read_write, m
|
||||||
|
}
|
||||||
|
if (dbp) {
|
||||||
|
RETVAL = (GDBM_File)safecalloc(1, sizeof(GDBM_File_type));
|
||||||
|
+ RETVAL->owner = aTHX;
|
||||||
|
RETVAL->dbp = dbp;
|
||||||
|
} else {
|
||||||
|
RETVAL = NULL;
|
||||||
|
@@ -118,12 +120,14 @@ gdbm_DESTROY(db)
|
||||||
|
PREINIT:
|
||||||
|
int i = store_value;
|
||||||
|
CODE:
|
||||||
|
- gdbm_close(db);
|
||||||
|
- do {
|
||||||
|
- if (db->filter[i])
|
||||||
|
- SvREFCNT_dec(db->filter[i]);
|
||||||
|
- } while (i-- > 0);
|
||||||
|
- safefree(db);
|
||||||
|
+ if (db && db->owner == aTHX) {
|
||||||
|
+ gdbm_close(db);
|
||||||
|
+ do {
|
||||||
|
+ if (db->filter[i])
|
||||||
|
+ SvREFCNT_dec(db->filter[i]);
|
||||||
|
+ } while (i-- > 0);
|
||||||
|
+ safefree(db);
|
||||||
|
+ }
|
||||||
|
|
||||||
|
#define gdbm_FETCH(db,key) gdbm_fetch(db->dbp,key)
|
||||||
|
datum_value
|
||||||
|
diff --git a/ext/NDBM_File/NDBM_File.xs b/ext/NDBM_File/NDBM_File.xs
|
||||||
|
index 52e60fc..af223e5 100644
|
||||||
|
--- a/ext/NDBM_File/NDBM_File.xs
|
||||||
|
+++ b/ext/NDBM_File/NDBM_File.xs
|
||||||
|
@@ -33,6 +33,7 @@ END_EXTERN_C
|
||||||
|
#define store_value 3
|
||||||
|
|
||||||
|
typedef struct {
|
||||||
|
+ tTHX owner;
|
||||||
|
DBM * dbp ;
|
||||||
|
SV * filter[4];
|
||||||
|
int filtering ;
|
||||||
|
@@ -71,6 +72,7 @@ ndbm_TIEHASH(dbtype, filename, flags, mode)
|
||||||
|
RETVAL = NULL ;
|
||||||
|
if ((dbp = dbm_open(filename, flags, mode))) {
|
||||||
|
RETVAL = (NDBM_File)safecalloc(1, sizeof(NDBM_File_type));
|
||||||
|
+ RETVAL->owner = aTHX;
|
||||||
|
RETVAL->dbp = dbp ;
|
||||||
|
}
|
||||||
|
|
||||||
|
@@ -84,12 +86,14 @@ ndbm_DESTROY(db)
|
||||||
|
PREINIT:
|
||||||
|
int i = store_value;
|
||||||
|
CODE:
|
||||||
|
- dbm_close(db->dbp);
|
||||||
|
- do {
|
||||||
|
- if (db->filter[i])
|
||||||
|
- SvREFCNT_dec(db->filter[i]);
|
||||||
|
- } while (i-- > 0);
|
||||||
|
- safefree(db);
|
||||||
|
+ if (db && db->owner == aTHX) {
|
||||||
|
+ dbm_close(db->dbp);
|
||||||
|
+ do {
|
||||||
|
+ if (db->filter[i])
|
||||||
|
+ SvREFCNT_dec(db->filter[i]);
|
||||||
|
+ } while (i-- > 0);
|
||||||
|
+ safefree(db);
|
||||||
|
+ }
|
||||||
|
|
||||||
|
#define ndbm_FETCH(db,key) dbm_fetch(db->dbp,key)
|
||||||
|
datum_value
|
||||||
|
diff --git a/ext/ODBM_File/ODBM_File.xs b/ext/ODBM_File/ODBM_File.xs
|
||||||
|
index d1ece7f..f7e00a0 100644
|
||||||
|
--- a/ext/ODBM_File/ODBM_File.xs
|
||||||
|
+++ b/ext/ODBM_File/ODBM_File.xs
|
||||||
|
@@ -49,6 +49,7 @@ datum nextkey(datum key);
|
||||||
|
#define store_value 3
|
||||||
|
|
||||||
|
typedef struct {
|
||||||
|
+ tTHX owner;
|
||||||
|
void * dbp ;
|
||||||
|
SV * filter[4];
|
||||||
|
int filtering ;
|
||||||
|
@@ -137,6 +138,7 @@ odbm_TIEHASH(dbtype, filename, flags, mode)
|
||||||
|
}
|
||||||
|
dbp = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0);
|
||||||
|
RETVAL = (ODBM_File)safecalloc(1, sizeof(ODBM_File_type));
|
||||||
|
+ RETVAL->owner = aTHX;
|
||||||
|
RETVAL->dbp = dbp ;
|
||||||
|
}
|
||||||
|
OUTPUT:
|
||||||
|
@@ -149,13 +151,15 @@ DESTROY(db)
|
||||||
|
dMY_CXT;
|
||||||
|
int i = store_value;
|
||||||
|
CODE:
|
||||||
|
- dbmrefcnt--;
|
||||||
|
- dbmclose();
|
||||||
|
- do {
|
||||||
|
- if (db->filter[i])
|
||||||
|
- SvREFCNT_dec(db->filter[i]);
|
||||||
|
- } while (i-- > 0);
|
||||||
|
- safefree(db);
|
||||||
|
+ if (db && db->owner == aTHX) {
|
||||||
|
+ dbmrefcnt--;
|
||||||
|
+ dbmclose();
|
||||||
|
+ do {
|
||||||
|
+ if (db->filter[i])
|
||||||
|
+ SvREFCNT_dec(db->filter[i]);
|
||||||
|
+ } while (i-- > 0);
|
||||||
|
+ safefree(db);
|
||||||
|
+ }
|
||||||
|
|
||||||
|
datum_value
|
||||||
|
odbm_FETCH(db, key)
|
||||||
|
diff --git a/ext/SDBM_File/SDBM_File.xs b/ext/SDBM_File/SDBM_File.xs
|
||||||
|
index 291e41b..0bdae9a 100644
|
||||||
|
--- a/ext/SDBM_File/SDBM_File.xs
|
||||||
|
+++ b/ext/SDBM_File/SDBM_File.xs
|
||||||
|
@@ -10,6 +10,7 @@
|
||||||
|
#define store_value 3
|
||||||
|
|
||||||
|
typedef struct {
|
||||||
|
+ tTHX owner;
|
||||||
|
DBM * dbp ;
|
||||||
|
SV * filter[4];
|
||||||
|
int filtering ;
|
||||||
|
@@ -51,6 +52,7 @@ sdbm_TIEHASH(dbtype, filename, flags, mode)
|
||||||
|
}
|
||||||
|
if (dbp) {
|
||||||
|
RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type));
|
||||||
|
+ RETVAL->owner = aTHX;
|
||||||
|
RETVAL->dbp = dbp ;
|
||||||
|
}
|
||||||
|
|
||||||
|
@@ -62,7 +64,7 @@ void
|
||||||
|
sdbm_DESTROY(db)
|
||||||
|
SDBM_File db
|
||||||
|
CODE:
|
||||||
|
- if (db) {
|
||||||
|
+ if (db && db->owner == aTHX) {
|
||||||
|
int i = store_value;
|
||||||
|
sdbm_close(db->dbp);
|
||||||
|
do {
|
||||||
|
diff --git a/t/lib/dbmt_common.pl b/t/lib/dbmt_common.pl
|
||||||
|
index 5d4098c..a0a4d52 100644
|
||||||
|
--- a/t/lib/dbmt_common.pl
|
||||||
|
+++ b/t/lib/dbmt_common.pl
|
||||||
|
@@ -510,5 +510,40 @@ unlink <Op_dbmx*>, $Dfile;
|
||||||
|
unlink <Op1_dbmx*>;
|
||||||
|
}
|
||||||
|
|
||||||
|
+{
|
||||||
|
+ # Check DBM back-ends do not destroy objects from then-spawned threads.
|
||||||
|
+ # RT#61912.
|
||||||
|
+ SKIP: {
|
||||||
|
+ my $threads_count = 2;
|
||||||
|
+ skip 'Threads are disabled', 3 + 2 * $threads_count
|
||||||
|
+ unless $Config{usethreads};
|
||||||
|
+ use_ok('threads');
|
||||||
|
+
|
||||||
|
+ my %h;
|
||||||
|
+ unlink <Op1_dbmx*>;
|
||||||
|
+
|
||||||
|
+ my $db = tie %h, $DBM_Class, 'Op1_dbmx', $create, 0640;
|
||||||
|
+ isa_ok($db, $DBM_Class);
|
||||||
|
+
|
||||||
|
+ for (1 .. 2) {
|
||||||
|
+ ok(threads->create(
|
||||||
|
+ sub {
|
||||||
|
+ $SIG{'__WARN__'} = sub { fail(shift) }; # debugging perl panics
|
||||||
|
+ # report it by spurious TAP line
|
||||||
|
+ 1;
|
||||||
|
+ }), "Thread $_ created");
|
||||||
|
+ }
|
||||||
|
+ for (threads->list) {
|
||||||
|
+ is($_->join, 1, "A thread exited successfully");
|
||||||
|
+ }
|
||||||
|
+
|
||||||
|
+ pass("Tied object survived exiting threads");
|
||||||
|
+
|
||||||
|
+ undef $db;
|
||||||
|
+ untie %h;
|
||||||
|
+ unlink <Op1_dbmx*>;
|
||||||
|
+ }
|
||||||
|
+}
|
||||||
|
+
|
||||||
|
done_testing();
|
||||||
|
1;
|
||||||
|
--
|
||||||
|
1.9.3
|
||||||
|
|
@ -0,0 +1,61 @@
|
|||||||
|
From 9644657c4 10326749fd321d9c24944ec25afad2f Mon Sep 17 00:00:00 2001
|
||||||
|
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
|
||||||
|
Date: Thu, 20 Jun 2013 15:22:53 +0200
|
||||||
|
Subject: [PATCH] Install libperl.so to shrpdir on Linux
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
Configure | 7 ++++---
|
||||||
|
Makefile.SH | 2 +-
|
||||||
|
2 files changed, 5 insertions(+), 4 deletions(-)
|
||||||
|
|
||||||
|
diff --git a/Configure b/Configure
|
||||||
|
index 2f30261..825496e 100755
|
||||||
|
--- a/Configure
|
||||||
|
+++ b/Configure
|
||||||
|
@@ -8762,7 +8762,9 @@ esac
|
||||||
|
|
||||||
|
# Detect old use of shrpdir via undocumented Configure -Dshrpdir
|
||||||
|
case "$shrpdir" in
|
||||||
|
-'') ;;
|
||||||
|
+'')
|
||||||
|
+shrpdir=$archlibexp/CORE
|
||||||
|
+;;
|
||||||
|
*) $cat >&4 <<EOM
|
||||||
|
WARNING: Use of the shrpdir variable for the installation location of
|
||||||
|
the shared $libperl is not supported. It was never documented and
|
||||||
|
@@ -8792,7 +8794,6 @@ esac
|
||||||
|
# Add $xxx to ccdlflags.
|
||||||
|
# If we can't figure out a command-line option, use $shrpenv to
|
||||||
|
# set env LD_RUN_PATH. The main perl makefile uses this.
|
||||||
|
-shrpdir=$archlibexp/CORE
|
||||||
|
xxx=''
|
||||||
|
tmp_shrpenv=''
|
||||||
|
if "$useshrplib"; then
|
||||||
|
@@ -8807,7 +8808,7 @@ if "$useshrplib"; then
|
||||||
|
xxx="-Wl,-R$shrpdir"
|
||||||
|
;;
|
||||||
|
bsdos|linux|irix*|dec_osf|gnu*|haiku)
|
||||||
|
- xxx="-Wl,-rpath,$shrpdir"
|
||||||
|
+ # We want standard path
|
||||||
|
;;
|
||||||
|
hpux*)
|
||||||
|
# hpux doesn't like the default, either.
|
||||||
|
diff --git a/Makefile.SH b/Makefile.SH
|
||||||
|
index 7733a32..a481183 100755
|
||||||
|
--- a/Makefile.SH
|
||||||
|
+++ b/Makefile.SH
|
||||||
|
@@ -288,7 +288,7 @@ ranlib = $ranlib
|
||||||
|
# installman commandline.
|
||||||
|
bin = $installbin
|
||||||
|
scriptdir = $scriptdir
|
||||||
|
-shrpdir = $archlibexp/CORE
|
||||||
|
+shrpdir = $shrpdir
|
||||||
|
privlib = $installprivlib
|
||||||
|
man1dir = $man1dir
|
||||||
|
man1ext = $man1ext
|
||||||
|
--
|
||||||
|
1.8.1.4
|
@ -0,0 +1,110 @@
|
|||||||
|
From 9575301256f67116eccdbb99b38fc804ba3dcf53 Mon Sep 17 00:00:00 2001
|
||||||
|
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
|
||||||
|
Date: Mon, 18 Apr 2016 16:24:03 +0200
|
||||||
|
Subject: [PATCH] Provide ExtUtils::MM methods as standalone
|
||||||
|
ExtUtils::MM::Utils
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
If you cannot afford depending on ExtUtils::MakeMaker, you can
|
||||||
|
depend on ExtUtils::MM::Utils instead.
|
||||||
|
|
||||||
|
<https://bugzilla.redhat.com/show_bug.cgi?id=1129443>
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
MANIFEST | 1 +
|
||||||
|
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM/Utils.pm | 68 ++++++++++++++++++++++++
|
||||||
|
2 files changed, 69 insertions(+)
|
||||||
|
create mode 100644 cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM/Utils.pm
|
||||||
|
|
||||||
|
diff --git a/MANIFEST b/MANIFEST
|
||||||
|
index 6af238c..d4f0c56 100644
|
||||||
|
--- a/MANIFEST
|
||||||
|
+++ b/MANIFEST
|
||||||
|
@@ -784,6 +784,7 @@ cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm MakeMaker methods for OS/2
|
||||||
|
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm MakeMaker methods for OS/2
|
||||||
|
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm MakeMaker methods for QNX
|
||||||
|
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm MakeMaker methods for Unix
|
||||||
|
+cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM/Utils.pm Independed MM methods
|
||||||
|
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_UWIN.pm MakeMaker methods for U/WIN
|
||||||
|
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm MakeMaker methods for VMS
|
||||||
|
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VOS.pm MakeMaker methods for VOS
|
||||||
|
diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM/Utils.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM/Utils.pm
|
||||||
|
new file mode 100644
|
||||||
|
index 0000000..6bbc0d8
|
||||||
|
--- /dev/null
|
||||||
|
+++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM/Utils.pm
|
||||||
|
@@ -0,0 +1,68 @@
|
||||||
|
+package ExtUtils::MM::Utils;
|
||||||
|
+
|
||||||
|
+require 5.006;
|
||||||
|
+
|
||||||
|
+use strict;
|
||||||
|
+use vars qw($VERSION);
|
||||||
|
+$VERSION = '7.11_06';
|
||||||
|
+$VERSION = eval $VERSION; ## no critic [BuiltinFunctions::ProhibitStringyEval]
|
||||||
|
+
|
||||||
|
+=head1 NAME
|
||||||
|
+
|
||||||
|
+ExtUtils::MM::Utils - ExtUtils::MM methods without dependency on ExtUtils::MakeMaker
|
||||||
|
+
|
||||||
|
+=head1 SYNOPSIS
|
||||||
|
+
|
||||||
|
+ require ExtUtils::MM::Utils;
|
||||||
|
+ MM->maybe_command($file);
|
||||||
|
+
|
||||||
|
+=head1 DESCRIPTION
|
||||||
|
+
|
||||||
|
+This is a collection of L<ExtUtils::MM> subroutines that are used by many
|
||||||
|
+other modules but that do not need full-featured L<ExtUtils::MakeMaker>. The
|
||||||
|
+issue with L<ExtUtils::MakeMaker> is it pulls in Perl header files and that is
|
||||||
|
+an overkill for small subroutines.
|
||||||
|
+
|
||||||
|
+An example is the L<IPC::Cmd> that caused installing GCC just because of
|
||||||
|
+three-line I<maybe_command()> from L<ExtUtils::MM_Unix>.
|
||||||
|
+
|
||||||
|
+The intentions is to use L<ExtUtils::MM::Utils> instead of
|
||||||
|
+L<ExtUtils::MakeMaker> for these trivial methods. You can still call them via
|
||||||
|
+L<MM> class name.
|
||||||
|
+
|
||||||
|
+=head1 METHODS
|
||||||
|
+
|
||||||
|
+=over 4
|
||||||
|
+
|
||||||
|
+=item maybe_command
|
||||||
|
+
|
||||||
|
+Returns true, if the argument is likely to be a command.
|
||||||
|
+
|
||||||
|
+=cut
|
||||||
|
+
|
||||||
|
+if (!exists $INC{'ExtUtils/MM.pm'}) {
|
||||||
|
+ *MM::maybe_command = *ExtUtils::MM::maybe_command = \&maybe_command;
|
||||||
|
+}
|
||||||
|
+
|
||||||
|
+sub maybe_command {
|
||||||
|
+ my($self,$file) = @_;
|
||||||
|
+ return $file if -x $file && ! -d $file;
|
||||||
|
+ return;
|
||||||
|
+}
|
||||||
|
+
|
||||||
|
+1;
|
||||||
|
+
|
||||||
|
+=back
|
||||||
|
+
|
||||||
|
+=head1 BUGS
|
||||||
|
+
|
||||||
|
+These methods are copied from L<ExtUtils::MM_Unix>. Other operating systems
|
||||||
|
+are not supported yet. The reason is this
|
||||||
|
+L<a hack for Linux
|
||||||
|
+distributions|https://bugzilla.redhat.com/show_bug.cgi?id=1129443>.
|
||||||
|
+
|
||||||
|
+=head1 SEE ALSO
|
||||||
|
+
|
||||||
|
+L<ExtUtils::MakeMaker>, L<ExtUtils::MM>
|
||||||
|
+
|
||||||
|
+=cut
|
||||||
|
--
|
||||||
|
2.5.5
|
||||||
|
|
@ -0,0 +1,34 @@
|
|||||||
|
From 216ddd39adb0043930acad70ff242c30a1b0c6cf Mon Sep 17 00:00:00 2001
|
||||||
|
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
|
||||||
|
Date: Mon, 18 Apr 2016 16:39:32 +0200
|
||||||
|
Subject: [PATCH] Replace EU::MM dependnecy with EU::MM::Utils in IPC::Cmd
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
This allows to free from a run-time dependency on fat
|
||||||
|
ExtUtils::MakeMaker.
|
||||||
|
|
||||||
|
<https://bugzilla.redhat.com/show_bug.cgi?id=1129443>
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
cpan/IPC-Cmd/lib/IPC/Cmd.pm | 2 +-
|
||||||
|
1 file changed, 1 insertion(+), 1 deletion(-)
|
||||||
|
|
||||||
|
diff --git a/cpan/IPC-Cmd/lib/IPC/Cmd.pm b/cpan/IPC-Cmd/lib/IPC/Cmd.pm
|
||||||
|
index 6a82bdf..b6cd7ef 100644
|
||||||
|
--- a/cpan/IPC-Cmd/lib/IPC/Cmd.pm
|
||||||
|
+++ b/cpan/IPC-Cmd/lib/IPC/Cmd.pm
|
||||||
|
@@ -232,7 +232,7 @@ sub can_run {
|
||||||
|
}
|
||||||
|
|
||||||
|
require File::Spec;
|
||||||
|
- require ExtUtils::MakeMaker;
|
||||||
|
+ require ExtUtils::MM::Utils;
|
||||||
|
|
||||||
|
my @possibles;
|
||||||
|
|
||||||
|
--
|
||||||
|
2.5.5
|
||||||
|
|
@ -0,0 +1,61 @@
|
|||||||
|
From f6bc8fb3d26892ba1a84ba2df76beedd51998dd2 Mon Sep 17 00:00:00 2001
|
||||||
|
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
|
||||||
|
Date: Mon, 29 Jan 2018 16:34:17 +0100
|
||||||
|
Subject: [PATCH] hints/linux: Add -lphtread to lddlflags
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
Passing -z defs to linker flags causes perl to fail to build if threads are
|
||||||
|
enabled:
|
||||||
|
|
||||||
|
gcc -shared -Wl,-z,relro -Wl,-z,defs -specs=/usr/lib/rpm/redhat/redhat-hardened-ld -L/usr/local/lib -fstack-protector-strong Bzip2.o -o ../../lib/auto/Compress/Raw/Bzip2/Bzip2.so \
|
||||||
|
-L/usr/lib64 -lbz2 "-L../.." -lperl \
|
||||||
|
|
||||||
|
Bzip2.o: In function `deRef':
|
||||||
|
/builddir/build/BUILD/perl-5.26.1/cpan/Compress-Raw-Bzip2/Bzip2.xs:256: undefined reference to `pthread_getspecific'
|
||||||
|
|
||||||
|
The reason is Bzip2.xs calls dTHX macro included from thread.h via perl.h that
|
||||||
|
expands to pthread_getspecific() function call that is defined in pthread
|
||||||
|
library. But the pthread library is not explicitly linked to Bzip.so (see the
|
||||||
|
gcc command). This is exactly what -z defs linker flag enforces.
|
||||||
|
|
||||||
|
Underlinking ELFs can be dangerous because in case of versioned
|
||||||
|
symbols it can cause run-time binding to an improper version symbol or
|
||||||
|
even to an symbold from different library.
|
||||||
|
|
||||||
|
This patch fixes hints for Linux by adding -lpthreads to lddlflags. It
|
||||||
|
also adds -shared there because Configure.sh adds it only hints return
|
||||||
|
lddlflags empty.
|
||||||
|
|
||||||
|
<https://lists.fedoraproject.org/archives/list/devel@lists.fedoraproject.org/message/3RHZEHLRUHJFF2XGHI5RB6YPDNLDR4HG/>
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
hints/linux.sh | 4 ++++
|
||||||
|
1 file changed, 4 insertions(+)
|
||||||
|
|
||||||
|
diff --git a/hints/linux.sh b/hints/linux.sh
|
||||||
|
index 3f38ea07f1..9ec3bc02ef 100644
|
||||||
|
--- a/hints/linux.sh
|
||||||
|
+++ b/hints/linux.sh
|
||||||
|
@@ -353,12 +353,16 @@ if [ -f /etc/synoinfo.conf -a -d /usr/syno ]; then
|
||||||
|
echo "$libswanted" >&4
|
||||||
|
fi
|
||||||
|
|
||||||
|
+# Flags needed to produce shared libraries.
|
||||||
|
+lddlflags='-shared'
|
||||||
|
+
|
||||||
|
# This script UU/usethreads.cbu will get 'called-back' by Configure
|
||||||
|
# after it has prompted the user for whether to use threads.
|
||||||
|
cat > UU/usethreads.cbu <<'EOCBU'
|
||||||
|
case "$usethreads" in
|
||||||
|
$define|true|[yY]*)
|
||||||
|
ccflags="-D_REENTRANT -D_GNU_SOURCE $ccflags"
|
||||||
|
+ lddlflags="-lpthread $lddlflags"
|
||||||
|
if echo $libswanted | grep -v pthread >/dev/null
|
||||||
|
then
|
||||||
|
set `echo X "$libswanted "| sed -e 's/ c / pthread c /'`
|
||||||
|
--
|
||||||
|
2.13.6
|
||||||
|
|
@ -0,0 +1,175 @@
|
|||||||
|
From bafffe7f2ca587960177ed03216e2d5692fe6143 Mon Sep 17 00:00:00 2001
|
||||||
|
From: Karl Williamson <khw@cpan.org>
|
||||||
|
Date: Wed, 19 Aug 2020 11:57:17 -0600
|
||||||
|
Subject: [PATCH] Add av_count()
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
This returns the number of elements in an array in a clearly named
|
||||||
|
function.
|
||||||
|
|
||||||
|
av_top_index(), av_tindex() are clearly named, but are less than ideal,
|
||||||
|
and came about because no one back then thought of this one, until now
|
||||||
|
Paul Evans did.
|
||||||
|
|
||||||
|
Petr Písař: Port 87306e0674dfe3af29804b4641347cd5ac9b0521 to 5.32.0.
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
av.c | 17 ++++++++++++++---
|
||||||
|
av.h | 3 ++-
|
||||||
|
embed.fnc | 3 ++-
|
||||||
|
embed.h | 2 +-
|
||||||
|
inline.h | 16 ++++++++++++----
|
||||||
|
proto.h | 11 ++++++++---
|
||||||
|
6 files changed, 39 insertions(+), 13 deletions(-)
|
||||||
|
|
||||||
|
diff --git a/av.c b/av.c
|
||||||
|
index 27b2f12..b5ddaca 100644
|
||||||
|
--- a/av.c
|
||||||
|
+++ b/av.c
|
||||||
|
@@ -814,9 +814,10 @@ The Perl equivalent for this is C<$#myarray>.
|
||||||
|
=for apidoc av_len
|
||||||
|
|
||||||
|
Same as L</av_top_index>. Note that, unlike what the name implies, it returns
|
||||||
|
-the highest index in the array, so to get the size of the array you need to use
|
||||||
|
-S<C<av_len(av) + 1>>. This is unlike L</sv_len>, which returns what you would
|
||||||
|
-expect.
|
||||||
|
+the highest index in the array. This is unlike L</sv_len>, which returns what
|
||||||
|
+you would expect.
|
||||||
|
+
|
||||||
|
+B<To get the true number of elements in the array, instead use C<L</av_count>>>.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
*/
|
||||||
|
@@ -1089,6 +1090,16 @@ Perl_av_nonelem(pTHX_ AV *av, SSize_t ix) {
|
||||||
|
return sv;
|
||||||
|
}
|
||||||
|
|
||||||
|
+SSize_t
|
||||||
|
+Perl_av_top_index(pTHX_ AV *av)
|
||||||
|
+{
|
||||||
|
+ PERL_ARGS_ASSERT_AV_TOP_INDEX;
|
||||||
|
+ assert(SvTYPE(av) == SVt_PVAV);
|
||||||
|
+
|
||||||
|
+ return AvFILL(av);
|
||||||
|
+}
|
||||||
|
+
|
||||||
|
+
|
||||||
|
/*
|
||||||
|
* ex: set ts=8 sts=4 sw=4 et:
|
||||||
|
*/
|
||||||
|
diff --git a/av.h b/av.h
|
||||||
|
index 5e39c42..90ebfff 100644
|
||||||
|
--- a/av.h
|
||||||
|
+++ b/av.h
|
||||||
|
@@ -81,7 +81,8 @@ Same as C<av_top_index()>.
|
||||||
|
|
||||||
|
#define AvFILL(av) ((SvRMAGICAL((const SV *) (av))) \
|
||||||
|
? mg_size(MUTABLE_SV(av)) : AvFILLp(av))
|
||||||
|
-#define av_tindex(av) av_top_index(av)
|
||||||
|
+#define av_top_index(av) AvFILL(av)
|
||||||
|
+#define av_tindex(av) av_top_index(av)
|
||||||
|
|
||||||
|
/* Note that it doesn't make sense to do this:
|
||||||
|
* SvGETMAGIC(av); IV x = av_tindex_nomg(av);
|
||||||
|
diff --git a/embed.fnc b/embed.fnc
|
||||||
|
index 589ab1a..789cd3c 100644
|
||||||
|
--- a/embed.fnc
|
||||||
|
+++ b/embed.fnc
|
||||||
|
@@ -541,7 +541,8 @@ Apd |void |av_push |NN AV *av|NN SV *val
|
||||||
|
EXp |void |av_reify |NN AV *av
|
||||||
|
ApdR |SV* |av_shift |NN AV *av
|
||||||
|
Apd |SV** |av_store |NN AV *av|SSize_t key|NULLOK SV *val
|
||||||
|
-AidRp |SSize_t|av_top_index |NN AV *av
|
||||||
|
+AMdRp |SSize_t|av_top_index |NN AV *av
|
||||||
|
+AidRp |Size_t |av_count |NN AV *av
|
||||||
|
AmdR |SSize_t|av_tindex |NN AV *av
|
||||||
|
Apd |void |av_undef |NN AV *av
|
||||||
|
Apdoex |SV** |av_create_and_unshift_one|NN AV **const avp|NN SV *const val
|
||||||
|
diff --git a/embed.h b/embed.h
|
||||||
|
index 182b12a..329ac40 100644
|
||||||
|
--- a/embed.h
|
||||||
|
+++ b/embed.h
|
||||||
|
@@ -48,6 +48,7 @@
|
||||||
|
#define atfork_lock Perl_atfork_lock
|
||||||
|
#define atfork_unlock Perl_atfork_unlock
|
||||||
|
#define av_clear(a) Perl_av_clear(aTHX_ a)
|
||||||
|
+#define av_count(a) Perl_av_count(aTHX_ a)
|
||||||
|
#define av_delete(a,b,c) Perl_av_delete(aTHX_ a,b,c)
|
||||||
|
#define av_exists(a,b) Perl_av_exists(aTHX_ a,b)
|
||||||
|
#define av_extend(a,b) Perl_av_extend(aTHX_ a,b)
|
||||||
|
@@ -59,7 +60,6 @@
|
||||||
|
#define av_push(a,b) Perl_av_push(aTHX_ a,b)
|
||||||
|
#define av_shift(a) Perl_av_shift(aTHX_ a)
|
||||||
|
#define av_store(a,b,c) Perl_av_store(aTHX_ a,b,c)
|
||||||
|
-#define av_top_index(a) Perl_av_top_index(aTHX_ a)
|
||||||
|
#define av_undef(a) Perl_av_undef(aTHX_ a)
|
||||||
|
#define av_unshift(a,b) Perl_av_unshift(aTHX_ a,b)
|
||||||
|
#define block_end(a,b) Perl_block_end(aTHX_ a,b)
|
||||||
|
diff --git a/inline.h b/inline.h
|
||||||
|
index 27005d2..35af18a 100644
|
||||||
|
--- a/inline.h
|
||||||
|
+++ b/inline.h
|
||||||
|
@@ -39,13 +39,21 @@ SOFTWARE.
|
||||||
|
|
||||||
|
/* ------------------------------- av.h ------------------------------- */
|
||||||
|
|
||||||
|
-PERL_STATIC_INLINE SSize_t
|
||||||
|
-Perl_av_top_index(pTHX_ AV *av)
|
||||||
|
+/*
|
||||||
|
+=for apidoc av_count
|
||||||
|
+Returns the number of elements in the array C<av>. This is the true length of
|
||||||
|
+the array, including any undefined elements. It is always the same as
|
||||||
|
+S<C<av_top_index(av) + 1>>.
|
||||||
|
+
|
||||||
|
+=cut
|
||||||
|
+*/
|
||||||
|
+PERL_STATIC_INLINE Size_t
|
||||||
|
+Perl_av_count(pTHX_ AV *av)
|
||||||
|
{
|
||||||
|
- PERL_ARGS_ASSERT_AV_TOP_INDEX;
|
||||||
|
+ PERL_ARGS_ASSERT_AV_COUNT;
|
||||||
|
assert(SvTYPE(av) == SVt_PVAV);
|
||||||
|
|
||||||
|
- return AvFILL(av);
|
||||||
|
+ return AvFILL(av) + 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* ------------------------------- cv.h ------------------------------- */
|
||||||
|
diff --git a/proto.h b/proto.h
|
||||||
|
index 02ef4ed..83ba098 100644
|
||||||
|
--- a/proto.h
|
||||||
|
+++ b/proto.h
|
||||||
|
@@ -219,6 +219,13 @@ PERL_CALLCONV SV** Perl_av_arylen_p(pTHX_ AV *av);
|
||||||
|
PERL_CALLCONV void Perl_av_clear(pTHX_ AV *av);
|
||||||
|
#define PERL_ARGS_ASSERT_AV_CLEAR \
|
||||||
|
assert(av)
|
||||||
|
+#ifndef PERL_NO_INLINE_FUNCTIONS
|
||||||
|
+PERL_STATIC_INLINE Size_t Perl_av_count(pTHX_ AV *av)
|
||||||
|
+ __attribute__warn_unused_result__;
|
||||||
|
+#define PERL_ARGS_ASSERT_AV_COUNT \
|
||||||
|
+ assert(av)
|
||||||
|
+#endif
|
||||||
|
+
|
||||||
|
PERL_CALLCONV void Perl_av_create_and_push(pTHX_ AV **const avp, SV *const val);
|
||||||
|
#define PERL_ARGS_ASSERT_AV_CREATE_AND_PUSH \
|
||||||
|
assert(avp); assert(val)
|
||||||
|
@@ -284,12 +291,10 @@ PERL_CALLCONV SV** Perl_av_store(pTHX_ AV *av, SSize_t key, SV *val);
|
||||||
|
__attribute__warn_unused_result__; */
|
||||||
|
#define PERL_ARGS_ASSERT_AV_TINDEX
|
||||||
|
|
||||||
|
-#ifndef PERL_NO_INLINE_FUNCTIONS
|
||||||
|
-PERL_STATIC_INLINE SSize_t Perl_av_top_index(pTHX_ AV *av)
|
||||||
|
+PERL_CALLCONV SSize_t Perl_av_top_index(pTHX_ AV *av)
|
||||||
|
__attribute__warn_unused_result__;
|
||||||
|
#define PERL_ARGS_ASSERT_AV_TOP_INDEX \
|
||||||
|
assert(av)
|
||||||
|
-#endif
|
||||||
|
|
||||||
|
PERL_CALLCONV void Perl_av_undef(pTHX_ AV *av);
|
||||||
|
#define PERL_ARGS_ASSERT_AV_UNDEF \
|
||||||
|
--
|
||||||
|
2.25.4
|
||||||
|
|
@ -0,0 +1,196 @@
|
|||||||
|
From d7504df2a5d8985f2a8b04f17acff5e324572c39 Mon Sep 17 00:00:00 2001
|
||||||
|
From: Richard Leach <richardleach@users.noreply.github.com>
|
||||||
|
Date: Sun, 11 Oct 2020 12:26:27 +0100
|
||||||
|
Subject: [PATCH] pp_split: no SWITCHSTACK in @ary = split(...) optimisation
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
Petr Písař: 607eaf26a99ff76ab48877e68f1d7b005dc51575 ported to 5.32.0.
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
pp.c | 89 +++++++++++++++++++++++++++++-----------------------
|
||||||
|
t/op/split.t | 23 +++++++++++++-
|
||||||
|
2 files changed, 72 insertions(+), 40 deletions(-)
|
||||||
|
|
||||||
|
diff --git a/pp.c b/pp.c
|
||||||
|
index df80830..e4863d3 100644
|
||||||
|
--- a/pp.c
|
||||||
|
+++ b/pp.c
|
||||||
|
@@ -5985,6 +5985,7 @@ PP(pp_split)
|
||||||
|
|
||||||
|
/* handle @ary = split(...) optimisation */
|
||||||
|
if (PL_op->op_private & OPpSPLIT_ASSIGN) {
|
||||||
|
+ realarray = 1;
|
||||||
|
if (!(PL_op->op_flags & OPf_STACKED)) {
|
||||||
|
if (PL_op->op_private & OPpSPLIT_LEX) {
|
||||||
|
if (PL_op->op_private & OPpLVAL_INTRO)
|
||||||
|
@@ -6007,26 +6008,10 @@ PP(pp_split)
|
||||||
|
oldsave = PL_savestack_ix;
|
||||||
|
}
|
||||||
|
|
||||||
|
- realarray = 1;
|
||||||
|
- PUTBACK;
|
||||||
|
- av_extend(ary,0);
|
||||||
|
- (void)sv_2mortal(SvREFCNT_inc_simple_NN(sv));
|
||||||
|
- av_clear(ary);
|
||||||
|
- SPAGAIN;
|
||||||
|
if ((mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied))) {
|
||||||
|
PUSHMARK(SP);
|
||||||
|
XPUSHs(SvTIED_obj(MUTABLE_SV(ary), mg));
|
||||||
|
- }
|
||||||
|
- else {
|
||||||
|
- if (!AvREAL(ary)) {
|
||||||
|
- I32 i;
|
||||||
|
- AvREAL_on(ary);
|
||||||
|
- AvREIFY_off(ary);
|
||||||
|
- for (i = AvFILLp(ary); i >= 0; i--)
|
||||||
|
- AvARRAY(ary)[i] = &PL_sv_undef; /* don't free mere refs */
|
||||||
|
- }
|
||||||
|
- /* temporarily switch stacks */
|
||||||
|
- SAVESWITCHSTACK(PL_curstack, ary);
|
||||||
|
+ } else {
|
||||||
|
make_mortal = 0;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
@@ -6358,29 +6343,56 @@ PP(pp_split)
|
||||||
|
LEAVE_SCOPE(oldsave); /* may undo an earlier SWITCHSTACK */
|
||||||
|
SPAGAIN;
|
||||||
|
if (realarray) {
|
||||||
|
- if (!mg) {
|
||||||
|
- if (SvSMAGICAL(ary)) {
|
||||||
|
- PUTBACK;
|
||||||
|
+ if (!mg) {
|
||||||
|
+ PUTBACK;
|
||||||
|
+ if(AvREAL(ary)) {
|
||||||
|
+ if (av_count(ary) > 0)
|
||||||
|
+ av_clear(ary);
|
||||||
|
+ } else {
|
||||||
|
+ AvREAL_on(ary);
|
||||||
|
+ AvREIFY_off(ary);
|
||||||
|
+
|
||||||
|
+ if (AvMAX(ary) > -1) {
|
||||||
|
+ /* don't free mere refs */
|
||||||
|
+ Zero(AvARRAY(ary), AvMAX(ary), SV*);
|
||||||
|
+ }
|
||||||
|
+ }
|
||||||
|
+ if(AvMAX(ary) < iters)
|
||||||
|
+ av_extend(ary,iters);
|
||||||
|
+ SPAGAIN;
|
||||||
|
+
|
||||||
|
+ /* Need to copy the SV*s from the stack into ary */
|
||||||
|
+ Copy(SP + 1 - iters, AvARRAY(ary), iters, SV*);
|
||||||
|
+ AvFILLp(ary) = iters - 1;
|
||||||
|
+
|
||||||
|
+ if (SvSMAGICAL(ary)) {
|
||||||
|
+ PUTBACK;
|
||||||
|
mg_set(MUTABLE_SV(ary));
|
||||||
|
SPAGAIN;
|
||||||
|
- }
|
||||||
|
- if (gimme == G_ARRAY) {
|
||||||
|
- EXTEND(SP, iters);
|
||||||
|
- Copy(AvARRAY(ary), SP + 1, iters, SV*);
|
||||||
|
- SP += iters;
|
||||||
|
- RETURN;
|
||||||
|
- }
|
||||||
|
+ }
|
||||||
|
+
|
||||||
|
+ if (gimme != G_ARRAY) {
|
||||||
|
+ /* SP points to the final SV* pushed to the stack. But the SV* */
|
||||||
|
+ /* are not going to be used from the stack. Point SP to below */
|
||||||
|
+ /* the first of these SV*. */
|
||||||
|
+ SP -= iters;
|
||||||
|
+ PUTBACK;
|
||||||
|
+ }
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
- PUTBACK;
|
||||||
|
- ENTER_with_name("call_PUSH");
|
||||||
|
- call_sv(SV_CONST(PUSH),G_SCALAR|G_DISCARD|G_METHOD_NAMED);
|
||||||
|
- LEAVE_with_name("call_PUSH");
|
||||||
|
- SPAGAIN;
|
||||||
|
+ PUTBACK;
|
||||||
|
+ av_extend(ary,iters);
|
||||||
|
+ av_clear(ary);
|
||||||
|
+
|
||||||
|
+ ENTER_with_name("call_PUSH");
|
||||||
|
+ call_sv(SV_CONST(PUSH),G_SCALAR|G_DISCARD|G_METHOD_NAMED);
|
||||||
|
+ LEAVE_with_name("call_PUSH");
|
||||||
|
+ SPAGAIN;
|
||||||
|
+
|
||||||
|
if (gimme == G_ARRAY) {
|
||||||
|
SSize_t i;
|
||||||
|
/* EXTEND should not be needed - we just popped them */
|
||||||
|
- EXTEND(SP, iters);
|
||||||
|
+ EXTEND_SKIP(SP, iters);
|
||||||
|
for (i=0; i < iters; i++) {
|
||||||
|
SV **svp = av_fetch(ary, i, FALSE);
|
||||||
|
PUSHs((svp) ? *svp : &PL_sv_undef);
|
||||||
|
@@ -6389,13 +6401,12 @@ PP(pp_split)
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
- else {
|
||||||
|
- if (gimme == G_ARRAY)
|
||||||
|
- RETURN;
|
||||||
|
- }
|
||||||
|
|
||||||
|
- GETTARGET;
|
||||||
|
- XPUSHi(iters);
|
||||||
|
+ if (gimme != G_ARRAY) {
|
||||||
|
+ GETTARGET;
|
||||||
|
+ XPUSHi(iters);
|
||||||
|
+ }
|
||||||
|
+
|
||||||
|
RETURN;
|
||||||
|
}
|
||||||
|
|
||||||
|
diff --git a/t/op/split.t b/t/op/split.t
|
||||||
|
index 14f9158..7f37512 100644
|
||||||
|
--- a/t/op/split.t
|
||||||
|
+++ b/t/op/split.t
|
||||||
|
@@ -7,7 +7,7 @@ BEGIN {
|
||||||
|
set_up_inc('../lib');
|
||||||
|
}
|
||||||
|
|
||||||
|
-plan tests => 176;
|
||||||
|
+plan tests => 182;
|
||||||
|
|
||||||
|
$FS = ':';
|
||||||
|
|
||||||
|
@@ -648,6 +648,19 @@ is "@a", '1 2 3', 'assignment to split-to-array (stacked)';
|
||||||
|
is (+@a, 0, "empty utf8 string");
|
||||||
|
}
|
||||||
|
|
||||||
|
+# correct stack adjustments (gh#18232)
|
||||||
|
+{
|
||||||
|
+ sub foo { return @_ }
|
||||||
|
+ my @a = foo(1, scalar split " ", "a b");
|
||||||
|
+ is(join('', @a), "12", "Scalar split to a sub parameter");
|
||||||
|
+}
|
||||||
|
+
|
||||||
|
+{
|
||||||
|
+ sub foo { return @_ }
|
||||||
|
+ my @a = foo(1, scalar(@x = split " ", "a b"));
|
||||||
|
+ is(join('', @a), "12", "Split to @x then use scalar result as a sub parameter");
|
||||||
|
+}
|
||||||
|
+
|
||||||
|
fresh_perl_is(<<'CODE', '', {}, "scalar split stack overflow");
|
||||||
|
map{int"";split//.0>60for"0000000000000000"}split// for"00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
|
||||||
|
CODE
|
||||||
|
@@ -667,3 +680,11 @@ CODE
|
||||||
|
ok(eq_array(\@result,['a','b']), "Resulting in ('a','b')");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
+
|
||||||
|
+# check that the (@ary = split) optimisation survives @ary being modified
|
||||||
|
+
|
||||||
|
+fresh_perl_is('my @ary; @ary = split(/\w(?{ @ary[1000] = 1 })/, "abc");',
|
||||||
|
+ '',{},'(@ary = split ...) survives @ary being Renew()ed');
|
||||||
|
+fresh_perl_is('my @ary; @ary = split(/\w(?{ undef @ary })/, "abc");',
|
||||||
|
+ '',{},'(@ary = split ...) survives an (undef @ary)');
|
||||||
|
+
|
||||||
|
--
|
||||||
|
2.25.4
|
||||||
|
|
@ -0,0 +1,34 @@
|
|||||||
|
From ab72b7bd043df0f0ad6090a4c95f378624fad9fc Mon Sep 17 00:00:00 2001
|
||||||
|
From: Karl Williamson <khw@cpan.org>
|
||||||
|
Date: Sat, 7 Mar 2020 12:54:19 -0700
|
||||||
|
Subject: [PATCH] DynaLoader: use PerlEnv_getenv()
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
Doing so invokes thread-safe guards
|
||||||
|
|
||||||
|
Petr Písař: Ported from b0312014d6c1804920d2b687a5fa5645b445ce9f to
|
||||||
|
5.32.1.
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
ext/DynaLoader/dlutils.c | 2 +-
|
||||||
|
1 file changed, 1 insertion(+), 1 deletion(-)
|
||||||
|
|
||||||
|
diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c
|
||||||
|
index 8584f89..1a27fbd 100644
|
||||||
|
--- a/ext/DynaLoader/dlutils.c
|
||||||
|
+++ b/ext/DynaLoader/dlutils.c
|
||||||
|
@@ -115,7 +115,7 @@ dl_generic_private_init(pTHX) /* called by dl_*.xs dl_private_init() */
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#if defined(PERL_IN_DL_HPUX_XS) || defined(PERL_IN_DL_DLOPEN_XS)
|
||||||
|
- if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL
|
||||||
|
+ if ( (perl_dl_nonlazy = PerlEnv_getenv("PERL_DL_NONLAZY")) != NULL
|
||||||
|
&& grok_atoUV(perl_dl_nonlazy, &uv, NULL)
|
||||||
|
&& uv <= INT_MAX
|
||||||
|
) {
|
||||||
|
--
|
||||||
|
2.26.2
|
||||||
|
|
@ -0,0 +1,44 @@
|
|||||||
|
From 2ce7bf1ad5fd7aee21975b3dd1c8dceef3aab7e4 Mon Sep 17 00:00:00 2001
|
||||||
|
From: David Mitchell <davem@iabyn.com>
|
||||||
|
Date: Tue, 9 Mar 2021 16:42:11 +0000
|
||||||
|
Subject: [PATCH] Perl_do_sv_dump(): handle PL_strtab
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
When dumping this special hash, the values in the HE entry are refcounts
|
||||||
|
rather than SV pointers. sv_dump() used to crash here.
|
||||||
|
|
||||||
|
Petr Písař: Ported to 5.32.1 from upstream
|
||||||
|
a9bb6a62ae45bb372a5cca98a76d1a79edd89ccb.
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
dump.c | 11 +++++++++--
|
||||||
|
1 file changed, 9 insertions(+), 2 deletions(-)
|
||||||
|
|
||||||
|
diff --git a/dump.c b/dump.c
|
||||||
|
index f03c3f6..0f15d77 100644
|
||||||
|
--- a/dump.c
|
||||||
|
+++ b/dump.c
|
||||||
|
@@ -2224,8 +2224,15 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
|
||||||
|
PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 6 * SvCUR(keysv), UNI_DISPLAY_QQ));
|
||||||
|
if (HvEITER_get(hv) == he)
|
||||||
|
PerlIO_printf(file, "[CURRENT] ");
|
||||||
|
- PerlIO_printf(file, "HASH = 0x%" UVxf "\n", (UV) hash);
|
||||||
|
- do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
|
||||||
|
+ PerlIO_printf(file, "HASH = 0x%" UVxf, (UV) hash);
|
||||||
|
+
|
||||||
|
+ if (sv == (SV*)PL_strtab)
|
||||||
|
+ PerlIO_printf(file, " REFCNT = 0x%" UVxf "\n",
|
||||||
|
+ (UV)he->he_valu.hent_refcount );
|
||||||
|
+ else {
|
||||||
|
+ (void)PerlIO_putc(file, '\n');
|
||||||
|
+ do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
|
||||||
|
+ }
|
||||||
|
}
|
||||||
|
}
|
||||||
|
DONEHV:;
|
||||||
|
--
|
||||||
|
2.26.3
|
||||||
|
|
@ -0,0 +1,53 @@
|
|||||||
|
From c5eed6e541fe27d9e9dfd31f42c43f4dfa1f486b Mon Sep 17 00:00:00 2001
|
||||||
|
From: Yves Orton <demerphq@gmail.com>
|
||||||
|
Date: Sat, 11 Jul 2020 09:26:21 +0200
|
||||||
|
Subject: [PATCH] hv.c: add a guard clause to prevent the number of buckets in
|
||||||
|
a hash from getting too large
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
This caps it at 1<<28 buckets, eg, ~268M. In theory without a guard clause like
|
||||||
|
this we could grow to the point of possibly wrapping around in terms of size,
|
||||||
|
not to mention being ridiculously wasteful of memory at larger sizes.
|
||||||
|
Even this cap is probably too high. It should probably be something like 1<<24.
|
||||||
|
|
||||||
|
Petr Písař: Ported to 5.32.1 from
|
||||||
|
aae087f7cec022be14a17deb95cb2208e16b7891.
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
hv.c | 10 +++++++++-
|
||||||
|
1 file changed, 9 insertions(+), 1 deletion(-)
|
||||||
|
|
||||||
|
diff --git a/hv.c b/hv.c
|
||||||
|
index eccae62..32dbd19 100644
|
||||||
|
--- a/hv.c
|
||||||
|
+++ b/hv.c
|
||||||
|
@@ -38,7 +38,13 @@ holds the key and hash value.
|
||||||
|
* NOTE if you change this formula so we split earlier than previously
|
||||||
|
* you MUST change the logic in hv_ksplit()
|
||||||
|
*/
|
||||||
|
-#define DO_HSPLIT(xhv) ( ((xhv)->xhv_keys + ((xhv)->xhv_keys >> 1)) > (xhv)->xhv_max )
|
||||||
|
+
|
||||||
|
+/* MAX_BUCKET_MAX is the maximum max bucket index, at which point we stop growing the
|
||||||
|
+ * number of buckets,
|
||||||
|
+ */
|
||||||
|
+#define MAX_BUCKET_MAX ((1<<26)-1)
|
||||||
|
+#define DO_HSPLIT(xhv) ( ( ((xhv)->xhv_keys + ((xhv)->xhv_keys >> 1)) > (xhv)->xhv_max ) && \
|
||||||
|
+ ((xhv)->xhv_max < MAX_BUCKET_MAX) )
|
||||||
|
#define HV_FILL_THRESHOLD 31
|
||||||
|
|
||||||
|
static const char S_strtab_error[]
|
||||||
|
@@ -1426,6 +1432,8 @@ S_hsplit(pTHX_ HV *hv, STRLEN const oldsize, STRLEN newsize)
|
||||||
|
);
|
||||||
|
|
||||||
|
PERL_ARGS_ASSERT_HSPLIT;
|
||||||
|
+ if (newsize > MAX_BUCKET_MAX+1)
|
||||||
|
+ return;
|
||||||
|
|
||||||
|
PL_nomemok = TRUE;
|
||||||
|
Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
|
||||||
|
--
|
||||||
|
2.26.2
|
||||||
|
|
@ -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
|
||||||
|
|
@ -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
|
||||||
|
|
@ -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
|
||||||
|
|
@ -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
|
||||||
|
|
@ -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
|
||||||
|
|
@ -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
|
||||||
|
|
@ -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
|
||||||
|
|
@ -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
|
||||||
|
|
@ -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
|
||||||
|
|
@ -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
|
||||||
|
|
@ -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
|
||||||
|
|
@ -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
|
||||||
|
|
@ -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
|
||||||
|
|
@ -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
|
||||||
|
|
@ -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
|
||||||
|
|
@ -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
|
||||||
|
|
@ -0,0 +1,77 @@
|
|||||||
|
From bd5fa06648085e8c17efd55abeb6424aeeb1018e Mon Sep 17 00:00:00 2001
|
||||||
|
From: Karl Williamson <khw@cpan.org>
|
||||||
|
Date: Tue, 29 Sep 2020 00:48:19 -0600
|
||||||
|
Subject: [PATCH] Remove Perl_av_top_index
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
I created this in 87306e0674dfe3af29804b4641347cd5ac9b0521, thinking it
|
||||||
|
was needed to preserve backward compatibility if someone were using this
|
||||||
|
instead of the macro. But it turned out that there never was such a
|
||||||
|
function, it was inlined, and the name was S_av_top_index, so there is
|
||||||
|
no reason to create a new function that no one has ever been able to
|
||||||
|
call. So just remove it, and let all accesses go through the macro
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
av.c | 10 ----------
|
||||||
|
embed.fnc | 2 +-
|
||||||
|
proto.h | 7 +++----
|
||||||
|
3 files changed, 4 insertions(+), 15 deletions(-)
|
||||||
|
|
||||||
|
diff --git a/av.c b/av.c
|
||||||
|
index ada09cde9a..ad2429f90d 100644
|
||||||
|
--- a/av.c
|
||||||
|
+++ b/av.c
|
||||||
|
@@ -1095,16 +1095,6 @@ Perl_av_nonelem(pTHX_ AV *av, SSize_t ix) {
|
||||||
|
return sv;
|
||||||
|
}
|
||||||
|
|
||||||
|
-SSize_t
|
||||||
|
-Perl_av_top_index(pTHX_ AV *av)
|
||||||
|
-{
|
||||||
|
- PERL_ARGS_ASSERT_AV_TOP_INDEX;
|
||||||
|
- assert(SvTYPE(av) == SVt_PVAV);
|
||||||
|
-
|
||||||
|
- return AvFILL(av);
|
||||||
|
-}
|
||||||
|
-
|
||||||
|
-
|
||||||
|
/*
|
||||||
|
* ex: set ts=8 sts=4 sw=4 et:
|
||||||
|
*/
|
||||||
|
diff --git a/embed.fnc b/embed.fnc
|
||||||
|
index a6b4d0350f..f5c5b29c2d 100644
|
||||||
|
--- a/embed.fnc
|
||||||
|
+++ b/embed.fnc
|
||||||
|
@@ -637,7 +637,7 @@ Apd |void |av_push |NN AV *av|NN SV *val
|
||||||
|
EXp |void |av_reify |NN AV *av
|
||||||
|
ApdR |SV* |av_shift |NN AV *av
|
||||||
|
Apd |SV** |av_store |NN AV *av|SSize_t key|NULLOK SV *val
|
||||||
|
-AMdRp |SSize_t|av_top_index |NN AV *av
|
||||||
|
+AmdR |SSize_t|av_top_index |NN AV *av
|
||||||
|
AidRp |Size_t |av_count |NN AV *av
|
||||||
|
AmdR |SSize_t|av_tindex |NN AV *av
|
||||||
|
Apd |void |av_undef |NN AV *av
|
||||||
|
diff --git a/proto.h b/proto.h
|
||||||
|
index c4490fc46e..2da1a07761 100644
|
||||||
|
--- a/proto.h
|
||||||
|
+++ b/proto.h
|
||||||
|
@@ -291,10 +291,9 @@ PERL_CALLCONV SV** Perl_av_store(pTHX_ AV *av, SSize_t key, SV *val);
|
||||||
|
__attribute__warn_unused_result__; */
|
||||||
|
#define PERL_ARGS_ASSERT_AV_TINDEX
|
||||||
|
|
||||||
|
-PERL_CALLCONV SSize_t Perl_av_top_index(pTHX_ AV *av)
|
||||||
|
- __attribute__warn_unused_result__;
|
||||||
|
-#define PERL_ARGS_ASSERT_AV_TOP_INDEX \
|
||||||
|
- assert(av)
|
||||||
|
+/* PERL_CALLCONV SSize_t av_top_index(pTHX_ AV *av)
|
||||||
|
+ __attribute__warn_unused_result__; */
|
||||||
|
+#define PERL_ARGS_ASSERT_AV_TOP_INDEX
|
||||||
|
|
||||||
|
PERL_CALLCONV void Perl_av_undef(pTHX_ AV *av);
|
||||||
|
#define PERL_ARGS_ASSERT_AV_UNDEF \
|
||||||
|
--
|
||||||
|
2.25.4
|
||||||
|
|
@ -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
|
||||||
|
|
@ -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
|
||||||
|
|
@ -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
|
||||||
|
|
@ -0,0 +1,76 @@
|
|||||||
|
From e050064b67c501e9fdc7bc3f513ba2b8b9e795f8 Mon Sep 17 00:00:00 2001
|
||||||
|
From: David Mitchell <davem@iabyn.com>
|
||||||
|
Date: Fri, 30 Oct 2020 20:50:58 +0000
|
||||||
|
Subject: [PATCH] Perl_custom_op_get_field(): remove undef behaviour
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
Thus function has a couple a switches with
|
||||||
|
|
||||||
|
default:
|
||||||
|
NOT_REACHED; /* NOTREACHED */
|
||||||
|
|
||||||
|
but clang is complaining that the value returned by the function is
|
||||||
|
undefined if those default branches are taken, since the 'any' variable
|
||||||
|
doesn't get set in that path.
|
||||||
|
|
||||||
|
Replace the NOTREACHED with a croak("panic: ..."). It's possible (albeit
|
||||||
|
not intended) for Perl_custom_op_get_field() to be called with a 'field'
|
||||||
|
arg which triggers the default case. So if this ever happens, make it
|
||||||
|
clear that something has gone wrong, rather than just silently
|
||||||
|
continuing on non-debugging builds.
|
||||||
|
|
||||||
|
In any case, this shuts up clang.
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
op.c | 14 ++++++--------
|
||||||
|
1 file changed, 6 insertions(+), 8 deletions(-)
|
||||||
|
|
||||||
|
diff --git a/op.c b/op.c
|
||||||
|
index c30c6b7c8f..2933e2ed7d 100644
|
||||||
|
--- a/op.c
|
||||||
|
+++ b/op.c
|
||||||
|
@@ -18100,6 +18100,7 @@ Perl_custom_op_get_field(pTHX_ const OP *o, const xop_flags_enum field)
|
||||||
|
else
|
||||||
|
xop = INT2PTR(XOP *, SvIV(HeVAL(he)));
|
||||||
|
}
|
||||||
|
+
|
||||||
|
{
|
||||||
|
XOPRETANY any;
|
||||||
|
if(field == XOPe_xop_ptr) {
|
||||||
|
@@ -18121,7 +18122,10 @@ Perl_custom_op_get_field(pTHX_ const OP *o, const xop_flags_enum field)
|
||||||
|
any.xop_peep = xop->xop_peep;
|
||||||
|
break;
|
||||||
|
default:
|
||||||
|
- NOT_REACHED; /* NOTREACHED */
|
||||||
|
+ field_panic:
|
||||||
|
+ Perl_croak(aTHX_
|
||||||
|
+ "panic: custom_op_get_field(): invalid field %d\n",
|
||||||
|
+ (int)field);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
@@ -18139,17 +18143,11 @@ Perl_custom_op_get_field(pTHX_ const OP *o, const xop_flags_enum field)
|
||||||
|
any.xop_peep = XOPd_xop_peep;
|
||||||
|
break;
|
||||||
|
default:
|
||||||
|
- NOT_REACHED; /* NOTREACHED */
|
||||||
|
+ goto field_panic;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
- /* On some platforms (HP-UX, IA64) gcc emits a warning for this function:
|
||||||
|
- * op.c: In function 'Perl_custom_op_get_field':
|
||||||
|
- * op.c:...: warning: 'any.xop_name' may be used uninitialized in this function [-Wmaybe-uninitialized]
|
||||||
|
- * This is because on those platforms (with -DEBUGGING) NOT_REACHED
|
||||||
|
- * expands to assert(0), which expands to ((0) ? (void)0 :
|
||||||
|
- * __assert(...)), and gcc doesn't know that __assert can never return. */
|
||||||
|
return any;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
--
|
||||||
|
2.25.4
|
||||||
|
|
@ -0,0 +1,57 @@
|
|||||||
|
From f877e124a20d4f94c82c36e6b7a99b4e9663e204 Mon Sep 17 00:00:00 2001
|
||||||
|
From: Tony Cook <tony@develop-help.com>
|
||||||
|
Date: Tue, 10 Nov 2020 15:50:27 +1100
|
||||||
|
Subject: [PATCH] fetch magic on the first stacked filetest, not the last
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
fixes #18293
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
pp_sys.c | 2 +-
|
||||||
|
t/op/filetest.t | 10 +++++++++-
|
||||||
|
2 files changed, 10 insertions(+), 2 deletions(-)
|
||||||
|
|
||||||
|
diff --git a/pp_sys.c b/pp_sys.c
|
||||||
|
index 66c5d9aade..5c9f768eaf 100644
|
||||||
|
--- a/pp_sys.c
|
||||||
|
+++ b/pp_sys.c
|
||||||
|
@@ -3067,7 +3067,7 @@ S_try_amagic_ftest(pTHX_ char chr) {
|
||||||
|
SV *const arg = *PL_stack_sp;
|
||||||
|
|
||||||
|
assert(chr != '?');
|
||||||
|
- if (!(PL_op->op_private & OPpFT_STACKING)) SvGETMAGIC(arg);
|
||||||
|
+ if (!(PL_op->op_private & OPpFT_STACKED)) SvGETMAGIC(arg);
|
||||||
|
|
||||||
|
if (SvAMAGIC(arg))
|
||||||
|
{
|
||||||
|
diff --git a/t/op/filetest.t b/t/op/filetest.t
|
||||||
|
index fe9724c59a..7c471c050c 100644
|
||||||
|
--- a/t/op/filetest.t
|
||||||
|
+++ b/t/op/filetest.t
|
||||||
|
@@ -9,7 +9,7 @@ BEGIN {
|
||||||
|
set_up_inc(qw '../lib ../cpan/Perl-OSType/lib');
|
||||||
|
}
|
||||||
|
|
||||||
|
-plan(tests => 57 + 27*14);
|
||||||
|
+plan(tests => 58 + 27*14);
|
||||||
|
|
||||||
|
if ($^O =~ /MSWin32|cygwin|msys/ && !is_miniperl) {
|
||||||
|
require Win32; # for IsAdminUser()
|
||||||
|
@@ -385,3 +385,11 @@ SKIP: {
|
||||||
|
ok(!-f "TEST\0-", '-f on name with \0');
|
||||||
|
ok(!-r "TEST\0-", '-r on name with \0');
|
||||||
|
}
|
||||||
|
+
|
||||||
|
+{
|
||||||
|
+ # github #18293
|
||||||
|
+ "" =~ /(.*)/;
|
||||||
|
+ my $x = $1; # call magic on $1, setting the pv to ""
|
||||||
|
+ "test.pl" =~ /(.*)/;
|
||||||
|
+ ok(-f -r $1, "stacked handles on a name with magic");
|
||||||
|
+}
|
||||||
|
--
|
||||||
|
2.25.4
|
||||||
|
|
@ -0,0 +1,54 @@
|
|||||||
|
From ab307de390c3459badcc89b3d77542b5b871b2e8 Mon Sep 17 00:00:00 2001
|
||||||
|
From: Richard Leach <richardleach@users.noreply.github.com>
|
||||||
|
Date: Tue, 20 Oct 2020 18:16:38 +0100
|
||||||
|
Subject: [PATCH 2/2] pp_split: add TonyC's stack-not-refcounted-suggestion and
|
||||||
|
tests
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
pp.c | 5 ++++-
|
||||||
|
t/op/split.t | 5 +++++
|
||||||
|
2 files changed, 9 insertions(+), 1 deletion(-)
|
||||||
|
|
||||||
|
diff --git a/pp.c b/pp.c
|
||||||
|
index ce16c56e63..5b5e163011 100644
|
||||||
|
--- a/pp.c
|
||||||
|
+++ b/pp.c
|
||||||
|
@@ -6034,6 +6034,9 @@ PP(pp_split)
|
||||||
|
oldsave = PL_savestack_ix;
|
||||||
|
}
|
||||||
|
|
||||||
|
+ /* Some defence against stack-not-refcounted bugs */
|
||||||
|
+ (void)sv_2mortal(SvREFCNT_inc_simple_NN(ary));
|
||||||
|
+
|
||||||
|
if ((mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied))) {
|
||||||
|
PUSHMARK(SP);
|
||||||
|
XPUSHs(SvTIED_obj(MUTABLE_SV(ary), mg));
|
||||||
|
@@ -6356,7 +6359,7 @@ PP(pp_split)
|
||||||
|
}
|
||||||
|
|
||||||
|
PUTBACK;
|
||||||
|
- LEAVE_SCOPE(oldsave); /* may undo an earlier SWITCHSTACK */
|
||||||
|
+ LEAVE_SCOPE(oldsave);
|
||||||
|
SPAGAIN;
|
||||||
|
if (realarray) {
|
||||||
|
if (!mg) {
|
||||||
|
diff --git a/t/op/split.t b/t/op/split.t
|
||||||
|
index 1d78a45bde..7a321645ac 100644
|
||||||
|
--- a/t/op/split.t
|
||||||
|
+++ b/t/op/split.t
|
||||||
|
@@ -703,3 +703,8 @@ fresh_perl_is('my @ary; @ary = split(/\w(?{ @ary[1000] = 1 })/, "abc");',
|
||||||
|
fresh_perl_is('my @ary; @ary = split(/\w(?{ undef @ary })/, "abc");',
|
||||||
|
'',{},'(@ary = split ...) survives an (undef @ary)');
|
||||||
|
|
||||||
|
+# check the (@ary = split) optimisation survives stack-not-refcounted bugs
|
||||||
|
+fresh_perl_is('our @ary; @ary = split(/\w(?{ *ary = 0 })/, "abc");',
|
||||||
|
+ '',{},'(@ary = split ...) survives @ary destruction via typeglob');
|
||||||
|
+fresh_perl_is('my $ary = []; @$ary = split(/\w(?{ $ary = [] })/, "abc");',
|
||||||
|
+ '',{},'(@ary = split ...) survives @ary destruction via reassignment');
|
||||||
|
--
|
||||||
|
2.25.4
|
||||||
|
|
@ -0,0 +1,71 @@
|
|||||||
|
From b52b6c4029b51818442d64c6104d26e12e140f09 Mon Sep 17 00:00:00 2001
|
||||||
|
From: TAKAI Kousuke <62541129+t-a-k@users.noreply.github.com>
|
||||||
|
Date: Thu, 5 Nov 2020 22:06:16 +0900
|
||||||
|
Subject: [PATCH] t/op/inc.t, t/op/hexfp.t, t/op/sprintf2.t: Add missing d_
|
||||||
|
prefixes for Config variable names.
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
t/op/hexfp.t | 2 +-
|
||||||
|
t/op/inc.t | 4 ++--
|
||||||
|
t/op/sprintf2.t | 4 ++--
|
||||||
|
3 files changed, 5 insertions(+), 5 deletions(-)
|
||||||
|
|
||||||
|
diff --git a/t/op/hexfp.t b/t/op/hexfp.t
|
||||||
|
index b0c85cfdc6..5fb80d3d74 100644
|
||||||
|
--- a/t/op/hexfp.t
|
||||||
|
+++ b/t/op/hexfp.t
|
||||||
|
@@ -246,7 +246,7 @@ SKIP: {
|
||||||
|
skip("non-80-bit-long-double", 4)
|
||||||
|
unless ($Config{uselongdouble} &&
|
||||||
|
($Config{nvsize} == 16 || $Config{nvsize} == 12) &&
|
||||||
|
- ($Config{long_double_style_ieee_extended}));
|
||||||
|
+ ($Config{d_long_double_style_ieee_extended}));
|
||||||
|
is(0x1p-1074, 4.94065645841246544e-324);
|
||||||
|
is(0x1p-1075, 2.47032822920623272e-324, '[perl #128919]');
|
||||||
|
is(0x1p-1076, 1.23516411460311636e-324);
|
||||||
|
diff --git a/t/op/inc.t b/t/op/inc.t
|
||||||
|
index 0bb8b85b13..3d5cc024d3 100644
|
||||||
|
--- a/t/op/inc.t
|
||||||
|
+++ b/t/op/inc.t
|
||||||
|
@@ -188,10 +188,10 @@ cmp_ok($a, '==', 2147483647, "postdecrement properly downgrades from double");
|
||||||
|
|
||||||
|
SKIP: {
|
||||||
|
if ($Config{uselongdouble} &&
|
||||||
|
- ($Config{long_double_style_ieee_doubledouble})) {
|
||||||
|
+ ($Config{d_long_double_style_ieee_doubledouble})) {
|
||||||
|
skip "the double-double format is weird", 1;
|
||||||
|
}
|
||||||
|
- unless ($Config{double_style_ieee}) {
|
||||||
|
+ unless ($Config{d_double_style_ieee}) {
|
||||||
|
skip "the doublekind $Config{doublekind} is not IEEE", 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t
|
||||||
|
index bbc12ccd0a..38a550c281 100644
|
||||||
|
--- a/t/op/sprintf2.t
|
||||||
|
+++ b/t/op/sprintf2.t
|
||||||
|
@@ -701,7 +701,7 @@ SKIP: {
|
||||||
|
skip("uselongdouble=" . ($Config{uselongdouble} ? 'define' : 'undef')
|
||||||
|
. " longdblkind=$Config{longdblkind} os=$^O", 6)
|
||||||
|
unless ($Config{uselongdouble} &&
|
||||||
|
- ($Config{long_double_style_ieee_doubledouble})
|
||||||
|
+ ($Config{d_long_double_style_ieee_doubledouble})
|
||||||
|
# Gating on 'linux' (ppc) here is due to the differing
|
||||||
|
# double-double implementations: other (also big-endian)
|
||||||
|
# double-double platforms (e.g. AIX on ppc or IRIX on mips)
|
||||||
|
@@ -892,7 +892,7 @@ SKIP: {
|
||||||
|
skip("non-80-bit-long-double", 17)
|
||||||
|
unless ($Config{uselongdouble} &&
|
||||||
|
($Config{nvsize} == 16 || $Config{nvsize} == 12) &&
|
||||||
|
- ($Config{long_double_style_ieee_extended}));
|
||||||
|
+ ($Config{d_long_double_style_ieee_extended}));
|
||||||
|
|
||||||
|
{
|
||||||
|
# The last normal for this format.
|
||||||
|
--
|
||||||
|
2.25.4
|
||||||
|
|
@ -0,0 +1,32 @@
|
|||||||
|
From 9289d4dc7a3d24b20c6e25045e687321ee3e8faf Mon Sep 17 00:00:00 2001
|
||||||
|
From: Karl Williamson <khw@cpan.org>
|
||||||
|
Date: Mon, 30 Nov 2020 09:25:52 -0700
|
||||||
|
Subject: [PATCH] locale.c: Fix typo in #ifdef
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
This misspelling led to the code assuming that the platform didn't have
|
||||||
|
a feature that, if used, would result in faster execution.
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
locale.c | 2 +-
|
||||||
|
1 file changed, 1 insertion(+), 1 deletion(-)
|
||||||
|
|
||||||
|
diff --git a/locale.c b/locale.c
|
||||||
|
index 9500ab7960..5970423404 100644
|
||||||
|
--- a/locale.c
|
||||||
|
+++ b/locale.c
|
||||||
|
@@ -2621,7 +2621,7 @@ S_my_nl_langinfo(const int item, bool toggle)
|
||||||
|
#if defined(HAS_NL_LANGINFO) /* nl_langinfo() is available. */
|
||||||
|
# if ! defined(HAS_THREAD_SAFE_NL_LANGINFO_L) \
|
||||||
|
|| ! defined(HAS_POSIX_2008_LOCALE) \
|
||||||
|
- || ! defined(DUPLOCALE)
|
||||||
|
+ || ! defined(HAS_DUPLOCALE)
|
||||||
|
|
||||||
|
/* Here, use plain nl_langinfo(), switching to the underlying LC_NUMERIC
|
||||||
|
* for those items dependent on it. This must be copied to a buffer before
|
||||||
|
--
|
||||||
|
2.26.2
|
||||||
|
|
@ -0,0 +1,140 @@
|
|||||||
|
From 4cfbe5474a5c5f852a6dbf0138dc796c2800be93 Mon Sep 17 00:00:00 2001
|
||||||
|
From: Karl Williamson <khw@cpan.org>
|
||||||
|
Date: Wed, 30 Dec 2020 05:55:08 -0700
|
||||||
|
Subject: [PATCH] Fix buggy fc() in Turkish locale
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
When Turkish handling was added, fc() wasn't properly updated
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
pp.c | 12 +++++++++---
|
||||||
|
t/op/lc.t | 23 ++++++++++++++++-------
|
||||||
|
2 files changed, 25 insertions(+), 10 deletions(-)
|
||||||
|
|
||||||
|
diff --git a/pp.c b/pp.c
|
||||||
|
index 5e1706346d..23cc6c8adb 100644
|
||||||
|
--- a/pp.c
|
||||||
|
+++ b/pp.c
|
||||||
|
@@ -4813,7 +4813,7 @@ PP(pp_fc)
|
||||||
|
do {
|
||||||
|
extra++;
|
||||||
|
|
||||||
|
- s_peek = (U8 *) memchr(s_peek + 1, 'i',
|
||||||
|
+ s_peek = (U8 *) memchr(s_peek + 1, 'I',
|
||||||
|
send - (s_peek + 1));
|
||||||
|
} while (s_peek != NULL);
|
||||||
|
}
|
||||||
|
@@ -4828,8 +4828,14 @@ PP(pp_fc)
|
||||||
|
+ 1 /* Trailing NUL */ );
|
||||||
|
d = (U8*)SvPVX(dest) + len;
|
||||||
|
|
||||||
|
- *d++ = UTF8_TWO_BYTE_HI(GREEK_SMALL_LETTER_MU);
|
||||||
|
- *d++ = UTF8_TWO_BYTE_LO(GREEK_SMALL_LETTER_MU);
|
||||||
|
+ if (*s == 'I') {
|
||||||
|
+ *d++ = UTF8_TWO_BYTE_HI(LATIN_SMALL_LETTER_DOTLESS_I);
|
||||||
|
+ *d++ = UTF8_TWO_BYTE_LO(LATIN_SMALL_LETTER_DOTLESS_I);
|
||||||
|
+ }
|
||||||
|
+ else {
|
||||||
|
+ *d++ = UTF8_TWO_BYTE_HI(GREEK_SMALL_LETTER_MU);
|
||||||
|
+ *d++ = UTF8_TWO_BYTE_LO(GREEK_SMALL_LETTER_MU);
|
||||||
|
+ }
|
||||||
|
s++;
|
||||||
|
|
||||||
|
for (; s < send; s++) {
|
||||||
|
diff --git a/t/op/lc.t b/t/op/lc.t
|
||||||
|
index fce77f3d34..812c41d6b6 100644
|
||||||
|
--- a/t/op/lc.t
|
||||||
|
+++ b/t/op/lc.t
|
||||||
|
@@ -17,7 +17,7 @@ BEGIN {
|
||||||
|
|
||||||
|
use feature qw( fc );
|
||||||
|
|
||||||
|
-plan tests => 139 + 2 * (4 * 256) + 15;
|
||||||
|
+plan tests => 139 + 2 * (5 * 256) + 17;
|
||||||
|
|
||||||
|
is(lc(undef), "", "lc(undef) is ''");
|
||||||
|
is(lcfirst(undef), "", "lcfirst(undef) is ''");
|
||||||
|
@@ -352,13 +352,14 @@ foreach my $turkic (0 .. 1) {
|
||||||
|
my $locale = ($turkic) ? $turkic_locale : $non_turkic_locale;
|
||||||
|
|
||||||
|
SKIP: {
|
||||||
|
- skip "Can't find a $type UTF-8 locale", 4*256 unless defined $locale;
|
||||||
|
+ skip "Can't find a $type UTF-8 locale", 5*256 unless defined $locale;
|
||||||
|
|
||||||
|
use feature qw( unicode_strings );
|
||||||
|
|
||||||
|
no locale;
|
||||||
|
|
||||||
|
my @unicode_lc;
|
||||||
|
+ my @unicode_fc;
|
||||||
|
my @unicode_uc;
|
||||||
|
my @unicode_lcfirst;
|
||||||
|
my @unicode_ucfirst;
|
||||||
|
@@ -366,6 +367,7 @@ foreach my $turkic (0 .. 1) {
|
||||||
|
# Get all the values outside of 'locale'
|
||||||
|
for my $i (0 .. 255) {
|
||||||
|
push @unicode_lc, lc(chr $i);
|
||||||
|
+ push @unicode_fc, fc(chr $i);
|
||||||
|
push @unicode_uc, uc(chr $i);
|
||||||
|
push @unicode_lcfirst, lcfirst(chr $i);
|
||||||
|
push @unicode_ucfirst, ucfirst(chr $i);
|
||||||
|
@@ -373,6 +375,7 @@ foreach my $turkic (0 .. 1) {
|
||||||
|
|
||||||
|
if ($turkic) {
|
||||||
|
$unicode_lc[ord 'I'] = chr 0x131;
|
||||||
|
+ $unicode_fc[ord 'I'] = chr 0x131;
|
||||||
|
$unicode_lcfirst[ord 'I'] = chr 0x131;
|
||||||
|
$unicode_uc[ord 'i'] = chr 0x130;
|
||||||
|
$unicode_ucfirst[ord 'i'] = chr 0x130;
|
||||||
|
@@ -384,6 +387,7 @@ foreach my $turkic (0 .. 1) {
|
||||||
|
for my $i (0 .. 255) {
|
||||||
|
is(lc(chr $i), $unicode_lc[$i], "In a $type UTF-8 locale, lc(chr $i) is the same as official Unicode");
|
||||||
|
is(uc(chr $i), $unicode_uc[$i], "In a $type UTF-8 locale, uc(chr $i) is the same as official Unicode");
|
||||||
|
+ is(fc(chr $i), $unicode_fc[$i], "In a $type UTF-8 locale, fc(chr $i) is the same as official Unicode");
|
||||||
|
is(lcfirst(chr $i), $unicode_lcfirst[$i], "In a $type UTF-8 locale, lcfirst(chr $i) is the same as official Unicode");
|
||||||
|
is(ucfirst(chr $i), $unicode_ucfirst[$i], "In a $type UTF-8 locale, ucfirst(chr $i) is the same as official Unicode");
|
||||||
|
}
|
||||||
|
@@ -391,27 +395,32 @@ foreach my $turkic (0 .. 1) {
|
||||||
|
}
|
||||||
|
|
||||||
|
SKIP: {
|
||||||
|
- skip "Can't find a turkic UTF-8 locale", 15 unless defined $turkic_locale;
|
||||||
|
+ skip "Can't find a turkic UTF-8 locale", 17 unless defined $turkic_locale;
|
||||||
|
|
||||||
|
# These are designed to stress the calculation of space needed for the
|
||||||
|
# strings. $filler contains a variety of characters that have special
|
||||||
|
# handling in the casing functions, and some regular chars as well.
|
||||||
|
+ # (0x49 = 'I')
|
||||||
|
my $filler_length = 10000;
|
||||||
|
- my $filler = uni_to_native("\x{df}\x{b5}\x{e0}\x{c1}\x{b6}\x{ff}") x $filler_length;
|
||||||
|
+ my $filler = uni_to_native("\x{df}\x{49}\x{69}\x{b5}\x{e0}\x{c1}\x{b6}\x{ff}") x $filler_length;
|
||||||
|
|
||||||
|
# These are the correct answers to what should happen when the given
|
||||||
|
# casing function is called on $filler;
|
||||||
|
- my $filler_lc = uni_to_native("\x{df}\x{b5}\x{e0}\x{e1}\x{b6}\x{ff}") x $filler_length;
|
||||||
|
- my $filler_fc = ("ss" . uni_to_native("\x{b5}\x{e0}\x{e1}\x{b6}\x{ff}")) x $filler_length;
|
||||||
|
- my $filler_uc = ("SS" . uni_to_native("\x{39c}\x{c0}\x{c1}\x{b6}\x{178}")) x $filler_length;
|
||||||
|
+ my $filler_lc = uni_to_native("\x{df}\x{131}\x{69}\x{b5}\x{e0}\x{e1}\x{b6}\x{ff}") x $filler_length;
|
||||||
|
+ my $filler_fc = ("ss" . uni_to_native("\x{131}\x{69}\x{3bc}\x{e0}\x{e1}\x{b6}\x{ff}")) x $filler_length;
|
||||||
|
+ my $filler_uc = ("SS" . uni_to_native("\x{49}\x{130}\x{39c}\x{c0}\x{c1}\x{b6}\x{178}")) x $filler_length;
|
||||||
|
|
||||||
|
use locale;
|
||||||
|
setlocale(&POSIX::LC_CTYPE, $turkic_locale);
|
||||||
|
|
||||||
|
is (lc "IIIIIII$filler", "\x{131}\x{131}\x{131}\x{131}\x{131}\x{131}\x{131}$filler_lc",
|
||||||
|
"lc non-UTF-8, in Turkic locale, beginning with a bunch of I's");
|
||||||
|
+ is (fc "IIIIIII$filler", "\x{131}\x{131}\x{131}\x{131}\x{131}\x{131}\x{131}$filler_fc",
|
||||||
|
+ "fc non-UTF-8, in Turkic locale, beginning with a bunch of I's");
|
||||||
|
is (lc "${filler}IIIIIII$filler", "$filler_lc\x{131}\x{131}\x{131}\x{131}\x{131}\x{131}\x{131}$filler_lc",
|
||||||
|
"lc non-UTF-8, in Turkic locale, a bunch of I's, but not at the beginning");
|
||||||
|
+ is (fc "${filler}IIIIIII$filler", "$filler_fc\x{131}\x{131}\x{131}\x{131}\x{131}\x{131}\x{131}$filler_fc",
|
||||||
|
+ "fc non-UTF-8, in Turkic locale, a bunch of I's, but not at the beginning");
|
||||||
|
is (lc "${filler}I\x{307}$filler", "${filler_lc}i$filler_lc",
|
||||||
|
"lc in Turkic locale with DOT ABOVE immediately following I");
|
||||||
|
is (lc "${filler}I\x{307}IIIIII$filler", "${filler_lc}i\x{131}\x{131}\x{131}\x{131}\x{131}\x{131}$filler_lc",
|
||||||
|
--
|
||||||
|
2.26.2
|
||||||
|
|
@ -0,0 +1,43 @@
|
|||||||
|
From 036189b0a003875df7bf09c7f7fd702267f549e5 Mon Sep 17 00:00:00 2001
|
||||||
|
From: Karl Williamson <khw@cpan.org>
|
||||||
|
Date: Sat, 26 Dec 2020 08:44:08 -0700
|
||||||
|
Subject: [PATCH] Use perl.h versions of PERL_UNUSED_foo in XSUB.h
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
This commit was applied to perl.h, but not to XSUB.h:
|
||||||
|
|
||||||
|
commit a730e3f230f364cffe49370f816f975ae7c9c403
|
||||||
|
Author: Jarkko Hietaniemi <jhi@iki.fi>
|
||||||
|
Date: Thu Sep 4 09:08:33 2014 -0400
|
||||||
|
|
||||||
|
Use sizeof() in UNUSED_ARG and UNUSED_VAR to avoid accessing the values.
|
||||||
|
|
||||||
|
The values might even be uninitialized in the case of PERL_UNUSED_VAR.
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
XSUB.h | 4 ++--
|
||||||
|
1 file changed, 2 insertions(+), 2 deletions(-)
|
||||||
|
|
||||||
|
diff --git a/XSUB.h b/XSUB.h
|
||||||
|
index 616d813840..c1e3959885 100644
|
||||||
|
--- a/XSUB.h
|
||||||
|
+++ b/XSUB.h
|
||||||
|
@@ -108,10 +108,10 @@ is a lexical C<$_> in scope.
|
||||||
|
*/
|
||||||
|
|
||||||
|
#ifndef PERL_UNUSED_ARG
|
||||||
|
-# define PERL_UNUSED_ARG(x) ((void)x)
|
||||||
|
+# define PERL_UNUSED_ARG(x) ((void)sizeof(x))
|
||||||
|
#endif
|
||||||
|
#ifndef PERL_UNUSED_VAR
|
||||||
|
-# define PERL_UNUSED_VAR(x) ((void)x)
|
||||||
|
+# define PERL_UNUSED_VAR(x) ((void)sizeof(x))
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#define ST(off) PL_stack_base[ax + (off)]
|
||||||
|
--
|
||||||
|
2.26.2
|
||||||
|
|
@ -0,0 +1,78 @@
|
|||||||
|
From 07319fdbb283f93cb655c3106b5237cbc7272038 Mon Sep 17 00:00:00 2001
|
||||||
|
From: Tomasz Konojacki <me@xenu.pl>
|
||||||
|
Date: Wed, 30 Dec 2020 14:03:02 +0100
|
||||||
|
Subject: [PATCH] op.c: croak on "my $_" when "use utf8" is in effect
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
Fixes #18449
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
op.c | 16 +++++++++-------
|
||||||
|
t/op/mydef.t | 11 +++++++++--
|
||||||
|
2 files changed, 18 insertions(+), 9 deletions(-)
|
||||||
|
|
||||||
|
diff --git a/op.c b/op.c
|
||||||
|
index b2e12dd0c0..dce844d297 100644
|
||||||
|
--- a/op.c
|
||||||
|
+++ b/op.c
|
||||||
|
@@ -730,6 +730,7 @@ PADOFFSET
|
||||||
|
Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags)
|
||||||
|
{
|
||||||
|
PADOFFSET off;
|
||||||
|
+ bool is_idfirst, is_default;
|
||||||
|
const bool is_our = (PL_parser->in_my == KEY_our);
|
||||||
|
|
||||||
|
PERL_ARGS_ASSERT_ALLOCMY;
|
||||||
|
@@ -738,14 +739,15 @@ Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags)
|
||||||
|
Perl_croak(aTHX_ "panic: allocmy illegal flag bits 0x%" UVxf,
|
||||||
|
(UV)flags);
|
||||||
|
|
||||||
|
+ is_idfirst = flags & SVf_UTF8
|
||||||
|
+ ? isIDFIRST_utf8_safe((U8*)name + 1, name + len)
|
||||||
|
+ : isIDFIRST_A(name[1]);
|
||||||
|
+
|
||||||
|
+ /* $_, @_, etc. */
|
||||||
|
+ is_default = len == 2 && name[1] == '_';
|
||||||
|
+
|
||||||
|
/* complain about "my $<special_var>" etc etc */
|
||||||
|
- if ( len
|
||||||
|
- && !( is_our
|
||||||
|
- || isALPHA(name[1])
|
||||||
|
- || ( (flags & SVf_UTF8)
|
||||||
|
- && isIDFIRST_utf8_safe((U8 *)name+1, name + len))
|
||||||
|
- || (name[1] == '_' && len > 2)))
|
||||||
|
- {
|
||||||
|
+ if (!is_our && (!is_idfirst || is_default)) {
|
||||||
|
const char * const type =
|
||||||
|
PL_parser->in_my == KEY_sigvar ? "subroutine signature" :
|
||||||
|
PL_parser->in_my == KEY_state ? "\"state\"" : "\"my\"";
|
||||||
|
diff --git a/t/op/mydef.t b/t/op/mydef.t
|
||||||
|
index 42a81d9ab0..225ce98e51 100644
|
||||||
|
--- a/t/op/mydef.t
|
||||||
|
+++ b/t/op/mydef.t
|
||||||
|
@@ -6,10 +6,17 @@ BEGIN {
|
||||||
|
set_up_inc('../lib');
|
||||||
|
}
|
||||||
|
|
||||||
|
-plan tests => 1;
|
||||||
|
-
|
||||||
|
use strict;
|
||||||
|
|
||||||
|
eval 'my $_';
|
||||||
|
like $@, qr/^Can't use global \$_ in "my" at /;
|
||||||
|
|
||||||
|
+{
|
||||||
|
+ # using utf8 allows $_ to be declared with 'my'
|
||||||
|
+ # GH #18449
|
||||||
|
+ use utf8;
|
||||||
|
+ eval 'my $_;';
|
||||||
|
+ like $@, qr/^Can't use global \$_ in "my" at /;
|
||||||
|
+}
|
||||||
|
+
|
||||||
|
+done_testing;
|
||||||
|
--
|
||||||
|
2.26.2
|
||||||
|
|
@ -0,0 +1,100 @@
|
|||||||
|
From cac138107138a9814b32c4de74426225628f1646 Mon Sep 17 00:00:00 2001
|
||||||
|
From: Karl Williamson <khw@cpan.org>
|
||||||
|
Date: Sun, 17 Jan 2021 21:45:20 -0700
|
||||||
|
Subject: [PATCH] Add missing entries to perldiag; GH #18276
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
The ticket mentions yet another message, not addressed in this
|
||||||
|
commit, "Insecure private-use override". That message is part of a
|
||||||
|
hook for a so-far unimplemented module, so it actually doesn't ever get
|
||||||
|
raised.
|
||||||
|
|
||||||
|
Committer: One correction per Grinnz comment in
|
||||||
|
https://github.com/Perl/perl5/pull/18491
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
pod/perldiag.pod | 45 +++++++++++++++++++++++++++++++++++++++++++++
|
||||||
|
1 file changed, 45 insertions(+)
|
||||||
|
|
||||||
|
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
|
||||||
|
index 9c91630d39..63f57f220e 100644
|
||||||
|
--- a/pod/perldiag.pod
|
||||||
|
+++ b/pod/perldiag.pod
|
||||||
|
@@ -2195,6 +2195,20 @@ single form when it must operate on them directly. Either you've passed
|
||||||
|
an invalid file specification to Perl, or you've found a case the
|
||||||
|
conversion routines don't handle. Drat.
|
||||||
|
|
||||||
|
+=item Error %s in expansion of %s
|
||||||
|
+
|
||||||
|
+(F) An error was encountered in handling a user-defined property
|
||||||
|
+(L<perlunicode/User-Defined Character Properties>). These are
|
||||||
|
+programmer written subroutines, hence subject to errors that may
|
||||||
|
+prevent them from compiling or running. The calls to these subs are
|
||||||
|
+C<eval>'d, and if there is a failure, this message is raised, using the
|
||||||
|
+contents of C<$@> from the failed C<eval>.
|
||||||
|
+
|
||||||
|
+Another possibility is that tainted data was encountered somewhere in
|
||||||
|
+the chain of expanding the property. If so, the message wording will
|
||||||
|
+indicate that this is the problem. See L</Insecure user-defined
|
||||||
|
+property %s>.
|
||||||
|
+
|
||||||
|
=item Eval-group in insecure regular expression
|
||||||
|
|
||||||
|
(F) Perl detected tainted data when trying to compile a regular
|
||||||
|
@@ -2836,6 +2850,16 @@ not match 8 spaces.
|
||||||
|
text. You should check the pattern to ensure that recursive patterns
|
||||||
|
either consume text or fail.
|
||||||
|
|
||||||
|
+=item Infinite recursion in user-defined property
|
||||||
|
+
|
||||||
|
+(F) A user-defined property (L<perlunicode/User-Defined Character
|
||||||
|
+Properties>) can depend on the definitions of other user-defined
|
||||||
|
+properties. If the chain of dependencies leads back to this property,
|
||||||
|
+infinite recursion would occur, were it not for the check that raised
|
||||||
|
+this error.
|
||||||
|
+
|
||||||
|
+Restructure your property definitions to avoid this.
|
||||||
|
+
|
||||||
|
=item Infinite recursion via empty pattern
|
||||||
|
|
||||||
|
(F) You tried to use the empty pattern inside of a regex code block,
|
||||||
|
@@ -6273,6 +6297,20 @@ lexicals that are initialized only once (see L<feature>):
|
||||||
|
This use of C<my()> in a false conditional was deprecated beginning in
|
||||||
|
Perl 5.10 and became a fatal error in Perl 5.30.
|
||||||
|
|
||||||
|
+=item Timeout waiting for another thread to define \p{%s}
|
||||||
|
+
|
||||||
|
+(F) The first time a user-defined property
|
||||||
|
+(L<perlunicode/User-Defined Character Properties>) is used, its
|
||||||
|
+definition is looked up and converted into an internal form for more
|
||||||
|
+efficient handling in subsequent uses. There could be a race if two or
|
||||||
|
+more threads tried to do this processing nearly simultaneously.
|
||||||
|
+Instead, a critical section is created around this task, locking out all
|
||||||
|
+but one thread from doing it. This message indicates that the thread
|
||||||
|
+that is doing the conversion is taking an unexpectedly long time. The
|
||||||
|
+timeout exists solely to prevent deadlock; it's long enough that the
|
||||||
|
+system was likely thrashing and about to crash. There is no real remedy but
|
||||||
|
+rebooting.
|
||||||
|
+
|
||||||
|
=item times not implemented
|
||||||
|
|
||||||
|
(F) Your version of the C library apparently doesn't do times(). I
|
||||||
|
@@ -6846,6 +6884,13 @@ for the list of known options.
|
||||||
|
L<perlrun|perlrun/-C [numberE<sol>list]> documentation of the C<-C> switch
|
||||||
|
for the list of known options.
|
||||||
|
|
||||||
|
+=item Unknown user-defined property name \p{%s}
|
||||||
|
+
|
||||||
|
+(F) You specified to use a property within the C<\p{...}> which was a
|
||||||
|
+syntactically valid user-defined property, but no definition was found
|
||||||
|
+for it by the time one was required to proceed. Check your spelling.
|
||||||
|
+See L<perlunicode/User-Defined Character Properties>.
|
||||||
|
+
|
||||||
|
=item Unknown verb pattern '%s' in regex; marked by S<<-- HERE> in m/%s/
|
||||||
|
|
||||||
|
(F) You either made a typo or have incorrectly put a C<*> quantifier
|
||||||
|
--
|
||||||
|
2.26.2
|
||||||
|
|
@ -0,0 +1,32 @@
|
|||||||
|
From a2f57b06b018b254bee93e1a1265cfc09833366f Mon Sep 17 00:00:00 2001
|
||||||
|
From: Karl Williamson <khw@cpan.org>
|
||||||
|
Date: Tue, 9 Feb 2021 11:32:15 -0700
|
||||||
|
Subject: [PATCH] t/run/locale.t: Rmv LANGUAGE from environment
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
This could cause interference with our tests on some platforms that have
|
||||||
|
this environment variable.
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
t/run/locale.t | 2 +-
|
||||||
|
1 file changed, 1 insertion(+), 1 deletion(-)
|
||||||
|
|
||||||
|
diff --git a/t/run/locale.t b/t/run/locale.t
|
||||||
|
index 8a04d1aea6..0f2a2ba457 100644
|
||||||
|
--- a/t/run/locale.t
|
||||||
|
+++ b/t/run/locale.t
|
||||||
|
@@ -38,7 +38,7 @@ if (defined $ARGV[0] && $ARGV[0] ne "") {
|
||||||
|
}
|
||||||
|
|
||||||
|
# reset the locale environment
|
||||||
|
-delete local @ENV{'LANG', (grep /^LC_[A-Z]+$/, keys %ENV)};
|
||||||
|
+delete local @ENV{'LANGUAGE', 'LANG', (grep /^LC_[A-Z]+$/, keys %ENV)};
|
||||||
|
|
||||||
|
# If user wants this to happen, they set the environment variable AND use
|
||||||
|
# 'debug'
|
||||||
|
--
|
||||||
|
2.26.2
|
||||||
|
|
@ -0,0 +1,74 @@
|
|||||||
|
From 5f41fa466a67b5535aa8bcf4b814f242545ac7bd Mon Sep 17 00:00:00 2001
|
||||||
|
From: Karl Williamson <khw@cpan.org>
|
||||||
|
Date: Sat, 27 Feb 2021 11:43:41 -0700
|
||||||
|
Subject: [PATCH] regcomp.c: Remove memory leak
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
This fixes GH #18604. There was a path through the code where a
|
||||||
|
particular SV did not get its reference count decremented.
|
||||||
|
|
||||||
|
I did an audit of the function and came up with several other
|
||||||
|
possiblities that are included in this commit.
|
||||||
|
|
||||||
|
Further, there would be leaks for some instances of finding syntax
|
||||||
|
errors in the input pattern, or when warnings are fatalized. Those
|
||||||
|
would require mortalizing some SVs, but that is beyond the scope of this
|
||||||
|
commit.
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
regcomp.c | 7 +++++++
|
||||||
|
t/op/svleak.t | 3 ++-
|
||||||
|
2 files changed, 9 insertions(+), 1 deletion(-)
|
||||||
|
|
||||||
|
diff --git a/regcomp.c b/regcomp.c
|
||||||
|
index e44c7a37e5..f5e5f581dc 100644
|
||||||
|
--- a/regcomp.c
|
||||||
|
+++ b/regcomp.c
|
||||||
|
@@ -18765,6 +18765,12 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
|
||||||
|
RExC_end = save_end;
|
||||||
|
RExC_in_multi_char_class = 0;
|
||||||
|
SvREFCNT_dec_NN(multi_char_matches);
|
||||||
|
+ SvREFCNT_dec(properties);
|
||||||
|
+ SvREFCNT_dec(cp_list);
|
||||||
|
+ SvREFCNT_dec(simple_posixes);
|
||||||
|
+ SvREFCNT_dec(posixes);
|
||||||
|
+ SvREFCNT_dec(nposixes);
|
||||||
|
+ SvREFCNT_dec(cp_foldable_list);
|
||||||
|
return ret;
|
||||||
|
}
|
||||||
|
|
||||||
|
@@ -20122,6 +20128,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
|
||||||
|
RExC_parse - orig_parse);;
|
||||||
|
SvREFCNT_dec(cp_list);;
|
||||||
|
SvREFCNT_dec(only_utf8_locale_list);
|
||||||
|
+ SvREFCNT_dec(upper_latin1_only_utf8_matches);
|
||||||
|
return ret;
|
||||||
|
}
|
||||||
|
|
||||||
|
diff --git a/t/op/svleak.t b/t/op/svleak.t
|
||||||
|
index 6acc298c3d..3df4838be8 100644
|
||||||
|
--- a/t/op/svleak.t
|
||||||
|
+++ b/t/op/svleak.t
|
||||||
|
@@ -15,7 +15,7 @@ BEGIN {
|
||||||
|
|
||||||
|
use Config;
|
||||||
|
|
||||||
|
-plan tests => 150;
|
||||||
|
+plan tests => 151;
|
||||||
|
|
||||||
|
# run some code N times. If the number of SVs at the end of loop N is
|
||||||
|
# greater than (N-1)*delta at the end of loop 1, we've got a leak
|
||||||
|
@@ -278,6 +278,7 @@ eleak(2,0,'/[[:ascii:]]/');
|
||||||
|
eleak(2,0,'/[[.zog.]]/');
|
||||||
|
eleak(2,0,'/[.zog.]/');
|
||||||
|
eleak(2,0,'/|\W/', '/|\W/ [perl #123198]');
|
||||||
|
+eleak(2,0,'/a\sb/', '/a\sb/ [GH #18604]');
|
||||||
|
eleak(2,0,'no warnings; /(?[])/');
|
||||||
|
eleak(2,0,'no warnings; /(?[[a]+[b]])/');
|
||||||
|
eleak(2,0,'no warnings; /(?[[a]-[b]])/');
|
||||||
|
--
|
||||||
|
2.26.2
|
||||||
|
|
@ -0,0 +1,62 @@
|
|||||||
|
From 4e82c85b1c9c9b30253b8624470da6f20a6c0604 Mon Sep 17 00:00:00 2001
|
||||||
|
From: Karl Williamson <khw@cpan.org>
|
||||||
|
Date: Mon, 15 Mar 2021 21:01:47 -0600
|
||||||
|
Subject: [PATCH] Fix broken left shift of IV_MIN under 'use integer'
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
This fixes GH 18639
|
||||||
|
|
||||||
|
When I wrote this code, I conflated casting and complementing.
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
pp.c | 3 ---
|
||||||
|
t/op/bop.t | 9 ++++++++-
|
||||||
|
2 files changed, 8 insertions(+), 4 deletions(-)
|
||||||
|
|
||||||
|
diff --git a/pp.c b/pp.c
|
||||||
|
index d365afea4c..baf0777a47 100644
|
||||||
|
--- a/pp.c
|
||||||
|
+++ b/pp.c
|
||||||
|
@@ -2007,9 +2007,6 @@ static IV S_iv_shift(IV iv, int shift, bool left)
|
||||||
|
* 18446744073709551552
|
||||||
|
* */
|
||||||
|
if (left) {
|
||||||
|
- if (iv == IV_MIN) { /* Casting this to a UV is undefined behavior */
|
||||||
|
- return 0;
|
||||||
|
- }
|
||||||
|
return (IV) (((UV) iv) << shift);
|
||||||
|
}
|
||||||
|
|
||||||
|
diff --git a/t/op/bop.t b/t/op/bop.t
|
||||||
|
index 07f057d0a9..31b6531a03 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 => 502;
|
||||||
|
+plan tests => 503;
|
||||||
|
|
||||||
|
# numerics
|
||||||
|
ok ((0xdead & 0xbeef) == 0x9ead);
|
||||||
|
@@ -33,6 +33,13 @@ ok ((33023 >> 7) == 257);
|
||||||
|
# signed vs. unsigned
|
||||||
|
ok ((~0 > 0 && do { use integer; ~0 } == -1));
|
||||||
|
|
||||||
|
+{ # GH #18639
|
||||||
|
+ my $iv_min = -(~0 >> 1) - 1;
|
||||||
|
+ my $shifted;
|
||||||
|
+ { use integer; $shifted = $iv_min << 0 };
|
||||||
|
+ is($shifted, $iv_min, "IV_MIN << 0 yields IV_MIN under 'use integer'");
|
||||||
|
+}
|
||||||
|
+
|
||||||
|
my $bits = 0;
|
||||||
|
for (my $i = ~0; $i; $i >>= 1) { ++$bits; }
|
||||||
|
my $cusp = 1 << ($bits - 1);
|
||||||
|
--
|
||||||
|
2.26.3
|
||||||
|
|
@ -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"
|
@ -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)" ';
|
||||||
|
}
|
||||||
|
|
@ -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)
|
||||||
|
}
|
@ -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
|
@ -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)
|
||||||
|
}
|
File diff suppressed because it is too large
Load Diff
Loading…
Reference in new issue