diff options
| -rw-r--r-- | embed.fnc | 2 | ||||
| -rw-r--r-- | embed.h | 2 | ||||
| -rw-r--r-- | gv.c | 33 | ||||
| -rw-r--r-- | proto.h | 2 | ||||
| -rw-r--r-- | sv.h | 2 |
5 files changed, 29 insertions, 12 deletions
@@ -99,7 +99,7 @@ END_EXTERN_C START_EXTERN_C # include "pp_proto.h" Ap |SV* |amagic_call |NN SV* left|NN SV* right|int method|int dir -Ap |bool |Gv_AMupdate |NN HV* stash +Ap |bool |Gv_AMupdate |NN HV* stash|bool destructing ApR |CV* |gv_handler |NULLOK HV* stash|I32 id : Used in perly.y p |OP* |append_elem |I32 optype|NULLOK OP* first|NULLOK OP* last @@ -2391,7 +2391,7 @@ #define get_context Perl_get_context #define set_context Perl_set_context #define amagic_call(a,b,c,d) Perl_amagic_call(aTHX_ a,b,c,d) -#define Gv_AMupdate(a) Perl_Gv_AMupdate(aTHX_ a) +#define Gv_AMupdate(a,b) Perl_Gv_AMupdate(aTHX_ a,b) #define gv_handler(a,b) Perl_gv_handler(aTHX_ a,b) #ifdef PERL_CORE #define append_elem(a,b,c) Perl_append_elem(aTHX_ a,b,c) @@ -1666,7 +1666,7 @@ Perl_magic_freeovrld(pTHX_ SV *sv, MAGIC *mg) /* Updates and caches the CV's */ bool -Perl_Gv_AMupdate(pTHX_ HV *stash) +Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing) { dVAR; MAGIC* const mg = mg_find((const SV *)stash, PERL_MAGIC_overload_table); @@ -1757,12 +1757,17 @@ Perl_Gv_AMupdate(pTHX_ HV *stash) FALSE))) { /* Can be an import stub (created by "can"). */ - const char * const name = (gvsv && SvPOK(gvsv)) ? SvPVX_const(gvsv) : "???"; - Perl_croak(aTHX_ "%s method \"%.256s\" overloading \"%s\" "\ - "in package \"%.256s\"", - (GvCVGEN(gv) ? "Stub found while resolving" - : "Can't resolve"), - name, cp, hvname); + if (destructing) { + return FALSE; + } + else { + const char * const name = (gvsv && SvPOK(gvsv)) ? SvPVX_const(gvsv) : "???"; + Perl_croak(aTHX_ "%s method \"%.256s\" overloading \"%s\" "\ + "in package \"%.256s\"", + (GvCVGEN(gv) ? "Stub found while resolving" + : "Can't resolve"), + name, cp, hvname); + } } cv = GvCV(gv = ngv); } @@ -1814,7 +1819,19 @@ Perl_gv_handler(pTHX_ HV *stash, I32 id) mg = mg_find((const SV *)stash, PERL_MAGIC_overload_table); if (!mg) { do_update: - Gv_AMupdate(stash); + /* If we're looking up a destructor to invoke, we must avoid + * that Gv_AMupdate croaks, because we might be dying already */ + if (!Gv_AMupdate(stash, id == DESTROY_amg)) { + /* and if it didn't found a destructor, we fall back + * to a simpler method that will only look for the + * destructor instead of the whole magic */ + if (id == DESTROY_amg) { + GV * const gv = gv_fetchmethod(stash, "DESTROY"); + if (gv) + return GvCV(gv); + } + return NULL; + } mg = mg_find((const SV *)stash, PERL_MAGIC_overload_table); } assert(mg); @@ -131,7 +131,7 @@ PERL_CALLCONV SV* Perl_amagic_call(pTHX_ SV* left, SV* right, int method, int di #define PERL_ARGS_ASSERT_AMAGIC_CALL \ assert(left); assert(right) -PERL_CALLCONV bool Perl_Gv_AMupdate(pTHX_ HV* stash) +PERL_CALLCONV bool Perl_Gv_AMupdate(pTHX_ HV* stash, bool destructing) __attribute__nonnull__(pTHX_1); #define PERL_ARGS_ASSERT_GV_AMUPDATE \ assert(stash) @@ -915,7 +915,7 @@ the scalar's value cannot change unless written to. #define SvGAMAGIC(sv) (SvGMAGICAL(sv) || SvAMAGIC(sv)) -#define Gv_AMG(stash) (PL_amagic_generation && Gv_AMupdate(stash)) +#define Gv_AMG(stash) (PL_amagic_generation && Gv_AMupdate(stash, FALSE)) #define SvWEAKREF(sv) ((SvFLAGS(sv) & (SVf_ROK|SVprv_WEAKREF)) \ == (SVf_ROK|SVprv_WEAKREF)) |