Mailing-List: contact dev-help@perl.apache.org; run by ezmlm
Precedence: bulk
Received-SPF: pass (hermes.apache.org: local policy)
Message-ID: <41C39514.9000808@stason.org>
Date: Fri, 17 Dec 2004 21:25:24 -0500
From: Stas Bekman <stas@stason.org>
Organization: Hope, Humanized
User-Agent: Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.7.3) Gecko/20040913
MIME-Version: 1.0
To: Stas Bekman <stas@stason.org>
Cc: Joe Schaefer <joe+gmane@sunstarsys.com>, dev@perl.apache.org
Subject: Re: [mp2] pools that go out of scope aren't a problem anymore?
References: <41A60A95.6010904@stason.org>
 <87fz2x4qu0.fsf@gemini.sunstarsys.com> <41A6411A.3010308@stason.org>
 <878y8p4p2n.fsf@gemini.sunstarsys.com> <41A66AEA.6090101@stason.org>
 <41A7A73C.8020701@stason.org> <41A7C343.4010703@stason.org>
 <41A8C0FE.7020905@stason.org> <41C392C3.60802@stason.org>
In-Reply-To: <41C392C3.60802@stason.org>
Content-Type: text/plain; charset=us-ascii; format=flowed
Content-Transfer-Encoding: 7bit

Stas Bekman wrote:
>> +static MP_INLINE SV *mpxs_APR__Table_make(pTHX_ SV *p_sv, int nelts)
>> +{
>> +    apr_pool_t *p = mp_xs_sv2_APR__Pool(p_sv);
>> +    apr_table_t *t = apr_table_make(p, nelts);
>> +    SV *t_sv = modperl_hash_tie(aTHX_ "APR::Table", Nullsv, t);
>> +    sv_magic(SvRV(t_sv), p_sv, PERL_MAGIC_ext, Nullch, -1);
>> +    return t_sv;
>> +}
> 
> 
> And that just happened to work, since it wasn't 5.8.x+
> 
> sv_magic(SvRV(t_sv), p_sv, PERL_MAGIC_ext, Nullch, -1);
> 
> can't be used since it's already used by:
> 
> MP_INLINE SV *modperl_hash_tie(pTHX_
> [...]
> 
>     /* Prefetch magic requires perl 5.8 */
> #if ((PERL_REVISION == 5) && (PERL_VERSION >= 8))
> 
>     sv_magic(hv, NULL, PERL_MAGIC_ext, Nullch, -1);
>     SvMAGIC(hv)->mg_virtual = (MGVTBL *)&modperl_table_magic_prefetch;
>     SvMAGIC(hv)->mg_flags |= MGf_COPY;
> 
> #endif /* End of prefetch magic */
> 
>     sv_magic(hv, rsv, PERL_MAGIC_tied, Nullch, 0);
> 
> so it happened to worked before I guess because I was testing with 5.6.x,
> 
> with 5.8.x, if I dump the table object it has only one _ext magic.
> 
> so we need to use some other magic to create this dependency.

In case someone wants to play with it here is the latest patch including 
the segfaulting tests.

Index: xs/maps/apr_functions.map
===================================================================
--- xs/maps/apr_functions.map	(revision 122696)
+++ xs/maps/apr_functions.map	(working copy)
@@ -245,7 +245,8 @@
  MODULE=APR::Table
   apr_table_clear
   apr_table_copy    | | t, p
- apr_table_make
+~apr_table_make
+ mpxs_APR__Table_make
   apr_table_overlap
   apr_table_overlay | | base, overlay, p
   apr_table_compress
Index: xs/APR/Table/APR__Table.h
===================================================================
--- xs/APR/Table/APR__Table.h	(revision 122696)
+++ xs/APR/Table/APR__Table.h	(working copy)
@@ -17,6 +17,18 @@
  #define mpxs_APR__Table_DELETE  apr_table_unset
  #define mpxs_APR__Table_CLEAR   apr_table_clear

+static MP_INLINE SV *mpxs_APR__Table_make(pTHX_ SV *p_sv, int nelts)
+{
+    apr_pool_t *p = mp_xs_sv2_APR__Pool(p_sv);
+    apr_table_t *t = apr_table_make(p, nelts);
+    SV *t_sv = modperl_hash_tie(aTHX_ "APR::Table", Nullsv, t);
+    sv_dump(SvRV(p_sv));
+    /* XXX: this seems to be ignored by perl 5.8.x+, since
+     * modperl_hash_tie already attached another _ext magic */
+    sv_magic(SvRV(t_sv), p_sv, PERL_MAGIC_ext, Nullch, -1);
+    return t_sv;
+}
+
  typedef struct {
      SV *cv;
      apr_hash_t *filter;
Index: xs/tables/current/ModPerl/FunctionTable.pm
===================================================================
--- xs/tables/current/ModPerl/FunctionTable.pm	(revision 122696)
+++ 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
+# !          Fri Dec 17 21:24:23 2004
  # !          do NOT edit, any changes will be lost !
  # !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

@@ -5921,6 +5921,28 @@
      ]
    },
    {
+    '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' => 'char *',
      'name' => 'mpxs_APR__URI_port',
      'args' => [
Index: t/lib/TestAPRlib/table.pm
===================================================================
--- t/lib/TestAPRlib/table.pm	(revision 122696)
+++ t/lib/TestAPRlib/table.pm	(working copy)
@@ -17,7 +17,7 @@
  our $filter_count;

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

      # tied hash values() for a table w/ multiple values for the same
      # key
@@ -295,6 +295,30 @@
          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",
+    {
+        my $table = APR::Table::make(APR::Pool->new, 10);
+        use Devel::Peek;
+        Dump $table;
+        $table->set($_ => $_) for 1..20;
+        ok t_cmp $table->get(20), 20, "no segfault";
+    }
+    {
+        {
+            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