]> git.vpit.fr Git - perl/modules/Lexical-Types.git/commitdiff
Clean up map entries associated to uncatched OPs
authorVincent Pit <vince@profvince.com>
Tue, 30 Jun 2009 20:38:57 +0000 (22:38 +0200)
committerVincent Pit <vince@profvince.com>
Tue, 30 Jun 2009 20:38:57 +0000 (22:38 +0200)
Types.xs
ptable.h

index 29e8d87ff13b163f9f318f6afb8363036e0d7b0e..bcf5fa15c9ac6937ac4e74347ff1a0b1b64631e3 100644 (file)
--- 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(&lt_op_map_mutex);
+#endif
+
+ ptable_map_store(lt_op_map, o, NULL);
+
+#ifdef USE_ITHREADS
+ MUTEX_UNLOCK(&lt_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);
 }
 
index 07a755198ff6b762a04cbb89493d93b3140cb2f5..c694620cf669a8fe2e8442ebdc4dd39cbb2e71c5 100644 (file)
--- 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;