105 lines
3.9 KiB
Diff
105 lines
3.9 KiB
Diff
From 4fe0e2d067ac5639d94f35f8c7e8ac4e0e3ab336 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.24.1:
|
|
|
|
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 a64ffba..2395efb 100644
|
|
--- a/embed.fnc
|
|
+++ b/embed.fnc
|
|
@@ -1437,7 +1437,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 fb4ee29..2b2004a 100644
|
|
--- a/proto.h
|
|
+++ b/proto.h
|
|
@@ -3015,7 +3015,7 @@ PERL_CALLCONV void Perl_sv_inc_nomg(pTHX_ SV *const sv);
|
|
/* PERL_CALLCONV void Perl_sv_insert(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN len, const char *const little, const STRLEN littlelen); */
|
|
#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);
|
|
#define PERL_ARGS_ASSERT_SV_INSERT_FLAGS \
|
|
assert(bigstr); assert(little)
|
|
PERL_CALLCONV int Perl_sv_isa(pTHX_ SV* sv, const char *const name);
|
|
diff --git a/sv.c b/sv.c
|
|
index d1e84f0..697db41 100644
|
|
--- a/sv.c
|
|
+++ b/sv.c
|
|
@@ -6223,7 +6223,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;
|
|
@@ -6236,6 +6236,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 eae2403..01c36a9 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;
|
|
|
|
@@ -869,3 +869,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
|
|
|