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.

diff --git a/embed.fnc b/embed.fnc
index 17011f2..4b33a68 100644 (file)
--- 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 6ca8948..2b162e1 100644 (file)
--- 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 b7a3eb3..64ec373 100644 (file)
--- 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 d244160..504d862 100644 (file)
--- 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 58f5227..d076e7a 100644 (file)
--- 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)
 
 /*