add Perl_magic_freecollxfrm() magic vtable method

v5.29.9-139-g44955e7de8 added a workaround to S_mg_free_struct() to
free mg->mg_ptr in PERL_MAGIC_collxfrm even if mg_len is zero.

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_collxfrm.

6 files changed, 23 insertions, 6 deletions

diff --git a/embed.fnc b/embed.fnc
index a68584dff9..96bea25dcc 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1338,6 +1338,7 @@ Fpod	|SV*	|magic_methcall	|NN SV *sv|NN const MAGIC *mg \
 Ap	|I32 *	|markstack_grow
 #if defined(USE_LOCALE_COLLATE)
 p	|int	|magic_setcollxfrm|NN SV* sv|NN MAGIC* mg
+p	|int	|magic_freecollxfrm|NN SV* sv|NN MAGIC* mg
 pbD	|char*	|mem_collxfrm	|NN const char* input_string|STRLEN len|NN STRLEN* xlen
 : Defined in locale.c, used only in sv.c
 #   if defined(PERL_IN_LOCALE_C) || defined(PERL_IN_SV_C) || defined(PERL_IN_MATHOMS_C)
diff --git a/embed.h b/embed.h
index 1447b2726f..cdea3847de 100644
--- a/embed.h
+++ b/embed.h
@@ -2006,6 +2006,7 @@
 #define padnamelist_dup(a,b)	Perl_padnamelist_dup(aTHX_ a,b)
 #  endif
 #  if defined(USE_LOCALE_COLLATE)
+#define magic_freecollxfrm(a,b)	Perl_magic_freecollxfrm(aTHX_ a,b)
 #define magic_setcollxfrm(a,b)	Perl_magic_setcollxfrm(aTHX_ a,b)
 #ifndef NO_MATHOMS
 #define mem_collxfrm(a,b,c)	Perl_mem_collxfrm(aTHX_ a,b,c)
diff --git a/mg.c b/mg.c
index 244928f859..c7088f8446 100644
--- a/mg.c
+++ b/mg.c
@@ -554,11 +554,7 @@ S_mg_free_struct(pTHX_ SV *sv, MAGIC *mg)
     if (vtbl && vtbl->svt_free)
 	vtbl->svt_free(aTHX_ sv, mg);
 
-    if (mg->mg_type == PERL_MAGIC_collxfrm && mg->mg_len >= 0)
-        /* collate magic uses string len not buffer len, so
-         * free even with mg_len == 0 */
-        Safefree(mg->mg_ptr);
-    else if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
+    if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
 	if (mg->mg_len > 0 || mg->mg_type == PERL_MAGIC_utf8)
 	    Safefree(mg->mg_ptr);
 	else if (mg->mg_len == HEf_SVKEY)
@@ -2648,6 +2644,21 @@ Perl_magic_setcollxfrm(pTHX_ SV *sv, MAGIC *mg)
     }
     return 0;
 }
+
+int
+Perl_magic_freecollxfrm(pTHX_ SV *sv, MAGIC *mg)
+{
+    PERL_ARGS_ASSERT_MAGIC_FREECOLLXFRM;
+    PERL_UNUSED_ARG(sv);
+
+    /* Collate 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_collxfrm && mg->mg_len >= 0);
+    Safefree(mg->mg_ptr);
+    mg->mg_ptr = NULL;
+    return 0;
+}
 #endif /* USE_LOCALE_COLLATE */
 
 /* Just clear the UTF-8 cache data. */
diff --git a/mg_vtable.h b/mg_vtable.h
index e4f3f3889d..809ab0e236 100644
--- a/mg_vtable.h
+++ b/mg_vtable.h
@@ -158,7 +158,7 @@ EXT_MGVTBL PL_magic_vtables[magic_vtable_max] = {
   { 0, 0, 0, 0, Perl_magic_killbackrefs, 0, 0, 0 },
   { 0, 0, 0, 0, 0, Perl_magic_copycallchecker, 0, 0 },
 #ifdef USE_LOCALE_COLLATE
-  { 0, Perl_magic_setcollxfrm, 0, 0, 0, 0, 0, 0 },
+  { 0, Perl_magic_setcollxfrm, 0, 0, Perl_magic_freecollxfrm, 0, 0, 0 },
 #else
   { 0, 0, 0, 0, 0, 0, 0, 0 },
 #endif
diff --git a/proto.h b/proto.h
index 2da1a07761..f094fdbc1b 100644
--- a/proto.h
+++ b/proto.h
@@ -6780,6 +6780,9 @@ PERL_CALLCONV bool	Perl__is_cur_LC_category_utf8(pTHX_ int category);
 #define PERL_ARGS_ASSERT__IS_CUR_LC_CATEGORY_UTF8
 #endif
 #if defined(USE_LOCALE_COLLATE)
+PERL_CALLCONV int	Perl_magic_freecollxfrm(pTHX_ SV* sv, MAGIC* mg);
+#define PERL_ARGS_ASSERT_MAGIC_FREECOLLXFRM	\
+	assert(sv); assert(mg)
 PERL_CALLCONV int	Perl_magic_setcollxfrm(pTHX_ SV* sv, MAGIC* mg);
 #define PERL_ARGS_ASSERT_MAGIC_SETCOLLXFRM	\
 	assert(sv); assert(mg)
diff --git a/regen/mg_vtable.pl b/regen/mg_vtable.pl
index df2e6eab98..5a102cc2c4 100644
--- a/regen/mg_vtable.pl
+++ b/regen/mg_vtable.pl
@@ -276,6 +276,7 @@ my %sig =
      'ovrld' => {free => 'freeovrld'},
      'utf8' => {set => 'setutf8'},
      'collxfrm' => {set => 'setcollxfrm',
+                    free => 'freecollxfrm',
 		    cond => '#ifdef USE_LOCALE_COLLATE'},
      'hintselem' => {set => 'sethint', clear => 'clearhint'},
      'hints' => {clear => 'clearhints'},