+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:[EMAIL PROTECTED] http://use.perl.org http://apacheweek.com http://modperlbook.org http://apache.org http://ticketmaster.com
--------------------------------------------------------------------- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]