add Perl_magic_freeutf8() magic vtable method

S_mg_free_struct() has a workaround to free mg->mg_ptr in
PERL_MAGIC_utf8 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_utf8.

diff --git a/embed.fnc b/embed.fnc
index 96bea25..56cd653 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1329,6 +1329,7 @@ p |int    |magic_settaint |NN SV* sv|NN MAGIC* mg
 p      |int    |magic_setuvar  |NN SV* sv|NN MAGIC* mg
 p      |int    |magic_setvec   |NN SV* sv|NN MAGIC* mg
 p      |int    |magic_setutf8  |NN SV* sv|NN MAGIC* mg
+p      |int    |magic_freeutf8 |NN SV* sv|NN MAGIC* mg
 p      |int    |magic_set_all_env|NN SV* sv|NN MAGIC* mg
 p      |U32    |magic_sizepack |NN SV* sv|NN MAGIC* mg
 p      |int    |magic_wipepack |NN SV* sv|NN MAGIC* mg

diff --git a/embed.h b/embed.h
index cdea384..ca4707c 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1340,6 +1340,7 @@
 #define magic_existspack(a,b)  Perl_magic_existspack(aTHX_ a,b)
 #define magic_freearylen_p(a,b)        Perl_magic_freearylen_p(aTHX_ a,b)
 #define magic_freeovrld(a,b)   Perl_magic_freeovrld(aTHX_ a,b)
+#define magic_freeutf8(a,b)    Perl_magic_freeutf8(aTHX_ a,b)
 #define magic_get(a,b)         Perl_magic_get(aTHX_ a,b)
 #define magic_getarylen(a,b)   Perl_magic_getarylen(aTHX_ a,b)
 #define magic_getdebugvar(a,b) Perl_magic_getdebugvar(aTHX_ a,b)

diff --git a/mg.c b/mg.c
index c7088f8..4f199af 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -555,7 +555,7 @@ S_mg_free_struct(pTHX_ SV *sv, MAGIC *mg)
        vtbl->svt_free(aTHX_ sv, mg);
 
     if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
-       if (mg->mg_len > 0 || mg->mg_type == PERL_MAGIC_utf8)
+       if (mg->mg_len > 0)
            Safefree(mg->mg_ptr);
        else if (mg->mg_len == HEf_SVKEY)
            SvREFCNT_dec(MUTABLE_SV(mg->mg_ptr));
@@ -2675,6 +2675,22 @@ Perl_magic_setutf8(pTHX_ SV *sv, MAGIC *mg)
 }
 
 int
+Perl_magic_freeutf8(pTHX_ SV *sv, MAGIC *mg)
+{
+    PERL_ARGS_ASSERT_MAGIC_FREEUTF8;
+    PERL_UNUSED_ARG(sv);
+
+    /* utf8 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_utf8 && mg->mg_len >= -1);
+    Safefree(mg->mg_ptr);
+    mg->mg_ptr = NULL;
+    return 0;
+}
+
+
+int
 Perl_magic_setlvref(pTHX_ SV *sv, MAGIC *mg)
 {
     const char *bad = NULL;

diff --git a/mg_vtable.h b/mg_vtable.h
index 809ab0e..8815d69 100644 (file)
--- a/mg_vtable.h
+++ b/mg_vtable.h
@@ -190,7 +190,7 @@ EXT_MGVTBL PL_magic_vtables[magic_vtable_max] = {
   { Perl_magic_getsubstr, Perl_magic_setsubstr, 0, 0, 0, 0, 0, 0 },
   { Perl_magic_get, Perl_magic_set, 0, 0, 0, 0, 0, 0 },
   { Perl_magic_gettaint, Perl_magic_settaint, 0, 0, 0, 0, 0, 0 },
-  { 0, Perl_magic_setutf8, 0, 0, 0, 0, 0, 0 },
+  { 0, Perl_magic_setutf8, 0, 0, Perl_magic_freeutf8, 0, 0, 0 },
   { Perl_magic_getuvar, Perl_magic_setuvar, 0, 0, 0, 0, 0, 0 },
   { Perl_magic_getvec, Perl_magic_setvec, 0, 0, 0, 0, 0, 0 }
 };

diff --git a/proto.h b/proto.h
index f094fdb..462c541 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1860,6 +1860,9 @@ PERL_CALLCONV int Perl_magic_freearylen_p(pTHX_ SV* sv, MAGIC* mg);
 PERL_CALLCONV int      Perl_magic_freeovrld(pTHX_ SV* sv, MAGIC* mg);
 #define PERL_ARGS_ASSERT_MAGIC_FREEOVRLD       \
        assert(sv); assert(mg)
+PERL_CALLCONV int      Perl_magic_freeutf8(pTHX_ SV* sv, MAGIC* mg);
+#define PERL_ARGS_ASSERT_MAGIC_FREEUTF8        \
+       assert(sv); assert(mg)
 PERL_CALLCONV int      Perl_magic_get(pTHX_ SV* sv, MAGIC* mg);
 #define PERL_ARGS_ASSERT_MAGIC_GET     \
        assert(sv); assert(mg)

diff --git a/regen/mg_vtable.pl b/regen/mg_vtable.pl
index 5a102cc..ae712b7 100644 (file)
--- a/regen/mg_vtable.pl
+++ b/regen/mg_vtable.pl
@@ -274,7 +274,8 @@ my %sig =
      'regdatum' => {get => 'regdatum_get', set => 'regdatum_set'},
      'backref' => {free => 'killbackrefs'},
      'ovrld' => {free => 'freeovrld'},
-     'utf8' => {set => 'setutf8'},
+     'utf8'     => {set   => 'setutf8',
+                    free  => 'freeutf8' },
      'collxfrm' => {set => 'setcollxfrm',
                     free => 'freecollxfrm',
                    cond => '#ifdef USE_LOCALE_COLLATE'},