This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
add Perl_magic_freecollxfrm() magic vtable method
authorDavid Mitchell <davem@iabyn.com>
Mon, 19 Oct 2020 13:43:18 +0000 (14:43 +0100)
committerDavid Mitchell <davem@iabyn.com>
Fri, 23 Oct 2020 13:25:52 +0000 (14:25 +0100)
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.

embed.fnc
embed.h
mg.c
mg_vtable.h
proto.h
regen/mg_vtable.pl

index a68584d..96bea25 100644 (file)
--- 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 1447b27..cdea384 100644 (file)
--- a/embed.h
+++ b/embed.h
 #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 244928f..c7088f8 100644 (file)
--- 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. */
index e4f3f38..809ab0e 100644 (file)
@@ -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 2da1a07..f094fdb 100644 (file)
--- 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)
index df2e6ea..5a102cc 100644 (file)
@@ -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'},