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

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

index 56cd653..be253fe 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1319,6 +1319,7 @@ dp        |int    |magic_sethint  |NN SV* sv|NN MAGIC* mg
 p      |int    |magic_setisa   |NN SV* sv|NN MAGIC* mg
 p      |int    |magic_setlvref |NN SV* sv|NN MAGIC* mg
 p      |int    |magic_setmglob |NN SV* sv|NN MAGIC* mg
+p      |int    |magic_freemglob|NN SV* sv|NN MAGIC* mg
 p      |int    |magic_setnkeys |NN SV* sv|NN MAGIC* mg
 p      |int    |magic_setpack  |NN SV* sv|NN MAGIC* mg
 p      |int    |magic_setpos   |NN SV* sv|NN MAGIC* mg
diff --git a/embed.h b/embed.h
index ca4707c..fbd32d3 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define magic_copycallchecker(a,b,c,d,e)       Perl_magic_copycallchecker(aTHX_ a,b,c,d,e)
 #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_freemglob(a,b)   Perl_magic_freemglob(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)
diff --git a/mg.c b/mg.c
index 4f199af..d14b2eb 100644 (file)
--- 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)
 {
index 8815d69..e5c8cba 100644 (file)
@@ -172,7 +172,7 @@ EXT_MGVTBL PL_magic_vtables[magic_vtable_max] = {
   { 0, Perl_magic_setisa, 0, Perl_magic_clearisa, 0, 0, 0, 0 },
   { 0, Perl_magic_setisa, 0, 0, 0, 0, 0, 0 },
   { 0, Perl_magic_setlvref, 0, 0, 0, 0, 0, 0 },
-  { 0, Perl_magic_setmglob, 0, 0, 0, 0, 0, 0 },
+  { 0, Perl_magic_setmglob, 0, 0, Perl_magic_freemglob, 0, 0, 0 },
   { Perl_magic_getnkeys, Perl_magic_setnkeys, 0, 0, 0, 0, 0, 0 },
   { 0, Perl_magic_setnonelem, 0, 0, 0, 0, 0, 0 },
   { 0, 0, 0, 0, Perl_magic_freeovrld, 0, 0, 0 },
diff --git a/proto.h b/proto.h
index 462c541..8a211e8 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1857,6 +1857,9 @@ PERL_CALLCONV int Perl_magic_existspack(pTHX_ SV* sv, const MAGIC* mg);
 PERL_CALLCONV int      Perl_magic_freearylen_p(pTHX_ SV* sv, MAGIC* mg);
 #define PERL_ARGS_ASSERT_MAGIC_FREEARYLEN_P    \
        assert(sv); assert(mg)
+PERL_CALLCONV int      Perl_magic_freemglob(pTHX_ SV* sv, MAGIC* mg);
+#define PERL_ARGS_ASSERT_MAGIC_FREEMGLOB       \
+       assert(sv); assert(mg)
 PERL_CALLCONV int      Perl_magic_freeovrld(pTHX_ SV* sv, MAGIC* mg);
 #define PERL_ARGS_ASSERT_MAGIC_FREEOVRLD       \
        assert(sv); assert(mg)
index ae712b7..019beef 100644 (file)
@@ -260,7 +260,8 @@ my %sig =
      'isaelem' => {set => 'setisa'},
      'arylen' => {get => 'getarylen', set => 'setarylen', const => 1},
      'arylen_p' => {clear => 'cleararylen_p', free => 'freearylen_p'},
-     'mglob' => {set => 'setmglob'},
+     'mglob'    => {set   => 'setmglob',
+                    free  => 'freemglob' },
      'nkeys' => {get => 'getnkeys', set => 'setnkeys'},
      'taint' => {get => 'gettaint', set => 'settaint'},
      'substr' => {get => 'getsubstr', set => 'setsubstr'},