This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Deprecate Perl_ptr_table_clear(). Nothing outside sv.c uses it.
authorNicholas Clark <nick@ccl4.org>
Thu, 29 Apr 2010 15:11:15 +0000 (16:11 +0100)
committerNicholas Clark <nick@ccl4.org>
Thu, 29 Apr 2010 15:11:15 +0000 (16:11 +0100)
Inline the necessary parts of Perl_ptr_table_clear() into Perl_ptr_table_free().
No need to reset memory to zero that is about to be freed anyway.

embed.fnc
proto.h
sv.c

index be7debe..7ae3b9f 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1424,7 +1424,7 @@ ApR       |void*  |ptr_table_fetch|NN PTR_TBL_t *const tbl|NULLOK const void *const sv
 Ap     |void   |ptr_table_store|NN PTR_TBL_t *const tbl|NULLOK const void *const oldsv \
                                |NN void *const newsv
 Ap     |void   |ptr_table_split|NN PTR_TBL_t *const tbl
 Ap     |void   |ptr_table_store|NN PTR_TBL_t *const tbl|NULLOK const void *const oldsv \
                                |NN void *const newsv
 Ap     |void   |ptr_table_split|NN PTR_TBL_t *const tbl
-Ap     |void   |ptr_table_clear|NULLOK PTR_TBL_t *const tbl
+ApD    |void   |ptr_table_clear|NULLOK PTR_TBL_t *const tbl
 Ap     |void   |ptr_table_free|NULLOK PTR_TBL_t *const tbl
 #if defined(USE_ITHREADS)
 #  if defined(HAVE_INTERP_INTERN)
 Ap     |void   |ptr_table_free|NULLOK PTR_TBL_t *const tbl
 #if defined(USE_ITHREADS)
 #  if defined(HAVE_INTERP_INTERN)
diff --git a/proto.h b/proto.h
index 9f89783..bbb1e3a 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -4299,7 +4299,9 @@ PERL_CALLCONV void        Perl_ptr_table_split(pTHX_ PTR_TBL_t *const tbl)
 #define PERL_ARGS_ASSERT_PTR_TABLE_SPLIT       \
        assert(tbl)
 
 #define PERL_ARGS_ASSERT_PTR_TABLE_SPLIT       \
        assert(tbl)
 
-PERL_CALLCONV void     Perl_ptr_table_clear(pTHX_ PTR_TBL_t *const tbl);
+PERL_CALLCONV void     Perl_ptr_table_clear(pTHX_ PTR_TBL_t *const tbl)
+                       __attribute__deprecated__;
+
 PERL_CALLCONV void     Perl_ptr_table_free(pTHX_ PTR_TBL_t *const tbl);
 #if defined(USE_ITHREADS)
 #  if defined(HAVE_INTERP_INTERN)
 PERL_CALLCONV void     Perl_ptr_table_free(pTHX_ PTR_TBL_t *const tbl);
 #if defined(USE_ITHREADS)
 #  if defined(HAVE_INTERP_INTERN)
diff --git a/sv.c b/sv.c
index e7d67a5..2e3ba69 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -10846,6 +10846,7 @@ Perl_ptr_table_split(pTHX_ PTR_TBL_t *const tbl)
 }
 
 /* remove all the entries from a ptr table */
 }
 
 /* remove all the entries from a ptr table */
+/* Deprecated - will be removed post 5.14 */
 
 void
 Perl_ptr_table_clear(pTHX_ PTR_TBL_t *const tbl)
 
 void
 Perl_ptr_table_clear(pTHX_ PTR_TBL_t *const tbl)
@@ -10874,10 +10875,21 @@ Perl_ptr_table_clear(pTHX_ PTR_TBL_t *const tbl)
 void
 Perl_ptr_table_free(pTHX_ PTR_TBL_t *const tbl)
 {
 void
 Perl_ptr_table_free(pTHX_ PTR_TBL_t *const tbl)
 {
+    struct ptr_tbl_arena *arena;
+
     if (!tbl) {
         return;
     }
     if (!tbl) {
         return;
     }
-    ptr_table_clear(tbl);
+
+    arena = tbl->tbl_arena;
+
+    while (arena) {
+       struct ptr_tbl_arena *next = arena->next;
+
+       Safefree(arena);
+       arena = next;
+    }
+
     Safefree(tbl->tbl_ary);
     Safefree(tbl);
 }
     Safefree(tbl->tbl_ary);
     Safefree(tbl);
 }