In perl.git, the branch blead has been updated <https://perl5.git.perl.org/perl.git/commitdiff/c1e47bad34ce1d9c84ed57c9b8978bcbd5a02e98?hp=6096c8b5a857766814f7e67361965635283f2354>
- Log ----------------------------------------------------------------- commit c1e47bad34ce1d9c84ed57c9b8978bcbd5a02e98 Author: David Mitchell <[email protected]> Date: Mon Feb 25 13:05:04 2019 +0000 add Perl_dup_warnings() and fix leak The macro DUP_WARNINGS() was doing (approximately) new = CopyD(old, malloc(size), size); which, depending on how the CopyD macro expanded (e.g. on debugging builds), could result in its arguments being used multiple times, and thus malloc() being called multiple times, with the result of the earlier call(s) then leaking. Fix this by implementing DUP_WARNINGS using a new function, Perl_dup_warnings() that stores its intermediate values in local vars. This function isn't performance critical, as its usually only called once per cop creation at compile time. ----------------------------------------------------------------------- Summary of changes: embed.fnc | 2 ++ op.c | 20 ++++++++++++++++++++ proto.h | 3 +++ regen/warnings.pl | 5 +---- warnings.h | 5 +---- 5 files changed, 27 insertions(+), 8 deletions(-) diff --git a/embed.fnc b/embed.fnc index 17011f2013..4b33a681c6 100644 --- a/embed.fnc +++ b/embed.fnc @@ -3279,4 +3279,6 @@ XEop |void |dtrace_probe_op |NN const OP *op XEop |void |dtrace_probe_phase|enum perl_phase phase #endif +XEop |STRLEN*|dup_warnings |NN STRLEN* warnings + : ex: set ts=8 sts=4 sw=4 noet: diff --git a/op.c b/op.c index 6ca89486e3..2b162e1665 100644 --- a/op.c +++ b/op.c @@ -17042,6 +17042,26 @@ const_av_xsub(pTHX_ CV* cv) XSRETURN(AvFILLp(av)+1); } +/* Copy an existing cop->cop_warnings field. + * If it's one of the standard addresses, just re-use the address. + * This is the e implementation for the DUP_WARNINGS() macro + */ + +STRLEN* +Perl_dup_warnings(pTHX_ STRLEN* warnings) +{ + Size_t size; + STRLEN *new_warnings; + + if (specialWARN(warnings)) + return warnings; + + size = sizeof(*warnings) + *warnings; + + new_warnings = (STRLEN*)PerlMemShared_malloc(size); + Copy(warnings, new_warnings, size, char); + return new_warnings; +} /* * ex: set ts=8 sts=4 sw=4 et: diff --git a/proto.h b/proto.h index b7a3eb3fd9..64ec373683 100644 --- a/proto.h +++ b/proto.h @@ -899,6 +899,9 @@ PERL_CALLCONV void Perl_dump_sub_perl(pTHX_ const GV* gv, bool justperl); PERL_CALLCONV void Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args); #define PERL_ARGS_ASSERT_DUMP_VINDENT \ assert(file); assert(pat) +PERL_CALLCONV STRLEN* Perl_dup_warnings(pTHX_ STRLEN* warnings); +#define PERL_ARGS_ASSERT_DUP_WARNINGS \ + assert(warnings) PERL_CALLCONV void Perl_emulate_cop_io(pTHX_ const COP *const c, SV *const sv); #define PERL_ARGS_ASSERT_EMULATE_COP_IO \ assert(c); assert(sv) diff --git a/regen/warnings.pl b/regen/warnings.pl index d244160b3e..504d86288e 100644 --- a/regen/warnings.pl +++ b/regen/warnings.pl @@ -376,10 +376,7 @@ EOM #define isWARN_on(c,x) (IsSet((U8 *)(c + 1), 2*(x))) #define isWARNf_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)+1)) -#define DUP_WARNINGS(p) \ - (specialWARN(p) ? (STRLEN*)(p) \ - : (STRLEN*)CopyD(p, PerlMemShared_malloc(sizeof(*p)+*p), sizeof(*p)+*p, \ - char)) +#define DUP_WARNINGS(p) Perl_dup_warnings(aTHX_ p) /* diff --git a/warnings.h b/warnings.h index 58f52272de..d076e7acc1 100644 --- a/warnings.h +++ b/warnings.h @@ -133,10 +133,7 @@ #define isWARN_on(c,x) (IsSet((U8 *)(c + 1), 2*(x))) #define isWARNf_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)+1)) -#define DUP_WARNINGS(p) \ - (specialWARN(p) ? (STRLEN*)(p) \ - : (STRLEN*)CopyD(p, PerlMemShared_malloc(sizeof(*p)+*p), sizeof(*p)+*p, \ - char)) +#define DUP_WARNINGS(p) Perl_dup_warnings(aTHX_ p) /* -- Perl5 Master Repository
