In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/e7a8a8aac45d42d72d1586227ca51771f193f5dc?hp=41dfb3984004156f53f309f68b7ba6d491b29704>
- Log -----------------------------------------------------------------
commit e7a8a8aac45d42d72d1586227ca51771f193f5dc
Author: Tony Cook <t...@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()
-----------------------------------------------------------------------
Summary of changes:
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 0f63ed0c0f..3b645143e6 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1553,7 +1553,7 @@ Apmdb |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 c61980e585..59f9b4b370 100644
--- a/proto.h
+++ b/proto.h
@@ -3113,7 +3113,7 @@ PERL_CALLCONV void Perl_sv_insert(pTHX_ SV *const
bigstr, const STRLEN offset, c
#define PERL_ARGS_ASSERT_SV_INSERT \
assert(bigstr); assert(little)
#endif
-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 e0c327a350..e90ea8408b 100644
--- a/sv.c
+++ b/sv.c
@@ -6328,7 +6328,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;
@@ -6341,6 +6341,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 83e7baeddc..a8abed825c 100644
--- a/t/op/substr.t
+++ b/t/op/substr.t
@@ -22,7 +22,7 @@ $SIG{__WARN__} = sub {
}
};
-plan(390);
+plan(391);
run_tests() unless caller;
@@ -877,3 +877,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");
--
Perl5 Master Repository
