5.28.0 bump

This commit is contained in:
Jitka Plesnikova 2018-06-26 23:26:07 +02:00
parent 004cea3a67
commit 70d930113d
54 changed files with 581 additions and 5291 deletions

1
.gitignore vendored
View File

@ -27,3 +27,4 @@ perl-5.12.1.tar.gz
/perl-5.26.1.tar.bz2
/perl-5.26.2-RC1.tar.bz2
/perl-5.26.2.tar.bz2
/perl-5.28.0.tar.xz

File diff suppressed because it is too large Load Diff

View File

@ -1,7 +1,7 @@
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
@@ -1479,7 +1479,7 @@ archname=''
@@ -1483,7 +1483,7 @@ archname=''
usereentrant='undef'
: List of libraries we want.
: If anyone needs extra -lxxx, put those in a hint file.

View File

@ -1,7 +1,7 @@
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
@@ -227,7 +227,7 @@ isnt($atime, 500000000, 'atime');
@@ -258,7 +258,7 @@ isnt($atime, 500000000, 'atime');
isnt($mtime, 500000000 + $delta, 'mtime');
SKIP: {

View File

@ -20,7 +20,7 @@ diff --git a/MANIFEST b/MANIFEST
index 397252a..d7c519b 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -3093,6 +3093,7 @@ dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/aix.pm CBuilder methods fo
@@ -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

View File

@ -18,7 +18,7 @@ diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm b/cpan/ExtUtils-Mak
index a8b172f..a3fbce2 100644
--- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm
+++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm
@@ -31,6 +31,7 @@ BEGIN {
@@ -30,6 +30,7 @@ BEGIN {
$Is{IRIX} = $^O eq 'irix';
$Is{NetBSD} = $^O eq 'netbsd';
$Is{Interix} = $^O eq 'interix';
@ -26,7 +26,7 @@ index a8b172f..a3fbce2 100644
$Is{SunOS4} = $^O eq 'sunos';
$Is{Solaris} = $^O eq 'solaris';
$Is{SunOS} = $Is{SunOS4} || $Is{Solaris};
@@ -932,7 +933,7 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP).
@@ -1028,7 +1029,7 @@ sub xs_make_dynamic_lib {
push(@m," \$(RM_F) \$\@\n");
my $libs = '$(LDLOADLIBS)';
@ -35,7 +35,7 @@ index a8b172f..a3fbce2 100644
# 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
@@ -941,6 +942,11 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP).
@@ -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';

View File

@ -14,7 +14,7 @@ diff --git a/Makefile.SH b/Makefile.SH
index d1da0a0..7733a32 100755
--- a/Makefile.SH
+++ b/Makefile.SH
@@ -58,7 +58,7 @@ true)
@@ -68,7 +68,7 @@ true)
${api_revision}.${api_version}.${api_subversion} \
-current_version \
${revision}.${patchlevel}.${subversion} \
@ -23,7 +23,7 @@ index d1da0a0..7733a32 100755
;;
cygwin*)
shrpldflags="$shrpldflags -Wl,--out-implib=libperl.dll.a -Wl,--image-base,0x52000000"
@@ -66,13 +66,15 @@ true)
@@ -76,13 +76,15 @@ true)
;;
sunos*)
linklibperl="-lperl"
@ -40,7 +40,7 @@ index d1da0a0..7733a32 100755
;;
aix*)
case "$cc" in
@@ -110,6 +112,9 @@ true)
@@ -120,6 +122,9 @@ true)
linklibperl='libperl.x'
DPERL_EXTERNAL_GLOB=''
;;

View File

@ -17,7 +17,7 @@ diff --git a/dist/Math-BigInt/lib/Math/BigInt/CalcEmu.pm b/dist/Math-BigInt/lib/
index c82e153..0c0b496 100644
--- a/cpan/Math-BigInt/lib/Math/BigInt/CalcEmu.pm
+++ b/cpan/Math-BigInt/lib/Math/BigInt/CalcEmu.pm
@@ -290,6 +290,7 @@ Math::BigInt::CalcEmu - Emulate low-level math with BigInt code
@@ -292,6 +292,7 @@ Math::BigInt::CalcEmu - Emulate low-level math with BigInt code
=head1 SYNOPSIS

View File

@ -41,15 +41,15 @@ index 33e08e2..7160f54 100644
GDBM_FILE dbp ;
SV * filter[4];
int filtering ;
@@ -89,6 +90,7 @@ gdbm_TIEHASH(dbtype, name, read_write, mode)
if ((dbp = gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode,
(FATALFUNC) croak_string))) {
RETVAL = (GDBM_File)safecalloc(1, sizeof(GDBM_File_type)) ;
+ RETVAL->owner = aTHX;
RETVAL->dbp = dbp ;
}
@@ -109,12 +111,14 @@ gdbm_DESTROY(db)
@@ -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:
@ -115,7 +115,7 @@ 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
@@ -45,6 +45,7 @@ datum nextkey(datum key);
@@ -49,6 +49,7 @@ datum nextkey(datum key);
#define store_value 3
typedef struct {
@ -123,7 +123,7 @@ index d1ece7f..f7e00a0 100644
void * dbp ;
SV * filter[4];
int filtering ;
@@ -112,6 +113,7 @@ odbm_TIEHASH(dbtype, filename, flags, mode)
@@ -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));
@ -131,7 +131,7 @@ index d1ece7f..f7e00a0 100644
RETVAL->dbp = dbp ;
}
OUTPUT:
@@ -124,13 +126,15 @@ DESTROY(db)
@@ -149,13 +151,15 @@ DESTROY(db)
dMY_CXT;
int i = store_value;
CODE:
@ -166,7 +166,7 @@ index 291e41b..0bdae9a 100644
DBM * dbp ;
SV * filter[4];
int filtering ;
@@ -49,6 +50,7 @@ sdbm_TIEHASH(dbtype, filename, flags, mode)
@@ -51,6 +52,7 @@ sdbm_TIEHASH(dbtype, filename, flags, mode)
}
if (dbp) {
RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type));
@ -174,7 +174,7 @@ index 291e41b..0bdae9a 100644
RETVAL->dbp = dbp ;
}
@@ -60,7 +62,7 @@ void
@@ -62,7 +64,7 @@ void
sdbm_DESTROY(db)
SDBM_File db
CODE:
@ -187,7 +187,7 @@ 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
@@ -511,5 +511,40 @@ unlink <Op_dbmx*>, $Dfile;
@@ -510,5 +510,40 @@ unlink <Op_dbmx*>, $Dfile;
unlink <Op1_dbmx*>;
}

View File

@ -16,7 +16,7 @@ diff --git a/Configure b/Configure
index 2f30261..825496e 100755
--- a/Configure
+++ b/Configure
@@ -8249,7 +8249,9 @@ esac
@@ -8762,7 +8762,9 @@ esac
# Detect old use of shrpdir via undocumented Configure -Dshrpdir
case "$shrpdir" in
@ -27,7 +27,7 @@ index 2f30261..825496e 100755
*) $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
@@ -8279,7 +8281,6 @@ esac
@@ -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.
@ -35,7 +35,7 @@ index 2f30261..825496e 100755
xxx=''
tmp_shrpenv=''
if "$useshrplib"; then
@@ -8294,7 +8295,7 @@ if "$useshrplib"; then
@@ -8807,7 +8808,7 @@ if "$useshrplib"; then
xxx="-Wl,-R$shrpdir"
;;
bsdos|linux|irix*|dec_osf|gnu*|haiku)
@ -48,7 +48,7 @@ diff --git a/Makefile.SH b/Makefile.SH
index 7733a32..a481183 100755
--- a/Makefile.SH
+++ b/Makefile.SH
@@ -266,7 +266,7 @@ ranlib = $ranlib
@@ -288,7 +288,7 @@ ranlib = $ranlib
# installman commandline.
bin = $installbin
scriptdir = $scriptdir

View File

@ -23,7 +23,7 @@ diff --git a/MANIFEST b/MANIFEST
index 6af238c..d4f0c56 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1045,6 +1045,7 @@ cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm MakeMaker methods for OS/2
@@ -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

View File

@ -20,7 +20,7 @@ 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
@@ -230,7 +230,7 @@ sub can_run {
@@ -232,7 +232,7 @@ sub can_run {
}
require File::Spec;

View File

@ -1,73 +0,0 @@
From 8985b12868f07d9ef501580d600e49fe8f230eb4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
Date: Tue, 22 Aug 2017 09:49:42 +0200
Subject: [PATCH] Time-HiRes: Fix unreliable t/usleep.t and t/utime.t
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Ported from Time-HiRes-1.9746.
The tests randomly failed on loaded machines because a CPU scheduler
could add unpredictable delays.
CPAN RT#122819
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
dist/Time-HiRes/t/usleep.t | 4 ++--
dist/Time-HiRes/t/utime.t | 9 +++++----
2 files changed, 7 insertions(+), 6 deletions(-)
diff --git a/dist/Time-HiRes/t/usleep.t b/dist/Time-HiRes/t/usleep.t
index 9322458..bb66cbe 100644
--- a/dist/Time-HiRes/t/usleep.t
+++ b/dist/Time-HiRes/t/usleep.t
@@ -32,7 +32,7 @@ SKIP: {
Time::HiRes::usleep(500_000);
my $f2 = Time::HiRes::time();
my $d = $f2 - $f;
- ok $d > 0.4 && $d < 0.9 or print("# slept $d secs $f to $f2\n");
+ ok $d > 0.49 or print("# slept $d secs $f to $f2\n");
}
SKIP: {
@@ -40,7 +40,7 @@ SKIP: {
my $r = [ Time::HiRes::gettimeofday() ];
Time::HiRes::sleep( 0.5 );
my $f = Time::HiRes::tv_interval $r;
- ok $f > 0.4 && $f < 0.9 or print("# slept $f instead of 0.5 secs.\n");
+ ok $f > 0.49 or print("# slept $f instead of 0.5 secs.\n");
}
SKIP: {
diff --git a/dist/Time-HiRes/t/utime.t b/dist/Time-HiRes/t/utime.t
index 22fd48e..c5c7e55 100644
--- a/dist/Time-HiRes/t/utime.t
+++ b/dist/Time-HiRes/t/utime.t
@@ -106,17 +106,18 @@ print "# utime undef sets time to now\n";
my ($fh2, $filename2) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 );
my $now = Time::HiRes::time;
+ sleep(1);
is Time::HiRes::utime(undef, undef, $filename1, $fh2), 2, "Two files changed";
{
my ($got_atime, $got_mtime) = ( Time::HiRes::stat($fh1) )[8, 9];
- cmp_ok abs( $got_atime - $now), '<', 0.1, "File 1 atime set correctly";
- cmp_ok abs( $got_mtime - $now), '<', 0.1, "File 1 mtime set correctly";
+ cmp_ok $got_atime, '>=', $now, "File 1 atime set correctly";
+ cmp_ok $got_mtime, '>=', $now, "File 1 mtime set correctly";
}
{
my ($got_atime, $got_mtime) = ( Time::HiRes::stat($filename2) )[8, 9];
- cmp_ok abs( $got_atime - $now), '<', 0.1, "File 2 atime set correctly";
- cmp_ok abs( $got_mtime - $now), '<', 0.1, "File 2 mtime set correctly";
+ cmp_ok $got_atime, '>=', $now, "File 2 atime set correctly";
+ cmp_ok $got_mtime, '>=', $now, "File 2 mtime set correctly";
}
};
--
2.9.5

View File

@ -1,72 +0,0 @@
From 7b3e03bd309fcc48a135123a60678ae2596b1c38 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 7 Jun 2017 15:00:26 +1000
Subject: [PATCH] clear the UTF8 flag on a glob if it isn't UTF8
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Ported to 5.26.0:
commit 1097da16b21fe0a2257dba9937e55c0cca18f7e1
Author: Tony Cook <tony@develop-help.com>
Date: Wed Jun 7 15:00:26 2017 +1000
[perl #131263] clear the UTF8 flag on a glob if it isn't UTF8
Previously sv_2pv_flags() would set the UTF8 flag on a glob if it
had a UTF8 name, but wouldn't clear tha flag if it didn't.
This meant a name change, eg. if assigned another glob, from a UTF8
name to a non-UTF8 name would leave the flag set.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
sv.c | 2 ++
t/op/gv.t | 10 +++++++++-
2 files changed, 11 insertions(+), 1 deletion(-)
diff --git a/sv.c b/sv.c
index 9f3e28e..ae3dc95 100644
--- a/sv.c
+++ b/sv.c
@@ -3179,6 +3179,8 @@ Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags)
assert(SvPOK(buffer));
if (SvUTF8(buffer))
SvUTF8_on(sv);
+ else
+ SvUTF8_off(sv);
if (lp)
*lp = SvCUR(buffer);
return SvPVX(buffer);
diff --git a/t/op/gv.t b/t/op/gv.t
index 4fe6b00..670ccf6 100644
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -12,7 +12,7 @@ BEGIN {
use warnings;
-plan(tests => 280);
+plan(tests => 282);
# type coercion on assignment
$foo = 'foo';
@@ -1170,6 +1170,14 @@ SKIP: {
is ($? & 127, 0,"[perl #128597] No crash when gp_free calls ckWARN_d");
}
+{
+ # [perl #131263]
+ *sym = "\N{U+0080}";
+ ok(*sym eq "*main::\N{U+0080}", "utf8 flag properly set");
+ *sym = "\xC3\x80";
+ ok(*sym eq "*main::\xC3\x80", "utf8 flag properly cleared");
+}
+
# test gv_try_downgrade()
# If a GV can be stored in a stash in a compact, non-GV form, then
# whenever ops are freed which reference the GV, an attempt is made to
--
2.9.4

View File

@ -19,7 +19,7 @@ diff --git a/ext/arybase/arybase.xs b/ext/arybase/arybase.xs
index 880bbe3..216442a 100644
--- a/ext/arybase/arybase.xs
+++ b/ext/arybase/arybase.xs
@@ -438,10 +438,12 @@ _tie_it(SV *sv)
@@ -428,10 +428,12 @@ _tie_it(SV *sv)
INIT:
GV * const gv = (GV *)sv;
CODE:

View File

@ -1,37 +0,0 @@
From 37268580c0cfbf190ff9aa7859a604713cb366ee Mon Sep 17 00:00:00 2001
From: Yves Orton <demerphq@gmail.com>
Date: Tue, 27 Jun 2017 16:36:57 +0200
Subject: [PATCH] t/op/hash.t: fixup intermittently failing test
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Port to 5.26.0:
commit b2ac59d1d0fda74d6612701d8316fe8dfb6a1b90
Author: Yves Orton <demerphq@gmail.com>
Date: Tue Jun 27 16:36:57 2017 +0200
t/op/hash.t: fixup intermittently failing test
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
t/op/hash.t | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/t/op/hash.t b/t/op/hash.t
index a0e79c7..b941c57 100644
--- a/t/op/hash.t
+++ b/t/op/hash.t
@@ -206,7 +206,7 @@ sub torture_hash {
my $keys = pop @groups;
++$h->{$_} foreach @$keys;
my (undef, $total) = validate_hash("$desc " . keys %$h, $h);
- is($total, $total0, "bucket count is constant when rebuilding");
+ ok($total == $total0 || $total == ($total0*2), "bucket count is expected size when rebuilding");
is(scalar %$h, pop @groups, "scalar keys is identical when rebuilding");
++$h1->{$_} foreach @$keys;
validate_hash("$desc copy " . keys %$h1, $h1);
--
2.9.4

View File

@ -1,48 +0,0 @@
From abd17348111a99642da217c45d836f2df5713594 Mon Sep 17 00:00:00 2001
From: John Lightsey <lightsey@debian.org>
Date: Tue, 31 Oct 2017 18:12:26 -0500
Subject: [PATCH] Fix deparsing of transliterations with unprintable
characters.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
RT #132405
Signed-off-by: Nicolas R <atoomic@cpan.org>
Petr Písař: Port to 5.26.1.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
lib/B/Deparse.pm | 2 +-
lib/B/Deparse.t | 5 +++++
2 files changed, 6 insertions(+), 1 deletion(-)
diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
index 3166415..cc74552 100644
--- a/lib/B/Deparse.pm
+++ b/lib/B/Deparse.pm
@@ -5200,7 +5200,7 @@ sub pchr { # ASCII
} elsif ($n == ord "\r") {
return '\\r';
} elsif ($n >= ord("\cA") and $n <= ord("\cZ")) {
- return '\\c' . unctrl{chr $n};
+ return '\\c' . $unctrl{chr $n};
} else {
# return '\x' . sprintf("%02x", $n);
return '\\' . sprintf("%03o", $n);
diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t
index 7eeb4f8..eae9c49 100644
--- a/lib/B/Deparse.t
+++ b/lib/B/Deparse.t
@@ -2610,3 +2610,8 @@ sub ($a, $=) {
$a;
}
;
+####
+# tr with unprintable characters
+my $str;
+$str = 'foo';
+$str =~ tr/\cA//;
--
2.13.6

View File

@ -1,111 +0,0 @@
From 3dfcac940930a8aa6779f5debea6ea6357372419 Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Sun, 16 Aug 2015 04:30:23 -0400
Subject: [PATCH] fix do dir returning no $!
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
do()ing a directory was returning false/empty string in $!, which isn't
an error, yet documentation says $! should have the error code in it.
Fix this by returning EISDIR for dirs, and EINVAL for block devices.
[perl #125774]
Remove "errno = 0" and comment added in b2da7ead68, since now there is no
scenario where errno is uninitialized, since the dir and block device
failure branches now set errno, where previously they didn't.
Petr Písař: Ported to 5.26.1.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
pp_ctl.c | 25 +++++++++++++++++--------
t/op/do.t | 14 +++++++++++++-
2 files changed, 30 insertions(+), 9 deletions(-)
diff --git a/pp_ctl.c b/pp_ctl.c
index e24d7b6..f136f91 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3534,15 +3534,22 @@ S_check_type_and_open(pTHX_ SV *name)
errno EACCES, so only do a stat to separate a dir from a real EACCES
caused by user perms */
#ifndef WIN32
- /* we use the value of errno later to see how stat() or open() failed.
- * We don't want it set if the stat succeeded but we still failed,
- * such as if the name exists, but is a directory */
- errno = 0;
-
st_rc = PerlLIO_stat(p, &st);
- if (st_rc < 0 || S_ISDIR(st.st_mode) || S_ISBLK(st.st_mode)) {
+ if (st_rc < 0)
return NULL;
+ else {
+ int eno;
+ if(S_ISBLK(st.st_mode)) {
+ eno = EINVAL;
+ goto not_file;
+ }
+ else if(S_ISDIR(st.st_mode)) {
+ eno = EISDIR;
+ not_file:
+ errno = eno;
+ return NULL;
+ }
}
#endif
@@ -3554,8 +3561,10 @@ S_check_type_and_open(pTHX_ SV *name)
int eno;
st_rc = PerlLIO_stat(p, &st);
if (st_rc >= 0) {
- if(S_ISDIR(st.st_mode) || S_ISBLK(st.st_mode))
- eno = 0;
+ if(S_ISDIR(st.st_mode))
+ eno = EISDIR;
+ else if(S_ISBLK(st.st_mode))
+ eno = EINVAL;
else
eno = EACCES;
errno = eno;
diff --git a/t/op/do.t b/t/op/do.t
index 78d8800..1c54f0b 100644
--- a/t/op/do.t
+++ b/t/op/do.t
@@ -7,6 +7,7 @@ BEGIN {
}
use strict;
no warnings 'void';
+use Errno qw(ENOENT EISDIR);
my $called;
my $result = do{ ++$called; 'value';};
@@ -247,7 +248,7 @@ SKIP: {
my $saved_errno = $!;
ok(!$rv, "do returns false on io errror");
ok(!$saved_error, "\$\@ not set on io error");
- ok($saved_errno, "\$! set on io error");
+ ok($saved_errno == ENOENT, "\$! is ENOENT for nonexistent file");
}
# do subname should not be do "subname"
@@ -305,4 +306,15 @@ SKIP: {
}
+# do file $!s must be correct
+{
+ local @INC = ('.'); #want EISDIR not ENOENT
+ my $rv = do 'op'; # /t/op dir
+ my $saved_error = $@;
+ my $saved_errno = $!+0;
+ ok(!$rv, "do dir returns false");
+ ok(!$saved_error, "\$\@ is false on do dir");
+ ok($saved_errno == EISDIR, "\$! is EISDIR on do dir");
+}
+
done_testing();
--
2.13.6

File diff suppressed because it is too large Load Diff

View File

@ -1,24 +0,0 @@
commit 13e70b397dcb0d1bf4a869b670f041c1d7b730d0
Author: Björn Esser <besser82@fedoraproject.org>
Date: Sat Jan 20 20:22:53 2018 +0100
pp: Guard fix for really old bug in glibc libcrypt
diff --git a/pp.c b/pp.c
index d50ad7ddbf..6510c7b15c 100644
--- a/pp.c
+++ b/pp.c
@@ -3650,8 +3650,12 @@ PP(pp_crypt)
#if defined(__GLIBC__) || defined(__EMX__)
if (PL_reentrant_buffer->_crypt_struct_buffer) {
PL_reentrant_buffer->_crypt_struct_buffer->initialized = 0;
- /* work around glibc-2.2.5 bug */
+#if (defined(__GLIBC__) && __GLIBC__ == 2) && \
+ (defined(__GLIBC_MINOR__) && __GLIBC_MINOR__ >= 2 && __GLIBC_MINOR__ < 4)
+ /* work around glibc-2.2.5 bug, has been fixed at some
+ * time in glibc-2.3.X */
PL_reentrant_buffer->_crypt_struct_buffer->current_saltbits = 0;
+#endif
}
#endif
}

View File

@ -1,107 +0,0 @@
From 7a962424149cc60f3a187d0213a12689dd5e806b Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 14 Aug 2017 11:52:39 +1000
Subject: [PATCH] (perl #131746) avoid undefined behaviour in Copy() etc
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
These functions depend on C library functions which have undefined
behaviour when passed NULL pointers, even when passed a zero 'n' value.
Some compilers use this information, ie. assume the pointers are
non-NULL when optimizing any following code, so we do need to
prevent such unguarded calls.
My initial thought was to add conditionals to each macro to skip the
call to the library function when n is zero, but this adds a cost to
every use of these macros, even when the n value is always true.
So instead I added asserts() which will give us a much more visible
indicator of such broken code and revealed the pp_caller and Glob.xs
issues also patched here.
Petr Písař: Ported to 5.26.1 from
f14cf3632059d421de83cf901c7e849adc1fcd03.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
ext/File-Glob/Glob.xs | 2 +-
handy.h | 14 +++++++-------
pp_ctl.c | 3 ++-
pp_hot.c | 3 ++-
4 files changed, 12 insertions(+), 10 deletions(-)
diff --git a/ext/File-Glob/Glob.xs b/ext/File-Glob/Glob.xs
index e0a3681..9779d54 100644
--- a/ext/File-Glob/Glob.xs
+++ b/ext/File-Glob/Glob.xs
@@ -121,7 +121,7 @@ iterate(pTHX_ bool(*globber)(pTHX_ AV *entries, const char *pat, STRLEN len, boo
/* chuck it all out, quick or slow */
if (gimme == G_ARRAY) {
- if (!on_stack) {
+ if (!on_stack && AvFILLp(entries) + 1) {
EXTEND(SP, AvFILLp(entries)+1);
Copy(AvARRAY(entries), SP+1, AvFILLp(entries)+1, SV *);
SP += AvFILLp(entries)+1;
diff --git a/handy.h b/handy.h
index 80f9cf4..88b5b55 100644
--- a/handy.h
+++ b/handy.h
@@ -2409,17 +2409,17 @@ void Perl_mem_log_del_sv(const SV *sv, const char *filename, const int linenumbe
#define Safefree(d) safefree(MEM_LOG_FREE((Malloc_t)(d)))
#endif
-#define Move(s,d,n,t) (MEM_WRAP_CHECK_(n,t) (void)memmove((char*)(d),(const char*)(s), (n) * sizeof(t)))
-#define Copy(s,d,n,t) (MEM_WRAP_CHECK_(n,t) (void)memcpy((char*)(d),(const char*)(s), (n) * sizeof(t)))
-#define Zero(d,n,t) (MEM_WRAP_CHECK_(n,t) (void)memzero((char*)(d), (n) * sizeof(t)))
+#define Move(s,d,n,t) (MEM_WRAP_CHECK_(n,t) assert(d), assert(s), (void)memmove((char*)(d),(const char*)(s), (n) * sizeof(t)))
+#define Copy(s,d,n,t) (MEM_WRAP_CHECK_(n,t) assert(d), assert(s), (void)memcpy((char*)(d),(const char*)(s), (n) * sizeof(t)))
+#define Zero(d,n,t) (MEM_WRAP_CHECK_(n,t) assert(d), (void)memzero((char*)(d), (n) * sizeof(t)))
-#define MoveD(s,d,n,t) (MEM_WRAP_CHECK_(n,t) memmove((char*)(d),(const char*)(s), (n) * sizeof(t)))
-#define CopyD(s,d,n,t) (MEM_WRAP_CHECK_(n,t) memcpy((char*)(d),(const char*)(s), (n) * sizeof(t)))
+#define MoveD(s,d,n,t) (MEM_WRAP_CHECK_(n,t) assert(d), assert(s), memmove((char*)(d),(const char*)(s), (n) * sizeof(t)))
+#define CopyD(s,d,n,t) (MEM_WRAP_CHECK_(n,t) assert(d), assert(s), memcpy((char*)(d),(const char*)(s), (n) * sizeof(t)))
#ifdef HAS_MEMSET
-#define ZeroD(d,n,t) (MEM_WRAP_CHECK_(n,t) memzero((char*)(d), (n) * sizeof(t)))
+#define ZeroD(d,n,t) (MEM_WRAP_CHECK_(n,t) assert(d), memzero((char*)(d), (n) * sizeof(t)))
#else
/* Using bzero(), which returns void. */
-#define ZeroD(d,n,t) (MEM_WRAP_CHECK_(n,t) memzero((char*)(d), (n) * sizeof(t)),d)
+#define ZeroD(d,n,t) (MEM_WRAP_CHECK_(n,t) assert(d), memzero((char*)(d), (n) * sizeof(t)),d)
#endif
#define PoisonWith(d,n,t,b) (MEM_WRAP_CHECK_(n,t) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t)))
diff --git a/pp_ctl.c b/pp_ctl.c
index 15c193b..f1c57bc 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1971,7 +1971,8 @@ PP(pp_caller)
if (AvMAX(PL_dbargs) < AvFILLp(ary) + off)
av_extend(PL_dbargs, AvFILLp(ary) + off);
- Copy(AvALLOC(ary), AvARRAY(PL_dbargs), AvFILLp(ary) + 1 + off, SV*);
+ if (AvFILLp(ary) + 1 + off)
+ Copy(AvALLOC(ary), AvARRAY(PL_dbargs), AvFILLp(ary) + 1 + off, SV*);
AvFILLp(PL_dbargs) = AvFILLp(ary) + off;
}
mPUSHi(CopHINTS_get(cx->blk_oldcop));
diff --git a/pp_hot.c b/pp_hot.c
index 5899413..66b79ea 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -4138,7 +4138,8 @@ PP(pp_entersub)
AvARRAY(av) = ary;
}
- Copy(MARK+1,AvARRAY(av),items,SV*);
+ if (items)
+ Copy(MARK+1,AvARRAY(av),items,SV*);
AvFILLp(av) = items - 1;
}
if (UNLIKELY((cx->blk_u16 & OPpENTERSUB_LVAL_MASK) == OPpLVAL_INTRO &&
--
2.13.6

View File

@ -1,223 +0,0 @@
From 4ac7295514f35016a79dbcc07500f6c9ca4729b7 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Thu, 2 Nov 2017 20:18:56 +0000
Subject: [PATCH] (perl #131895) fail stat on names with \0 embedded
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Also lstat() and the file test ops.
Petr Písař: Port to 5.26.1.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
doio.c | 21 ++++++++++++++++-----
pp_sys.c | 29 +++++++++++++++++++++++------
t/lib/warnings/pp_sys | 14 ++++++++++++++
t/op/filetest.t | 10 +++++++++-
t/op/stat.t | 12 +++++++++++-
5 files changed, 73 insertions(+), 13 deletions(-)
diff --git a/doio.c b/doio.c
index becb19b..70d7747 100644
--- a/doio.c
+++ b/doio.c
@@ -1466,7 +1466,7 @@ Perl_my_stat_flags(pTHX_ const U32 flags)
return PL_laststatval;
else {
SV* const sv = TOPs;
- const char *s;
+ const char *s, *d;
STRLEN len;
if ((gv = MAYBE_DEREF_GV_flags(sv,flags))) {
goto do_fstat;
@@ -1480,9 +1480,14 @@ Perl_my_stat_flags(pTHX_ const U32 flags)
s = SvPV_flags_const(sv, len, flags);
PL_statgv = NULL;
sv_setpvn(PL_statname, s, len);
- s = SvPVX_const(PL_statname); /* s now NUL-terminated */
+ d = SvPVX_const(PL_statname); /* s now NUL-terminated */
PL_laststype = OP_STAT;
- PL_laststatval = PerlLIO_stat(s, &PL_statcache);
+ if (!IS_SAFE_PATHNAME(s, len, OP_NAME(PL_op))) {
+ PL_laststatval = -1;
+ }
+ else {
+ PL_laststatval = PerlLIO_stat(d, &PL_statcache);
+ }
if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && should_warn_nl(s)) {
GCC_DIAG_IGNORE(-Wformat-nonliteral); /* PL_warn_nl is constant */
Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat");
@@ -1499,6 +1504,7 @@ Perl_my_lstat_flags(pTHX_ const U32 flags)
static const char* const no_prev_lstat = "The stat preceding -l _ wasn't an lstat";
dSP;
const char *file;
+ STRLEN len;
SV* const sv = TOPs;
bool isio = FALSE;
if (PL_op->op_flags & OPf_REF) {
@@ -1542,9 +1548,14 @@ Perl_my_lstat_flags(pTHX_ const U32 flags)
HEKfARG(GvENAME_HEK((const GV *)
(SvROK(sv) ? SvRV(sv) : sv))));
}
- file = SvPV_flags_const_nolen(sv, flags);
+ file = SvPV_flags_const(sv, len, flags);
sv_setpv(PL_statname,file);
- PL_laststatval = PerlLIO_lstat(file,&PL_statcache);
+ if (!IS_SAFE_PATHNAME(file, len, OP_NAME(PL_op))) {
+ PL_laststatval = -1;
+ }
+ else {
+ PL_laststatval = PerlLIO_lstat(file,&PL_statcache);
+ }
if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && should_warn_nl(file)) {
GCC_DIAG_IGNORE(-Wformat-nonliteral); /* PL_warn_nl is constant */
Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "lstat");
diff --git a/pp_sys.c b/pp_sys.c
index 0b60584..1b81fda 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -2963,19 +2963,24 @@ PP(pp_stat)
}
else {
const char *file;
+ const char *temp;
+ STRLEN len;
if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) {
io = MUTABLE_IO(SvRV(sv));
if (PL_op->op_type == OP_LSTAT)
goto do_fstat_warning_check;
goto do_fstat_have_io;
}
-
SvTAINTED_off(PL_statname); /* previous tainting irrelevant */
- sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv));
+ temp = SvPV_nomg_const(sv, len);
+ sv_setpv(PL_statname, temp);
PL_statgv = NULL;
PL_laststype = PL_op->op_type;
file = SvPV_nolen_const(PL_statname);
- if (PL_op->op_type == OP_LSTAT)
+ if (!IS_SAFE_PATHNAME(temp, len, OP_NAME(PL_op))) {
+ PL_laststatval = -1;
+ }
+ else if (PL_op->op_type == OP_LSTAT)
PL_laststatval = PerlLIO_lstat(file, &PL_statcache);
else
PL_laststatval = PerlLIO_stat(file, &PL_statcache);
@@ -3211,8 +3216,12 @@ PP(pp_ftrread)
if (use_access) {
#if defined(HAS_ACCESS) || defined (PERL_EFF_ACCESS)
- const char *name = SvPV_nolen(*PL_stack_sp);
- if (effective) {
+ STRLEN len;
+ const char *name = SvPV(*PL_stack_sp, len);
+ if (!IS_SAFE_PATHNAME(name, len, OP_NAME(PL_op))) {
+ result = -1;
+ }
+ else if (effective) {
# ifdef PERL_EFF_ACCESS
result = PERL_EFF_ACCESS(name, access_mode);
# else
@@ -3537,10 +3546,18 @@ PP(pp_fttext)
}
else {
const char *file;
+ const char *temp;
+ STRLEN temp_len;
int fd;
assert(sv);
- sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv));
+ temp = SvPV_nomg_const(sv, temp_len);
+ sv_setpv(PL_statname, temp);
+ if (!IS_SAFE_PATHNAME(temp, temp_len, OP_NAME(PL_op))) {
+ PL_laststatval = -1;
+ PL_laststype = OP_STAT;
+ FT_RETURNUNDEF;
+ }
really_filename:
file = SvPVX_const(PL_statname);
PL_statgv = NULL;
diff --git a/t/lib/warnings/pp_sys b/t/lib/warnings/pp_sys
index 9c544e0..c599aa3 100644
--- a/t/lib/warnings/pp_sys
+++ b/t/lib/warnings/pp_sys
@@ -972,3 +972,17 @@ close $fh;
unlink $file;
EXPECT
syswrite() is deprecated on :utf8 handles. This will be a fatal error in Perl 5.30 at - line 5.
+########
+# NAME stat on name with \0
+use warnings;
+my @x = stat("./\0-");
+my @y = lstat("./\0-");
+-T ".\0-";
+-x ".\0-";
+-l ".\0-";
+EXPECT
+Invalid \0 character in pathname for stat: ./\0- at - line 2.
+Invalid \0 character in pathname for lstat: ./\0- at - line 3.
+Invalid \0 character in pathname for fttext: .\0- at - line 4.
+Invalid \0 character in pathname for fteexec: .\0- at - line 5.
+Invalid \0 character in pathname for ftlink: .\0- at - line 6.
diff --git a/t/op/filetest.t b/t/op/filetest.t
index 8883381..bd1d08c 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 => 53 + 27*14);
+plan(tests => 57 + 27*14);
if ($^O =~ /MSWin32|cygwin|msys/ && !is_miniperl) {
require Win32; # for IsAdminUser()
@@ -393,3 +393,11 @@ SKIP: {
is $failed_stat2, $failed_stat1,
'failed -r($gv_with_io_but_no_fp) with and w/out fatal warnings';
}
+
+{
+ # [perl #131895] stat() doesn't fail on filenames containing \0 / NUL
+ ok(!-T "TEST\0-", '-T on name with \0');
+ ok(!-B "TEST\0-", '-B on name with \0');
+ ok(!-f "TEST\0-", '-f on name with \0');
+ ok(!-r "TEST\0-", '-r on name with \0');
+}
diff --git a/t/op/stat.t b/t/op/stat.t
index 323c498..dbbe6ec 100644
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -25,7 +25,7 @@ if ($^O eq 'MSWin32') {
${^WIN32_SLOPPY_STAT} = 0;
}
-plan tests => 118;
+plan tests => 120;
my $Perl = which_perl();
@@ -653,6 +653,16 @@ SKIP:
'stat on an array of valid paths should return ENOENT';
}
+# [perl #131895] stat() doesn't fail on filenames containing \0 / NUL
+ok !stat("TEST\0-"), 'stat on filename with \0';
+SKIP: {
+ my $link = "TEST.symlink.$$";
+ my $can_symlink = eval { symlink "TEST", $link };
+ skip "cannot symlink", 1 unless $can_symlink;
+ ok !lstat("$link\0-"), 'lstat on filename with \0';
+ unlink $link;
+}
+
END {
chmod 0666, $tmpfile;
unlink_all $tmpfile;
--
2.13.6

View File

@ -1,54 +0,0 @@
From dc5c68130b7c8b727e9e792506183c255fc2bc70 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Thu, 19 Oct 2017 10:46:04 +1100
Subject: [PATCH] (perl #132245) don't try to process a char range with no
preceding char
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
A range like \N{}-0 eventually results in compilation failing, but
before that, get_and_check_backslash_N_name() attempts to treat
the memory before the empty output of \N{} as a character.
Petr Písař: Ported to 5.26.1.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
t/lib/warnings/toke | 5 +++++
toke.c | 6 +++---
2 files changed, 8 insertions(+), 3 deletions(-)
diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke
index fc51d9f..398ee22 100644
--- a/t/lib/warnings/toke
+++ b/t/lib/warnings/toke
@@ -1651,3 +1651,8 @@ Execution of - aborted due to compilation errors.
use utf8;
qw∘foo ∞ ♥ bar∘
EXPECT
+########
+# NAME tr/// range with empty \N{} at the start
+tr//\N{}-0/;
+EXPECT
+Unknown charname '' is deprecated. Its use will be fatal in Perl 5.28 at - line 1.
diff --git a/toke.c b/toke.c
index 6f84d2d..6ee7a68 100644
--- a/toke.c
+++ b/toke.c
@@ -2958,9 +2958,9 @@ S_scan_const(pTHX_ char *start)
/* Here, we don't think we're in a range. If the new character
* is not a hyphen; or if it is a hyphen, but it's too close to
- * either edge to indicate a range, then it's a regular
- * character. */
- if (*s != '-' || s >= send - 1 || s == start) {
+ * either edge to indicate a range, or if we haven't output any
+ * characters yet then it's a regular character. */
+ if (*s != '-' || s >= send - 1 || s == start || d == SvPVX(sv)) {
/* A regular character. Process like any other, but first
* clear any flags */
--
2.13.6

View File

@ -1,211 +0,0 @@
From 8c7182b26a43f14cd8afbfbe4448cbbd691c3609 Mon Sep 17 00:00:00 2001
From: Zefram <zefram@fysh.org>
Date: Wed, 15 Nov 2017 08:11:37 +0000
Subject: [PATCH] set $! when statting a closed filehandle
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
When a stat fails because it's on a closed or otherwise invalid
filehandle, $! was often not being set, depending on the operation
and the nature of the invalidity. Consistently set it to EBADF.
Fixes [perl #108288].
Petr Písař: Ported to 5.26.1.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
MANIFEST | 1 +
doio.c | 10 +++++++++-
pp_sys.c | 22 ++++++++++++---------
t/op/stat_errors.t | 57 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
4 files changed, 80 insertions(+), 10 deletions(-)
create mode 100644 t/op/stat_errors.t
diff --git a/MANIFEST b/MANIFEST
index fcbf5cc..996759e 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5670,6 +5670,7 @@ t/op/srand.t See if srand works
t/op/sselect.t See if 4 argument select works
t/op/stash.t See if %:: stashes work
t/op/stat.t See if stat works
+t/op/stat_errors.t See if stat and file tests handle threshold errors
t/op/state.t See if state variables work
t/op/study.t See if study works
t/op/studytied.t See if study works with tied scalars
diff --git a/doio.c b/doio.c
index 70d7747..71dc6e4 100644
--- a/doio.c
+++ b/doio.c
@@ -1437,8 +1437,11 @@ Perl_my_stat_flags(pTHX_ const U32 flags)
if (PL_op->op_flags & OPf_REF) {
gv = cGVOP_gv;
do_fstat:
- if (gv == PL_defgv)
+ if (gv == PL_defgv) {
+ if (PL_laststatval < 0)
+ SETERRNO(EBADF,RMS_IFI);
return PL_laststatval;
+ }
io = GvIO(gv);
do_fstat_have_io:
PL_laststype = OP_STAT;
@@ -1449,6 +1452,7 @@ Perl_my_stat_flags(pTHX_ const U32 flags)
int fd = PerlIO_fileno(IoIFP(io));
if (fd < 0) {
/* E.g. PerlIO::scalar has no real fd. */
+ SETERRNO(EBADF,RMS_IFI);
return (PL_laststatval = -1);
} else {
return (PL_laststatval = PerlLIO_fstat(fd, &PL_statcache));
@@ -1459,6 +1463,7 @@ Perl_my_stat_flags(pTHX_ const U32 flags)
}
PL_laststatval = -1;
report_evil_fh(gv);
+ SETERRNO(EBADF,RMS_IFI);
return -1;
}
else if ((PL_op->op_private & (OPpFT_STACKED|OPpFT_AFTER_t))
@@ -1511,6 +1516,8 @@ Perl_my_lstat_flags(pTHX_ const U32 flags)
if (cGVOP_gv == PL_defgv) {
if (PL_laststype != OP_LSTAT)
Perl_croak(aTHX_ "%s", no_prev_lstat);
+ if (PL_laststatval < 0)
+ SETERRNO(EBADF,RMS_IFI);
return PL_laststatval;
}
PL_laststatval = -1;
@@ -1520,6 +1527,7 @@ Perl_my_lstat_flags(pTHX_ const U32 flags)
"Use of -l on filehandle %" HEKf,
HEKfARG(GvENAME_HEK(cGVOP_gv)));
}
+ SETERRNO(EBADF,RMS_IFI);
return -1;
}
if ((PL_op->op_private & (OPpFT_STACKED|OPpFT_AFTER_t))
diff --git a/pp_sys.c b/pp_sys.c
index fefbea3..87961f1 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -2925,10 +2925,11 @@ PP(pp_stat)
Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat");
}
- if (gv != PL_defgv) {
- bool havefp;
+ if (gv == PL_defgv) {
+ if (PL_laststatval < 0)
+ SETERRNO(EBADF,RMS_IFI);
+ } else {
do_fstat_have_io:
- havefp = FALSE;
PL_laststype = OP_STAT;
PL_statgv = gv ? gv : (GV *)io;
SvPVCLEAR(PL_statname);
@@ -2939,22 +2940,25 @@ PP(pp_stat)
if (IoIFP(io)) {
int fd = PerlIO_fileno(IoIFP(io));
if (fd < 0) {
+ report_evil_fh(gv);
PL_laststatval = -1;
SETERRNO(EBADF,RMS_IFI);
} else {
PL_laststatval = PerlLIO_fstat(fd, &PL_statcache);
- havefp = TRUE;
}
} else if (IoDIRP(io)) {
PL_laststatval =
PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache);
- havefp = TRUE;
} else {
+ report_evil_fh(gv);
PL_laststatval = -1;
+ SETERRNO(EBADF,RMS_IFI);
}
- }
- else PL_laststatval = -1;
- if (PL_laststatval < 0 && !havefp) report_evil_fh(gv);
+ } else {
+ report_evil_fh(gv);
+ PL_laststatval = -1;
+ SETERRNO(EBADF,RMS_IFI);
+ }
}
if (PL_laststatval < 0) {
@@ -3451,7 +3455,7 @@ PP(pp_fttty)
else if (name && isDIGIT(*name) && grok_atoUV(name, &uv, NULL) && uv <= PERL_INT_MAX)
fd = (int)uv;
else
- FT_RETURNUNDEF;
+ fd = -1;
if (fd < 0) {
SETERRNO(EBADF,RMS_IFI);
FT_RETURNUNDEF;
diff --git a/t/op/stat_errors.t b/t/op/stat_errors.t
new file mode 100644
index 0000000..e043c61
--- /dev/null
+++ b/t/op/stat_errors.t
@@ -0,0 +1,57 @@
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ require './test.pl';
+ set_up_inc('../lib');
+}
+
+plan(tests => 2*11*29);
+
+use Errno qw(EBADF ENOENT);
+
+open(SCALARFILE, "<", \"wibble") or die $!;
+open(CLOSEDFILE, "<", "./test.pl") or die $!;
+close(CLOSEDFILE) or die $!;
+opendir(CLOSEDDIR, "../lib") or die $!;
+closedir(CLOSEDDIR) or die $!;
+
+foreach my $op (
+ qw(stat lstat),
+ (map { "-$_" } qw(r w x o R W X O e z s f d l p S b c t u g k T B M A C)),
+) {
+ foreach my $arg (
+ (map { ($_, "\\*$_") }
+ qw(NEVEROPENED SCALARFILE CLOSEDFILE CLOSEDDIR _)),
+ "\"tmpnotexist\"",
+ ) {
+ my $argdesc = $arg;
+ if ($arg eq "_") {
+ my @z = lstat "tmpnotexist";
+ $argdesc .= " with prior stat fail";
+ }
+ SKIP: {
+ if ($op eq "-l" && $arg =~ /\A\\/) {
+ # The op weirdly stringifies the globref and uses it as
+ # a filename, rather than treating it as a file handle.
+ # That might be a bug, but while that behaviour exists it
+ # needs to be exempted from these tests.
+ skip "-l on globref", 2;
+ }
+ if ($op eq "-t" && $arg eq "\"tmpnotexist\"") {
+ # The op doesn't operate on filenames.
+ skip "-t on filename", 2;
+ }
+ $! = 0;
+ my $res = eval "$op $arg";
+ my $err = $!;
+ is $res, $op =~ /\A-/ ? undef : !!0, "result of $op $arg";
+ is 0+$err,
+ $arg eq "\"tmpnotexist\"" ||
+ ($op =~ /\A-[TB]\z/ && $arg =~ /_\z/) ? ENOENT : EBADF,
+ "error from $op $arg";
+ }
+ }
+}
+
+1;
--
2.13.6

View File

@ -1,105 +0,0 @@
From dc1f8f6b581a8e4efbb782398ab3e7c3a52b062f Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Tue, 8 May 2018 12:13:18 -0600
Subject: [PATCH] PATCH: [perl #133185] Infinite loop in qr//
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
This loop was inadvertently introduced as part of patches to fix
(perl #132227 CVE-2018-6797] heap-buffer-overflow". The commit in 5.27
responsible was f8fb8615ddc5a80e3bbd4386a8914497f921b62d.
To be vulnerable, the pattern must start out as /d (hence no use 5.012
or higher), and then there must be something that implicitly forces /u
(which the \pp does in the test case added by this patch), and then
(?aa), and then the code point \xDF. (German Sharp S). The /i must be
in effect by the time the DF is encountered, but it needn't come in the
(?aa) which the test does.
The problem is that the conditional that is testing that we switched
away from /d rules is assuming that this happened during the
construction of the current EXACTFish node. The comments I wrote
indicate this assumption. But this example shows that the switch can
come before this node started getting constructed, and so it loops.
The patch explicitly saves the state at the beginning of this node's
construction, and only retries if it changed during that construction.
Therefore the next time through, it will see that it hasn't changed
since the previous time, and won't loop.
Petr Písař: Ported to 5.26.2 from:
commit 0b9cb33b146b3eb55634853f883a880771dd1413
Author: Karl Williamson <khw@cpan.org>
Date: Tue May 8 12:13:18 2018 -0600
PATCH: [perl #133185] Infinite loop in qr//
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
regcomp.c | 10 +++++++++-
t/re/speed.t | 5 ++++-
2 files changed, 13 insertions(+), 2 deletions(-)
diff --git a/regcomp.c b/regcomp.c
index 845e660..18fa465 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -13100,6 +13100,10 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
bool maybe_exactfu = PASS2
&& (node_type == EXACTF || node_type == EXACTFL);
+ /* To see if RExC_uni_semantics changes during parsing of the node.
+ * */
+ bool uni_semantics_at_node_start;
+
/* If a folding node contains only code points that don't
* participate in folds, it can be changed into an EXACT node,
* which allows the optimizer more things to look for */
@@ -13147,6 +13151,8 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
|| UTF8_IS_INVARIANT(UCHARAT(RExC_parse))
|| UTF8_IS_START(UCHARAT(RExC_parse)));
+ uni_semantics_at_node_start = RExC_uni_semantics;
+
/* Here, we have a literal character. Find the maximal string of
* them in the input that we can fit into a single EXACTish node.
* We quit at the first non-literal or when the node gets full */
@@ -13550,7 +13556,9 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
* didn't think it needed to reparse. But this
* sharp s now does indicate the need for
* reparsing. */
- if (RExC_uni_semantics) {
+ if ( uni_semantics_at_node_start
+ != RExC_uni_semantics)
+ {
p = oldp;
goto loopdone;
}
diff --git a/t/re/speed.t b/t/re/speed.t
index 4a4830f..9a57de1 100644
--- a/t/re/speed.t
+++ b/t/re/speed.t
@@ -24,7 +24,7 @@ BEGIN {
skip_all('no re module') unless defined &DynaLoader::boot_DynaLoader;
skip_all_without_unicode_tables();
-plan tests => 58; #** update watchdog timeouts proportionally when adding tests
+plan tests => 59; #** update watchdog timeouts proportionally when adding tests
use strict;
use warnings;
@@ -156,6 +156,9 @@ PROG
ok( $elapsed <= 1, "should not COW on long string with substr and m//g");
}
+ # [perl #133185] Infinite loop
+ like("!\xdf", eval 'qr/\pp(?aai)\xdf/',
+ 'Compiling qr/\pp(?aai)\xdf/ doesn\'t loop');
} # End of sub run_tests
--
2.14.3

View File

@ -1,143 +0,0 @@
From 07ebe9c4fb1028d17e61caabe8c15abd0cd48983 Mon Sep 17 00:00:00 2001
From: Yves Orton <demerphq@gmail.com>
Date: Thu, 29 Jun 2017 11:31:14 +0200
Subject: [PATCH] Parse caret vars with subscripts the same as normal vars
inside of ${..} escaping
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
This behavior is discussed in perl #131664, which complains that
"${^CAPTURE}[0]" does not work as expected. Abigail explains the
behavior is by design and Eirik Berg Hanssen expands on that explanation
pointing out that what /should/ work, "${^CAPTURE[0]}" does not,
which Sawyer then ruled was a bug.
So this patch makes "${^CAPTURE[0]}" (and "${^CAPTURE [0]}" [hi
abigial]) work the same as they would if the var was called @foo.
Petr Písař: Ported to 5.26.2-RC1.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
t/base/lex.t | 28 +++++++++++++++++++++++++++-
toke.c | 46 +++++++++++++++++++++++++---------------------
2 files changed, 52 insertions(+), 22 deletions(-)
diff --git a/t/base/lex.t b/t/base/lex.t
index 99fd3bb..ae17bbd 100644
--- a/t/base/lex.t
+++ b/t/base/lex.t
@@ -1,6 +1,6 @@
#!./perl
-print "1..112\n";
+print "1..119\n";
$x = 'x';
@@ -154,6 +154,32 @@ my $test = 31;
print "not " unless index ($@, 'Can\'t use global $^XYZ in "my"') > -1;
print "ok $test\n"; $test++;
# print "($@)\n" if $@;
+#
+ ${^TEST}= "splat";
+ @{^TEST}= ("foo", "bar");
+ %{^TEST}= ("foo" => "FOO", "bar" => "BAR" );
+
+ print "not " if "${^TEST}" ne "splat";
+ print "ok $test\n"; $test++;
+
+ print "not " if "${^TEST}[0]" ne "splat[0]";
+ print "ok $test\n"; $test++;
+
+ print "not " if "${^TEST[0]}" ne "foo";
+ print "ok $test\n"; $test++;
+
+ print "not " if "${ ^TEST [1] }" ne "bar";
+ print "ok $test\n"; $test++;
+
+ print "not " if "${^TEST}{foo}" ne "splat{foo}";
+ print "ok $test\n"; $test++;
+
+ print "not " if "${^TEST{foo}}" ne "FOO";
+ print "ok $test\n"; $test++;
+
+ print "not " if "${ ^TEST {bar} }" ne "BAR";
+ print "ok $test\n"; $test++;
+
# Now let's make sure that caret variables are all forced into the main package.
package Someother;
diff --git a/toke.c b/toke.c
index ee9c464..aff785b 100644
--- a/toke.c
+++ b/toke.c
@@ -9416,19 +9416,36 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni)
bool skip;
char *s2;
/* If we were processing {...} notation then... */
- if (isIDFIRST_lazy_if_safe(d, e, is_utf8)) {
- /* if it starts as a valid identifier, assume that it is one.
- (the later check for } being at the expected point will trap
- cases where this doesn't pan out.) */
- d += is_utf8 ? UTF8SKIP(d) : 1;
- parse_ident(&s, &d, e, 1, is_utf8, TRUE);
- *d = '\0';
+ if (isIDFIRST_lazy_if_safe(d, e, is_utf8)
+ || (!isPRINT(*d) /* isCNTRL(d), plus all non-ASCII */
+ && isWORDCHAR(*s))
+ ) {
+ /* note we have to check for a normal identifier first,
+ * as it handles utf8 symbols, and only after that has
+ * been ruled out can we look at the caret words */
+ if (isIDFIRST_lazy_if_safe(d, e, is_utf8) ) {
+ /* if it starts as a valid identifier, assume that it is one.
+ (the later check for } being at the expected point will trap
+ cases where this doesn't pan out.) */
+ d += is_utf8 ? UTF8SKIP(d) : 1;
+ parse_ident(&s, &d, e, 1, is_utf8, TRUE);
+ *d = '\0';
+ }
+ else { /* caret word: ${^Foo} ${^CAPTURE[0]} */
+ d++;
+ while (isWORDCHAR(*s) && d < e) {
+ *d++ = *s++;
+ }
+ if (d >= e)
+ Perl_croak(aTHX_ "%s", ident_too_long);
+ *d = '\0';
+ }
tmp_copline = CopLINE(PL_curcop);
if (s < PL_bufend && isSPACE(*s)) {
s = skipspace(s);
}
if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) {
- /* ${foo[0]} and ${foo{bar}} notation. */
+ /* ${foo[0]} and ${foo{bar}} and ${^CAPTURE[0]} notation. */
if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest, 0)) {
const char * const brack =
(const char *)
@@ -9447,19 +9464,6 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni)
return s;
}
}
- /* Handle extended ${^Foo} variables
- * 1999-02-27 mjd-perl-patch@plover.com */
- else if (! isPRINT(*d) /* isCNTRL(d), plus all non-ASCII */
- && isWORDCHAR(*s))
- {
- d++;
- while (isWORDCHAR(*s) && d < e) {
- *d++ = *s++;
- }
- if (d >= e)
- Perl_croak(aTHX_ "%s", ident_too_long);
- *d = '\0';
- }
if ( !tmp_copline )
tmp_copline = CopLINE(PL_curcop);
--
2.14.3

View File

@ -1,45 +0,0 @@
From edea384e57453b0a62de58445eed1fded18c1cca Mon Sep 17 00:00:00 2001
From: Yves Orton <demerphq@gmail.com>
Date: Thu, 29 Jun 2017 13:20:49 +0200
Subject: [PATCH] add an additional test for whitespace tolerance in caret
word-vars
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Petr Písař: Ported to 5.26.2-RC1.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
t/base/lex.t | 7 +++++--
1 file changed, 5 insertions(+), 2 deletions(-)
diff --git a/t/base/lex.t b/t/base/lex.t
index ae17bbd..414aa1f 100644
--- a/t/base/lex.t
+++ b/t/base/lex.t
@@ -1,6 +1,6 @@
#!./perl
-print "1..119\n";
+print "1..120\n";
$x = 'x';
@@ -158,9 +158,12 @@ my $test = 31;
${^TEST}= "splat";
@{^TEST}= ("foo", "bar");
%{^TEST}= ("foo" => "FOO", "bar" => "BAR" );
-
+
print "not " if "${^TEST}" ne "splat";
print "ok $test\n"; $test++;
+
+ print "not " if "${ ^TEST }" ne "splat";
+ print "ok $test\n"; $test++;
print "not " if "${^TEST}[0]" ne "splat[0]";
print "ok $test\n"; $test++;
--
2.14.3

View File

@ -1,90 +0,0 @@
From 3e6e57e89f298f450cbe14c61609f08fc01bf233 Mon Sep 17 00:00:00 2001
From: Zefram <zefram@fysh.org>
Date: Sat, 16 Dec 2017 05:33:20 +0000
Subject: [PATCH] perform system() arg processing before fork
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
A lot of things can happen when stringifying an argument list: side
effects, warnings, exceptions. In the case of system(), these effects
should happen in the context of the parent process. The stringification
can also depend on which process it happens in, as in the case of
$$, and in that case it should also happen in the parent process.
Therefore reduce the argument scalars to strings first thing in pp_system.
Fixes [perl #121105].
Petr Písař: Ported to 5.26.2-RC1 from
64def2aeaeb63f92dadc6dfa33486c1d7b311963.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
pp_sys.c | 16 ++++++++++------
t/op/exec.t | 15 ++++++++++++++-
2 files changed, 24 insertions(+), 7 deletions(-)
diff --git a/pp_sys.c b/pp_sys.c
index 87961f1..07e552a 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -4375,14 +4375,18 @@ PP(pp_system)
int result;
# endif
+ while (++MARK <= SP) {
+ SV *origsv = *MARK;
+ STRLEN len;
+ char *pv;
+ pv = SvPV(origsv, len);
+ *MARK = newSVpvn_flags(pv, len,
+ (SvFLAGS(origsv) & SVf_UTF8) | SVs_TEMP);
+ }
+ MARK = ORIGMARK;
+
if (TAINTING_get) {
TAINT_ENV();
- while (++MARK <= SP) {
- (void)SvPV_nolen_const(*MARK); /* stringify for taint check */
- if (TAINT_get)
- break;
- }
- MARK = ORIGMARK;
TAINT_PROPER("system");
}
PERL_FLUSHALL_FOR_CHILD;
diff --git a/t/op/exec.t b/t/op/exec.t
index 237388b..e29de82 100644
--- a/t/op/exec.t
+++ b/t/op/exec.t
@@ -36,7 +36,7 @@ $ENV{LANGUAGE} = 'C'; # Ditto in GNU.
my $Is_VMS = $^O eq 'VMS';
my $Is_Win32 = $^O eq 'MSWin32';
-plan(tests => 34);
+plan(tests => 37);
my $Perl = which_perl();
@@ -177,6 +177,19 @@ TODO: {
"exec failure doesn't terminate process");
}
+package CountRead {
+ sub TIESCALAR { bless({ n => 0 }, $_[0]) }
+ sub FETCH { ++$_[0]->{n} }
+}
+my $cr;
+tie $cr, "CountRead";
+is system($^X, "-e", "exit(\$ARGV[0] eq '1' ? 0 : 1)", $cr), 0,
+ "system args have magic processed exactly once";
+is tied($cr)->{n}, 1, "system args have magic processed before fork";
+
+is system($^X, "-e", "exit(\$ARGV[0] eq \$ARGV[1] ? 0 : 1)", "$$", $$), 0,
+ "system args have magic processed before fork";
+
my $test = curr_test();
exec $Perl, '-le', qq{${quote}print 'ok $test - exec PROG, LIST'${quote}};
fail("This should never be reached if the exec() worked");
--
2.14.3

View File

@ -1,32 +0,0 @@
From e80af1fd276d83858d27742ea887415e3263960b Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 12 Oct 2016 10:42:47 +1100
Subject: [PATCH] (perl 129183) don't treat \ as an escape in PATH for -S
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
util.c | 5 ++---
1 file changed, 2 insertions(+), 3 deletions(-)
diff --git a/util.c b/util.c
index 5bb0dfc..6bc2fe5 100644
--- a/util.c
+++ b/util.c
@@ -3352,9 +3352,8 @@ Perl_find_script(pTHX_ const char *scriptname, bool dosearch,
if (len < sizeof tmpbuf)
tmpbuf[len] = '\0';
# else
- s = delimcpy(tmpbuf, tmpbuf + sizeof tmpbuf, s, bufend,
- ':',
- &len);
+ s = delimcpy_no_escape(tmpbuf, tmpbuf + sizeof tmpbuf, s, bufend,
+ ':', &len);
# endif
if (s < bufend)
s++;
--
2.9.4

View File

@ -1,258 +0,0 @@
From 0db967b2e6a4093a6a5f649190159767e5d005e0 Mon Sep 17 00:00:00 2001
From: Yves Orton <demerphq@gmail.com>
Date: Tue, 25 Apr 2017 15:17:06 +0200
Subject: [PATCH] [perl #131211] fixup File::Glob degenerate matching
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
The old code would go quadratic with recursion and backtracking
when doing patterns like "a*a*a*a*a*a*a*x" on a file like
"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa".
This patch changes the code to not recurse, and to not backtrack,
as per this article from Russ Cox: https://research.swtch.com/glob
It also adds a micro-optimisation for M_ONE and M_SET under the new code.
Thanks to Avar and Russ Cox for helping with this patch, along with
Jilles Tjoelker and the rest of the FreeBSD community.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
MANIFEST | 1 +
ext/File-Glob/bsd_glob.c | 64 +++++++++++++++++++++++--------
ext/File-Glob/t/rt131211.t | 94 ++++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 144 insertions(+), 15 deletions(-)
create mode 100644 ext/File-Glob/t/rt131211.t
diff --git a/MANIFEST b/MANIFEST
index b7b6e74..af0da6c 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -3948,6 +3948,7 @@ ext/File-Glob/t/basic.t See if File::Glob works
ext/File-Glob/t/case.t See if File::Glob works
ext/File-Glob/t/global.t See if File::Glob works
ext/File-Glob/t/rt114984.t See if File::Glob works
+ext/File-Glob/t/rt131211.t See if File::Glob works
ext/File-Glob/t/taint.t See if File::Glob works
ext/File-Glob/t/threads.t See if File::Glob + threads works
ext/File-Glob/TODO File::Glob extension todo list
diff --git a/ext/File-Glob/bsd_glob.c b/ext/File-Glob/bsd_glob.c
index 821ef20..e96fb73 100644
--- a/ext/File-Glob/bsd_glob.c
+++ b/ext/File-Glob/bsd_glob.c
@@ -563,8 +563,12 @@ glob0(const Char *pattern, glob_t *pglob)
break;
case BG_STAR:
pglob->gl_flags |= GLOB_MAGCHAR;
- /* collapse adjacent stars to one,
- * to avoid exponential behavior
+ /* Collapse adjacent stars to one.
+ * This is required to ensure that a pattern like
+ * "a**" matches a name like "a", as without this
+ * check when the first star matched everything it would
+ * cause the second star to return a match fail.
+ * As long ** is folded here this does not happen.
*/
if (bufnext == patbuf || bufnext[-1] != M_ALL)
*bufnext++ = M_ALL;
@@ -909,35 +913,56 @@ globextend(const Char *path, glob_t *pglob, size_t *limitp)
/*
- * pattern matching function for filenames. Each occurrence of the *
- * pattern causes a recursion level.
+ * pattern matching function for filenames using state machine to avoid
+ * recursion. We maintain a "nextp" and "nextn" to allow us to backtrack
+ * without additional callframes, and to do cleanly prune the backtracking
+ * state when multiple '*' (start) matches are included in the patter.
+ *
+ * Thanks to Russ Cox for the improved state machine logic to avoid quadratic
+ * matching on failure.
+ *
+ * https://research.swtch.com/glob
+ *
+ * An example would be a pattern
+ * ("a*" x 100) . "y"
+ * against a file name like
+ * ("a" x 100) . "x"
+ *
*/
static int
match(Char *name, Char *pat, Char *patend, int nocase)
{
int ok, negate_range;
Char c, k;
+ Char *nextp = NULL;
+ Char *nextn = NULL;
+ loop:
while (pat < patend) {
c = *pat++;
switch (c & M_MASK) {
case M_ALL:
if (pat == patend)
return(1);
- do
- if (match(name, pat, patend, nocase))
- return(1);
- while (*name++ != BG_EOS)
- ;
- return(0);
+ if (*name == BG_EOS)
+ return 0;
+ nextn = name + 1;
+ nextp = pat - 1;
+ break;
case M_ONE:
+ /* since * matches leftmost-shortest first *
+ * if we encounter the EOS then backtracking *
+ * will not help, so we can exit early here. */
if (*name++ == BG_EOS)
- return(0);
+ return 0;
break;
case M_SET:
ok = 0;
+ /* since * matches leftmost-shortest first *
+ * if we encounter the EOS then backtracking *
+ * will not help, so we can exit early here. */
if ((k = *name++) == BG_EOS)
- return(0);
+ return 0;
if ((negate_range = ((*pat & M_MASK) == M_NOT)) != BG_EOS)
++pat;
while (((c = *pat++) & M_MASK) != M_END)
@@ -953,16 +978,25 @@ match(Char *name, Char *pat, Char *patend, int nocase)
} else if (nocase ? (tolower(c) == tolower(k)) : (c == k))
ok = 1;
if (ok == negate_range)
- return(0);
+ goto fail;
break;
default:
k = *name++;
if (nocase ? (tolower(k) != tolower(c)) : (k != c))
- return(0);
+ goto fail;
break;
}
}
- return(*name == BG_EOS);
+ if (*name == BG_EOS)
+ return 1;
+
+ fail:
+ if (nextn) {
+ pat = nextp;
+ name = nextn;
+ goto loop;
+ }
+ return 0;
}
/* Free allocated data belonging to a glob_t structure. */
diff --git a/ext/File-Glob/t/rt131211.t b/ext/File-Glob/t/rt131211.t
new file mode 100644
index 0000000..c1bcbe0
--- /dev/null
+++ b/ext/File-Glob/t/rt131211.t
@@ -0,0 +1,94 @@
+use strict;
+use warnings;
+use v5.16.0;
+use File::Temp 'tempdir';
+use File::Spec::Functions;
+use Test::More;
+use Time::HiRes qw(time);
+
+plan tests => 13;
+
+my $path = tempdir uc cleanup => 1;
+my @files= (
+ "x".("a" x 50)."b", # 0
+ "abbbbbbbbbbbbc", # 1
+ "abbbbbbbbbbbbd", # 2
+ "aaabaaaabaaaabc", # 3
+ "pq", # 4
+ "r", # 5
+ "rttiiiiiii", # 6
+ "wewewewewewe", # 7
+ "weeeweeeweee", # 8
+ "weewweewweew", # 9
+ "wewewewewewewewewewewewewewewewewq", # 10
+ "wtttttttetttttttwr", # 11
+);
+
+
+foreach (@files) {
+ open(my $f, ">", catfile $path, $_);
+}
+
+my $elapsed_fail= 0;
+my $elapsed_match= 0;
+my @got_files;
+my @no_files;
+my $count = 0;
+
+while (++$count < 10) {
+ $elapsed_match -= time;
+ @got_files= glob catfile $path, "x".("a*" x $count) . "b";
+ $elapsed_match += time;
+
+ $elapsed_fail -= time;
+ @no_files= glob catfile $path, "x".("a*" x $count) . "c";
+ $elapsed_fail += time;
+ last if $elapsed_fail > $elapsed_match * 100;
+}
+
+is $count,10,
+ "tried all the patterns without bailing out";
+
+cmp_ok $elapsed_fail/$elapsed_match,"<",2,
+ "time to fail less than twice the time to match";
+is "@got_files", catfile($path, $files[0]),
+ "only got the expected file for xa*..b";
+is "@no_files", "", "shouldnt have files for xa*..c";
+
+
+@got_files= glob catfile $path, "a*b*b*b*bc";
+is "@got_files", catfile($path, $files[1]),
+ "only got the expected file for a*b*b*b*bc";
+
+@got_files= sort glob catfile $path, "a*b*b*bc";
+is "@got_files", catfile($path, $files[3])." ".catfile($path,$files[1]),
+ "got the expected two files for a*b*b*bc";
+
+@got_files= sort glob catfile $path, "p*";
+is "@got_files", catfile($path, $files[4]),
+ "p* matches pq";
+
+@got_files= sort glob catfile $path, "r*???????";
+is "@got_files", catfile($path, $files[6]),
+ "r*??????? works as expected";
+
+@got_files= sort glob catfile $path, "w*e*w??e";
+is "@got_files", join(" ", sort map { catfile($path, $files[$_]) } (7,8)),
+ "w*e*w??e works as expected";
+
+@got_files= sort glob catfile $path, "w*e*we??";
+is "@got_files", join(" ", sort map { catfile($path, $files[$_]) } (7,8,9,10)),
+ "w*e*we?? works as expected";
+
+@got_files= sort glob catfile $path, "w**e**w";
+is "@got_files", join(" ", sort map { catfile($path, $files[$_]) } (9)),
+ "w**e**w works as expected";
+
+@got_files= sort glob catfile $path, "*wee*";
+is "@got_files", join(" ", sort map { catfile($path, $files[$_]) } (8,9)),
+ "*wee* works as expected";
+
+@got_files= sort glob catfile $path, "we*";
+is "@got_files", join(" ", sort map { catfile($path, $files[$_]) } (7,8,9,10)),
+ "we* works as expected";
+
--
2.9.4

View File

@ -1,45 +0,0 @@
From b4d257e2d408f0f1c6686dcdc112f3ebfec68f44 Mon Sep 17 00:00:00 2001
From: Yves Orton <demerphq@gmail.com>
Date: Tue, 27 Jun 2017 10:22:23 +0200
Subject: [PATCH] File::Glob - tweak rt131211.t to be less sensitive on wonky
boxes
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
make the test less senstive and avoid divide by zero errors,
also we skip the test if either elapsed_match or elapsed_fail is
true, as we can not rely on the timings then. For the operations
we are doing we should get a non-zero timing from Time::HiRes.
This should mean that running this test on boxes with heavy
load, etc, will no longer result in false positives.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
ext/File-Glob/t/rt131211.t | 9 +++++++--
1 file changed, 7 insertions(+), 2 deletions(-)
diff --git a/ext/File-Glob/t/rt131211.t b/ext/File-Glob/t/rt131211.t
index c1bcbe0..b29cd04 100644
--- a/ext/File-Glob/t/rt131211.t
+++ b/ext/File-Glob/t/rt131211.t
@@ -49,8 +49,13 @@ while (++$count < 10) {
is $count,10,
"tried all the patterns without bailing out";
-cmp_ok $elapsed_fail/$elapsed_match,"<",2,
- "time to fail less than twice the time to match";
+SKIP: {
+ skip "unstable timing", 1 unless $elapsed_match && $elapsed_fail;
+ ok $elapsed_fail <= 10 * $elapsed_match,
+ "time to fail less than 10x the time to match"
+ or diag("elapsed_match=$elapsed_match elapsed_fail=$elapsed_fail");
+}
+
is "@got_files", catfile($path, $files[0]),
"only got the expected file for xa*..b";
is "@no_files", "", "shouldnt have files for xa*..c";
--
2.9.4

View File

@ -1,226 +0,0 @@
From 5aca16e032861ea3dfcc96ad417ea87e2b1552e5 Mon Sep 17 00:00:00 2001
From: Aaron Crane <arc@cpan.org>
Date: Sat, 4 Mar 2017 12:50:58 +0000
Subject: [PATCH] RT #130907: Fix the Unicode Bug in split " "
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Ported to 5.26.0:
commit 20ae58f7a9bbf84d043d6e90f5988b6e3ca4ee3d
Author: Aaron Crane <arc@cpan.org>
Date: Sat Mar 4 12:50:58 2017 +0000
RT #130907: Fix the Unicode Bug in split " "
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
lib/feature.pm | 5 +++--
pod/perldelta.pod | 9 +++++++++
pod/perlfunc.pod | 8 ++++++++
pod/perlunicode.pod | 11 +++++++++++
pod/perluniintro.pod | 5 +++--
pp.c | 13 +++++++++++++
regen/feature.pl | 5 +++--
t/op/split.t | 20 +++++++++++++++++++-
8 files changed, 69 insertions(+), 7 deletions(-)
diff --git a/lib/feature.pm b/lib/feature.pm
index ed13273..93e020b 100644
--- a/lib/feature.pm
+++ b/lib/feature.pm
@@ -175,8 +175,9 @@ C<use feature 'unicode_strings'> subpragma is B<strongly> recommended.
This feature is available starting with Perl 5.12; was almost fully
implemented in Perl 5.14; and extended in Perl 5.16 to cover C<quotemeta>;
-and extended further in Perl 5.26 to cover L<the range
-operator|perlop/Range Operators>.
+was extended further in Perl 5.26 to cover L<the range
+operator|perlop/Range Operators>; and was extended again in Perl 5.28 to
+cover L<special-cased whitespace splitting|perlfunc/split>.
=head2 The 'unicode_eval' and 'evalbytes' features
#diff --git a/pod/perldelta.pod b/pod/perldelta.pod
#index 06dcd1d..d31335f 100644
#--- a/pod/perldelta.pod
#+++ b/pod/perldelta.pod
#@@ -3206,6 +3206,15 @@ calls.
# Parsing bad POSIX charclasses no longer leaks memory.
# L<[perl #128313]|https://rt.perl.org/Public/Bug/Display.html?id=128313>
#
#+=item *
#+
#+C<split ' '> now correctly handles the argument being split when in the
#+scope of the L<< C<unicode_strings>|feature/"The 'unicode_strings' feature"
#+>> feature. Previously, when a string using the single-byte internal
#+representation contained characters that are whitespace by Unicode rules but
#+not by ASCII rules, it treated those characters as part of fields rather
#+than as field separators. [perl #130907]
#+
# =back
#
# =head1 Known Problems
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index b8dca6e..9abadf4 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -7616,6 +7616,14 @@ special case was restricted to the use of a plain S<C<" ">> as the
pattern argument to split; in Perl 5.18.0 and later this special case is
triggered by any expression which evaluates to the simple string S<C<" ">>.
+As of Perl 5.28, this special-cased whitespace splitting works as expected in
+the scope of L<< S<C<"use feature 'unicode_strings">>|feature/The
+'unicode_strings' feature >>. In previous versions, and outside the scope of
+that feature, it exhibits L<perlunicode/The "Unicode Bug">: characters that are
+whitespace according to Unicode rules but not according to ASCII rules can be
+treated as part of fields rather than as field separators, depending on the
+string's internal encoding.
+
If omitted, PATTERN defaults to a single space, S<C<" ">>, triggering
the previously described I<awk> emulation.
diff --git a/pod/perlunicode.pod b/pod/perlunicode.pod
index 9c13c35..2e84e95 100644
--- a/pod/perlunicode.pod
+++ b/pod/perlunicode.pod
@@ -1835,6 +1835,17 @@ outside its scope, it could produce strings whose length in characters
exceeded that of the right-hand side, where the right-hand side took up more
bytes than the correct range endpoint.
+=item *
+
+In L<< C<split>'s special-case whitespace splitting|perlfunc/split >>.
+
+Starting in Perl 5.28.0, the C<split> function with a pattern specified as
+a string containing a single space handles whitespace characters consistently
+within the scope of of C<unicode_strings>. Prior to that, or outside its scope,
+characters that are whitespace according to Unicode rules but not according to
+ASCII rules were treated as field contents rather than field separators when
+they appear in byte-encoded strings.
+
=back
You can see from the above that the effect of C<unicode_strings>
diff --git a/pod/perluniintro.pod b/pod/perluniintro.pod
index d35de34..595ec46 100644
--- a/pod/perluniintro.pod
+++ b/pod/perluniintro.pod
@@ -151,11 +151,12 @@ serious Unicode work. The maintenance release 5.6.1 fixed many of the
problems of the initial Unicode implementation, but for example
regular expressions still do not work with Unicode in 5.6.1.
Perl v5.14.0 is the first release where Unicode support is
-(almost) seamlessly integrable without some gotchas. (There are two
+(almost) seamlessly integrable without some gotchas. (There are a few
exceptions. Firstly, some differences in L<quotemeta|perlfunc/quotemeta>
were fixed starting in Perl 5.16.0. Secondly, some differences in
L<the range operator|perlop/Range Operators> were fixed starting in
-Perl 5.26.0.)
+Perl 5.26.0. Thirdly, some differences in L<split|perlfunc/split> were fixed
+started in Perl 5.28.0.)
To enable this
seamless support, you should C<use feature 'unicode_strings'> (which is
diff --git a/pp.c b/pp.c
index cc4cb59..d9dd005 100644
--- a/pp.c
+++ b/pp.c
@@ -5740,6 +5740,7 @@ PP(pp_split)
STRLEN len;
const char *s = SvPV_const(sv, len);
const bool do_utf8 = DO_UTF8(sv);
+ const bool in_uni_8_bit = IN_UNI_8_BIT;
const char *strend = s + len;
PMOP *pm = cPMOPx(PL_op);
REGEXP *rx;
@@ -5826,6 +5827,10 @@ PP(pp_split)
while (s < strend && isSPACE_LC(*s))
s++;
}
+ else if (in_uni_8_bit) {
+ while (s < strend && isSPACE_L1(*s))
+ s++;
+ }
else {
while (s < strend && isSPACE(*s))
s++;
@@ -5857,6 +5862,10 @@ PP(pp_split)
{
while (m < strend && !isSPACE_LC(*m))
++m;
+ }
+ else if (in_uni_8_bit) {
+ while (m < strend && !isSPACE_L1(*m))
+ ++m;
} else {
while (m < strend && !isSPACE(*m))
++m;
@@ -5891,6 +5900,10 @@ PP(pp_split)
{
while (s < strend && isSPACE_LC(*s))
++s;
+ }
+ else if (in_uni_8_bit) {
+ while (s < strend && isSPACE_L1(*s))
+ ++s;
} else {
while (s < strend && isSPACE(*s))
++s;
diff --git a/regen/feature.pl b/regen/feature.pl
index 579120e..8a4ce63 100755
--- a/regen/feature.pl
+++ b/regen/feature.pl
@@ -485,8 +485,9 @@ C<use feature 'unicode_strings'> subpragma is B<strongly> recommended.
This feature is available starting with Perl 5.12; was almost fully
implemented in Perl 5.14; and extended in Perl 5.16 to cover C<quotemeta>;
-and extended further in Perl 5.26 to cover L<the range
-operator|perlop/Range Operators>.
+was extended further in Perl 5.26 to cover L<the range
+operator|perlop/Range Operators>; and was extended again in Perl 5.28 to
+cover L<special-cased whitespace splitting|perlfunc/split>.
=head2 The 'unicode_eval' and 'evalbytes' features
diff --git a/t/op/split.t b/t/op/split.t
index d60bcaf..038c5d7 100644
--- a/t/op/split.t
+++ b/t/op/split.t
@@ -7,7 +7,7 @@ BEGIN {
set_up_inc('../lib');
}
-plan tests => 163;
+plan tests => 172;
$FS = ':';
@@ -480,6 +480,24 @@ is($cnt, scalar(@ary));
qq{split(\$cond ? qr/ / : " ", "$exp") behaves as expected over repeated similar patterns};
}
+SKIP: {
+ # RT #130907: unicode_strings feature doesn't work with split ' '
+
+ my ($sp) = grep /\s/u, map chr, reverse 128 .. 255 # prefer \xA0 over \x85
+ or skip 'no unicode whitespace found in high-8-bit range', 9;
+
+ for (["$sp$sp. /", "leading unicode whitespace"],
+ [".$sp$sp/", "unicode whitespace separator"],
+ [". /$sp$sp", "trailing unicode whitespace"]) {
+ my ($str, $desc) = @$_;
+ use feature "unicode_strings";
+ my @got = split " ", $str;
+ is @got, 2, "whitespace split: $desc: field count";
+ is $got[0], '.', "whitespace split: $desc: field 0";
+ is $got[1], '/', "whitespace split: $desc: field 1";
+ }
+}
+
{
# 'RT #116086: split "\x20" does not work as documented';
my @results;
--
2.9.4

View File

@ -1,51 +0,0 @@
From b9a58d500dd75ba783abac92a56e57d41227f62b Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Sun, 2 Jul 2017 11:35:20 -0700
Subject: [PATCH] =?UTF-8?q?[perl=20#131679]=20Fix=20=E2=80=98our=20sub=20f?=
=?UTF-8?q?oo::bar=E2=80=99=20message?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
It should say subroutine, not variable.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
t/lib/croak/toke | 6 ++++++
toke.c | 3 ++-
2 files changed, 8 insertions(+), 1 deletion(-)
diff --git a/t/lib/croak/toke b/t/lib/croak/toke
index 7aa15ef..2603224 100644
--- a/t/lib/croak/toke
+++ b/t/lib/croak/toke
@@ -133,6 +133,12 @@ state sub;
EXPECT
Missing name in "state sub" at - line 2.
########
+# NAME our sub pack::foo
+our sub foo::bar;
+EXPECT
+No package name allowed for subroutine &foo::bar in "our" at - line 1, near "our sub foo::bar"
+Execution of - aborted due to compilation errors.
+########
# NAME my sub pack::foo
use feature 'lexical_subs', 'state';
my sub foo::bar;
diff --git a/toke.c b/toke.c
index ace92e3..6aa5f26 100644
--- a/toke.c
+++ b/toke.c
@@ -8848,7 +8848,8 @@ S_pending_ident(pTHX)
if (PL_in_my == KEY_our) { /* "our" is merely analogous to "my" */
if (has_colon)
yyerror_pv(Perl_form(aTHX_ "No package name allowed for "
- "variable %s in \"our\"",
+ "%se %s in \"our\"",
+ *PL_tokenbuf=='&' ?"subroutin":"variabl",
PL_tokenbuf), UTF ? SVf_UTF8 : 0);
tmp = allocmy(PL_tokenbuf, tokenbuf_len, UTF ? SVf_UTF8 : 0);
}
--
2.9.4

View File

@ -1,30 +0,0 @@
From 97e57bec1f0ba4f0c3b1dc18ee146632010e3373 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Sat, 15 Jul 2017 19:36:25 -0600
Subject: [PATCH] t/lib/warnings/utf8: Fix test
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
There is some randomness to this test added to fix [perl #131646].
Change what passes to be a pattern that matches the correct template
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
t/lib/warnings/utf8 | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/t/lib/warnings/utf8 b/t/lib/warnings/utf8
index 9066308..dfc58c1 100644
--- a/t/lib/warnings/utf8
+++ b/t/lib/warnings/utf8
@@ -781,4 +781,5 @@ no warnings;
use warnings 'utf8';
for(uc 0..t){0~~pack"UXc",exp}
EXPECT
-Malformed UTF-8 character: \xc2\x00 (unexpected non-continuation byte 0x00, immediately after start byte 0xc2; need 2 bytes, got 1) in smart match at - line 9.
+OPTIONS regex
+Malformed UTF-8 character: \\x([[:xdigit:]]{2})\\x([[:xdigit:]]{2}) \(unexpected non-continuation byte 0x\2, immediately after start byte 0x\1; need 2 bytes, got 1\) in smart match at - line 9.
--
2.9.4

View File

@ -1,43 +0,0 @@
From 05b9033b464ce8dd2c9b33238f9aa14755d7a91a Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Sat, 17 Jun 2017 17:56:10 -0600
Subject: [PATCH] utf8n_to_uvchr(): Don't display too many bytes in msg
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
When raising a message about malformed UTF-8, we shouldn't display bytes
from the next character, unless those bytes were expected to have been
part of the current one. Tests for this will be added in future commits
in ext/XS-APItest/t/utf8_warn_base.pl
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
utf8.c | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/utf8.c b/utf8.c
index ee5405f..e55a6f1 100644
--- a/utf8.c
+++ b/utf8.c
@@ -1428,7 +1428,7 @@ Perl_utf8n_to_uvchr_error(pTHX_ const U8 *s,
if (pack_warn) {
message = Perl_form(aTHX_ "%s: %s (overflows)",
malformed_text,
- _byte_dump_string(s0, send - s0, 0));
+ _byte_dump_string(s0, curlen, 0));
}
}
}
@@ -1554,7 +1554,7 @@ Perl_utf8n_to_uvchr_error(pTHX_ const U8 *s,
"%s: %s (overlong; instead use %s to represent"
" U+%0*" UVXf ")",
malformed_text,
- _byte_dump_string(s0, send - s0, 0),
+ _byte_dump_string(s0, curlen, 0),
_byte_dump_string(tmpbuf, e - tmpbuf, 0),
((uv < 256) ? 2 : 4), /* Field width of 2 for
small code points */
--
2.9.4

View File

@ -1,57 +0,0 @@
From 8121278aa8fe72e9e8aca8651c7f1d4fa204ac1d Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Mon, 2 Apr 2018 21:54:59 -0600
Subject: [PATCH] PATCH: [perl #132167] Parse error in regex_sets
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
When popping the stack, the code inappropriately also subtracted one
from the result. This is probably left over from an earlier change in
the implementation. The top of the stack contained the correct value;
subtracting was a mistake.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
regcomp.c | 2 +-
t/re/regex_sets.t | 11 +++++++++++
2 files changed, 12 insertions(+), 1 deletion(-)
diff --git a/regcomp.c b/regcomp.c
index 018d5646fc..39ab260efa 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -15689,7 +15689,7 @@ redo_curchar:
* fence. Get rid of it */
fence_ptr = av_pop(fence_stack);
assert(fence_ptr);
- fence = SvIV(fence_ptr) - 1;
+ fence = SvIV(fence_ptr);
SvREFCNT_dec_NN(fence_ptr);
fence_ptr = NULL;
diff --git a/t/re/regex_sets.t b/t/re/regex_sets.t
index e9644bd4e6..e70df81254 100644
--- a/t/re/regex_sets.t
+++ b/t/re/regex_sets.t
@@ -204,6 +204,17 @@ for my $char ("٠", "٥", "٩") {
like("a", qr/$pat/, "/$pat/ compiles and matches 'a'");
}
+{ # [perl #132167]
+ fresh_perl_is('no warnings "experimental::regex_sets";
+ print "c" =~ qr/(?[ ( \p{Uppercase} ) + (\p{Lowercase} - ([a] + [b])) ])/;',
+ 1, {},
+ 'qr/(?[ ( \p{Uppercase} ) + (\p{Lowercase} - ([a] + [b])) ]) compiles and properly matches');
+ fresh_perl_is('no warnings "experimental::regex_sets";
+ print "b" =~ qr/(?[ ( \p{Uppercase} ) + (\p{Lowercase} - ([a] + [b])) ])/;',
+ "", {},
+ 'qr/(?[ ( \p{Uppercase} ) + (\p{Lowercase} - ([a] + [b])) ]) compiles and properly matches');
+}
+
done_testing();
1;
--
2.14.3

View File

@ -1,71 +0,0 @@
From 62e6b70574842d7f2c547d33c85c50228522f685 Mon Sep 17 00:00:00 2001
From: Marc-Philip <marc-philip.werner@sap.com>
Date: Sun, 8 Apr 2018 12:15:29 -0600
Subject: [PATCH] PATCH: [perl #133074] 5.26.1: some coverity fixes
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
we have some coverity code scans here. They have found this
uninilialized variable in pp.c and the integer overrun in toke.c.
Though it might be possible that these are false positives (no
reasonable control path gets there), it's good to mute the scan here to
see the real problems easier.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
pp.c | 1 +
toke.c | 8 ++++----
2 files changed, 5 insertions(+), 4 deletions(-)
diff --git a/pp.c b/pp.c
index 5524131658..d777ae4309 100644
--- a/pp.c
+++ b/pp.c
@@ -3727,6 +3727,7 @@ PP(pp_ucfirst)
if (! slen) { /* If empty */
need = 1; /* still need a trailing NUL */
ulen = 0;
+ *tmpbuf = '\0';
}
else if (DO_UTF8(source)) { /* Is the source utf8? */
doing_utf8 = TRUE;
diff --git a/toke.c b/toke.c
index 3405dc6c89..fc87252bb1 100644
--- a/toke.c
+++ b/toke.c
@@ -9052,7 +9052,7 @@ S_pending_ident(pTHX)
HEK * const stashname = HvNAME_HEK(stash);
SV * const sym = newSVhek(stashname);
sv_catpvs(sym, "::");
- sv_catpvn_flags(sym, PL_tokenbuf+1, tokenbuf_len - 1, (UTF ? SV_CATUTF8 : SV_CATBYTES ));
+ sv_catpvn_flags(sym, PL_tokenbuf+1, tokenbuf_len > 0 ? tokenbuf_len - 1 : 0, (UTF ? SV_CATUTF8 : SV_CATBYTES ));
pl_yylval.opval = newSVOP(OP_CONST, 0, sym);
pl_yylval.opval->op_private = OPpCONST_ENTERED;
if (pit != '&')
@@ -9080,7 +9080,7 @@ S_pending_ident(pTHX)
&& PL_lex_state != LEX_NORMAL
&& !PL_lex_brackets)
{
- GV *const gv = gv_fetchpvn_flags(PL_tokenbuf + 1, tokenbuf_len - 1,
+ GV *const gv = gv_fetchpvn_flags(PL_tokenbuf + 1, tokenbuf_len > 0 ? tokenbuf_len - 1 : 0,
( UTF ? SVf_UTF8 : 0 ) | GV_ADDMG,
SVt_PVAV);
if ((!gv || ((PL_tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv)))
@@ -9097,11 +9097,11 @@ S_pending_ident(pTHX)
/* build ops for a bareword */
pl_yylval.opval = newSVOP(OP_CONST, 0,
newSVpvn_flags(PL_tokenbuf + 1,
- tokenbuf_len - 1,
+ tokenbuf_len > 0 ? tokenbuf_len - 1 : 0,
UTF ? SVf_UTF8 : 0 ));
pl_yylval.opval->op_private = OPpCONST_ENTERED;
if (pit != '&')
- gv_fetchpvn_flags(PL_tokenbuf+1, tokenbuf_len - 1,
+ gv_fetchpvn_flags(PL_tokenbuf+1, tokenbuf_len > 0 ? tokenbuf_len - 1 : 0,
(PL_in_eval ? GV_ADDMULTI : GV_ADD)
| ( UTF ? SVf_UTF8 : 0 ),
((PL_tokenbuf[0] == '$') ? SVt_PV
--
2.14.3

View File

@ -1,45 +0,0 @@
From 357c35e6f18e65f372e7a1b22ee39a3c7c9e5810 Mon Sep 17 00:00:00 2001
From: Robin Barker <RMBarker@cpan.org>
Date: Mon, 17 Dec 2012 18:20:14 +0100
Subject: [PATCH] Avoid compiler warnings due to mismatched types in *printf
format strings.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
gcc (and probably others) was warning about a mismatch for between `int`
(implied by the format %d) and the actual type passed, `line_t`. Avoid this
by explicitly casting to UV, and using UVuf.
CPAN #63832
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
cpan/ExtUtils-Constant/lib/ExtUtils/Constant/ProxySubs.pm | 7 ++++---
1 file changed, 4 insertions(+), 3 deletions(-)
diff --git a/cpan/ExtUtils-Constant/lib/ExtUtils/Constant/ProxySubs.pm b/cpan/ExtUtils-Constant/lib/ExtUtils/Constant/ProxySubs.pm
index 545d322..c7e6d05 100644
--- a/cpan/ExtUtils-Constant/lib/ExtUtils/Constant/ProxySubs.pm
+++ b/cpan/ExtUtils-Constant/lib/ExtUtils/Constant/ProxySubs.pm
@@ -629,13 +629,14 @@ EOA
if ((C_ARRAY_LENGTH(values_for_notfound) > 1)
? hv_exists_ent(${c_subname}_missing, sv, 0) : 0) {
sv = newSVpvf("Your vendor has not defined $package_sprintf_safe macro %" SVf
- ", used at %" COP_FILE_F " line %d\\n", sv,
- COP_FILE(cop), CopLINE(cop));
+ ", used at %" COP_FILE_F " line %" UVuf "\\n",
+ sv, COP_FILE(cop), (UV)CopLINE(cop));
} else
#endif
{
sv = newSVpvf("%"SVf" is not a valid $package_sprintf_safe macro at %"
- COP_FILE_F " line %d\\n", sv, COP_FILE(cop), CopLINE(cop));
+ COP_FILE_F " line %" UVuf "\\n",
+ sv, COP_FILE(cop), (UV)CopLINE(cop));
}
croak_sv(sv_2mortal(sv));
EOC
--
2.9.4

View File

@ -1,69 +0,0 @@
From 389f3ef2fdfbba2c2816e7334a69a5f540c0a33d Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Mon, 15 Dec 2014 16:14:13 +0000
Subject: [PATCH] EU::Constant: avoid 'uninit' warning
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
The code generated by ExtUtils::Constant can look something like:
static int
constant (..., IV *iv_return) {
switch (...) {
case ...:
*iv_return = ...;
return PERL_constant_ISIV;
...
}
}
{
int type;
IV iv;
type = constant(..., &iv);
switch (type) {
case PERL_constant_ISIV:
PUSHi(iv);
...
}
}
and the compiler isn't clever enough to realise that the value of iv
is only used in the code path where its been set.
So initialise it to zero to shut gcc up. Ditto nv and pv.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
cpan/ExtUtils-Constant/lib/ExtUtils/Constant.pm | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/cpan/ExtUtils-Constant/lib/ExtUtils/Constant.pm b/cpan/ExtUtils-Constant/lib/ExtUtils/Constant.pm
index 0dc9258..cf0e1ca 100644
--- a/cpan/ExtUtils-Constant/lib/ExtUtils/Constant.pm
+++ b/cpan/ExtUtils-Constant/lib/ExtUtils/Constant.pm
@@ -198,17 +198,17 @@ $XS_subname(sv)
EOT
if ($params->{IV}) {
- $xs .= " IV iv;\n";
+ $xs .= " IV iv = 0; /* avoid uninit var warning */\n";
} else {
$xs .= " /* IV\t\tiv;\tUncomment this if you need to return IVs */\n";
}
if ($params->{NV}) {
- $xs .= " NV nv;\n";
+ $xs .= " NV nv = 0.0; /* avoid uninit var warning */\n";
} else {
$xs .= " /* NV\t\tnv;\tUncomment this if you need to return NVs */\n";
}
if ($params->{PV}) {
- $xs .= " const char *pv;\n";
+ $xs .= " const char *pv = NULL; /* avoid uninit var warning */\n";
} else {
$xs .=
" /* const char\t*pv;\tUncomment this if you need to return PVs */\n";
--
2.9.4

View File

@ -1,60 +0,0 @@
From 45908e4d120d33a558a8b052036c56cd0c90b898 Mon Sep 17 00:00:00 2001
From: Yves Orton <demerphq@gmail.com>
Date: Wed, 13 Sep 2017 13:30:25 +0200
Subject: [PATCH] avoid 'the address of ... will always evaluate as ...' warns
in mem macros
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
In f14cf363205 we added asserts to our memory macros (Copy(), Zero() etc)
to ensure that the target is non-null. These asserts throw warnings like
perl.c: In function Perl_eval_sv:
perl.c:2976:264: warning: the address of myop will always evaluate
as true [-Waddress]
Zero(&myop, 1, UNOP);
which is annoying. This patch changes how these asserts are coded so
we avoid the warning. Thanks to Zefram for the fix.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
handy.h | 17 ++++++++++-------
1 file changed, 10 insertions(+), 7 deletions(-)
diff --git a/handy.h b/handy.h
index 31afaae65e..85e8f70721 100644
--- a/handy.h
+++ b/handy.h
@@ -2409,17 +2409,20 @@ void Perl_mem_log_del_sv(const SV *sv, const char *filename, const int linenumbe
#define Safefree(d) safefree(MEM_LOG_FREE((Malloc_t)(d)))
#endif
-#define Move(s,d,n,t) (MEM_WRAP_CHECK_(n,t) assert(d), assert(s), (void)memmove((char*)(d),(const char*)(s), (n) * sizeof(t)))
-#define Copy(s,d,n,t) (MEM_WRAP_CHECK_(n,t) assert(d), assert(s), (void)memcpy((char*)(d),(const char*)(s), (n) * sizeof(t)))
-#define Zero(d,n,t) (MEM_WRAP_CHECK_(n,t) assert(d), (void)memzero((char*)(d), (n) * sizeof(t)))
+#define perl_assert_ptr(p) assert( ((void*)(p)) != 0 )
-#define MoveD(s,d,n,t) (MEM_WRAP_CHECK_(n,t) assert(d), assert(s), memmove((char*)(d),(const char*)(s), (n) * sizeof(t)))
-#define CopyD(s,d,n,t) (MEM_WRAP_CHECK_(n,t) assert(d), assert(s), memcpy((char*)(d),(const char*)(s), (n) * sizeof(t)))
+
+#define Move(s,d,n,t) (MEM_WRAP_CHECK_(n,t) perl_assert_ptr(d), perl_assert_ptr(s), (void)memmove((char*)(d),(const char*)(s), (n) * sizeof(t)))
+#define Copy(s,d,n,t) (MEM_WRAP_CHECK_(n,t) perl_assert_ptr(d), perl_assert_ptr(s), (void)memcpy((char*)(d),(const char*)(s), (n) * sizeof(t)))
+#define Zero(d,n,t) (MEM_WRAP_CHECK_(n,t) perl_assert_ptr(d), (void)memzero((char*)(d), (n) * sizeof(t)))
+
+#define MoveD(s,d,n,t) (MEM_WRAP_CHECK_(n,t) perl_assert_ptr(d), perl_assert_ptr(s), memmove((char*)(d),(const char*)(s), (n) * sizeof(t)))
+#define CopyD(s,d,n,t) (MEM_WRAP_CHECK_(n,t) perl_assert_ptr(d), perl_assert_ptr(s), memcpy((char*)(d),(const char*)(s), (n) * sizeof(t)))
#ifdef HAS_MEMSET
-#define ZeroD(d,n,t) (MEM_WRAP_CHECK_(n,t) assert(d), memzero((char*)(d), (n) * sizeof(t)))
+#define ZeroD(d,n,t) (MEM_WRAP_CHECK_(n,t) perl_assert_ptr(d), memzero((char*)(d), (n) * sizeof(t)))
#else
/* Using bzero(), which returns void. */
-#define ZeroD(d,n,t) (MEM_WRAP_CHECK_(n,t) assert(d), memzero((char*)(d), (n) * sizeof(t)),d)
+#define ZeroD(d,n,t) (MEM_WRAP_CHECK_(n,t) perl_assert_ptr(d), memzero((char*)(d), (n) * sizeof(t)),d)
#endif
#define PoisonWith(d,n,t,b) (MEM_WRAP_CHECK_(n,t) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t)))
--
2.13.6

View File

@ -1,30 +0,0 @@
From 4369267db9ca4982c1a9bd1ef680bc4350decc3a Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 18 Sep 2017 15:07:21 +1000
Subject: [PATCH] (perl #132008) try to prevent the similar mistakes in the
future
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
dist/Term-ReadLine/lib/Term/ReadLine.pm | 2 ++
1 file changed, 2 insertions(+)
diff --git a/dist/Term-ReadLine/lib/Term/ReadLine.pm b/dist/Term-ReadLine/lib/Term/ReadLine.pm
index e00fb376cd..78c1ebf5b6 100644
--- a/dist/Term-ReadLine/lib/Term/ReadLine.pm
+++ b/dist/Term-ReadLine/lib/Term/ReadLine.pm
@@ -75,6 +75,8 @@ history. Returns the old value.
returns an array with two strings that give most appropriate names for
files for input and output using conventions C<"E<lt>$in">, C<"E<gt>out">.
+The strings returned may not be useful for 3-argument open().
+
=item Attribs
returns a reference to a hash which describes internal configuration
--
2.13.6

View File

@ -1,32 +0,0 @@
From e7e69c85c7e8e0cb75b831e606ad4f26f18b11ff Mon Sep 17 00:00:00 2001
From: Nicolas R <atoomic@cpan.org>
Date: Mon, 31 Oct 2016 11:53:17 -0600
Subject: [PATCH] Avoid a segfault when untying an object
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Check if the tied object has a stash set
before calling UNTIE method.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
pp_sys.c | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/pp_sys.c b/pp_sys.c
index 672e7de08e..6d4dd86b7f 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1017,7 +1017,7 @@ PP(pp_untie)
if ((mg = SvTIED_mg(sv, how))) {
SV * const obj = SvRV(SvTIED_obj(sv, mg));
- if (obj) {
+ if (obj && SvSTASH(obj)) {
GV * const gv = gv_fetchmethod_autoload(SvSTASH(obj), "UNTIE", FALSE);
CV *cv;
if (gv && isGV(gv) && (cv = GvCV(gv))) {
--
2.13.6

View File

@ -1,73 +0,0 @@
From b3937e202aaf10c2f8996e2993c880bb38a7a268 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Wed, 1 Nov 2017 13:11:27 -0700
Subject: [PATCH] =?UTF-8?q?Carp:=20Don=E2=80=99t=20choke=20on=20ISA=20cons?=
=?UTF-8?q?tant?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
This broke some time between 1.29 (perl 5.18) and 1.3301 (perl 5.20):
$ perl5.20.1 -e 'package Foo { use constant ISA => 42; Bar::f() } package Bar { use Carp; sub f { carp "tun syn" } }'
Not a GLOB reference at /usr/local/lib/perl5/5.20.1/Carp.pm line 560.
and still persisted in bleadperl (Carp 1.43) until this commit.
The code that goes poking through the symbol table needs to take into
account that not all stash elements are globs.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
dist/Carp/lib/Carp.pm | 3 ++-
dist/Carp/t/Carp.t | 13 ++++++++++++-
2 files changed, 14 insertions(+), 2 deletions(-)
diff --git a/dist/Carp/lib/Carp.pm b/dist/Carp/lib/Carp.pm
index 6127b26f54..ef11a0c046 100644
--- a/dist/Carp/lib/Carp.pm
+++ b/dist/Carp/lib/Carp.pm
@@ -593,7 +593,8 @@ sub trusts_directly {
for my $var (qw/ CARP_NOT ISA /) {
# Don't try using the variable until we know it exists,
# to avoid polluting the caller's namespace.
- if ( $stash->{$var} && *{$stash->{$var}}{ARRAY} && @{$stash->{$var}} ) {
+ if ( $stash->{$var} && ref \$stash->{$var} eq 'GLOB'
+ && *{$stash->{$var}}{ARRAY} && @{$stash->{$var}} ) {
return @{$stash->{$var}}
}
}
diff --git a/dist/Carp/t/Carp.t b/dist/Carp/t/Carp.t
index 65daed7c6c..b1e399d143 100644
--- a/dist/Carp/t/Carp.t
+++ b/dist/Carp/t/Carp.t
@@ -3,7 +3,7 @@ no warnings "once";
use Config;
use IPC::Open3 1.0103 qw(open3);
-use Test::More tests => 67;
+use Test::More tests => 68;
sub runperl {
my(%args) = @_;
@@ -488,6 +488,17 @@ SKIP:
);
}
+{
+ package Mpar;
+ sub f { Carp::croak "tun syn" }
+
+ package Phou;
+ $Phou::{ISA} = \42;
+ eval { Mpar::f };
+}
+like $@, qr/tun syn/, 'Carp can handle non-glob ISA stash elems';
+
+
# New tests go here
# line 1 "XA"
--
2.13.6

View File

@ -1,593 +0,0 @@
From 3f8a98327dfdb171bd6e447fec23721b0e74c7a6 Mon Sep 17 00:00:00 2001
From: Zefram <zefram@fysh.org>
Date: Sun, 19 Nov 2017 09:15:53 +0000
Subject: [PATCH] fix tainting of s/// with overloaded replacement
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
The substitution code was trying to track the taintedness of the
replacement string itself, but it didn't account for the replacement
being an untainted object with overloading that returns a tainted
stringification. It looked at the taintedness of the object value, not
realising that taint could arise during the string concatenation per se.
Change the taint checks to look at the actual TAINT_get flag after string
concatenation. This may falsely ascribe to the replacement taint that
actually came from somewhere else, but the end result is the same anyway:
there's no visible behaviour that distinguishes taint specifically from
the replacement. Also remove a related taint check that seems to be
not needed at all. Fixes [perl #115266].
Petr Písař: Ported to 5.26.1.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
pp_ctl.c | 4 +-
pp_hot.c | 4 +-
t/op/taint.t | 428 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++--
3 files changed, 422 insertions(+), 14 deletions(-)
diff --git a/pp_ctl.c b/pp_ctl.c
index f136f91..15c193b 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -219,9 +219,9 @@ PP(pp_substcont)
SvGETMAGIC(TOPs); /* possibly clear taint on $1 etc: #67962 */
/* See "how taint works" above pp_subst() */
- if (SvTAINTED(TOPs))
- cx->sb_rxtainted |= SUBST_TAINT_REPL;
sv_catsv_nomg(dstr, POPs);
+ if (UNLIKELY(TAINT_get))
+ cx->sb_rxtainted |= SUBST_TAINT_REPL;
if (CxONCE(cx) || s < orig ||
!CALLREGEXEC(rx, s, cx->sb_strend, orig,
(s == m), cx->sb_targ, NULL,
diff --git a/pp_hot.c b/pp_hot.c
index f445fd9..5899413 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -3250,7 +3250,7 @@ PP(pp_subst)
doutf8 = DO_UTF8(dstr);
}
- if (SvTAINTED(dstr))
+ if (UNLIKELY(TAINT_get))
rxtainted |= SUBST_TAINT_REPL;
}
else {
@@ -3421,8 +3421,6 @@ PP(pp_subst)
}
else {
sv_catsv(dstr, repl);
- if (UNLIKELY(SvTAINTED(repl)))
- rxtainted |= SUBST_TAINT_REPL;
}
if (once)
break;
diff --git a/t/op/taint.t b/t/op/taint.t
index c13eaf6..be5eaa8 100644
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -17,7 +17,7 @@ BEGIN {
use strict;
use Config;
-plan tests => 828;
+plan tests => 1040;
$| = 1;
@@ -83,6 +83,8 @@ EndOfCleanup
# Sources of taint:
# The empty tainted value, for tainting strings
my $TAINT = substr($^X, 0, 0);
+# A tainted non-empty string
+my $TAINTXYZ = "xyz".$TAINT;
# A tainted zero, useful for tainting numbers
my $TAINT0;
{
@@ -565,7 +567,7 @@ my $TEST = 'TEST';
is($one, 'abcd', "$desc: \$1 value");
}
- $desc = "substitution with replacement tainted";
+ $desc = "substitution with partial replacement tainted";
$s = 'abcd';
$res = $s =~ s/(.+)/xyz$TAINT/;
@@ -577,7 +579,7 @@ my $TEST = 'TEST';
is($res, 1, "$desc: res value");
is($one, 'abcd', "$desc: \$1 value");
- $desc = "substitution /g with replacement tainted";
+ $desc = "substitution /g with partial replacement tainted";
$s = 'abcd';
$res = $s =~ s/(.)/x$TAINT/g;
@@ -589,7 +591,7 @@ my $TEST = 'TEST';
is($res, 4, "$desc: res value");
is($one, 'd', "$desc: \$1 value");
- $desc = "substitution /ge with replacement tainted";
+ $desc = "substitution /ge with partial replacement tainted";
$s = 'abc';
{
@@ -618,7 +620,7 @@ my $TEST = 'TEST';
is($res, 3, "$desc: res value");
is($one, 'c', "$desc: \$1 value");
- $desc = "substitution /r with replacement tainted";
+ $desc = "substitution /r with partial replacement tainted";
$s = 'abcd';
$res = $s =~ s/(.+)/xyz$TAINT/r;
@@ -630,6 +632,71 @@ my $TEST = 'TEST';
is($res, 'xyz', "$desc: res value");
is($one, 'abcd', "$desc: \$1 value");
+ $desc = "substitution with whole replacement tainted";
+
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/$TAINTXYZ/;
+ $one = $1;
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xyz', "$desc: s value");
+ is($res, 1, "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution /g with whole replacement tainted";
+
+ $s = 'abcd';
+ $res = $s =~ s/(.)/$TAINTXYZ/g;
+ $one = $1;
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xyz' x 4, "$desc: s value");
+ is($res, 4, "$desc: res value");
+ is($one, 'd', "$desc: \$1 value");
+
+ $desc = "substitution /ge with whole replacement tainted";
+
+ $s = 'abc';
+ {
+ my $i = 0;
+ my $j;
+ $res = $s =~ s{(.)}{
+ $j = $i; # make sure code not tainted
+ $one = $1;
+ isnt_tainted($j, "$desc: code not tainted within /e");
+ $i++;
+ if ($i == 1) {
+ isnt_tainted($s, "$desc: s not tainted loop 1");
+ }
+ else {
+ is_tainted($s, "$desc: s tainted loop $i");
+ }
+ isnt_tainted($one, "$desc: \$1 not tainted within /e");
+ $TAINTXYZ;
+ }ge;
+ $one = $1;
+ }
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xyz' x 3, "$desc: s value");
+ is($res, 3, "$desc: res value");
+ is($one, 'c', "$desc: \$1 value");
+
+ $desc = "substitution /r with whole replacement tainted";
+
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/$TAINTXYZ/r;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ is_tainted($res, "$desc: res tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'abcd', "$desc: s value");
+ is($res, 'xyz', "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
{
# now do them all again with "use re 'taint"
@@ -955,7 +1022,7 @@ my $TEST = 'TEST';
is($one, 'abcd', "$desc: \$1 value");
}
- $desc = "use re 'taint': substitution with replacement tainted";
+ $desc = "use re 'taint': substitution with partial replacement tainted";
$s = 'abcd';
$res = $s =~ s/(.+)/xyz$TAINT/;
@@ -967,7 +1034,7 @@ my $TEST = 'TEST';
is($res, 1, "$desc: res value");
is($one, 'abcd', "$desc: \$1 value");
- $desc = "use re 'taint': substitution /g with replacement tainted";
+ $desc = "use re 'taint': substitution /g with partial replacement tainted";
$s = 'abcd';
$res = $s =~ s/(.)/x$TAINT/g;
@@ -979,7 +1046,7 @@ my $TEST = 'TEST';
is($res, 4, "$desc: res value");
is($one, 'd', "$desc: \$1 value");
- $desc = "use re 'taint': substitution /ge with replacement tainted";
+ $desc = "use re 'taint': substitution /ge with partial replacement tainted";
$s = 'abc';
{
@@ -1008,7 +1075,7 @@ my $TEST = 'TEST';
is($res, 3, "$desc: res value");
is($one, 'c', "$desc: \$1 value");
- $desc = "use re 'taint': substitution /r with replacement tainted";
+ $desc = "use re 'taint': substitution /r with partial replacement tainted";
$s = 'abcd';
$res = $s =~ s/(.+)/xyz$TAINT/r;
@@ -1020,6 +1087,71 @@ my $TEST = 'TEST';
is($res, 'xyz', "$desc: res value");
is($one, 'abcd', "$desc: \$1 value");
+ $desc = "use re 'taint': substitution with whole replacement tainted";
+
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/$TAINTXYZ/;
+ $one = $1;
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xyz', "$desc: s value");
+ is($res, 1, "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "use re 'taint': substitution /g with whole replacement tainted";
+
+ $s = 'abcd';
+ $res = $s =~ s/(.)/$TAINTXYZ/g;
+ $one = $1;
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xyz' x 4, "$desc: s value");
+ is($res, 4, "$desc: res value");
+ is($one, 'd', "$desc: \$1 value");
+
+ $desc = "use re 'taint': substitution /ge with whole replacement tainted";
+
+ $s = 'abc';
+ {
+ my $i = 0;
+ my $j;
+ $res = $s =~ s{(.)}{
+ $j = $i; # make sure code not tainted
+ $one = $1;
+ isnt_tainted($j, "$desc: code not tainted within /e");
+ $i++;
+ if ($i == 1) {
+ isnt_tainted($s, "$desc: s not tainted loop 1");
+ }
+ else {
+ is_tainted($s, "$desc: s tainted loop $i");
+ }
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ $TAINTXYZ;
+ }ge;
+ $one = $1;
+ }
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xyz' x 3, "$desc: s value");
+ is($res, 3, "$desc: res value");
+ is($one, 'c', "$desc: \$1 value");
+
+ $desc = "use re 'taint': substitution /r with whole replacement tainted";
+
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/$TAINTXYZ/r;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ is_tainted($res, "$desc: res tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'abcd', "$desc: s value");
+ is($res, 'xyz', "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
# [perl #121854] match taintedness became sticky
# when one match has a taintess result, subseqent matches
# using the same pattern shouldn't necessarily be tainted
@@ -2448,6 +2580,284 @@ is eval { eval $::x.1 }, 1, 'reset does not taint undef';
isnt_tainted $b, "list assign post tainted expression b";
}
+# taint passing through overloading
+package OvTaint {
+ sub new { bless({ t => $_[1] }, $_[0]) }
+ use overload '""' => sub { $_[0]->{t} ? "hi".$TAINT : "hello" };
+}
+my $ovclean = OvTaint->new(0);
+my $ovtaint = OvTaint->new(1);
+isnt_tainted("$ovclean", "overload preserves cleanliness");
+is_tainted("$ovtaint", "overload preserves taint");
+
+# substitutions with overloaded replacement
+{
+ my ($desc, $s, $res, $one);
+
+ $desc = "substitution with partial replacement overloaded and clean";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/xyz$ovclean/;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xyzhello', "$desc: s value");
+ is($res, 1, "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution with partial replacement overloaded and tainted";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/xyz$ovtaint/;
+ $one = $1;
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xyzhi', "$desc: s value");
+ is($res, 1, "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution with whole replacement overloaded and clean";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/$ovclean/;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'hello', "$desc: s value");
+ is($res, 1, "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution with whole replacement overloaded and tainted";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/$ovtaint/;
+ $one = $1;
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'hi', "$desc: s value");
+ is($res, 1, "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution /e with partial replacement overloaded and clean";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/"xyz".$ovclean/e;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xyzhello', "$desc: s value");
+ is($res, 1, "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution /e with partial replacement overloaded and tainted";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/"xyz".$ovtaint/e;
+ $one = $1;
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xyzhi', "$desc: s value");
+ is($res, 1, "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution /e with whole replacement overloaded and clean";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/$ovclean/e;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'hello', "$desc: s value");
+ is($res, 1, "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution /e with whole replacement overloaded and tainted";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/$ovtaint/e;
+ $one = $1;
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'hi', "$desc: s value");
+ is($res, 1, "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution /e with extra code and partial replacement overloaded and clean";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/(my $z++), "xyz".$ovclean/e;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xyzhello', "$desc: s value");
+ is($res, 1, "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution /e with extra code and partial replacement overloaded and tainted";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/(my $z++), "xyz".$ovtaint/e;
+ $one = $1;
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xyzhi', "$desc: s value");
+ is($res, 1, "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution /e with extra code and whole replacement overloaded and clean";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/(my $z++), $ovclean/e;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'hello', "$desc: s value");
+ is($res, 1, "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution /e with extra code and whole replacement overloaded and tainted";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/(my $z++), $ovtaint/e;
+ $one = $1;
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'hi', "$desc: s value");
+ is($res, 1, "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution /r with partial replacement overloaded and clean";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/xyz$ovclean/r;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'abcd', "$desc: s value");
+ is($res, 'xyzhello', "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution /r with partial replacement overloaded and tainted";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/xyz$ovtaint/r;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ is_tainted($res, "$desc: res tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'abcd', "$desc: s value");
+ is($res, 'xyzhi', "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution /r with whole replacement overloaded and clean";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/$ovclean/r;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'abcd', "$desc: s value");
+ is($res, 'hello', "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution /r with whole replacement overloaded and tainted";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/$ovtaint/r;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ is_tainted($res, "$desc: res tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'abcd', "$desc: s value");
+ is($res, 'hi', "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution /g with partial replacement overloaded and clean";
+ $s = 'abcd';
+ $res = $s =~ s/(.)/x$ovclean/g;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xhello' x 4, "$desc: s value");
+ is($res, 4, "$desc: res value");
+ is($one, 'd', "$desc: \$1 value");
+
+ $desc = "substitution /g with partial replacement overloaded and tainted";
+ $s = 'abcd';
+ $res = $s =~ s/(.)/x$ovtaint/g;
+ $one = $1;
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xhi' x 4, "$desc: s value");
+ is($res, 4, "$desc: res value");
+ is($one, 'd', "$desc: \$1 value");
+
+ $desc = "substitution /g with whole replacement overloaded and clean";
+ $s = 'abcd';
+ $res = $s =~ s/(.)/$ovclean/g;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'hello' x 4, "$desc: s value");
+ is($res, 4, "$desc: res value");
+ is($one, 'd', "$desc: \$1 value");
+
+ $desc = "substitution /g with whole replacement overloaded and tainted";
+ $s = 'abcd';
+ $res = $s =~ s/(.)/$ovtaint/g;
+ $one = $1;
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'hi' x 4, "$desc: s value");
+ is($res, 4, "$desc: res value");
+ is($one, 'd', "$desc: \$1 value");
+
+ $desc = "substitution /ge with partial replacement overloaded and clean";
+ $s = 'abcd';
+ $res = $s =~ s/(.)/"x".$ovclean/ge;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xhello' x 4, "$desc: s value");
+ is($res, 4, "$desc: res value");
+ is($one, 'd', "$desc: \$1 value");
+
+ $desc = "substitution /ge with partial replacement overloaded and tainted";
+ $s = 'abcd';
+ $res = $s =~ s/(.)/"x".$ovtaint/ge;
+ $one = $1;
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xhi' x 4, "$desc: s value");
+ is($res, 4, "$desc: res value");
+ is($one, 'd', "$desc: \$1 value");
+
+ $desc = "substitution /ge with whole replacement overloaded and clean";
+ $s = 'abcd';
+ $res = $s =~ s/(.)/$ovclean/ge;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'hello' x 4, "$desc: s value");
+ is($res, 4, "$desc: res value");
+ is($one, 'd', "$desc: \$1 value");
+
+ $desc = "substitution /ge with whole replacement overloaded and tainted";
+ $s = 'abcd';
+ $res = $s =~ s/(.)/$ovtaint/ge;
+ $one = $1;
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'hi' x 4, "$desc: s value");
+ is($res, 4, "$desc: res value");
+ is($one, 'd', "$desc: \$1 value");
+}
# This may bomb out with the alarm signal so keep it last
SKIP: {
--
2.13.6

View File

@ -1,105 +0,0 @@
From 695d6585affc8f13711f013329fb4810ab89d833 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Tue, 14 Nov 2017 18:55:55 -0800
Subject: [PATCH] [perl #132442] Fix stack with do {my sub l; 1}
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
A block in perl usually compiles to a leave op with an enter inside
it, followed by the statements:
leave
enter
nextstate
... expr ...
nextstate
... expr ...
If a block contains only one statement, and that statement is suffic-
iently innocuous, then the enter/leave pair to create the scope at run
time get skipped, and instead we have a simple scope op which is not
even executed:
scope
ex-nextstate
... expr ...
The nextstate in this case also gets nulled.
In the case of do { my sub l; 1 } we were getting a variation of the
latter, that looked like this:
scope
introcv
clonecv
nextstate
... expr ...
The problem here is that nextstate resets the stack, even though a new
scope has not been pushed, so we end up with all existing stack items
from the *outer* scope getting clobbered.
One can have fun with this and erase everything pushed on to the stack
so far in a given statement:
$ ./perl -le 'print join "-", 1..10, do {my sub l; ","}, 11..20'
11,12,13,14,15,16,17,18,19,20
Here I replaced the first argument to join() from within the do{}
block, after having cleared the stack.
Why was the op tree was getting muddled up like this? The my sub
declaration does not immediately add any ops to the op tree; those ops
get added when the current scope finishing compiling, since those ops
must be inserted at the beginning of the block.
I have not fully looked into the order that things happen, and why the
nextstate op does not get nulled; but it did not matter, because of
the simple fix: Treat lexical sub declarations as not innocuous by
setting the HINT_BLOCK_SCOPE flag when a lexical sub is declared.
Thus, we end up with an enter/leave pair, which creates a
proper scope.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
op.c | 2 ++
t/op/lexsub.t | 5 ++++-
2 files changed, 6 insertions(+), 1 deletion(-)
diff --git a/op.c b/op.c
index 8fa5aad876..c617ad2a00 100644
--- a/op.c
+++ b/op.c
@@ -9243,6 +9243,8 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
PERL_ARGS_ASSERT_NEWMYSUB;
+ PL_hints |= HINT_BLOCK_SCOPE;
+
/* Find the pad slot for storing the new sub.
We cannot use PL_comppad, as it is the pad owned by the new sub. We
need to look in CvOUTSIDE and find the pad belonging to the enclos-
diff --git a/t/op/lexsub.t b/t/op/lexsub.t
index 3fa17acdda..f085cd97e8 100644
--- a/t/op/lexsub.t
+++ b/t/op/lexsub.t
@@ -7,7 +7,7 @@ BEGIN {
*bar::is = *is;
*bar::like = *like;
}
-plan 149;
+plan 150;
# -------------------- our -------------------- #
@@ -957,3 +957,6 @@ like runperl(
{
my sub h; sub{my $x; sub{h}}
}
+
+is join("-", qw(aa bb), do { my sub lleexx; 123 }, qw(cc dd)),
+ "aa-bb-123-cc-dd", 'do { my sub...} in a list [perl #132442]';
--
2.13.6

View File

@ -1,34 +0,0 @@
From 8e7c2faafb74d3b07e8a5818608dfe065e361604 Mon Sep 17 00:00:00 2001
From: "Craig A. Berry" <craigberry@mac.com>
Date: Mon, 1 Jan 2018 10:10:33 -0600
Subject: [PATCH] Reenable numeric first argument of system() on VMS.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
This was broken in 64def2aeaeb63f92dadc6dfa334, and fixed for Win32
only in 8fe3452cc6ac7af8c08. But VMS also uses a numeric first
argument to system() as a flag indicating spawn without waiting for
completion.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
pp_sys.c | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/pp_sys.c b/pp_sys.c
index 0c9147bc4e..5154b9baa8 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -4375,7 +4375,7 @@ PP(pp_system)
STRLEN len;
char *pv;
SvGETMAGIC(origsv);
-#ifdef WIN32
+#if defined(WIN32) || defined(__VMS)
/*
* Because of a nasty platform-specific variation on the meaning
* of arguments to this op, we must preserve numeric arguments
--
2.13.6

View File

@ -1,73 +0,0 @@
From 8fe3452cc6ac7af8c08c2044cd3757018a9c8887 Mon Sep 17 00:00:00 2001
From: Zefram <zefram@fysh.org>
Date: Fri, 22 Dec 2017 05:32:41 +0000
Subject: [PATCH] preserve numericness of system() args on Win32
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
On Windows there's a nasty variation in the meaning of arguments
to Perl's system(), in which a numeric first argument isn't used as
part of the command to run, but instead selects between two different
operations to perform with the command (whether to wait for the command
to complete or not). Therefore the reduction of argument scalars to
their operative values in the parent process, which was added in commit
64def2aeaeb63f92dadc6dfa33486c1d7b311963, needs to preserve numericness
of arguments on Windows. Fixes [perl #132633].
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
pp_sys.c | 35 +++++++++++++++++++++++++++++++----
1 file changed, 31 insertions(+), 4 deletions(-)
diff --git a/pp_sys.c b/pp_sys.c
index beb60da4c6..0649794104 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -4393,12 +4393,39 @@ PP(pp_system)
# endif
while (++MARK <= SP) {
- SV *origsv = *MARK;
+ SV *origsv = *MARK, *copysv;
STRLEN len;
char *pv;
- pv = SvPV(origsv, len);
- *MARK = newSVpvn_flags(pv, len,
- (SvFLAGS(origsv) & SVf_UTF8) | SVs_TEMP);
+ SvGETMAGIC(origsv);
+#ifdef WIN32
+ /*
+ * Because of a nasty platform-specific variation on the meaning
+ * of arguments to this op, we must preserve numeric arguments
+ * as numeric, not just retain the string value.
+ */
+ if (SvNIOK(origsv) || SvNIOKp(origsv)) {
+ copysv = newSV_type(SVt_PVNV);
+ sv_2mortal(copysv);
+ if (SvPOK(origsv) || SvPOKp(origsv)) {
+ pv = SvPV_nomg(origsv, len);
+ sv_setpvn(copysv, pv, len);
+ SvPOK_off(copysv);
+ }
+ if (SvIOK(origsv) || SvIOKp(origsv))
+ SvIV_set(copysv, SvIVX(origsv));
+ if (SvNOK(origsv) || SvNOKp(origsv))
+ SvNV_set(copysv, SvNVX(origsv));
+ SvFLAGS(copysv) |= SvFLAGS(origsv) &
+ (SVf_IOK|SVf_NOK|SVf_POK|SVp_IOK|SVp_NOK|SVp_POK|
+ SVf_UTF8|SVf_IVisUV);
+ } else
+#endif
+ {
+ pv = SvPV_nomg(origsv, len);
+ copysv = newSVpvn_flags(pv, len,
+ (SvFLAGS(origsv) & SVf_UTF8) | SVs_TEMP);
+ }
+ *MARK = copysv;
}
MARK = ORIGMARK;
--
2.13.6

View File

@ -1,127 +0,0 @@
From fed9fe5b48ccdffef9065a03c12c237cc7418de6 Mon Sep 17 00:00:00 2001
From: Zefram <zefram@fysh.org>
Date: Fri, 16 Feb 2018 17:20:34 +0000
Subject: [PATCH] don't clobber file bytes in :encoding layer
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
The PerlIO::encoding layer, when used on input, was creating an SvLEN==0
scalar pointing into the byte buffer, to pass to the ->decode method
of the encoding object. Since the method mutates this scalar, for some
encodings this led to mutating the byte buffer, and depending on where
it came from that might be something visible elsewhere that should not
be mutated. Remove the code for the SvLEN==0 scalar, instead always
using the alternate code that would copy the bytes into a separate buffer
owned by the scalar. Fixes [perl #132833].
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
ext/PerlIO-encoding/encoding.pm | 2 +-
ext/PerlIO-encoding/encoding.xs | 43 ++++++++++------------------------------
ext/PerlIO-encoding/t/encoding.t | 12 ++++++++++-
3 files changed, 22 insertions(+), 35 deletions(-)
diff --git a/ext/PerlIO-encoding/encoding.pm b/ext/PerlIO-encoding/encoding.pm
index 08d2df4713..3d740b181a 100644
--- a/ext/PerlIO-encoding/encoding.pm
+++ b/ext/PerlIO-encoding/encoding.pm
@@ -1,7 +1,7 @@
package PerlIO::encoding;
use strict;
-our $VERSION = '0.25';
+our $VERSION = '0.26';
our $DEBUG = 0;
$DEBUG and warn __PACKAGE__, " called by ", join(", ", caller), "\n";
diff --git a/ext/PerlIO-encoding/encoding.xs b/ext/PerlIO-encoding/encoding.xs
index bb4754f3d9..941d786266 100644
--- a/ext/PerlIO-encoding/encoding.xs
+++ b/ext/PerlIO-encoding/encoding.xs
@@ -307,42 +307,19 @@ PerlIOEncode_fill(pTHX_ PerlIO * f)
goto end_of_file;
}
}
- if (SvCUR(e->dataSV)) {
- /* something left over from last time - create a normal
- SV with new data appended
- */
- if (use + SvCUR(e->dataSV) > e->base.bufsiz) {
- if (e->flags & NEEDS_LINES) {
- /* Have to grow buffer */
- e->base.bufsiz = use + SvCUR(e->dataSV);
- PerlIOEncode_get_base(aTHX_ f);
- }
- else {
- use = e->base.bufsiz - SvCUR(e->dataSV);
- }
- }
- sv_catpvn(e->dataSV,(char*)ptr,use);
- }
- else {
- /* Create a "dummy" SV to represent the available data from layer below */
- if (SvLEN(e->dataSV) && SvPVX_const(e->dataSV)) {
- Safefree(SvPVX_mutable(e->dataSV));
- }
- if (use > (SSize_t)e->base.bufsiz) {
- if (e->flags & NEEDS_LINES) {
- /* Have to grow buffer */
- e->base.bufsiz = use;
- PerlIOEncode_get_base(aTHX_ f);
- }
- else {
- use = e->base.bufsiz;
+ if (!SvCUR(e->dataSV))
+ SvPVCLEAR(e->dataSV);
+ if (use + SvCUR(e->dataSV) > e->base.bufsiz) {
+ if (e->flags & NEEDS_LINES) {
+ /* Have to grow buffer */
+ e->base.bufsiz = use + SvCUR(e->dataSV);
+ PerlIOEncode_get_base(aTHX_ f);
}
+ else {
+ use = e->base.bufsiz - SvCUR(e->dataSV);
}
- SvPV_set(e->dataSV, (char *) ptr);
- SvLEN_set(e->dataSV, 0); /* Hands off sv.c - it isn't yours */
- SvCUR_set(e->dataSV,use);
- SvPOK_only(e->dataSV);
}
+ sv_catpvn(e->dataSV,(char*)ptr,use);
SvUTF8_off(e->dataSV);
PUSHMARK(sp);
XPUSHs(e->enc);
diff --git a/ext/PerlIO-encoding/t/encoding.t b/ext/PerlIO-encoding/t/encoding.t
index 088f89ee20..41cefcb137 100644
--- a/ext/PerlIO-encoding/t/encoding.t
+++ b/ext/PerlIO-encoding/t/encoding.t
@@ -16,7 +16,7 @@ BEGIN {
require "../../t/charset_tools.pl";
}
-use Test::More tests => 24;
+use Test::More tests => 27;
my $grk = "grk$$";
my $utf = "utf$$";
@@ -231,6 +231,16 @@ is $x, "To hymn him who heard her herd herd\n",
} # SKIP
+# decoding shouldn't mutate the original bytes [perl #132833]
+{
+ my $b = "a\0b\0\n\0";
+ open my $fh, "<:encoding(UTF16-LE)", \$b or die;
+ is scalar(<$fh>), "ab\n";
+ is $b, "a\0b\0\n\0";
+ close $fh or die;
+ is $b, "a\0b\0\n\0";
+}
+
END {
1 while unlink($grk, $utf, $fail1, $fail2, $russki, $threebyte);
}
--
2.14.3

View File

@ -1,68 +0,0 @@
From 823ba440369100de3f2693420a3887a645a57d28 Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Wed, 7 Mar 2018 09:27:26 +0000
Subject: [PATCH] fix line numbers in multi-line s///
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
my commit v5.25.6-230-g6432a58, "Eliminate SVrepl_EVAL and SvEVALED()",
introduced a regression: __LINE__ no longer took account of multiple
lines in the s///.
Now fixed.
Spotted by Abigail.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
t/re/subst.t | 12 +++++++++++-
toke.c | 2 +-
2 files changed, 12 insertions(+), 2 deletions(-)
diff --git a/t/re/subst.t b/t/re/subst.t
index b9b9939b11..dd62e95ee6 100644
--- a/t/re/subst.t
+++ b/t/re/subst.t
@@ -11,7 +11,7 @@ BEGIN {
require './loc_tools.pl';
}
-plan(tests => 275);
+plan(tests => 276);
$_ = 'david';
$a = s/david/rules/r;
@@ -1163,6 +1163,16 @@ __EOF__
pass("RT #130188");
}
+# RT #131930
+# a multi-line s/// wasn't resetting the cop_line correctly
+{
+ my $l0 = __LINE__;
+ my $s = "a";
+ $s =~ s[a]
+ [b];
+ my $lines = __LINE__ - $l0;
+ is $lines, 4, "RT #131930";
+}
diff --git a/toke.c b/toke.c
index 9dbad98408..0ef33415c0 100644
--- a/toke.c
+++ b/toke.c
@@ -9884,7 +9884,7 @@ S_scan_subst(pTHX_ char *start)
* the NVX field indicates how many src code lines the replacement
* spreads over */
sv_upgrade(PL_parser->lex_sub_repl, SVt_PVNV);
- ((XPVNV*)SvANY(PL_parser->lex_sub_repl))->xnv_u.xnv_lines = 0;
+ ((XPVNV*)SvANY(PL_parser->lex_sub_repl))->xnv_u.xnv_lines = linediff;
((XPVIV*)SvANY(PL_parser->lex_sub_repl))->xiv_u.xivu_eval_seen =
cBOOL(es);
}
--
2.14.3

View File

@ -1,6 +1,7 @@
--- perl-5.8.0/Configure.orig 2002-09-09 11:31:19.000000000 -0400
+++ perl-5.8.0/Configure 2002-09-09 11:40:37.000000000 -0400
@@ -6458,8 +6458,8 @@
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
@ -11,7 +12,7 @@
esac
;;
*) dflt="$installstyle" ;;
@@ -6475,8 +6475,8 @@
@@ -7336,8 +7336,8 @@ esac
: /opt/perl/lib/perl5... would be redundant.
: The default "style" setting is made in installstyle.U
case "$installstyle" in
@ -22,7 +23,7 @@
esac
eval $prefixit
$cat <<EOM
@@ -6934,8 +6934,8 @@
@@ -7584,8 +7584,8 @@ siteprefixexp="$ansexp"
prog=`echo $package | $sed 's/-*[0-9.]*$//'`
case "$sitelib" in
'') case "$installstyle" in
@ -33,7 +34,7 @@
esac
;;
*) dflt="$sitelib"
@@ -7061,8 +7061,8 @@
@@ -8001,8 +8001,8 @@ case "$vendorprefix" in
'')
prog=`echo $package | $sed 's/-*[0-9.]*$//'`
case "$installstyle" in

View File

@ -1,7 +1,7 @@
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
@@ -88,6 +88,11 @@ libraries. LD_RUN_PATH is a colon separ
@@ -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.
@ -16,7 +16,7 @@ diff -up perl-5.14.0/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm.usem perl-5
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
@@ -278,7 +278,7 @@ sub full_setup {
@@ -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
@ -25,7 +25,7 @@ diff -up perl-5.14.0/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm.usem perl
XSBUILD XSMULTI XSOPT XSPROTOARG XS_VERSION
clean depend dist dynamic_lib linkext macro realclean tool_autosplit
@@ -422,7 +422,27 @@ sub new {
@@ -501,7 +501,27 @@ sub new {
# PRINT_PREREQ is RedHatism.
if ("@ARGV" =~ /\bPRINT_PREREQ\b/) {
$self->_PRINT_PREREQ;
@ -54,7 +54,7 @@ diff -up perl-5.14.0/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm.usem perl
print "MakeMaker (v$VERSION)\n" if $Verbose;
if (-f "MANIFEST" && ! -f "Makefile" && ! $UNDER_CORE){
@@ -2352,6 +2372,40 @@ precedence. A typemap in the current di
@@ -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.
@ -98,7 +98,7 @@ diff -up perl-5.14.0/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm.usem perl
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
@@ -944,7 +944,7 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $
@@ -1045,7 +1045,7 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $
}
my $ld_run_path_shell = "";

View File

@ -1,7 +1,7 @@
diff -up perl-5.16.0-RC2/utils/perlbug.PL.fedora perl-5.16.0-RC2/utils/perlbug.PL
--- perl-5.16.0-RC2/utils/perlbug.PL.fedora 2012-05-16 16:15:51.000000000 +0200
+++ perl-5.16.0-RC2/utils/perlbug.PL 2012-05-16 16:18:36.018894464 +0200
@@ -271,17 +271,6 @@ sub Init {
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') {

425
perl.spec
View File

@ -1,4 +1,4 @@
%global perl_version 5.26.2
%global perl_version 5.28.0
%global perl_epoch 4
%global perl_arch_stem -thread-multi
%global perl_archname %{_arch}-%{_os}%{perl_arch_stem}
@ -81,10 +81,10 @@ License: GPL+ or Artistic
Epoch: %{perl_epoch}
Version: %{perl_version}
# release number must be even higher, because dual-lived modules will be broken otherwise
Release: 414%{?dist}
Release: 415%{?dist}
Summary: Practical Extraction and Report Language
Url: http://www.perl.org/
Source0: http://www.cpan.org/src/5.0/perl-%{perl_version}.tar.bz2
Url: https://www.perl.org/
Source0: https://www.cpan.org/src/5.0/perl-%{perl_version}.tar.xz
Source3: macros.perl
#Systemtap tapset and example that make use of systemtap-sdt-devel
# build requirement. Written by lberk; Not yet upstream.
@ -105,175 +105,50 @@ Source7: gendep.macros
Patch1: perl-perlbug-tag.patch
# Fedora/RHEL only (64bit only)
Patch3: perl-5.8.0-libdir64.patch
Patch2: perl-5.8.0-libdir64.patch
# Fedora/RHEL specific (use libresolv instead of libbind), bug #151127
Patch4: perl-5.10.0-libresolv.patch
Patch3: perl-5.10.0-libresolv.patch
# FIXME: May need the "Fedora" references removed before upstreaming
# patches ExtUtils-MakeMaker
Patch5: perl-USE_MM_LD_RUN_PATH.patch
Patch4: perl-USE_MM_LD_RUN_PATH.patch
# Provide maybe_command independently, bug #1129443
Patch6: perl-5.22.1-Provide-ExtUtils-MM-methods-as-standalone-ExtUtils-M.patch
Patch5: perl-5.22.1-Provide-ExtUtils-MM-methods-as-standalone-ExtUtils-M.patch
# The Fedora builders started randomly failing this futime test
# only on x86_64, so we just don't run it. Works fine on normal
# systems.
Patch7: perl-5.10.0-x86_64-io-test-failure.patch
Patch6: perl-5.10.0-x86_64-io-test-failure.patch
# switch off test, which is failing only on koji (fork)
Patch8: perl-5.14.1-offtest.patch
Patch7: perl-5.14.1-offtest.patch
# Define SONAME for libperl.so
Patch15: perl-5.16.3-create_libperl_soname.patch
Patch8: perl-5.16.3-create_libperl_soname.patch
# Install libperl.so to -Dshrpdir value
Patch16: perl-5.22.0-Install-libperl.so-to-shrpdir-on-Linux.patch
Patch9: perl-5.22.0-Install-libperl.so-to-shrpdir-on-Linux.patch
# Document Math::BigInt::CalcEmu requires Math::BigInt, rhbz#959096,
# CPAN RT#85015
Patch22: perl-5.18.1-Document-Math-BigInt-CalcEmu-requires-Math-BigInt.patch
Patch10: perl-5.18.1-Document-Math-BigInt-CalcEmu-requires-Math-BigInt.patch
# Make *DBM_File desctructors thread-safe, bug #1107543, RT#61912
Patch26: perl-5.18.2-Destroy-GDBM-NDBM-ODBM-SDBM-_File-objects-only-from-.patch
Patch11: perl-5.18.2-Destroy-GDBM-NDBM-ODBM-SDBM-_File-objects-only-from-.patch
# Replace ExtUtils::MakeMaker dependency with ExtUtils::MM::Utils.
# This allows not to require perl-devel. Bug #1129443
Patch30: perl-5.22.1-Replace-EU-MM-dependnecy-with-EU-MM-Utils-in-IPC-Cmd.patch
# Make File::Glob more resistant against degenerative matching, RT#131211,
# in upstream after 5.27.0
Patch31: perl-5.27.0-perl-131211-fixup-File-Glob-degenerate-matching.patch
# Fix glob UTF-8 flag on a glob reassignment, RT#131263,
# in upstream after 5.27.0
Patch36: perl-5.26.0-perl-131263-clear-the-UTF8-flag-on-a-glob-if-it-isn-.patch
# Fix handling backslashes in PATH environment variable when executing
# "perl -S", RT#129183, in upstream after 5.27.0
Patch38: perl-5.27.0-perl-129183-don-t-treat-as-an-escape-in-PATH-for-S.patch
# Fix reporting malformed UTF-8 character, RT#131646, in upstream after 5.27.1
Patch43: perl-5.27.1-t-lib-warnings-utf8-Fix-test.patch
# Fix File::Glob rt131211.t test random failures, in upstream after 5.27.1
Patch45: perl-5.27.1-File-Glob-tweak-rt131211.t-to-be-less-sensitive-on-w.patch
# Fix t/op/hash.t test random failures, in upstream after 5.27.1
Patch46: perl-5.26.0-t-op-hash.t-fixup-intermittently-failing-test.patch
# Parse caret variables with subscripts as normal variables inside ${...}
# escaping, RT#131664, in upstream after 5.27.1
Patch47: perl-5.26.2-RC1-Parse-caret-vars-with-subscripts-the-same-as-normal-.patch
Patch48: perl-5.26.2-RC1-add-an-additional-test-for-whitespace-tolerance-in-c.patch
# Do not display too many bytes when reporting malformed UTF-8 character,
# in upstream after 5.27.1
Patch49: perl-5.27.1-utf8n_to_uvchr-Don-t-display-too-many-bytes-in-msg.patch
# Fix error message for "our sub foo::bar", RT#131679, in upstream after 5.27.1
Patch51: perl-5.27.1-perl-131679-Fix-our-sub-foo-bar-message.patch
Patch12: perl-5.22.1-Replace-EU-MM-dependnecy-with-EU-MM-Utils-in-IPC-Cmd.patch
# Fix executing arybase::_tie_it() in Safe compartement, RT#131588,
# not yet accepted by upstream
Patch52: perl-5.26.0-perl-131588-be-a-little-more-careful-in-arybase-_tie.patch
# Fix splitting non-ASCII strings if unicode_strings feature is enabled,
# RT#130907 in upstream after 5.27.1
Patch54: perl-5.27.1-RT-130907-Fix-the-Unicode-Bug-in-split.patch
# Fix compiler warnings in code generated by ExtUtils::Constant, CPAN RT#63832,
# in upstream after 5.27.2
Patch55: perl-5.27.2-Avoid-compiler-warnings-due-to-mismatched-types-in-p.patch
# Fix compiler warnings in code generated by ExtUtils::Constant, CPAN RT#101487,
# in upstream after 5.27.2
Patch56: perl-5.27.2-EU-Constant-avoid-uninit-warning.patch
# Fix unreliable Time-HiRes tests, CPAN RT#122819, in Time-HiRes-1.9746
Patch58: perl-5.26.0-Time-HiRes-Fix-unreliable-t-usleep.t-and-t-utime.t.patch
# Fix Term::ReadLine not to create spurious &STDERR files, RT#132008,
# in upstream after 5.27.3
Patch61: perl-5.27.3-perl-132008-try-to-prevent-the-similar-mistakes-in-t.patch
# Fix an overflow when parsing a character range with no preceding character,
# RT#132245, in upstream after 5.27.5
Patch64: perl-5.26.1-perl-132245-don-t-try-to-process-a-char-range-with-n.patch
# Fix walking symbol table for ISA in Carp, in upstream after 5.27.5
Patch65: perl-5.27.5-Carp-Don-t-choke-on-ISA-constant.patch
# Fix handling file names with null bytes in stat and lstat functions,
# RT#131895, in upstream after 5.27.5
Patch66: perl-5.26.1-perl-131895-fail-stat-on-names-with-0-embedded.patch
# Fix a crash when untying an object witout a stash, in upstream after 5.27.5
Patch67: perl-5.27.5-Avoid-a-segfault-when-untying-an-object.patch
# Fix deparsing of transliterations with unprintable characters, RT#132405,
# in upstream after 5.27.5
Patch68: perl-5.26.1-Fix-deparsing-of-transliterations-with-unprintable-c.patch
# Fix error reporting on do() on a directory, RT#125774,
# in upstream after 5.27.5
Patch69: perl-5.26.1-fix-do-dir-returning-no.patch
# Fix stack manipulation when a lexical subroutine is defined in a do block in
# a member of an iteration list, RT#132442, in upstream after 5.27.5
Patch70: perl-5.27.5-perl-132442-Fix-stack-with-do-my-sub-l-1.patch
# Fix setting $! when statting a closed filehandle, RT#108288,
# in upstream after 5.27.5
Patch71: perl-5.26.1-set-when-statting-a-closed-filehandle.patch
# Fix tainting of s/// with overloaded replacement, RT#115266,
# in upstream after 5.27.5
Patch72: perl-5.27.5-fix-tainting-of-s-with-overloaded-replacement.patch
# Expand system() arguments before a fork, RT#121105,
# in upstream after 5.27.6
Patch73: perl-5.26.2-RC1-perform-system-arg-processing-before-fork.patch
# in upstream after 5.27.7
Patch74: perl-5.27.7-preserve-numericness-of-system-args-on-Win32.patch
Patch75: perl-5.27.7-Reenable-numeric-first-argument-of-system-on-VMS.patch
# Avoid undefined behavior when copying memory in Glob and pp_caller,
# RT#131746, in upstream after 5.27.3
Patch76: perl-5.26.1-perl-131746-avoid-undefined-behaviour-in-Copy-etc.patch
Patch77: perl-5.27.3-avoid-the-address-of-.-will-always-evaluate-as-.-war.patch
# Conditionalize a fix for an old and long fixed bug
# in libcrypt / glibc, rhbz#1536752, RT#133184, in upstream after 5.27.11
Patch78: perl-5.26.1-guard_old_libcrypt_fix.patch
Patch13: perl-5.26.0-perl-131588-be-a-little-more-careful-in-arybase-_tie.patch
# Link XS modules to pthread library to fix linking with -z defs,
# <https://lists.fedoraproject.org/archives/list/devel@lists.fedoraproject.org/message/3RHZEHLRUHJFF2XGHI5RB6YPDNLDR4HG/>
Patch79: perl-5.27.8-hints-linux-Add-lphtread-to-lddlflags.patch
# Fix parsing braced subscript after parentheses, RT#8045,
# in upstream after 5.27.7
Patch80: perl-5.26.1-fix-parsing-of-braced-subscript-after-parens.patch
# Do not clobber file bytes in :encoding layer, RT#132833,
# in upstream after 5.27.8
Patch81: perl-5.27.8-don-t-clobber-file-bytes-in-encoding-layer.patch
# Fix line numbers in multi-line s///, RT#131930, in upstream after 5.27.9
Patch82: perl-5.27.9-fix-line-numbers-in-multi-line-s.patch
# Fix parsing extended bracketed character classes, RT#132167,
# in upstream after 5.27.10
Patch83: perl-5.27.10-PATCH-perl-132167-Parse-error-in-regex_sets.patch
# Fix a possibly unitialized memory read in the Perl parser, RT#133074,
# in upstream after 5.27.10
Patch84: perl-5.27.10-PATCH-perl-133074-5.26.1-some-coverity-fixes.patch
# Fix an infinite loop in the regular expression compiler, RT#133185,
# in upstream after 5.27.11
Patch85: perl-5.26.2-PATCH-perl-133185-Infinite-loop-in-qr.patch
Patch14: perl-5.27.8-hints-linux-Add-lphtread-to-lddlflags.patch
# Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048
Patch200: perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch
@ -324,7 +199,7 @@ BuildRequires: rsyslog
# compat macro needed for rebuild
%global perl_compat perl(:MODULE_COMPAT_5.26.2)
%global perl_compat perl(:MODULE_COMPAT_5.28.0)
Requires: %perl_compat
Requires: perl-interpreter%{?_isa} = %{perl_epoch}:%{perl_version}-%{release}
@ -475,6 +350,7 @@ Summary: The libraries for the perl run-time
License: (GPL+ or Artistic) and HSRL and MIT and UCD
# Compat provides
Provides: %perl_compat
Provides: perl(:MODULE_COMPAT_5.26.2)
Provides: perl(:MODULE_COMPAT_5.26.1)
Provides: perl(:MODULE_COMPAT_5.26.0)
# Interpreter version to fulfil required genersted from "require 5.006;"
@ -595,7 +471,7 @@ packages like perldoc by perl-Pod-Perldoc.
Summary: A module for Perl manipulation of .tar files
License: GPL+ or Artistic
Epoch: 0
Version: 2.24
Version: 2.30
BuildArch: noarch
Requires: %perl_compat
Requires: perl(IO::Zlib) >= 1.01
@ -623,7 +499,7 @@ gzipped tar files.
Summary: Simpler definition of attribute handlers
License: GPL+ or Artistic
Epoch: 0
Version: 0.99
Version: 1.01
BuildArch: noarch
Requires: %perl_compat
%if %{defined perl_bootstrap}
@ -670,7 +546,7 @@ autodie in preference to "Fatal".
Summary: Walk Perl syntax tree, print debug information about op-codes
License: GPL+ or Artistic
Epoch: 0
Version: 1.24
Version: 1.26
Requires: %perl_compat
BuildArch: noarch
%if %{defined perl_bootstrap}
@ -686,7 +562,7 @@ B::Concise and B::Terse for other details.
Summary: Transparent big number support for Perl
License: GPL+ or Artistic
Epoch: 0
Version: 0.47
Version: 0.49
Requires: %perl_compat
Requires: perl(Carp)
# Math::BigInt::Lite is optional
@ -705,8 +581,8 @@ BigFloats in a transparent way.
%package Carp
Summary: Alternative warn and die for modules
Epoch: 0
# Real version 1.42
Version: 1.42
# Real version 1.50
Version: 1.50
License: GPL+ or Artistic
Requires: %perl_compat
Provides: perl(Carp::Heavy) = %{version}
@ -747,7 +623,7 @@ It is used by IO::Compress::Bzip2.
Summary: Low-Level Interface to the zlib compression library
License: (GPL+ or Artistic) and zlib
Epoch: 0
Version: 2.074
Version: 2.076
Requires: %perl_compat
%if %{defined perl_bootstrap}
%gendep_perl_Compress_Raw_Zlib
@ -763,7 +639,7 @@ It is used by IO::Compress::Zlib.
Summary: Structured data retrieval of perl -V output
License: GPL+ or Artistic
Epoch: 0
Version: 0.28
Version: 0.29
Requires: %perl_compat
%if %{defined perl_bootstrap}
%gendep_perl_Config_Perl_V
@ -815,7 +691,7 @@ away if the constant is false.
Summary: Query, download and build perl modules from CPAN sites
License: GPL+ or Artistic
Epoch: 0
Version: 2.18
Version: 2.20
Requires: make
# Prefer Archive::Tar and Compress::Zlib over tar and gzip
Requires: perl(Archive::Tar) >= 1.50
@ -944,7 +820,7 @@ used for any other general YAML parsing or generation task.
Summary: Stringify perl data structures, suitable for printing and eval
License: GPL+ or Artistic
Epoch: 0
Version: 2.167
Version: 2.170
Requires: %perl_compat
Requires: perl(Scalar::Util)
Requires: perl(XSLoader)
@ -984,7 +860,7 @@ interface defined here mirrors the Berkeley DB interface closely.
Summary: A data debugging tool for the XS programmer
License: GPL+ or Artistic
Epoch: 0
Version: 1.26
Version: 1.27
Requires: %perl_compat
%if %{defined perl_bootstrap}
%gendep_perl_Devel_Peek
@ -1002,7 +878,7 @@ should look.
Summary: Perl Pollution Portability header generator
License: GPL+ or Artistic
Epoch: 0
Version: 3.35
Version: 3.40
Requires: %perl_compat
%if %{defined perl_bootstrap}
%gendep_perl_Devel_PPPort
@ -1086,7 +962,7 @@ Summary: Perl extension for SHA-1/224/256/384/512
License: GPL+ or Artistic
# Epoch bump for clean upgrade over old standalone package
Epoch: 1
Version: 5.96
Version: 6.01
Requires: %perl_compat
Requires: perl(Carp)
# Recommended
@ -1107,7 +983,7 @@ module can handle all types of input, including partial-byte data.
Summary: Character encodings in Perl
License: (GPL+ or Artistic) and Artistic 2.0 and UCD
Epoch: 4
Version: 2.88
Version: 2.97
Requires: %perl_compat
%if %{defined perl_bootstrap}
%gendep_perl_Encode
@ -1122,7 +998,7 @@ of the system. Perl strings are sequences of characters.
Summary: Write your Perl script in non-ASCII or non-UTF-8
License: GPL+ or Artistic
Epoch: 4
Version: 2.19
Version: 2.22
# Keeping this sub-package arch-specific because it installs files into
# arch-specific directories.
Requires: %perl_compat
@ -1153,7 +1029,7 @@ The easiest and the best alternative is to write your script in UTF-8.
Summary: Character encodings in Perl
License: (GPL+ or Artistic) and UCD
Epoch: 4
Version: 2.88
Version: 2.97
Requires: %perl_compat
Requires: %{name}-Encode = %{epoch}:%{version}-%{release}
Recommends: perl-devel
@ -1191,7 +1067,7 @@ variables to be treated as scalar or array variables.
Summary: System errno constants
License: GPL+ or Artistic
Epoch: 0
Version: 1.28
Version: 1.29
Requires: %perl_compat
# Errno.pm bakes in kernel version at build time and compares it against
# $Config{osvers} at run time. Match exact interpreter build. Bug #1393421.
@ -1212,7 +1088,7 @@ which will export all POSIX defined error numbers.
Summary: Experimental features made easy
License: GPL+ or Artistic
Epoch: 0
Version: 0.016
Version: 0.019
Requires: %perl_compat
%if %{defined perl_bootstrap}
%gendep_perl_experimental
@ -1230,7 +1106,7 @@ experimental features.
Summary: Implements default import method for modules
License: GPL+ or Artistic
Epoch: 0
Version: 5.72
Version: 5.73
Requires: %perl_compat
Requires: perl(Carp) >= 1.05
%if %{defined perl_bootstrap}
@ -1253,7 +1129,7 @@ Summary: Compile and link C code for Perl modules
License: GPL+ or Artistic
# Epoch bump for clean upgrade over old standalone package
Epoch: 1
Version: 0.280225
Version: 0.280230
BuildArch: noarch
# C and C++ compilers are highly recommended because compiling code is the
# purpose of ExtUtils::CBuilder, bug #1547165
@ -1280,7 +1156,7 @@ by the Module::Build project, but may be useful for other purposes as well.
Summary: Perl routines to replace common UNIX commands in Makefiles
License: GPL+ or Artistic
Epoch: 1
Version: 7.24
Version: 7.34
BuildArch: noarch
Requires: %perl_compat
Conflicts: perl < 4:5.20.1-312
@ -1299,7 +1175,7 @@ easier to deal with in Makefiles.
Summary: Utilities for embedding Perl in C/C++ applications
License: GPL+ or Artistic
Epoch: 0
Version: 1.34
Version: 1.35
Requires: perl-devel
Requires: %perl_compat
%if %{defined perl_bootstrap}
@ -1316,7 +1192,7 @@ Utilities for embedding Perl in C/C++ applications.
Summary: Install files from here to there
License: GPL+ or Artistic
Epoch: 0
Version: 2.04
Version: 2.14
BuildArch: noarch
Requires: %perl_compat
Requires: perl(Data::Dumper)
@ -1334,7 +1210,7 @@ pages, etc.
Summary: Create a module Makefile
License: GPL+ or Artistic
Epoch: 1
Version: 7.24
Version: 7.34
# These dependencies are weak in order to relieve building noarch
# packages from perl-devel and gcc. See bug #1547165.
# If an XS module is built, the generated Makefile executes gcc.
@ -1375,7 +1251,7 @@ Create a module Makefile.
%package ExtUtils-Manifest
Summary: Utilities to write and check a MANIFEST file
License: GPL+ or Artistic
Epoch: 0
Epoch: 1
Version: 1.70
Requires: %perl_compat
Requires: perl(File::Path)
@ -1392,7 +1268,7 @@ BuildArch: noarch
Summary: Write the C code for perlmain.c
License: GPL+ or Artistic
Epoch: 0
Version: 1.06
Version: 1.08
Requires: perl-devel
Requires: %perl_compat
%if %{defined perl_bootstrap}
@ -1416,7 +1292,7 @@ License: GPL+ or Artistic
Epoch: 1
# Real version 7.11
# Dual-life ExtUtils-MakeMaker generate it with its version
Version: 7.24
Version: 7.34
BuildArch: noarch
Requires: %perl_compat
%if %{defined perl_bootstrap}
@ -1436,7 +1312,7 @@ Summary: Module and a script for converting Perl XS code into C code
License: GPL+ or Artistic
# Epoch bump for clean upgrade over old standalone package
Epoch: 1
Version: 3.34
Version: 3.39
Requires: %perl_compat
%if %{defined perl_bootstrap}
%gendep_perl_ExtUtils_ParseXS
@ -1455,7 +1331,7 @@ necessary to let Perl access those functions.
Summary: Generic file fetching mechanism
License: GPL+ or Artistic
Epoch: 0
Version: 0.52
Version: 0.56
Requires: perl(IPC::Cmd) >= 0.36
Requires: perl(Module::Load::Conditional) >= 0.04
Requires: perl(Params::Check) >= 0.07
@ -1474,7 +1350,7 @@ File::Fetch is a generic file fetching mechanism.
Summary: Create or remove directory trees
License: GPL+ or Artistic
Epoch: 0
Version: 2.12
Version: 2.15
Requires: %perl_compat
Requires: perl(Carp)
%if %{defined perl_bootstrap}
@ -1492,7 +1368,7 @@ depth and to delete an entire directory subtree from the file system.
%package File-Temp
Summary: Return name and handle of a temporary file safely
License: GPL+ or Artistic
Epoch: 0
Epoch: 1
# Normalized version
Version: 0.230.400
Requires: %perl_compat
@ -1518,7 +1394,7 @@ can be used to create a temporary directory.
Summary: Perl source filters
License: GPL+ or Artistic
Epoch: 2
Version: 1.55
Version: 1.58
Requires: %perl_compat
%if %{defined perl_bootstrap}
%gendep_perl_Filter
@ -1535,7 +1411,7 @@ sees it.
Summary: Simplified Perl source filtering
License: GPL+ or Artistic
Epoch: 0
Version: 0.93
Version: 0.95
BuildArch: noarch
Requires: %perl_compat
Conflicts: perl < 4:5.20.1-312
@ -1555,7 +1431,7 @@ Filter::Util::Call; one that is sufficient for most common cases.
Summary: Extended processing of command line options
License: GPLv2+ or Artistic
Epoch: 1
Version: 2.49
Version: 2.50
Requires: %perl_compat
Requires: perl(overload)
Requires: perl(Text::ParseWords)
@ -1582,7 +1458,7 @@ enabled by default.
Summary: Perl input/output modules
License: GPL+ or Artistic
Epoch: 0
Version: 1.38
Version: 1.39
Requires: %perl_compat
%if %{defined perl_bootstrap}
%gendep_perl_IO
@ -1617,7 +1493,7 @@ purpose is to to be sub-classed by IO::Compress modules.
Summary: Drop-in replacement for IO::Socket::INET supporting both IPv4 and IPv6
License: GPL+ or Artistic
Epoch: 0
Version: 0.38
Version: 0.39
Requires: %perl_compat
%if %{defined perl_bootstrap}
%gendep_perl_IO_Socket_IP
@ -1657,7 +1533,7 @@ Summary: Finding and running system commands made easy
License: GPL+ or Artistic
# Epoch bump for clean upgrade over old standalone package
Epoch: 2
Version: 0.96
Version: 1.00
Requires: perl(ExtUtils::MM::Utils)
Requires: %perl_compat
%if %{defined perl_bootstrap}
@ -1715,8 +1591,8 @@ resumes after EINTR.
%package JSON-PP
Summary: JSON::XS compatible pure-Perl module
Epoch: 1
# Real version 2.27400
Version: 2.27.400
# Real version 2.97001
Version: 2.97.001
License: GPL+ or Artistic
BuildArch: noarch
Requires: %perl_compat
@ -1742,7 +1618,7 @@ JSON::PP is a pure-Perl module and is compatible with JSON::XS.
Summary: Perl clients for various network protocols
License: (GPL+ or Artistic) and Artistic
Epoch: 0
Version: 3.10
Version: 3.11
Requires: %perl_compat
Requires: perl(File::Basename)
Requires: perl(IO::Socket) >= 1.05
@ -1810,7 +1686,7 @@ including languages, countries, currency, etc.
Summary: Framework for localization
License: GPL+ or Artistic
Epoch: 0
Version: 1.28
Version: 1.29
Requires: %perl_compat
%if %{defined perl_bootstrap}
%gendep_perl_Locale_Maketext
@ -1849,8 +1725,8 @@ to alleviate the need of creating Language Classes for module authors.
Summary: Arbitrary-size integer and float mathematics
License: GPL+ or Artistic
Epoch: 1
# Real version 1.999806
Version: 1.9998.06
# Real version 1.999811
Version: 1.9998.11
Requires: %perl_compat
Requires: perl(Carp)
# File::Spec not used on recent perl
@ -1871,8 +1747,8 @@ Summary: Math::BigInt::Calc XS implementation
License: GPL+ or Artistic
Epoch: 0
# Version normalized to dot format
# Real version 0.5005
Version: 0.500.500
# Real version 0.5006
Version: 0.500.600
Requires: %perl_compat
%if %{defined perl_bootstrap}
%gendep_perl_Math_BigInt_FastCalc
@ -1886,8 +1762,8 @@ This package provides support for faster big integer calculations.
Summary: Arbitrary big rational numbers
License: GPL+ or Artistic
Epoch: 0
# Real version 0.2611
Version: 0.2611
# Real version 0.2613
Version: 0.2613
Requires: %perl_compat
Requires: perl(Math::BigInt)
%if %{defined perl_bootstrap}
@ -1964,7 +1840,7 @@ encoder/decoder. These encoding methods are specified in RFC 2045 - MIME
Summary: What modules are shipped with versions of perl
License: GPL+ or Artistic
Epoch: 1
Version: 5.20180414
Version: 5.20180622
Requires: %perl_compat
Requires: perl(List::Util)
Requires: perl(version) >= 0.88
@ -1982,7 +1858,7 @@ are shipped with each version of perl.
Summary: Tool for listing modules shipped with perl
License: GPL+ or Artistic
Epoch: 1
Version: 5.20180414
Version: 5.20180622
Requires: %perl_compat
Requires: perl(feature)
Requires: perl(version) >= 0.88
@ -2078,7 +1954,7 @@ Gather package and POD information from perl module files
Summary: Check a remote host for reachability
License: GPL+ or Artistic
Epoch: 0
Version: 2.55
Version: 2.62
Requires: %perl_compat
# Keep Net::Ping::External optional
%if %{defined perl_bootstrap}
@ -2159,7 +2035,7 @@ Params::Check is a generic input parsing/checking mechanism.
Summary: PathTools Perl module (Cwd, File::Spec)
License: (GPL+ or Artistic) and BSD
Epoch: 0
Version: 3.67
Version: 3.74
Requires: %perl_compat
Requires: perl(Carp)
%if %{defined perl_bootstrap}
@ -2269,8 +2145,7 @@ This module provides things that are useful in decoding Pod E<...> sequences.
Summary: Convert POD files to HTML
License: GPL+ or Artistic
Epoch: 0
# Real version 1.2202
Version: 1.22.02
Version: 1.24
Requires: %perl_compat
%if %{defined perl_bootstrap}
%gendep_perl_Pod_Html
@ -2306,7 +2181,8 @@ Perl5 distribution for more information about POD.
Summary: Look up Perl documentation in Pod format
License: GPL+ or Artistic
Epoch: 0
Version: 3.28
# Real version 3.2801
Version: 3.28.01
%if %{with perl_enables_groff}
# Pod::Perldoc::ToMan executes roff
Requires: groff-base
@ -2384,8 +2260,8 @@ verbose level is 2, then the entire manual page is printed.
%package podlators
Summary: Format POD source into various output formats
License: (GPL+ or Artistic) and MIT
Epoch: 0
Version: 4.09
Epoch: 1
Version: 4.10
BuildArch: noarch
Requires: %perl_compat
Requires: perl(File::Spec) >= 0.8
@ -2407,8 +2283,7 @@ with various capabilities.
Summary: A selection of general-utility scalar and list subroutines
License: GPL+ or Artistic
Epoch: 3
# Real version 1.46_02
Version: 1.46
Version: 1.50
Requires: %perl_compat
%if %{defined perl_bootstrap}
%gendep_perl_Scalar_List_Utils
@ -2425,7 +2300,7 @@ such that being individual extensions would be wasteful.
Summary: Load functions only on demand
License: GPL+ or Artistic
Epoch: 0
Version: 1.23
Version: 1.25
BuildArch: noarch
Requires: %perl_compat
Requires: perl(Carp)
@ -2444,7 +2319,7 @@ perlsub.
Summary: C socket.h defines and structure manipulators
License: GPL+ or Artistic
Epoch: 4
Version: 2.020
Version: 2.027
Requires: %perl_compat
%if %{defined perl_bootstrap}
%gendep_perl_Socket
@ -2463,7 +2338,7 @@ includes all of the commonly used pound-defines like AF_INET, SOCK_STREAM, etc.
Summary: Persistence for Perl data structures
License: GPL+ or Artistic
Epoch: 1
Version: 2.62
Version: 3.08
Requires: %perl_compat
# Carp substitutes missing Log::Agent
Requires: perl(Carp)
@ -2546,7 +2421,7 @@ capability (termcap) database.
Summary: Simple framework for writing test scripts
License: GPL+ or Artistic
Epoch: 0
Version: 1.30
Version: 1.31
Requires: %perl_compat
# Algorithm::Diff 1.15 is optional
Requires: perl(File::Temp)
@ -2565,7 +2440,7 @@ such that their output is in the format that Test::Harness expects to see.
Summary: Run Perl standard test scripts with statistics
License: GPL+ or Artistic
Epoch: 1
Version: 3.38
Version: 3.42
Requires: %perl_compat
%if %{defined perl_bootstrap}
%gendep_perl_Test_Harness
@ -2581,8 +2456,8 @@ Use TAP::Parser, Test::Harness package was whole rewritten.
%package Test-Simple
Summary: Basic utilities for writing tests
License: (GPL+ or Artistic) and CC0 and Public Domain
Epoch: 1
Version: 1.302073
Epoch: 2
Version: 1.302133
Requires: %perl_compat
Requires: perl(Data::Dumper)
%if %{defined perl_bootstrap}
@ -2675,7 +2550,7 @@ any number of threads.
Summary: High resolution alarm, sleep, gettimeofday, interval timers
License: GPL+ or Artistic
Epoch: 0
Version: 1.9741
Version: 1.9759
Requires: %perl_compat
Requires: perl(Carp)
%if %{defined perl_bootstrap}
@ -2693,7 +2568,7 @@ high resolution time and timers.
%package Time-Local
Summary: Efficiently compute time from local and GMT time
License: GPL+ or Artistic
Epoch: 0
Epoch: 2
# Real version 1.25
Version: 1.250
Requires: %perl_compat
@ -2716,7 +2591,8 @@ so dates before the system's epoch may not work on all operating systems.
Summary: Time objects from localtime and gmtime
License: (GPL+ or Artistic) and BSD
Epoch: 0
Version: 1.31
# Real version 1.3204
Version: 1.32.04
Requires: %perl_compat
%if %{defined perl_bootstrap}
%gendep_perl_Time_Piece
@ -2733,7 +2609,7 @@ behave as expected.
Summary: Perl interpreter-based threads
License: GPL+ or Artistic
Epoch: 1
Version: 2.15
Version: 2.22
Requires: %perl_compat
%if %{defined perl_bootstrap}
%gendep_perl_threads
@ -2757,7 +2633,7 @@ variables, you need to also load threads::shared.
Summary: Perl extension for sharing data structures between threads
License: GPL+ or Artistic
Epoch: 0
Version: 1.56
Version: 1.58
Requires: %perl_compat
%if %{defined perl_bootstrap}
%gendep_perl_threads_shared
@ -2777,7 +2653,7 @@ hashes and hash refs.
Summary: Unicode Collation Algorithm
License: (GPL+ or Artistic) and Unicode
Epoch: 0
Version: 1.19
Version: 1.25
Requires: %perl_compat
Requires: perl(Unicode::Normalize)
%if %{defined perl_bootstrap}
@ -2795,7 +2671,7 @@ Collation Algorithm).
Summary: Unicode Normalization Forms
License: GPL+ or Artistic
Epoch: 0
Version: 1.25
Version: 1.26
Requires: %perl_compat
# unicore/CombiningClass.pl and unicore/Decomposition.pl from perl, perl is
# auto-detected.
@ -2814,9 +2690,9 @@ Unicode normalization forms as defined in Unicode Standard Annex #15.
Summary: Perl extension for Version Objects
License: GPL+ or Artistic
# Epoch bump for clean upgrade over old standalone package
Epoch: 6
# real version 0.9917
Version: 0.99.17
Epoch: 7
# real version 0.9923
Version: 0.99.23
Requires: %perl_compat
%if %{defined perl_bootstrap}
%gendep_perl_version
@ -2831,56 +2707,20 @@ Perl extension for Version Objects
%setup -q -n perl-%{perl_version}
%patch1 -p1
%ifarch %{multilib_64_archs}
%patch3 -p1
%patch2 -p1
%endif
%patch3 -p1
%patch4 -p1
%patch5 -p1
%patch6 -p1
%patch7 -p1
%patch8 -p1
%patch15 -p1
%patch16 -p1
%patch22 -p1
%patch26 -p1
%patch30 -p1
%patch31 -p1
%patch36 -p1
%patch38 -p1
%patch43 -p1
%patch45 -p1
%patch46 -p1
%patch47 -p1
%patch48 -p1
%patch49 -p1
%patch51 -p1
%patch52 -p1
%patch54 -p1
%patch55 -p1
%patch56 -p1
%patch58 -p1
%patch61 -p1
%patch64 -p1
%patch65 -p1
%patch66 -p1
%patch67 -p1
%patch68 -p1
%patch69 -p1
%patch70 -p1
%patch71 -p1
%patch72 -p1
%patch73 -p1
%patch74 -p1
%patch75 -p1
%patch76 -p1
%patch77 -p1
%patch78 -p1
%patch79 -p1
%patch80 -p1
%patch81 -p1
%patch82 -p1
%patch83 -p1
%patch84 -p1
%patch85 -p1
%patch9 -p1
%patch10 -p1
%patch11 -p1
%patch12 -p1
%patch13 -p1
%patch14 -p1
%patch200 -p1
%patch201 -p1
@ -2889,51 +2729,19 @@ Perl extension for Version Objects
perl -x patchlevel.h \
'Fedora Patch1: Removes date check, Fedora/RHEL specific' \
%ifarch %{multilib_64_archs} \
'Fedora Patch3: support for libdir64' \
'Fedora Patch2: support for libdir64' \
%endif \
'Fedora Patch4: use libresolv instead of libbind' \
'Fedora Patch5: USE_MM_LD_RUN_PATH' \
'Fedora Patch6: Provide MM::maybe_command independently (bug #1129443)' \
'Fedora Patch7: Dont run one io test due to random builder failures' \
'Fedora Patch15: Define SONAME for libperl.so' \
'Fedora Patch16: Install libperl.so to -Dshrpdir value' \
'Fedora Patch22: Document Math::BigInt::CalcEmu requires Math::BigInt (CPAN RT#85015)' \
'Fedora Patch26: Make *DBM_File desctructors thread-safe (RT#61912)' \
'Fedora Patch27: Make PadlistNAMES() lvalue again (CPAN RT#101063)' \
'Fedora Patch30: Replace EU::MakeMaker dependency with EU::MM::Utils in IPC::Cmd (bug #1129443)' \
'Fedora Patch31: Make File::Glob more resistant against degenerative matching (RT#131211)' \
'Fedora Patch36: Fix glob UTF-8 flag on a glob reassignment (RT#131263)' \
'Fedora Patch38: Fix handling backslashes in PATH environment variable when executing "perl -S" (RT#129183)' \
'Fedora Patch45: Fix File::Glob rt131211.t test random failures' \
'Fedora Patch46: Fix t/op/hash.t test random failures' \
'Fedora Patch47: Parse caret variables with subscripts as normal variables inside ${...} escaping (RT#131664)' \
'Fedora Patch49: Do not display too many bytes when reporting malformed UTF-8 character' \
'Fedora Patch51: Fix error message for "our sub foo::bar" (RT#131679)' \
'Fedora Patch52: Fix executing arybase::_tie_it() in Safe compartement (RT#131588)' \
'Fedora Patch54: Fix splitting non-ASCII strings if unicode_strings feature is enabled (RT#130907)' \
'Fedora Patch55: Fix compiler warnings in code generated by ExtUtils::Constant (CPAN RT#63832)' \
'Fedora Patch56: Fix compiler warnings in code generated by ExtUtils::Constant (CPAN RT#101487)' \
'Fedora Patch58: Fix unreliable Time-HiRes tests (CPAN RT#122819)' \
'Fedora Patch61: Fix Term::ReadLine not to create spurious &STDERR files (RT#132008)' \
'Fedora Patch64: Fix an overflow when parsing a character range with no preceding character (RT#132245)' \
'Fedora Patch65: Fix walking symbol table for ISA in Carp' \
'Fedora Patch66: Fix handling file names with null bytes in stat and lstat functions (RT#131895)' \
'Fedora Patch67: Fix a crash when untying an object witout a stash' \
'Fedora Patch68: Fix deparsing of transliterations with unprintable characters (RT#132405)' \
'Fedora Patch69: Fix error reporting on do() on a directory (RT#125774)' \
'Fedora Patch70: Fix stack manipulation when a lexical subroutine is defined in a do block in a member of an iteration list (RT#132442)' \
'Fedora Patch71: Fix setting $! when statting a closed filehandle (RT#108288)' \
'Fedora Patch72: Fix tainting of s/// with overloaded replacement (RT#115266)' \
'Fedora Patch73: Expand system() arguments before a fork (RT#121105)' \
'Fedora Patch76: Avoid undefined behavior when copying memory in Glob and pp_caller (RT#131746)' \
'Fedora Patch78: Fix compatibility with libxcrypt (RT#133184)' \
'Fedora Patch79: Link XS modules to pthread library to fix linking with -z defs' \
'Fedora Patch80: Fix parsing braced subscript after parentheses (RT#8045)' \
'Fedora Patch81: Do not clobber file bytes in :encoding layer (RT#132833)' \
'Fedora Patch82: Fix line numbers in multi-line s/// (RT#131930)' \
'Fedora Patch83: Fix parsing extended bracketed character classes (RT#132167)' \
'Fedora Patch84: Fix a possibly unitialized memory read in the Perl parser (RT#133074)' \
'Fedora Patch85: Fix an infinite loop in the regular expression compiler (RT#133185)' \
'Fedora Patch3: use libresolv instead of libbind' \
'Fedora Patch4: USE_MM_LD_RUN_PATH' \
'Fedora Patch5: Provide MM::maybe_command independently (bug #1129443)' \
'Fedora Patch6: Dont run one io test due to random builder failures' \
'Fedora Patch8: Define SONAME for libperl.so' \
'Fedora Patch9: Install libperl.so to -Dshrpdir value' \
'Fedora Patch10: Document Math::BigInt::CalcEmu requires Math::BigInt (CPAN RT#85015)' \
'Fedora Patch11: Make *DBM_File desctructors thread-safe (RT#61912)' \
'Fedora Patch12: Replace EU::MakeMaker dependency with EU::MM::Utils in IPC::Cmd (bug #1129443)' \
'Fedora Patch13: Fix executing arybase::_tie_it() in Safe compartement (RT#131588)' \
'Fedora Patch14: Link XS modules to pthread library to fix linking with -z defs' \
'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \
'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
%{nil}
@ -4286,6 +4094,7 @@ popd
%{privlib}/CPAN/Meta/Converter.pm
%{privlib}/CPAN/Meta/Feature.pm
%dir %{privlib}/CPAN/Meta/History
%{privlib}/CPAN/Meta/History/Meta*
%{privlib}/CPAN/Meta/History.pm
%{privlib}/CPAN/Meta/Merge.pm
%{privlib}/CPAN/Meta/Prereqs.pm
@ -5221,6 +5030,10 @@ popd
# Old changelog entries are preserved in CVS.
%changelog
* Tue Jun 26 2018 Jitka Plesnikova <jplesnik@redhat.com> - 4:5.28.0-415
- 5.28.0 bump (see <https://metacpan.org/pod/release/XSAWYERX/perl-5.28.0/pod/perldelta.pod>
for release notes)
* Fri May 25 2018 Petr Pisar <ppisar@redhat.com> - 4:5.26.2-414
- Fix an infinite loop in the regular expression compiler (RT#133185)

View File

@ -1 +1 @@
SHA512 (perl-5.26.2.tar.bz2) = ee9e8e56dc053b29294bd867f8651e37124a68f46a1aeffd5042e55abeacd55e19acd346dd7e7b39db202f65288cfcd7668b63e85ceeaae511462e0bbf5f733a
SHA512 (perl-5.28.0.tar.xz) = de701e37371b81cecf06098bb2c09017bde9cebaf9537d58838d0adf605ac2ecf739897b0a73576a7adb74d4cf65591ec4d2ed1f94b7191e695f88cb7e214a39