Compare commits
55 Commits
Author | SHA1 | Date |
---|---|---|
Jitka Plesnikova | e5b8656035 | |
Petr Písař | fc0d45e3f8 | |
Petr Písař | 274d3944a9 | |
Petr Písař | 5b60fc1457 | |
Petr Písař | 78cf160884 | |
Petr Písař | 2d50691c83 | |
Petr Písař | 72e436423c | |
Petr Písař | c9dfb72cde | |
Petr Písař | 1fc5049a79 | |
Petr Písař | 76e6db566f | |
Petr Písař | 0ef0d6cb42 | |
Petr Písař | b79c21226a | |
Petr Písař | 7d019df066 | |
Petr Písař | dd252f70bc | |
Petr Písař | 484f119f04 | |
Petr Písař | 80911529e5 | |
Petr Písař | 1c39f84025 | |
Petr Písař | 2b73452532 | |
Petr Písař | fcbf7bd51a | |
Petr Písař | a05a3a16f9 | |
Petr Písař | 9692f34557 | |
Petr Písař | e8b0bf4b5c | |
Petr Písař | bcc35dc4f4 | |
Petr Písař | 962c5141e2 | |
Petr Písař | 1db7a9786c | |
Petr Písař | 628397ebd0 | |
Petr Písař | 60c6ffd4a1 | |
Petr Písař | c23879e98f | |
Jitka Plesnikova | e7934ed5ac | |
Petr Písař | 79b8edddae | |
Petr Písař | a3871a6bc0 | |
Petr Písař | 807139eab9 | |
Petr Písař | 1d4a4ab82f | |
Petr Písař | d31c571d9b | |
Petr Písař | 37bcef5aed | |
Petr Písař | 82a2a484bc | |
Petr Písař | eda9660722 | |
Petr Písař | c7d9a35fb8 | |
Petr Písař | fb5031caa5 | |
Petr Písař | c104251b47 | |
Petr Písař | 296892300c | |
Petr Písař | 2bcc96be96 | |
Petr Písař | 04a7dad8a7 | |
Petr Písař | be3f0bf7eb | |
Petr Písař | c97f38aed9 | |
Petr Písař | 5d6a5ae819 | |
Petr Písař | a8fc8833db | |
Petr Písař | f5a25d6db2 | |
Petr Písař | bf1e935711 | |
Petr Písař | a0f4e270b1 | |
Jitka Plesnikova | 91d3c16704 | |
Petr Písař | 0f54b8ef65 | |
Jitka Plesnikova | aad2faf3c0 | |
Petr Písař | 2c07853b1d | |
Jitka Plesnikova | bedaf21285 |
|
@ -20,3 +20,6 @@ perl-5.12.1.tar.gz
|
|||
/perl-5.20.2.tar.bz2
|
||||
/perl-5.22.0.tar.bz2
|
||||
/perl-5.22.1.tar.bz2
|
||||
/perl-5.22.2.tar.bz2
|
||||
/perl-5.22.3.tar.bz2
|
||||
/perl-5.22.4.tar.bz2
|
||||
|
|
|
@ -5,8 +5,8 @@ diff -up perl-5.10.0/Configure.didi perl-5.10.0/Configure
|
|||
: set usesocks on the Configure command line to enable socks.
|
||||
: List of libraries we want.
|
||||
: If anyone needs extra -lxxx, put those in a hint file.
|
||||
-libswanted="cl pthread socket bind inet nsl nm ndbm gdbm dbm db malloc dl ld"
|
||||
+libswanted="cl pthread socket resolv inet nsl nm ndbm gdbm dbm db malloc dl ld"
|
||||
-libswanted="cl pthread socket bind inet nsl ndbm gdbm dbm db malloc dl ld"
|
||||
+libswanted="cl pthread socket resolv inet nsl ndbm gdbm dbm db malloc dl ld"
|
||||
libswanted="$libswanted sun m crypt sec util c cposix posix ucb bsd BSD"
|
||||
: We probably want to search /usr/shlib before most other libraries.
|
||||
: This is only used by the lib/ExtUtils/MakeMaker.pm routine extliblist.
|
||||
|
|
|
@ -1,38 +0,0 @@
|
|||
From 73949fca082fe50bf47755c5ffa328259057ae36 Mon Sep 17 00:00:00 2001
|
||||
From: David Mitchell <davem@iabyn.com>
|
||||
Date: Mon, 8 Jun 2015 09:15:17 +0100
|
||||
Subject: [PATCH] make PadlistNAMES() lvalue again.
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
The PadlistNAMES() macro was introduced with v5.17.3-69-g86d2498.
|
||||
This macro happened to be lvalue-capable, although it wasn't documented
|
||||
as such.
|
||||
|
||||
v5.21.6-163-g9b7476d as a side effect, broke the lvalueness, which broke
|
||||
Coro.
|
||||
|
||||
This commit restores the lvalueness.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
pad.h | 2 +-
|
||||
1 file changed, 1 insertion(+), 1 deletion(-)
|
||||
|
||||
diff --git a/pad.h b/pad.h
|
||||
index 1f86248..31b8715 100644
|
||||
--- a/pad.h
|
||||
+++ b/pad.h
|
||||
@@ -295,7 +295,7 @@ Restore the old pad saved into the local variable opad by PAD_SAVE_LOCAL()
|
||||
|
||||
#define PadlistARRAY(pl) (pl)->xpadl_alloc
|
||||
#define PadlistMAX(pl) (pl)->xpadl_max
|
||||
-#define PadlistNAMES(pl) ((PADNAMELIST *)*PadlistARRAY(pl))
|
||||
+#define PadlistNAMES(pl) *((PADNAMELIST **)PadlistARRAY(pl))
|
||||
#define PadlistNAMESARRAY(pl) PadnamelistARRAY(PadlistNAMES(pl))
|
||||
#define PadlistNAMESMAX(pl) PadnamelistMAX(PadlistNAMES(pl))
|
||||
#define PadlistREFCNT(pl) 1 /* reserved for future use */
|
||||
--
|
||||
2.1.0
|
||||
|
|
@ -0,0 +1,126 @@
|
|||
From fb211db6cbcf25bbdeaa39b6685fae7228c92b3a Mon Sep 17 00:00:00 2001
|
||||
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
|
||||
Date: Thu, 24 Nov 2016 16:34:09 +0100
|
||||
Subject: [PATCH] Fix const correctness in hv_func.h
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Building an XS code with -Wcast-qual yielded warnings about discarding
|
||||
const qualifiers from pointer targets like:
|
||||
|
||||
$ printf '#include "EXTERN.h"\n#include "perl.h"\n' | gcc -Wcast-qual -I/usr/lib64/perl5/CORE -c -x c -
|
||||
In file included from /usr/lib64/perl5/CORE/hv.h:629:0,
|
||||
from /usr/lib64/perl5/CORE/perl.h:3740,
|
||||
from <stdin>:2:
|
||||
/usr/lib64/perl5/CORE/hv_func.h: In function ‘S_perl_hash_siphash_2_4’:
|
||||
/usr/lib64/perl5/CORE/hv_func.h:213:17: warning: cast discards ‘const’ qualifier from pointer target type [-Wcast-qual]
|
||||
U64TYPE k0 = ((U64TYPE*)seed)[0];
|
||||
^
|
||||
|
||||
Petr Písař: Ported to 5.22.2.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
hv_func.h | 22 +++++++++++-----------
|
||||
1 file changed, 11 insertions(+), 11 deletions(-)
|
||||
|
||||
diff --git a/hv_func.h b/hv_func.h
|
||||
index 49a677e..e64d21f 100644
|
||||
--- a/hv_func.h
|
||||
+++ b/hv_func.h
|
||||
@@ -118,7 +118,7 @@
|
||||
|
||||
#if (BYTEORDER == 0x1234 || BYTEORDER == 0x12345678) && U32SIZE == 4
|
||||
/* CPU endian matches murmurhash algorithm, so read 32-bit word directly */
|
||||
- #define U8TO32_LE(ptr) (*((U32*)(ptr)))
|
||||
+ #define U8TO32_LE(ptr) (*((const U32*)(ptr)))
|
||||
#elif BYTEORDER == 0x4321 || BYTEORDER == 0x87654321
|
||||
/* TODO: Add additional cases below where a compiler provided bswap32 is available */
|
||||
#if defined(__GNUC__) && (__GNUC__>4 || (__GNUC__==4 && __GNUC_MINOR__>=3))
|
||||
@@ -210,8 +210,8 @@ S_perl_hash_siphash_2_4(const unsigned char * const seed, const unsigned char *i
|
||||
U64TYPE v3 = UINT64_C(0x7465646279746573);
|
||||
|
||||
U64TYPE b;
|
||||
- U64TYPE k0 = ((U64TYPE*)seed)[0];
|
||||
- U64TYPE k1 = ((U64TYPE*)seed)[1];
|
||||
+ U64TYPE k0 = ((const U64TYPE*)seed)[0];
|
||||
+ U64TYPE k1 = ((const U64TYPE*)seed)[1];
|
||||
U64TYPE m;
|
||||
const int left = inlen & 7;
|
||||
const U8 *end = in + inlen - left;
|
||||
@@ -269,7 +269,7 @@ S_perl_hash_siphash_2_4(const unsigned char * const seed, const unsigned char *i
|
||||
|
||||
PERL_STATIC_INLINE U32
|
||||
S_perl_hash_superfast(const unsigned char * const seed, const unsigned char *str, STRLEN len) {
|
||||
- U32 hash = *((U32*)seed) + (U32)len;
|
||||
+ U32 hash = *((const U32*)seed) + (U32)len;
|
||||
U32 tmp;
|
||||
int rem= len & 3;
|
||||
len >>= 2;
|
||||
@@ -373,7 +373,7 @@ S_perl_hash_superfast(const unsigned char * const seed, const unsigned char *str
|
||||
/* now we create the hash function */
|
||||
PERL_STATIC_INLINE U32
|
||||
S_perl_hash_murmur3(const unsigned char * const seed, const unsigned char *ptr, STRLEN len) {
|
||||
- U32 h1 = *((U32*)seed);
|
||||
+ U32 h1 = *((const U32*)seed);
|
||||
U32 k1;
|
||||
U32 carry = 0;
|
||||
|
||||
@@ -467,7 +467,7 @@ S_perl_hash_murmur3(const unsigned char * const seed, const unsigned char *ptr,
|
||||
PERL_STATIC_INLINE U32
|
||||
S_perl_hash_djb2(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
|
||||
const unsigned char * const end = (const unsigned char *)str + len;
|
||||
- U32 hash = *((U32*)seed) + (U32)len;
|
||||
+ U32 hash = *((const U32*)seed) + (U32)len;
|
||||
while (str < end) {
|
||||
hash = ((hash << 5) + hash) + *str++;
|
||||
}
|
||||
@@ -477,7 +477,7 @@ S_perl_hash_djb2(const unsigned char * const seed, const unsigned char *str, con
|
||||
PERL_STATIC_INLINE U32
|
||||
S_perl_hash_sdbm(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
|
||||
const unsigned char * const end = (const unsigned char *)str + len;
|
||||
- U32 hash = *((U32*)seed) + (U32)len;
|
||||
+ U32 hash = *((const U32*)seed) + (U32)len;
|
||||
while (str < end) {
|
||||
hash = (hash << 6) + (hash << 16) - hash + *str++;
|
||||
}
|
||||
@@ -503,7 +503,7 @@ S_perl_hash_sdbm(const unsigned char * const seed, const unsigned char *str, con
|
||||
PERL_STATIC_INLINE U32
|
||||
S_perl_hash_one_at_a_time(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
|
||||
const unsigned char * const end = (const unsigned char *)str + len;
|
||||
- U32 hash = *((U32*)seed) + (U32)len;
|
||||
+ U32 hash = *((const U32*)seed) + (U32)len;
|
||||
while (str < end) {
|
||||
hash += *str++;
|
||||
hash += (hash << 10);
|
||||
@@ -518,7 +518,7 @@ S_perl_hash_one_at_a_time(const unsigned char * const seed, const unsigned char
|
||||
PERL_STATIC_INLINE U32
|
||||
S_perl_hash_one_at_a_time_hard(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
|
||||
const unsigned char * const end = (const unsigned char *)str + len;
|
||||
- U32 hash = *((U32*)seed) + (U32)len;
|
||||
+ U32 hash = *((const U32*)seed) + (U32)len;
|
||||
|
||||
while (str < end) {
|
||||
hash += (hash << 10);
|
||||
@@ -553,7 +553,7 @@ S_perl_hash_one_at_a_time_hard(const unsigned char * const seed, const unsigned
|
||||
PERL_STATIC_INLINE U32
|
||||
S_perl_hash_old_one_at_a_time(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
|
||||
const unsigned char * const end = (const unsigned char *)str + len;
|
||||
- U32 hash = *((U32*)seed);
|
||||
+ U32 hash = *((const U32*)seed);
|
||||
while (str < end) {
|
||||
hash += *str++;
|
||||
hash += (hash << 10);
|
||||
@@ -581,7 +581,7 @@ S_perl_hash_murmur_hash_64a (const unsigned char * const seed, const unsigned ch
|
||||
{
|
||||
const U64TYPE m = 0xc6a4a7935bd1e995;
|
||||
const int r = 47;
|
||||
- U64TYPE h = *((U64TYPE*)seed) ^ len;
|
||||
+ U64TYPE h = *((const U64TYPE*)seed) ^ len;
|
||||
const U64TYPE * data = (const U64TYPE *)str;
|
||||
const U64TYPE * end = data + (len/8);
|
||||
const unsigned char * data2;
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,73 @@
|
|||
From fdee5b4a06f183a26f897e1ea8825da3577b74fd Mon Sep 17 00:00:00 2001
|
||||
From: David Mitchell <davem@iabyn.com>
|
||||
Date: Mon, 5 Dec 2016 14:54:44 +0000
|
||||
Subject: [PATCH] assertion failure in ... or ((0) x 0))
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Petr Pisar: Ported to 5.22.2:
|
||||
|
||||
commit 5aa240eab7dbaa91f98c2fee1f04b6c0b5a9b9e3
|
||||
Author: David Mitchell <davem@iabyn.com>
|
||||
Date: Mon Dec 5 14:54:44 2016 +0000
|
||||
|
||||
assertion failure in ... or ((0) x 0))
|
||||
|
||||
[perl #130247] Perl_rpeep(OP *): Assertion `oldop' failed
|
||||
|
||||
the 'x 0' optimising code in rpeep didn't expect the repeat expression
|
||||
to occur on the op_other side of an op_next chain.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
op.c | 4 ++--
|
||||
t/op/repeat.t | 11 ++++++++++-
|
||||
2 files changed, 12 insertions(+), 3 deletions(-)
|
||||
|
||||
diff --git a/op.c b/op.c
|
||||
index e92de57..48b1130 100644
|
||||
--- a/op.c
|
||||
+++ b/op.c
|
||||
@@ -13297,10 +13297,10 @@ Perl_rpeep(pTHX_ OP *o)
|
||||
&& kid->op_next->op_type == OP_REPEAT
|
||||
&& kid->op_next->op_private & OPpREPEAT_DOLIST
|
||||
&& (kid->op_next->op_flags & OPf_WANT) == OPf_WANT_LIST
|
||||
- && SvIOK(kSVOP_sv) && SvIVX(kSVOP_sv) == 0)
|
||||
+ && SvIOK(kSVOP_sv) && SvIVX(kSVOP_sv) == 0
|
||||
+ && oldop)
|
||||
{
|
||||
o = kid->op_next; /* repeat */
|
||||
- assert(oldop);
|
||||
oldop->op_next = o;
|
||||
op_free(cBINOPo->op_first);
|
||||
op_free(cBINOPo->op_last );
|
||||
diff --git a/t/op/repeat.t b/t/op/repeat.t
|
||||
index 8df5241..2bd3c62 100644
|
||||
--- a/t/op/repeat.t
|
||||
+++ b/t/op/repeat.t
|
||||
@@ -6,7 +6,7 @@ BEGIN {
|
||||
}
|
||||
|
||||
require './test.pl';
|
||||
-plan(tests => 47);
|
||||
+plan(tests => 48);
|
||||
|
||||
# compile time
|
||||
|
||||
@@ -173,3 +173,12 @@ for(($#that_array)x2) {
|
||||
$_ *= 2;
|
||||
}
|
||||
is($#that_array, 28, 'list repetition propagates lvalue cx to its lhs');
|
||||
+
|
||||
+# [perl #130247] Perl_rpeep(OP *): Assertion `oldop' failed
|
||||
+#
|
||||
+# the 'x 0' optimising code in rpeep didn't expect the repeat expression
|
||||
+# to occur on the op_other side of an op_next chain.
|
||||
+# This used to give an assertion failure
|
||||
+
|
||||
+eval q{() = (() or ((0) x 0)); 1};
|
||||
+is($@, "", "RT #130247");
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,101 @@
|
|||
From 31321d9c337d50cc8ead96ffacc82c90999ecef0 Mon Sep 17 00:00:00 2001
|
||||
From: Father Chrysostomos <sprout@cpan.org>
|
||||
Date: Mon, 11 Jul 2016 14:49:17 -0700
|
||||
Subject: [PATCH] Crash from gp_free/ckWARN_d
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Ported to 5.22.2:
|
||||
|
||||
commit a2637ca0a3fec01b80d7ea5ba62802354fd5e6f3
|
||||
Author: Father Chrysostomos <sprout@cpan.org>
|
||||
Date: Mon Jul 11 14:49:17 2016 -0700
|
||||
|
||||
[perl #128597] Crash from gp_free/ckWARN_d
|
||||
|
||||
See the explanation in the test added and in the RT ticket.
|
||||
|
||||
The solution is to make the warn macros check that PL_curcop
|
||||
is non-null.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
regen/warnings.pl | 6 ++++--
|
||||
t/op/gv.t | 18 +++++++++++++++++-
|
||||
warnings.h | 6 ++++--
|
||||
3 files changed, 25 insertions(+), 5 deletions(-)
|
||||
|
||||
diff --git a/regen/warnings.pl b/regen/warnings.pl
|
||||
index 694cb03..85e6d5a 100644
|
||||
--- a/regen/warnings.pl
|
||||
+++ b/regen/warnings.pl
|
||||
@@ -362,8 +362,10 @@ EOM
|
||||
|
||||
print $warn <<'EOM';
|
||||
|
||||
-#define isLEXWARN_on (PL_curcop->cop_warnings != pWARN_STD)
|
||||
-#define isLEXWARN_off (PL_curcop->cop_warnings == pWARN_STD)
|
||||
+#define isLEXWARN_on \
|
||||
+ (PL_curcop && PL_curcop->cop_warnings != pWARN_STD)
|
||||
+#define isLEXWARN_off \
|
||||
+ (!PL_curcop || PL_curcop->cop_warnings == pWARN_STD)
|
||||
#define isWARN_ONCE (PL_dowarn & (G_WARN_ON|G_WARN_ONCE))
|
||||
#define isWARN_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)))
|
||||
#define isWARNf_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)+1))
|
||||
diff --git a/t/op/gv.t b/t/op/gv.t
|
||||
index 2c9cc64..0cb8ebe 100644
|
||||
--- a/t/op/gv.t
|
||||
+++ b/t/op/gv.t
|
||||
@@ -12,7 +12,7 @@ BEGIN {
|
||||
|
||||
use warnings;
|
||||
|
||||
-plan(tests => 276 );
|
||||
+plan(tests => 277 );
|
||||
|
||||
# type coercion on assignment
|
||||
$foo = 'foo';
|
||||
@@ -1150,6 +1150,22 @@ pass "No crash due to CvGV pointing to glob copy in the stash";
|
||||
is($c_125840, 1, 'RT #125840: $c=$d');
|
||||
}
|
||||
|
||||
+# [perl #128597] Crash when gp_free calls ckWARN_d
|
||||
+# I am not sure this test even belongs in this file, as the crash was the
|
||||
+# result of various features interacting. But a call to ckWARN_d from
|
||||
+# gv.c:gp_free triggered the crash, so this seems as good a place as any.
|
||||
+# ‘die’ (or any abnormal scope exit) can cause the current cop to be freed,
|
||||
+# if the subroutine containing the ‘die’ gets freed as a result. That
|
||||
+# causes PL_curcop to be set to NULL. If a writable handle gets freed
|
||||
+# while PL_curcop is NULL, then gp_free will call ckWARN_d while that con-
|
||||
+# dition still holds, so ckWARN_d needs to know about PL_curcop possibly
|
||||
+# being NULL.
|
||||
+SKIP: {
|
||||
+ skip_if_miniperl("No PerlIO::scalar on miniperl", 1);
|
||||
+ runperl(prog => 'open my $fh, q|>|, \$buf;'
|
||||
+ .'my $sub = eval q|sub {exit 0}|; $sub->()');
|
||||
+ is ($? & 127, 0,"[perl #128597] No crash when gp_free calls ckWARN_d");
|
||||
+}
|
||||
|
||||
__END__
|
||||
Perl
|
||||
diff --git a/warnings.h b/warnings.h
|
||||
index 24fe243..b0a0eb4 100644
|
||||
--- a/warnings.h
|
||||
+++ b/warnings.h
|
||||
@@ -117,8 +117,10 @@
|
||||
#define WARN_ALLstring "\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125"
|
||||
#define WARN_NONEstring "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"
|
||||
|
||||
-#define isLEXWARN_on (PL_curcop->cop_warnings != pWARN_STD)
|
||||
-#define isLEXWARN_off (PL_curcop->cop_warnings == pWARN_STD)
|
||||
+#define isLEXWARN_on \
|
||||
+ (PL_curcop && PL_curcop->cop_warnings != pWARN_STD)
|
||||
+#define isLEXWARN_off \
|
||||
+ (!PL_curcop || PL_curcop->cop_warnings == pWARN_STD)
|
||||
#define isWARN_ONCE (PL_dowarn & (G_WARN_ON|G_WARN_ONCE))
|
||||
#define isWARN_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)))
|
||||
#define isWARNf_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)+1))
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,66 @@
|
|||
From 36dc786e5ea4a6d3e85f1f55251b8538fabb8321 Mon Sep 17 00:00:00 2001
|
||||
From: Tony Cook <tony@develop-help.com>
|
||||
Date: Mon, 5 Sep 2016 15:40:11 +1000
|
||||
Subject: [PATCH] (perl #129130) make chdir allocate the stack it needs
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Ported to 5.22.2:
|
||||
|
||||
commit 92c843fb4b4e1a1e0ac7ec0fe198dc77266838da
|
||||
Author: Tony Cook <tony@develop-help.com>
|
||||
Date: Mon Sep 5 15:40:11 2016 +1000
|
||||
|
||||
(perl #129130) make chdir allocate the stack it needs
|
||||
|
||||
chdir with no argument didn't ensure there was stack space available
|
||||
for its result.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
pp_sys.c | 1 +
|
||||
t/op/chdir.t | 8 +++++++-
|
||||
2 files changed, 8 insertions(+), 1 deletion(-)
|
||||
|
||||
diff --git a/pp_sys.c b/pp_sys.c
|
||||
index 1285c75..2171a1a 100644
|
||||
--- a/pp_sys.c
|
||||
+++ b/pp_sys.c
|
||||
@@ -3580,6 +3580,7 @@ PP(pp_chdir)
|
||||
HV * const table = GvHVn(PL_envgv);
|
||||
SV **svp;
|
||||
|
||||
+ EXTEND(SP, 1);
|
||||
if ( (svp = hv_fetchs(table, "HOME", FALSE))
|
||||
|| (svp = hv_fetchs(table, "LOGDIR", FALSE))
|
||||
#ifdef VMS
|
||||
diff --git a/t/op/chdir.t b/t/op/chdir.t
|
||||
index 813b0ed..f16be41 100644
|
||||
--- a/t/op/chdir.t
|
||||
+++ b/t/op/chdir.t
|
||||
@@ -10,7 +10,7 @@ BEGIN {
|
||||
# possibilities into @INC.
|
||||
unshift @INC, qw(t . lib ../lib);
|
||||
require "./test.pl";
|
||||
- plan(tests => 48);
|
||||
+ plan(tests => 49);
|
||||
}
|
||||
|
||||
use Config;
|
||||
@@ -176,6 +176,12 @@ WARNING
|
||||
}
|
||||
}
|
||||
|
||||
+fresh_perl_is(<<'EOP', '', { stderr => 1 }, "check stack handling");
|
||||
+for $x (map $_+1, 1 .. 100) {
|
||||
+ map chdir, 1 .. $x;
|
||||
+}
|
||||
+EOP
|
||||
+
|
||||
my %Saved_Env = ();
|
||||
sub clean_env {
|
||||
foreach my $env (@magic_envs) {
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,79 @@
|
|||
From 5114cc26ed8a68debf3e4ed357f205ddaf99ef15 Mon Sep 17 00:00:00 2001
|
||||
From: Father Chrysostomos <sprout@cpan.org>
|
||||
Date: Sun, 11 Sep 2016 21:29:56 -0700
|
||||
Subject: [PATCH] Crash with splice
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Ported to 5.22.2:
|
||||
|
||||
commit 92b69f6501b4d7351e09c8b1ddd386aa7e1c9cd1
|
||||
Author: Father Chrysostomos <sprout@cpan.org>
|
||||
Date: Sun Sep 11 21:29:56 2016 -0700
|
||||
|
||||
[perl #129164] Crash with splice
|
||||
|
||||
This fixes #129166 and #129167 as well.
|
||||
|
||||
splice needs to take into account that arrays can hold NULLs and
|
||||
return &PL_sv_undef in those cases where it would have returned a
|
||||
NULL element.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
pp.c | 4 ++++
|
||||
t/op/array.t | 17 +++++++++++++++++
|
||||
2 files changed, 21 insertions(+)
|
||||
|
||||
diff --git a/pp.c b/pp.c
|
||||
index 3173c5a..996b346 100644
|
||||
--- a/pp.c
|
||||
+++ b/pp.c
|
||||
@@ -5325,6 +5325,8 @@ PP(pp_splice)
|
||||
for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--)
|
||||
SvREFCNT_dec(*dst++); /* free them now */
|
||||
}
|
||||
+ if (!*MARK)
|
||||
+ *MARK = &PL_sv_undef;
|
||||
}
|
||||
AvFILLp(ary) += diff;
|
||||
|
||||
@@ -5421,6 +5423,8 @@ PP(pp_splice)
|
||||
while (length-- > 0)
|
||||
SvREFCNT_dec(tmparyval[length]);
|
||||
}
|
||||
+ if (!*MARK)
|
||||
+ *MARK = &PL_sv_undef;
|
||||
}
|
||||
else
|
||||
*MARK = &PL_sv_undef;
|
||||
diff --git a/t/op/array.t b/t/op/array.t
|
||||
index 7239d48..bbdf86c 100644
|
||||
--- a/t/op/array.t
|
||||
+++ b/t/op/array.t
|
||||
@@ -549,4 +549,21 @@ is "@ary", 'b a',
|
||||
for(scalar $#foo) { $_ = 3 }
|
||||
is $#foo, 3, 'assigning to arylen aliased in foreach(scalar $#arylen)';
|
||||
|
||||
+# [perl #129164], [perl #129166], [perl #129167]
|
||||
+# splice() with null array entries
|
||||
+# These used to crash.
|
||||
+$#a = -1; $#a++;
|
||||
+() = 0-splice @a; # subtract
|
||||
+$#a = -1; $#a++;
|
||||
+() = -splice @a; # negate
|
||||
+$#a = -1; $#a++;
|
||||
+() = 0+splice @a; # add
|
||||
+# And with array expansion, too
|
||||
+$#a = -1; $#a++;
|
||||
+() = 0-splice @a, 0, 1, 1, 1;
|
||||
+$#a = -1; $#a++;
|
||||
+() = -splice @a, 0, 1, 1, 1;
|
||||
+$#a = -1; $#a++;
|
||||
+() = 0+splice @a, 0, 1, 1, 1;
|
||||
+
|
||||
"We're included by lib/Tie/Array/std.t so we need to return something true";
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,56 @@
|
|||
From 23628ae4896040e64261a925d06d8003c61d8bbd Mon Sep 17 00:00:00 2001
|
||||
From: Hugo van der Sanden <hv@crypt.org>
|
||||
Date: Tue, 4 Oct 2016 14:40:11 +0100
|
||||
Subject: [PATCH] anchored/floating substrings must be utf8 if target is
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Ported to 5.22.2:
|
||||
|
||||
commit 2814f4b3549f665a6f9203ac9e890ae1e415e0dc
|
||||
Author: Hugo van der Sanden <hv@crypt.org>
|
||||
Date: Tue Oct 4 14:40:11 2016 +0100
|
||||
|
||||
[perl #129350] anchored/floating substrings must be utf8 if target is
|
||||
|
||||
If the target is utf8 and either the anchored or floating substrings
|
||||
are not, we need to create utf8 copies to check against. The state
|
||||
of the two substrings may not be the same, but we were only testing
|
||||
whichever we planned to check first.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
regexec.c | 3 ++-
|
||||
t/re/re_tests | 1 +
|
||||
2 files changed, 3 insertions(+), 1 deletion(-)
|
||||
|
||||
diff --git a/regexec.c b/regexec.c
|
||||
index e38c6ca..98df35d 100644
|
||||
--- a/regexec.c
|
||||
+++ b/regexec.c
|
||||
@@ -694,7 +694,8 @@ Perl_re_intuit_start(pTHX_
|
||||
reginfo->poscache_maxiter = 0;
|
||||
|
||||
if (utf8_target) {
|
||||
- if (!prog->check_utf8 && prog->check_substr)
|
||||
+ if ((!prog->anchored_utf8 && prog->anchored_substr)
|
||||
+ || (!prog->float_utf8 && prog->float_substr))
|
||||
to_utf8_substr(prog);
|
||||
check = prog->check_utf8;
|
||||
} else {
|
||||
diff --git a/t/re/re_tests b/t/re/re_tests
|
||||
index 85ce7f4..c65bcce 100644
|
||||
--- a/t/re/re_tests
|
||||
+++ b/t/re/re_tests
|
||||
@@ -1941,6 +1941,7 @@ A+(*PRUNE)BC(?{}) AAABC y $& AAABC
|
||||
.{1}?? - c - Nested quantifiers
|
||||
.{1}?+ - c - Nested quantifiers
|
||||
(?:.||)(?|)000000000@ 000000000@ y $& 000000000@ # [perl #126405]
|
||||
+\b\z0*\x{100} .\x{100} n - - # [perl #129350] crashed in intuit_start
|
||||
|
||||
# Keep these lines at the end of the file
|
||||
# vim: softtabstop=0 noexpandtab
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,134 @@
|
|||
From 5ae12482f66b0062e89b661641647aa99c2b9ad9 Mon Sep 17 00:00:00 2001
|
||||
From: Tony Cook <tony@develop-help.com>
|
||||
Date: Tue, 25 Oct 2016 16:17:18 +1100
|
||||
Subject: [PATCH] (perl #129788) IO::Poll: fix memory leak
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Petr Pisar: Ported to 5.22.2:
|
||||
|
||||
commit 6de2dd46140d0d3ab6813e26940d7b74418b0260
|
||||
Author: Tony Cook <tony@develop-help.com>
|
||||
Date: Tue Oct 25 16:17:18 2016 +1100
|
||||
|
||||
(perl #129788) IO::Poll: fix memory leak
|
||||
|
||||
Whenever a magical/tied scalar which dies upon read was passed to _poll()
|
||||
temporary buffer for events was not freed.
|
||||
|
||||
Adapted from a patch by Sergey Aleynikov <sergey.aleynikov@gmail.com>
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
MANIFEST | 1 +
|
||||
META.json | 1 +
|
||||
META.yml | 1 +
|
||||
dist/IO/IO.xs | 3 +--
|
||||
dist/IO/t/io_leak.t | 37 +++++++++++++++++++++++++++++++++++++
|
||||
5 files changed, 41 insertions(+), 2 deletions(-)
|
||||
create mode 100644 dist/IO/t/io_leak.t
|
||||
|
||||
diff --git a/MANIFEST b/MANIFEST
|
||||
index 4cc6433..110d4f9 100644
|
||||
--- a/MANIFEST
|
||||
+++ b/MANIFEST
|
||||
@@ -3129,6 +3129,7 @@ dist/IO/t/io_dir.t See if directory-related methods from IO work
|
||||
dist/IO/t/io_dup.t See if dup()-related methods from IO work
|
||||
dist/IO/t/io_file_export.t Test IO::File exports
|
||||
dist/IO/t/io_file.t See if binmode()-related methods on IO::File work
|
||||
+dist/IO/t/io_leak.t See if IO leaks SVs (only run in core)
|
||||
dist/IO/t/io_linenum.t See if I/O line numbers are tracked correctly
|
||||
dist/IO/t/io_multihomed.t See if INET sockets work with multi-homed hosts
|
||||
dist/IO/t/io_pipe.t See if pipe()-related methods from IO work
|
||||
diff --git a/META.json b/META.json
|
||||
index f639e6d..55838a7 100644
|
||||
--- a/META.json
|
||||
+++ b/META.json
|
||||
@@ -85,6 +85,7 @@
|
||||
"dist/IO/t/io_dup.t",
|
||||
"dist/IO/t/io_file.t",
|
||||
"dist/IO/t/io_file_export.t",
|
||||
+ "dist/IO/t/io_leak.t",
|
||||
"dist/IO/t/io_linenum.t",
|
||||
"dist/IO/t/io_multihomed.t",
|
||||
"dist/IO/t/io_pipe.t",
|
||||
diff --git a/META.yml b/META.yml
|
||||
index 4b525a4..7ab17f9 100644
|
||||
--- a/META.yml
|
||||
+++ b/META.yml
|
||||
@@ -82,6 +82,7 @@ no_index:
|
||||
- dist/IO/t/io_dup.t
|
||||
- dist/IO/t/io_file.t
|
||||
- dist/IO/t/io_file_export.t
|
||||
+ - dist/IO/t/io_leak.t
|
||||
- dist/IO/t/io_linenum.t
|
||||
- dist/IO/t/io_multihomed.t
|
||||
- dist/IO/t/io_pipe.t
|
||||
diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs
|
||||
index 1f546b9..b6b6ae9 100644
|
||||
--- a/dist/IO/IO.xs
|
||||
+++ b/dist/IO/IO.xs
|
||||
@@ -318,7 +318,7 @@ PPCODE:
|
||||
{
|
||||
#ifdef HAS_POLL
|
||||
const int nfd = (items - 1) / 2;
|
||||
- SV *tmpsv = NEWSV(999,nfd * sizeof(struct pollfd));
|
||||
+ SV *tmpsv = sv_2mortal(NEWSV(999,nfd * sizeof(struct pollfd)));
|
||||
struct pollfd *fds = (struct pollfd *)SvPVX(tmpsv);
|
||||
int i,j,ret;
|
||||
for(i=1, j=0 ; j < nfd ; j++) {
|
||||
@@ -334,7 +334,6 @@ PPCODE:
|
||||
sv_setiv(ST(i), fds[j].revents); i++;
|
||||
}
|
||||
}
|
||||
- SvREFCNT_dec(tmpsv);
|
||||
XSRETURN_IV(ret);
|
||||
#else
|
||||
not_here("IO::Poll::poll");
|
||||
diff --git a/dist/IO/t/io_leak.t b/dist/IO/t/io_leak.t
|
||||
new file mode 100644
|
||||
index 0000000..08cbe2b
|
||||
--- /dev/null
|
||||
+++ b/dist/IO/t/io_leak.t
|
||||
@@ -0,0 +1,37 @@
|
||||
+#!/usr/bin/perl
|
||||
+
|
||||
+use warnings;
|
||||
+use strict;
|
||||
+
|
||||
+use Test::More;
|
||||
+
|
||||
+eval { require XS::APItest; XS::APItest->import('sv_count'); 1 }
|
||||
+ or plan skip_all => "No XS::APItest::sv_count() available";
|
||||
+
|
||||
+plan tests => 1;
|
||||
+
|
||||
+sub leak {
|
||||
+ my ($n, $delta, $code, $name) = @_;
|
||||
+ my $sv0 = 0;
|
||||
+ my $sv1 = 0;
|
||||
+ for my $i (1..$n) {
|
||||
+ &$code();
|
||||
+ $sv1 = sv_count();
|
||||
+ $sv0 = $sv1 if $i == 1;
|
||||
+ }
|
||||
+ cmp_ok($sv1-$sv0, '<=', ($n-1)*$delta, $name);
|
||||
+}
|
||||
+
|
||||
+# [perl #129788] IO::Poll shouldn't leak on errors
|
||||
+{
|
||||
+ package io_poll_leak;
|
||||
+ use IO::Poll;
|
||||
+
|
||||
+ sub TIESCALAR { bless {} }
|
||||
+ sub FETCH { die }
|
||||
+
|
||||
+ tie(my $a, __PACKAGE__);
|
||||
+ sub f {eval { IO::Poll::_poll(0, $a, 1) }}
|
||||
+
|
||||
+ ::leak(5, 0, \&f, q{IO::Poll::_poll shouldn't leak});
|
||||
+}
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,53 @@
|
|||
From 5d9b0550a63f6b1e20a69ea9f60d2fffaca0af74 Mon Sep 17 00:00:00 2001
|
||||
From: Hugo van der Sanden <hv@crypt.org>
|
||||
Date: Mon, 12 Dec 2016 15:15:06 +0000
|
||||
Subject: [PATCH] Correctly unwind on cache hit
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Petr Pisar: Ported to 5.22.2:
|
||||
|
||||
commit d3c48e81594c1d64ba9833495e45d8951b42027c
|
||||
Author: Hugo van der Sanden <hv@crypt.org>
|
||||
Date: Mon Dec 12 15:15:06 2016 +0000
|
||||
|
||||
[perl #130307] Correctly unwind on cache hit
|
||||
|
||||
We've already incremented curlyx.count in the WHILEM branch before
|
||||
we check for a hit in the super-linear cache, so must reverse that
|
||||
on the sayNO.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
regexec.c | 1 +
|
||||
t/re/re_tests | 1 +
|
||||
2 files changed, 2 insertions(+)
|
||||
|
||||
diff --git a/regexec.c b/regexec.c
|
||||
index 98df35d..ff1d5d8 100644
|
||||
--- a/regexec.c
|
||||
+++ b/regexec.c
|
||||
@@ -6867,6 +6867,7 @@ NULL
|
||||
"%*s whilem: (cache) already tried at this position...\n",
|
||||
REPORT_CODE_OFF+depth*2, "")
|
||||
);
|
||||
+ cur_curlyx->u.curlyx.count--;
|
||||
sayNO; /* cache records failure */
|
||||
}
|
||||
ST.cache_offset = offset;
|
||||
diff --git a/t/re/re_tests b/t/re/re_tests
|
||||
index c65bcce..41fc458 100644
|
||||
--- a/t/re/re_tests
|
||||
+++ b/t/re/re_tests
|
||||
@@ -1942,6 +1942,7 @@ A+(*PRUNE)BC(?{}) AAABC y $& AAABC
|
||||
.{1}?+ - c - Nested quantifiers
|
||||
(?:.||)(?|)000000000@ 000000000@ y $& 000000000@ # [perl #126405]
|
||||
\b\z0*\x{100} .\x{100} n - - # [perl #129350] crashed in intuit_start
|
||||
+(X{2,}[-X]{1,4}){3,}X{2,} XXX-XXX-XXX-- n - - # [perl #130307]
|
||||
|
||||
# Keep these lines at the end of the file
|
||||
# vim: softtabstop=0 noexpandtab
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,97 @@
|
|||
From e40804ef8d2f49e588498bcc4bc0ba8e108ac648 Mon Sep 17 00:00:00 2001
|
||||
From: Yves Orton <demerphq@gmail.com>
|
||||
Date: Thu, 27 Oct 2016 13:52:24 +0200
|
||||
Subject: [PATCH] regcomp.c: fix perl #129950 - fix firstchar bitmap under utf8
|
||||
with prefix optimisation
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Ported to 5.22.2:
|
||||
|
||||
commit da42332b10691ba7af7550035ffc7f46c87e4e66
|
||||
Author: Yves Orton <demerphq@gmail.com>
|
||||
Date: Thu Oct 27 13:52:24 2016 +0200
|
||||
|
||||
regcomp.c: fix perl #129950 - fix firstchar bitmap under utf8 with prefix optimisation
|
||||
|
||||
The trie code contains a number of sub optimisations, one of which
|
||||
extracts common prefixes from alternations, and another which isa
|
||||
bitmap of the possible matching first chars.
|
||||
|
||||
The bitmap needs to contain the possible first octets of the string
|
||||
which the trie can match, and for codepoints which might have a different
|
||||
first octet under utf8 or non-utf8 need to register BOTH codepoints.
|
||||
|
||||
So for instance in the pattern (?:a|a\x{E4}) we should restructure this
|
||||
as a(|\x{E4), and the bitmap for the trie should contain both \x{E4} AND
|
||||
\x{C3} as \x{C3} is the first byte of \x{EF} expressed as utf8.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
regcomp.c | 14 ++++++++++++++
|
||||
t/re/pat.t | 9 ++++++++-
|
||||
2 files changed, 22 insertions(+), 1 deletion(-)
|
||||
|
||||
diff --git a/regcomp.c b/regcomp.c
|
||||
index 9332dea..fcb5147 100644
|
||||
--- a/regcomp.c
|
||||
+++ b/regcomp.c
|
||||
@@ -2965,6 +2965,13 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch,
|
||||
TRIE_BITMAP_SET(trie,*ch);
|
||||
if ( folder )
|
||||
TRIE_BITMAP_SET(trie, folder[ *ch ]);
|
||||
+ if ( !UTF ) {
|
||||
+ /* store first byte of utf8 representation of
|
||||
+ variant codepoints */
|
||||
+ if (! UVCHR_IS_INVARIANT(*ch)) {
|
||||
+ TRIE_BITMAP_SET(trie, UTF8_TWO_BYTE_HI(*ch));
|
||||
+ }
|
||||
+ }
|
||||
DEBUG_OPTIMISE_r(
|
||||
PerlIO_printf(Perl_debug_log, "%s", (char*)ch)
|
||||
);
|
||||
@@ -2973,6 +2980,13 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch,
|
||||
TRIE_BITMAP_SET(trie,*ch);
|
||||
if ( folder )
|
||||
TRIE_BITMAP_SET(trie,folder[ *ch ]);
|
||||
+ if ( !UTF ) {
|
||||
+ /* store first byte of utf8 representation of
|
||||
+ variant codepoints */
|
||||
+ if (! UVCHR_IS_INVARIANT(*ch)) {
|
||||
+ TRIE_BITMAP_SET(trie, UTF8_TWO_BYTE_HI(*ch));
|
||||
+ }
|
||||
+ }
|
||||
DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"%s", ch));
|
||||
}
|
||||
idx = ofs;
|
||||
diff --git a/t/re/pat.t b/t/re/pat.t
|
||||
index 3377b19..2f18aa8 100644
|
||||
--- a/t/re/pat.t
|
||||
+++ b/t/re/pat.t
|
||||
@@ -23,7 +23,7 @@ BEGIN {
|
||||
skip_all_without_unicode_tables();
|
||||
}
|
||||
|
||||
-plan tests => 775; # Update this when adding/deleting tests.
|
||||
+plan tests => 777; # Update this when adding/deleting tests.
|
||||
|
||||
run_tests() unless caller;
|
||||
|
||||
@@ -1708,6 +1708,13 @@ EOP
|
||||
like($error, qr{Reference to nonexistent group},
|
||||
'gave appropriate error for qr{()(?1)}n');
|
||||
}
|
||||
+
|
||||
+ {
|
||||
+ my $str = "a\xE4";
|
||||
+ ok( $str =~ m{^(a|a\x{e4})$}, "fix [perl #129950] - latin1 case" );
|
||||
+ utf8::upgrade($str);
|
||||
+ ok( $str =~ m{^(a|a\x{e4})$}, "fix [perl #129950] - utf8 case" );
|
||||
+ }
|
||||
} # End of sub run_tests
|
||||
|
||||
1;
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,93 @@
|
|||
From de94c50b9dc29fcb2184347cb709c9fdeaaf5a7c Mon Sep 17 00:00:00 2001
|
||||
From: Yves Orton <demerphq@gmail.com>
|
||||
Date: Fri, 27 Jan 2017 10:18:51 +0100
|
||||
Subject: [PATCH] fix RT #130561 - recursion and optimising away impossible
|
||||
quantifiers are not friends
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Ported to 5.22.3:
|
||||
|
||||
commit 31fc93954d1f379c7a49889d91436ce99818e1f6
|
||||
Author: Yves Orton <demerphq@gmail.com>
|
||||
Date: Fri Jan 27 10:18:51 2017 +0100
|
||||
|
||||
fix RT #130561 - recursion and optimising away impossible quantifiers are not friends
|
||||
|
||||
Instead of optimising away impossible quantifiers like (foo){1,0} treat them
|
||||
as unquantified, and guard them with an OPFAIL. Thus /(foo){1,0}/ is treated
|
||||
the same as /(*FAIL)(foo)/ this is important in patterns like /(foo){1,0}|(?1)/
|
||||
where the (?1) needs to be able to recurse into the (foo) even though the
|
||||
(foo){1,0} can never match. It also resolves various issues (SEGVs) with patterns
|
||||
like /((?1)){1,0}/.
|
||||
|
||||
This patch would have been easier if S_reginsert() documented that it is
|
||||
the callers responsibility to properly set up the NEXT_OFF() of the inserted
|
||||
node (if the node has a NEXT_OFF())
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
regcomp.c | 14 +++-----------
|
||||
t/re/pat_rt_report.t | 11 ++++++++++-
|
||||
2 files changed, 13 insertions(+), 12 deletions(-)
|
||||
|
||||
diff --git a/regcomp.c b/regcomp.c
|
||||
index fcb5147..e9c84b3 100644
|
||||
--- a/regcomp.c
|
||||
+++ b/regcomp.c
|
||||
@@ -10882,19 +10882,11 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
|
||||
nextchar(pRExC_state);
|
||||
if (max < min) { /* If can't match, warn and optimize to fail
|
||||
unconditionally */
|
||||
- if (SIZE_ONLY) {
|
||||
-
|
||||
- /* We can't back off the size because we have to reserve
|
||||
- * enough space for all the things we are about to throw
|
||||
- * away, but we can shrink it by the ammount we are about
|
||||
- * to re-use here */
|
||||
- RExC_size = PREVOPER(RExC_size) - regarglen[(U8)OPFAIL];
|
||||
- }
|
||||
- else {
|
||||
+ if (PASS2) {
|
||||
ckWARNreg(RExC_parse, "Quantifier {n,m} with n > m can't match");
|
||||
- RExC_emit = orig_emit;
|
||||
}
|
||||
- ret = reg_node(pRExC_state, OPFAIL);
|
||||
+ reginsert(pRExC_state, OPFAIL, orig_emit, depth+1);
|
||||
+ NEXT_OFF(orig_emit)= regarglen[OPFAIL] + NODE_STEP_REGNODE;
|
||||
return ret;
|
||||
}
|
||||
else if (min == max && RExC_parse < RExC_end && *RExC_parse == '?')
|
||||
diff --git a/t/re/pat_rt_report.t b/t/re/pat_rt_report.t
|
||||
index ed8fafc..19d41df 100644
|
||||
--- a/t/re/pat_rt_report.t
|
||||
+++ b/t/re/pat_rt_report.t
|
||||
@@ -20,7 +20,7 @@ use warnings;
|
||||
use 5.010;
|
||||
use Config;
|
||||
|
||||
-plan tests => 2532; # Update this when adding/deleting tests.
|
||||
+plan tests => 2534; # Update this when adding/deleting tests.
|
||||
|
||||
run_tests() unless caller;
|
||||
|
||||
@@ -1181,6 +1181,15 @@ EOP
|
||||
ok($s =~ /.\C+/, "CANY pointer wrap");
|
||||
}
|
||||
}
|
||||
+ {
|
||||
+ # rt
|
||||
+ fresh_perl_is(
|
||||
+ '"foo"=~/((?1)){8,0}/; print "ok"',
|
||||
+ "ok", {}, 'RT #130561 - allowing impossible quantifier should not cause SEGVs');
|
||||
+ my $s= "foo";
|
||||
+ ok($s=~/(foo){1,0}|(?1)/,
|
||||
+ "RT #130561 - allowing impossible quantifier should not break recursion");
|
||||
+ }
|
||||
} # End of sub run_tests
|
||||
|
||||
1;
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,79 @@
|
|||
From e70566d418a424aef71fa277a3c93240659790af Mon Sep 17 00:00:00 2001
|
||||
From: Zefram <zefram@fysh.org>
|
||||
Date: Sun, 22 Jan 2017 07:26:34 +0000
|
||||
Subject: [PATCH] fix special-case recreation of *::
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Ported to 5.22.3:
|
||||
|
||||
commit 120921acd4cf27bb932a725a8cf5c957652b22eb
|
||||
Author: Zefram <zefram@fysh.org>
|
||||
Date: Sun Jan 22 07:26:34 2017 +0000
|
||||
|
||||
fix special-case recreation of *::
|
||||
|
||||
If *:: is called for then as a special case it is looked up as
|
||||
$::{"main::"}. If $::{"main::"} has been deleted, then that hash entry
|
||||
is recreated. But formerly it was only recreated as an undef scalar,
|
||||
which broke things relying on glob lookup returning a glob. Now in
|
||||
that special case the recreated hash entry is initialised as a glob,
|
||||
and populated with the customary recursive reference to the main stash.
|
||||
Fixes [perl #129869].
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
gv.c | 11 +++++++++--
|
||||
t/op/stash.t | 9 ++++++++-
|
||||
2 files changed, 17 insertions(+), 3 deletions(-)
|
||||
|
||||
diff --git a/gv.c b/gv.c
|
||||
index 47a5407..ba7516b 100644
|
||||
--- a/gv.c
|
||||
+++ b/gv.c
|
||||
@@ -1637,8 +1637,15 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
|
||||
name_cursor++;
|
||||
*name = name_cursor+1;
|
||||
if (*name == name_end) {
|
||||
- if (!*gv)
|
||||
- *gv = MUTABLE_GV(*hv_fetchs(PL_defstash, "main::", TRUE));
|
||||
+ if (!*gv) {
|
||||
+ *gv = MUTABLE_GV(*hv_fetchs(PL_defstash, "main::", TRUE));
|
||||
+ if (SvTYPE(*gv) != SVt_PVGV) {
|
||||
+ gv_init_pvn(*gv, PL_defstash, "main::", 6,
|
||||
+ GV_ADDMULTI);
|
||||
+ GvHV(*gv) =
|
||||
+ MUTABLE_HV(SvREFCNT_inc_simple(PL_defstash));
|
||||
+ }
|
||||
+ }
|
||||
return TRUE;
|
||||
}
|
||||
}
|
||||
diff --git a/t/op/stash.t b/t/op/stash.t
|
||||
index af218ad..0433c9d 100644
|
||||
--- a/t/op/stash.t
|
||||
+++ b/t/op/stash.t
|
||||
@@ -7,7 +7,7 @@ BEGIN {
|
||||
|
||||
BEGIN { require "./test.pl"; }
|
||||
|
||||
-plan( tests => 51 );
|
||||
+plan( tests => 52 );
|
||||
|
||||
# Used to segfault (bug #15479)
|
||||
fresh_perl_like(
|
||||
@@ -334,3 +334,10 @@ is runperl(
|
||||
),
|
||||
"ok\n",
|
||||
'[perl #123847] no crash from *foo::=*bar::=*glob_with_hash';
|
||||
+
|
||||
+is runperl(
|
||||
+ prog => '%:: = (); print *{q|::|}, qq|\n|',
|
||||
+ stderr => 1,
|
||||
+ ),
|
||||
+ "*main::main::\n",
|
||||
+ "[perl #129869] lookup %:: by name after clearing %::";
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,46 @@
|
|||
From abcd833284abc4feae9dae25a3a28134db1b42fa Mon Sep 17 00:00:00 2001
|
||||
From: Yves Orton <demerphq@gmail.com>
|
||||
Date: Fri, 27 Jan 2017 16:57:40 +0100
|
||||
Subject: [PATCH] only mess with NEXT_OFF() when we are in PASS2
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Ported to 5.22.3:
|
||||
|
||||
commit bb78386f13c18a1a7dae932b9b36e977056b13c7
|
||||
Author: Yves Orton <demerphq@gmail.com>
|
||||
Date: Fri Jan 27 16:57:40 2017 +0100
|
||||
|
||||
only mess with NEXT_OFF() when we are in PASS2
|
||||
|
||||
In 31fc93954d1f379c7a49889d91436ce99818e1f6 I added code that would modify
|
||||
NEXT_OFF() when we were not in PASS2, when we should not do so. Strangly this
|
||||
did not segfault when I tested, but this fix is required.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
regcomp.c | 4 ++--
|
||||
1 file changed, 2 insertions(+), 2 deletions(-)
|
||||
|
||||
diff --git a/regcomp.c b/regcomp.c
|
||||
index e9c84b3..50081aa 100644
|
||||
--- a/regcomp.c
|
||||
+++ b/regcomp.c
|
||||
@@ -10882,11 +10882,11 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
|
||||
nextchar(pRExC_state);
|
||||
if (max < min) { /* If can't match, warn and optimize to fail
|
||||
unconditionally */
|
||||
+ reginsert(pRExC_state, OPFAIL, orig_emit, depth+1);
|
||||
if (PASS2) {
|
||||
ckWARNreg(RExC_parse, "Quantifier {n,m} with n > m can't match");
|
||||
+ NEXT_OFF(orig_emit)= regarglen[OPFAIL] + NODE_STEP_REGNODE;
|
||||
}
|
||||
- reginsert(pRExC_state, OPFAIL, orig_emit, depth+1);
|
||||
- NEXT_OFF(orig_emit)= regarglen[OPFAIL] + NODE_STEP_REGNODE;
|
||||
return ret;
|
||||
}
|
||||
else if (min == max && RExC_parse < RExC_end && *RExC_parse == '?')
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,70 @@
|
|||
From 34fd995c20ab8049eadd63b0bfaca732e4cdb4bd Mon Sep 17 00:00:00 2001
|
||||
From: Tony Cook <tony@develop-help.com>
|
||||
Date: Tue, 24 Jan 2017 11:14:28 +1100
|
||||
Subject: [PATCH] (perl #129274) avoid treating the # in $# as a comment intro
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Petr Písař: Ported to 5.22.3:
|
||||
|
||||
commit 71776ae4fad9a7659deefe0c2376d45b873ffd6a
|
||||
Author: Tony Cook <tony@develop-help.com>
|
||||
Date: Tue Jan 24 11:14:28 2017 +1100
|
||||
|
||||
(perl #129274) avoid treating the # in $# as a comment intro
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
t/op/lex.t | 15 ++++++++++++++-
|
||||
toke.c | 4 +++-
|
||||
2 files changed, 17 insertions(+), 2 deletions(-)
|
||||
|
||||
diff --git a/t/op/lex.t b/t/op/lex.t
|
||||
index a58beb5..2f29e85 100644
|
||||
--- a/t/op/lex.t
|
||||
+++ b/t/op/lex.t
|
||||
@@ -7,7 +7,7 @@ use warnings;
|
||||
|
||||
BEGIN { chdir 't' if -d 't'; require './test.pl'; }
|
||||
|
||||
-plan(tests => 26);
|
||||
+plan(tests => 27);
|
||||
|
||||
{
|
||||
no warnings 'deprecated';
|
||||
@@ -216,3 +216,16 @@ fresh_perl_like(
|
||||
{},
|
||||
'[perl #129336] - #!perl -i argument handling'
|
||||
);
|
||||
+
|
||||
+# probably only failed under ASAN
|
||||
+fresh_perl_is(
|
||||
+ "stat\tt\$#0",
|
||||
+ <<'EOM',
|
||||
+$# is no longer supported at - line 1.
|
||||
+Number found where operator expected at - line 1, near "$#0"
|
||||
+ (Missing operator before 0?)
|
||||
+Can't call method "t" on an undefined value at - line 1.
|
||||
+EOM
|
||||
+ {},
|
||||
+ "[perl #129273] heap use after free or overflow"
|
||||
+);
|
||||
diff --git a/toke.c b/toke.c
|
||||
index c8c14d5..999eb2c 100644
|
||||
--- a/toke.c
|
||||
+++ b/toke.c
|
||||
@@ -3895,7 +3895,9 @@ S_intuit_method(pTHX_ char *start, SV *ioname, CV *cv)
|
||||
if (cv || PL_last_lop_op == OP_PRINT || PL_last_lop_op == OP_SAY ||
|
||||
isUPPER(*PL_tokenbuf))
|
||||
return 0;
|
||||
- s = skipspace(s);
|
||||
+ /* this could be $# */
|
||||
+ if (isSPACE(*s))
|
||||
+ s = skipspace(s);
|
||||
PL_bufptr = start;
|
||||
PL_expect = XREF;
|
||||
return *s == '(' ? FUNCMETH : METHOD;
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,49 @@
|
|||
From c1423633ac24ca51dd0fb0b51f03221816245f74 Mon Sep 17 00:00:00 2001
|
||||
From: Tony Cook <tony@develop-help.com>
|
||||
Date: Mon, 10 Oct 2016 10:46:46 +1100
|
||||
Subject: [PATCH] (perl #129281) test for buffer overflow issue
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Ported to 5.22.3:
|
||||
|
||||
commit d2ba660af00f1bf2e7012741615eff7c19f29707
|
||||
Author: Tony Cook <tony@develop-help.com>
|
||||
Date: Mon Oct 10 10:46:46 2016 +1100
|
||||
|
||||
(perl #129281) test for buffer overflow issue
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
t/re/pat.t | 7 ++++++-
|
||||
1 file changed, 6 insertions(+), 1 deletion(-)
|
||||
|
||||
diff --git a/t/re/pat.t b/t/re/pat.t
|
||||
index b274100..f305320 100644
|
||||
--- a/t/re/pat.t
|
||||
+++ b/t/re/pat.t
|
||||
@@ -23,7 +23,7 @@ BEGIN {
|
||||
skip_all_without_unicode_tables();
|
||||
}
|
||||
|
||||
-plan tests => 778; # Update this when adding/deleting tests.
|
||||
+plan tests => 779; # Update this when adding/deleting tests.
|
||||
|
||||
run_tests() unless caller;
|
||||
|
||||
@@ -1729,6 +1729,11 @@ EOP
|
||||
}msx, { stderr => 1 }, "Offsets in debug output are not negative");
|
||||
}
|
||||
}
|
||||
+ {
|
||||
+ # [perl #129281] buffer write overflow, detected by ASAN, valgrind
|
||||
+ local $::TODO = "whilem_c bumped too much";
|
||||
+ fresh_perl_is('/0(?0)|^*0(?0)|^*(^*())0|/', '', {}, "don't bump whilem_c too much");
|
||||
+ }
|
||||
} # End of sub run_tests
|
||||
|
||||
1;
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,72 @@
|
|||
From be269dd17b2c617ae66d9bf8e185fa2cc8ac9407 Mon Sep 17 00:00:00 2001
|
||||
From: Father Chrysostomos <sprout@cpan.org>
|
||||
Date: Sun, 18 Sep 2016 20:17:08 -0700
|
||||
Subject: [PATCH] Make UTF8 & append null
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Petr Písař: Ported to 5.22.3:
|
||||
|
||||
commit b43665fffa48dd179eba1b5616d4ca35b4def876
|
||||
Author: Father Chrysostomos <sprout@cpan.org>
|
||||
Date: Sun Sep 18 20:17:08 2016 -0700
|
||||
|
||||
[perl #129287] Make UTF8 & append null
|
||||
|
||||
The & and &. operators were not appending a null byte to the string
|
||||
in utf8 mode.
|
||||
|
||||
(The internal function that they use is the same. I used &. in the
|
||||
test just because its intent is clearer.)
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
doop.c | 1 +
|
||||
t/op/bop.t | 14 +++++++++++++-
|
||||
2 files changed, 14 insertions(+), 1 deletion(-)
|
||||
|
||||
diff --git a/doop.c b/doop.c
|
||||
index c6ee847..ca122b4 100644
|
||||
--- a/doop.c
|
||||
+++ b/doop.c
|
||||
@@ -1086,6 +1086,7 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
|
||||
if (sv == left || sv == right)
|
||||
(void)sv_usepvn(sv, dcorig, needlen);
|
||||
SvCUR_set(sv, dc - dcorig);
|
||||
+ *SvEND(sv) = 0;
|
||||
break;
|
||||
case OP_BIT_XOR:
|
||||
while (lulen && rulen) {
|
||||
diff --git a/t/op/bop.t b/t/op/bop.t
|
||||
index 09f2be9..0de7f0b 100644
|
||||
--- a/t/op/bop.t
|
||||
+++ b/t/op/bop.t
|
||||
@@ -15,7 +15,7 @@ BEGIN {
|
||||
# If you find tests are failing, please try adding names to tests to track
|
||||
# down where the failure is, and supply your new names as a patch.
|
||||
# (Just-in-time test naming)
|
||||
-plan tests => 194 + (10*13*2) + 5;
|
||||
+plan tests => 194 + (10*13*2) + 6;
|
||||
|
||||
# numerics
|
||||
ok ((0xdead & 0xbeef) == 0x9ead);
|
||||
@@ -620,3 +620,15 @@ $^A .= new version ~$_ for eval sprintf('"\\x%02x"', 0xff - ord("1")),
|
||||
$::IS_EBCDIC ? v13 : v205, # 255 - ord('2')
|
||||
eval sprintf('"\\x%02x"', 0xff - ord("3"));
|
||||
is $^A, "123", '~v0 clears vstring magic on retval';
|
||||
+
|
||||
+# [perl #129287] UTF8 & was not providing a trailing null byte.
|
||||
+# This test is a bit convoluted, as we want to make sure that the string
|
||||
+# allocated for &’s target contains memory initialised to something other
|
||||
+# than a null byte. Uninitialised memory does not make for a reliable
|
||||
+# test. So we do &. on a longer non-utf8 string first.
|
||||
+for (["aaa","aaa"],[substr ("a\x{100}",0,1), "a"]) {
|
||||
+ use feature "bitwise";
|
||||
+ no warnings "experimental::bitwise", "pack";
|
||||
+ $byte = substr unpack("P2", pack "P", $$_[0] &. $$_[1]), -1;
|
||||
+}
|
||||
+is $byte, "\0", "utf8 &. appends null byte";
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,104 @@
|
|||
From ee45d0c2ef62617f75c7f99aaaa44ab1225864af Mon Sep 17 00:00:00 2001
|
||||
From: Tony Cook <tony@develop-help.com>
|
||||
Date: Mon, 20 Feb 2017 11:02:21 +1100
|
||||
Subject: [PATCH] (perl #129340) copy the source when inside the dest in
|
||||
sv_insert_flags()
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Ported to 5.22.3:
|
||||
|
||||
commit e7a8a8aac45d42d72d1586227ca51771f193f5dc
|
||||
Author: Tony Cook <tony@develop-help.com>
|
||||
Date: Mon Feb 20 11:02:21 2017 +1100
|
||||
|
||||
(perl #129340) copy the source when inside the dest in sv_insert_flags()
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
embed.fnc | 2 +-
|
||||
proto.h | 2 +-
|
||||
sv.c | 12 +++++++++++-
|
||||
t/op/substr.t | 5 ++++-
|
||||
4 files changed, 17 insertions(+), 4 deletions(-)
|
||||
|
||||
diff --git a/embed.fnc b/embed.fnc
|
||||
index b26ba18..3dbf9e8 100644
|
||||
--- a/embed.fnc
|
||||
+++ b/embed.fnc
|
||||
@@ -1442,7 +1442,7 @@ Amdb |void |sv_insert |NN SV *const bigstr|const STRLEN offset \
|
||||
|const STRLEN len|NN const char *const little \
|
||||
|const STRLEN littlelen
|
||||
Apd |void |sv_insert_flags|NN SV *const bigstr|const STRLEN offset|const STRLEN len \
|
||||
- |NN const char *const little|const STRLEN littlelen|const U32 flags
|
||||
+ |NN const char *little|const STRLEN littlelen|const U32 flags
|
||||
Apd |int |sv_isa |NULLOK SV* sv|NN const char *const name
|
||||
Apd |int |sv_isobject |NULLOK SV* sv
|
||||
Apd |STRLEN |sv_len |NULLOK SV *const sv
|
||||
diff --git a/proto.h b/proto.h
|
||||
index ab78202..f82c62e 100644
|
||||
--- a/proto.h
|
||||
+++ b/proto.h
|
||||
@@ -4373,7 +4373,7 @@ PERL_CALLCONV void Perl_sv_inc_nomg(pTHX_ SV *const sv);
|
||||
#define PERL_ARGS_ASSERT_SV_INSERT \
|
||||
assert(bigstr); assert(little)
|
||||
|
||||
-PERL_CALLCONV void Perl_sv_insert_flags(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN len, const char *const little, const STRLEN littlelen, const U32 flags)
|
||||
+PERL_CALLCONV void Perl_sv_insert_flags(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN len, const char *little, const STRLEN littlelen, const U32 flags);
|
||||
__attribute__nonnull__(pTHX_1)
|
||||
__attribute__nonnull__(pTHX_4);
|
||||
#define PERL_ARGS_ASSERT_SV_INSERT_FLAGS \
|
||||
diff --git a/sv.c b/sv.c
|
||||
index 263d27b..5329f9e 100644
|
||||
--- a/sv.c
|
||||
+++ b/sv.c
|
||||
@@ -6301,7 +6301,7 @@ C<SvPV_force_flags> that applies to C<bigstr>.
|
||||
*/
|
||||
|
||||
void
|
||||
-Perl_sv_insert_flags(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN len, const char *const little, const STRLEN littlelen, const U32 flags)
|
||||
+Perl_sv_insert_flags(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN len, const char *little, const STRLEN littlelen, const U32 flags)
|
||||
{
|
||||
char *big;
|
||||
char *mid;
|
||||
@@ -6314,6 +6314,16 @@ Perl_sv_insert_flags(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN l
|
||||
|
||||
SvPV_force_flags(bigstr, curlen, flags);
|
||||
(void)SvPOK_only_UTF8(bigstr);
|
||||
+
|
||||
+ if (little >= SvPVX(bigstr) &&
|
||||
+ little < SvPVX(bigstr) + (SvLEN(bigstr) ? SvLEN(bigstr) : SvCUR(bigstr))) {
|
||||
+ /* little is a pointer to within bigstr, since we can reallocate bigstr,
|
||||
+ or little...little+littlelen might overlap offset...offset+len we make a copy
|
||||
+ */
|
||||
+ little = savepvn(little, littlelen);
|
||||
+ SAVEFREEPV(little);
|
||||
+ }
|
||||
+
|
||||
if (offset + len > curlen) {
|
||||
SvGROW(bigstr, offset+len+1);
|
||||
Zero(SvPVX(bigstr)+curlen, offset+len-curlen, char);
|
||||
diff --git a/t/op/substr.t b/t/op/substr.t
|
||||
index 71e9e89..7d8f3e0 100644
|
||||
--- a/t/op/substr.t
|
||||
+++ b/t/op/substr.t
|
||||
@@ -22,7 +22,7 @@ $SIG{__WARN__} = sub {
|
||||
}
|
||||
};
|
||||
|
||||
-plan(388);
|
||||
+plan(389);
|
||||
|
||||
run_tests() unless caller;
|
||||
|
||||
@@ -868,3 +868,6 @@ is($destroyed, 1, 'Timely scalar destruction with lvalue substr');
|
||||
|
||||
is($result_3363, "best", "ref-to-substr retains lvalue-ness under recursion [perl #3363]");
|
||||
}
|
||||
+
|
||||
+# failed with ASAN
|
||||
+fresh_perl_is('$0 = "/usr/bin/perl"; substr($0, 0, 0, $0)', '', {}, "(perl #129340) substr() with source in target");
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,106 @@
|
|||
From 19b3bde41dc56af0d042139b1f3261a26bb3c339 Mon Sep 17 00:00:00 2001
|
||||
From: Hugo van der Sanden <hv@crypt.org>
|
||||
Date: Wed, 5 Oct 2016 12:56:05 +0100
|
||||
Subject: [PATCH] don't read past start of string for unmatched backref
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Ported to 5.22.3:
|
||||
|
||||
commit 2dfc11ec3af312f4fa3eb244077c79dbb5fc2d85
|
||||
Author: Hugo van der Sanden <hv@crypt.org>
|
||||
Date: Wed Oct 5 12:56:05 2016 +0100
|
||||
|
||||
[perl #129377] don't read past start of string for unmatched backref
|
||||
|
||||
We can have (start, end) == (0, -1) for an unmatched backref, we must
|
||||
check for that.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
regexec.c | 10 ++++++----
|
||||
t/re/pat.t | 16 +++++++++++++++-
|
||||
2 files changed, 21 insertions(+), 5 deletions(-)
|
||||
|
||||
diff --git a/regexec.c b/regexec.c
|
||||
index ff1d5d8..b01368e 100644
|
||||
--- a/regexec.c
|
||||
+++ b/regexec.c
|
||||
@@ -4830,6 +4830,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
|
||||
regnode *next;
|
||||
U32 n = 0; /* general value; init to avoid compiler warning */
|
||||
SSize_t ln = 0; /* len or last; init to avoid compiler warning */
|
||||
+ SSize_t endref = 0; /* offset of end of backref when ln is start */
|
||||
char *locinput = startpos;
|
||||
char *pushinput; /* where to continue after a PUSH */
|
||||
I32 nextchr; /* is always set to UCHARAT(locinput) */
|
||||
@@ -6090,10 +6091,11 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
|
||||
|
||||
do_nref_ref_common:
|
||||
ln = rex->offs[n].start;
|
||||
+ endref = rex->offs[n].end;
|
||||
reginfo->poscache_iter = reginfo->poscache_maxiter; /* Void cache */
|
||||
- if (rex->lastparen < n || ln == -1)
|
||||
+ if (rex->lastparen < n || ln == -1 || endref == -1)
|
||||
sayNO; /* Do not match unless seen CLOSEn. */
|
||||
- if (ln == rex->offs[n].end)
|
||||
+ if (ln == endref)
|
||||
break;
|
||||
|
||||
s = reginfo->strbeg + ln;
|
||||
@@ -6107,7 +6109,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
|
||||
* not going off the end given by reginfo->strend, and
|
||||
* returns in <limit> upon success, how much of the
|
||||
* current input was matched */
|
||||
- if (! foldEQ_utf8_flags(s, NULL, rex->offs[n].end - ln, utf8_target,
|
||||
+ if (! foldEQ_utf8_flags(s, NULL, endref - ln, utf8_target,
|
||||
locinput, &limit, 0, utf8_target, utf8_fold_flags))
|
||||
{
|
||||
sayNO;
|
||||
@@ -6122,7 +6124,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
|
||||
(type == REF ||
|
||||
UCHARAT(s) != fold_array[nextchr]))
|
||||
sayNO;
|
||||
- ln = rex->offs[n].end - ln;
|
||||
+ ln = endref - ln;
|
||||
if (locinput + ln > reginfo->strend)
|
||||
sayNO;
|
||||
if (ln > 1 && (type == REF
|
||||
diff --git a/t/re/pat.t b/t/re/pat.t
|
||||
index 2f18aa8..b274100 100644
|
||||
--- a/t/re/pat.t
|
||||
+++ b/t/re/pat.t
|
||||
@@ -23,7 +23,7 @@ BEGIN {
|
||||
skip_all_without_unicode_tables();
|
||||
}
|
||||
|
||||
-plan tests => 777; # Update this when adding/deleting tests.
|
||||
+plan tests => 778; # Update this when adding/deleting tests.
|
||||
|
||||
run_tests() unless caller;
|
||||
|
||||
@@ -1715,6 +1715,20 @@ EOP
|
||||
utf8::upgrade($str);
|
||||
ok( $str =~ m{^(a|a\x{e4})$}, "fix [perl #129950] - utf8 case" );
|
||||
}
|
||||
+ {
|
||||
+ # [perl #129377] backref to an unmatched capture should not cause
|
||||
+ # reading before start of string.
|
||||
+ SKIP: {
|
||||
+ skip "no re-debug under miniperl" if is_miniperl;
|
||||
+ my $prog = <<'EOP';
|
||||
+use re qw(Debug EXECUTE);
|
||||
+"x" =~ m{ () y | () \1 }x;
|
||||
+EOP
|
||||
+ fresh_perl_like($prog, qr{
|
||||
+ \A (?! .* ^ \s+ - )
|
||||
+ }msx, { stderr => 1 }, "Offsets in debug output are not negative");
|
||||
+ }
|
||||
+ }
|
||||
} # End of sub run_tests
|
||||
|
||||
1;
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,50 @@
|
|||
From 976900025e7327873d86550633c9c9a9200fa73d Mon Sep 17 00:00:00 2001
|
||||
From: Hugo van der Sanden <hv@crypt.org>
|
||||
Date: Sun, 19 Feb 2017 10:46:09 +0000
|
||||
Subject: [PATCH] update pointer into PL_linestr after lookahead
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Ported to: 5.22.3:
|
||||
|
||||
commit 90f2cc9a600117a49f8ee3e30cc681f062350c24
|
||||
Author: Hugo van der Sanden <hv@crypt.org>
|
||||
Date: Sun Feb 19 10:46:09 2017 +0000
|
||||
|
||||
[perl #130814] update pointer into PL_linestr after lookahead
|
||||
|
||||
Looking ahead for the "Missing $ on loop variable" diagnostic can reallocate
|
||||
PL_linestr, invalidating our pointer. Save the offset so we can update it
|
||||
in that case.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
toke.c | 4 ++++
|
||||
1 file changed, 4 insertions(+)
|
||||
|
||||
diff --git a/toke.c b/toke.c
|
||||
index 999eb2c..da3ff73 100644
|
||||
--- a/toke.c
|
||||
+++ b/toke.c
|
||||
@@ -7318,6 +7318,7 @@ Perl_yylex(pTHX)
|
||||
s = skipspace(s);
|
||||
if (PL_expect == XSTATE && isIDFIRST_lazy_if(s,UTF)) {
|
||||
char *p = s;
|
||||
+ SSize_t s_off = s - SvPVX(PL_linestr);
|
||||
|
||||
if ((PL_bufend - p) >= 3 &&
|
||||
strnEQ(p, "my", 2) && isSPACE(*(p + 2)))
|
||||
@@ -7333,6 +7334,9 @@ Perl_yylex(pTHX)
|
||||
}
|
||||
if (*p != '$')
|
||||
Perl_croak(aTHX_ "Missing $ on loop variable");
|
||||
+
|
||||
+ /* The buffer may have been reallocated, update s */
|
||||
+ s = SvPVX(PL_linestr) + s_off;
|
||||
}
|
||||
OPERATOR(FOR);
|
||||
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,81 @@
|
|||
From 9c27a78d1d66d355c5d7d1502d057667bb66deb3 Mon Sep 17 00:00:00 2001
|
||||
From: Tony Cook <tony@develop-help.com>
|
||||
Date: Tue, 21 Feb 2017 16:38:36 +1100
|
||||
Subject: [PATCH] (perl #130822) fix an AV leak in Perl_reg_named_buff_fetch
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Ported to 5.22.3:
|
||||
|
||||
commit 853eb961c1a3b014b5a9510740abc15ccd4383b6
|
||||
Author: Tony Cook <tony@develop-help.com>
|
||||
Date: Tue Feb 21 16:38:36 2017 +1100
|
||||
|
||||
(perl #130822) fix an AV leak in Perl_reg_named_buff_fetch
|
||||
|
||||
Originally noted as a scoping issue by Andy Lester.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
regcomp.c | 5 +----
|
||||
t/op/svleak.t | 12 +++++++++++-
|
||||
2 files changed, 12 insertions(+), 5 deletions(-)
|
||||
|
||||
diff --git a/regcomp.c b/regcomp.c
|
||||
index bf4011e..777b5cc 100644
|
||||
--- a/regcomp.c
|
||||
+++ b/regcomp.c
|
||||
@@ -7478,21 +7478,18 @@ SV*
|
||||
Perl_reg_named_buff_fetch(pTHX_ REGEXP * const r, SV * const namesv,
|
||||
const U32 flags)
|
||||
{
|
||||
- AV *retarray = NULL;
|
||||
SV *ret;
|
||||
struct regexp *const rx = ReANY(r);
|
||||
|
||||
PERL_ARGS_ASSERT_REG_NAMED_BUFF_FETCH;
|
||||
|
||||
- if (flags & RXapif_ALL)
|
||||
- retarray=newAV();
|
||||
-
|
||||
if (rx && RXp_PAREN_NAMES(rx)) {
|
||||
HE *he_str = hv_fetch_ent( RXp_PAREN_NAMES(rx), namesv, 0, 0 );
|
||||
if (he_str) {
|
||||
IV i;
|
||||
SV* sv_dat=HeVAL(he_str);
|
||||
I32 *nums=(I32*)SvPVX(sv_dat);
|
||||
+ AV * const retarray = (flags & RXapif_ALL) ? newAV() : NULL;
|
||||
for ( i=0; i<SvIVX(sv_dat); i++ ) {
|
||||
if ((I32)(rx->nparens) >= nums[i]
|
||||
&& rx->offs[nums[i]].start != -1
|
||||
diff --git a/t/op/svleak.t b/t/op/svleak.t
|
||||
index 076f2bf..2842aa7 100644
|
||||
--- a/t/op/svleak.t
|
||||
+++ b/t/op/svleak.t
|
||||
@@ -15,7 +15,7 @@ BEGIN {
|
||||
|
||||
use Config;
|
||||
|
||||
-plan tests => 129;
|
||||
+plan tests => 130;
|
||||
|
||||
# run some code N times. If the number of SVs at the end of loop N is
|
||||
# greater than (N-1)*delta at the end of loop 1, we've got a leak
|
||||
@@ -493,3 +493,13 @@ $x = $mdr::a[0]{foo}{$mdr::k}{$mdr::i};
|
||||
$x = $mdr::h[0]{foo}{$mdr::k}{$mdr::i};
|
||||
$x = $mdr::r->[0]{foo}{$mdr::k}{$mdr::i};
|
||||
EOF
|
||||
+
|
||||
+{
|
||||
+ # Perl_reg_named_buff_fetch() leaks an AV when called with an RE
|
||||
+ # with no named captures
|
||||
+ sub named {
|
||||
+ "x" =~ /x/;
|
||||
+ re::regname("foo", 1);
|
||||
+ }
|
||||
+ ::leak(2, 0, \&named, "Perl_reg_named_buff_fetch() on no-name RE");
|
||||
+}
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,295 @@
|
|||
From 2501db6be20dce5e31432f8aecdff262e377390b Mon Sep 17 00:00:00 2001
|
||||
From: Tony Cook <tony@develop-help.com>
|
||||
Date: Thu, 1 Jun 2017 15:11:27 +1000
|
||||
Subject: [PATCH] improve duplication of :via handles
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Ported to 5.22.3:
|
||||
|
||||
commit 99b847695211f825df6299aa9da91f9494f741e2
|
||||
Author: Tony Cook <tony@develop-help.com>
|
||||
Date: Thu Jun 1 15:11:27 2017 +1000
|
||||
|
||||
[perl #131221] improve duplication of :via handles
|
||||
|
||||
Previously duplication (as with open ... ">&...") would fail
|
||||
unless the user supplied a GETARG, which wasn't documented, and
|
||||
resulted in an attempt to free and unreferened scalar if supplied.
|
||||
|
||||
Cloning on thread creation was simply broken.
|
||||
|
||||
We now handle GETARG correctly, and provide a useful default if it
|
||||
returns nothing.
|
||||
|
||||
Cloning on thread creation now duplicates the appropriate parts of the
|
||||
parent thread's handle.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
MANIFEST | 1 +
|
||||
ext/PerlIO-via/t/thread.t | 73 +++++++++++++++++++++++++++++++++++++++++++++++
|
||||
ext/PerlIO-via/t/via.t | 56 +++++++++++++++++++++++++++++++++++-
|
||||
ext/PerlIO-via/via.xs | 55 +++++++++++++++++++++++++++++++----
|
||||
4 files changed, 178 insertions(+), 7 deletions(-)
|
||||
create mode 100644 ext/PerlIO-via/t/thread.t
|
||||
|
||||
diff --git a/MANIFEST b/MANIFEST
|
||||
index c326d91..b2b78b0 100644
|
||||
--- a/MANIFEST
|
||||
+++ b/MANIFEST
|
||||
@@ -3694,6 +3694,7 @@ ext/PerlIO-scalar/scalar.xs PerlIO layer for scalars
|
||||
ext/PerlIO-scalar/t/scalar.t See if PerlIO::scalar works
|
||||
ext/PerlIO-scalar/t/scalar_ungetc.t Tests for PerlIO layer for scalars
|
||||
ext/PerlIO-via/hints/aix.pl Hint for PerlIO::via for named architecture
|
||||
+ext/PerlIO-via/t/thread.t See if PerlIO::via works with threads
|
||||
ext/PerlIO-via/t/via.t See if PerlIO::via works
|
||||
ext/PerlIO-via/via.pm PerlIO layer for layers in perl
|
||||
ext/PerlIO-via/via.xs PerlIO layer for layers in perl
|
||||
diff --git a/ext/PerlIO-via/t/thread.t b/ext/PerlIO-via/t/thread.t
|
||||
new file mode 100644
|
||||
index 0000000..e4358f9
|
||||
--- /dev/null
|
||||
+++ b/ext/PerlIO-via/t/thread.t
|
||||
@@ -0,0 +1,73 @@
|
||||
+#!perl
|
||||
+BEGIN {
|
||||
+ unless (find PerlIO::Layer 'perlio') {
|
||||
+ print "1..0 # Skip: not perlio\n";
|
||||
+ exit 0;
|
||||
+ }
|
||||
+ require Config;
|
||||
+ unless ($Config::Config{'usethreads'}) {
|
||||
+ print "1..0 # Skip -- need threads for this test\n";
|
||||
+ exit 0;
|
||||
+ }
|
||||
+ if (($Config::Config{'extensions'} !~ m!\bPerlIO/via\b!) ){
|
||||
+ print "1..0 # Skip -- Perl configured without PerlIO::via module\n";
|
||||
+ exit 0;
|
||||
+ }
|
||||
+}
|
||||
+
|
||||
+use strict;
|
||||
+use warnings;
|
||||
+use threads;
|
||||
+
|
||||
+my $tmp = "via$$";
|
||||
+
|
||||
+END {
|
||||
+ 1 while unlink $tmp;
|
||||
+}
|
||||
+
|
||||
+use Test::More tests => 2;
|
||||
+
|
||||
+our $push_count = 0;
|
||||
+
|
||||
+{
|
||||
+ open my $fh, ">:via(Test1)", $tmp
|
||||
+ or die "Cannot open $tmp: $!";
|
||||
+ $fh->autoflush;
|
||||
+
|
||||
+ print $fh "AXAX";
|
||||
+
|
||||
+ # previously this would crash
|
||||
+ threads->create(
|
||||
+ sub {
|
||||
+ print $fh "XZXZ";
|
||||
+ })->join;
|
||||
+
|
||||
+ print $fh "BXBX";
|
||||
+ close $fh;
|
||||
+
|
||||
+ open my $in, "<", $tmp;
|
||||
+ my $line = <$in>;
|
||||
+ close $in;
|
||||
+
|
||||
+ is($line, "AYAYYZYZBYBY", "check thread data delivered");
|
||||
+
|
||||
+ is($push_count, 1, "PUSHED not called for dup on thread creation");
|
||||
+}
|
||||
+
|
||||
+package PerlIO::via::Test1;
|
||||
+
|
||||
+sub PUSHED {
|
||||
+ my ($class) = @_;
|
||||
+ ++$main::push_count;
|
||||
+ bless {}, $class;
|
||||
+}
|
||||
+
|
||||
+sub WRITE {
|
||||
+ my ($self, $data, $fh) = @_;
|
||||
+ $data =~ tr/X/Y/;
|
||||
+ $fh->autoflush;
|
||||
+ print $fh $data;
|
||||
+ return length $data;
|
||||
+}
|
||||
+
|
||||
+
|
||||
diff --git a/ext/PerlIO-via/t/via.t b/ext/PerlIO-via/t/via.t
|
||||
index 0619592..c390172 100644
|
||||
--- a/ext/PerlIO-via/t/via.t
|
||||
+++ b/ext/PerlIO-via/t/via.t
|
||||
@@ -17,7 +17,7 @@ use warnings;
|
||||
|
||||
my $tmp = "via$$";
|
||||
|
||||
-use Test::More tests => 18;
|
||||
+use Test::More tests => 26;
|
||||
|
||||
my $fh;
|
||||
my $a = join("", map { chr } 0..255) x 10;
|
||||
@@ -84,6 +84,60 @@ is( $obj, 'Foo', 'search for package Foo' );
|
||||
open $fh, '<:via(Bar)', "bar";
|
||||
is( $obj, 'PerlIO::via::Bar', 'search for package PerlIO::via::Bar' );
|
||||
|
||||
+{
|
||||
+ # [perl #131221]
|
||||
+ ok(open(my $fh1, ">", $tmp), "open $tmp");
|
||||
+ ok(binmode($fh1, ":via(XXX)"), "binmode :via(XXX) onto it");
|
||||
+ ok(open(my $fh2, ">&", $fh1), "dup it");
|
||||
+ close $fh1;
|
||||
+ close $fh2;
|
||||
+
|
||||
+ # make sure the old workaround still works
|
||||
+ ok(open($fh1, ">", $tmp), "open $tmp");
|
||||
+ ok(binmode($fh1, ":via(YYY)"), "binmode :via(YYY) onto it");
|
||||
+ ok(open($fh2, ">&", $fh1), "dup it");
|
||||
+ print $fh2 "XZXZ";
|
||||
+ close $fh1;
|
||||
+ close $fh2;
|
||||
+
|
||||
+ ok(open($fh1, "<", $tmp), "open $tmp for check");
|
||||
+ { local $/; $b = <$fh1> }
|
||||
+ close $fh1;
|
||||
+ is($b, "XZXZ", "check result is from non-filtering class");
|
||||
+
|
||||
+ package PerlIO::via::XXX;
|
||||
+
|
||||
+ sub PUSHED {
|
||||
+ my $class = shift;
|
||||
+ bless {}, $class;
|
||||
+ }
|
||||
+
|
||||
+ sub WRITE {
|
||||
+ my ($self, $buffer, $handle) = @_;
|
||||
+
|
||||
+ print $handle $buffer;
|
||||
+ return length($buffer);
|
||||
+ }
|
||||
+ package PerlIO::via::YYY;
|
||||
+
|
||||
+ sub PUSHED {
|
||||
+ my $class = shift;
|
||||
+ bless {}, $class;
|
||||
+ }
|
||||
+
|
||||
+ sub WRITE {
|
||||
+ my ($self, $buffer, $handle) = @_;
|
||||
+
|
||||
+ $buffer =~ tr/X/Y/;
|
||||
+ print $handle $buffer;
|
||||
+ return length($buffer);
|
||||
+ }
|
||||
+
|
||||
+ sub GETARG {
|
||||
+ "XXX";
|
||||
+ }
|
||||
+}
|
||||
+
|
||||
END {
|
||||
1 while unlink $tmp;
|
||||
}
|
||||
diff --git a/ext/PerlIO-via/via.xs b/ext/PerlIO-via/via.xs
|
||||
index d7a037b..e86f655 100644
|
||||
--- a/ext/PerlIO-via/via.xs
|
||||
+++ b/ext/PerlIO-via/via.xs
|
||||
@@ -38,6 +38,8 @@ typedef struct
|
||||
CV *UTF8;
|
||||
} PerlIOVia;
|
||||
|
||||
+static const MGVTBL PerlIOVia_tag = { 0, 0, 0, 0, 0, 0, 0, 0 };
|
||||
+
|
||||
#define MYMethod(x) #x,&s->x
|
||||
|
||||
CV *
|
||||
@@ -131,8 +133,14 @@ PerlIOVia_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
|
||||
PerlIO_funcs * tab)
|
||||
{
|
||||
IV code = PerlIOBase_pushed(aTHX_ f, mode, Nullsv, tab);
|
||||
+
|
||||
+ if (SvTYPE(arg) >= SVt_PVMG
|
||||
+ && mg_findext(arg, PERL_MAGIC_ext, &PerlIOVia_tag)) {
|
||||
+ return code;
|
||||
+ }
|
||||
+
|
||||
if (code == 0) {
|
||||
- PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
|
||||
+ PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
|
||||
if (!arg) {
|
||||
if (ckWARN(WARN_LAYER))
|
||||
Perl_warner(aTHX_ packWARN(WARN_LAYER),
|
||||
@@ -583,20 +591,55 @@ SV *
|
||||
PerlIOVia_getarg(pTHX_ PerlIO * f, CLONE_PARAMS * param, int flags)
|
||||
{
|
||||
PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
|
||||
- PERL_UNUSED_ARG(param);
|
||||
+ SV *arg;
|
||||
PERL_UNUSED_ARG(flags);
|
||||
- return PerlIOVia_method(aTHX_ f, MYMethod(GETARG), G_SCALAR, Nullsv);
|
||||
+
|
||||
+ /* During cloning, return an undef token object so that _pushed() knows
|
||||
+ * that it should not call methods and wait for _dup() to actually dup the
|
||||
+ * object. */
|
||||
+ if (param) {
|
||||
+ SV *sv = newSV(0);
|
||||
+ sv_magicext(sv, NULL, PERL_MAGIC_ext, &PerlIOVia_tag, 0, 0);
|
||||
+ return sv;
|
||||
+ }
|
||||
+
|
||||
+ arg = PerlIOVia_method(aTHX_ f, MYMethod(GETARG), G_SCALAR, Nullsv);
|
||||
+ if (arg) {
|
||||
+ /* arg is a temp, and PerlIOBase_dup() will explicitly free it */
|
||||
+ SvREFCNT_inc(arg);
|
||||
+ }
|
||||
+ else {
|
||||
+ arg = newSVpvn(HvNAME(s->stash), HvNAMELEN(s->stash));
|
||||
+ }
|
||||
+
|
||||
+ return arg;
|
||||
}
|
||||
|
||||
PerlIO *
|
||||
PerlIOVia_dup(pTHX_ PerlIO * f, PerlIO * o, CLONE_PARAMS * param,
|
||||
int flags)
|
||||
{
|
||||
- if ((f = PerlIOBase_dup(aTHX_ f, o, param, flags))) {
|
||||
- /* Most of the fields will lazily set themselves up as needed
|
||||
- stash and obj have been set up by the implied push
|
||||
+ if ((f = PerlIOBase_dup(aTHX_ f, o, param, flags)) && param) {
|
||||
+ /* For a non-interpreter dup stash and obj have been set up
|
||||
+ by the implied push.
|
||||
+
|
||||
+ But if this is a clone for a new interpreter we need to
|
||||
+ translate the objects to their dups.
|
||||
*/
|
||||
+
|
||||
+ PerlIOVia *fs = PerlIOSelf(f, PerlIOVia);
|
||||
+ PerlIOVia *os = PerlIOSelf(o, PerlIOVia);
|
||||
+
|
||||
+ fs->obj = sv_dup_inc(os->obj, param);
|
||||
+ fs->stash = (HV*)sv_dup((SV*)os->stash, param);
|
||||
+ fs->var = sv_dup_inc(os->var, param);
|
||||
+ fs->cnt = os->cnt;
|
||||
+
|
||||
+ /* fh, io, cached CVs left as NULL, PerlIOVia_method()
|
||||
+ will reinitialize them if needed */
|
||||
}
|
||||
+ /* for a non-threaded dup fs->obj and stash should be set by _pushed() */
|
||||
+
|
||||
return f;
|
||||
}
|
||||
|
||||
--
|
||||
2.9.4
|
||||
|
|
@ -0,0 +1,94 @@
|
|||
From 7778ccd83efc90dd4c0635d67184bcf9ace5b4ce Mon Sep 17 00:00:00 2001
|
||||
From: Zefram <zefram@fysh.org>
|
||||
Date: Mon, 23 Jan 2017 02:25:50 +0000
|
||||
Subject: [PATCH] permit goto at top level of multicalled sub
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Petr Písař: Ported to 5.22.3:
|
||||
|
||||
commit 3c157b3cf0631c69ffa5aa2d55b9199bf93b22a9
|
||||
Author: Zefram <zefram@fysh.org>
|
||||
Date: Mon Jan 23 02:25:50 2017 +0000
|
||||
|
||||
permit goto at top level of multicalled sub
|
||||
|
||||
A multicalled sub is reckoned to be a pseudo block, out of which it is
|
||||
not permissible to goto. However, the test for a pseudo block was being
|
||||
applied too early, preventing not just escape from a multicalled sub but
|
||||
also a goto at the top level within the sub. This is a bug similar, but
|
||||
not identical, to [perl #113938]. Now the test is deferred, permitting
|
||||
goto at the sub's top level but still forbidding goto out of it.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
pp_ctl.c | 11 ++++++-----
|
||||
t/op/goto.t | 11 ++++++++++-
|
||||
2 files changed, 16 insertions(+), 6 deletions(-)
|
||||
|
||||
diff --git a/pp_ctl.c b/pp_ctl.c
|
||||
index 74005a6..ad06186 100644
|
||||
--- a/pp_ctl.c
|
||||
+++ b/pp_ctl.c
|
||||
@@ -3023,6 +3023,7 @@ PP(pp_goto)
|
||||
OP *gotoprobe = NULL;
|
||||
bool leaving_eval = FALSE;
|
||||
bool in_block = FALSE;
|
||||
+ bool pseudo_block = FALSE;
|
||||
PERL_CONTEXT *last_eval_cx = NULL;
|
||||
|
||||
/* find label */
|
||||
@@ -3060,11 +3061,9 @@ PP(pp_goto)
|
||||
gotoprobe = PL_main_root;
|
||||
break;
|
||||
case CXt_SUB:
|
||||
- if (CvDEPTH(cx->blk_sub.cv) && !CxMULTICALL(cx)) {
|
||||
- gotoprobe = CvROOT(cx->blk_sub.cv);
|
||||
- break;
|
||||
- }
|
||||
- /* FALLTHROUGH */
|
||||
+ gotoprobe = CvROOT(cx->blk_sub.cv);
|
||||
+ pseudo_block = cBOOL(CxMULTICALL(cx));
|
||||
+ break;
|
||||
case CXt_FORMAT:
|
||||
case CXt_NULL:
|
||||
DIE(aTHX_ "Can't \"goto\" out of a pseudo block");
|
||||
@@ -3093,6 +3092,8 @@ PP(pp_goto)
|
||||
break;
|
||||
}
|
||||
}
|
||||
+ if (pseudo_block)
|
||||
+ DIE(aTHX_ "Can't \"goto\" out of a pseudo block");
|
||||
PL_lastgotoprobe = gotoprobe;
|
||||
}
|
||||
if (!retop)
|
||||
diff --git a/t/op/goto.t b/t/op/goto.t
|
||||
index ca48ac0..ca8fa08 100644
|
||||
--- a/t/op/goto.t
|
||||
+++ b/t/op/goto.t
|
||||
@@ -10,7 +10,7 @@ BEGIN {
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
-plan tests => 94;
|
||||
+plan tests => 95;
|
||||
our $TODO;
|
||||
|
||||
my $deprecated = 0;
|
||||
@@ -702,3 +702,12 @@ sub FETCH { $_[0][0] }
|
||||
tie my $t, "", sub { "cluck up porridge" };
|
||||
is eval { sub { goto $t }->() }//$@, 'cluck up porridge',
|
||||
'tied arg returning sub ref';
|
||||
+
|
||||
+sub revnumcmp ($$) {
|
||||
+ goto FOO;
|
||||
+ die;
|
||||
+ FOO:
|
||||
+ return $_[1] <=> $_[0];
|
||||
+}
|
||||
+is eval { join(":", sort revnumcmp (9,5,1,3,7)) }, "9:7:5:3:1",
|
||||
+ "can goto at top level of multicalled sub";
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,160 @@
|
|||
From 0ee3fa26f660ac426e3e082f77d806c9d1471f93 Mon Sep 17 00:00:00 2001
|
||||
From: Vincent Pit <perl@profvince.com>
|
||||
Date: Fri, 28 Aug 2015 14:17:00 -0300
|
||||
Subject: [PATCH] Properly duplicate PerlIO::encoding objects
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
PerlIO::encoding objects are usually initialized by calling Perl methods,
|
||||
essentially from the pushed() and getarg() callbacks. During cloning, the
|
||||
PerlIO API will by default call these methods to initialize the duplicate
|
||||
struct when the PerlIOBase parent struct is itself duplicated. This does
|
||||
not behave so well because the perl interpreter is not ready to call
|
||||
methods at this point, for the stacks are not set up yet.
|
||||
|
||||
The proper way to duplicate the PerlIO::encoding object is to call sv_dup()
|
||||
on its members from the dup() PerlIO callback. So the only catch is to make
|
||||
the getarg() and pushed() calls implied by the duplication of the underlying
|
||||
PerlIOBase object aware that they are called during cloning, and make them
|
||||
wait that the control flow returns to the dup() callback. Fortunately,
|
||||
getarg() knows since its param argument is then non-null, and its return
|
||||
value is passed immediately to pushed(), so it is enough to tag this
|
||||
returned value with a custom magic so that pushed() can see it is being
|
||||
called during cloning.
|
||||
|
||||
This fixes [RT #31923].
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
MANIFEST | 1 +
|
||||
ext/PerlIO-encoding/encoding.pm | 2 +-
|
||||
ext/PerlIO-encoding/encoding.xs | 25 +++++++++++++++++++++++--
|
||||
ext/PerlIO-encoding/t/threads.t | 35 +++++++++++++++++++++++++++++++++++
|
||||
4 files changed, 60 insertions(+), 3 deletions(-)
|
||||
create mode 100644 ext/PerlIO-encoding/t/threads.t
|
||||
|
||||
diff --git a/MANIFEST b/MANIFEST
|
||||
index f79df00..34c2e24 100644
|
||||
--- a/MANIFEST
|
||||
+++ b/MANIFEST
|
||||
@@ -3753,6 +3753,7 @@ ext/PerlIO-encoding/encoding.xs PerlIO::encoding
|
||||
ext/PerlIO-encoding/t/encoding.t See if PerlIO encoding conversion works
|
||||
ext/PerlIO-encoding/t/fallback.t See if PerlIO fallbacks work
|
||||
ext/PerlIO-encoding/t/nolooping.t Tests for PerlIO::encoding
|
||||
+ext/PerlIO-encoding/t/threads.t Tests PerlIO::encoding and threads
|
||||
ext/PerlIO-mmap/mmap.pm PerlIO layer for memory maps
|
||||
ext/PerlIO-mmap/mmap.xs PerlIO layer for memory maps
|
||||
ext/PerlIO-scalar/scalar.pm PerlIO layer for scalars
|
||||
diff --git a/ext/PerlIO-encoding/encoding.pm b/ext/PerlIO-encoding/encoding.pm
|
||||
index 4cff76d..97f05ec 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.21';
|
||||
+our $VERSION = '0.22';
|
||||
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 03b8850..3575d72 100644
|
||||
--- a/ext/PerlIO-encoding/encoding.xs
|
||||
+++ b/ext/PerlIO-encoding/encoding.xs
|
||||
@@ -49,13 +49,23 @@ typedef struct {
|
||||
|
||||
#define NEEDS_LINES 1
|
||||
|
||||
+static const MGVTBL PerlIOEncode_tag = { 0, 0, 0, 0, 0, 0, 0, 0 };
|
||||
+
|
||||
SV *
|
||||
PerlIOEncode_getarg(pTHX_ PerlIO * f, CLONE_PARAMS * param, int flags)
|
||||
{
|
||||
PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode);
|
||||
- SV *sv = &PL_sv_undef;
|
||||
- PERL_UNUSED_ARG(param);
|
||||
+ SV *sv;
|
||||
PERL_UNUSED_ARG(flags);
|
||||
+ /* During cloning, return an undef token object so that _pushed() knows
|
||||
+ * that it should not call methods and wait for _dup() to actually dup the
|
||||
+ * encoding object. */
|
||||
+ if (param) {
|
||||
+ sv = newSV(0);
|
||||
+ sv_magicext(sv, NULL, PERL_MAGIC_ext, &PerlIOEncode_tag, 0, 0);
|
||||
+ return sv;
|
||||
+ }
|
||||
+ sv = &PL_sv_undef;
|
||||
if (e->enc) {
|
||||
dSP;
|
||||
/* Not 100% sure stack swap is right thing to do during dup ... */
|
||||
@@ -85,6 +95,14 @@ PerlIOEncode_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg, PerlIO_funcs *
|
||||
IV code = PerlIOBuf_pushed(aTHX_ f, mode, Nullsv,tab);
|
||||
SV *result = Nullsv;
|
||||
|
||||
+ if (SvTYPE(arg) >= SVt_PVMG
|
||||
+ && mg_findext(arg, PERL_MAGIC_ext, &PerlIOEncode_tag)) {
|
||||
+ e->enc = NULL;
|
||||
+ e->chk = NULL;
|
||||
+ e->inEncodeCall = 0;
|
||||
+ return code;
|
||||
+ }
|
||||
+
|
||||
PUSHSTACKi(PERLSI_MAGIC);
|
||||
ENTER;
|
||||
SAVETMPS;
|
||||
@@ -566,6 +584,9 @@ PerlIOEncode_dup(pTHX_ PerlIO * f, PerlIO * o,
|
||||
if (oe->enc) {
|
||||
fe->enc = PerlIO_sv_dup(aTHX_ oe->enc, params);
|
||||
}
|
||||
+ if (oe->chk) {
|
||||
+ fe->chk = PerlIO_sv_dup(aTHX_ oe->chk, params);
|
||||
+ }
|
||||
}
|
||||
return f;
|
||||
}
|
||||
diff --git a/ext/PerlIO-encoding/t/threads.t b/ext/PerlIO-encoding/t/threads.t
|
||||
new file mode 100644
|
||||
index 0000000..64f0e55
|
||||
--- /dev/null
|
||||
+++ b/ext/PerlIO-encoding/t/threads.t
|
||||
@@ -0,0 +1,35 @@
|
||||
+#!perl
|
||||
+
|
||||
+use strict;
|
||||
+use warnings;
|
||||
+
|
||||
+BEGIN {
|
||||
+ use Config;
|
||||
+ if ($Config{extensions} !~ /\bEncode\b/) {
|
||||
+ print "1..0 # Skip: no Encode\n";
|
||||
+ exit 0;
|
||||
+ }
|
||||
+ unless ($Config{useithreads}) {
|
||||
+ print "1..0 # Skip: no threads\n";
|
||||
+ exit 0;
|
||||
+ }
|
||||
+}
|
||||
+
|
||||
+use threads;
|
||||
+
|
||||
+use Test::More tests => 3 + 1;
|
||||
+
|
||||
+binmode *STDOUT, ':encoding(UTF-8)';
|
||||
+
|
||||
+SKIP: {
|
||||
+ local $@;
|
||||
+ my $ret = eval {
|
||||
+ my $thread = threads->create(sub { pass 'in thread'; return 1 });
|
||||
+ skip 'test thread could not be spawned' => 3 unless $thread;
|
||||
+ $thread->join;
|
||||
+ };
|
||||
+ is $@, '', 'thread did not croak';
|
||||
+ is $ret, 1, 'thread returned the right value';
|
||||
+}
|
||||
+
|
||||
+pass 'passes at least one test';
|
||||
--
|
||||
2.5.5
|
||||
|
|
@ -0,0 +1,45 @@
|
|||
From a51d828a6d402f30f37707c714de218f6b47dbd8 Mon Sep 17 00:00:00 2001
|
||||
From: Dan Collins <dcollinsn@gmail.com>
|
||||
Date: Sun, 4 Sep 2016 14:43:41 -0400
|
||||
Subject: [PATCH] Regression test for RT #129196
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Ported to 5.24.0:
|
||||
|
||||
commit a6128716d2cc20147851e0a37768376647bd3242
|
||||
Author: Dan Collins <dcollinsn@gmail.com>
|
||||
Date: Sun Sep 4 14:43:41 2016 -0400
|
||||
|
||||
Regression test for RT #129196
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
t/op/evalbytes.t | 6 +++++-
|
||||
1 file changed, 5 insertions(+), 1 deletion(-)
|
||||
|
||||
diff --git a/t/op/evalbytes.t b/t/op/evalbytes.t
|
||||
index cca7c04..5e2af76 100644
|
||||
--- a/t/op/evalbytes.t
|
||||
+++ b/t/op/evalbytes.t
|
||||
@@ -6,7 +6,7 @@ BEGIN {
|
||||
require './test.pl'; require './charset_tools.pl';
|
||||
}
|
||||
|
||||
-plan(tests => 8);
|
||||
+plan(tests => 9);
|
||||
|
||||
{
|
||||
local $SIG{__WARN__} = sub {};
|
||||
@@ -33,3 +33,7 @@ chop($upcode = "use utf8; $U_100" . chr 256);
|
||||
is evalbytes $upcode, chr 256, 'use utf8 within evalbytes on utf8 string';
|
||||
eval { evalbytes chr 256 };
|
||||
like $@, qr/Wide character/, 'evalbytes croaks on non-bytes';
|
||||
+
|
||||
+eval 'evalbytes S';
|
||||
+ok 1, '[RT #129196] evalbytes S should not segfault';
|
||||
+
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,94 @@
|
|||
From af04cb4d2503c5c75d2229e232b8a0bd5c210084 Mon Sep 17 00:00:00 2001
|
||||
From: Yves Orton <demerphq@gmail.com>
|
||||
Date: Tue, 13 Sep 2016 23:06:07 +0200
|
||||
Subject: [PATCH] clean up gv_fetchmethod_pvn_flags: introduce name_end
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Ported to 5.24.0:
|
||||
|
||||
commit 65308f87d02a1900e59f0002fa94c855d4d4c5df
|
||||
Author: Yves Orton <demerphq@gmail.com>
|
||||
Date: Tue Sep 13 23:06:07 2016 +0200
|
||||
|
||||
clean up gv_fetchmethod_pvn_flags: introduce name_end
|
||||
|
||||
nend is used for too many things, this replaces various
|
||||
uses of nend with name_end, which is constant.
|
||||
|
||||
this is a first step to fixing [perl #129267], which shouldnt
|
||||
change any behavior
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
gv.c | 14 ++++++++------
|
||||
1 file changed, 8 insertions(+), 6 deletions(-)
|
||||
|
||||
diff --git a/gv.c b/gv.c
|
||||
index 28396de..d738bf0 100644
|
||||
--- a/gv.c
|
||||
+++ b/gv.c
|
||||
@@ -1014,6 +1014,8 @@ Perl_gv_fetchmethod_pv_flags(pTHX_ HV *stash, const char *name, U32 flags)
|
||||
GV *
|
||||
Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN len, U32 flags)
|
||||
{
|
||||
+ const char * const origname = name;
|
||||
+ const char * const name_end = name + len;
|
||||
const char *nend;
|
||||
const char *nsplit = NULL;
|
||||
GV* gv;
|
||||
@@ -1034,7 +1036,7 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
|
||||
the error reporting code. */
|
||||
}
|
||||
|
||||
- for (nend = name; *nend || nend != (origname + len); nend++) {
|
||||
+ for (nend = name; *nend || nend != name_end; nend++) {
|
||||
if (*nend == '\'') {
|
||||
nsplit = nend;
|
||||
name = nend + 1;
|
||||
@@ -1065,13 +1067,13 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
|
||||
ostash = stash;
|
||||
}
|
||||
|
||||
- gv = gv_fetchmeth_pvn(stash, name, nend - name, 0, flags);
|
||||
+ gv = gv_fetchmeth_pvn(stash, name, name_end - name, 0, flags);
|
||||
if (!gv) {
|
||||
if (strEQ(name,"import") || strEQ(name,"unimport"))
|
||||
gv = MUTABLE_GV(&PL_sv_yes);
|
||||
else if (autoload)
|
||||
gv = gv_autoload_pvn(
|
||||
- ostash, name, nend - name, GV_AUTOLOAD_ISMETHOD|flags
|
||||
+ ostash, name, name_end - name, GV_AUTOLOAD_ISMETHOD|flags
|
||||
);
|
||||
if (!gv && do_croak) {
|
||||
/* Right now this is exclusively for the benefit of S_method_common
|
||||
@@ -1087,14 +1089,14 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
|
||||
HV_FETCH_ISEXISTS, NULL, 0)
|
||||
) {
|
||||
require_pv("IO/File.pm");
|
||||
- gv = gv_fetchmeth_pvn(stash, name, nend - name, 0, flags);
|
||||
+ gv = gv_fetchmeth_pvn(stash, name, name_end - name, 0, flags);
|
||||
if (gv)
|
||||
return gv;
|
||||
}
|
||||
Perl_croak(aTHX_
|
||||
"Can't locate object method \"%"UTF8f
|
||||
"\" via package \"%"HEKf"\"",
|
||||
- UTF8fARG(is_utf8, nend - name, name),
|
||||
+ UTF8fARG(is_utf8, name_end - name, name),
|
||||
HEKfARG(HvNAME_HEK(stash)));
|
||||
}
|
||||
else {
|
||||
@@ -1111,7 +1113,7 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
|
||||
"Can't locate object method \"%"UTF8f
|
||||
"\" via package \"%"SVf"\""
|
||||
" (perhaps you forgot to load \"%"SVf"\"?)",
|
||||
- UTF8fARG(is_utf8, nend - name, name),
|
||||
+ UTF8fARG(is_utf8, name_end - name, name),
|
||||
SVfARG(packnamesv), SVfARG(packnamesv));
|
||||
}
|
||||
}
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,92 @@
|
|||
From 03fcc0c44bc7972f2c92736daae5b63d601b7c49 Mon Sep 17 00:00:00 2001
|
||||
From: Dan Collins <dcollinsn@gmail.com>
|
||||
Date: Fri, 23 Sep 2016 01:21:20 -0400
|
||||
Subject: [PATCH] [rt #129336] #!perl -i u erroneously interpreted as -u
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Ported to 5.24.0:
|
||||
|
||||
commit f54cfdacff1f3744ef08fc70f1f3bc6c7d862e83
|
||||
Author: Dan Collins <dcollinsn@gmail.com>
|
||||
Date: Fri Sep 23 01:21:20 2016 -0400
|
||||
|
||||
[rt #129336] #!perl -i u erroneously interpreted as -u
|
||||
|
||||
Perl_moreswitches processes a single switch, and returns a pointer
|
||||
to the start of the next switch. It can return either
|
||||
the a pointer to the next flag itself:
|
||||
|
||||
#!perl -n -p
|
||||
^ Can point here
|
||||
|
||||
Or, to the space before the next "arg":
|
||||
|
||||
#!perl -n -p
|
||||
^ Can point here
|
||||
|
||||
(Where the next call to Perl_moreswitches will consume " -".)
|
||||
|
||||
In the case of -i[extension], the pointer is by default pointing at
|
||||
the space after the end of the argument. The current code tries to
|
||||
do the former, by unconditionally advancing the pointer, and then
|
||||
advancing it again if it is on a '-'. But that is incorrect:
|
||||
|
||||
#!perl -i p
|
||||
^ Will point here, but that isn't a flag
|
||||
|
||||
I could fix this by removing the unconditional s++, and having it
|
||||
increment by 2 if *(s+1)=='-', but this work isn't actually
|
||||
necessary - it's better to just leave it pointing at the space after
|
||||
the argument.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
perl.c | 5 -----
|
||||
t/op/lex.t | 9 ++++++++-
|
||||
2 files changed, 8 insertions(+), 6 deletions(-)
|
||||
|
||||
diff --git a/perl.c b/perl.c
|
||||
index 228a0d8..5cc7d0b 100644
|
||||
--- a/perl.c
|
||||
+++ b/perl.c
|
||||
@@ -3306,11 +3306,6 @@ Perl_moreswitches(pTHX_ const char *s)
|
||||
|
||||
PL_inplace = savepvn(start, s - start);
|
||||
}
|
||||
- if (*s) {
|
||||
- ++s;
|
||||
- if (*s == '-') /* Additional switches on #! line. */
|
||||
- s++;
|
||||
- }
|
||||
return s;
|
||||
case 'I': /* -I handled both here and in parse_body() */
|
||||
forbid_setid('I', FALSE);
|
||||
diff --git a/t/op/lex.t b/t/op/lex.t
|
||||
index c515449..9ada592 100644
|
||||
--- a/t/op/lex.t
|
||||
+++ b/t/op/lex.t
|
||||
@@ -7,7 +7,7 @@ use warnings;
|
||||
|
||||
BEGIN { chdir 't' if -d 't'; require './test.pl'; }
|
||||
|
||||
-plan(tests => 25);
|
||||
+plan(tests => 26);
|
||||
|
||||
{
|
||||
no warnings 'deprecated';
|
||||
@@ -209,3 +209,10 @@ fresh_perl_is(
|
||||
{ stderr => 1 },
|
||||
's;@{<<a; [perl #123995]'
|
||||
);
|
||||
+
|
||||
+fresh_perl_like(
|
||||
+ "#!perl -i u\nprint 'OK'",
|
||||
+ qr/OK/,
|
||||
+ {},
|
||||
+ '[perl #129336] - #!perl -i argument handling'
|
||||
+);
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,94 @@
|
|||
From 27a8a9e2a55ccc148582006396a9c35bafa5f0b3 Mon Sep 17 00:00:00 2001
|
||||
From: David Mitchell <davem@iabyn.com>
|
||||
Date: Wed, 30 Nov 2016 08:59:01 +0000
|
||||
Subject: [PATCH] split was leaving PL_sv_undef in unused ary slots
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Petr Pisar: Ported to 5.24.0:
|
||||
|
||||
commit 71ca73e5fa9639ac33e9f2e74cd0c32288a5040d
|
||||
Author: David Mitchell <davem@iabyn.com>
|
||||
Date: Wed Nov 30 08:59:01 2016 +0000
|
||||
|
||||
split was leaving PL_sv_undef in unused ary slots
|
||||
|
||||
This:
|
||||
|
||||
@a = split(/-/,"-");
|
||||
$a[1] = undef;
|
||||
$a[0] = 0;
|
||||
|
||||
was giving
|
||||
|
||||
Modification of a read-only value attempted at foo line 3.
|
||||
|
||||
This is because:
|
||||
|
||||
1) unused slots in AvARRAY between AvFILL and AvMAX should always be
|
||||
null; av_clear(), av_extend() etc do this; while av_store(), if storing
|
||||
to a slot N somewhere between AvFILL and AvMAX, doesn't bother to clear
|
||||
between (AvFILL+1)..(N-1) on the assumption that everyone else plays
|
||||
nicely.
|
||||
|
||||
2) pp_split() when splitting directly to an array, sometimes over-splits
|
||||
and has to null out the excess elements;
|
||||
|
||||
3) Since perl 5.19.4, unused AV slots are now marked with NULL rather than
|
||||
&PL_sv_undef;
|
||||
|
||||
4) pp_split was still using &PL_sv_undef;
|
||||
|
||||
The fault was with (4), and is easily fixed.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
pp.c | 2 +-
|
||||
t/op/split.t | 13 ++++++++++++-
|
||||
2 files changed, 13 insertions(+), 2 deletions(-)
|
||||
|
||||
diff --git a/pp.c b/pp.c
|
||||
index 4153482..70345ce 100644
|
||||
--- a/pp.c
|
||||
+++ b/pp.c
|
||||
@@ -6212,7 +6212,7 @@ PP(pp_split)
|
||||
while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0)) {
|
||||
if (TOPs && !make_mortal)
|
||||
sv_2mortal(TOPs);
|
||||
- *SP-- = &PL_sv_undef;
|
||||
+ *SP-- = NULL;
|
||||
iters--;
|
||||
}
|
||||
}
|
||||
diff --git a/t/op/split.t b/t/op/split.t
|
||||
index fb73271..b7846a1 100644
|
||||
--- a/t/op/split.t
|
||||
+++ b/t/op/split.t
|
||||
@@ -7,7 +7,7 @@ BEGIN {
|
||||
set_up_inc('../lib');
|
||||
}
|
||||
|
||||
-plan tests => 131;
|
||||
+plan tests => 133;
|
||||
|
||||
$FS = ':';
|
||||
|
||||
@@ -523,3 +523,14 @@ is "@a", '1 2 3', 'assignment to split-to-array (pmtarget/package array)';
|
||||
}
|
||||
(@{\@a} = split //, "abc") = 1..10;
|
||||
is "@a", '1 2 3', 'assignment to split-to-array (stacked)';
|
||||
+
|
||||
+# splitting directly to an array wasn't filling unused AvARRAY slots with
|
||||
+# NULL
|
||||
+
|
||||
+{
|
||||
+ my @a;
|
||||
+ @a = split(/-/,"-");
|
||||
+ $a[1] = 'b';
|
||||
+ ok eval { $a[0] = 'a'; 1; }, "array split filling AvARRAY: assign 0";
|
||||
+ is "@a", "a b", "array split filling AvARRAY: result";
|
||||
+}
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,70 @@
|
|||
From 4e0fb37303b72ed9d38949139c304abdb73e223e Mon Sep 17 00:00:00 2001
|
||||
From: Aaron Crane <arc@cpan.org>
|
||||
Date: Tue, 24 Jan 2017 23:39:40 +0000
|
||||
Subject: [PATCH] RT#130624: heap-use-after-free in 4-arg substr
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Ported to 5.24.1:
|
||||
|
||||
commit 41b1e858a075694f88057b9514f5fc78c80b5355
|
||||
Author: Aaron Crane <arc@cpan.org>
|
||||
Date: Tue Jan 24 23:39:40 2017 +0000
|
||||
|
||||
RT#130624: heap-use-after-free in 4-arg substr
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
pp.c | 4 +++-
|
||||
t/op/substr.t | 14 +++++++++++++-
|
||||
2 files changed, 16 insertions(+), 2 deletions(-)
|
||||
|
||||
diff --git a/pp.c b/pp.c
|
||||
index 334b353..aa6cff0 100644
|
||||
--- a/pp.c
|
||||
+++ b/pp.c
|
||||
@@ -3462,8 +3462,10 @@ PP(pp_substr)
|
||||
tmps = SvPV_force_nomg(sv, curlen);
|
||||
if (DO_UTF8(repl_sv) && repl_len) {
|
||||
if (!DO_UTF8(sv)) {
|
||||
+ /* Upgrade the dest, and recalculate tmps in case the buffer
|
||||
+ * got reallocated; curlen may also have been changed */
|
||||
sv_utf8_upgrade_nomg(sv);
|
||||
- curlen = SvCUR(sv);
|
||||
+ tmps = SvPV_nomg(sv, curlen);
|
||||
}
|
||||
}
|
||||
else if (DO_UTF8(sv))
|
||||
diff --git a/t/op/substr.t b/t/op/substr.t
|
||||
index 01c36a9..f9fee48 100644
|
||||
--- a/t/op/substr.t
|
||||
+++ b/t/op/substr.t
|
||||
@@ -22,7 +22,7 @@ $SIG{__WARN__} = sub {
|
||||
}
|
||||
};
|
||||
|
||||
-plan(389);
|
||||
+plan(391);
|
||||
|
||||
run_tests() unless caller;
|
||||
|
||||
@@ -872,3 +872,15 @@ is($destroyed, 1, 'Timely scalar destruction with lvalue substr');
|
||||
|
||||
# failed with ASAN
|
||||
fresh_perl_is('$0 = "/usr/bin/perl"; substr($0, 0, 0, $0)', '', {}, "(perl #129340) substr() with source in target");
|
||||
+
|
||||
+
|
||||
+# [perl #130624] - heap-use-after-free, observable under asan
|
||||
+{
|
||||
+ my $x = "\xE9zzzz";
|
||||
+ my $y = "\x{100}";
|
||||
+ my $z = substr $x, 0, 1, $y;
|
||||
+ is $z, "\xE9", "RT#130624: heap-use-after-free in 4-arg substr (ret)";
|
||||
+ is $x, "\x{100}zzzz", "RT#130624: heap-use-after-free in 4-arg substr (targ)";
|
||||
+}
|
||||
+
|
||||
+
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,93 @@
|
|||
From fd25d49cae6409a4ce901fd4d899a197541604b3 Mon Sep 17 00:00:00 2001
|
||||
From: David Mitchell <davem@iabyn.com>
|
||||
Date: Sat, 4 Feb 2017 15:10:49 +0000
|
||||
Subject: [PATCH] buffer overrun with format and 'use bytes'
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Ported to 5.24.1:
|
||||
|
||||
commit e452bf1c9e9f30813b1f289188a6e8b0894575ba
|
||||
Author: David Mitchell <davem@iabyn.com>
|
||||
Date: Sat Feb 4 15:10:49 2017 +0000
|
||||
|
||||
buffer overrun with format and 'use bytes'
|
||||
|
||||
RT #130703
|
||||
|
||||
In the scope of 'use bytes', appending a string to a format where the
|
||||
format is utf8 and the string is non-utf8 but contains lots of chars
|
||||
with ords >= 128, the buffer could be overrun. This is due to all the
|
||||
\x80-type chars going from being stored as 1 bytes to 2 bytes, without
|
||||
growing PL_formtarget accordingly.
|
||||
|
||||
This commit contains a minimal fix; the next commit will more generally
|
||||
tidy up the grow code in pp_formline.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
pp_ctl.c | 3 +++
|
||||
t/op/write.t | 18 +++++++++++++++++-
|
||||
2 files changed, 20 insertions(+), 1 deletion(-)
|
||||
|
||||
diff --git a/pp_ctl.c b/pp_ctl.c
|
||||
index a1fc2f4..4d5ef2e 100644
|
||||
--- a/pp_ctl.c
|
||||
+++ b/pp_ctl.c
|
||||
@@ -505,6 +505,8 @@ PP(pp_formline)
|
||||
SvTAINTED_on(PL_formtarget);
|
||||
if (DO_UTF8(PL_formtarget))
|
||||
targ_is_utf8 = TRUE;
|
||||
+ /* this is an initial estimate of how much output buffer space
|
||||
+ * to allocate. It may be exceeded later */
|
||||
linemax = (SvCUR(formsv) * (IN_BYTES ? 1 : 3) + 1);
|
||||
t = SvGROW(PL_formtarget, len + linemax + 1);
|
||||
/* XXX from now onwards, SvCUR(PL_formtarget) is invalid */
|
||||
@@ -766,6 +768,7 @@ PP(pp_formline)
|
||||
|
||||
if (targ_is_utf8 && !item_is_utf8) {
|
||||
source = tmp = bytes_to_utf8(source, &to_copy);
|
||||
+ grow = to_copy;
|
||||
} else {
|
||||
if (item_is_utf8 && !targ_is_utf8) {
|
||||
U8 *s;
|
||||
diff --git a/t/op/write.t b/t/op/write.t
|
||||
index ab2733f..ae4ddb5 100644
|
||||
--- a/t/op/write.t
|
||||
+++ b/t/op/write.t
|
||||
@@ -98,7 +98,7 @@ for my $tref ( @NumTests ){
|
||||
my $bas_tests = 21;
|
||||
|
||||
# number of tests in section 3
|
||||
-my $bug_tests = 66 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 6 + 2 + 3 + 96 + 11 + 3;
|
||||
+my $bug_tests = 66 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 6 + 2 + 3 + 96 + 11 + 4;
|
||||
|
||||
# number of tests in section 4
|
||||
my $hmb_tests = 37;
|
||||
@@ -1562,6 +1562,22 @@ ok defined *{$::{CmT}}{FORMAT}, "glob assign";
|
||||
formline $format, $orig, 12345;
|
||||
is $^A, ("x" x 100) . " 12345\n", "\@* doesn't overflow";
|
||||
|
||||
+ # ...nor this (RT #130703).
|
||||
+ # Under 'use bytes', the two bytes (c2, 80) making up each \x80 char
|
||||
+ # each get expanded to two bytes (so four in total per \x80 char); the
|
||||
+ # buffer growth wasn't accounting for this doubling in size
|
||||
+
|
||||
+ {
|
||||
+ local $^A = '';
|
||||
+ my $format = "X\n\x{100}" . ("\x80" x 200);
|
||||
+ my $expected = $format;
|
||||
+ utf8::encode($expected);
|
||||
+ use bytes;
|
||||
+ formline($format);
|
||||
+ is $^A, $expected, "RT #130703";
|
||||
+ }
|
||||
+
|
||||
+
|
||||
# make sure it can cope with formats > 64k
|
||||
|
||||
$format = 'x' x 65537;
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,107 @@
|
|||
From 0c43d46cd570d2a19edfa54b9c637dea5c0a3514 Mon Sep 17 00:00:00 2001
|
||||
From: Tony Cook <tony@develop-help.com>
|
||||
Date: Thu, 19 Jan 2017 16:28:03 +1100
|
||||
Subject: [PATCH] (perl #129125) copy form data if it might be freed
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Ported to 5.24.1:
|
||||
|
||||
commit 86191aed6f092273950ebdd48f886d4ec0c5e85e
|
||||
Author: Tony Cook <tony@develop-help.com>
|
||||
Date: Thu Jan 19 16:28:03 2017 +1100
|
||||
|
||||
(perl #129125) copy form data if it might be freed
|
||||
|
||||
If the format SV also appeared as an argument, and the FF_CHOP
|
||||
operator modified that argument, the magic and hence the compiled
|
||||
format would be freed, and the next iteration of the processing
|
||||
the compiled format would read freed memory.
|
||||
|
||||
Unlike my original patch this copies the formsv too, since
|
||||
that is also stored in the magic, and is needed for presenting
|
||||
literal text from the format.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
pp_ctl.c | 18 ++++++++++++++++++
|
||||
t/op/write.t | 19 ++++++++++++++++++-
|
||||
2 files changed, 36 insertions(+), 1 deletion(-)
|
||||
|
||||
diff --git a/pp_ctl.c b/pp_ctl.c
|
||||
index b94c09a..e859e01 100644
|
||||
--- a/pp_ctl.c
|
||||
+++ b/pp_ctl.c
|
||||
@@ -490,6 +490,7 @@ PP(pp_formline)
|
||||
U8 *source; /* source of bytes to append */
|
||||
STRLEN to_copy; /* how may bytes to append */
|
||||
char trans; /* what chars to translate */
|
||||
+ bool copied_form = false; /* have we duplicated the form? */
|
||||
|
||||
mg = doparseform(tmpForm);
|
||||
|
||||
@@ -687,6 +688,23 @@ PP(pp_formline)
|
||||
case FF_CHOP: /* (for ^*) chop the current item */
|
||||
if (sv != &PL_sv_no) {
|
||||
const char *s = chophere;
|
||||
+ if (!copied_form &&
|
||||
+ ((sv == tmpForm || SvSMAGICAL(sv))
|
||||
+ || (SvGMAGICAL(tmpForm) && !sv_only_taint_gmagic(tmpForm))) ) {
|
||||
+ /* sv and tmpForm are either the same SV, or magic might allow modification
|
||||
+ of tmpForm when sv is modified, so copy */
|
||||
+ SV *newformsv = sv_mortalcopy(formsv);
|
||||
+ U32 *new_compiled;
|
||||
+
|
||||
+ f = SvPV_nolen(newformsv) + (f - SvPV_nolen(formsv));
|
||||
+ Newx(new_compiled, mg->mg_len / sizeof(U32), U32);
|
||||
+ memcpy(new_compiled, mg->mg_ptr, mg->mg_len);
|
||||
+ SAVEFREEPV(new_compiled);
|
||||
+ fpc = new_compiled + (fpc - (U32*)mg->mg_ptr);
|
||||
+ formsv = newformsv;
|
||||
+
|
||||
+ copied_form = true;
|
||||
+ }
|
||||
if (chopspace) {
|
||||
while (isSPACE(*s))
|
||||
s++;
|
||||
diff --git a/t/op/write.t b/t/op/write.t
|
||||
index 590d658..ab2733f 100644
|
||||
--- a/t/op/write.t
|
||||
+++ b/t/op/write.t
|
||||
@@ -98,7 +98,7 @@ for my $tref ( @NumTests ){
|
||||
my $bas_tests = 21;
|
||||
|
||||
# number of tests in section 3
|
||||
-my $bug_tests = 66 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 4 + 2 + 3 + 96 + 11 + 3;
|
||||
+my $bug_tests = 66 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 6 + 2 + 3 + 96 + 11 + 3;
|
||||
|
||||
# number of tests in section 4
|
||||
my $hmb_tests = 37;
|
||||
@@ -1637,6 +1637,23 @@ printf ">%s<\n", ref $zamm;
|
||||
print "$zamm->[0]\n";
|
||||
EOP
|
||||
|
||||
+# [perl #129125] - detected by -fsanitize=address or valgrind
|
||||
+# the compiled format would be freed when the format string was modified
|
||||
+# by the chop operator
|
||||
+fresh_perl_is(<<'EOP', "^", { stderr => 1 }, '#129125 - chop on format');
|
||||
+my $x = '^@';
|
||||
+formline$x=>$x;
|
||||
+print $^A;
|
||||
+EOP
|
||||
+
|
||||
+fresh_perl_is(<<'EOP', '<^< xx AA><xx ^<><>', { stderr => 1 }, '#129125 - chop on format, later values');
|
||||
+my $x = '^< xx ^<';
|
||||
+my $y = 'AA';
|
||||
+formline $x => $x, $y;
|
||||
+print "<$^A><$x><$y>";
|
||||
+EOP
|
||||
+
|
||||
+
|
||||
# [perl #73690]
|
||||
|
||||
select +(select(RT73690), do {
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,73 @@
|
|||
From a26907949ed561dccd661fc8600889eddc6664ea Mon Sep 17 00:00:00 2001
|
||||
From: Hugo van der Sanden <hv@crypt.org>
|
||||
Date: Wed, 5 Oct 2016 14:53:27 +0100
|
||||
Subject: [PATCH] [perl #129342] ensure range-start is set after error in tr///
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Ported to 5.24.1:
|
||||
|
||||
t 59143e29a717d67a61b869a6c5bb49574f1ef43f
|
||||
Author: Tony Cook <tony@develop-help.com>
|
||||
Date: Tue Jan 17 11:52:53 2017 +1100
|
||||
|
||||
(perl #129342) test for buffer overflow
|
||||
|
||||
commit 3dd4eaeb8ac39e08179145b86aedda36584a3509
|
||||
Author: Hugo van der Sanden <hv@crypt.org>
|
||||
Date: Wed Oct 5 14:53:27 2016 +0100
|
||||
|
||||
[perl #129342] ensure range-start is set after error in tr///
|
||||
|
||||
A parse error due to invalid octal or hex escape in the range of a
|
||||
transliteration must still ensure some kind of start and end values
|
||||
are captured, since we don't stop on the first such error. Failure
|
||||
to do so can cause invalid reads after "Here we have parsed a range".
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
t/lib/croak/toke | 7 +++++++
|
||||
toke.c | 4 ++--
|
||||
2 files changed, 9 insertions(+), 2 deletions(-)
|
||||
|
||||
diff --git a/t/lib/croak/toke b/t/lib/croak/toke
|
||||
index 18dfa24..578a6da 100644
|
||||
--- a/t/lib/croak/toke
|
||||
+++ b/t/lib/croak/toke
|
||||
@@ -302,3 +302,10 @@ Execution of - aborted due to compilation errors.
|
||||
BEGIN <>
|
||||
EXPECT
|
||||
Illegal declaration of subroutine BEGIN at - line 1.
|
||||
+########
|
||||
+# NAME tr/// handling of mis-formatted \o characters
|
||||
+# may only fail with ASAN
|
||||
+tr/\o-0//;
|
||||
+EXPECT
|
||||
+Missing braces on \o{} at - line 2, within string
|
||||
+Execution of - aborted due to compilation errors.
|
||||
diff --git a/toke.c b/toke.c
|
||||
index 288f372..576ce72 100644
|
||||
--- a/toke.c
|
||||
+++ b/toke.c
|
||||
@@ -3338,7 +3338,7 @@ S_scan_const(pTHX_ char *start)
|
||||
UTF);
|
||||
if (! valid) {
|
||||
yyerror(error);
|
||||
- continue;
|
||||
+ uv = 0; /* drop through to ensure range ends are set */
|
||||
}
|
||||
goto NUM_ESCAPE_INSERT;
|
||||
}
|
||||
@@ -3356,7 +3356,7 @@ S_scan_const(pTHX_ char *start)
|
||||
UTF);
|
||||
if (! valid) {
|
||||
yyerror(error);
|
||||
- continue;
|
||||
+ uv = 0; /* drop through to ensure range ends are set */
|
||||
}
|
||||
}
|
||||
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,62 @@
|
|||
From 2bcb4a5888b1c26ee11bc447cc02b42290c707af Mon Sep 17 00:00:00 2001
|
||||
From: Tony Cook <tony@develop-help.com>
|
||||
Date: Mon, 5 Dec 2016 11:48:14 +1100
|
||||
Subject: [PATCH] (perl #130262) split scalar context stack overflow fix
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Ported to 5.14.1:
|
||||
|
||||
commit 02c161ef974f8f1efbb5632f741c1164adb6ca75
|
||||
Author: Tony Cook <tony@develop-help.com>
|
||||
Date: Mon Dec 5 11:48:14 2016 +1100
|
||||
|
||||
(perl #130262) split scalar context stack overflow fix
|
||||
|
||||
pp_split didn't ensure there was space for its return value
|
||||
in scalar context.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
pp.c | 2 +-
|
||||
t/op/split.t | 6 +++++-
|
||||
2 files changed, 6 insertions(+), 2 deletions(-)
|
||||
|
||||
diff --git a/pp.c b/pp.c
|
||||
index 70345ce..334b353 100644
|
||||
--- a/pp.c
|
||||
+++ b/pp.c
|
||||
@@ -6259,7 +6259,7 @@ PP(pp_split)
|
||||
}
|
||||
|
||||
GETTARGET;
|
||||
- PUSHi(iters);
|
||||
+ XPUSHi(iters);
|
||||
RETURN;
|
||||
}
|
||||
|
||||
diff --git a/t/op/split.t b/t/op/split.t
|
||||
index b7846a1..3e08841 100644
|
||||
--- a/t/op/split.t
|
||||
+++ b/t/op/split.t
|
||||
@@ -7,7 +7,7 @@ BEGIN {
|
||||
set_up_inc('../lib');
|
||||
}
|
||||
|
||||
-plan tests => 133;
|
||||
+plan tests => 134;
|
||||
|
||||
$FS = ':';
|
||||
|
||||
@@ -534,3 +534,7 @@ is "@a", '1 2 3', 'assignment to split-to-array (stacked)';
|
||||
ok eval { $a[0] = 'a'; 1; }, "array split filling AvARRAY: assign 0";
|
||||
is "@a", "a b", "array split filling AvARRAY: result";
|
||||
}
|
||||
+
|
||||
+fresh_perl_is(<<'CODE', '', {}, "scalar split stack overflow");
|
||||
+map{int"";split//.0>60for"0000000000000000"}split// for"00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
|
||||
+CODE
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,72 @@
|
|||
From be05b2f7a801ae1721641fd240e0d7d6fc018136 Mon Sep 17 00:00:00 2001
|
||||
From: Aaron Crane <arc@cpan.org>
|
||||
Date: Sun, 19 Feb 2017 12:26:54 +0000
|
||||
Subject: [PATCH] fix ck_return null-pointer deref on malformed code
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Ported to 5.24.1:
|
||||
|
||||
commit e5c165a0b7551ffb94661aa7f18aabadba257782
|
||||
Author: Aaron Crane <arc@cpan.org>
|
||||
Date: Sun Feb 19 12:26:54 2017 +0000
|
||||
|
||||
[perl #130815] fix ck_return null-pointer deref on malformed code
|
||||
|
||||
commit 9de2a80ffc0eefb4d60e13766baf4bad129e0a92
|
||||
Author: David Mitchell <davem@iabyn.com>
|
||||
Date: Sun Feb 19 12:36:58 2017 +0000
|
||||
|
||||
bump test count in t/comp/parser.t
|
||||
|
||||
(the previous commit forgot to)
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
op.c | 2 +-
|
||||
t/comp/parser.t | 8 +++++++-
|
||||
2 files changed, 8 insertions(+), 2 deletions(-)
|
||||
|
||||
diff --git a/op.c b/op.c
|
||||
index 018d90c..9a61ea7 100644
|
||||
--- a/op.c
|
||||
+++ b/op.c
|
||||
@@ -10695,7 +10695,7 @@ Perl_ck_return(pTHX_ OP *o)
|
||||
PERL_ARGS_ASSERT_CK_RETURN;
|
||||
|
||||
kid = OpSIBLING(cLISTOPo->op_first);
|
||||
- if (CvLVALUE(PL_compcv)) {
|
||||
+ if (PL_compcv && CvLVALUE(PL_compcv)) {
|
||||
for (; kid; kid = OpSIBLING(kid))
|
||||
op_lvalue(kid, OP_LEAVESUBLV);
|
||||
}
|
||||
diff --git a/t/comp/parser.t b/t/comp/parser.t
|
||||
index 50f601c..5016509 100644
|
||||
--- a/t/comp/parser.t
|
||||
+++ b/t/comp/parser.t
|
||||
@@ -8,7 +8,7 @@ BEGIN {
|
||||
chdir 't' if -d 't';
|
||||
}
|
||||
|
||||
-print "1..173\n";
|
||||
+print "1..174\n";
|
||||
|
||||
sub failed {
|
||||
my ($got, $expected, $name) = @_;
|
||||
@@ -546,6 +546,12 @@ eval "grep+grep";
|
||||
eval 'qq{@{0]}${}},{})';
|
||||
is(1, 1, "RT #124207");
|
||||
|
||||
+# RT #130815: crash in ck_return for malformed code
|
||||
+{
|
||||
+ eval 'm(@{if(0){sub d{]]])}return';
|
||||
+ like $@, qr/^syntax error at \(eval \d+\) line 1, near "\{\]"/,
|
||||
+ 'RT #130815: null pointer deref';
|
||||
+}
|
||||
|
||||
# Add new tests HERE (above this line)
|
||||
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,61 @@
|
|||
From cba9aa759f7ce8a4a80e748eb451f679042cd74b Mon Sep 17 00:00:00 2001
|
||||
From: Father Chrysostomos <sprout@cpan.org>
|
||||
Date: Fri, 7 Apr 2017 14:08:02 -0700
|
||||
Subject: [PATCH] Crash with sub-in-stash
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Ported to 5.24.1:
|
||||
|
||||
commit 790acddeaa0d2c73524596048b129561225cf100
|
||||
Author: Father Chrysostomos <sprout@cpan.org>
|
||||
Date: Fri Apr 7 14:08:02 2017 -0700
|
||||
|
||||
[perl #131085] Crash with sub-in-stash
|
||||
|
||||
$ perl -e '$::{"A"} = sub {}; \&{"A"}'
|
||||
Segmentation fault (core dumped)
|
||||
|
||||
The code that vivifies a typeglob out of a code ref assumed that the
|
||||
CV had a name hek, which is always the case when perl itself puts the
|
||||
code ref there (via ‘sub A{}’), but is not necessarily the case if
|
||||
someone is insinuating other stuff into the stash.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
gv.c | 2 +-
|
||||
t/op/gv.t | 4 ++++
|
||||
2 files changed, 5 insertions(+), 1 deletion(-)
|
||||
|
||||
diff --git a/gv.c b/gv.c
|
||||
index 3fda9b9..6690b64 100644
|
||||
--- a/gv.c
|
||||
+++ b/gv.c
|
||||
@@ -421,7 +421,7 @@ Perl_gv_init_pvn(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, U32 flag
|
||||
/* Not actually a constant. Just a regular sub. */
|
||||
CV * const cv = (CV *)has_constant;
|
||||
GvCV_set(gv,cv);
|
||||
- if (CvSTASH(cv) == stash && (
|
||||
+ if (CvNAMED(cv) && CvSTASH(cv) == stash && (
|
||||
CvNAME_HEK(cv) == GvNAME_HEK(gv)
|
||||
|| ( HEK_LEN(CvNAME_HEK(cv)) == HEK_LEN(GvNAME_HEK(gv))
|
||||
&& HEK_FLAGS(CvNAME_HEK(cv)) != HEK_FLAGS(GvNAME_HEK(gv))
|
||||
diff --git a/t/op/gv.t b/t/op/gv.t
|
||||
index 03ae46e..cdaaef5 100644
|
||||
--- a/t/op/gv.t
|
||||
+++ b/t/op/gv.t
|
||||
@@ -1170,6 +1170,10 @@ SKIP: {
|
||||
is ($? & 127, 0,"[perl #128597] No crash when gp_free calls ckWARN_d");
|
||||
}
|
||||
|
||||
+# [perl #131085] This used to crash; no ok() necessary.
|
||||
+$::{"A131085"} = sub {}; \&{"A131085"};
|
||||
+
|
||||
+
|
||||
__END__
|
||||
Perl
|
||||
Rules
|
||||
--
|
||||
2.9.4
|
||||
|
|
@ -0,0 +1,266 @@
|
|||
From 30cba075ecbb662b392b2c6e896dec287ea49aa8 Mon Sep 17 00:00:00 2001
|
||||
From: Yves Orton <demerphq@gmail.com>
|
||||
Date: Tue, 25 Apr 2017 15:17:06 +0200
|
||||
Subject: [PATCH] fixup File::Glob degenerate matching
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Ported to 5.24.1:
|
||||
|
||||
commit 0db967b2e6a4093a6a5f649190159767e5d005e0
|
||||
Author: Yves Orton <demerphq@gmail.com>
|
||||
Date: Tue Apr 25 15:17:06 2017 +0200
|
||||
|
||||
[perl #131211] fixup File::Glob degenerate matching
|
||||
|
||||
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 fe045a7..be2a44f 100644
|
||||
--- a/MANIFEST
|
||||
+++ b/MANIFEST
|
||||
@@ -3678,6 +3678,7 @@ 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/TODO File::Glob extension todo list
|
||||
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/GDBM_File/GDBM_File.pm GDBM extension Perl module
|
||||
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
|
||||
|
|
@ -0,0 +1,72 @@
|
|||
From 064604f904546ae4ddada5a2aa30256faccee39c 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.24.1:
|
||||
|
||||
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 12cbb5f..05584a2 100644
|
||||
--- a/sv.c
|
||||
+++ b/sv.c
|
||||
@@ -3162,6 +3162,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 cdaaef5..ea79e51 100644
|
||||
--- a/t/op/gv.t
|
||||
+++ b/t/op/gv.t
|
||||
@@ -12,7 +12,7 @@ BEGIN {
|
||||
|
||||
use warnings;
|
||||
|
||||
-plan(tests => 277 );
|
||||
+plan(tests => 279 );
|
||||
|
||||
# type coercion on assignment
|
||||
$foo = 'foo';
|
||||
@@ -1173,6 +1173,14 @@ SKIP: {
|
||||
# [perl #131085] This used to crash; no ok() necessary.
|
||||
$::{"A131085"} = sub {}; \&{"A131085"};
|
||||
|
||||
+{
|
||||
+ # [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");
|
||||
+}
|
||||
+
|
||||
|
||||
__END__
|
||||
Perl
|
||||
--
|
||||
2.9.4
|
||||
|
|
@ -0,0 +1,74 @@
|
|||
From 08bc282a248b21c92ff45e49490fb95e24358213 Mon Sep 17 00:00:00 2001
|
||||
From: David Mitchell <davem@iabyn.com>
|
||||
Date: Tue, 9 May 2017 14:29:11 +0100
|
||||
Subject: [PATCH] sprintf(): add memory wrap tests
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Ported to 5.24.1:
|
||||
|
||||
commit d729f63cc94318c248eab95844cfbed5298a7ecd
|
||||
Author: David Mitchell <davem@iabyn.com>
|
||||
Date: Tue May 9 14:29:11 2017 +0100
|
||||
|
||||
sprintf(): add memory wrap tests
|
||||
|
||||
In various places Perl_sv_vcatpvfn_flags() does croak_memory_wrap()
|
||||
(including a couple added by the previous commit to fix RT #131260),
|
||||
but there don't appear to be any tests for them.
|
||||
|
||||
So this commit adds some tests.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
t/op/sprintf2.t | 29 ++++++++++++++++++++++++++++-
|
||||
1 file changed, 28 insertions(+), 1 deletion(-)
|
||||
|
||||
diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t
|
||||
index 43ed919..ef8a743 100644
|
||||
--- a/t/op/sprintf2.t
|
||||
+++ b/t/op/sprintf2.t
|
||||
@@ -262,7 +262,7 @@ if ($Config{nvsize} == 8 &&
|
||||
print "# no hexfloat tests\n";
|
||||
}
|
||||
|
||||
-plan tests => 1408 + ($Q ? 0 : 12) + @hexfloat + 12;
|
||||
+plan tests => 1408 + ($Q ? 0 : 12) + @hexfloat + 16;
|
||||
|
||||
use strict;
|
||||
use Config;
|
||||
@@ -749,3 +749,30 @@ SKIP: {
|
||||
"non-canonical form");
|
||||
}
|
||||
}
|
||||
+
|
||||
+# check all calls to croak_memory_wrap()
|
||||
+# RT #131260
|
||||
+
|
||||
+{
|
||||
+ my $s = 8 * $Config{sizesize};
|
||||
+ my $i = 1;
|
||||
+ my $max;
|
||||
+ while ($s--) { $max |= $i; $i <<= 1; }
|
||||
+ my $max40 = $max - 40; # see the magic fudge factor in sv_vcatpvfn_flags()
|
||||
+
|
||||
+ my @tests = (
|
||||
+ # format, arg
|
||||
+ ["%.${max}a", 1.1 ],
|
||||
+ ["%.${max40}a", 1.1 ],
|
||||
+ ["%.${max}i", 1 ],
|
||||
+ ["%.${max}i", -1 ],
|
||||
+ );
|
||||
+
|
||||
+ for my $test (@tests) {
|
||||
+ my ($fmt, $arg) = @$test;
|
||||
+ eval { my $s = sprintf $fmt, $arg; };
|
||||
+ like("$@", qr/panic: memory wrap/, qq{memory wrap: "$fmt", "$arg"});
|
||||
+ }
|
||||
+}
|
||||
+
|
||||
+
|
||||
--
|
||||
2.9.4
|
||||
|
|
@ -0,0 +1,73 @@
|
|||
From 3f6b66c14467c0f8c7459e32c576618155ca89f3 Mon Sep 17 00:00:00 2001
|
||||
From: Tony Cook <tony@develop-help.com>
|
||||
Date: Thu, 16 Jun 2016 14:08:18 +1000
|
||||
Subject: [PATCH] (perl #128316) preserve errno from failed system calls
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
pp_sys.c | 4 ++--
|
||||
t/io/socket.t | 22 ++++++++++++++++++++++
|
||||
2 files changed, 24 insertions(+), 2 deletions(-)
|
||||
|
||||
diff --git a/pp_sys.c b/pp_sys.c
|
||||
index 33cba46..3bf2673 100644
|
||||
--- a/pp_sys.c
|
||||
+++ b/pp_sys.c
|
||||
@@ -2497,7 +2497,6 @@ PP(pp_socket)
|
||||
TAINT_PROPER("socket");
|
||||
fd = PerlSock_socket(domain, type, protocol);
|
||||
if (fd < 0) {
|
||||
- SETERRNO(EBADF,RMS_IFI);
|
||||
RETPUSHUNDEF;
|
||||
}
|
||||
IoIFP(io) = PerlIO_fdopen(fd, "r"SOCKET_OPEN_MODE); /* stdio gets confused about sockets */
|
||||
@@ -3531,8 +3530,9 @@ PP(pp_fttext)
|
||||
}
|
||||
PL_laststatval = PerlLIO_fstat(fd, &PL_statcache);
|
||||
if (PL_laststatval < 0) {
|
||||
+ dSAVE_ERRNO;
|
||||
(void)PerlIO_close(fp);
|
||||
- SETERRNO(EBADF,RMS_IFI);
|
||||
+ RESTORE_ERRNO;
|
||||
FT_RETURNUNDEF;
|
||||
}
|
||||
PerlIO_binmode(aTHX_ fp, '<', O_BINARY, NULL);
|
||||
diff --git a/t/io/socket.t b/t/io/socket.t
|
||||
index b51079a..54e4438 100644
|
||||
--- a/t/io/socket.t
|
||||
+++ b/t/io/socket.t
|
||||
@@ -128,6 +128,28 @@ SKIP: {
|
||||
}
|
||||
}
|
||||
|
||||
+SKIP:
|
||||
+{
|
||||
+ eval { require Errno; defined &Errno::EMFILE }
|
||||
+ or skip "Can't load Errno or EMFILE not defined", 1;
|
||||
+ my @socks;
|
||||
+ my $sock_limit = 1000; # don't consume every file in the system
|
||||
+ # Default limits on various systems I have:
|
||||
+ # 65536 - Linux
|
||||
+ # 256 - Solaris
|
||||
+ # 128 - NetBSD
|
||||
+ # 256 - Cygwin
|
||||
+ # 256 - darwin
|
||||
+ while (@socks < $sock_limit) {
|
||||
+ socket my $work, PF_INET, SOCK_STREAM, $tcp
|
||||
+ or last;
|
||||
+ push @socks, $work;
|
||||
+ }
|
||||
+ @socks == $sock_limit
|
||||
+ and skip "Didn't run out of open handles", 1;
|
||||
+ is(0+$!, Errno::EMFILE(), "check correct errno for too many files");
|
||||
+}
|
||||
+
|
||||
done_testing();
|
||||
|
||||
my @child_tests;
|
||||
--
|
||||
2.5.5
|
||||
|
|
@ -0,0 +1,44 @@
|
|||
From bce4a2abeb8652d19e97d3bf07dd2580a3cc2e6c Mon Sep 17 00:00:00 2001
|
||||
From: Hugo van der Sanden <hv@crypt.org>
|
||||
Date: Sat, 25 Feb 2017 10:42:17 +0000
|
||||
Subject: [PATCH] fix VMS test fail
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
d7186add added a runperl() test that breaks command line length limits for
|
||||
VMS. Switch to fresh_perl() instead, so the prog is put in a file for us.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
t/comp/parser_run.t | 12 ++++++------
|
||||
1 file changed, 6 insertions(+), 6 deletions(-)
|
||||
|
||||
diff --git a/t/comp/parser_run.t b/t/comp/parser_run.t
|
||||
index 2543f49..e74644d 100644
|
||||
--- a/t/comp/parser_run.t
|
||||
+++ b/t/comp/parser_run.t
|
||||
@@ -14,14 +14,14 @@ plan(1);
|
||||
|
||||
# [perl #130814] can reallocate lineptr while looking ahead for
|
||||
# "Missing $ on loop variable" diagnostic.
|
||||
-my $result = runperl(
|
||||
- prog => " foreach m0\n\$" . ("0" x 0x2000),
|
||||
- stderr => 1,
|
||||
+my $result = fresh_perl(
|
||||
+ " foreach m0\n\$" . ("0" x 0x2000),
|
||||
+ { stderr => 1 },
|
||||
);
|
||||
-is($result, <<EXPECT);
|
||||
-syntax error at -e line 3, near "foreach m0
|
||||
+is($result . "\n", <<EXPECT);
|
||||
+syntax error at - line 3, near "foreach m0
|
||||
"
|
||||
-Identifier too long at -e line 3.
|
||||
+Identifier too long at - line 3.
|
||||
EXPECT
|
||||
|
||||
__END__
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,55 @@
|
|||
From d7186addd1b477f6bdcef5e9d24f2125691a9082 Mon Sep 17 00:00:00 2001
|
||||
From: Hugo van der Sanden <hv@crypt.org>
|
||||
Date: Sun, 19 Feb 2017 11:15:38 +0000
|
||||
Subject: [PATCH] [perl #130814] Add testcase, and new testfile
|
||||
t/comp/parser_run.t
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Sometimes it's useful to have test.pl around, but it seems inappropriate
|
||||
to pollute the existing t/comp/parser.t with that.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
t/comp/parser_run.t | 28 ++++++++++++++++++++++++++++
|
||||
1 file changed, 28 insertions(+)
|
||||
create mode 100644 t/comp/parser_run.t
|
||||
|
||||
diff --git a/t/comp/parser_run.t b/t/comp/parser_run.t
|
||||
new file mode 100644
|
||||
index 0000000..2543f49
|
||||
--- /dev/null
|
||||
+++ b/t/comp/parser_run.t
|
||||
@@ -0,0 +1,28 @@
|
||||
+#!./perl
|
||||
+
|
||||
+# Parser tests that want test.pl, eg to use runperl() for tests to show
|
||||
+# reads through invalid pointers.
|
||||
+# Note that this should still be runnable under miniperl.
|
||||
+
|
||||
+BEGIN {
|
||||
+ @INC = qw(. ../lib );
|
||||
+ chdir 't' if -d 't';
|
||||
+}
|
||||
+
|
||||
+require './test.pl';
|
||||
+plan(1);
|
||||
+
|
||||
+# [perl #130814] can reallocate lineptr while looking ahead for
|
||||
+# "Missing $ on loop variable" diagnostic.
|
||||
+my $result = runperl(
|
||||
+ prog => " foreach m0\n\$" . ("0" x 0x2000),
|
||||
+ stderr => 1,
|
||||
+);
|
||||
+is($result, <<EXPECT);
|
||||
+syntax error at -e line 3, near "foreach m0
|
||||
+"
|
||||
+Identifier too long at -e line 3.
|
||||
+EXPECT
|
||||
+
|
||||
+__END__
|
||||
+# ex: set ts=8 sts=4 sw=4 et:
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,54 @@
|
|||
From bd1a29f218b291165e47d9035aaeec14abd9732e Mon Sep 17 00:00:00 2001
|
||||
From: David Mitchell <davem@iabyn.com>
|
||||
Date: Mon, 8 May 2017 21:06:38 +0100
|
||||
Subject: [PATCH] avoid a memory wrap in sv_vcatpvfn_flags()
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
RT #131260
|
||||
|
||||
When calculating the new size of PL_efloatbuf, avoid wrapping 'need'.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
sv.c | 14 +++++++++++---
|
||||
1 file changed, 11 insertions(+), 3 deletions(-)
|
||||
|
||||
diff --git a/sv.c b/sv.c
|
||||
index e90ea84..9f3e28e 100644
|
||||
--- a/sv.c
|
||||
+++ b/sv.c
|
||||
@@ -12448,7 +12448,13 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
|
||||
need = BIT_DIGITS(i);
|
||||
} /* if i < 0, the number of digits is hard to predict. */
|
||||
}
|
||||
- need += has_precis ? precis : 6; /* known default */
|
||||
+
|
||||
+ {
|
||||
+ STRLEN pr = has_precis ? precis : 6; /* known default */
|
||||
+ if (need >= ((STRLEN)~0) - pr)
|
||||
+ croak_memory_wrap();
|
||||
+ need += pr;
|
||||
+ }
|
||||
|
||||
if (need < width)
|
||||
need = width;
|
||||
@@ -12519,10 +12525,12 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
|
||||
|
||||
#endif /* HAS_LDBL_SPRINTF_BUG */
|
||||
|
||||
- need += 20; /* fudge factor */
|
||||
+ if (need >= ((STRLEN)~0) - 40)
|
||||
+ croak_memory_wrap();
|
||||
+ need += 40; /* fudge factor */
|
||||
if (PL_efloatsize < need) {
|
||||
Safefree(PL_efloatbuf);
|
||||
- PL_efloatsize = need + 20; /* more fudge */
|
||||
+ PL_efloatsize = need;
|
||||
Newx(PL_efloatbuf, PL_efloatsize, char);
|
||||
PL_efloatbuf[0] = '\0';
|
||||
}
|
||||
--
|
||||
2.9.4
|
||||
|
|
@ -0,0 +1,74 @@
|
|||
From f6203e997f3012b8aab4cd35fe49f58e4d71fb8c Mon Sep 17 00:00:00 2001
|
||||
From: Karl Williamson <khw@cpan.org>
|
||||
Date: Sun, 10 Jul 2016 22:06:12 -0600
|
||||
Subject: [PATCH] t/test.pl: Add fresh_perl() function
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
This will be useful for cases where the results don't readily fall into
|
||||
fresh_perl_is and fresh_perl_like, such as when a bunch of massaging of
|
||||
the results is needed before it is convenient to test them.
|
||||
fresh_perl_like() could be used, but in the case of failure there could
|
||||
be lines and lines of noise output.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
t/test.pl | 25 +++++++++++++++++++++----
|
||||
1 file changed, 21 insertions(+), 4 deletions(-)
|
||||
|
||||
diff --git a/t/test.pl b/t/test.pl
|
||||
index 41b77f4..20d08e9 100644
|
||||
--- a/t/test.pl
|
||||
+++ b/t/test.pl
|
||||
@@ -953,11 +953,16 @@ sub register_tempfile {
|
||||
return $count;
|
||||
}
|
||||
|
||||
-# This is the temporary file for _fresh_perl
|
||||
+# This is the temporary file for fresh_perl
|
||||
my $tmpfile = tempfile();
|
||||
|
||||
-sub _fresh_perl {
|
||||
- my($prog, $action, $expect, $runperl_args, $name) = @_;
|
||||
+sub fresh_perl {
|
||||
+ my($prog, $runperl_args) = @_;
|
||||
+
|
||||
+ # Run 'runperl' with the complete perl program contained in '$prog', and
|
||||
+ # arguments in the hash referred to by '$runperl_args'. The results are
|
||||
+ # returned, with $? set to the exit code. Unless overridden, stderr is
|
||||
+ # redirected to stdout.
|
||||
|
||||
# Given the choice of the mis-parsable {}
|
||||
# (we want an anon hash, but a borked lexer might think that it's a block)
|
||||
@@ -975,7 +980,8 @@ sub _fresh_perl {
|
||||
close TEST or die "Cannot close $tmpfile: $!";
|
||||
|
||||
my $results = runperl(%$runperl_args);
|
||||
- my $status = $?;
|
||||
+ my $status = $?; # Not necessary to save this, but it makes it clear to
|
||||
+ # future maintainers.
|
||||
|
||||
# Clean up the results into something a bit more predictable.
|
||||
$results =~ s/\n+$//;
|
||||
@@ -994,6 +1000,17 @@ sub _fresh_perl {
|
||||
$results =~ s/\n\n/\n/g;
|
||||
}
|
||||
|
||||
+ $? = $status;
|
||||
+ return $results;
|
||||
+}
|
||||
+
|
||||
+
|
||||
+sub _fresh_perl {
|
||||
+ my($prog, $action, $expect, $runperl_args, $name) = @_;
|
||||
+
|
||||
+ my $results = fresh_perl($prog, $runperl_args);
|
||||
+ my $status = $?;
|
||||
+
|
||||
# Use the first line of the program as a name if none was given
|
||||
unless( $name ) {
|
||||
($first_line, $name) = $prog =~ /^((.{1,50}).*)/;
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,32 @@
|
|||
From d5ea0ef8623c7d7ba5f42d239787aa71393e2054 Mon Sep 17 00:00:00 2001
|
||||
From: Yves Orton <demerphq@gmail.com>
|
||||
Date: Tue, 13 Sep 2016 23:06:58 +0200
|
||||
Subject: [PATCH 2/5] clean up gv_fetchmethod_pvn_flags: move origname init to
|
||||
function start
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
so it is more obvious that it is a constant copy of the
|
||||
original name.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
gv.c | 1 -
|
||||
1 file changed, 1 deletion(-)
|
||||
|
||||
diff --git a/gv.c b/gv.c
|
||||
index b0221e0..fe38d44 100644
|
||||
--- a/gv.c
|
||||
+++ b/gv.c
|
||||
@@ -1014,7 +1014,6 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
|
||||
const char *nsplit = NULL;
|
||||
GV* gv;
|
||||
HV* ostash = stash;
|
||||
- const char * const origname = name;
|
||||
SV *const error_report = MUTABLE_SV(stash);
|
||||
const U32 autoload = flags & GV_AUTOLOAD;
|
||||
const U32 do_croak = flags & GV_CROAK;
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,92 @@
|
|||
From e2cace1e9e89525afbca257742ddb36630b7fbc3 Mon Sep 17 00:00:00 2001
|
||||
From: Yves Orton <demerphq@gmail.com>
|
||||
Date: Tue, 13 Sep 2016 23:10:48 +0200
|
||||
Subject: [PATCH 3/5] clean up gv_fetchmethod_pvn_flags: rename nsplit to
|
||||
last_separator
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
nsplit if set points at the first char of the last separator
|
||||
in name, so rename it so it is more comprehensible what it means.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
gv.c | 24 ++++++++++++------------
|
||||
1 file changed, 12 insertions(+), 12 deletions(-)
|
||||
|
||||
diff --git a/gv.c b/gv.c
|
||||
index fe38d44..07709a0 100644
|
||||
--- a/gv.c
|
||||
+++ b/gv.c
|
||||
@@ -1011,7 +1011,7 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
|
||||
const char * const origname = name;
|
||||
const char * const name_end = name + len;
|
||||
const char *nend;
|
||||
- const char *nsplit = NULL;
|
||||
+ const char *last_separator = NULL;
|
||||
GV* gv;
|
||||
HV* ostash = stash;
|
||||
SV *const error_report = MUTABLE_SV(stash);
|
||||
@@ -1024,38 +1024,38 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
|
||||
if (SvTYPE(stash) < SVt_PVHV)
|
||||
stash = NULL;
|
||||
else {
|
||||
- /* The only way stash can become NULL later on is if nsplit is set,
|
||||
+ /* The only way stash can become NULL later on is if last_separator is set,
|
||||
which in turn means that there is no need for a SVt_PVHV case
|
||||
the error reporting code. */
|
||||
}
|
||||
|
||||
for (nend = name; *nend || nend != name_end; nend++) {
|
||||
if (*nend == '\'') {
|
||||
- nsplit = nend;
|
||||
+ last_separator = nend;
|
||||
name = nend + 1;
|
||||
}
|
||||
else if (*nend == ':' && *(nend + 1) == ':') {
|
||||
- nsplit = nend++;
|
||||
+ last_separator = nend++;
|
||||
name = nend + 1;
|
||||
}
|
||||
}
|
||||
- if (nsplit) {
|
||||
- if ((nsplit - origname) == 5 && memEQ(origname, "SUPER", 5)) {
|
||||
+ if (last_separator) {
|
||||
+ if ((last_separator - origname) == 5 && memEQ(origname, "SUPER", 5)) {
|
||||
/* ->SUPER::method should really be looked up in original stash */
|
||||
stash = CopSTASH(PL_curcop);
|
||||
flags |= GV_SUPER;
|
||||
DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n",
|
||||
origname, HvENAME_get(stash), name) );
|
||||
}
|
||||
- else if ((nsplit - origname) >= 7 &&
|
||||
- strnEQ(nsplit - 7, "::SUPER", 7)) {
|
||||
+ else if ((last_separator - origname) >= 7 &&
|
||||
+ strnEQ(last_separator - 7, "::SUPER", 7)) {
|
||||
/* don't autovifify if ->NoSuchStash::SUPER::method */
|
||||
- stash = gv_stashpvn(origname, nsplit - origname - 7, is_utf8);
|
||||
+ stash = gv_stashpvn(origname, last_separator - origname - 7, is_utf8);
|
||||
if (stash) flags |= GV_SUPER;
|
||||
}
|
||||
else {
|
||||
/* don't autovifify if ->NoSuchStash::method */
|
||||
- stash = gv_stashpvn(origname, nsplit - origname, is_utf8);
|
||||
+ stash = gv_stashpvn(origname, last_separator - origname, is_utf8);
|
||||
}
|
||||
ostash = stash;
|
||||
}
|
||||
@@ -1098,8 +1098,8 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
|
||||
else {
|
||||
SV* packnamesv;
|
||||
|
||||
- if (nsplit) {
|
||||
- packnamesv = newSVpvn_flags(origname, nsplit - origname,
|
||||
+ if (last_separator) {
|
||||
+ packnamesv = newSVpvn_flags(origname, last_separator - origname,
|
||||
SVs_TEMP | is_utf8);
|
||||
} else {
|
||||
packnamesv = error_report;
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,81 @@
|
|||
From cfb736762c1becf344ce6beaa701ff2e1abd5f9c Mon Sep 17 00:00:00 2001
|
||||
From: Yves Orton <demerphq@gmail.com>
|
||||
Date: Tue, 13 Sep 2016 23:14:49 +0200
|
||||
Subject: [PATCH 4/5] fix #129267: rework gv_fetchmethod_pvn_flags separator
|
||||
parsing
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
With previous code we could overrun the end of the name when
|
||||
the last char in the string was a colon. This reworks the code
|
||||
so it is more clear what is going on, and so it more similar
|
||||
to other code that also parses out package separaters in gv.c.
|
||||
|
||||
This is a rework of the reverted patches:
|
||||
243ca72 rename "nend" name_cursor in Perl_gv_fetchmethod_pvn_flags
|
||||
b053c93 fix: [perl #129267] Possible string overrun with invalid len in gv.c
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
gv.c | 36 ++++++++++++++++++++++++++----------
|
||||
1 file changed, 26 insertions(+), 10 deletions(-)
|
||||
|
||||
diff --git a/gv.c b/gv.c
|
||||
index 07709a0..3237c53 100644
|
||||
--- a/gv.c
|
||||
+++ b/gv.c
|
||||
@@ -1010,7 +1010,6 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
|
||||
{
|
||||
const char * const origname = name;
|
||||
const char * const name_end = name + len;
|
||||
- const char *nend;
|
||||
const char *last_separator = NULL;
|
||||
GV* gv;
|
||||
HV* ostash = stash;
|
||||
@@ -1029,16 +1028,33 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
|
||||
the error reporting code. */
|
||||
}
|
||||
|
||||
- for (nend = name; *nend || nend != name_end; nend++) {
|
||||
- if (*nend == '\'') {
|
||||
- last_separator = nend;
|
||||
- name = nend + 1;
|
||||
- }
|
||||
- else if (*nend == ':' && *(nend + 1) == ':') {
|
||||
- last_separator = nend++;
|
||||
- name = nend + 1;
|
||||
- }
|
||||
+ {
|
||||
+ /* check if the method name is fully qualified or
|
||||
+ * not, and separate the package name from the actual
|
||||
+ * method name.
|
||||
+ *
|
||||
+ * leaves last_separator pointing to the beginning of the
|
||||
+ * last package separator (either ' or ::) or 0
|
||||
+ * if none was found.
|
||||
+ *
|
||||
+ * leaves name pointing at the beginning of the
|
||||
+ * method name.
|
||||
+ */
|
||||
+ const char *name_cursor = name;
|
||||
+ const char * const name_em1 = name_end - 1; /* name_end minus 1 */
|
||||
+ for (name_cursor = name; name_cursor < name_end ; name_cursor++) {
|
||||
+ if (*name_cursor == '\'') {
|
||||
+ last_separator = name_cursor;
|
||||
+ name = name_cursor + 1;
|
||||
+ }
|
||||
+ else if (name_cursor < name_em1 && *name_cursor == ':' && name_cursor[1] == ':') {
|
||||
+ last_separator = name_cursor++;
|
||||
+ name = name_cursor + 1;
|
||||
+ }
|
||||
+ }
|
||||
}
|
||||
+
|
||||
+ /* did we find a separator? */
|
||||
if (last_separator) {
|
||||
if ((last_separator - origname) == 5 && memEQ(origname, "SUPER", 5)) {
|
||||
/* ->SUPER::method should really be looked up in original stash */
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
From 9bde56224e82f20e7a65b3469b1ffb6b9f6d4df8 Mon Sep 17 00:00:00 2001
|
||||
From: Father Chrysostomos <sprout@cpan.org>
|
||||
Date: Sun, 4 Sep 2016 20:24:19 -0700
|
||||
Subject: [PATCH] =?UTF-8?q?[perl=20#129196]=20Crash/bad=20read=20with=20?=
|
||||
=?UTF-8?q?=E2=80=98evalbytes=20S=E2=80=99?=
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
5dc13276 added some code to toke.c that did not take into account
|
||||
that the opnum (‘f’) argument to UNI* could be a negated op number.
|
||||
PL_last_lop_op must never be negative, since it is used as an offset
|
||||
into a struct.
|
||||
|
||||
Tests for the crash will come in the next commit.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
toke.c | 2 +-
|
||||
1 file changed, 1 insertion(+), 1 deletion(-)
|
||||
|
||||
diff --git a/toke.c b/toke.c
|
||||
index 2fe8b69..2350703 100644
|
||||
--- a/toke.c
|
||||
+++ b/toke.c
|
||||
@@ -241,7 +241,7 @@ static const char* const lex_state_names[] = {
|
||||
if (have_x) PL_expect = x; \
|
||||
PL_bufptr = s; \
|
||||
PL_last_uni = PL_oldbufptr; \
|
||||
- PL_last_lop_op = f; \
|
||||
+ PL_last_lop_op = f < 0 ? -f : f; \
|
||||
if (*s == '(') \
|
||||
return REPORT( (int)FUNC1 ); \
|
||||
s = skipspace(s); \
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,44 @@
|
|||
From 1665b718d8fbd58705dbe6376fa51f8c1a02d887 Mon Sep 17 00:00:00 2001
|
||||
From: Father Chrysostomos <sprout@cpan.org>
|
||||
Date: Tue, 13 Sep 2016 22:38:59 -0700
|
||||
Subject: [PATCH 5/5] [perl #129267] Test for gv_fetchmethod buffer overrun
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
ext/XS-APItest/APItest.xs | 3 +++
|
||||
ext/XS-APItest/t/gv_fetchmethod_flags.t | 5 +++++
|
||||
2 files changed, 8 insertions(+)
|
||||
|
||||
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
|
||||
index 992b6a5..4602cee 100644
|
||||
--- a/ext/XS-APItest/APItest.xs
|
||||
+++ b/ext/XS-APItest/APItest.xs
|
||||
@@ -2571,6 +2571,9 @@ gv_fetchmethod_flags_type(stash, methname, type, flags)
|
||||
gv = gv_fetchmethod_pvn_flags(stash, name, len, flags | SvUTF8(methname));
|
||||
break;
|
||||
}
|
||||
+ case 4:
|
||||
+ gv = gv_fetchmethod_pvn_flags(stash, SvPV_nolen(methname),
|
||||
+ flags, SvUTF8(methname));
|
||||
}
|
||||
XPUSHs( gv ? (SV*)gv : &PL_sv_undef);
|
||||
|
||||
diff --git a/ext/XS-APItest/t/gv_fetchmethod_flags.t b/ext/XS-APItest/t/gv_fetchmethod_flags.t
|
||||
index 15d1c41..2da3b70 100644
|
||||
--- a/ext/XS-APItest/t/gv_fetchmethod_flags.t
|
||||
+++ b/ext/XS-APItest/t/gv_fetchmethod_flags.t
|
||||
@@ -49,3 +49,8 @@ is XS::APItest::gv_fetchmethod_flags_type(\%::, "method\0not quite!", 2, 0), "*m
|
||||
}
|
||||
}
|
||||
}
|
||||
+
|
||||
+# [perl #129267] Buffer overrun when argument name ends with colon and
|
||||
+# there is a colon past the end. This used to segv.
|
||||
+XS::APItest::gv_fetchmethod_flags_type(\%::, "method:::::", 4, 7);
|
||||
+ # With type 4, 7 is the length
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,46 @@
|
|||
From 0af40c757f083cc12988effb46da5313cd042f00 Mon Sep 17 00:00:00 2001
|
||||
From: David Mitchell <davem@iabyn.com>
|
||||
Date: Mon, 5 Sep 2016 15:49:28 +0100
|
||||
Subject: [PATCH] toke.c: fix mswin32 builds
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
9bde56224 added this as part of macro:
|
||||
|
||||
- PL_last_lop_op = f; \
|
||||
+ PL_last_lop_op = f < 0 ? -f : f; \
|
||||
|
||||
which broke win32 builds due to this
|
||||
|
||||
UNIBRACK(-OP_ENTEREVAL)
|
||||
|
||||
expanding to
|
||||
|
||||
PL_last_lop_op = -345 < 0 ? --345 : -345
|
||||
|
||||
and the -- being seen as a pre-dec op.
|
||||
|
||||
Diagnosed by Dagfinn Ilmari Mannsåker.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
toke.c | 2 +-
|
||||
1 file changed, 1 insertion(+), 1 deletion(-)
|
||||
|
||||
diff --git a/toke.c b/toke.c
|
||||
index 2350703..a1cdda8 100644
|
||||
--- a/toke.c
|
||||
+++ b/toke.c
|
||||
@@ -241,7 +241,7 @@ static const char* const lex_state_names[] = {
|
||||
if (have_x) PL_expect = x; \
|
||||
PL_bufptr = s; \
|
||||
PL_last_uni = PL_oldbufptr; \
|
||||
- PL_last_lop_op = f < 0 ? -f : f; \
|
||||
+ PL_last_lop_op = (f) < 0 ? -(f) : (f); \
|
||||
if (*s == '(') \
|
||||
return REPORT( (int)FUNC1 ); \
|
||||
s = skipspace(s); \
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,32 @@
|
|||
From 9ce5bf4c39e28441410672f39b5ee1c4569967f8 Mon Sep 17 00:00:00 2001
|
||||
From: Hugo van der Sanden <hv@crypt.org>
|
||||
Date: Fri, 28 Oct 2016 13:27:23 +0100
|
||||
Subject: [PATCH] [perl #130001] h2xs: avoid infinite loop for enums
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
'typedef enum x { ... } x' causes h2xs to enter a substitution loop while
|
||||
trying to write the typemap file.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
utils/h2xs.PL | 2 +-
|
||||
1 file changed, 1 insertion(+), 1 deletion(-)
|
||||
|
||||
diff --git a/utils/h2xs.PL b/utils/h2xs.PL
|
||||
index 8fda87b..f9063cb 100644
|
||||
--- a/utils/h2xs.PL
|
||||
+++ b/utils/h2xs.PL
|
||||
@@ -1034,7 +1034,7 @@ if( ! $opt_X ){ # use XS, unless it was disabled
|
||||
}
|
||||
}
|
||||
{ local $" = '|';
|
||||
- $typedef_rex = qr(\b(?<!struct )(?:@good_td)\b) if @good_td;
|
||||
+ $typedef_rex = qr(\b(?<!struct )(?<!enum )(?:@good_td)\b) if @good_td;
|
||||
}
|
||||
%known_fnames = map @$_[1,3], @$fdecls_parsed; # [1,3] is NAME, FULLTEXT
|
||||
if ($fmask) {
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,61 @@
|
|||
From fecd3be8dbdb747b9cbf4cbb9299ce40faabc8e6 Mon Sep 17 00:00:00 2001
|
||||
From: John Lightsey <lightsey@debian.org>
|
||||
Date: Mon, 14 Nov 2016 11:56:15 +0100
|
||||
Subject: [PATCH] Fix Storable segfaults.
|
||||
|
||||
Fix a null pointed dereference segfault in storable when the
|
||||
retrieve_code logic was unable to read the string that contained
|
||||
the code.
|
||||
|
||||
Also fix several locations where retrieve_other was called with a
|
||||
null context pointer. This also resulted in a null pointer
|
||||
dereference.
|
||||
---
|
||||
dist/Storable/Storable.xs | 10 +++++++---
|
||||
1 file changed, 7 insertions(+), 3 deletions(-)
|
||||
|
||||
diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs
|
||||
index 053951c..caa489c 100644
|
||||
--- a/dist/Storable/Storable.xs
|
||||
+++ b/dist/Storable/Storable.xs
|
||||
@@ -5647,6 +5647,10 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname)
|
||||
CROAK(("Unexpected type %d in retrieve_code\n", type));
|
||||
}
|
||||
|
||||
+ if (!text) {
|
||||
+ CROAK(("Unable to retrieve code\n"));
|
||||
+ }
|
||||
+
|
||||
/*
|
||||
* prepend "sub " to the source
|
||||
*/
|
||||
@@ -5767,7 +5771,7 @@ static SV *old_retrieve_array(pTHX_ stcxt_t *cxt, const char *cname)
|
||||
continue; /* av_extend() already filled us with undef */
|
||||
}
|
||||
if (c != SX_ITEM)
|
||||
- (void) retrieve_other(aTHX_ (stcxt_t *) 0, 0); /* Will croak out */
|
||||
+ (void) retrieve_other(aTHX_ cxt, 0); /* Will croak out */
|
||||
TRACEME(("(#%d) item", i));
|
||||
sv = retrieve(aTHX_ cxt, 0); /* Retrieve item */
|
||||
if (!sv)
|
||||
@@ -5844,7 +5848,7 @@ static SV *old_retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname)
|
||||
if (!sv)
|
||||
return (SV *) 0;
|
||||
} else
|
||||
- (void) retrieve_other(aTHX_ (stcxt_t *) 0, 0); /* Will croak out */
|
||||
+ (void) retrieve_other(aTHX_ cxt, 0); /* Will croak out */
|
||||
|
||||
/*
|
||||
* Get key.
|
||||
@@ -5855,7 +5859,7 @@ static SV *old_retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname)
|
||||
|
||||
GETMARK(c);
|
||||
if (c != SX_KEY)
|
||||
- (void) retrieve_other(aTHX_ (stcxt_t *) 0, 0); /* Will croak out */
|
||||
+ (void) retrieve_other(aTHX_ cxt, 0); /* Will croak out */
|
||||
RLEN(size); /* Get key size */
|
||||
KBUFCHK((STRLEN)size); /* Grow hash key read pool if needed */
|
||||
if (size)
|
||||
--
|
||||
2.10.2
|
||||
|
|
@ -0,0 +1,58 @@
|
|||
From bf4a926a29374161655548b149d1cb37300bcc05 Mon Sep 17 00:00:00 2001
|
||||
From: Tony Cook <tony@develop-help.com>
|
||||
Date: Wed, 7 Sep 2016 16:51:39 +1000
|
||||
Subject: [PATCH] (perl #129149) avoid a heap buffer overflow with pack "W"...
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
pp_pack.c | 2 +-
|
||||
t/op/pack.t | 13 ++++++++++++-
|
||||
2 files changed, 13 insertions(+), 2 deletions(-)
|
||||
|
||||
diff --git a/pp_pack.c b/pp_pack.c
|
||||
index ee4c69e..737e019 100644
|
||||
--- a/pp_pack.c
|
||||
+++ b/pp_pack.c
|
||||
@@ -2587,7 +2587,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
|
||||
if (in_bytes) auv = auv % 0x100;
|
||||
if (utf8) {
|
||||
W_utf8:
|
||||
- if (cur > end) {
|
||||
+ if (cur >= end) {
|
||||
*cur = '\0';
|
||||
SvCUR_set(cat, cur - start);
|
||||
|
||||
diff --git a/t/op/pack.t b/t/op/pack.t
|
||||
index 3fc12e4..47d1216 100644
|
||||
--- a/t/op/pack.t
|
||||
+++ b/t/op/pack.t
|
||||
@@ -12,7 +12,7 @@ my $no_endianness = $] > 5.009 ? '' :
|
||||
my $no_signedness = $] > 5.009 ? '' :
|
||||
"Signed/unsigned pack modifiers not available on this perl";
|
||||
|
||||
-plan tests => 14712;
|
||||
+plan tests => 14713;
|
||||
|
||||
use strict;
|
||||
use warnings qw(FATAL all);
|
||||
@@ -2047,3 +2047,14 @@ ok(1, "argument underflow did not crash");
|
||||
is(pack("H40", $up_nul), $twenty_nuls,
|
||||
"check pack H zero fills (utf8 source)");
|
||||
}
|
||||
+
|
||||
+{
|
||||
+ # [perl #129149] the code below would write one past the end of the output
|
||||
+ # buffer, only detected by ASAN, not by valgrind
|
||||
+ $Config{ivsize} >= 8
|
||||
+ or skip "[perl #129149] need 64-bit for this test", 1;
|
||||
+ fresh_perl_is(<<'EOS', "ok\n", { stderr => 1 }, "pack W overflow");
|
||||
+print pack("ucW", "0000", 0, 140737488355327) eq "\$,#`P,```\n\0\x{7fffffffffff}"
|
||||
+ ? "ok\n" : "not ok\n";
|
||||
+EOS
|
||||
+}
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,30 @@
|
|||
From 30be69c851a7fa7e29d85c9b6e070273df82f3e7 Mon Sep 17 00:00:00 2001
|
||||
From: Tony Cook <tony@develop-help.com>
|
||||
Date: Tue, 17 Jan 2017 15:36:31 +1100
|
||||
Subject: [PATCH] (perl #129149) fix the test so skip has a SKIP: to work with
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Thanks to bulk88 for pointing this out.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
t/op/pack.t | 1 +
|
||||
1 file changed, 1 insertion(+)
|
||||
|
||||
diff --git a/t/op/pack.t b/t/op/pack.t
|
||||
index 47d1216..919e4c5 100644
|
||||
--- a/t/op/pack.t
|
||||
+++ b/t/op/pack.t
|
||||
@@ -2048,6 +2048,7 @@ ok(1, "argument underflow did not crash");
|
||||
"check pack H zero fills (utf8 source)");
|
||||
}
|
||||
|
||||
+SKIP:
|
||||
{
|
||||
# [perl #129149] the code below would write one past the end of the output
|
||||
# buffer, only detected by ASAN, not by valgrind
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,69 @@
|
|||
From 42e9b60980bb8e29e76629e14c6aa945194c0647 Mon Sep 17 00:00:00 2001
|
||||
From: Hugo van der Sanden <hv@crypt.org>
|
||||
Date: Wed, 5 Oct 2016 02:20:26 +0100
|
||||
Subject: [PATCH] [perl #129061] CURLYX nodes can be studied more than once
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
study_chunk() for CURLYX is used to set flags on the linked WHILEM
|
||||
node to say it is the whilem_c'th of whilem_seen. However it assumes
|
||||
each CURLYX can be studied only once, which is not the case - there
|
||||
are various cases such as GOSUB which call study_chunk() recursively
|
||||
on already-visited parts of the program.
|
||||
|
||||
Storing the wrong index can cause the super-linear cache handling in
|
||||
regmatch() to read/write the byte after the end of poscache.
|
||||
|
||||
Also reported in [perl #129281].
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
regcomp.c | 12 +++++++++---
|
||||
t/re/pat.t | 1 -
|
||||
2 files changed, 9 insertions(+), 4 deletions(-)
|
||||
|
||||
diff --git a/regcomp.c b/regcomp.c
|
||||
index 850a6c1..48c8d8d 100644
|
||||
--- a/regcomp.c
|
||||
+++ b/regcomp.c
|
||||
@@ -5218,15 +5218,21 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
|
||||
However, this time it's not a subexpression
|
||||
we care about, but the expression itself. */
|
||||
&& (maxcount == REG_INFTY)
|
||||
- && data && ++data->whilem_c < 16) {
|
||||
+ && data) {
|
||||
/* This stays as CURLYX, we can put the count/of pair. */
|
||||
/* Find WHILEM (as in regexec.c) */
|
||||
regnode *nxt = oscan + NEXT_OFF(oscan);
|
||||
|
||||
if (OP(PREVOPER(nxt)) == NOTHING) /* LONGJMP */
|
||||
nxt += ARG(nxt);
|
||||
- PREVOPER(nxt)->flags = (U8)(data->whilem_c
|
||||
- | (RExC_whilem_seen << 4)); /* On WHILEM */
|
||||
+ nxt = PREVOPER(nxt);
|
||||
+ if (nxt->flags & 0xf) {
|
||||
+ /* we've already set whilem count on this node */
|
||||
+ } else if (++data->whilem_c < 16) {
|
||||
+ assert(data->whilem_c <= RExC_whilem_seen);
|
||||
+ nxt->flags = (U8)(data->whilem_c
|
||||
+ | (RExC_whilem_seen << 4)); /* On WHILEM */
|
||||
+ }
|
||||
}
|
||||
if (data && fl & (SF_HAS_PAR|SF_IN_PAR))
|
||||
pars++;
|
||||
diff --git a/t/re/pat.t b/t/re/pat.t
|
||||
index ecd3af1..16bfc8e 100644
|
||||
--- a/t/re/pat.t
|
||||
+++ b/t/re/pat.t
|
||||
@@ -1909,7 +1909,6 @@ EOP
|
||||
}
|
||||
{
|
||||
# [perl #129281] buffer write overflow, detected by ASAN, valgrind
|
||||
- local $::TODO = "whilem_c bumped too much";
|
||||
fresh_perl_is('/0(?0)|^*0(?0)|^*(^*())0|/', '', {}, "don't bump whilem_c too much");
|
||||
}
|
||||
} # End of sub run_tests
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,34 @@
|
|||
From 923e23bad0514e1bd29112650fb78aa4ea69e1b7 Mon Sep 17 00:00:00 2001
|
||||
From: Yves Orton <demerphq@gmail.com>
|
||||
Date: Sat, 28 Jan 2017 15:13:17 +0100
|
||||
Subject: [PATCH] silence warnings from tests about impossible quantifiers
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
thanks to Dave M for noticing....
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
t/re/pat_rt_report.t | 3 ++-
|
||||
1 file changed, 2 insertions(+), 1 deletion(-)
|
||||
|
||||
diff --git a/t/re/pat_rt_report.t b/t/re/pat_rt_report.t
|
||||
index 21aff58..dd740e7 100644
|
||||
--- a/t/re/pat_rt_report.t
|
||||
+++ b/t/re/pat_rt_report.t
|
||||
@@ -1134,9 +1134,10 @@ EOP
|
||||
{
|
||||
# rt
|
||||
fresh_perl_is(
|
||||
- '"foo"=~/((?1)){8,0}/; print "ok"',
|
||||
+ 'no warnings "regexp"; "foo"=~/((?1)){8,0}/; print "ok"',
|
||||
"ok", {}, 'RT #130561 - allowing impossible quantifier should not cause SEGVs');
|
||||
my $s= "foo";
|
||||
+ no warnings 'regexp';
|
||||
ok($s=~/(foo){1,0}|(?1)/,
|
||||
"RT #130561 - allowing impossible quantifier should not break recursion");
|
||||
}
|
||||
--
|
||||
2.7.4
|
||||
|
|
@ -0,0 +1,33 @@
|
|||
From 2c2da8e7f0f6325fab643997a536072633fa0cf8 Mon Sep 17 00:00:00 2001
|
||||
From: Yves Orton <demerphq@gmail.com>
|
||||
Date: Thu, 1 Jun 2017 14:51:44 +0200
|
||||
Subject: [PATCH] Fix #131190 - UTF8 code improperly casting negative integer
|
||||
to U8 in comparison
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
This reverts commit b4972372a75776de3c9e6bd234a398d103677316,
|
||||
effectively restoring commit ca7eb79a236b41b7722c6800527f95cd76843eed,
|
||||
and commit 85fde2b7c3f5631fd982f5db735b84dc9224bec0.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
regexec.c | 1 +
|
||||
1 file changed, 1 insertion(+)
|
||||
|
||||
diff --git a/regexec.c b/regexec.c
|
||||
index 82128a7..35b88d7 100644
|
||||
--- a/regexec.c
|
||||
+++ b/regexec.c
|
||||
@@ -5593,6 +5593,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
|
||||
if (scan->flags == EXACTL || scan->flags == EXACTFLU8) {
|
||||
_CHECK_AND_WARN_PROBLEMATIC_LOCALE;
|
||||
if (utf8_target
|
||||
+ && nextchr >= 0 /* guard against negative EOS value in nextchr */
|
||||
&& UTF8_IS_ABOVE_LATIN1(nextchr)
|
||||
&& scan->flags == EXACTL)
|
||||
{
|
||||
--
|
||||
2.9.4
|
||||
|
|
@ -0,0 +1,32 @@
|
|||
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
|
||||
|
|
@ -0,0 +1,71 @@
|
|||
From 7b3443d31f11c15859593e5b710c301795a6de01 Mon Sep 17 00:00:00 2001
|
||||
From: Tony Cook <tony@develop-help.com>
|
||||
Date: Thu, 8 Jun 2017 11:06:39 +1000
|
||||
Subject: [PATCH] [perl #131221] sv_dup/sv_dup_inc are only available under
|
||||
threads
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
ext/PerlIO-via/via.xs | 42 +++++++++++++++++++++++-------------------
|
||||
1 file changed, 23 insertions(+), 19 deletions(-)
|
||||
|
||||
diff --git a/ext/PerlIO-via/via.xs b/ext/PerlIO-via/via.xs
|
||||
index 61953c8..d91c685 100644
|
||||
--- a/ext/PerlIO-via/via.xs
|
||||
+++ b/ext/PerlIO-via/via.xs
|
||||
@@ -619,26 +619,30 @@ static PerlIO *
|
||||
PerlIOVia_dup(pTHX_ PerlIO * f, PerlIO * o, CLONE_PARAMS * param,
|
||||
int flags)
|
||||
{
|
||||
- if ((f = PerlIOBase_dup(aTHX_ f, o, param, flags)) && param) {
|
||||
- /* For a non-interpreter dup stash and obj have been set up
|
||||
- by the implied push.
|
||||
-
|
||||
- But if this is a clone for a new interpreter we need to
|
||||
- translate the objects to their dups.
|
||||
- */
|
||||
-
|
||||
- PerlIOVia *fs = PerlIOSelf(f, PerlIOVia);
|
||||
- PerlIOVia *os = PerlIOSelf(o, PerlIOVia);
|
||||
-
|
||||
- fs->obj = sv_dup_inc(os->obj, param);
|
||||
- fs->stash = (HV*)sv_dup((SV*)os->stash, param);
|
||||
- fs->var = sv_dup_inc(os->var, param);
|
||||
- fs->cnt = os->cnt;
|
||||
-
|
||||
- /* fh, io, cached CVs left as NULL, PerlIOVia_method()
|
||||
- will reinitialize them if needed */
|
||||
+ if ((f = PerlIOBase_dup(aTHX_ f, o, param, flags))) {
|
||||
+#ifdef USE_ITHREADS
|
||||
+ if (param) {
|
||||
+ /* For a non-interpreter dup stash and obj have been set up
|
||||
+ by the implied push.
|
||||
+
|
||||
+ But if this is a clone for a new interpreter we need to
|
||||
+ translate the objects to their dups.
|
||||
+ */
|
||||
+
|
||||
+ PerlIOVia *fs = PerlIOSelf(f, PerlIOVia);
|
||||
+ PerlIOVia *os = PerlIOSelf(o, PerlIOVia);
|
||||
+
|
||||
+ fs->obj = sv_dup_inc(os->obj, param);
|
||||
+ fs->stash = (HV*)sv_dup((SV*)os->stash, param);
|
||||
+ fs->var = sv_dup_inc(os->var, param);
|
||||
+ fs->cnt = os->cnt;
|
||||
+
|
||||
+ /* fh, io, cached CVs left as NULL, PerlIOVia_method()
|
||||
+ will reinitialize them if needed */
|
||||
+ }
|
||||
+#endif
|
||||
+ /* for a non-threaded dup fs->obj and stash should be set by _pushed() */
|
||||
}
|
||||
- /* for a non-threaded dup fs->obj and stash should be set by _pushed() */
|
||||
|
||||
return f;
|
||||
}
|
||||
--
|
||||
2.9.4
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
From 9604fbf0722bd97ca6031a263c50ad52b6633db7 Mon Sep 17 00:00:00 2001
|
||||
From: Tony Cook <tony@develop-help.com>
|
||||
Date: Wed, 14 Jun 2017 09:42:31 +1000
|
||||
Subject: [PATCH] (perl #131526) don't go beyond the end of the NUL in my_atof2
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Perl_my_atof2() calls GROK_NUMERIC_RADIX() to detect and skip past
|
||||
a decimal point and then can increment the parse pointer (s) before
|
||||
checking what it points at, so skipping the terminating NUL if the
|
||||
decimal point is immediately before the NUL.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
numeric.c | 4 ++--
|
||||
1 file changed, 2 insertions(+), 2 deletions(-)
|
||||
|
||||
diff --git a/numeric.c b/numeric.c
|
||||
index 6ea6968..5771907 100644
|
||||
--- a/numeric.c
|
||||
+++ b/numeric.c
|
||||
@@ -1485,9 +1485,9 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value)
|
||||
else if (!seen_dp && GROK_NUMERIC_RADIX(&s, send)) {
|
||||
seen_dp = 1;
|
||||
if (sig_digits > MAX_SIG_DIGITS) {
|
||||
- do {
|
||||
+ while (isDIGIT(*s)) {
|
||||
++s;
|
||||
- } while (isDIGIT(*s));
|
||||
+ }
|
||||
break;
|
||||
}
|
||||
}
|
||||
--
|
||||
2.9.4
|
||||
|
410
perl.spec
410
perl.spec
|
@ -1,4 +1,4 @@
|
|||
%global perl_version 5.22.1
|
||||
%global perl_version 5.22.4
|
||||
%global perl_epoch 4
|
||||
%global perl_arch_stem -thread-multi
|
||||
%global perl_archname %{_arch}-%{_os}%{perl_arch_stem}
|
||||
|
@ -29,7 +29,7 @@
|
|||
Name: perl
|
||||
Version: %{perl_version}
|
||||
# release number must be even higher, because dual-lived modules will be broken otherwise
|
||||
Release: 358%{?dist}
|
||||
Release: 372%{?dist}
|
||||
Epoch: %{perl_epoch}
|
||||
Summary: Practical Extraction and Report Language
|
||||
Group: Development/Languages
|
||||
|
@ -84,17 +84,184 @@ Patch22: perl-5.18.1-Document-Math-BigInt-CalcEmu-requires-Math-BigInt.pa
|
|||
# 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
|
||||
|
||||
# Make PadlistNAMES() lvalue again, bug #1231165, CPAN RT#101063,
|
||||
# in upstream after 5.22.0
|
||||
Patch27: perl-5.22.0-make-PadlistNAMES-lvalue-again.patch
|
||||
|
||||
# Workaround for Coro, bug #1231165, CPAN RT#101063. To remove in the future.
|
||||
Patch28: perl-5.22.0-Revert-const-the-core-magic-vtables.patch
|
||||
|
||||
# Fix CVE-2016-2381 (ambiguous environment variables handling), bug #1313702,
|
||||
# in upstream after 5.23.8
|
||||
Patch29: perl-5.23.8-remove-duplicate-environment-variables-from-environ.patch
|
||||
# Fix duplicating PerlIO::encoding when spawning threads, bug #1345788,
|
||||
# RT#31923, in upstream after 5.23.3
|
||||
Patch29: perl-5.23.3-Properly-duplicate-PerlIO-encoding-objects.patch
|
||||
|
||||
# Fix a crash in lexical scope warnings, RT#128597, in upstream after 5.25.2
|
||||
Patch32: perl-5.22.2-perl-128597-Crash-from-gp_free-ckWARN_d.patch
|
||||
|
||||
# Do not mangle errno from failed socket calls, RT#128316,
|
||||
# in upstream after 5.25.1
|
||||
Patch33: perl-5.25.1-perl-128316-preserve-errno-from-failed-system-calls.patch
|
||||
|
||||
# Fix crash in "evalbytes S", RT#129196, in upstream after 5.25.4
|
||||
Patch34: perl-5.25.4-perl-129196-Crash-bad-read-with-evalbytes-S.patch
|
||||
Patch35: perl-5.24.0-Regression-test-for-RT-129196.patch
|
||||
Patch36: perl-5.25.4-toke.c-fix-mswin32-builds.patch
|
||||
|
||||
# Fix crash in splice, RT#129164, RT#129166, RT#129167, in upstream after 5.25.4
|
||||
Patch37: perl-5.22.2-perl-129164-Crash-with-splice.patch
|
||||
|
||||
# Fix string overrun in Perl_gv_fetchmethod_pvn_flags, RT#129267,
|
||||
# in upstream after 5.25.4
|
||||
Patch38: perl-5.24.0-clean-up-gv_fetchmethod_pvn_flags-introduce-name_end.patch
|
||||
Patch39: perl-5.25.4-clean-up-gv_fetchmethod_pvn_flags-move-origname-init.patch
|
||||
Patch40: perl-5.25.4-clean-up-gv_fetchmethod_pvn_flags-rename-nsplit-to-l.patch
|
||||
Patch41: perl-5.25.4-fix-129267-rework-gv_fetchmethod_pvn_flags-separator.patch
|
||||
Patch42: perl-5.25.4-perl-129267-Test-for-gv_fetchmethod-buffer-overrun.patch
|
||||
|
||||
# Fix crash when matching UTF-8 string with non-UTF-8 substrings, RT#129350,
|
||||
# in upstream after 5.25.5
|
||||
Patch43: perl-5.22.2-perl-129350-anchored-floating-substrings-must-be-utf.patch
|
||||
|
||||
# Fix parsing perl options in shell bang line, RT#129336,
|
||||
# in upstream after 5.25.5
|
||||
Patch44: perl-5.24.0-rt-129336-perl-i-u-erroneously-interpreted-as-u.patch
|
||||
|
||||
# Fix firstchar bitmap under UTF-8 with prefix optimization, RT#129950,
|
||||
# in upstream after 5.25.6
|
||||
Patch45: perl-5.22.2-regcomp.c-fix-perl-129950-fix-firstchar-bitmap-under.patch
|
||||
|
||||
# Avoid infinite loop in h2xs tool if enum and type have the same name,
|
||||
# RT#130001, in upstream after 5.25.6
|
||||
Patch46: perl-5.25.6-perl-130001-h2xs-avoid-infinite-loop-for-enums.patch
|
||||
|
||||
# Fix stack handling when calling chdir without an argument, RT#129130,
|
||||
# in upstream after 5.25.6
|
||||
Patch47: perl-5.22.2-perl-129130-make-chdir-allocate-the-stack-it-needs.patch
|
||||
|
||||
# Fix crash in Storable when deserializing malformed code reference, RT#68348,
|
||||
# RT130098
|
||||
Patch48: perl-5.25.7-Fix-Storable-segfaults.patch
|
||||
|
||||
# Fix assigning split() return values to an array, in upstream after 5.25.7
|
||||
Patch49: perl-5.24.0-split-was-leaving-PL_sv_undef-in-unused-ary-slots.patch
|
||||
|
||||
# Fix const correctness in hv_func.h, bug #1242980, RT#130169,
|
||||
# in upstream after 5.25.7
|
||||
Patch50: perl-5.22.2-Fix-const-correctness-in-hv_func.h.patch
|
||||
|
||||
# Fix a crash in optimized evaluation of "or ((0) x 0))", RT#130247,
|
||||
# in upsream after 5.25.7
|
||||
Patch51: perl-5.22.2-assertion-failure-in-.-or-0-x-0.patch
|
||||
|
||||
# Fix a memory leak in IO::Poll, RT#129788, in upstream after 5.25.7
|
||||
Patch52: perl-5.22.2-perl-129788-IO-Poll-fix-memory-leak.patch
|
||||
|
||||
# Fix regular expression matching, RT#130307, in upstream after 5.25.7
|
||||
Patch53: perl-5.22.2-perl-130307-Correctly-unwind-on-cache-hit.patch
|
||||
|
||||
# Fix a buffer overflow in split in scalar context, RT#130262,
|
||||
# in upstream after 5.25.8
|
||||
Patch54: perl-5.24.1-perl-130262-split-scalar-context-stack-overflow-fix.patch
|
||||
|
||||
# Fix a heap overflow with pack "W", RT129149, in upstream after 5.25.8
|
||||
Patch55: perl-5.25.8-perl-129149-avoid-a-heap-buffer-overflow-with-pack-W.patch
|
||||
Patch56: perl-5.25.8-perl-129149-fix-the-test-so-skip-has-a-SKIP-to-work-.patch
|
||||
|
||||
# Fix a use-after-free when processing scalar variables in forms, RT#129125,
|
||||
# in upstream after 5.25.8
|
||||
Patch57: perl-5.24.1-perl-129125-copy-form-data-if-it-might-be-freed.patch
|
||||
|
||||
# Fix a heap overflow if invalid octal or hexadecimal number is used in
|
||||
# transliteration expression, RT#129342, in upstream after 5.25.8
|
||||
Patch58: perl-5.24.1-perl-129342-ensure-range-start-is-set-after-error-in.patch
|
||||
|
||||
# Fix out-of-bound read in case of unmatched regexp backreference, RT#129377,
|
||||
# in upstream after 5.25.8
|
||||
Patch59: perl-5.22.3-perl-129377-don-t-read-past-start-of-string-for-unma.patch
|
||||
|
||||
# Fix UTF-8 string handling in & operator, RT#129287, in upstream after 5.25.4
|
||||
Patch60: perl-5.22.3-perl-129287-Make-UTF8-append-null.patch
|
||||
|
||||
# Fix recreation of *::, RT#129869, in upstream after 5.25.9
|
||||
Patch61: perl-5.22.3-fix-special-case-recreation-of.patch
|
||||
|
||||
# Fix parsing goto statements in multicalled subroutine, RT#113938,
|
||||
# in upstream after 5.25.9
|
||||
Patch62: perl-5.22.3-permit-goto-at-top-level-of-multicalled-sub.patch
|
||||
|
||||
# Fix a heap overlow in parsing $#, RT#129274, in upstream after 5.25.9
|
||||
Patch63: perl-5.22.3-perl-129274-avoid-treating-the-in-as-a-comment-intro.patch
|
||||
|
||||
# Fix a crash when compiling a regexp with impossible quantifiers, RT#130561,
|
||||
# in upstream after 5.25.9
|
||||
Patch64: perl-5.22.3-fix-RT-130561-recursion-and-optimising-away-impossib.patch
|
||||
Patch65: perl-5.22.3-only-mess-with-NEXT_OFF-when-we-are-in-PASS2.patch
|
||||
Patch66: perl-5.25.9-silence-warnings-from-tests-about-impossible-quantif.patch
|
||||
|
||||
# Fix a buffer overrun with format and "use bytes", RT#130703,
|
||||
# in upstream after 5.25.9
|
||||
Patch67: perl-5.24.1-buffer-overrun-with-format-and-use-bytes.patch
|
||||
|
||||
# Fix a buffer overflow when studying some regexps repeatedly,
|
||||
# RT#129281, RT#129061, un upstream after 5.25.9
|
||||
Patch68: perl-5.22.3-perl-129281-test-for-buffer-overflow-issue.patch
|
||||
Patch69: perl-5.25.9-perl-129061-CURLYX-nodes-can-be-studied-more-than-on.patch
|
||||
|
||||
# Fix a null-pointer dereference on malformed code, RT#130815,
|
||||
# in upstream after 5.25.9
|
||||
Patch70: perl-5.24.1-perl-130815-fix-ck_return-null-pointer-deref-on-malf.patch
|
||||
|
||||
# Fix an use-after-free in substr() that modifies a magic variable, RT#129340,
|
||||
# in upstream after 5.25.9
|
||||
Patch71: perl-5.22.3-perl-129340-copy-the-source-when-inside-the-dest-in-.patch
|
||||
|
||||
# Fix a memory leak leak in Perl_reg_named_buff_fetch(), RT#130822,
|
||||
# in upstream after 5.25.10
|
||||
Patch72: perl-5.22.3-perl-130822-fix-an-AV-leak-in-Perl_reg_named_buff_fe.patch
|
||||
|
||||
# Fix an invalid memory read when parsing a loop variable, RT#130814,
|
||||
# in upstream after 5.25.10
|
||||
Patch73: perl-5.25.10-perl-130814-Add-testcase-and-new-testfile-t-comp-par.patch
|
||||
# in upstream after 5.25.10
|
||||
Patch74: perl-5.22.3-perl-130814-update-pointer-into-PL_linestr-after-loo.patch
|
||||
# in upstream after 5.25.2
|
||||
Patch75: perl-5.25.2-t-test.pl-Add-fresh_perl-function.patch
|
||||
# in upstream after 5.25.10
|
||||
Patch76: perl-5.25.10-fix-VMS-test-fail.patch
|
||||
|
||||
# Fix a heap-use-after-free in four-arguments substr call, RT#130624,
|
||||
# in upstream after 5.25.10
|
||||
Patch77: perl-5.24.1-RT-130624-heap-use-after-free-in-4-arg-substr.patch
|
||||
|
||||
# Make File::Glob more resistant against degenerative matching, RT#131211,
|
||||
# in upstream after 5.27.0
|
||||
Patch78: perl-5.24.1-perl-131211-fixup-File-Glob-degenerate-matching.patch
|
||||
|
||||
# Fix a memory wrap in sv_vcatpvfn_flags(), RT#131260, in upstream after 5.25.12
|
||||
Patch79: perl-5.25.12-avoid-a-memory-wrap-in-sv_vcatpvfn_flags.patch
|
||||
# Tests for avoid-a-memory-wrap-in-sv_vcatpvfn_flags.patch, RT#131260,
|
||||
# in upstream after 5.27.0
|
||||
Patch80: perl-5.24.1-sprintf-add-memory-wrap-tests.patch
|
||||
|
||||
# Fix a crash when calling a subroutine from a stash, RT#131085,
|
||||
# in upstream after 5.27.0
|
||||
Patch81: perl-5.24.1-perl-131085-Crash-with-sub-in-stash.patch
|
||||
|
||||
# Fix an improper cast of a negative integer to an unsigned 8-bit type,
|
||||
# RT#131190, in upstream after 5.27.0
|
||||
Patch82: perl-5.27.0-Fix-131190-UTF8-code-improperly-casting-negative-int.patch
|
||||
|
||||
# Fix cloning :via handles on thread creation, RT#131221,
|
||||
# in upstream after 5.27.0
|
||||
Patch83: perl-5.22.3-perl-131221-improve-duplication-of-via-handles.patch
|
||||
Patch84: perl-5.27.0-perl-131221-sv_dup-sv_dup_inc-are-only-available-und.patch
|
||||
|
||||
# Fix glob UTF-8 flag on a glob reassignment, RT#131263,
|
||||
# in upstream after 5.27.0
|
||||
Patch85: perl-5.24.1-perl-131263-clear-the-UTF8-flag-on-a-glob-if-it-isn-.patch
|
||||
|
||||
# Fix a buffer overflow in my_atof2(), RT#131526, in upstream after 5.27.0
|
||||
Patch86: perl-5.27.0-perl-131526-don-t-go-beyond-the-end-of-the-NUL-in-my.patch
|
||||
|
||||
# Fix handling backslashes in PATH environment variable when executing
|
||||
# "perl -S", RT#129183, in upstream after 5.27.0
|
||||
Patch88: perl-5.27.0-perl-129183-don-t-treat-as-an-escape-in-PATH-for-S.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
|
||||
|
@ -120,7 +287,12 @@ BuildRequires: procps, rsyslog
|
|||
|
||||
|
||||
# compat macro needed for rebuild
|
||||
%global perl_compat perl(:MODULE_COMPAT_5.22.1)
|
||||
%global perl_compat perl(:MODULE_COMPAT_5.22.4)
|
||||
|
||||
# perl-interpreter denotes a package with the perl executable.
|
||||
# Full EVR is for compatibility with systems that swapped perl and perl-core
|
||||
# <https://fedoraproject.org/wiki/Changes/perl_Package_to_Install_Core_Modules>.
|
||||
Provides: perl-interpreter = %{perl_epoch}:%{perl_version}-%{release}
|
||||
|
||||
# File provides
|
||||
Provides: perl(bytes_heavy.pl)
|
||||
|
@ -130,7 +302,7 @@ Provides: perl(perl5db.pl)
|
|||
# suidperl isn't created by upstream since 5.12.0
|
||||
Obsoletes: perl-suidperl <= 4:5.12.2
|
||||
|
||||
Requires: perl-libs = %{perl_epoch}:%{perl_version}-%{release}
|
||||
Requires: perl-libs%{?_isa} = %{perl_epoch}:%{perl_version}-%{release}
|
||||
# Require this till perl sub-package requires any modules
|
||||
Requires: %perl_compat
|
||||
|
||||
|
@ -173,6 +345,9 @@ Group: Development/Languages
|
|||
License: GPL+ or Artistic
|
||||
# Compat provides
|
||||
Provides: %perl_compat
|
||||
Provides: perl(:MODULE_COMPAT_5.22.3)
|
||||
Provides: perl(:MODULE_COMPAT_5.22.2)
|
||||
Provides: perl(:MODULE_COMPAT_5.22.1)
|
||||
Provides: perl(:MODULE_COMPAT_5.22.0)
|
||||
# Interpreter version to fulfil required genersted from "require 5.006;"
|
||||
Provides: perl(:VERSION) = %{perl_version}
|
||||
|
@ -218,7 +393,7 @@ Requires: systemtap-sdt-devel
|
|||
Requires: perl(ExtUtils::ParseXS)
|
||||
Requires: %perl_compat
|
||||
# Match library and header files when downgrading releases
|
||||
Requires: perl-libs = %{perl_epoch}:%{perl_version}-%{release}
|
||||
Requires: perl-libs%{?_isa} = %{perl_epoch}:%{perl_version}-%{release}
|
||||
|
||||
%description devel
|
||||
This package contains header files and development modules.
|
||||
|
@ -282,8 +457,8 @@ License: GPL+ or Artistic
|
|||
Epoch: 0
|
||||
Version: %{perl_version}
|
||||
Requires: %perl_compat
|
||||
Requires: perl-libs = %{perl_epoch}:%{perl_version}-%{release}
|
||||
Requires: perl-devel = %{perl_epoch}:%{perl_version}-%{release}
|
||||
Requires: perl-libs%{?_isa} = %{perl_epoch}:%{perl_version}-%{release}
|
||||
Requires: perl-devel%{?_isa} = %{perl_epoch}:%{perl_version}-%{release}
|
||||
Requires: perl-macros
|
||||
Requires: perl-utils
|
||||
|
||||
|
@ -812,7 +987,7 @@ module can handle all types of input, including partial-byte data.
|
|||
%package Encode
|
||||
Summary: Character encodings in Perl
|
||||
Group: Development/Libraries
|
||||
License: (GPL+ or Artistic) and UCD
|
||||
License: (GPL+ or Artistic) and Artistic 2.0 and UCD
|
||||
Epoch: 3
|
||||
Version: 2.72
|
||||
Requires: %perl_compat
|
||||
|
@ -892,6 +1067,9 @@ License: GPL+ or Artistic
|
|||
Epoch: 0
|
||||
Version: 1.23
|
||||
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.
|
||||
Requires: perl-libs%{?_isa} = %{perl_epoch}:%{perl_version}-%{release}
|
||||
Requires: perl(Carp)
|
||||
Conflicts: perl < 4:5.22.0-351
|
||||
|
||||
|
@ -1556,7 +1734,7 @@ Summary: What modules are shipped with versions of perl
|
|||
Group: Development/Libraries
|
||||
License: GPL+ or Artistic
|
||||
Epoch: 1
|
||||
Version: 5.20151213
|
||||
Version: 5.20160429
|
||||
Requires: %perl_compat
|
||||
Requires: perl(List::Util)
|
||||
Requires: perl(version) >= 0.88
|
||||
|
@ -1572,7 +1750,7 @@ Summary: Tool for listing modules shipped with perl
|
|||
Group: Development/Tools
|
||||
License: GPL+ or Artistic
|
||||
Epoch: 1
|
||||
Version: 5.20151213
|
||||
Version: 5.20160429
|
||||
Requires: %perl_compat
|
||||
Requires: perl(feature)
|
||||
Requires: perl(version) >= 0.88
|
||||
|
@ -2302,7 +2480,7 @@ hashes and hash refs.
|
|||
%package Unicode-Collate
|
||||
Summary: Unicode Collation Algorithm
|
||||
Group: Development/Libraries
|
||||
License: (GPL+ or Artistic) and UCD
|
||||
License: (GPL+ or Artistic) and Unicode
|
||||
Epoch: 0
|
||||
Version: 1.12
|
||||
Requires: %perl_compat
|
||||
|
@ -2362,9 +2540,64 @@ Perl extension for Version Objects
|
|||
%patch16 -p1
|
||||
%patch22 -p1
|
||||
%patch26 -p1
|
||||
%patch27 -p1
|
||||
%patch28 -p1
|
||||
%patch29 -p1
|
||||
%patch32 -p1
|
||||
%patch33 -p1
|
||||
%patch34 -p1
|
||||
%patch35 -p1
|
||||
%patch36 -p1
|
||||
%patch37 -p1
|
||||
%patch38 -p1
|
||||
%patch39 -p1
|
||||
%patch40 -p1
|
||||
%patch41 -p1
|
||||
%patch42 -p1
|
||||
%patch43 -p1
|
||||
%patch44 -p1
|
||||
%patch45 -p1
|
||||
%patch46 -p1
|
||||
%patch47 -p1
|
||||
%patch48 -p1
|
||||
%patch49 -p1
|
||||
%patch50 -p1
|
||||
%patch51 -p1
|
||||
%patch52 -p1
|
||||
%patch53 -p1
|
||||
%patch54 -p1
|
||||
%patch55 -p1
|
||||
%patch56 -p1
|
||||
%patch57 -p1
|
||||
%patch58 -p1
|
||||
%patch59 -p1
|
||||
%patch60 -p1
|
||||
%patch61 -p1
|
||||
%patch62 -p1
|
||||
%patch63 -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
|
||||
%patch86 -p1
|
||||
%patch88 -p1
|
||||
%patch200 -p1
|
||||
%patch201 -p1
|
||||
|
||||
|
@ -2383,9 +2616,55 @@ perl -x patchlevel.h \
|
|||
'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 Patch28: Make magic vtable writable as a work-around for Coro (CPAN RT#101063)' \
|
||||
'Fedora Patch29: Fix CVE-2016-2381 (ambiguous environment variables handling)' \
|
||||
'Fedora Patch29: Fix duplicating PerlIO::encoding when spawning threads (RT#31923)' \
|
||||
'Fedora Patch32: Fix a crash in lexical scope warnings (RT#128597)' \
|
||||
'Fedora Patch33: Do not mangle errno from failed socket calls (RT#128316)' \
|
||||
'Fedora Patch34: Fix crash in "evalbytes S" (RT#129196)' \
|
||||
'Fedora Patch35: Fix crash in "evalbytes S" (RT#129196)' \
|
||||
'Fedora Patch36: Fix crash in "evalbytes S" (RT#129196)' \
|
||||
'Fedora Patch37: Fix crash in splice (RT#129164, RT#129166, RT#129167)' \
|
||||
'Fedora Patch38: Fix string overrun in Perl_gv_fetchmethod_pvn_flags (RT#129267)' \
|
||||
'Fedora Patch39: Fix string overrun in Perl_gv_fetchmethod_pvn_flags (RT#129267)' \
|
||||
'Fedora Patch40: Fix string overrun in Perl_gv_fetchmethod_pvn_flags (RT#129267)' \
|
||||
'Fedora Patch41: Fix string overrun in Perl_gv_fetchmethod_pvn_flags (RT#129267)' \
|
||||
'Fedora Patch42: Fix string overrun in Perl_gv_fetchmethod_pvn_flags (RT#129267)' \
|
||||
'Fedora Patch43: Fix crash when matching UTF-8 string with non-UTF-8 substrings (RT#129350)' \
|
||||
'Fedora Patch44: Fix parsing perl options in shell bang line (RT#129336)' \
|
||||
'Fedora Patch45: Fix firstchar bitmap under UTF-8 with prefix optimization (RT#129950)' \
|
||||
'Fedora Patch46: Avoid infinite loop in h2xs tool if enum and type have the same name (RT130001)' \
|
||||
'Fedora Patch47: Fix stack handling when calling chdir without an argument (RT#129130)' \
|
||||
'Fedora Patch48: Fix crash in Storable when deserializing malformed code reference (RT#68348, RT#130098)' \
|
||||
'Fedora Patch49: Fix assigning split() return values to an array' \
|
||||
'Fedora Patch50: Fix const correctness in hv_func.h (RT#130169)' \
|
||||
'Fedora Patch51: Fix a crash in optimized evaluation of "or ((0) x 0))" (RT#130247)' \
|
||||
'Fedora Patch52: Fix a memory leak in IO::Poll (RT#129788)' \
|
||||
'Fedora Patch53: Fix regular expression matching (RT#130307)' \
|
||||
'Fedora Patch54: Fix a buffer overflow in split in scalar context (RT#130262)' \
|
||||
'Fedora Patch55: Fix a heap overflow with pack "W" (RT129149)' \
|
||||
'Fedora Patch57: Fix a use-after-free when processing scalar variables in forms (RT#129125)' \
|
||||
'Fedora Patch58: Fix a heap overflow if invalid octal or hexadecimal number is used in transliteration expression (RT#129342)' \
|
||||
'Fedora Patch59: Fix out-of-bound read in case of unmatched regexp backreference (RT#129377)' \
|
||||
'Fedora Patch60: Fix UTF-8 string handling in & operator (RT#129287)' \
|
||||
'Fedora Patch61: Fix recreation of *:: (RT#129869)' \
|
||||
'Fedora Patch62: Fix parsing goto statements in multicalled subroutine (RT#113938)' \
|
||||
'Fedora Patch63: Fix a heap overlow in parsing $# (RT#129274)' \
|
||||
'Fedora Patch64: Fix a crash when compiling a regexp with impossible quantifiers (RT#130561)' \
|
||||
'Fedora Patch67: Fix a buffer overrun with format and "use bytes" (RT#130703)' \
|
||||
'Fedora Patch68: Fix a buffer overflow when studying some regexps repeatedly (RT#129281, RT#129061)' \
|
||||
'Fedora Patch70: Fix a null-pointer dereference on malformed code (RT#130815)' \
|
||||
'Fedora Patch71: Fix an use-after-free in substr() that modifies a magic variable (RT#129340)' \
|
||||
'Fedora Patch72: Fix a memory leak leak in Perl_reg_named_buff_fetch() (RT#130822)' \
|
||||
'Fedora Patch73: Fix an invalid memory read when parsing a loop variable (RT#130814)' \
|
||||
'Fedora Patch77: Fix a heap-use-after-free in four-arguments substr call (RT#130624)' \
|
||||
'Fedora Patch78: Make File::Glob more resistant against degenerative matching (RT#131211)' \
|
||||
'Fedora Patch79: Fix a memory wrap in sv_vcatpvfn_flags() (RT#131260)' \
|
||||
'Fedora Patch81: Fix a crash when calling a subroutine from a stash (RT#131085)' \
|
||||
'Fedora Patch82: Fix an improper cast of a negative integer to an unsigned 8-bit type (RT#131190)' \
|
||||
'Fedora Patch83: Fix cloning :via handles on thread creation (RT#131221)' \
|
||||
'Fedora Patch85: Fix glob UTF-8 flag on a glob reassignment (RT#131263)' \
|
||||
'Fedora Patch86: Fix a buffer overflow in my_atof2() (RT#131526)' \
|
||||
'Fedora Patch88: Fix handling backslashes in PATH environment variable when executing "perl -S" (RT#129183)' \
|
||||
'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}
|
||||
|
@ -4638,6 +4917,95 @@ popd
|
|||
|
||||
# Old changelog entries are preserved in CVS.
|
||||
%changelog
|
||||
* Mon Jul 17 2017 Jitka Plesnikova <jplesnik@redhat.com> - 4:5.22.4-372
|
||||
- 5.22.4 bump (see <http://search.cpan.org/dist/perl-5.22.4/pod/perldelta.pod>
|
||||
for release notes)
|
||||
|
||||
* Mon Jun 26 2017 Petr Pisar <ppisar@redhat.com> - 4:5.22.3-371
|
||||
- Make File::Glob more resistant against degenerative matching (RT#131211)
|
||||
- Fix a memory wrap in sv_vcatpvfn_flags() (RT#131260)
|
||||
- Fix a crash when calling a subroutine from a stash (RT#131085)
|
||||
- Fix an improper cast of a negative integer to an unsigned 8-bit type (RT#131190)
|
||||
- Fix cloning :via handles on thread creation (RT#131221)
|
||||
- Fix glob UTF-8 flag on a glob reassignment (RT#131263)
|
||||
- Fix a buffer overflow in my_atof2() (RT#131526)
|
||||
- Fix checks for tainted directory in $ENV{PATH} if a backslash escape presents
|
||||
- Fix handling backslashes in PATH environment variable when executing
|
||||
"perl -S" (RT#129183)
|
||||
- Provide perl-interpreter RPM dependency symbol
|
||||
<https://fedoraproject.org/wiki/Changes/perl_Package_to_Install_Core_Modules>
|
||||
|
||||
* Wed Mar 08 2017 Petr Pisar <ppisar@redhat.com> - 4:5.22.3-370
|
||||
- Fix a null-pointer dereference on malformed code (RT#130815)
|
||||
- Fix an use-after-free in substr() that modifies a magic variable (RT#129340)
|
||||
- Fix a memory leak leak in Perl_reg_named_buff_fetch() (RT#130822)
|
||||
- Fix an invalid memory read when parsing a loop variable (RT#130814)
|
||||
- Fix a heap-use-after-free in four-arguments substr call (RT#130624)
|
||||
|
||||
* Fri Feb 17 2017 Petr Pisar <ppisar@redhat.com> - 4:5.22.3-369
|
||||
- Fix a crash when compiling a regexp with impossible quantifiers (RT#130561)
|
||||
- Fix a buffer overrun with format and "use bytes" (RT#130703)
|
||||
- Fix a buffer overflow when studying some regexps repeatedly
|
||||
(RT#129281, RT#129061)
|
||||
|
||||
* Thu Jan 26 2017 Petr Pisar <ppisar@redhat.com> - 4:5.22.3-368
|
||||
- Fix UTF-8 string handling in & operator (RT#129287)
|
||||
- Fix recreation of *:: (RT#129869)
|
||||
- Fix parsing goto statements in multicalled subroutine (RT#113938)
|
||||
- Fix a heap overlow in parsing $# (RT#129274)
|
||||
|
||||
* Fri Jan 20 2017 Petr Pisar <ppisar@redhat.com> - 4:5.22.3-367
|
||||
- Fix a buffer overflow in split in scalar context (RT#130262)
|
||||
- Fix a heap overflow with pack "W" (RT129149)
|
||||
- Fix a use-after-free when processing scalar variables in forms (RT#129125)
|
||||
- Fix a heap overflow if invalid octal or hexadecimal number is used in
|
||||
transliteration expression (RT#129342)
|
||||
- Fix out-of-bound read in case of unmatched regexp backreference (RT#129377)
|
||||
|
||||
* Mon Jan 16 2017 Jitka Plesnikova <jplesnik@redhat.com> - 4:5.22.3-366
|
||||
- 5.22.3 bump (see <http://search.cpan.org/dist/perl-5.22.3/pod/perldelta.pod>
|
||||
for release notes)
|
||||
|
||||
* Mon Dec 19 2016 Petr Pisar <ppisar@redhat.com> - 4:5.22.2-365
|
||||
- Fix crash in Storable when deserializing malformed code reference
|
||||
(RT#68348, RT#130098)
|
||||
- Tighten dependencies between architecture specific sub-packages to ISA
|
||||
- Fix assigning split() return values to an array
|
||||
- Fix const correctness in hv_func.h (bug #1242980)
|
||||
- Fix a crash in optimized evaluation of "or ((0) x 0))" (RT#130247)
|
||||
- Fix a memory leak in IO::Poll (RT#129788)
|
||||
- Fix regular expression matching (RT#130307)
|
||||
|
||||
* Wed Nov 09 2016 Petr Pisar <ppisar@redhat.com> - 4:5.22.2-364
|
||||
- Tie perl-Errno release to interpreter build because of kernel version check
|
||||
(bug #1393421)
|
||||
|
||||
* Fri Nov 04 2016 Petr Pisar <ppisar@redhat.com> - 4:5.22.2-363
|
||||
- Fix a crash in lexical scope warnings (RT#128597)
|
||||
- Do not mangle errno from failed socket calls (RT#128316)
|
||||
- Fix crash in "evalbytes S" (RT#129196)
|
||||
- Fix crash in splice (RT#129164, RT#129166, RT#129167)
|
||||
- Fix string overrun in Perl_gv_fetchmethod_pvn_flags (RT#129267)
|
||||
- Fix crash when matching UTF-8 string with non-UTF-8 substrings (RT#129350)
|
||||
- Fix parsing perl options in shell bang line (RT#129336)
|
||||
- Fix firstchar bitmap under UTF-8 with prefix optimization (RT#129950)
|
||||
- Avoid infinite loop in h2xs tool if enum and type have the same name
|
||||
(RT130001)
|
||||
- Fix stack handling when calling chdir without an argument (RT#129130)
|
||||
|
||||
* Wed Aug 03 2016 Jitka Plesnikova <jplesnik@redhat.com> - 4:5.22.2-362
|
||||
- Avoid loading optional modules from default . (CVE-2016-1238)
|
||||
|
||||
* Thu Jul 07 2016 Jitka Plesnikova <jplesnik@redhat.com> - 4:5.22.2-361
|
||||
- Do not let XSLoader load relative paths (CVE-2016-6185)
|
||||
|
||||
* Mon Jun 13 2016 Petr Pisar <ppisar@redhat.com> - 4:5.22.2-360
|
||||
- Fix duplicating PerlIO::encoding when spawning threads (bug #1345788)
|
||||
|
||||
* Mon May 02 2016 Jitka Plesnikova <jplesnik@redhat.com> - 4:5.22.2-359
|
||||
- 5.22.2 bump (see <http://search.cpan.org/dist/perl-5.22.2/pod/perldelta.pod>
|
||||
for release notes)
|
||||
|
||||
* Fri Mar 04 2016 Petr Pisar <ppisar@redhat.com> - 4:5.22.1-358
|
||||
- Remove bundled perl-IPC-SysV (bug #1308527)
|
||||
|
||||
|
|
Loading…
Reference in New Issue