import perl-5.32.1-471.module+el8.6.0+13324+628a2397
This commit is contained in:
		
						commit
						9c4387687e
					
				
							
								
								
									
										1
									
								
								.gitignore
									
									
									
									
										vendored
									
									
										Normal file
									
								
							
							
						
						
									
										1
									
								
								.gitignore
									
									
									
									
										vendored
									
									
										Normal file
									
								
							| @ -0,0 +1 @@ | ||||
| SOURCES/perl-5.32.1.tar.xz | ||||
							
								
								
									
										1
									
								
								.perl.metadata
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										1
									
								
								.perl.metadata
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1 @@ | ||||
| 1fb4f710d139da1e1a3e1fa4eaba201fcaa8e18e SOURCES/perl-5.32.1.tar.xz | ||||
							
								
								
									
										41
									
								
								SOURCES/Pod-Html-license-clarification
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										41
									
								
								SOURCES/Pod-Html-license-clarification
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,41 @@ | ||||
| Date: Sun, 15 Mar 2015 21:22:10 -0600 | ||||
| Subject: Re: Pod::Html license | ||||
| From: Tom Christiansen <tchrist53147@gmail.com> | ||||
| To: Petr Šabata <contyk@redhat.com> | ||||
| Cc: Tom Christiansen <tchrist@perl.com>, marcgreen@cpan.org, | ||||
|  jplesnik@redhat.com | ||||
| MIME-Version: 1.0 | ||||
| Content-Transfer-Encoding: 8bit | ||||
| Content-Type: text/plain; charset=utf-8 | ||||
| 
 | ||||
| Yes, it was supposed to be licensed just like the rest of Perl. | ||||
| 
 | ||||
| Sent from my Sprint phone | ||||
| 
 | ||||
| Petr Šabata <contyk@redhat.com> wrote: | ||||
| 
 | ||||
| >Marc, Tom, | ||||
| > | ||||
| >I'm reviewing licensing of our perl package in Fedora and  | ||||
| >noticed Pod::HTML and its pod2html script are licensed under | ||||
| >the Artistic license (only). | ||||
| > | ||||
| >This is an issue for us as this license isn't considered free by | ||||
| >FSF [0].  Unless the license of this core component changes, we | ||||
| >will have to drop it from the tarball and remove support for it | ||||
| >from all the modules we ship that use it, such as Module::Build | ||||
| >or Module::Install. | ||||
| > | ||||
| >What I've seen in the past is authors originally claiming their | ||||
| >module was released under Artistic while what they actually meant | ||||
| >was the common `the same as perl itself', i.e. `GPL+/Aristic' [1], | ||||
| >an FSF free license.  Is it possible this is also the case | ||||
| >of Pod::Html? | ||||
| > | ||||
| >Thanks, | ||||
| >Petr | ||||
| > | ||||
| >(also CC'ing Jitka, the primary package maintainer in Fedora) | ||||
| > | ||||
| >[0] https://www.gnu.org/licenses/license-list.html#ArtisticLicense | ||||
| >[1] https://www.gnu.org/licenses/license-list.html#PerlLicense | ||||
							
								
								
									
										2474
									
								
								SOURCES/gendep.macros
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										2474
									
								
								SOURCES/gendep.macros
									
									
									
									
									
										Normal file
									
								
							
										
											
												File diff suppressed because it is too large
												Load Diff
											
										
									
								
							
							
								
								
									
										158
									
								
								SOURCES/macros.perl
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										158
									
								
								SOURCES/macros.perl
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,158 @@ | ||||
| # Sensible Perl-specific RPM build macros. | ||||
| # | ||||
| # Note that these depend on the generic filtering system being in place in | ||||
| # rpm core; but won't cause a build to fail if they're not present. | ||||
| # | ||||
| # Chris Weyl <cweyl@alumni.drew.edu> 2009 | ||||
| # Marcela Mašláňová <mmaslano@redhat.com> 2011 | ||||
| 
 | ||||
| # This macro unsets several common vars used to control how Makefile.PL (et | ||||
| # al) build and install packages.  We also set a couple to help some of the | ||||
| # common systems be less interactive.  This was blatantly stolen from | ||||
| # cpanminus, and helps building rpms locally when one makes extensive use of | ||||
| # local::lib, etc. | ||||
| # | ||||
| # Usage, in %build, before "%{__perl} Makefile.PL ..." | ||||
| # | ||||
| #   %{?perl_ext_env_unset} | ||||
| 
 | ||||
| %perl_ext_env_unset %{expand: | ||||
| unset PERL_MM_OPT MODULEBUILDRC PERL5INC | ||||
| export PERL_AUTOINSTALL="--defaultdeps" | ||||
| export PERL_MM_USE_DEFAULT=1 | ||||
| } | ||||
| 
 | ||||
| ############################################################################# | ||||
| # Perl specific macros, no longer part of rpm >= 4.15 | ||||
| %perl_vendorarch %(eval "`%{__perl} -V:installvendorarch`"; echo $installvendorarch) | ||||
| %perl_vendorlib  %(eval "`%{__perl} -V:installvendorlib`"; echo $installvendorlib) | ||||
| %perl_archlib    %(eval "`%{__perl} -V:installarchlib`"; echo $installarchlib) | ||||
| %perl_privlib    %(eval "`%{__perl} -V:installprivlib`"; echo $installprivlib) | ||||
| 
 | ||||
| ############################################################################# | ||||
| # Filtering macro incantations | ||||
| 
 | ||||
| # keep track of what "revision" of the filtering we're at.  Each time we | ||||
| # change the filter we should increment this. | ||||
| 
 | ||||
| %perl_default_filter_revision 3 | ||||
| 
 | ||||
| # By default, for perl packages we want to filter all files in _docdir from  | ||||
| # req/prov scanning. | ||||
| # Filtering out any provides caused by private libs in vendorarch/archlib | ||||
| # (vendor/core) is done by rpmbuild since Fedora 20 | ||||
| # <https://fedorahosted.org/fpc/ticket/353>. | ||||
| # | ||||
| # Note that this must be invoked in the spec file, preferably as  | ||||
| # "%{?perl_default_filter}", before any %description block. | ||||
| 
 | ||||
| %perl_default_filter %{expand: \ | ||||
| %global __provides_exclude_from %{?__provides_exclude_from:%__provides_exclude_from|}^%{_docdir} | ||||
| %global __requires_exclude_from %{?__requires_exclude_from:%__requires_exclude_from|}^%{_docdir} | ||||
| %global __provides_exclude %{?__provides_exclude:%__provides_exclude|}^perl\\\\(VMS|^perl\\\\(Win32|^perl\\\\(DB\\\\)|^perl\\\\(UNIVERSAL\\\\) | ||||
| %global __requires_exclude %{?__requires_exclude:%__requires_exclude|}^perl\\\\(VMS|^perl\\\\(Win32 | ||||
| } | ||||
| 
 | ||||
| ############################################################################# | ||||
| # Macros to assist with generating a "-tests" subpackage in a semi-automatic | ||||
| # manner. | ||||
| # | ||||
| # The following macros are still in a highly experimental stage and users | ||||
| # should be aware that the interface and behaviour may change.  | ||||
| # | ||||
| # PLEASE, PLEASE CONDITIONALIZE THESE MACROS IF YOU USE THEM. | ||||
| # | ||||
| # See http://gist.github.com/284409 | ||||
| 
 | ||||
| # These macros should be invoked as above, right before the first %description | ||||
| # section, and conditionalized.  e.g., for the common case where all our tests | ||||
| # are located under t/, the correct usage is: | ||||
| # | ||||
| #   %{?perl_default_subpackage_tests} | ||||
| # | ||||
| # If custom files/directories need to be specified, this can be done as such: | ||||
| # | ||||
| #   %{?perl_subpackage_tests:%perl_subpackage_tests t/ one/ three.sql} | ||||
| # | ||||
| # etc, etc. | ||||
| 
 | ||||
| %perl_version   %(eval "`%{__perl} -V:version`"; echo $version) | ||||
| %perl_testdir   %{_libexecdir}/perl5-tests | ||||
| %cpan_dist_name %(eval echo %{name} | %{__sed} -e 's/^perl-//') | ||||
| 
 | ||||
| # easily mark something as required by -tests and BR to the main package | ||||
| %tests_req() %{expand:\ | ||||
| BuildRequires: %*\ | ||||
| %%tests_subpackage_requires %*\ | ||||
| } | ||||
| 
 | ||||
| # fixup (and create if needed) the shbang lines in tests, so they work and | ||||
| # rpmlint doesn't (correctly) have a fit | ||||
| %fix_shbang_line() \ | ||||
| TMPHEAD=`mktemp`\ | ||||
| TMPBODY=`mktemp`\ | ||||
| for file in %* ; do \ | ||||
|     head -1 $file > $TMPHEAD\ | ||||
|     tail -n +2 $file > $TMPBODY\ | ||||
|     %{__perl} -pi -e '$f = /^#!/ ? "" : "#!%{__perl}$/"; $_="$f$_"' $TMPHEAD\ | ||||
|     cat $TMPHEAD $TMPBODY > $file\ | ||||
| done\ | ||||
| %{__perl} -MExtUtils::MakeMaker -e "ExtUtils::MM_Unix->fixin(qw{%*})"\ | ||||
| %{__rm} $TMPHEAD $TMPBODY\ | ||||
| %{nil} | ||||
| 
 | ||||
| # additional -tests subpackage requires, if any | ||||
| %tests_subpackage_requires() %{expand: \ | ||||
| %global __tests_spkg_req %{?__tests_spkg_req} %* \ | ||||
| } | ||||
| 
 | ||||
| # additional -tests subpackage provides, if any | ||||
| %tests_subpackage_provides() %{expand: \ | ||||
| %global __tests_spkg_prov %{?__tests_spkg_prov} %* \ | ||||
| } | ||||
| 
 | ||||
| # | ||||
| # Runs after the body of %check completes. | ||||
| # | ||||
| 
 | ||||
| %__perl_check_pre %{expand: \ | ||||
| %{?__spec_check_pre} \ | ||||
| pushd %{buildsubdir} \ | ||||
| %define perl_br_testdir %{buildroot}%{perl_testdir}/%{cpan_dist_name} \ | ||||
| %{__mkdir_p} %{perl_br_testdir} \ | ||||
| %{__tar} -cf - %{__perl_test_dirs} | ( cd %{perl_br_testdir} && %{__tar} -xf - ) \ | ||||
| find . -maxdepth 1 -type f -name '*META*' -exec %{__cp} -vp {} %{perl_br_testdir} ';' \ | ||||
| find %{perl_br_testdir} -type f -exec %{__chmod} -c -x {} ';' \ | ||||
| T_FILES=`find %{perl_br_testdir} -type f -name '*.t'` \ | ||||
| %fix_shbang_line $T_FILES \ | ||||
| %{__chmod} +x $T_FILES \ | ||||
| %{_fixperms} %{perl_br_testdir} \ | ||||
| popd \ | ||||
| } | ||||
| 
 | ||||
| # | ||||
| # The actual invoked macro | ||||
| # | ||||
| 
 | ||||
| %perl_subpackage_tests() %{expand: \ | ||||
| %global __perl_package 1\ | ||||
| %global __perl_test_dirs %* \ | ||||
| %global __spec_check_pre %{expand:%{__perl_check_pre}} \ | ||||
| %package tests\ | ||||
| Summary: Test suite for package %{name}\ | ||||
| Group: Development/Debug\ | ||||
| Requires: %{name} = %{?epoch:%{epoch}:}%{version}-%{release}\ | ||||
| Requires: /usr/bin/prove \ | ||||
| %{?__tests_spkg_req:Requires: %__tests_spkg_req}\ | ||||
| %{?__tests_spkg_prov:Provides: %__tests_spkg_prov}\ | ||||
| AutoReqProv: 0 \ | ||||
| %description tests\ | ||||
| This package provides the test suite for package %{name}.\ | ||||
| %files tests\ | ||||
| %defattr(-,root,root,-)\ | ||||
| %{perl_testdir}\ | ||||
| } | ||||
| 
 | ||||
| # shortcut sugar | ||||
| %perl_default_subpackage_tests %perl_subpackage_tests t/ | ||||
| 
 | ||||
							
								
								
									
										12
									
								
								SOURCES/perl-5.10.0-libresolv.patch
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										12
									
								
								SOURCES/perl-5.10.0-libresolv.patch
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,12 @@ | ||||
| diff -up perl-5.10.0/Configure.didi perl-5.10.0/Configure
 | ||||
| --- perl-5.10.0/Configure.didi	2007-12-18 11:47:07.000000000 +0100
 | ||||
| +++ perl-5.10.0/Configure	2008-07-21 10:51:16.000000000 +0200
 | ||||
| @@ -1483,7 +1483,7 @@ archname=''
 | ||||
|  usereentrant='undef' | ||||
|  : List of libraries we want. | ||||
|  : If anyone needs extra -lxxx, put those in a hint file. | ||||
| -libswanted="cl pthread socket bind inet nsl ndbm gdbm dbm db malloc dl ld"
 | ||||
| +libswanted="cl pthread socket resolv inet nsl ndbm gdbm dbm db malloc dl ld"
 | ||||
|  libswanted="$libswanted sun m crypt sec util c cposix posix ucb bsd BSD" | ||||
|  : We probably want to search /usr/shlib before most other libraries. | ||||
|  : This is only used by the lib/ExtUtils/MakeMaker.pm routine extliblist. | ||||
							
								
								
									
										12
									
								
								SOURCES/perl-5.10.0-x86_64-io-test-failure.patch
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										12
									
								
								SOURCES/perl-5.10.0-x86_64-io-test-failure.patch
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,12 @@ | ||||
| diff -up perl-5.10.0/t/io/fs.t.BAD perl-5.10.0/t/io/fs.t
 | ||||
| --- perl-5.10.0/t/io/fs.t.BAD	2008-01-30 13:36:43.000000000 -0500
 | ||||
| +++ perl-5.10.0/t/io/fs.t	2008-01-30 13:41:27.000000000 -0500
 | ||||
| @@ -257,7 +257,7 @@ isnt($atime, 500000000, 'atime');
 | ||||
|  isnt($mtime, $ut + $delta, 'mtime: utime called with two undefs'); | ||||
|   | ||||
|  SKIP: { | ||||
| -    skip "no futimes", 6 unless ($Config{d_futimes} || "") eq "define";
 | ||||
| +    skip "no futimes", 6;
 | ||||
|      note("check futimes"); | ||||
|      open(my $fh, "<", 'b'); | ||||
|      $foo = (utime $ut,$ut + $delta, $fh); | ||||
							
								
								
									
										17
									
								
								SOURCES/perl-5.14.1-offtest.patch
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										17
									
								
								SOURCES/perl-5.14.1-offtest.patch
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,17 @@ | ||||
| diff -up perl-5.14.1/cpan/File-Temp/t/fork.t.off perl-5.14.1/cpan/File-Temp/t/fork.t
 | ||||
| --- perl-5.14.1/cpan/File-Temp/t/fork.t.off	2011-04-13 13:36:34.000000000 +0200
 | ||||
| +++ perl-5.14.1/cpan/File-Temp/t/fork.t	2011-06-20 10:29:31.536282611 +0200
 | ||||
| @@ -12,12 +12,8 @@ BEGIN {
 | ||||
|       $Config::Config{useithreads} and | ||||
|       $Config::Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/ | ||||
|      ); | ||||
| -  if ( $can_fork ) {
 | ||||
| -    print "1..8\n";
 | ||||
| -  } else {
 | ||||
| -    print "1..0 # Skip No fork available\n";
 | ||||
| +    print "1..0 # Skip Koji doesn't work with Perl fork tests\n";
 | ||||
|      exit; | ||||
| -  }
 | ||||
|  } | ||||
|   | ||||
|  use File::Temp; | ||||
| @ -0,0 +1,65 @@ | ||||
| From b598ba3f2d4b8347c6621cff022b8e2329b79ea5 Mon Sep 17 00:00:00 2001 | ||||
| From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com> | ||||
| Date: Wed, 3 Jul 2013 11:01:02 +0200 | ||||
| Subject: [PATCH] Link XS modules to libperl.so with EU::CBuilder on Linux | ||||
| MIME-Version: 1.0 | ||||
| Content-Type: text/plain; charset=UTF-8 | ||||
| Content-Transfer-Encoding: 8bit | ||||
| 
 | ||||
| <https://bugzilla.redhat.com/show_bug.cgi?id=960048> | ||||
| <http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=327585#50> | ||||
| 
 | ||||
| Signed-off-by: Petr Písař <ppisar@redhat.com> | ||||
| ---
 | ||||
|  MANIFEST                                           |  1 + | ||||
|  .../lib/ExtUtils/CBuilder/Platform/linux.pm        | 26 ++++++++++++++++++++++ | ||||
|  2 files changed, 27 insertions(+) | ||||
|  create mode 100644 dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/linux.pm | ||||
| 
 | ||||
| diff --git a/MANIFEST b/MANIFEST
 | ||||
| index 397252a..d7c519b 100644
 | ||||
| --- a/MANIFEST
 | ||||
| +++ b/MANIFEST
 | ||||
| @@ -3424,6 +3424,7 @@ dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/aix.pm	CBuilder methods fo
 | ||||
|  dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/cygwin.pm	CBuilder methods for cygwin | ||||
|  dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/darwin.pm	CBuilder methods for darwin | ||||
|  dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/dec_osf.pm	CBuilder methods for OSF | ||||
| +dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/linux.pm	CBuilder methods for Linux
 | ||||
|  dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/os2.pm	CBuilder methods for OS/2 | ||||
|  dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Unix.pm	CBuilder methods for Unix | ||||
|  dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/VMS.pm	CBuilder methods for VMS | ||||
| diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/linux.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/linux.pm
 | ||||
| new file mode 100644 | ||||
| index 0000000..e3251c4
 | ||||
| --- /dev/null
 | ||||
| +++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/linux.pm
 | ||||
| @@ -0,0 +1,26 @@
 | ||||
| +package ExtUtils::CBuilder::Platform::linux;
 | ||||
| +
 | ||||
| +use strict;
 | ||||
| +use ExtUtils::CBuilder::Platform::Unix;
 | ||||
| +use File::Spec;
 | ||||
| +
 | ||||
| +use vars qw($VERSION @ISA);
 | ||||
| +$VERSION = '0.280206';
 | ||||
| +@ISA = qw(ExtUtils::CBuilder::Platform::Unix);
 | ||||
| +
 | ||||
| +sub link {
 | ||||
| +  my ($self, %args) = @_;
 | ||||
| +  my $cf = $self->{config};
 | ||||
| +
 | ||||
| +  # Link XS modules to libperl.so explicitly because multiple
 | ||||
| +  # dlopen(, RTLD_LOCAL) hides libperl symbols from XS module.
 | ||||
| +  local $cf->{lddlflags} = $cf->{lddlflags};
 | ||||
| +  if ($ENV{PERL_CORE}) {
 | ||||
| +    $cf->{lddlflags} .= ' -L' . $self->perl_inc();
 | ||||
| +  }
 | ||||
| +  $cf->{lddlflags} .= ' -lperl';
 | ||||
| +
 | ||||
| +  return $self->SUPER::link(%args);
 | ||||
| +}
 | ||||
| +
 | ||||
| +1;
 | ||||
| -- 
 | ||||
| 1.8.1.4 | ||||
| 
 | ||||
| @ -0,0 +1,52 @@ | ||||
| From fc1f8ac36c34c35bad84fb7b99a26ab83c9ba075 Mon Sep 17 00:00:00 2001 | ||||
| From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com> | ||||
| Date: Wed, 3 Jul 2013 12:59:09 +0200 | ||||
| Subject: [PATCH] Link XS modules to libperl.so with EU::MM on Linux | ||||
| MIME-Version: 1.0 | ||||
| Content-Type: text/plain; charset=UTF-8 | ||||
| Content-Transfer-Encoding: 8bit | ||||
| 
 | ||||
| <https://bugzilla.redhat.com/show_bug.cgi?id=960048> | ||||
| <http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=327585#50> | ||||
| 
 | ||||
| Signed-off-by: Petr Písař <ppisar@redhat.com> | ||||
| ---
 | ||||
|  cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm | 8 +++++++- | ||||
|  1 file changed, 7 insertions(+), 1 deletion(-) | ||||
| 
 | ||||
| diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm
 | ||||
| index a8b172f..a3fbce2 100644
 | ||||
| --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm
 | ||||
| +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm
 | ||||
| @@ -30,6 +30,7 @@ BEGIN {
 | ||||
|      $Is{IRIX}    = $^O eq 'irix'; | ||||
|      $Is{NetBSD}  = $^O eq 'netbsd'; | ||||
|      $Is{Interix} = $^O eq 'interix'; | ||||
| +    $Is{Linux}   = $^O eq 'linux';
 | ||||
|      $Is{SunOS4}  = $^O eq 'sunos'; | ||||
|      $Is{Solaris} = $^O eq 'solaris'; | ||||
|      $Is{SunOS}   = $Is{SunOS4} || $Is{Solaris}; | ||||
| @@ -1028,7 +1029,7 @@ sub xs_make_dynamic_lib {
 | ||||
|      push(@m,"	\$(RM_F) \$\@\n"); | ||||
|   | ||||
|      my $libs = '$(LDLOADLIBS)'; | ||||
| -    if (($Is{NetBSD} || $Is{Interix} || $Is{Android}) && $Config{'useshrplib'} eq 'true') {
 | ||||
| +    if (($Is{Linux} || $Is{NetBSD} || $Is{Interix} || $Is{Android}) && $Config{'useshrplib'} eq 'true') {
 | ||||
|          # Use nothing on static perl platforms, and to the flags needed | ||||
|          # to link against the shared libperl library on shared perl | ||||
|          # platforms.  We peek at lddlflags to see if we need -Wl,-R | ||||
| @@ -1041,6 +1042,11 @@ sub xs_make_dynamic_lib {
 | ||||
|              # The Android linker will not recognize symbols from | ||||
|              # libperl unless the module explicitly depends on it. | ||||
|              $libs .= ' "-L$(PERL_INC)" -lperl'; | ||||
| +        } else {
 | ||||
| +            if ($ENV{PERL_CORE}) {
 | ||||
| +                $libs .= ' "-L$(PERL_INC)"';
 | ||||
| +            }
 | ||||
| +            $libs .= ' -lperl';
 | ||||
|          } | ||||
|      } | ||||
|   | ||||
| -- 
 | ||||
| 1.8.1.4 | ||||
| 
 | ||||
							
								
								
									
										57
									
								
								SOURCES/perl-5.16.3-create_libperl_soname.patch
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										57
									
								
								SOURCES/perl-5.16.3-create_libperl_soname.patch
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,57 @@ | ||||
| From fa2f0dd5a7767223df10149d3f16d7ed7013e16f Mon Sep 17 00:00:00 2001 | ||||
| From: Torsten Veller <tove@gentoo.org> | ||||
| Date: Sat, 14 Apr 2012 13:49:18 +0200 | ||||
| Subject: Set libperl soname | ||||
| 
 | ||||
| Bug-Gentoo: https://bugs.gentoo.org/286840 | ||||
| 
 | ||||
| Patch-Name: gentoo/create_libperl_soname.diff | ||||
| ---
 | ||||
|  Makefile.SH | 9 +++++++-- | ||||
|  1 file changed, 7 insertions(+), 2 deletions(-) | ||||
| 
 | ||||
| diff --git a/Makefile.SH b/Makefile.SH
 | ||||
| index d1da0a0..7733a32 100755
 | ||||
| --- a/Makefile.SH
 | ||||
| +++ b/Makefile.SH
 | ||||
| @@ -70,11 +70,11 @@ true)
 | ||||
|  				${revision}.${patchlevel}.${subversion}" | ||||
|  		case "$osvers" in | ||||
|  	        1[5-9]*|[2-9]*) | ||||
| -			shrpldflags="$shrpldflags -install_name `pwd`/\$@ -Xlinker -headerpad_max_install_names"
 | ||||
| +			shrpldflags="$shrpldflags -install_name `pwd`/libperl.${revision}.${patchlevel}.dylib -Xlinker -headerpad_max_install_names"
 | ||||
|  			exeldflags="-Xlinker -headerpad_max_install_names" | ||||
|  			;; | ||||
|  		*) | ||||
| -			shrpldflags="$shrpldflags -install_name \$(shrpdir)/\$@"
 | ||||
| +			shrpldflags="$shrpldflags -install_name \$(shrpdir)/libperl.${revision}.${patchlevel}.dylib"
 | ||||
|  			;; | ||||
|  		esac | ||||
|  		;; | ||||
| @@ -76,13 +76,15 @@ true)
 | ||||
|  		;; | ||||
|  	sunos*) | ||||
|  		linklibperl="-lperl" | ||||
| +		shrpldflags="$shrpldflags -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}"
 | ||||
|  		;; | ||||
|  	netbsd*|freebsd[234]*|openbsd*|dragonfly*|bitrig*) | ||||
|  		linklibperl="-L. -lperl" | ||||
| +		shrpldflags="$shrpldflags -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}"
 | ||||
|  		;; | ||||
|  	interix*) | ||||
|  		linklibperl="-L. -lperl" | ||||
| -		shrpldflags="$shrpldflags -Wl,--image-base,0x57000000"
 | ||||
| +		shrpldflags="$shrpldflags -Wl,--image-base,0x57000000 -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}"
 | ||||
|  		;; | ||||
|  	aix*) | ||||
|  		case "$cc" in | ||||
| @@ -120,6 +122,9 @@ true)
 | ||||
|  	    linklibperl='libperl.x' | ||||
|  	    DPERL_EXTERNAL_GLOB='' | ||||
|  	    ;; | ||||
| +	linux*)
 | ||||
| +		shrpldflags="$shrpldflags -Wl,-soname -Wl,libperl.so.${revision}.${patchlevel}"
 | ||||
| +	    ;;
 | ||||
|  	esac | ||||
|  	case "$ldlibpthname" in | ||||
|  	'') ;; | ||||
| @ -0,0 +1,233 @@ | ||||
| From f793042f2bac2ace9a5c0030b47b41c4db561a5b Mon Sep 17 00:00:00 2001 | ||||
| From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com> | ||||
| Date: Fri, 6 Jun 2014 14:31:59 +0200 | ||||
| Subject: [PATCH] Destroy {GDBM,NDBM,ODBM,SDBM}_File objects only from original | ||||
|  thread context | ||||
| MIME-Version: 1.0 | ||||
| Content-Type: text/plain; charset=UTF-8 | ||||
| Content-Transfer-Encoding: 8bit | ||||
| 
 | ||||
| This patch fixes a crash when destroing a hash tied to a *_File | ||||
| database after spawning a thread: | ||||
| 
 | ||||
| use Fcntl; | ||||
| use SDBM_File; | ||||
| use threads; | ||||
| tie(my %dbtest, 'SDBM_File', "test.db", O_RDWR|O_CREAT, 0666); | ||||
| threads->new(sub {})->join; | ||||
| 
 | ||||
| This crashed or paniced depending on how perl was configured. | ||||
| 
 | ||||
| Closes RT#61912. | ||||
| 
 | ||||
| Signed-off-by: Petr Písař <ppisar@redhat.com> | ||||
| ---
 | ||||
|  ext/GDBM_File/GDBM_File.xs | 16 ++++++++++------ | ||||
|  ext/NDBM_File/NDBM_File.xs | 16 ++++++++++------ | ||||
|  ext/ODBM_File/ODBM_File.xs | 18 +++++++++++------- | ||||
|  ext/SDBM_File/SDBM_File.xs |  4 +++- | ||||
|  t/lib/dbmt_common.pl       | 35 +++++++++++++++++++++++++++++++++++ | ||||
|  5 files changed, 69 insertions(+), 20 deletions(-) | ||||
| 
 | ||||
| diff --git a/ext/GDBM_File/GDBM_File.xs b/ext/GDBM_File/GDBM_File.xs
 | ||||
| index 33e08e2..7160f54 100644
 | ||||
| --- a/ext/GDBM_File/GDBM_File.xs
 | ||||
| +++ b/ext/GDBM_File/GDBM_File.xs
 | ||||
| @@ -13,6 +13,7 @@
 | ||||
|  #define store_value 3 | ||||
|   | ||||
|  typedef struct { | ||||
| +	tTHX    owner;
 | ||||
|  	GDBM_FILE 	dbp ; | ||||
|  	SV *    filter[4]; | ||||
|  	int     filtering ; | ||||
| @@ -98,6 +99,7 @@ gdbm_TIEHASH(dbtype, name, read_write, m
 | ||||
|  	} | ||||
|  	if (dbp) { | ||||
|  	    RETVAL = (GDBM_File)safecalloc(1, sizeof(GDBM_File_type)); | ||||
| +	    RETVAL->owner = aTHX;
 | ||||
|  	    RETVAL->dbp = dbp; | ||||
|  	} else { | ||||
|  	    RETVAL = NULL; | ||||
| @@ -118,12 +120,14 @@ gdbm_DESTROY(db)
 | ||||
|  	PREINIT: | ||||
|  	int i = store_value; | ||||
|  	CODE: | ||||
| -	gdbm_close(db);
 | ||||
| -	do {
 | ||||
| -	    if (db->filter[i])
 | ||||
| -		SvREFCNT_dec(db->filter[i]);
 | ||||
| -	} while (i-- > 0);
 | ||||
| -	safefree(db);
 | ||||
| +	if (db && db->owner == aTHX) {
 | ||||
| +	    gdbm_close(db);
 | ||||
| +	    do {
 | ||||
| +		if (db->filter[i])
 | ||||
| +		    SvREFCNT_dec(db->filter[i]);
 | ||||
| +	    } while (i-- > 0);
 | ||||
| +	    safefree(db);
 | ||||
| +	}
 | ||||
|   | ||||
|  #define gdbm_FETCH(db,key)			gdbm_fetch(db->dbp,key) | ||||
|  datum_value | ||||
| diff --git a/ext/NDBM_File/NDBM_File.xs b/ext/NDBM_File/NDBM_File.xs
 | ||||
| index 52e60fc..af223e5 100644
 | ||||
| --- a/ext/NDBM_File/NDBM_File.xs
 | ||||
| +++ b/ext/NDBM_File/NDBM_File.xs
 | ||||
| @@ -33,6 +33,7 @@ END_EXTERN_C
 | ||||
|  #define store_value 3 | ||||
|   | ||||
|  typedef struct { | ||||
| +	tTHX    owner;
 | ||||
|  	DBM * 	dbp ; | ||||
|  	SV *    filter[4]; | ||||
|  	int     filtering ; | ||||
| @@ -71,6 +72,7 @@ ndbm_TIEHASH(dbtype, filename, flags, mode)
 | ||||
|  	    RETVAL = NULL ; | ||||
|  	    if ((dbp =  dbm_open(filename, flags, mode))) { | ||||
|  	        RETVAL = (NDBM_File)safecalloc(1, sizeof(NDBM_File_type)); | ||||
| +		RETVAL->owner = aTHX;
 | ||||
|  		RETVAL->dbp = dbp ; | ||||
|  	    } | ||||
|  	     | ||||
| @@ -84,12 +86,14 @@ ndbm_DESTROY(db)
 | ||||
|  	PREINIT: | ||||
|  	int i = store_value; | ||||
|  	CODE: | ||||
| -	dbm_close(db->dbp);
 | ||||
| -	do {
 | ||||
| -	    if (db->filter[i])
 | ||||
| -		SvREFCNT_dec(db->filter[i]);
 | ||||
| -	} while (i-- > 0);
 | ||||
| -	safefree(db);
 | ||||
| +	if (db && db->owner == aTHX) {
 | ||||
| +	    dbm_close(db->dbp);
 | ||||
| +	    do {
 | ||||
| +		if (db->filter[i])
 | ||||
| +		    SvREFCNT_dec(db->filter[i]);
 | ||||
| +	    } while (i-- > 0);
 | ||||
| +	    safefree(db);
 | ||||
| +	}
 | ||||
|   | ||||
|  #define ndbm_FETCH(db,key)			dbm_fetch(db->dbp,key) | ||||
|  datum_value | ||||
| diff --git a/ext/ODBM_File/ODBM_File.xs b/ext/ODBM_File/ODBM_File.xs
 | ||||
| index d1ece7f..f7e00a0 100644
 | ||||
| --- a/ext/ODBM_File/ODBM_File.xs
 | ||||
| +++ b/ext/ODBM_File/ODBM_File.xs
 | ||||
| @@ -49,6 +49,7 @@ datum	nextkey(datum key);
 | ||||
|  #define store_value 3 | ||||
|   | ||||
|  typedef struct { | ||||
| +	tTHX    owner;
 | ||||
|  	void * 	dbp ; | ||||
|  	SV *    filter[4]; | ||||
|  	int     filtering ; | ||||
| @@ -137,6 +138,7 @@ odbm_TIEHASH(dbtype, filename, flags, mode)
 | ||||
|  	    } | ||||
|  	    dbp = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0); | ||||
|  	    RETVAL = (ODBM_File)safecalloc(1, sizeof(ODBM_File_type)); | ||||
| +	    RETVAL->owner = aTHX;
 | ||||
|  	    RETVAL->dbp = dbp ; | ||||
|  	} | ||||
|  	OUTPUT: | ||||
| @@ -149,13 +151,15 @@ DESTROY(db)
 | ||||
|  	dMY_CXT; | ||||
|  	int i = store_value; | ||||
|  	CODE: | ||||
| -	dbmrefcnt--;
 | ||||
| -	dbmclose();
 | ||||
| -	do {
 | ||||
| -	    if (db->filter[i])
 | ||||
| -		SvREFCNT_dec(db->filter[i]);
 | ||||
| -	} while (i-- > 0);
 | ||||
| -	safefree(db);
 | ||||
| +	if (db && db->owner == aTHX) {
 | ||||
| +	    dbmrefcnt--;
 | ||||
| +	    dbmclose();
 | ||||
| +	    do {
 | ||||
| +		if (db->filter[i])
 | ||||
| +		    SvREFCNT_dec(db->filter[i]);
 | ||||
| +	    } while (i-- > 0);
 | ||||
| +	    safefree(db);
 | ||||
| +	}
 | ||||
|   | ||||
|  datum_value | ||||
|  odbm_FETCH(db, key) | ||||
| diff --git a/ext/SDBM_File/SDBM_File.xs b/ext/SDBM_File/SDBM_File.xs
 | ||||
| index 291e41b..0bdae9a 100644
 | ||||
| --- a/ext/SDBM_File/SDBM_File.xs
 | ||||
| +++ b/ext/SDBM_File/SDBM_File.xs
 | ||||
| @@ -10,6 +10,7 @@
 | ||||
|  #define store_value 3 | ||||
|   | ||||
|  typedef struct { | ||||
| +	tTHX    owner;
 | ||||
|  	DBM * 	dbp ; | ||||
|  	SV *    filter[4]; | ||||
|  	int     filtering ; | ||||
| @@ -51,6 +52,7 @@ sdbm_TIEHASH(dbtype, filename, flags, mode)
 | ||||
|  	    } | ||||
|  	    if (dbp) { | ||||
|  	        RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type)); | ||||
| +		RETVAL->owner = aTHX;
 | ||||
|  		RETVAL->dbp = dbp ; | ||||
|  	    } | ||||
|  	     | ||||
| @@ -62,7 +64,7 @@ void
 | ||||
|  sdbm_DESTROY(db) | ||||
|  	SDBM_File	db | ||||
|  	CODE: | ||||
| -	if (db) {
 | ||||
| +	if (db && db->owner == aTHX) {
 | ||||
|  	    int i = store_value; | ||||
|  	    sdbm_close(db->dbp); | ||||
|  	    do { | ||||
| diff --git a/t/lib/dbmt_common.pl b/t/lib/dbmt_common.pl
 | ||||
| index 5d4098c..a0a4d52 100644
 | ||||
| --- a/t/lib/dbmt_common.pl
 | ||||
| +++ b/t/lib/dbmt_common.pl
 | ||||
| @@ -510,5 +510,40 @@ unlink <Op_dbmx*>, $Dfile;
 | ||||
|     unlink <Op1_dbmx*>; | ||||
|  } | ||||
|   | ||||
| +{
 | ||||
| +   # Check DBM back-ends do not destroy objects from then-spawned threads.
 | ||||
| +   # RT#61912.
 | ||||
| +   SKIP: {
 | ||||
| +      my $threads_count = 2;
 | ||||
| +      skip 'Threads are disabled', 3 + 2 * $threads_count
 | ||||
| +        unless $Config{usethreads};
 | ||||
| +      use_ok('threads');
 | ||||
| +
 | ||||
| +      my %h;
 | ||||
| +      unlink <Op1_dbmx*>;
 | ||||
| +
 | ||||
| +      my $db = tie %h, $DBM_Class, 'Op1_dbmx', $create, 0640;
 | ||||
| +      isa_ok($db, $DBM_Class);
 | ||||
| +
 | ||||
| +      for (1 .. 2) {
 | ||||
| +         ok(threads->create(
 | ||||
| +            sub {
 | ||||
| +               $SIG{'__WARN__'} = sub { fail(shift) }; # debugging perl panics
 | ||||
| +                        # report it by spurious TAP line
 | ||||
| +               1;
 | ||||
| +            }), "Thread $_ created");
 | ||||
| +      }
 | ||||
| +      for (threads->list) {
 | ||||
| +         is($_->join, 1, "A thread exited successfully");
 | ||||
| +      }
 | ||||
| +
 | ||||
| +      pass("Tied object survived exiting threads");
 | ||||
| +
 | ||||
| +      undef $db;
 | ||||
| +      untie %h;
 | ||||
| +      unlink <Op1_dbmx*>;
 | ||||
| +   }
 | ||||
| +}
 | ||||
| +
 | ||||
|  done_testing(); | ||||
|  1; | ||||
| -- 
 | ||||
| 1.9.3 | ||||
| 
 | ||||
| @ -0,0 +1,61 @@ | ||||
| From 9644657c4 10326749fd321d9c24944ec25afad2f Mon Sep 17 00:00:00 2001 | ||||
| From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com> | ||||
| Date: Thu, 20 Jun 2013 15:22:53 +0200 | ||||
| Subject: [PATCH] Install libperl.so to shrpdir on Linux | ||||
| MIME-Version: 1.0 | ||||
| Content-Type: text/plain; charset=UTF-8 | ||||
| Content-Transfer-Encoding: 8bit | ||||
| 
 | ||||
| Signed-off-by: Petr Písař <ppisar@redhat.com> | ||||
| ---
 | ||||
|  Configure   | 7 ++++--- | ||||
|  Makefile.SH | 2 +- | ||||
|  2 files changed, 5 insertions(+), 4 deletions(-) | ||||
| 
 | ||||
| diff --git a/Configure b/Configure
 | ||||
| index 2f30261..825496e 100755
 | ||||
| --- a/Configure
 | ||||
| +++ b/Configure
 | ||||
| @@ -8762,7 +8762,9 @@ esac
 | ||||
|   | ||||
|  # Detect old use of shrpdir via undocumented Configure -Dshrpdir | ||||
|  case "$shrpdir" in | ||||
| -'') ;;
 | ||||
| +'') 
 | ||||
| +shrpdir=$archlibexp/CORE
 | ||||
| +;;
 | ||||
|  *)	$cat >&4 <<EOM | ||||
|  WARNING:  Use of the shrpdir variable for the installation location of | ||||
|  the shared $libperl is not supported.  It was never documented and | ||||
| @@ -8792,7 +8794,6 @@ esac
 | ||||
|  # Add $xxx to ccdlflags. | ||||
|  # If we can't figure out a command-line option, use $shrpenv to | ||||
|  # set env LD_RUN_PATH.  The main perl makefile uses this. | ||||
| -shrpdir=$archlibexp/CORE
 | ||||
|  xxx='' | ||||
|  tmp_shrpenv='' | ||||
|  if "$useshrplib"; then | ||||
| @@ -8807,7 +8808,7 @@ if "$useshrplib"; then
 | ||||
|  		xxx="-Wl,-R$shrpdir" | ||||
|  		;; | ||||
|  	bsdos|linux|irix*|dec_osf|gnu*|haiku) | ||||
| -		xxx="-Wl,-rpath,$shrpdir"
 | ||||
| +		# We want standard path
 | ||||
|  		;; | ||||
|  	hpux*) | ||||
|  		# hpux doesn't like the default, either. | ||||
| diff --git a/Makefile.SH b/Makefile.SH
 | ||||
| index 7733a32..a481183 100755
 | ||||
| --- a/Makefile.SH
 | ||||
| +++ b/Makefile.SH
 | ||||
| @@ -288,7 +288,7 @@ ranlib = $ranlib
 | ||||
|  # installman commandline. | ||||
|  bin = $installbin | ||||
|  scriptdir = $scriptdir | ||||
| -shrpdir = $archlibexp/CORE
 | ||||
| +shrpdir = $shrpdir
 | ||||
|  privlib = $installprivlib | ||||
|  man1dir = $man1dir | ||||
|  man1ext = $man1ext | ||||
| -- 
 | ||||
| 1.8.1.4 | ||||
| @ -0,0 +1,110 @@ | ||||
| From 9575301256f67116eccdbb99b38fc804ba3dcf53 Mon Sep 17 00:00:00 2001 | ||||
| From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com> | ||||
| Date: Mon, 18 Apr 2016 16:24:03 +0200 | ||||
| Subject: [PATCH] Provide ExtUtils::MM methods as standalone | ||||
|  ExtUtils::MM::Utils | ||||
| MIME-Version: 1.0 | ||||
| Content-Type: text/plain; charset=UTF-8 | ||||
| Content-Transfer-Encoding: 8bit | ||||
| 
 | ||||
| If you cannot afford depending on ExtUtils::MakeMaker, you can | ||||
| depend on ExtUtils::MM::Utils instead. | ||||
| 
 | ||||
| <https://bugzilla.redhat.com/show_bug.cgi?id=1129443> | ||||
| 
 | ||||
| Signed-off-by: Petr Písař <ppisar@redhat.com> | ||||
| ---
 | ||||
|  MANIFEST                                         |  1 + | ||||
|  cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM/Utils.pm | 68 ++++++++++++++++++++++++ | ||||
|  2 files changed, 69 insertions(+) | ||||
|  create mode 100644 cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM/Utils.pm | ||||
| 
 | ||||
| diff --git a/MANIFEST b/MANIFEST
 | ||||
| index 6af238c..d4f0c56 100644
 | ||||
| --- a/MANIFEST
 | ||||
| +++ b/MANIFEST
 | ||||
| @@ -784,6 +784,7 @@ cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm			MakeMaker methods for OS/2
 | ||||
|  cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm			MakeMaker methods for OS/2 | ||||
|  cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm			MakeMaker methods for QNX | ||||
|  cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm			MakeMaker methods for Unix | ||||
| +cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM/Utils.pm		Independed MM methods
 | ||||
|  cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_UWIN.pm			MakeMaker methods for U/WIN | ||||
|  cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm			MakeMaker methods for VMS | ||||
|  cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VOS.pm			MakeMaker methods for VOS | ||||
| diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM/Utils.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM/Utils.pm
 | ||||
| new file mode 100644 | ||||
| index 0000000..6bbc0d8
 | ||||
| --- /dev/null
 | ||||
| +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM/Utils.pm
 | ||||
| @@ -0,0 +1,68 @@
 | ||||
| +package ExtUtils::MM::Utils;
 | ||||
| +
 | ||||
| +require 5.006;
 | ||||
| +
 | ||||
| +use strict;
 | ||||
| +use vars qw($VERSION);
 | ||||
| +$VERSION = '7.11_06';
 | ||||
| +$VERSION = eval $VERSION;  ## no critic [BuiltinFunctions::ProhibitStringyEval]
 | ||||
| +
 | ||||
| +=head1 NAME
 | ||||
| +
 | ||||
| +ExtUtils::MM::Utils - ExtUtils::MM methods without dependency on ExtUtils::MakeMaker
 | ||||
| +
 | ||||
| +=head1 SYNOPSIS
 | ||||
| +
 | ||||
| +    require ExtUtils::MM::Utils;
 | ||||
| +    MM->maybe_command($file);
 | ||||
| +
 | ||||
| +=head1 DESCRIPTION
 | ||||
| +
 | ||||
| +This is a collection of L<ExtUtils::MM> subroutines that are used by many
 | ||||
| +other modules but that do not need full-featured L<ExtUtils::MakeMaker>. The
 | ||||
| +issue with L<ExtUtils::MakeMaker> is it pulls in Perl header files and that is
 | ||||
| +an overkill for small subroutines.
 | ||||
| +
 | ||||
| +An example is the L<IPC::Cmd> that caused installing GCC just because of
 | ||||
| +three-line I<maybe_command()> from L<ExtUtils::MM_Unix>.
 | ||||
| +
 | ||||
| +The intentions is to use L<ExtUtils::MM::Utils> instead of
 | ||||
| +L<ExtUtils::MakeMaker> for these trivial methods. You can still call them via
 | ||||
| +L<MM> class name.
 | ||||
| +
 | ||||
| +=head1 METHODS
 | ||||
| +
 | ||||
| +=over 4
 | ||||
| +
 | ||||
| +=item maybe_command
 | ||||
| +
 | ||||
| +Returns true, if the argument is likely to be a command.
 | ||||
| +
 | ||||
| +=cut
 | ||||
| +
 | ||||
| +if (!exists $INC{'ExtUtils/MM.pm'}) {
 | ||||
| +    *MM::maybe_command = *ExtUtils::MM::maybe_command = \&maybe_command;
 | ||||
| +}
 | ||||
| +
 | ||||
| +sub maybe_command {
 | ||||
| +    my($self,$file) = @_;
 | ||||
| +    return $file if -x $file && ! -d $file;
 | ||||
| +    return;
 | ||||
| +}
 | ||||
| +
 | ||||
| +1;
 | ||||
| +
 | ||||
| +=back
 | ||||
| +
 | ||||
| +=head1 BUGS
 | ||||
| +
 | ||||
| +These methods are copied from L<ExtUtils::MM_Unix>. Other operating systems
 | ||||
| +are not supported yet. The reason is this
 | ||||
| +L<a hack for Linux
 | ||||
| +distributions|https://bugzilla.redhat.com/show_bug.cgi?id=1129443>.
 | ||||
| +
 | ||||
| +=head1 SEE ALSO
 | ||||
| +
 | ||||
| +L<ExtUtils::MakeMaker>, L<ExtUtils::MM>
 | ||||
| +
 | ||||
| +=cut
 | ||||
| -- 
 | ||||
| 2.5.5 | ||||
| 
 | ||||
| @ -0,0 +1,34 @@ | ||||
| From 216ddd39adb0043930acad70ff242c30a1b0c6cf Mon Sep 17 00:00:00 2001 | ||||
| From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com> | ||||
| Date: Mon, 18 Apr 2016 16:39:32 +0200 | ||||
| Subject: [PATCH] Replace EU::MM dependnecy with EU::MM::Utils in IPC::Cmd | ||||
| MIME-Version: 1.0 | ||||
| Content-Type: text/plain; charset=UTF-8 | ||||
| Content-Transfer-Encoding: 8bit | ||||
| 
 | ||||
| This allows to free from a run-time dependency on fat | ||||
| ExtUtils::MakeMaker. | ||||
| 
 | ||||
| <https://bugzilla.redhat.com/show_bug.cgi?id=1129443> | ||||
| 
 | ||||
| Signed-off-by: Petr Písař <ppisar@redhat.com> | ||||
| ---
 | ||||
|  cpan/IPC-Cmd/lib/IPC/Cmd.pm | 2 +- | ||||
|  1 file changed, 1 insertion(+), 1 deletion(-) | ||||
| 
 | ||||
| diff --git a/cpan/IPC-Cmd/lib/IPC/Cmd.pm b/cpan/IPC-Cmd/lib/IPC/Cmd.pm
 | ||||
| index 6a82bdf..b6cd7ef 100644
 | ||||
| --- a/cpan/IPC-Cmd/lib/IPC/Cmd.pm
 | ||||
| +++ b/cpan/IPC-Cmd/lib/IPC/Cmd.pm
 | ||||
| @@ -232,7 +232,7 @@ sub can_run {
 | ||||
|      } | ||||
|   | ||||
|      require File::Spec; | ||||
| -    require ExtUtils::MakeMaker;
 | ||||
| +    require ExtUtils::MM::Utils;
 | ||||
|   | ||||
|      my @possibles; | ||||
|   | ||||
| -- 
 | ||||
| 2.5.5 | ||||
| 
 | ||||
| @ -0,0 +1,61 @@ | ||||
| From f6bc8fb3d26892ba1a84ba2df76beedd51998dd2 Mon Sep 17 00:00:00 2001 | ||||
| From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com> | ||||
| Date: Mon, 29 Jan 2018 16:34:17 +0100 | ||||
| Subject: [PATCH] hints/linux: Add -lphtread to lddlflags | ||||
| MIME-Version: 1.0 | ||||
| Content-Type: text/plain; charset=UTF-8 | ||||
| Content-Transfer-Encoding: 8bit | ||||
| 
 | ||||
| Passing -z defs to linker flags causes perl to fail to build if threads are | ||||
| enabled: | ||||
| 
 | ||||
| gcc  -shared -Wl,-z,relro -Wl,-z,defs -specs=/usr/lib/rpm/redhat/redhat-hardened-ld -L/usr/local/lib -fstack-protector-strong Bzip2.o  -o ../../lib/auto/Compress/Raw/Bzip2/Bzip2.so  \ | ||||
|    -L/usr/lib64 -lbz2 "-L../.." -lperl   \ | ||||
| 
 | ||||
| Bzip2.o: In function `deRef': | ||||
| /builddir/build/BUILD/perl-5.26.1/cpan/Compress-Raw-Bzip2/Bzip2.xs:256: undefined reference to `pthread_getspecific' | ||||
| 
 | ||||
| The reason is Bzip2.xs calls dTHX macro included from thread.h via perl.h that | ||||
| expands to pthread_getspecific() function call that is defined in pthread | ||||
| library. But the pthread library is not explicitly linked to Bzip.so (see the | ||||
| gcc command). This is exactly what -z defs linker flag enforces. | ||||
| 
 | ||||
| Underlinking ELFs can be dangerous because in case of versioned | ||||
| symbols it can cause run-time binding to an improper version symbol or | ||||
| even to an symbold from different library. | ||||
| 
 | ||||
| This patch fixes hints for Linux by adding -lpthreads to lddlflags. It | ||||
| also adds -shared there because Configure.sh adds it only hints return | ||||
| lddlflags empty. | ||||
| 
 | ||||
| <https://lists.fedoraproject.org/archives/list/devel@lists.fedoraproject.org/message/3RHZEHLRUHJFF2XGHI5RB6YPDNLDR4HG/> | ||||
| 
 | ||||
| Signed-off-by: Petr Písař <ppisar@redhat.com> | ||||
| ---
 | ||||
|  hints/linux.sh | 4 ++++ | ||||
|  1 file changed, 4 insertions(+) | ||||
| 
 | ||||
| diff --git a/hints/linux.sh b/hints/linux.sh
 | ||||
| index 3f38ea07f1..9ec3bc02ef 100644
 | ||||
| --- a/hints/linux.sh
 | ||||
| +++ b/hints/linux.sh
 | ||||
| @@ -353,12 +353,16 @@ if [ -f /etc/synoinfo.conf -a -d /usr/syno ]; then
 | ||||
|      echo "$libswanted" >&4 | ||||
|  fi | ||||
|   | ||||
| +# Flags needed to produce shared libraries.
 | ||||
| +lddlflags='-shared'
 | ||||
| +
 | ||||
|  # This script UU/usethreads.cbu will get 'called-back' by Configure | ||||
|  # after it has prompted the user for whether to use threads. | ||||
|  cat > UU/usethreads.cbu <<'EOCBU' | ||||
|  case "$usethreads" in | ||||
|  $define|true|[yY]*) | ||||
|          ccflags="-D_REENTRANT -D_GNU_SOURCE $ccflags" | ||||
| +        lddlflags="-lpthread $lddlflags"
 | ||||
|          if echo $libswanted | grep -v pthread >/dev/null | ||||
|          then | ||||
|              set `echo X "$libswanted "| sed -e 's/ c / pthread c /'` | ||||
| -- 
 | ||||
| 2.13.6 | ||||
| 
 | ||||
							
								
								
									
										63
									
								
								SOURCES/perl-5.28.0-Pass-CFLAGS-to-dtrace.patch
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										63
									
								
								SOURCES/perl-5.28.0-Pass-CFLAGS-to-dtrace.patch
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,63 @@ | ||||
| Subject: [PATCH] Pass CFLAGS to dtrace | ||||
| 
 | ||||
| Signed-off-by: Petr PĂsaĹ <ppisar@redhat.com> | ||||
| ---
 | ||||
|  Makefile.SH | 8 +++++--- | ||||
|  cflags.SH   | 5 ++++- | ||||
|  2 files changed, 9 insertions(+), 4 deletions(-) | ||||
| 
 | ||||
| diff --git a/Makefile.SH b/Makefile.SH
 | ||||
| index 5fc6d1c..e89ad70 100755
 | ||||
| --- a/Makefile.SH
 | ||||
| +++ b/Makefile.SH
 | ||||
| @@ -462,6 +462,8 @@ CCCMD    = sh $(shellflags) cflags "optimize='$(OPTIMIZE)'" $@
 | ||||
|   | ||||
|  CCCMDSRC = sh $(shellflags) cflags "optimize='$(OPTIMIZE)'" $< | ||||
|   | ||||
| +DTRACEFLAGS = sh $(shellflags) cflags "optimize='$(OPTIMIZE)'" $@
 | ||||
| +
 | ||||
|  CONFIGPM_FROM_CONFIG_SH = lib/Config.pm lib/Config_heavy.pl | ||||
|  CONFIGPM = $(CONFIGPM_FROM_CONFIG_SH) lib/Config_git.pl | ||||
|   | ||||
| @@ -895,19 +897,19 @@ $(DTRACE_MINI_O): perldtrace.d $(miniperl_objs_nodt)
 | ||||
|  	-rm -rf mpdtrace | ||||
|  	mkdir mpdtrace | ||||
|  	cp $(miniperl_objs_nodt) mpdtrace/ | ||||
| -	$(DTRACE) -G -s perldtrace.d -o $(DTRACE_MINI_O) $(miniperl_dtrace_objs)
 | ||||
| +	CFLAGS="`$(DTRACEFLAGS)`" $(DTRACE) -G -s perldtrace.d -o $(DTRACE_MINI_O) $(miniperl_dtrace_objs)
 | ||||
|   | ||||
|  $(DTRACE_PERLLIB_O): perldtrace.d $(perllib_objs_nodt) | ||||
|  	-rm -rf libpdtrace | ||||
|  	mkdir libpdtrace | ||||
|  	cp $(perllib_objs_nodt) libpdtrace/ | ||||
| -	$(DTRACE) -G -s perldtrace.d -o $(DTRACE_PERLLIB_O) $(perllib_dtrace_objs)
 | ||||
| +	CFLAGS="`$(DTRACEFLAGS)`" $(DTRACE) -G -s perldtrace.d -o $(DTRACE_PERLLIB_O) $(perllib_dtrace_objs)
 | ||||
|   | ||||
|  $(DTRACE_MAIN_O): perldtrace.d perlmain$(OBJ_EXT) | ||||
|  	-rm -rf maindtrace | ||||
|  	mkdir maindtrace | ||||
|  	cp perlmain$(OBJ_EXT) maindtrace/ | ||||
| -	$(DTRACE) -G -s perldtrace.d -o $(DTRACE_MAIN_O) $(perlmain_dtrace_objs) ||	      \
 | ||||
| +	CFLAGS="`$(DTRACEFLAGS)`" $(DTRACE) -G -s perldtrace.d -o $(DTRACE_MAIN_O) $(perlmain_dtrace_objs) ||	      \
 | ||||
|  	  ( $(ECHO) "No probes in perlmain$(OBJ_EXT), generating a dummy $(DTRACE_MAIN_O)" && \ | ||||
|  	    $(ECHO) >dtrace_main.c &&							      \ | ||||
|  	    `$(CCCMD)` $(PLDLFLAGS) dtrace_main.c &&					      \ | ||||
| diff --git a/cflags.SH b/cflags.SH
 | ||||
| index 3af1e97..b845127 100755
 | ||||
| --- a/cflags.SH
 | ||||
| +++ b/cflags.SH
 | ||||
| @@ -519,7 +519,10 @@ for file do
 | ||||
|      toke) optimize=-O0 ;; | ||||
|      esac | ||||
|   | ||||
| -    echo "$cc -c -DPERL_CORE $ccflags $stdflags $optimize $warn $extra"
 | ||||
| +    case "$file" in
 | ||||
| +    dtrace_*) echo "$ccflags $stdflags $optimize $warn $extra";;
 | ||||
| +    *) echo "$cc -c -DPERL_CORE $ccflags $stdflags $optimize $warn $extra";;
 | ||||
| +    esac
 | ||||
|   | ||||
|      . $TOP/config.sh | ||||
|   | ||||
| -- 
 | ||||
| 2.17.1 | ||||
| 
 | ||||
							
								
								
									
										175
									
								
								SOURCES/perl-5.32.0-Add-av_count.patch
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										175
									
								
								SOURCES/perl-5.32.0-Add-av_count.patch
									
									
									
									
									
										Normal file
									
								
							| @ -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 | ||||
| 
 | ||||
							
								
								
									
										34
									
								
								SOURCES/perl-5.32.1-DynaLoader-use-PerlEnv_getenv.patch
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										34
									
								
								SOURCES/perl-5.32.1-DynaLoader-use-PerlEnv_getenv.patch
									
									
									
									
									
										Normal file
									
								
							| @ -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 | ||||
| 
 | ||||
							
								
								
									
										44
									
								
								SOURCES/perl-5.32.1-Perl_do_sv_dump-handle-PL_strtab.patch
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										44
									
								
								SOURCES/perl-5.32.1-Perl_do_sv_dump-handle-PL_strtab.patch
									
									
									
									
									
										Normal file
									
								
							| @ -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 | ||||
| 
 | ||||
							
								
								
									
										193
									
								
								SOURCES/perl-5.33.0-fix-C-i-obj-where-obj-is-a-lexical.patch
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										193
									
								
								SOURCES/perl-5.33.0-fix-C-i-obj-where-obj-is-a-lexical.patch
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,193 @@ | ||||
| From b334474a337421c6643b872388245fb2c11bf995 Mon Sep 17 00:00:00 2001 | ||||
| From: Tony Cook <tony@develop-help.com> | ||||
| Date: Mon, 30 Mar 2020 16:32:46 +1100 | ||||
| Subject: [PATCH] fix C<i $obj> where $obj is a lexical | ||||
| MIME-Version: 1.0 | ||||
| Content-Type: text/plain; charset=UTF-8 | ||||
| Content-Transfer-Encoding: 8bit | ||||
| 
 | ||||
| the DB::eval function depends on the special behaviour of eval "" | ||||
| within the DB package, which evaluates the string within the context | ||||
| of the first non-DB sub or eval scope, working up the call stack. | ||||
| 
 | ||||
| The debugger refactor moved handling for the 'i' command from the | ||||
| DB package to the DB::Obj package, so the eval in DB::eval was | ||||
| working in the context of the DB::Obj::cmd_i function, not in the | ||||
| calling scope. | ||||
| 
 | ||||
| Fixed by moving the handling for the i command back to DB. | ||||
| 
 | ||||
| Fixes #17661. | ||||
| 
 | ||||
| Signed-off-by: Petr Písař <ppisar@redhat.com> | ||||
| ---
 | ||||
|  MANIFEST               |  1 + | ||||
|  lib/perl5db.pl         | 65 +++++++++++++++++++++--------------------- | ||||
|  lib/perl5db.t          | 20 +++++++++++++ | ||||
|  lib/perl5db/t/gh-17661 | 14 +++++++++ | ||||
|  4 files changed, 68 insertions(+), 32 deletions(-) | ||||
|  create mode 100644 lib/perl5db/t/gh-17661 | ||||
| 
 | ||||
| diff --git a/MANIFEST b/MANIFEST
 | ||||
| index 8c71995174..96af3618bd 100644
 | ||||
| --- a/MANIFEST
 | ||||
| +++ b/MANIFEST
 | ||||
| @@ -4808,6 +4808,7 @@ lib/perl5db/t/eval-line-bug	Tests for the Perl debugger
 | ||||
|  lib/perl5db/t/fact		Tests for the Perl debugger | ||||
|  lib/perl5db/t/filename-line-breakpoint		Tests for the Perl debugger | ||||
|  lib/perl5db/t/gh-17660		Tests for the Perl debugger | ||||
| +lib/perl5db/t/gh-17661		Tests for the Perl debugger
 | ||||
|  lib/perl5db/t/load-modules	Tests for the Perl debugger | ||||
|  lib/perl5db/t/lsub-n		Test script used by perl5db.t | ||||
|  lib/perl5db/t/lvalue-bug	Tests for the Perl debugger | ||||
| diff --git a/lib/perl5db.pl b/lib/perl5db.pl
 | ||||
| index 96e56d559f..b647d24fb8 100644
 | ||||
| --- a/lib/perl5db.pl
 | ||||
| +++ b/lib/perl5db.pl
 | ||||
| @@ -2512,6 +2512,37 @@ EOP
 | ||||
|      return; | ||||
|  } | ||||
|   | ||||
| +=head3 C<_DB__handle_i_command> - inheritance display
 | ||||
| +
 | ||||
| +Display the (nested) parentage of the module or object given.
 | ||||
| +
 | ||||
| +=cut
 | ||||
| +
 | ||||
| +sub _DB__handle_i_command {
 | ||||
| +    my $self = shift;
 | ||||
| +
 | ||||
| +    my $line = $self->cmd_args;
 | ||||
| +    require mro;
 | ||||
| +    foreach my $isa ( split( /\s+/, $line ) ) {
 | ||||
| +        $evalarg = "$isa";
 | ||||
| +        # The &-call is here to ascertain the mutability of @_.
 | ||||
| +        ($isa) = &DB::eval;
 | ||||
| +        no strict 'refs';
 | ||||
| +        print join(
 | ||||
| +            ', ',
 | ||||
| +            map {
 | ||||
| +                "$_"
 | ||||
| +                  . (
 | ||||
| +                    defined( ${"$_\::VERSION"} )
 | ||||
| +                    ? ' ' . ${"$_\::VERSION"}
 | ||||
| +                    : undef )
 | ||||
| +              } @{mro::get_linear_isa(ref($isa) || $isa)}
 | ||||
| +        );
 | ||||
| +        print "\n";
 | ||||
| +    }
 | ||||
| +    next CMD;
 | ||||
| +}
 | ||||
| +
 | ||||
|  # 't' is type. | ||||
|  # 'm' is method. | ||||
|  # 'v' is the value (i.e: method name or subroutine ref). | ||||
| @@ -2531,6 +2562,7 @@ BEGIN
 | ||||
|      'W' => { t => 'm', v => '_handle_W_command', }, | ||||
|      'c' => { t => 's', v => \&_DB__handle_c_command, }, | ||||
|      'f' => { t => 's', v => \&_DB__handle_f_command, }, | ||||
| +    'i' => { t => 's', v => \&_DB__handle_i_command, },
 | ||||
|      'm' => { t => 's', v => \&_DB__handle_m_command, }, | ||||
|      'n' => { t => 'm', v => '_handle_n_command', }, | ||||
|      'p' => { t => 'm', v => '_handle_p_command', }, | ||||
| @@ -2551,7 +2583,7 @@ BEGIN
 | ||||
|          { t => 's', v => \&_DB__handle_restart_and_rerun_commands, }, | ||||
|          } qw(R rerun)), | ||||
|      (map { $_ => {t => 'm', v => '_handle_cmd_wrapper_commands' }, } | ||||
| -        qw(a A b B e E h i l L M o O v w W)),
 | ||||
| +        qw(a A b B e E h l L M o O v w W)),
 | ||||
|  ); | ||||
|  }; | ||||
|   | ||||
| @@ -5468,37 +5500,6 @@ sub cmd_h {
 | ||||
|      } | ||||
|  } ## end sub cmd_h | ||||
|   | ||||
| -=head3 C<cmd_i> - inheritance display
 | ||||
| -
 | ||||
| -Display the (nested) parentage of the module or object given.
 | ||||
| -
 | ||||
| -=cut
 | ||||
| -
 | ||||
| -sub cmd_i {
 | ||||
| -    my $cmd  = shift;
 | ||||
| -    my $line = shift;
 | ||||
| -
 | ||||
| -    require mro;
 | ||||
| -
 | ||||
| -    foreach my $isa ( split( /\s+/, $line ) ) {
 | ||||
| -        $evalarg = $isa;
 | ||||
| -        # The &-call is here to ascertain the mutability of @_.
 | ||||
| -        ($isa) = &DB::eval;
 | ||||
| -        no strict 'refs';
 | ||||
| -        print join(
 | ||||
| -            ', ',
 | ||||
| -            map {
 | ||||
| -                "$_"
 | ||||
| -                  . (
 | ||||
| -                    defined( ${"$_\::VERSION"} )
 | ||||
| -                    ? ' ' . ${"$_\::VERSION"}
 | ||||
| -                    : undef )
 | ||||
| -              } @{mro::get_linear_isa(ref($isa) || $isa)}
 | ||||
| -        );
 | ||||
| -        print "\n";
 | ||||
| -    }
 | ||||
| -} ## end sub cmd_i
 | ||||
| -
 | ||||
|  =head3 C<cmd_l> - list lines (command) | ||||
|   | ||||
|  Most of the command is taken up with transforming all the different line | ||||
| diff --git a/lib/perl5db.t b/lib/perl5db.t
 | ||||
| index 913a301d98..ffa659a215 100644
 | ||||
| --- a/lib/perl5db.t
 | ||||
| +++ b/lib/perl5db.t
 | ||||
| @@ -2946,6 +2946,26 @@ SKIP:
 | ||||
|         ); | ||||
|  } | ||||
|   | ||||
| +{
 | ||||
| +    # gh #17661
 | ||||
| +    my $wrapper = DebugWrap->new(
 | ||||
| +        {
 | ||||
| +            cmds =>
 | ||||
| +            [
 | ||||
| +                'c',
 | ||||
| +                'i $obj',
 | ||||
| +                'q',
 | ||||
| +            ],
 | ||||
| +            prog => '../lib/perl5db/t/gh-17661',
 | ||||
| +        }
 | ||||
| +    );
 | ||||
| +
 | ||||
| +    $wrapper->output_like(
 | ||||
| +        qr/C5, C1, C2, C3, C4/,
 | ||||
| +        q/check for reasonable result/,
 | ||||
| +       );
 | ||||
| +}
 | ||||
| +
 | ||||
|  SKIP: | ||||
|  { | ||||
|      $Config{usethreads} | ||||
| diff --git a/lib/perl5db/t/gh-17661 b/lib/perl5db/t/gh-17661
 | ||||
| new file mode 100644 | ||||
| index 0000000000..0d85977b35
 | ||||
| --- /dev/null
 | ||||
| +++ b/lib/perl5db/t/gh-17661
 | ||||
| @@ -0,0 +1,14 @@
 | ||||
| +use v5.10.0;
 | ||||
| +
 | ||||
| +{ package C1; sub c1 { } our @ISA = qw(C2) }
 | ||||
| +{ package C2; sub c2 { } our @ISA = qw(C3) }
 | ||||
| +{ package C3; sub c3 { } our @ISA = qw(  ) }
 | ||||
| +{ package C4; sub c4 { } our @ISA = qw(  ) }
 | ||||
| +{ package C5; sub c5 { } our @ISA = qw(C1 C4) }
 | ||||
| +
 | ||||
| +my $obj = bless {}, 'C5';
 | ||||
| +$main::global = bless {}, 'C5';
 | ||||
| +
 | ||||
| +$DB::single = 1;
 | ||||
| +
 | ||||
| +say "Done.";
 | ||||
| -- 
 | ||||
| 2.25.4 | ||||
| 
 | ||||
| @ -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 | ||||
| 
 | ||||
							
								
								
									
										46
									
								
								SOURCES/perl-5.33.0-reentr.c-Prevent-infinite-looping.patch
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										46
									
								
								SOURCES/perl-5.33.0-reentr.c-Prevent-infinite-looping.patch
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,46 @@ | ||||
| From 981fbfc16220a15e72457d8ece4e014988746946 Mon Sep 17 00:00:00 2001 | ||||
| From: Karl Williamson <khw@cpan.org> | ||||
| Date: Thu, 12 Mar 2020 12:48:47 -0600 | ||||
| Subject: [PATCH] reentr.c: Prevent infinite looping | ||||
| MIME-Version: 1.0 | ||||
| Content-Type: text/plain; charset=UTF-8 | ||||
| Content-Transfer-Encoding: 8bit | ||||
| 
 | ||||
| This is an easy, though  paranoid hedge to prevent something that should | ||||
| never happen from causing an infinite loop if it were to happen. | ||||
| 
 | ||||
| Signed-off-by: Petr Písař <ppisar@redhat.com> | ||||
| ---
 | ||||
|  reentr.c        | 2 +- | ||||
|  regen/reentr.pl | 2 +- | ||||
|  2 files changed, 2 insertions(+), 2 deletions(-) | ||||
| 
 | ||||
| diff --git a/reentr.c b/reentr.c
 | ||||
| index 8438c8f90f..2429aa2f5d 100644
 | ||||
| --- a/reentr.c
 | ||||
| +++ b/reentr.c
 | ||||
| @@ -36,7 +36,7 @@
 | ||||
|   | ||||
|  #define RenewDouble(data_pointer, size_pointer, type) \ | ||||
|      STMT_START { \ | ||||
| -	const size_t size = *(size_pointer) * 2; \
 | ||||
| +	const size_t size = MAX(*(size_pointer), 1) * 2; \
 | ||||
|  	Renew((data_pointer), (size), type); \ | ||||
|  	*(size_pointer) = size; \ | ||||
|      } STMT_END | ||||
| diff --git a/regen/reentr.pl b/regen/reentr.pl
 | ||||
| index 94721e9dec..ba2e1c8fa6 100644
 | ||||
| --- a/regen/reentr.pl
 | ||||
| +++ b/regen/reentr.pl
 | ||||
| @@ -818,7 +818,7 @@ print $c <<"EOF";
 | ||||
|   | ||||
|  #define RenewDouble(data_pointer, size_pointer, type) \\ | ||||
|      STMT_START { \\ | ||||
| -	const size_t size = *(size_pointer) * 2; \\
 | ||||
| +	const size_t size = MAX(*(size_pointer), 1) * 2; \\
 | ||||
|  	Renew((data_pointer), (size), type); \\ | ||||
|  	*(size_pointer) = size; \\ | ||||
|      } STMT_END | ||||
| -- 
 | ||||
| 2.25.4 | ||||
| 
 | ||||
							
								
								
									
										31
									
								
								SOURCES/perl-5.33.0-sv.h-Wanted-UOK-but-said-IOK.patch
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										31
									
								
								SOURCES/perl-5.33.0-sv.h-Wanted-UOK-but-said-IOK.patch
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,31 @@ | ||||
| From 530e9296a21b673d7e4c2b42f18d0d52d00f35c4 Mon Sep 17 00:00:00 2001 | ||||
| From: Karl Williamson <khw@cpan.org> | ||||
| Date: Sun, 28 Jun 2020 12:03:54 -0600 | ||||
| Subject: [PATCH] sv.h: Wanted UOK, but said IOK | ||||
| MIME-Version: 1.0 | ||||
| Content-Type: text/plain; charset=UTF-8 | ||||
| Content-Transfer-Encoding: 8bit | ||||
| 
 | ||||
| I don't know the consequences of this bug | ||||
| 
 | ||||
| Signed-off-by: Petr Písař <ppisar@redhat.com> | ||||
| ---
 | ||||
|  sv.h | 2 +- | ||||
|  1 file changed, 1 insertion(+), 1 deletion(-) | ||||
| 
 | ||||
| diff --git a/sv.h b/sv.h
 | ||||
| index 2f6431a826..3721b2fb1b 100644
 | ||||
| --- a/sv.h
 | ||||
| +++ b/sv.h
 | ||||
| @@ -1711,7 +1711,7 @@ Like C<sv_catsv> but doesn't process magic.
 | ||||
|  #define SvNV(sv) (SvNOK_nog(sv) ? SvNVX(sv) : sv_2nv(sv)) | ||||
|   | ||||
|  #define SvIV_nomg(sv) (SvIOK(sv) ? SvIVX(sv) : sv_2iv_flags(sv, 0)) | ||||
| -#define SvUV_nomg(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv_flags(sv, 0))
 | ||||
| +#define SvUV_nomg(sv) (SvUOK(sv) ? SvUVX(sv) : sv_2uv_flags(sv, 0))
 | ||||
|  #define SvNV_nomg(sv) (SvNOK(sv) ? SvNVX(sv) : sv_2nv_flags(sv, 0)) | ||||
|   | ||||
|  /* ----*/ | ||||
| -- 
 | ||||
| 2.25.4 | ||||
| 
 | ||||
							
								
								
									
										77
									
								
								SOURCES/perl-5.33.1-sort-return-foo.patch
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										77
									
								
								SOURCES/perl-5.33.1-sort-return-foo.patch
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,77 @@ | ||||
| From 390fe0c0d09aadc66f644e9eee4aa1245221188c Mon Sep 17 00:00:00 2001 | ||||
| From: David Mitchell <davem@iabyn.com> | ||||
| Date: Tue, 25 Aug 2020 13:15:25 +0100 | ||||
| Subject: [PATCH] sort { return foo() } ... | ||||
| MIME-Version: 1.0 | ||||
| Content-Type: text/plain; charset=UTF-8 | ||||
| Content-Transfer-Encoding: 8bit | ||||
| 
 | ||||
| GH #18081 | ||||
| 
 | ||||
| A sub call via return in a sort block was called in void rather than | ||||
| scalar context, causing the comparison result to be discarded. | ||||
| 
 | ||||
| This because when a sort block is called it is not a real function | ||||
| call, even though a sort block can be returned from. Instead, a | ||||
| CXt_NULL is pushed on the context stack. Because this isn't a sub-ish | ||||
| context type (unlike CXt_SUB, CXt_EVAL etc) there is no 'caller sub' | ||||
| on the context stack to be found to retrieve the caller's context | ||||
| (i.e. cx->cx_gimme). | ||||
| 
 | ||||
| This commit fixes it by special-casing Perl_gimme_V(). | ||||
| 
 | ||||
| Ideally at some future point, a new context type, CXt_SORT, should be | ||||
| added. This would be used instead of CXt_NULL when a sort BLOCK is | ||||
| called. Like other sub-ish context types, it would have an old_cxsubix | ||||
| field and PL_curstackinfo->si_cxsubix would point to it. This would | ||||
| eliminate needing special-case handling in places like Perl_gimme_V(). | ||||
| 
 | ||||
| Signed-off-by: Petr Písař <ppisar@redhat.com> | ||||
| ---
 | ||||
|  inline.h    |  2 +- | ||||
|  t/op/sort.t | 12 +++++++++++- | ||||
|  2 files changed, 12 insertions(+), 2 deletions(-) | ||||
| 
 | ||||
| diff --git a/inline.h b/inline.h
 | ||||
| index a8240efb9c..6fbd5abfea 100644
 | ||||
| --- a/inline.h
 | ||||
| +++ b/inline.h
 | ||||
| @@ -2086,7 +2086,7 @@ Perl_gimme_V(pTHX)
 | ||||
|          return gimme; | ||||
|      cxix = PL_curstackinfo->si_cxsubix; | ||||
|      if (cxix < 0) | ||||
| -        return G_VOID;
 | ||||
| +        return PL_curstackinfo->si_type == PERLSI_SORT ? G_SCALAR: G_VOID;
 | ||||
|      assert(cxstack[cxix].blk_gimme & G_WANT); | ||||
|      return (cxstack[cxix].blk_gimme & G_WANT); | ||||
|  } | ||||
| diff --git a/t/op/sort.t b/t/op/sort.t
 | ||||
| index f2e139dff0..8e387fb90d 100644
 | ||||
| --- a/t/op/sort.t
 | ||||
| +++ b/t/op/sort.t
 | ||||
| @@ -7,7 +7,7 @@ BEGIN {
 | ||||
|      set_up_inc('../lib'); | ||||
|  } | ||||
|  use warnings; | ||||
| -plan(tests => 203);
 | ||||
| +plan(tests => 204);
 | ||||
|  use Tie::Array; # we need to test sorting tied arrays | ||||
|   | ||||
|  # these shouldn't hang | ||||
| @@ -1202,3 +1202,13 @@ SKIP:
 | ||||
|      $fillb = undef; | ||||
|      is $act, "01[sortb]2[fillb]"; | ||||
|  } | ||||
| +
 | ||||
| +# GH #18081
 | ||||
| +# sub call via return in sort block was called in void rather than scalar
 | ||||
| +# context
 | ||||
| +
 | ||||
| +{
 | ||||
| +    sub sort18081 { $a + 1 <=> $b + 1 }
 | ||||
| +    my @a = sort { return &sort18081 } 6,1,2;
 | ||||
| +    is "@a", "1 2 6", "GH #18081";
 | ||||
| +}
 | ||||
| -- 
 | ||||
| 2.25.4 | ||||
| 
 | ||||
							
								
								
									
										77
									
								
								SOURCES/perl-5.33.2-Remove-Perl_av_top_index.patch
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										77
									
								
								SOURCES/perl-5.33.2-Remove-Perl_av_top_index.patch
									
									
									
									
									
										Normal file
									
								
							| @ -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 | ||||
| 
 | ||||
							
								
								
									
										31
									
								
								SOURCES/perl-5.33.2-mro.xs-Fix-compiler-warning.patch
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										31
									
								
								SOURCES/perl-5.33.2-mro.xs-Fix-compiler-warning.patch
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,31 @@ | ||||
| From fa353c3d2833fc326233e0eb583753b4d7887a63 Mon Sep 17 00:00:00 2001 | ||||
| From: Karl Williamson <khw@cpan.org> | ||||
| Date: Sun, 4 Oct 2020 11:07:19 -0600 | ||||
| Subject: [PATCH] mro.xs: Fix compiler warning | ||||
| MIME-Version: 1.0 | ||||
| Content-Type: text/plain; charset=UTF-8 | ||||
| Content-Transfer-Encoding: 8bit | ||||
| 
 | ||||
| Fixes GH #18155 | ||||
| 
 | ||||
| Signed-off-by: Petr Písař <ppisar@redhat.com> | ||||
| ---
 | ||||
|  ext/mro/mro.xs | 2 +- | ||||
|  1 file changed, 1 insertion(+), 1 deletion(-) | ||||
| 
 | ||||
| diff --git a/ext/mro/mro.xs b/ext/mro/mro.xs
 | ||||
| index f21216af6e..8ce5844904 100644
 | ||||
| --- a/ext/mro/mro.xs
 | ||||
| +++ b/ext/mro/mro.xs
 | ||||
| @@ -253,7 +253,7 @@ S_mro_get_linear_isa_c3(pTHX_ HV* stash, U32 level)
 | ||||
|                 hierarchy is not C3-incompatible */ | ||||
|              if(!winner) { | ||||
|                  SV *errmsg; | ||||
| -                I32 i;
 | ||||
| +                Size_t i;
 | ||||
|   | ||||
|                  errmsg = newSVpvf( | ||||
|                             "Inconsistent hierarchy during C3 merge of class '%" HEKf "':\n\t" | ||||
| -- 
 | ||||
| 2.25.4 | ||||
| 
 | ||||
| @ -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 | ||||
| 
 | ||||
							
								
								
									
										32
									
								
								SOURCES/perl-5.33.4-locale.c-Fix-typo-in-ifdef.patch
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										32
									
								
								SOURCES/perl-5.33.4-locale.c-Fix-typo-in-ifdef.patch
									
									
									
									
									
										Normal file
									
								
							| @ -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 | ||||
| 
 | ||||
							
								
								
									
										140
									
								
								SOURCES/perl-5.33.5-Fix-buggy-fc-in-Turkish-locale.patch
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										140
									
								
								SOURCES/perl-5.33.5-Fix-buggy-fc-in-Turkish-locale.patch
									
									
									
									
									
										Normal file
									
								
							| @ -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 | ||||
| 
 | ||||
							
								
								
									
										74
									
								
								SOURCES/perl-5.33.7-regcomp.c-Remove-memory-leak.patch
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										74
									
								
								SOURCES/perl-5.33.7-regcomp.c-Remove-memory-leak.patch
									
									
									
									
									
										Normal file
									
								
							| @ -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 | ||||
| 
 | ||||
							
								
								
									
										47
									
								
								SOURCES/perl-5.8.0-libdir64.patch
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										47
									
								
								SOURCES/perl-5.8.0-libdir64.patch
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,47 @@ | ||||
| diff -up perl-5.28.0-RC1/Configure.orig   perl-5.28.0-RC1/Configure
 | ||||
| --- perl-5.28.0-RC1/Configure.orig   2018-05-21 12:44:04.000000000 +0200
 | ||||
| +++ perl-5.28.0-RC1/Configure	2018-05-22 12:21:53.908599933 +0200
 | ||||
| @@ -7269,8 +7269,8 @@ esac'
 | ||||
|  : Reproduce behavior of 5.005 and earlier, maybe drop that in 5.7. | ||||
|  case "$installstyle" in | ||||
|  '')	case "$prefix" in | ||||
| -		*perl*) dflt='lib';;
 | ||||
| -		*) dflt='lib/perl5' ;;
 | ||||
| +		*perl*) dflt='lib64';;
 | ||||
| +		*) dflt='lib64/perl5' ;;
 | ||||
|  	esac | ||||
|  	;; | ||||
|  *)	dflt="$installstyle" ;; | ||||
| @@ -7336,8 +7336,8 @@ esac
 | ||||
|  : /opt/perl/lib/perl5... would be redundant. | ||||
|  : The default "style" setting is made in installstyle.U | ||||
|  case "$installstyle" in | ||||
| -*lib/perl5*) set dflt privlib lib/$package/$version ;;
 | ||||
| -*)	 set dflt privlib lib/$version ;;
 | ||||
| +*lib64/perl5*) set dflt privlib lib64/$package/$version ;;
 | ||||
| +*)	 set dflt privlib lib64/$version ;;
 | ||||
|  esac | ||||
|  eval $prefixit | ||||
|  $cat <<EOM | ||||
| @@ -7584,8 +7584,8 @@ siteprefixexp="$ansexp"
 | ||||
|  prog=`echo $package | $sed 's/-*[0-9.]*$//'` | ||||
|  case "$sitelib" in | ||||
|  '') case "$installstyle" in | ||||
| -	*lib/perl5*) dflt=$siteprefix/lib/$package/site_$prog/$version ;;
 | ||||
| -	*)	 dflt=$siteprefix/lib/site_$prog/$version ;;
 | ||||
| +	*lib64/perl5*) dflt=$siteprefix/lib64/$package/site_$prog/$version ;;
 | ||||
| +	*)	 dflt=$siteprefix/lib64/site_$prog/$version ;;
 | ||||
|  	esac | ||||
|  	;; | ||||
|  *)	dflt="$sitelib" | ||||
| @@ -8001,8 +8001,8 @@ case "$vendorprefix" in
 | ||||
|  	'') | ||||
|  		prog=`echo $package | $sed 's/-*[0-9.]*$//'` | ||||
|  		case "$installstyle" in | ||||
| -		*lib/perl5*) dflt=$vendorprefix/lib/$package/vendor_$prog/$version ;;
 | ||||
| -		*)	     dflt=$vendorprefix/lib/vendor_$prog/$version ;;
 | ||||
| +		*lib64/perl5*) dflt=$vendorprefix/lib64/$package/vendor_$prog/$version ;;
 | ||||
| +		*)	     dflt=$vendorprefix/lib64/vendor_$prog/$version ;;
 | ||||
|  		esac | ||||
|  		;; | ||||
|  	*)	dflt="$vendorlib" | ||||
							
								
								
									
										109
									
								
								SOURCES/perl-USE_MM_LD_RUN_PATH.patch
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										109
									
								
								SOURCES/perl-USE_MM_LD_RUN_PATH.patch
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,109 @@ | ||||
| diff -up perl-5.14.0/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm.usem perl-5.14.0/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm
 | ||||
| --- perl-5.14.0/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm.usem	2011-05-08 05:10:08.000000000 +0200
 | ||||
| +++ perl-5.14.0/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm	2011-05-17 11:14:22.169115984 +0200
 | ||||
| @@ -89,6 +89,11 @@ libraries.  LD_RUN_PATH is a colon separ
 | ||||
|  in LDLOADLIBS. It is passed as an environment variable to the process | ||||
|  that links the shared library. | ||||
|   | ||||
| +Fedora extension: This generation of LD_RUN_PATH is disabled by default.
 | ||||
| +To use the generated LD_RUN_PATH for all links, set the USE_MM_LD_RUN_PATH
 | ||||
| +MakeMaker object attribute / argument, (or set the $USE_MM_LD_RUN_PATH
 | ||||
| +environment variable).
 | ||||
| +
 | ||||
|  =head2 BSLOADLIBS | ||||
|   | ||||
|  List of those libraries that are needed but can be linked in | ||||
| diff -up perl-5.14.0/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm.usem perl-5.14.0/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm
 | ||||
| --- perl-5.14.0/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm.usem	2011-05-08 05:10:08.000000000 +0200
 | ||||
| +++ perl-5.14.0/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm	2011-05-17 13:39:26.912586030 +0200
 | ||||
| @@ -317,7 +317,7 @@ sub full_setup {
 | ||||
|      PERM_DIR PERM_RW PERM_RWX MAGICXS | ||||
|      PL_FILES PM PM_FILTER PMLIBDIRS PMLIBPARENTDIRS POLLUTE | ||||
|      PREREQ_FATAL PREREQ_PM PREREQ_PRINT PRINT_PREREQ PUREPERL_ONLY | ||||
| -    SIGN SKIP TEST_REQUIRES TYPEMAPS UNINST VERSION VERSION_FROM XS
 | ||||
| +    SIGN SKIP TEST_REQUIRES TYPEMAPS UNINST USE_MM_LD_RUN_PATH VERSION VERSION_FROM XS
 | ||||
|      XSBUILD XSMULTI XSOPT XSPROTOARG XS_VERSION | ||||
|      clean depend dist dynamic_lib linkext macro realclean tool_autosplit | ||||
|   | ||||
| @@ -501,7 +501,27 @@ sub new {
 | ||||
|      # PRINT_PREREQ is RedHatism. | ||||
|      if ("@ARGV" =~ /\bPRINT_PREREQ\b/) { | ||||
|          $self->_PRINT_PREREQ; | ||||
| -   }
 | ||||
| +    }
 | ||||
| +
 | ||||
| +    # USE_MM_LD_RUN_PATH - another RedHatism to disable automatic RPATH generation
 | ||||
| +    if ( ( ! $self->{USE_MM_LD_RUN_PATH} )
 | ||||
| +       &&( ("@ARGV" =~ /\bUSE_MM_LD_RUN_PATH(=([01]))?\b/)
 | ||||
| +        ||( exists( $ENV{USE_MM_LD_RUN_PATH} )
 | ||||
| +           &&( $ENV{USE_MM_LD_RUN_PATH} =~ /([01])?$/ )
 | ||||
| +           )
 | ||||
| +        )
 | ||||
| +       )
 | ||||
| +    {
 | ||||
| +       my $v = $1;
 | ||||
| +       if( $v )
 | ||||
| +       {
 | ||||
| +           $v = ($v=~/=([01])$/)[0];
 | ||||
| +       }else
 | ||||
| +       {
 | ||||
| +           $v = 1;
 | ||||
| +       };
 | ||||
| +       $self->{USE_MM_LD_RUN_PATH}=$v;
 | ||||
| +    };
 | ||||
|   | ||||
|      print "MakeMaker (v$VERSION)\n" if $Verbose; | ||||
|      if (-f "MANIFEST" && ! -f "Makefile" && ! $UNDER_CORE){ | ||||
| @@ -2821,6 +2841,40 @@ precedence.  A typemap in the current di
 | ||||
|  precedence, even if it isn't listed in TYPEMAPS.  The default system | ||||
|  typemap has lowest precedence. | ||||
|   | ||||
| +=item USE_MM_LD_RUN_PATH
 | ||||
| +
 | ||||
| +boolean
 | ||||
| +The Fedora perl MakeMaker distribution differs from the standard
 | ||||
| +upstream release in that it disables use of the MakeMaker generated
 | ||||
| +LD_RUN_PATH by default, UNLESS this attribute is specified , or the
 | ||||
| +USE_MM_LD_RUN_PATH environment variable is set during the MakeMaker run.
 | ||||
| +
 | ||||
| +The upstream MakeMaker will set the ld(1) environment variable LD_RUN_PATH
 | ||||
| +to the concatenation of every -L ld(1) option directory in which a -l ld(1)
 | ||||
| +option library is found, which is used as the ld(1) -rpath option if none
 | ||||
| +is specified. This means that, if your application builds shared libraries
 | ||||
| +and your MakeMaker application links to them, that the absolute paths of the
 | ||||
| +libraries in the build tree will be inserted into the RPATH header of all
 | ||||
| +MakeMaker generated binaries, and that such binaries will be unable to link
 | ||||
| +to these libraries if they do not still reside in the build tree directories
 | ||||
| +(unlikely) or in the system library directories (/lib or /usr/lib), regardless
 | ||||
| +of any LD_LIBRARY_PATH setting. So if you specified -L../mylib -lmylib , and
 | ||||
| + your 'libmylib.so' gets installed into /some_directory_other_than_usr_lib,
 | ||||
| + your MakeMaker application will be unable to link to it, even if LD_LIBRARY_PATH
 | ||||
| +is set to include /some_directory_other_than_usr_lib, because RPATH overrides
 | ||||
| +LD_LIBRARY_PATH.
 | ||||
| +
 | ||||
| +So for Fedora MakeMaker builds LD_RUN_PATH is NOT generated by default for
 | ||||
| +every link. You can still use explicit -rpath ld options or the LD_RUN_PATH
 | ||||
| +environment variable during the build to generate an RPATH for the binaries.
 | ||||
| +
 | ||||
| +You can set the USE_MM_LD_RUN_PATH attribute to 1 on the MakeMaker command
 | ||||
| +line or in the WriteMakefile arguments to enable generation of LD_RUN_PATH
 | ||||
| +for every link command.
 | ||||
| +
 | ||||
| +USE_MM_LD_RUN_PATH will default to 1 (LD_RUN_PATH will be used) IF the
 | ||||
| +$USE_MM_LD_RUN_PATH environment variable is set during a MakeMaker run.
 | ||||
| +
 | ||||
|  =item VENDORPREFIX | ||||
|   | ||||
|  Like PERLPREFIX, but only for the vendor install locations. | ||||
| diff -up perl-5.14.0/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm.usem perl-5.14.0/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm
 | ||||
| --- perl-5.14.0/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm.usem	2011-05-08 05:10:08.000000000 +0200
 | ||||
| +++ perl-5.14.0/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm	2011-05-17 11:14:22.172115972 +0200
 | ||||
| @@ -1045,7 +1045,7 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $
 | ||||
|      } | ||||
|   | ||||
|      my $ld_run_path_shell = ""; | ||||
| -    if ($self->{LD_RUN_PATH} ne "") {
 | ||||
| +    if (($self->{LD_RUN_PATH} ne "") && ($self->{USE_MM_LD_RUN_PATH})) {
 | ||||
|          $ld_run_path_shell = 'LD_RUN_PATH="$(LD_RUN_PATH)" '; | ||||
|      } | ||||
|   | ||||
							
								
								
									
										21
									
								
								SOURCES/perl-example.stp
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										21
									
								
								SOURCES/perl-example.stp
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,21 @@ | ||||
| /* | ||||
|     Example of the perl systemtap tapset shows a nested view of perl subroutine | ||||
|     calls and returns across the whole system. | ||||
| 
 | ||||
|     To run: | ||||
|         stap perl-example.stp (for all perl processes) | ||||
|     For specific perl process: | ||||
|         stap perl-example.stp -c COMMAND | ||||
| */ | ||||
| 
 | ||||
| probe perl.sub.call | ||||
| { | ||||
|     printf("%s => sub: %s, filename: %s, line: %d, package: %s\n", | ||||
|         thread_indent(1), sub, filename, lineno, package) | ||||
| } | ||||
| 
 | ||||
| probe perl.sub.return | ||||
| { | ||||
|     printf("%s <= sub: %s, filename: %s, line: %d, package: %s\n", | ||||
|         thread_indent(-1), sub, filename, lineno, package) | ||||
| } | ||||
							
								
								
									
										21
									
								
								SOURCES/perl-perlbug-tag.patch
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										21
									
								
								SOURCES/perl-perlbug-tag.patch
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,21 @@ | ||||
| diff -up perl-5.28.0-RC1/utils/perlbug.PL.orig perl-5.28.0-RC1/utils/perlbug.PL
 | ||||
| --- perl-5.28.0-RC1/utils/perlbug.PL.orig	2018-05-21 12:44:04.000000000 +0200
 | ||||
| +++ perl-5.28.0-RC1/utils/perlbug.PL	2018-05-22 12:17:58.584993588 +0200
 | ||||
| @@ -288,17 +288,6 @@ sub Init {
 | ||||
|      $ok = ''; | ||||
|      if ($opt{o}) { | ||||
|  	if ($opt{o} eq 'k' or $opt{o} eq 'kay') { | ||||
| -	    my $age = time - $patchlevel_date;
 | ||||
| -	    if ($opt{o} eq 'k' and $age > 60 * 24 * 60 * 60 ) {
 | ||||
| -		my $date = localtime $patchlevel_date;
 | ||||
| -		print <<"EOF";
 | ||||
| -"perlbug -ok" and "perlbug -nok" do not report on Perl versions which
 | ||||
| -are more than 60 days old.  This Perl version was constructed on
 | ||||
| -$date.  If you really want to report this, use
 | ||||
| -"perlbug -okay" or "perlbug -nokay".
 | ||||
| -EOF
 | ||||
| -		exit();
 | ||||
| -	    }
 | ||||
|  	    # force these options | ||||
|  	    unless ($opt{n}) { | ||||
|  		$opt{S} = 1; # don't prompt for send | ||||
							
								
								
									
										71
									
								
								SOURCES/perl.stp
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										71
									
								
								SOURCES/perl.stp
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,71 @@ | ||||
| /* | ||||
|    This probe will fire when the perl script enters a subroutine. | ||||
|  */ | ||||
| 
 | ||||
| probe perl.sub.call = process("LIBRARY_PATH").mark("sub__entry") | ||||
| { | ||||
| 
 | ||||
|   sub = user_string($arg1) | ||||
|   filename = user_string($arg2) | ||||
|   lineno = $arg3 | ||||
|   package = user_string($arg4) | ||||
| 
 | ||||
| } | ||||
| 
 | ||||
| /* | ||||
|    This probe will fire when the return from a subroutine has been | ||||
|    hit. | ||||
|  */ | ||||
| 
 | ||||
| probe perl.sub.return = process("LIBRARY_PATH").mark("sub__return") | ||||
| { | ||||
| 
 | ||||
|   sub = user_string($arg1) | ||||
|   filename = user_string($arg2) | ||||
|   lineno = $arg3 | ||||
|   package = user_string($arg4) | ||||
| 
 | ||||
| } | ||||
| 
 | ||||
| /* | ||||
|    This probe will fire when the Perl interperter changes state. | ||||
|  */ | ||||
| 
 | ||||
| probe perl.phase.change = process("LIBRARY_PATH").mark("phase__change") | ||||
| { | ||||
|   newphase = user_string($arg1) | ||||
|   oldphase = user_string($arg2) | ||||
| 
 | ||||
| } | ||||
| 
 | ||||
| 
 | ||||
| /* | ||||
|    Fires when Perl has successfully loaded an individual file. | ||||
|  */ | ||||
| 
 | ||||
| probe perl.loaded.file = process("LIBRARY_PATH").mark("loaded__file") | ||||
| { | ||||
|   filename = user_string($arg1) | ||||
| 
 | ||||
| } | ||||
| 
 | ||||
| 
 | ||||
| /* | ||||
|    Fires when Perl is about to load an individual file. | ||||
|  */ | ||||
| 
 | ||||
| probe perl.loading.file = process("LIBRARY_PATH").mark("loading__file") | ||||
| { | ||||
|   filename = user_string($arg1) | ||||
| 
 | ||||
| } | ||||
| 
 | ||||
| 
 | ||||
| /* | ||||
|    Traces the execution of each opcode in the Perl runloop. | ||||
|  */ | ||||
| 
 | ||||
| probe perl.op.entry = process("LIBRARY_PATH").mark("op__entry") | ||||
| { | ||||
|   opname = user_string($arg1) | ||||
| } | ||||
							
								
								
									
										9112
									
								
								SPECS/perl.spec
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										9112
									
								
								SPECS/perl.spec
									
									
									
									
									
										Normal file
									
								
							
										
											
												File diff suppressed because it is too large
												Load Diff
											
										
									
								
							
		Loading…
	
		Reference in New Issue
	
	Block a user