add Perl_magic_freemglob() magic vtable method

S_mg_free_struct() has a workaround to never free mg->mg_ptr for
PERL_MAGIC_regex_global.

Move this logic into a new magic vtable free method instead, so that
S_mg_free_struct() (which gets called for every type of magic) doesn't
have the overhead of checking every time for mg->mg_type ==
PERL_MAGIC_regex_global.

[ No, I don't know why PERL_MAGIC_regex_global's vtable and methods
  are suffixed mglob rather than regex_global or vice versa ]

1 files changed, 21 insertions, 6 deletions

diff --git a/mg.c b/mg.c
index 4f199af423..d14b2eb88c 100644
--- a/mg.c
+++ b/mg.c
@@ -554,12 +554,10 @@ S_mg_free_struct(pTHX_ SV *sv, MAGIC *mg)
     if (vtbl && vtbl->svt_free)
 	vtbl->svt_free(aTHX_ sv, mg);
 
-    if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
-	if (mg->mg_len > 0)
-	    Safefree(mg->mg_ptr);
-	else if (mg->mg_len == HEf_SVKEY)
-	    SvREFCNT_dec(MUTABLE_SV(mg->mg_ptr));
-    }
+    if (mg->mg_len > 0)
+        Safefree(mg->mg_ptr);
+    else if (mg->mg_len == HEf_SVKEY)
+        SvREFCNT_dec(MUTABLE_SV(mg->mg_ptr));
 
     if (mg->mg_flags & MGf_REFCOUNTED)
 	SvREFCNT_dec(mg->mg_obj);
@@ -2600,6 +2598,23 @@ Perl_magic_setmglob(pTHX_ SV *sv, MAGIC *mg)
     return 0;
 }
 
+
+int
+Perl_magic_freemglob(pTHX_ SV *sv, MAGIC *mg)
+{
+    PERL_ARGS_ASSERT_MAGIC_FREEMGLOB;
+    PERL_UNUSED_ARG(sv);
+
+    /* glob magic uses mg_len as a string length rather than a buffer
+     * length, so we need to free even with mg_len == 0: hence we can't
+     * rely on standard magic free handling */
+    assert(mg->mg_type == PERL_MAGIC_regex_global && mg->mg_len >= -1);
+    Safefree(mg->mg_ptr);
+    mg->mg_ptr = NULL;
+    return 0;
+}
+
+
 int
 Perl_magic_setuvar(pTHX_ SV *sv, MAGIC *mg)
 {