Toshaan Bharvani
2 years ago
commit
da91542796
58 changed files with 15433 additions and 0 deletions
@ -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 |
@ -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) |
||||||
|
} |
Loading…
Reference in new issue