In perl.git, the branch maint-5.26 has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/d0671c338a562f1c5e045e8c59f406e83e54d283?hp=44af63824611e1e562a7090ab7263a3d9b9ab68b>
- Log -----------------------------------------------------------------
commit d0671c338a562f1c5e045e8c59f406e83e54d283
Author: E. Choroba <chor...@cpan.org>
Date: Mon Jun 19 22:12:20 2017 -0400
Pod correction.
Based on submission from E Choroba in RT # 131603.
(cherry picked from commit b7f366106e07d8d8d2efe8d65343329ebb32062b)
M pod/perlre.pod
commit 9a41ea83b8686bace3d83558771ecc0fdc6dc114
Author: Tony Cook <t...@develop-help.com>
Date: Fri Jul 28 15:19:46 2017 +1000
make _GNU-ish function declarations visible on cygwin
The lack of this caused several test failures on cygwin64, the one case
I tracked down involved memmem() which is a GNU extension that cygwin
supports.
Since the compiler couldn't see the memmem() prototype it treated it's
return value as int, which was then cast to (char *) preventing any
type-mismatch warning, but since int is 32-bits and (char *) on
cygwin64, the upper 32-bits of the pointer was cleared, resulting in a
crash.
After adding this a test cygwin64 build went from 30 or so test failures
to one.
(cherry picked from commit fd998cbffc88a8e50fa34259c36a8db338168383)
M hints/cygwin.sh
commit 130ca3f2c0ed10cf365ddc83dd12b1c37146d3f4
Author: Andy Dougherty <dough...@lafayette.edu>
Date: Mon Jun 12 08:02:10 2017 -0400
Simpler hints fix for [perl #131337].
The Configure scan fails to find dlopen() with g++. Explicitly making
it availble allows Configure to default to using dynamic loading, but
still allows the user to override and use static loading.
(cherry picked from commit 2c8efe4079b75c61cf34425054539a9c24913e9f)
M hints/freebsd.sh
commit 11e42ded02cf9636dfacb56537c11be59b0d3d2b
Author: James E Keenan <jkee...@cpan.org>
Date: Mon May 22 21:25:18 2017 -0400
When building with g++ on FreeBSD, explicitly set 'usedl' and 'dlsrc'.
For: https://rt.perl.org/Ticket/Display.html?id=131337
Signed-off-by: James E Keenan <jkee...@cpan.org>
(cherry picked from commit 21a33adc37856aaedd4bf756d5dca47bdc4f7b50)
M hints/freebsd.sh
commit f8d2fa4a0e346d086c97ad65a72be24c1bc06bd7
Author: James E Keenan <jkee...@cpan.org>
Date: Sun May 21 22:16:23 2017 -0400
Patch suggested by Craig Berry for RT 131337.
(cherry picked from commit 66c5e3f2ab554a89dfc00689602414ac21ea66f6)
M regexec.c
commit cdc7fabede829ac6bfdc731fb5449291c65a7292
Author: Yves Orton <demer...@gmail.com>
Date: Thu Jun 1 14:51:44 2017 +0200
Fix #131190 - UTF8 code improperly casting negative integer to U8 in
comparison
This reverts commit b4972372a75776de3c9e6bd234a398d103677316,
effectively restoring commit ca7eb79a236b41b7722c6800527f95cd76843eed,
and commit 85fde2b7c3f5631fd982f5db735b84dc9224bec0.
(cherry picked from commit 2c2da8e7f0f6325fab643997a536072633fa0cf8)
M regexec.c
commit a14bc0107fb659d0e5200866fed2eba8ac2b7f3f
Author: Lukas Mai <l....@web.de>
Date: Fri May 26 20:15:12 2017 +0200
add X<s> to s/// in perlop (RT #131371)
This should make 'perldoc -f s' work.
(cherry picked from commit 0a31ee11c8f69d509334d0813d833cddacf9dacb)
M pod/perlop.pod
commit 6a206489e8827d93c46bfcf4ced5d046534f5031
Author: Aaron Crane <a...@cpan.org>
Date: Sun Jul 16 16:51:53 2017 +0100
[perl #131627] extend stack in scalar-context pp_list when no args
In scalar (well, non-list) context, pp_list always yields exactly one stack
element. It must therefore extend the stack for that element, in case there
were no arguments on the stack when it started.
(cherry picked from commit b54564c32e53d4c517e4d4810eeb633be80649a9)
M pp.c
M t/op/list.t
commit e902bd916982f3a7e98657bd98cad4276909277e
Author: Tony Cook <t...@develop-help.com>
Date: Mon Jun 19 14:59:53 2017 +1000
(perl #131597) ensure the GV slot is filled for our [%$@]foo: attr
(cherry picked from commit 6091bd4ca4a4a4c9b6f8cadddb53c19b96748a04)
M op.c
M t/op/attrs.t
commit 26f130dde1a67b60888da9266a596c990d9b0386
Author: Tony Cook <t...@develop-help.com>
Date: Wed Jun 21 15:00:56 2017 +1000
(perl #131570) don't skip the temps stack entry we just allocated
(cherry picked from commit 67c3640a57440a4e9e224e9164ac9f39bdc9376f)
M pp_hot.c
commit e3875c509ec2899a5cb68c3eba97b49c381281ad
Author: Dagfinn Ilmari Mannsåker <ilm...@ilmari.org>
Date: Thu Jun 22 20:41:58 2017 +0100
[perl #131627] Fix multideref for $x{qw/a/->$*}
qw// sets OPf_PARENS on the OP_CONST it generates, which persists when
->$* turns it into an OP_GV.
This used to cause an assertion failure on debugging builds, and didn't
get the multideref optimisation on non-debugging.
(cherry picked from commit e13dc8886fcabf88a521e8e73c358157b1fa4c8a)
M op.c
M t/op/multideref.t
commit ddb60739b677c3b9a31b35412ff7daaa23b28915
Author: Steve Hay <steve.m....@googlemail.com>
Date: Wed Aug 23 21:22:25 2017 +0100
Fix previous cherry-pick, which Git was unable to work out correctly itself
M t/re/pat.t
commit d268074d893d83bd5bd8f0483bcc7c793bf84bdc
Author: David Mitchell <da...@iabyn.com>
Date: Fri Jun 16 15:46:19 2017 +0100
don't call Perl_fbm_instr() with negative length
RT #131575
re_intuit_start() could calculate a maximum end position less than the
current start position. This used to get rejected by fbm_intr(), until
v5.23.3-110-g147f21b, which made fbm_intr() faster and removed unnecessary
checks.
This commits fixes re_intuit_start(), and adds an assert to fbm_intr().
(cherry picked from commit bb152a4b442f7718fd37d32cc558be675e8ae1ae)
M regexec.c
M t/re/pat.t
M util.c
commit 6aaabe5196719b29658e550df4d13c7984a10408
Author: Tony Cook <t...@develop-help.com>
Date: Wed Jun 14 09:42:31 2017 +1000
(perl #131526) don't go beyond the end of the NUL in my_atof2
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.
(cherry picked from commit 9604fbf0722bd97ca6031a263c50ad52b6633db7)
M numeric.c
commit 6e35e9969781d5b6932a8fd1f2c4973b6350a845
Author: Karl Williamson <k...@cpan.org>
Date: Sat Jun 3 09:08:50 2017 -0600
Make LOCK_LC_NUMERIC_STANDARD recursive
Same for UNLOCK_LC_NUMERIC_STANDARD.
This partially fixes [perl #128207]
(cherry picked from commit 42752acc4959c5b770bbc29532bf2677f4533c4e)
M perl.h
commit b632bcdee5b2a66cf1d36f758f89ef24e32a9168
Author: David Mitchell <da...@iabyn.com>
Date: Tue Mar 14 09:19:15 2017 +0000
S_require_tie_mod(): use a new stack
RT #130861
This function is used to load a module associated with various magic vars,
like $[ and %+. Since it can be called 'unexpectedly', it should use a new
stack. The issue in this ticket was equivalent to
my $var = '[';
$$var;
where the symbolic dereference triggered a run-time load of arybase.pm,
which grew the stack, invalidating the SP in pp_rv2sv.
Note that most of the stuff which S_require_tie_mod() calls, such as
load_module(), will do its own PUSHSTACK(); but S_require_tie_mod() also
does a bit of stack manipulation itself.
The test case includes a magic number, 125, which happens to be the exact
size necessary to trigger a stack realloc in S_require_tie_mod(). In later
perl versions this value may well change. But it seemed too expensive
to call fresh_perl_is() 100's of times with different values of $n.
This commit also adds a SPAGAIN to pp_rv2sv on the 'belt and braces'
principle.
This commit is based on an earlier effort by Aaron Crane.
(cherry picked from commit 655f5b268af8bf50c44ba4ae4803a33c9b792b8b)
M gv.c
M pp.c
M t/op/ref.t
commit d3442404188ae957414c2cb25bbb315bfd880b71
Author: Father Chrysostomos <spr...@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.
(cherry picked from commit 790acddeaa0d2c73524596048b129561225cf100)
M gv.c
M t/op/gv.t
-----------------------------------------------------------------------
Summary of changes:
gv.c | 4 +++-
hints/cygwin.sh | 2 +-
hints/freebsd.sh | 11 +++++++++++
numeric.c | 4 ++--
op.c | 10 +++++-----
perl.h | 16 +++++++++++-----
pod/perlop.pod | 2 +-
pod/perlre.pod | 2 +-
pp.c | 2 ++
pp_hot.c | 2 +-
regexec.c | 21 +++++++++++++++------
t/op/attrs.t | 18 ++++++++++++++++++
t/op/gv.t | 4 ++++
t/op/list.t | 10 +++++++++-
t/op/multideref.t | 12 +++++++++++-
t/op/ref.t | 20 +++++++++++++++++++-
t/re/pat.t | 13 ++++++++++++-
util.c | 2 ++
18 files changed, 128 insertions(+), 27 deletions(-)
diff --git a/gv.c b/gv.c
index d32a9c5399..8573e6755d 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))
@@ -1338,6 +1338,7 @@ S_require_tie_mod(pTHX_ GV *gv, const char varname, const
char * name,
GV **gvp;
dSP;
+ PUSHSTACKi(PERLSI_MAGIC);
ENTER;
#define HV_FETCH_TIE_FUNC (GV **)hv_fetchs(stash, "_tie_it", 0)
@@ -1367,6 +1368,7 @@ S_require_tie_mod(pTHX_ GV *gv, const char varname, const
char * name,
PUTBACK;
call_sv((SV *)*gvp, G_VOID|G_DISCARD);
LEAVE;
+ POPSTACK;
}
}
diff --git a/hints/cygwin.sh b/hints/cygwin.sh
index 21997dba74..20e0e58821 100644
--- a/hints/cygwin.sh
+++ b/hints/cygwin.sh
@@ -31,7 +31,7 @@ test -z "$optimize" && optimize='-O3'
man3ext='3pm'
test -z "$use64bitint" && use64bitint='define'
test -z "$useithreads" && useithreads='define'
-ccflags="$ccflags -DPERL_USE_SAFE_PUTENV -U__STRICT_ANSI__"
+ccflags="$ccflags -DPERL_USE_SAFE_PUTENV -U__STRICT_ANSI__ -D_GNU_SOURCE"
# - otherwise i686-cygwin
archname='cygwin'
diff --git a/hints/freebsd.sh b/hints/freebsd.sh
index e5ecea8db9..b3422c9ecc 100644
--- a/hints/freebsd.sh
+++ b/hints/freebsd.sh
@@ -320,3 +320,14 @@ d_printf_format_null='undef'
# As of 10.3-RELEASE FreeBSD. See [perl #128867]
d_uselocale='undef'
+
+# https://rt.perl.org/Ticket/Display.html?id=131337
+# Reported in 11.0-CURRENT with g++-4.8.5:
+# If using g++, the Configure scan for dlopen() fails.
+# Easier for now to just to forcibly set it.
+case "$cc" in
+*g++*)
+ d_dlopen='define'
+ ;;
+esac
+
diff --git a/numeric.c b/numeric.c
index 6ea6968c27..5771907b2e 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;
}
}
diff --git a/op.c b/op.c
index 51ffac2ac5..1517fa73b6 100644
--- a/op.c
+++ b/op.c
@@ -3826,9 +3826,9 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
PL_parser->in_my = FALSE;
PL_parser->in_my_stash = NULL;
apply_attrs(GvSTASH(gv),
- (type == OP_RV2SV ? GvSV(gv) :
- type == OP_RV2AV ? MUTABLE_SV(GvAV(gv)) :
- type == OP_RV2HV ? MUTABLE_SV(GvHV(gv)) :
MUTABLE_SV(gv)),
+ (type == OP_RV2SV ? GvSVn(gv) :
+ type == OP_RV2AV ? MUTABLE_SV(GvAVn(gv)) :
+ type == OP_RV2HV ? MUTABLE_SV(GvHVn(gv)) :
MUTABLE_SV(gv)),
attrs);
}
o->op_private |= OPpOUR_INTRO;
@@ -13085,9 +13085,9 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV
orig_action, U8 hints)
case OP_GV:
/* it may be a package var index */
- ASSUME(!(o->op_flags & ~(OPf_WANT|OPf_SPECIAL)));
+ ASSUME(!(o->op_flags &
~(OPf_WANT|OPf_PARENS|OPf_SPECIAL)));
ASSUME(!(o->op_private & ~(OPpEARLY_CV)));
- if ( (o->op_flags &~ OPf_SPECIAL) != OPf_WANT_SCALAR
+ if ( (o->op_flags & ~(OPf_PARENS|OPf_SPECIAL)) !=
OPf_WANT_SCALAR
|| o->op_private != 0
)
break;
diff --git a/perl.h b/perl.h
index da326abc19..7c07afd6c7 100644
--- a/perl.h
+++ b/perl.h
@@ -6187,14 +6187,20 @@ expression, but with an empty argument list, like this:
_restore_LC_NUMERIC_function = &Perl_set_numeric_standard; \
}
-/* Lock to the C locale until unlock is called */
+/* Lock/unlock to the C locale until unlock is called. This needs to be
+ * recursively callable. [perl #128207] */
#define LOCK_LC_NUMERIC_STANDARD() \
(__ASSERT_(PL_numeric_standard) \
- PL_numeric_standard = 2)
-
+ PL_numeric_standard++)
#define UNLOCK_LC_NUMERIC_STANDARD() \
- (__ASSERT_(PL_numeric_standard == 2) \
- PL_numeric_standard = 1)
+ STMT_START { \
+ if (PL_numeric_standard > 1) { \
+ PL_numeric_standard--; \
+ } \
+ else { \
+ assert(0); \
+ } \
+ } STMT_END
#define RESTORE_LC_NUMERIC_UNDERLYING() \
if (_was_local) set_numeric_local();
diff --git a/pod/perlop.pod b/pod/perlop.pod
index 26196c8a07..6c754ca477 100644
--- a/pod/perlop.pod
+++ b/pod/perlop.pod
@@ -2064,7 +2064,7 @@ syntax error. If you encounter this construct in older
code, you can just add
C<m>.
=item C<s/I<PATTERN>/I<REPLACEMENT>/msixpodualngcer>
-X<substitute> X<substitution> X<replace> X<regexp, replace>
+X<s> X<substitute> X<substitution> X<replace> X<regexp, replace>
X<regexp, substitute> X</m> X</s> X</i> X</x> X</p> X</o> X</g> X</c> X</e>
X</r>
Searches a string for a pattern, and if found, replaces that pattern
diff --git a/pod/perlre.pod b/pod/perlre.pod
index 57a98e4466..9cab16e223 100644
--- a/pod/perlre.pod
+++ b/pod/perlre.pod
@@ -505,7 +505,7 @@ a C<\Q...\E> stays unaffected by C</x>. And note that
C</x> doesn't affect
space interpretation within a single multi-character construct. For
example in C<\x{...}>, regardless of the C</x> modifier, there can be no
spaces. Same for a L<quantifier|/Quantifiers> such as C<{3}> or
-C<{5,}>. Similarly, C<(?:...)> can't have a space between the C<"{">,
+C<{5,}>. Similarly, C<(?:...)> can't have a space between the C<"(">,
C<"?">, and C<":">. Within any delimiters for such a
construct, allowed spaces are not affected by C</x>, and depend on the
construct. For example, C<\x{...}> can't have spaces because hexadecimal
diff --git a/pp.c b/pp.c
index cc4cb59f7d..1f7e03599f 100644
--- a/pp.c
+++ b/pp.c
@@ -403,6 +403,7 @@ PP(pp_rv2sv)
else if (PL_op->op_private & OPpDEREF)
sv = vivify_ref(sv, PL_op->op_private & OPpDEREF);
}
+ SPAGAIN; /* in case chasing soft refs reallocated the stack */
SETs(sv);
RETURN;
}
@@ -5187,6 +5188,7 @@ PP(pp_list)
if (GIMME_V != G_ARRAY) {
SV **mark = PL_stack_base + markidx;
dSP;
+ EXTEND(SP, 1); /* in case no arguments, as in @empty */
if (++MARK <= SP)
*MARK = *SP; /* unwanted list, return last item */
else
diff --git a/pp_hot.c b/pp_hot.c
index 7c98c90337..f445fd904b 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1736,7 +1736,7 @@ PP(pp_aassign)
if (UNLIKELY(ix >= PL_tmps_max))
/* speculatively grow enough to cover other
* possible refs */
- ix = tmps_grow_p(ix + (lastlelem - lelem));
+ (void)tmps_grow_p(ix + (lastlelem - lelem));
PL_tmps_stack[ix] = ref;
}
diff --git a/regexec.c b/regexec.c
index 82128a7edc..134b196fc4 100644
--- a/regexec.c
+++ b/regexec.c
@@ -126,13 +126,16 @@ static const char* const non_utf8_target_but_utf8_required
(U8*)(off >= 0 ? reginfo->strend : reginfo->strbeg)) \
: (U8*)(pos + off))
-#define HOPBACKc(pos, off) \
- (char*)(reginfo->is_utf8_target \
- ? reghopmaybe3((U8*)pos, (SSize_t)0-off, (U8*)(reginfo->strbeg)) \
- : (pos - off >= reginfo->strbeg) \
- ? (U8*)pos - off \
+/* like HOPMAYBE3 but backwards. lim must be +ve. Returns NULL on overshoot */
+#define HOPBACK3(pos, off, lim) \
+ (reginfo->is_utf8_target \
+ ? reghopmaybe3((U8*)pos, (SSize_t)0-off, (U8*)(lim)) \
+ : (pos - off >= lim) \
+ ? (U8*)pos - off \
: NULL)
+#define HOPBACKc(pos, off) ((char*)HOPBACK3(pos, off, reginfo->strbeg))
+
#define HOP3(pos,off,lim) (reginfo->is_utf8_target ? reghop3((U8*)(pos), off,
(U8*)(lim)) : (U8*)(pos + off))
#define HOP3c(pos,off,lim) ((char*)HOP3(pos,off,lim))
@@ -884,7 +887,9 @@ Perl_re_intuit_start(pTHX_
(IV)prog->check_end_shift);
});
- end_point = HOP3(strend, -end_shift, strbeg);
+ end_point = HOPBACK3(strend, end_shift, rx_origin);
+ if (!end_point)
+ goto fail_finish;
start_point = HOPMAYBE3(rx_origin, start_shift, end_point);
if (!start_point)
goto fail_finish;
@@ -5593,6 +5598,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)
{
@@ -9749,6 +9755,8 @@ S_to_byte_substr(pTHX_ regexp *prog)
return TRUE;
}
+#ifndef PERL_IN_XSUB_RE
+
bool
Perl__is_grapheme(pTHX_ const U8 * strbeg, const U8 * s, const U8 * strend,
const UV cp)
{
@@ -9804,6 +9812,7 @@ Perl__is_grapheme(pTHX_ const U8 * strbeg, const U8 * s,
const U8 * strend, cons
return isGCB(cp_gcb_val, next_cp_gcb_val, strbeg, s, TRUE);
}
+#endif
diff --git a/t/op/attrs.t b/t/op/attrs.t
index c3cf439f1f..83f3725cc9 100644
--- a/t/op/attrs.t
+++ b/t/op/attrs.t
@@ -490,4 +490,22 @@ EOP
is($out, '', 'RT #3605: $a ? my $var : my $othervar is perfectly valid
syntax');
}
+fresh_perl_is('sub dummy {} our $dummy : Dummy', <<EOS, {},
+Invalid SCALAR attribute: Dummy at - line 1.
+BEGIN failed--compilation aborted at - line 1.
+EOS
+ "attribute on our scalar with sub of same name");
+
+fresh_perl_is('sub dummy {} our @dummy : Dummy', <<EOS, {},
+Invalid ARRAY attribute: Dummy at - line 1.
+BEGIN failed--compilation aborted at - line 1.
+EOS
+ "attribute on our array with sub of same name");
+
+fresh_perl_is('sub dummy {} our %dummy : Dummy', <<EOS, {},
+Invalid HASH attribute: Dummy at - line 1.
+BEGIN failed--compilation aborted at - line 1.
+EOS
+ "attribute on our hash with sub of same name");
+
done_testing();
diff --git a/t/op/gv.t b/t/op/gv.t
index 8d5e7dcacc..4fe6b0028a 100644
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -1187,6 +1187,10 @@ package GV_DOWNGRADE {
::like "$GV_DOWNGRADE::{FOO}", qr/SCALAR/, "gv_downgrade: post";
}
+# [perl #131085] This used to crash; no ok() necessary.
+$::{"A131085"} = sub {}; \&{"A131085"};
+
+
__END__
Perl
Rules
diff --git a/t/op/list.t b/t/op/list.t
index 7bd3eb41b5..3f9487b96f 100644
--- a/t/op/list.t
+++ b/t/op/list.t
@@ -6,7 +6,7 @@ BEGIN {
set_up_inc(qw(. ../lib));
}
-plan( tests => 70 );
+plan( tests => 71 );
@foo = (1, 2, 3, 4);
cmp_ok($foo[0], '==', 1, 'first elem');
@@ -220,3 +220,11 @@ is(tied($t)->{fetched}, undef, 'assignment to empty list
makes no copies');
# this was passing a trash SV at the top of the stack to SvIV()
ok(($0[()[()]],1), "[perl #126193] list slice with zero indexes");
+
+# RT #131732: pp_list must extend stack when empty-array arg and not in list
+# context
+{
+ my @x;
+ @x;
+ pass('no panic'); # panics only under DEBUGGING
+}
diff --git a/t/op/multideref.t b/t/op/multideref.t
index 199e523451..20ba1ca614 100644
--- a/t/op/multideref.t
+++ b/t/op/multideref.t
@@ -18,7 +18,7 @@ BEGIN {
use warnings;
use strict;
-plan 62;
+plan 63;
# check that strict refs hint is handled
@@ -223,3 +223,13 @@ sub defer {}
ok !defined $x[0][0],"RT #130727 part 2: array not autovivified";
}
+
+# RT #131627: assertion failure on OPf_PAREN on OP_GV
+{
+ my @x = (10..12);
+ our $rt131627 = 1;
+
+ no strict qw(refs vars);
+ is $x[qw(rt131627)->$*], 11, 'RT #131627: $a[qw(var)->$*]';
+}
+
diff --git a/t/op/ref.t b/t/op/ref.t
index 65d50b67a2..44047ae17b 100644
--- a/t/op/ref.t
+++ b/t/op/ref.t
@@ -8,7 +8,7 @@ BEGIN {
use strict qw(refs subs);
-plan(236);
+plan(237);
# Test this first before we extend the stack with other operations.
# This caused an asan failure due to a bad write past the end of the stack.
@@ -820,6 +820,24 @@ for ("4eounthouonth") {
'[perl #109746] referential identity of \literal under threads+mad'
}
+# RT#130861: heap-use-after-free in pp_rv2sv, from asan fuzzing
+SKIP: {
+ skip_if_miniperl("no dynamic loading on miniperl, so can't load arybase",
1);
+ # this value is critical - its just enough so that the stack gets
+ # grown which loading/calling arybase
+ my $n = 125;
+
+ my $code = <<'EOF';
+$ary = '[';
+my @a = map $$ary, 1..NNN;
+print "@a\n";
+EOF
+ $code =~ s/NNN/$n/g;
+ my @exp = ("0") x $n;
+ fresh_perl_is($code, "@exp", { stderr => 1 },
+ 'rt#130861: heap uaf in pp_rv2sv');
+}
+
# Bit of a hack to make test.pl happy. There are 3 more tests after it leaves.
$test = curr_test();
curr_test($test + 3);
diff --git a/t/re/pat.t b/t/re/pat.t
index 16bfc8e773..2510eabec8 100644
--- a/t/re/pat.t
+++ b/t/re/pat.t
@@ -23,7 +23,7 @@ BEGIN {
skip_all('no re module') unless defined &DynaLoader::boot_DynaLoader;
skip_all_without_unicode_tables();
-plan tests => 837; # Update this when adding/deleting tests.
+plan tests => 838; # Update this when adding/deleting tests.
run_tests() unless caller;
@@ -1911,6 +1911,17 @@ EOP
# [perl #129281] buffer write overflow, detected by ASAN, valgrind
fresh_perl_is('/0(?0)|^*0(?0)|^*(^*())0|/', '', {}, "don't bump
whilem_c too much");
}
+
+ {
+ # RT #131575 intuit skipping back from the end to find the highest
+ # possible start point, was potentially hopping back beyond pos()
+ # and crashing by calling fbm_instr with a negative length
+
+ my $text = "=t=\x{5000}";
+ pos($text) = 3;
+ ok(scalar($text !~ m{(~*=[a-z]=)}g), "RT #131575");
+ }
+
} # End of sub run_tests
1;
diff --git a/util.c b/util.c
index b324af43ed..2e053a7115 100644
--- a/util.c
+++ b/util.c
@@ -816,6 +816,8 @@ Perl_fbm_instr(pTHX_ unsigned char *big, unsigned char
*bigend, SV *littlestr, U
PERL_ARGS_ASSERT_FBM_INSTR;
+ assert(bigend >= big);
+
if ((STRLEN)(bigend - big) < littlelen) {
if ( tail
&& ((STRLEN)(bigend - big) == littlelen - 1)
--
Perl5 Master Repository
