diff options
author | David Mitchell <davem@iabyn.com> | 2020-10-19 16:01:49 +0100 |
---|---|---|
committer | David Mitchell <davem@iabyn.com> | 2020-10-23 14:25:52 +0100 |
commit | 02a48966c3f10e905b24f9bd307fa31c05060908 (patch) | |
tree | 5e53a6e6b781f76381e6e386114fc9ea60dac581 | |
parent | 032a49194dbdca7f62038e1b4af134d72972ecd8 (diff) | |
download | perl-02a48966c3f10e905b24f9bd307fa31c05060908.tar.gz |
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 ]
-rw-r--r-- | embed.fnc | 1 | ||||
-rw-r--r-- | embed.h | 1 | ||||
-rw-r--r-- | mg.c | 27 | ||||
-rw-r--r-- | mg_vtable.h | 2 | ||||
-rw-r--r-- | proto.h | 3 | ||||
-rw-r--r-- | regen/mg_vtable.pl | 3 |
6 files changed, 29 insertions, 8 deletions
@@ -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 @@ -1339,6 +1339,7 @@ #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) @@ -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) { diff --git a/mg_vtable.h b/mg_vtable.h index 8815d697ca..e5c8cba37c 100644 --- a/mg_vtable.h +++ b/mg_vtable.h @@ -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 }, @@ -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) diff --git a/regen/mg_vtable.pl b/regen/mg_vtable.pl index ae712b7ddf..019beef990 100644 --- a/regen/mg_vtable.pl +++ b/regen/mg_vtable.pl @@ -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'}, |