Author: stas Date: Sun Dec 26 20:57:35 2004 New Revision: 123387 URL: http://svn.apache.org/viewcvs?view=rev&rev=123387 Log: - APR::Pool: new: create dependency on the parent pool - adjust MP_APR_POOL_SV_DROPS_OWNERSHIP_RUN to carefuly unwind that dependency to avoid too early destruction of the parent pool, which otherwise would nuke the child pool.
Modified: perl/modperl/trunk/Changes perl/modperl/trunk/t/lib/TestAPRlib/pool.pm perl/modperl/trunk/todo/release perl/modperl/trunk/xs/APR/Pool/APR__Pool.h perl/modperl/trunk/xs/modperl_xs_util.h Modified: perl/modperl/trunk/Changes Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/Changes?view=diff&rev=123387&p1=perl/modperl/trunk/Changes&r1=123386&p2=perl/modperl/trunk/Changes&r2=123387 ============================================================================== --- perl/modperl/trunk/Changes (original) +++ perl/modperl/trunk/Changes Sun Dec 26 20:57:35 2004 @@ -27,6 +27,7 @@ - APR::ThreadMutex: new - APR::URI: parse - Apache::RequestUtil: new +- APR::Pool: new speed up the 'perl Makefile.PL' stage [Randy Kobes]: - reduce the number of calls to build_config() of Modified: perl/modperl/trunk/t/lib/TestAPRlib/pool.pm Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/lib/TestAPRlib/pool.pm?view=diff&rev=123387&p1=perl/modperl/trunk/t/lib/TestAPRlib/pool.pm&r1=123386&p2=perl/modperl/trunk/t/lib/TestAPRlib/pool.pm&r2=123387 ============================================================================== --- perl/modperl/trunk/t/lib/TestAPRlib/pool.pm (original) +++ perl/modperl/trunk/t/lib/TestAPRlib/pool.pm Sun Dec 26 20:57:35 2004 @@ -11,7 +11,7 @@ use APR::Table (); sub num_of_tests { - return 74; + return 75; } sub test { @@ -387,8 +387,13 @@ ok 1; } - - + # out-of-scope pools + { + my $sp = APR::Pool->new->new; + # the parent temp pool must stick around + ok t_cmp(2, ancestry_count($sp), + "parent pool is still alive + global pool"); + } # other stuff { Modified: perl/modperl/trunk/todo/release Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/todo/release?view=diff&rev=123387&p1=perl/modperl/trunk/todo/release&r1=123386&p2=perl/modperl/trunk/todo/release&r2=123387 ============================================================================== --- perl/modperl/trunk/todo/release (original) +++ perl/modperl/trunk/todo/release Sun Dec 26 20:57:35 2004 @@ -42,7 +42,3 @@ problem, but this seems to be a problem in modperl_bucket_sv_setaside which loses the newly seta-aside bucket) - - APR::Pool: - ? mpxs_apr_pool_create (having problems): APR__Pool.patch - Modified: perl/modperl/trunk/xs/APR/Pool/APR__Pool.h Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/xs/APR/Pool/APR__Pool.h?view=diff&rev=123387&p1=perl/modperl/trunk/xs/APR/Pool/APR__Pool.h&r1=123386&p2=perl/modperl/trunk/xs/APR/Pool/APR__Pool.h&r2=123387 ============================================================================== --- perl/modperl/trunk/xs/APR/Pool/APR__Pool.h (original) +++ perl/modperl/trunk/xs/APR/Pool/APR__Pool.h Sun Dec 26 20:57:35 2004 @@ -45,12 +45,30 @@ #define MP_APR_POOL_SV_HAS_OWNERSHIP(sv) mpxs_pool_is_custom(sv) +/* before the magic is freed, one needs to carefully detach the + * dependant pool magic added by mpxs_add_pool_magic (most of the time + * it'd be a parent pool), and postpone its destruction, until after + * the child pool is destroyed. Since if we don't do that the + * destruction of the parent pool will destroy the child pool C guts + * and when perl unware of that the rug was pulled under the feet will + * continue destructing the child pool, things will crash + */ +#define MP_APR_POOL_SV_DROPS_OWNERSHIP_RUN(acct) STMT_START { \ + MAGIC *mg = mg_find(acct->sv, PERL_MAGIC_ext); \ + if (mg && mg->mg_obj) { \ + sv_2mortal(mg->mg_obj); \ + mg->mg_obj = Nullsv; \ + mg->mg_flags &= ~MGf_REFCOUNTED; \ + } \ + mg_free(acct->sv); \ + SvIVX(acct->sv) = 0; \ +} STMT_END + #ifdef USE_ITHREADS #define MP_APR_POOL_SV_DROPS_OWNERSHIP(acct) STMT_START { \ dTHXa(acct->perl); \ - mg_free(acct->sv); \ - SvIVX(acct->sv) = 0; \ + MP_APR_POOL_SV_DROPS_OWNERSHIP_RUN(acct); \ if (modperl_opt_interp_unselect && acct->interp) { \ /* this will decrement the interp refcnt until \ * there are no more references, in which case \ @@ -83,10 +101,7 @@ #else /* !USE_ITHREADS */ -#define MP_APR_POOL_SV_DROPS_OWNERSHIP(acct) STMT_START { \ - mg_free(acct->sv); \ - SvIVX(acct->sv) = 0; \ -} STMT_END +#define MP_APR_POOL_SV_DROPS_OWNERSHIP MP_APR_POOL_SV_DROPS_OWNERSHIP_RUN #define MP_APR_POOL_SV_TAKES_OWNERSHIP(acct_sv, pool) STMT_START { \ mpxs_pool_account_t *acct = apr_palloc(pool, sizeof *acct); \ @@ -198,6 +213,10 @@ MP_POOL_TRACE(MP_FUNC, "sub-pool p: 0x%lx, sv: 0x%lx, rv: 0x%lx", (unsigned long)child_pool, sv, rv); + if (parent_pool) { + mpxs_add_pool_magic(rv, parent_pool_obj); + } + return rv; } } Modified: perl/modperl/trunk/xs/modperl_xs_util.h Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/xs/modperl_xs_util.h?view=diff&rev=123387&p1=perl/modperl/trunk/xs/modperl_xs_util.h&r1=123386&p2=perl/modperl/trunk/xs/modperl_xs_util.h&r2=123387 ============================================================================== --- perl/modperl/trunk/xs/modperl_xs_util.h (original) +++ perl/modperl/trunk/xs/modperl_xs_util.h Sun Dec 26 20:57:35 2004 @@ -126,10 +126,33 @@ sv_magic(SvRV(obj), pool_obj, PERL_MAGIC_ext, Nullch, -1) #endif -/* add dependency magic only for custom pools */ -#define mpxs_add_pool_magic(obj, pool_obj) \ - if (mpxs_pool_is_custom(SvRV(pool_obj))) { \ - mpxs_add_pool_magic_doit(obj, pool_obj); \ +/* add dependency magic only for custom pools. there are all kind of + * complications when more than one magic of the same type(in this + * case PERL_MAGIC_ext is added), luckily most of the PERL_MAGIC_ext + * magic used by modperl-core, uses Nullsv as mg->mg_obj, therefore + * the following code tries to workaround the multiple magic issue, by + * simply hanging the pool object into the unused slot, incrementing + * its refcnt just like sv_magic does internally. In case we ever hit + * magic which already has mg->mg_obj taken we will deal with that, + * for now we just croak in such a case. + */ +#define mpxs_add_pool_magic(obj, pool_obj) \ + if (mpxs_pool_is_custom(SvRV(pool_obj))) { \ + MAGIC *mg = mg_find(SvRV(obj), PERL_MAGIC_ext); \ + if (mg) { \ + if (mg->mg_obj == Nullsv) { \ + mg->mg_obj = SvREFCNT_inc(SvRV(pool_obj)); \ + mg->mg_flags |= MGf_REFCOUNTED; \ + } \ + else { \ + Perl_croak(aTHX_ "Fixme: don't know how to " \ + "handle magic w/ occupied mg->mg_obj"); \ + } \ + } \ + else { \ + mpxs_add_pool_magic_doit(obj, SvRV(pool_obj)); \ + } \ } + #endif /* MODPERL_XS_H */
