From: Vincent Pit Date: Tue, 30 Jun 2009 20:38:57 +0000 (+0200) Subject: Clean up map entries associated to uncatched OPs X-Git-Tag: v0.07~3 X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FLexical-Types.git;a=commitdiff_plain;h=6e9765def6efaf02330bf276fc8006e13769d035 Clean up map entries associated to uncatched OPs --- diff --git a/Types.xs b/Types.xs index 29e8d87..bcf5fa1 100644 --- a/Types.xs +++ b/Types.xs @@ -263,6 +263,19 @@ STATIC const lt_op_info *lt_map_fetch(const OP *o, lt_op_info *oi) { return val; } +STATIC void lt_map_delete(pTHX_ const OP *o) { +#define lt_map_delete(O) lt_map_delete(aTHX_ (O)) +#ifdef USE_ITHREADS + MUTEX_LOCK(<_op_map_mutex); +#endif + + ptable_map_store(lt_op_map, o, NULL); + +#ifdef USE_ITHREADS + MUTEX_UNLOCK(<_op_map_mutex); +#endif +} + /* --- Hooks --------------------------------------------------------------- */ /* ... Our pp_padsv ........................................................ */ @@ -420,9 +433,11 @@ STATIC OP *lt_ck_padany(pTHX_ OP *o) { lt_pp_padsv_save(); lt_map_store(o, orig_pkg, type_pkg, type_meth, lt_pp_padsv_saved); + } else { +skip: + lt_map_delete(o); } -skip: return o; } @@ -431,6 +446,8 @@ STATIC OP *(*lt_old_ck_padsv)(pTHX_ OP *) = 0; STATIC OP *lt_ck_padsv(pTHX_ OP *o) { lt_pp_padsv_restore(o); + lt_map_delete(o); + return CALL_FPTR(lt_old_ck_padsv)(aTHX_ o); } diff --git a/ptable.h b/ptable.h index 07a7551..c694620 100644 --- a/ptable.h +++ b/ptable.h @@ -1,4 +1,4 @@ -/* This file is part of the Lexical-Types Perl module. +/* This file is part of the Lexical::Types Perl module. * See http://search.cpan.org/dist/Lexical-Types/ */ /* This is a pointer table implementation essentially copied from the ptr_table @@ -155,7 +155,7 @@ STATIC void PTABLE_PREFIX(_store)(pPTBL_ ptable * const t, const void * const ke void *oldval = ent->val; PTABLE_VAL_FREE(oldval); ent->val = val; - } else { + } else if (val) { const UV i = PTABLE_HASH(key) & t->max; ent = PerlMemShared_malloc(sizeof *ent); ent->key = key;