perl-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Stas Bekman <s...@stason.org>
Subject Re: [mp2] pool object dependant methods insanity
Date Wed, 22 Dec 2004 03:31:50 GMT
Ok, here is the first batch. All the relevant APR::Table methods were 
pretty similar, so I was able to use macros for all 3. I've first tests 
and I saw all 3 methods broken. Only make() was segfaulting, the rest were 
giving corrupted data. - I have found a nice way to get the data 
corrupted, by allocating a new pool and overwriting the data, making an 
old table corrupted. (but with this patch all tests pass).

I guess I should start committing those, and then refactor any re-usable 
macros, like MPXS_POOL_MAGIC(obj)

Index: todo/release
===================================================================
--- todo/release	(revision 123029)
+++ todo/release	(working copy)
@@ -69,9 +69,9 @@
    - mpxs_Apache__RequestRec_new

    APR::Table:
-  - apr_table_copy
-  - apr_table_overlay
-  - apr_table_make
+  V apr_table_copy
+  V apr_table_overlay
+  V apr_table_make

    APR::ThreadMutex
    - mpxs_apr_thread_mutex_create




Index: src/modules/perl/modperl_common_util.c
===================================================================
--- src/modules/perl/modperl_common_util.c	(revision 123029)
+++ src/modules/perl/modperl_common_util.c	(working copy)
@@ -69,7 +69,7 @@
      /* Prefetch magic requires perl 5.8 */
  #if ((PERL_REVISION == 5) && (PERL_VERSION >= 8))

-    sv_magic(hv, NULL, PERL_MAGIC_ext, Nullch, -1);
+    sv_magicext(hv, NULL, PERL_MAGIC_ext, NULL, Nullch, -1);
      SvMAGIC(hv)->mg_virtual = (MGVTBL *)&modperl_table_magic_prefetch;
      SvMAGIC(hv)->mg_flags |= MGf_COPY;

Index: xs/maps/apr_functions.map
===================================================================
--- xs/maps/apr_functions.map	(revision 123029)
+++ xs/maps/apr_functions.map	(working copy)
@@ -244,10 +244,13 @@

  MODULE=APR::Table
   apr_table_clear
- apr_table_copy    | | t, p
- apr_table_make
+~ apr_table_copy
+ mpxs_APR__Table_copy
+~apr_table_make
+ mpxs_APR__Table_make
   apr_table_overlap
- apr_table_overlay | | base, overlay, p
+~apr_table_overlay
+ mpxs_APR__Table_overlay
   apr_table_compress
   apr_table_add
  -apr_table_addn
Index: xs/APR/Table/APR__Table.h
===================================================================
--- xs/APR/Table/APR__Table.h	(revision 123029)
+++ xs/APR/Table/APR__Table.h	(working copy)
@@ -17,6 +17,42 @@
  #define mpxs_APR__Table_DELETE  apr_table_unset
  #define mpxs_APR__Table_CLEAR   apr_table_clear

+#if ((PERL_REVISION == 5) && (PERL_VERSION >= 8))
+    /* modperl_hash_tie already attached another _ext magic under
+     * 5.8+, so must use sv_magicext to have two magics with the
+     * type  */
+#define MPXS_POOL_MAGIC(obj)                                            \
+    sv_magicext(SvRV(obj), p_sv, PERL_MAGIC_ext, NULL, Nullch, -1)
+#else
+#define MPXS_POOL_MAGIC(obj)                                            \
+    sv_magic(SvRV(obj), p_sv, PERL_MAGIC_ext, Nullch, -1)
+#endif
+
+#define MPXS_DO_TABLE_N_MAGIC_RETURN(call)                              \
+    apr_pool_t *p = mp_xs_sv2_APR__Pool(p_sv);                          \
+    apr_table_t *t = call;                                              \
+    SV *t_sv = modperl_hash_tie(aTHX_ "APR::Table", Nullsv, t);         \
+    MPXS_POOL_MAGIC(t_sv);                                              \
+    return t_sv;
+
+static MP_INLINE SV *mpxs_APR__Table_make(pTHX_ SV *p_sv, int nelts)
+{
+    MPXS_DO_TABLE_N_MAGIC_RETURN(apr_table_make(p, nelts));
+}
+
+
+static MP_INLINE SV *mpxs_APR__Table_copy(pTHX_ apr_table_t *base, SV *p_sv)
+{
+    MPXS_DO_TABLE_N_MAGIC_RETURN(apr_table_copy(p, base));
+}
+
+static MP_INLINE SV *mpxs_APR__Table_overlay(pTHX_ apr_table_t *base,
+                                             apr_table_t *overlay, SV *p_sv)
+{
+    MPXS_DO_TABLE_N_MAGIC_RETURN(apr_table_overlay(p, overlay, base));
+}
+
+
  typedef struct {
      SV *cv;
      apr_hash_t *filter;
Index: xs/tables/current/ModPerl/FunctionTable.pm
===================================================================
--- xs/tables/current/ModPerl/FunctionTable.pm	(revision 123029)
+++ xs/tables/current/ModPerl/FunctionTable.pm	(working copy)
@@ -2,7 +2,7 @@

  # !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  # ! WARNING: generated by ModPerl::ParseSource/0.01
-# !          Fri Dec 17 21:23:11 2004
+# !          Tue Dec 21 22:12:37 2004
  # !          do NOT edit, any changes will be lost !
  # !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

@@ -5921,6 +5921,76 @@
      ]
    },
    {
+    'return_type' => 'SV *',
+    'name' => 'mpxs_APR__Table_copy',
+    'attr' => [
+      'static',
+      '__inline__'
+    ],
+    'args' => [
+      {
+        'type' => 'PerlInterpreter *',
+        'name' => 'my_perl'
+      },
+      {
+        'type' => 'apr_table_t *',
+        'name' => 'base'
+      },
+      {
+        'type' => 'SV *',
+        'name' => 'p_sv'
+      }
+    ]
+  },
+  {
+    'return_type' => 'SV *',
+    'name' => 'mpxs_APR__Table_make',
+    'attr' => [
+      'static',
+      '__inline__'
+    ],
+    'args' => [
+      {
+        'type' => 'PerlInterpreter *',
+        'name' => 'my_perl'
+      },
+      {
+        'type' => 'SV *',
+        'name' => 'p_sv'
+      },
+      {
+        'type' => 'int',
+        'name' => 'nelts'
+      }
+    ]
+  },
+  {
+    'return_type' => 'SV *',
+    'name' => 'mpxs_APR__Table_overlay',
+    'attr' => [
+      'static',
+      '__inline__'
+    ],
+    'args' => [
+      {
+        'type' => 'PerlInterpreter *',
+        'name' => 'my_perl'
+      },
+      {
+        'type' => 'apr_table_t *',
+        'name' => 'base'
+      },
+      {
+        'type' => 'apr_table_t *',
+        'name' => 'overlay'
+      },
+      {
+        'type' => 'SV *',
+        'name' => 'p_sv'
+      }
+    ]
+  },
+  {
      'return_type' => 'char *',
      'name' => 'mpxs_APR__URI_port',
      'args' => [
Index: t/lib/TestAPRlib/table.pm
===================================================================
--- t/lib/TestAPRlib/table.pm	(revision 123029)
+++ t/lib/TestAPRlib/table.pm	(working copy)
@@ -17,7 +17,7 @@
  our $filter_count;

  sub num_of_tests {
-    my $tests = 50;
+    my $tests = 56;

      # tied hash values() for a table w/ multiple values for the same
      # key
@@ -295,6 +295,59 @@
          ok t_cmp($foo[0], 'one, two, three');
          ok t_cmp($bar[0], 'beer');
      }
+
+
+    # temp pool objects.
+    # testing here that the temp pool object doesn't go out of scope
+    # before the object based on it was freed. the following tests
+    # were previously segfaulting when using apr1/httpd2.1 built w/
+    # --enable-pool-debug CPPFLAGS="-DAPR_BUCKET_DEBUG",
+    # the affected methods are:
+    # - make
+    # - copy
+    # - overlay
+    {
+        my $table = APR::Table::make(APR::Pool->new, 10);
+        $table->set($_ => $_) for 1..20;
+        ok t_cmp $table->get(20), 20, "no segfault";
+
+        my $table_copy = $table->copy(APR::Pool->new);
+        {
+            # verify that the temp pool used to create $table_copy was
+            # not freed, by allocating a new table to fill with a
+            # different data. if that former pool was freed
+            # $table_copy will now contain bogus data (and may
+            # segfault)
+            my $table = APR::Table::make(APR::Pool->new, 50);
+            $table->set($_ => $_) for 'a'..'z';
+            ok t_cmp $table->get('z'), 'z', "helper test";
+
+        }
+        ok t_cmp $table_copy->get(20), 20, "no segfault/valid data";
+
+        my $table2 = APR::Table::make(APR::Pool->new, 1);
+        $table2->set($_**2 => $_**2) for 1..20;
+        my $overlay = $table_copy->overlay($table2, APR::Pool->new);
+        {
+            # see the comment for above's:
+            # $table_copy = $table->copy(APR::Pool->new);
+            my $table = APR::Table::make(APR::Pool->new, 50);
+            $table->set($_ => $_) for 'aa'..'za';
+            ok t_cmp $table->get('za'), 'za', "helper test";
+
+        }
+        ok t_cmp $overlay->get(20), 20, "no segfault/valid data";
+    }
+    {
+        {
+            my $p = APR::Pool->new;
+            $p->cleanup_register(sub { "whatever" });
+            $table = APR::Table::make($p, 10)
+        };
+        $table->set(a => 5);
+        ok t_cmp $table->get("a"), 5, "no segfault";
+    }
+
  }

  sub my_filter {

-- 
__________________________________________________________________
Stas Bekman            JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/     mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org   http://ticketmaster.com

---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org


Mime
View raw message