perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From s...@apache.org
Subject cvs commit: modperl-2.0 Changes
Date Sat, 31 Jan 2004 10:06:59 GMT
stas        2004/01/31 02:06:59

  Modified:    lib/ModPerl WrapXS.pm
               t/response/TestAPR pool.pm
               xs       typemap
               xs/APR/Pool APR__Pool.h
               xs/maps  apr_functions.map
               xs/tables/current/ModPerl FunctionTable.pm
               .        Changes
  Log:
  In order to make Apache-Test compatible with the rest of Perl testing
  frameworks, we no longer chdir into t/, but run from the root of the
  project (where t/ resides). A test needing to know where it's running
  from (e.g. to read/write files/dirs on the filesystem), should do that
  relative to the serverroot, documentroot and other server
  configuration variables, available via
  Apache::Test::vars('serverroot'), Apache::Test::vars('documentroot'),
  etc.
  
  Revision  Changes    Path
  1.64      +4 -3      modperl-2.0/lib/ModPerl/WrapXS.pm
  
  Index: WrapXS.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/lib/ModPerl/WrapXS.pm,v
  retrieving revision 1.63
  retrieving revision 1.64
  diff -u -u -r1.63 -r1.64
  --- WrapXS.pm	17 Dec 2003 21:21:28 -0000	1.63
  +++ WrapXS.pm	31 Jan 2004 10:06:59 -0000	1.64
  @@ -524,9 +524,10 @@
   
   my %typemap = (
       'Apache::RequestRec' => 'T_APACHEOBJ',
  -    'apr_time_t' => 'T_APR_TIME',
  -    'APR::Table' => 'T_HASHOBJ',
  -    'APR::OS::Thread' => 'T_UVOBJ',
  +    'apr_time_t'         => 'T_APR_TIME',
  +    'APR::Table'         => 'T_HASHOBJ',
  +    'APR::Pool'          => 'T_POOLOBJ',
  +    'APR::OS::Thread'    => 'T_UVOBJ',
   );
   
   sub write_typemap {
  
  
  
  1.8       +175 -2    modperl-2.0/t/response/TestAPR/pool.pm
  
  Index: pool.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/t/response/TestAPR/pool.pm,v
  retrieving revision 1.7
  retrieving revision 1.8
  diff -u -u -r1.7 -r1.8
  --- pool.pm	26 Sep 2003 08:56:11 -0000	1.7
  +++ pool.pm	31 Jan 2004 10:06:59 -0000	1.8
  @@ -16,7 +16,7 @@
   sub handler {
       my $r = shift;
   
  -    plan $r, tests => 38;
  +    plan $r, tests => 62;
   
       ### native pools ###
   
  @@ -39,6 +39,7 @@
           $r->notes->clear;
       }
   
  +
       # implicit DESTROY shouldn't destroy native pools
       {
           {
  @@ -84,6 +85,9 @@
       }
   
   
  +
  +
  +
       # test: lexical scoping DESTROYs the custom pool
       {
           {
  @@ -132,6 +136,7 @@
       }
   
   
  +
       # test: destroying a sub-pool before the parent pool
       {
           my ($pp, $sp) = both_pools_create_ok($r);
  @@ -145,8 +150,10 @@
       }
   
   
  +    # test: destroying a sub-pool explicitly after the parent pool destroy
   
  -    # test: destroying a sub-pool explicitly after the parent pool
  +    # the parent pool should have already destroyed the child pool, so
  +    # the object is invalid
       {
           my ($pp, $sp) = both_pools_create_ok($r);
   
  @@ -158,9 +165,175 @@
           $r->notes->clear;
       }
   
  +
  +    # test: destroying a sub-pool before the parent pool and trying to
  +    # call APR::Pool methods on the a subpool object which points to a
  +    # destroyed pool
  +    {
  +        my ($pp, $sp) = both_pools_create_ok($r);
  +
  +        # parent pool destroys child pool
  +        $pp->DESTROY;
  +
  +        # this should "gracefully" fail, since $sp's guts were
  +        # destroyed when the parent pool was destroyed
  +        eval { $pp = $sp->parent_get };
  +        ok t_cmp(qr/invalid pool object/,
  +                 $@,
  +                 "parent pool destroys child pool");
  +
  +        # since pool $sp now contains 0 pointer, if we try to make a
  +        # new pool out of it, it's the same as APR->new (i.e. it'll
  +        # use the global top level pool for it), so the resulting pool
  +        # should have an ancestry length of exactly 1
  +        my $ssp = $sp->new;
  +        ok t_cmp(1, ancestry_count($ssp),
  +                 "a new pool has one ancestor: the global pool");
  +
  +
  +        both_pools_destroy_ok($r);
  +
  +        $r->notes->clear;
  +    }
  +
  +    # test: make sure that one pool won't destroy/affect another pool,
  +    # which happened to be allocated at the same memory address after
  +    # the pointer to the first pool was destroyed
  +    {
  +        my $pp2;
  +        {
  +            my $pp = APR::Pool->new;
  +            $pp->DESTROY;
  +            # $pp2 ideally should take the exact place of apr_pool
  +            # previously pointed to by $pp
  +            $pp2 = APR::Pool->new;
  +            # $pp object didn't go away yet (it'll when exiting this
  +            # scope). in the previous implementation, $pp will be
  +            # DESTROY'ed second time on the exit of the scope and it
  +            # could happen to work, because $pp2 pointer has allocated
  +            # exactly the same address. and if so it would have killed
  +            # the pool that $pp2 points to
  +
  +            # this should "gracefully" fail, since $pp's guts were
  +            # destroyed when the parent pool was destroyed
  +            # must make sure that it won't try to hijack the new pool
  +            # $pp2 that (hopefully) took over $pp's place
  +            eval { $pp->parent_get };
  +            ok t_cmp(qr/invalid pool object/,
  +                     $@,
  +                     "a dead pool is a dead pool");
  +        }
  +
  +        # next make sure that $pp2's pool is still alive
  +        $pp2->cleanup_register(\&set_cleanup, [$r, 'overtake']);
  +        $pp2->DESTROY;
  +
  +        my @notes = $r->notes->get('cleanup');
  +
  +        ok t_cmp(1, scalar(@notes), "should be 1 note");
  +        ok t_cmp('overtake', $notes[0]);
  +
  +        $r->notes->clear;
  +
  +    }
  +
  +    # test: similar to the previous test, but this time, the parent
  +    # pool destroys the child pool. a second allocation of a new pair
  +    # of the parent and child pools take over exactly the same
  +    # allocations. so if there are any ghost objects, they must not
  +    # find the other pools and use them as they own. for example they
  +    # could destroy the pools, and the perl objects of the pair would
  +    # have no idea that someone has destroyed the pools without their
  +    # knowledge. the previous implementation suffered from this
  +    # problem. the new implementation uses an SV which is stored in
  +    # the object and in the pool. when the pool is destroyed the SV
  +    # gets its IVX pointer set to 0, which affects any perl object
  +    # that is a ref to that SV. so once an apr pool is destroyed all
  +    # perl objects pointing to it get automatically invalidated and
  +    # there is no risk of hijacking newly created pools that happen to
  +    # be at the same memory address.
  +
  +    {
  +        my ($pp2, $sp2);
  +        {
  +            my $pp = APR::Pool->new;
  +            my $sp = $pp->new;
  +            # parent destroys $sp
  +            $pp->DESTROY;
  +
  +            # hopefully these pool will take over the $pp and $sp
  +            # allocations
  +            ($pp2, $sp2) = both_pools_create_ok($r);
  +        }
  +
  +        # $pp and $sp shouldn't have triggered any cleanups
  +        my @notes = $r->notes->get('cleanup');
  +        ok t_cmp(0, scalar(@notes), "should be 0 notes");
  +        $r->notes->clear;
  +
  +        # parent pool destroys child pool
  +        $pp2->DESTROY;
  +
  +        both_pools_destroy_ok($r);
  +
  +        $r->notes->clear;
  +    }
  +
  +    # test: only when the last references to the pool object is gone
  +    # it should get destroyed
  +    {
  +
  +        my $cp;
  +
  +        {
  +            my $sp = $r->pool->new;
  +
  +            $sp->cleanup_register(\&set_cleanup, [$r, 'several references']);
  +
  +            $cp = $sp;
  +            # destroy of $sp shouldn't call apr_pool_destroy, because
  +            # $cp still references to it
  +        }
  +
  +        my @notes = $r->notes->get('cleanup');
  +        ok t_cmp(0, scalar(@notes), "should be 0 notes");
  +        $r->notes->clear;
  +
  +        # now the last copy is gone and the cleanup hooks will be called
  +        $cp->DESTROY;
  +
  +        @notes = $r->notes->get('cleanup');
  +        ok t_cmp(1, scalar(@notes), "should be 1 note");
  +        ok t_cmp('several references', $notes[0]);
  +    }
  +
  +    {
  +        # and another variation
  +        my $pp = $r->pool->new;
  +        my $sp = $pp->new;
  +
  +        my $gp  = $pp->parent_get;
  +        my $pp2 = $sp->parent_get;
  +
  +        # parent destroys children
  +        $pp->DESTROY;
  +
  +        # grand parent ($r->pool) is undestroyable (core pool)
  +        $gp->DESTROY;
  +
  +        # now all custom pools are destroyed - $sp and $pp2 point nowhere
  +        $pp2->DESTROY;
  +        $sp->DESTROY;
  +
  +        ok 1;
  +    }
  +
       # other stuff
       {
           my $p = APR::Pool->new;
  +
  +        # find some method that wants a pool object and try to pass it
  +        # an object that was already destroyed e.g. APR::Table::make($p, 2);
   
           # only available with -DAPR_POOL_DEBUG
           #my $num_bytes = $p->num_bytes;
  
  
  
  1.10      +17 -1     modperl-2.0/xs/typemap
  
  Index: typemap
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/xs/typemap,v
  retrieving revision 1.9
  retrieving revision 1.10
  diff -u -u -r1.9 -r1.10
  --- typemap	11 Jul 2002 06:14:10 -0000	1.9
  +++ typemap	31 Jan 2004 10:06:59 -0000	1.10
  @@ -5,6 +5,9 @@
   
   ######################################################################
   OUTPUT
  +T_POOLOBJ
  +        sv_setref_pv($arg, \"${ntype}\", (void*)$var);
  +
   T_APACHEOBJ
   	sv_setref_pv($arg, \"${ntype}\", (void*)$var);
   
  @@ -33,7 +36,20 @@
                          \"$var is not a blessed reference\");
           }
   
  -INPUT
  +T_POOLOBJ
  +	if (SvROK($arg) && sv_derived_from($arg, \"${ntype}\")) {
  +	    IV tmp = SvIV((SV*)SvRV($arg));
  +            if (tmp == 0) {
  +                Perl_croak(aTHX_ \"invalid pool object (already destroyed?)\");
  +            }
  +	    $var = INT2PTR($type,tmp);
  +	}
  +	else {
  +	    Perl_croak(aTHX_ SvROK($arg) ?
  +                       \"$var is not of type ${ntype}\" :
  +                       \"$var is not a blessed reference\");
  +        }
  +
   T_UVOBJ
   	if (SvROK($arg) && sv_derived_from($arg, \"${ntype}\")) {
   	    UV tmp = SvUV((SV*)SvRV($arg));
  
  
  
  1.9       +121 -126  modperl-2.0/xs/APR/Pool/APR__Pool.h
  
  Index: APR__Pool.h
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/xs/APR/Pool/APR__Pool.h,v
  retrieving revision 1.8
  retrieving revision 1.9
  diff -u -u -r1.8 -r1.9
  --- APR__Pool.h	30 Sep 2003 21:18:39 -0000	1.8
  +++ APR__Pool.h	31 Jan 2004 10:06:59 -0000	1.9
  @@ -1,10 +1,24 @@
   #define MP_APR_POOL_NEW "APR::Pool::new"
   
   typedef struct {
  -    int destroyable;
  -    int ref_count;
  +    SV *sv;
  +    PerlInterpreter *perl;
   } mpxs_pool_account_t;
   
  +/* XXX: this implementation has a problem with perl ithreads. if a
  + * custom pool is allocated, and then a thread is spawned we now have
  + * two copies of the pool object, each living in a different perl
  + * interpreter, both pointing to the same memory address of the apr
  + * pool.
  + *
  + * need to write a CLONE class method could properly clone the
  + * thread's copied object, but it's tricky:
  + * - it needs to call parent_get() on the copied object and allocate a
  + *   new pool from that parent's pool
  + * - it needs to reinstall any registered cleanup callbacks (can we do
  + *   that?) may be we can skip those?
  + */
  +
   /* XXX: should we make it a new global tracing category
    * MOD_PERL_TRACE=p for tracing pool management? */
   #define MP_POOL_TRACE_DO 0
  @@ -15,92 +29,34 @@
   #define MP_POOL_TRACE if (0) modperl_trace
   #endif
   
  -
  -static MP_INLINE int mpxs_apr_pool_ref_count_inc(apr_pool_t *p)
  -{
  -    mpxs_pool_account_t *data;
  -    
  -    apr_pool_userdata_get((void **)&data, MP_APR_POOL_NEW, p);
  -    if (!data) {
  -        data = (mpxs_pool_account_t *)apr_pcalloc(p, sizeof(*data));
  -    }
  -
  -    data->ref_count++;
  -
  -    apr_pool_userdata_set(data, MP_APR_POOL_NEW, NULL, p);
  -
  -    return data->ref_count;
  -}
  -
  -static MP_INLINE int mpxs_apr_pool_ref_count_dec(apr_pool_t *p)
  -{
  -    mpxs_pool_account_t *data;
  -
  -    apr_pool_userdata_get((void **)&data, MP_APR_POOL_NEW, p);
  -    if (!data) {
  -        /* if there is no data, there is nothing to decrement */
  -        return 0;
  -    }
  -
  -    if (data->ref_count > 0) {
  -        data->ref_count--;
  -    }
  -    
  -    apr_pool_userdata_set(data, MP_APR_POOL_NEW, NULL, p);
  -
  -    return data->ref_count;
  -}
  -
  -static MP_INLINE void mpxs_apr_pool_destroyable_set(apr_pool_t *p)
  -{
  -    mpxs_pool_account_t *data;
  -    
  -    apr_pool_userdata_get((void **)&data, MP_APR_POOL_NEW, p);
  -    if (!data) {
  -        data = (mpxs_pool_account_t *)apr_pcalloc(p, sizeof(*data));
  -    }
  -
  -    data->destroyable++;
  -
  -    apr_pool_userdata_set(data, MP_APR_POOL_NEW, NULL, p);
  -}
  -
  -static MP_INLINE void mpxs_apr_pool_destroyable_unset(apr_pool_t *p)
  +/* invalidate all Perl objects referencing the data sv stored in the
  + * pool and the sv itself. this is needed when a parent pool triggers
  + * apr_pool_destroy on its child pools
  + */
  +static MP_INLINE apr_status_t
  +mpxs_apr_pool_cleanup(void *cleanup_data)
   {
       mpxs_pool_account_t *data;
  -    
  -    apr_pool_userdata_get((void **)&data, MP_APR_POOL_NEW, p);
  -    if (!data) {
  +    apr_pool_userdata_get((void **)&data, MP_APR_POOL_NEW,
  +                          (apr_pool_t *)cleanup_data);
  +    if (!(data && data->sv)) {
           /* if there is no data, there is nothing to unset */
  -        return;
  +        MP_POOL_TRACE(MP_FUNC, "this pool seems to be destroyed already");
       }
  -
  -    data->destroyable = 0;
  -
  -    apr_pool_userdata_set(data, MP_APR_POOL_NEW, NULL, p);
  -}
  -
  -static MP_INLINE int mpxs_apr_pool_is_pool_destroyable(apr_pool_t *p)
  -{
  -    mpxs_pool_account_t *data;
  -
  -    apr_pool_userdata_get((void **)&data, MP_APR_POOL_NEW, p);
  -    if (!data) {
  -        /* pools with no special data weren't created by us and
  -         * therefore shouldn't be destroyed */
  -        return 0;
  +    else {
  +        dTHXa(data->perl);
  +        MP_POOL_TRACE(MP_FUNC,
  +                      "pool 0x%lx contains a valid sv 0x%lx, invalidating it",
  +                      (unsigned long)data->sv, (unsigned long)cleanup_data);
  +
  +        /* invalidate all Perl objects referencing this sv */
  +        SvIVX(data->sv) = 0;
  +
  +        /* invalidate the reference stored in the pool */
  +        data->sv = NULL;
  +        /* data->sv will go away by itself when all objects will go away */
       }
   
  -    return data->destroyable && !data->ref_count;
  -}
  -
  -static MP_INLINE apr_status_t
  -mpxs_apr_pool_cleanup_destroyable_unset(void *data)
  -{
  -    /* unset the flag for the key MP_APR_POOL_NEW to prevent from
  -     * apr_pool_destroy being called twice */
  -    mpxs_apr_pool_destroyable_unset((apr_pool_t *)data);
  -    
       return APR_SUCCESS;
   }
   
  @@ -109,13 +65,13 @@
    * @param  parent_pool_obj   an APR::Pool object or an "APR::Pool" class
    * @return                   a new pool or subpool
    */
  -static MP_INLINE apr_pool_t *mpxs_apr_pool_create(pTHX_ SV *parent_pool_obj)
  +static MP_INLINE SV *mpxs_apr_pool_create(pTHX_ SV *parent_pool_obj)
   {
       apr_pool_t *parent_pool = mpxs_sv_object_deref(parent_pool_obj, apr_pool_t);
       apr_pool_t *child_pool  = NULL;
  -    
  +
  +    MP_POOL_TRACE(MP_FUNC, "parent pool 0x%lx\n", (unsigned long)parent_pool);
       (void)apr_pool_create(&child_pool, parent_pool);
  -    MP_POOL_TRACE(MP_FUNC, "new pool 0x%lx\n", child_pool);
   
   #if APR_POOL_DEBUG
       /* useful for pools debugging, can grep for APR::Pool::new */
  @@ -131,12 +87,6 @@
                      (unsigned long)child_pool, (unsigned long)parent_pool);
       }
   
  -    /* mark the pool eligible for destruction. We aren't suppose to
  -     * destroy pools not created by APR::Pool::new().
  -     * see mpxs_apr_pool_DESTROY
  -     */
  -    mpxs_apr_pool_destroyable_set(child_pool);
  -
       /* Each newly created pool must be destroyed only once. Calling
        * apr_pool_destroy will destroy the pool and its children pools,
        * however a perl object for a sub-pool will still keep a pointer
  @@ -146,10 +96,15 @@
        * case it'll destroy a different valid pool which has been given
        * the same memory allocation wrecking havoc. Therefore we must
        * ensure that when sub-pools are destroyed via the parent pool,
  -     * their cleanup callbacks will destroy their perl objects
  +     * their cleanup callbacks will destroy the guts of their perl
  +     * objects, so when those perl objects, pointing to memory
  +     * previously allocated by destroyed sub-pools or re-used already
  +     * by new pools, will get their time to DESTROY, they won't make a
  +     * mess, trying to destroy an already destroyed pool or even worse
  +     * a pool allocate in the place of the old one.
        */
       apr_pool_cleanup_register(child_pool, (void *)child_pool,
  -                              mpxs_apr_pool_cleanup_destroyable_unset,
  +                              mpxs_apr_pool_cleanup,
                                 apr_pool_cleanup_null);
   #if APR_POOL_DEBUG
       /* child <-> parent <-> ... <-> top ancestry traversal */
  @@ -170,8 +125,23 @@
       }
   #endif
   
  -    mpxs_apr_pool_ref_count_inc(child_pool);
  -    return child_pool;
  +    {
  +        mpxs_pool_account_t *data =
  +            (mpxs_pool_account_t *)apr_pcalloc(child_pool, sizeof(*data));
  +
  +        SV *rv = sv_setref_pv(NEWSV(0, 0), "APR::Pool", (void*)child_pool);
  +
  +        data->sv = SvRV(rv);
  +#ifdef USE_ITHREADS
  +        data->perl = aTHX;
  +#endif
  +        MP_POOL_TRACE(MP_FUNC, "sub-pool p: 0x%lx, sv: 0x%lx, rv: 0x%lx",
  +                      (unsigned long)child_pool, data->sv, rv);
  +
  +        apr_pool_userdata_set(data, MP_APR_POOL_NEW, NULL, child_pool);
  +
  +        return rv;
  +    }
   }
   
   typedef struct {
  @@ -267,10 +237,11 @@
   }
   
   
  -static MP_INLINE apr_pool_t *
  +static MP_INLINE SV *
   mpxs_apr_pool_parent_get(pTHX_ apr_pool_t *child_pool)
   {
       apr_pool_t *parent_pool = apr_pool_parent_get(child_pool);
  +
       if (parent_pool) {
           /* ideally this should be done by mp_xs_APR__Pool_2obj. Though
            * since most of the time we don't use custom pools, we don't
  @@ -281,45 +252,69 @@
            * reference to a custom pool, they must do the ref-counting
            * as well.
            */
  -        mpxs_apr_pool_ref_count_inc(parent_pool);
  +        mpxs_pool_account_t *data;
  +        apr_pool_userdata_get((void **)&data, MP_APR_POOL_NEW, parent_pool);
  +        if (data && data->sv) {
  +            MP_POOL_TRACE(MP_FUNC,
  +                          "parent pool (0x%lx) is a custom pool, sv 0x%lx",
  +                          (unsigned long)parent_pool,
  +                          (unsigned long)data->sv);
  +
  +            return newRV_inc(data->sv);
  +        }
  +        else {
  +            MP_POOL_TRACE(MP_FUNC, "parent pool (0x%lx) is a core pool",
  +                          (unsigned long)parent_pool);
  +            return SvREFCNT_inc(mp_xs_APR__Pool_2obj(parent_pool));
  +        }
  +    }
  +    else {
  +        MP_POOL_TRACE(MP_FUNC, "pool (0x%lx) has no parents",
  +                      (unsigned long)child_pool);
  +                      return SvREFCNT_inc(mp_xs_APR__Pool_2obj(parent_pool));
       }
  -    
  -    return parent_pool;
   }
  -    
  +
   /**
    * destroy a pool
    * @param obj    an APR::Pool object
    */
  -static MP_INLINE void mpxs_apr_pool_DESTROY(pTHX_ SV *obj) {
  -
  +static MP_INLINE void mpxs_apr_pool_DESTROY(pTHX_ SV *obj)
  +{
       apr_pool_t *p;
  +    SV *sv = SvRV(obj);
   
  -    p = mpxs_sv_object_deref(obj, apr_pool_t);
  +    /* MP_POOL_TRACE(MP_FUNC, "DESTROY 0x%lx-0x%lx",       */
  +    /*              (unsigned long)obj,(unsigned long)sv); */
  +    /* do_sv_dump(0, Perl_debug_log, obj, 0, 4, FALSE, 0); */
   
  -    mpxs_apr_pool_ref_count_dec(p);
  -    
  -    /* APR::Pool::DESTROY
  -     * we only want to call DESTROY on objects created by 
  -     * APR::Pool->new(), not objects representing native pools
  -     * like r->pool.  native pools can be destroyed using 
  -     * apr_pool_destroy ($p->destroy)
  -     */
  -    if (mpxs_apr_pool_is_pool_destroyable(p)) {
  -        MP_POOL_TRACE(MP_FUNC, "DESTROY pool 0x%lx\n", (unsigned long)p);
  -        apr_pool_destroy(p);
  -        /* mpxs_apr_pool_cleanup_destroyable_unset called by
  -         * apr_pool_destroy takes care of marking this pool as
  -         * undestroyable, so we do it only once */
  +    p = mpxs_sv_object_deref(obj, apr_pool_t);
  +    if (!p) {
  +        /* non-custom pool */
  +        MP_POOL_TRACE(MP_FUNC, "skip apr_pool_destroy: not a custom pool");
  +        return;
       }
  -    else {
  -        /* either because we didn't create this pool (e.g., r->pool),
  -         * or because this pool has already been destroyed via the
  -         * destruction of the parent pool
  -         */
  -        MP_POOL_TRACE(MP_FUNC, "skipping DESTROY, "
  -                  "this object is not eligible to destroy pool 0x%lx\n",
  -                  (unsigned long)p);
  -        
  +
  +    if (sv && SvOK(sv)) {
  +        mpxs_pool_account_t *data;
  +
  +        apr_pool_userdata_get((void **)&data, MP_APR_POOL_NEW, p);
  +        if (!(data && data->sv)) {
  +            MP_POOL_TRACE(MP_FUNC, "skip apr_pool_destroy: no sv found");
  +            return;
  +        }
  +
  +        if (SvREFCNT(sv) == 1) {
  +            MP_POOL_TRACE(MP_FUNC, "call apr_pool_destroy: last reference");
  +            apr_pool_destroy(p);
  +        }
  +        else {
  +            /* when the pool object dies, sv's ref count decrements
  +             * itself automatically */
  +            MP_POOL_TRACE(MP_FUNC,
  +                          "skip apr_pool_destroy: refcount > 1 (%d)",
  +                          SvREFCNT(sv));
  +        }
       }
   }
  +
  
  
  
  1.70      +2 -2      modperl-2.0/xs/maps/apr_functions.map
  
  Index: apr_functions.map
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/xs/maps/apr_functions.map,v
  retrieving revision 1.69
  retrieving revision 1.70
  diff -u -u -r1.69 -r1.70
  --- apr_functions.map	29 Jan 2004 01:26:49 -0000	1.69
  +++ apr_functions.map	31 Jan 2004 10:06:59 -0000	1.70
  @@ -157,7 +157,7 @@
    apr_pool_destroy
    DEFINE_DESTROY | mpxs_apr_pool_DESTROY | SV *:obj
   >apr_pool_destroy_debug
  - apr_pool_t *:DEFINE_new | mpxs_apr_pool_create | SV *:parent_pool_obj
  + SV *:DEFINE_new | mpxs_apr_pool_create | SV *:parent_pool_obj
   -apr_pool_create_ex
   >apr_pool_create_ex_debug
   !apr_pool_userdata_get
  @@ -175,7 +175,7 @@
   -apr_pmemdup
   !apr_pool_child_cleanup_set
   !apr_pool_abort_get
  - apr_pool_parent_get | mpxs_
  + SV *:apr_pool_parent_get | mpxs_
    apr_pool_is_ancestor
   -apr_pool_abort_set
   >apr_pool_initialize
  
  
  
  1.143     +2 -2      modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm
  
  Index: FunctionTable.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
  retrieving revision 1.142
  retrieving revision 1.143
  diff -u -u -r1.142 -r1.143
  --- FunctionTable.pm	29 Jan 2004 01:32:58 -0000	1.142
  +++ FunctionTable.pm	31 Jan 2004 10:06:59 -0000	1.143
  @@ -6586,7 +6586,7 @@
       ]
     },
     {
  -    'return_type' => 'apr_pool_t *',
  +    'return_type' => 'SV *',
       'name' => 'mpxs_apr_pool_parent_get',
       'attr' => [
         'static',
  @@ -6618,7 +6618,7 @@
       ]
     },
     {
  -    'return_type' => 'apr_pool_t *',
  +    'return_type' => 'SV *',
       'name' => 'mpxs_apr_pool_create',
       'attr' => [
         'static',
  
  
  
  1.317     +12 -0     modperl-2.0/Changes
  
  Index: Changes
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/Changes,v
  retrieving revision 1.316
  retrieving revision 1.317
  diff -u -u -r1.316 -r1.317
  --- Changes	31 Jan 2004 07:17:17 -0000	1.316
  +++ Changes	31 Jan 2004 10:06:59 -0000	1.317
  @@ -12,6 +12,18 @@
   
   =item 1.99_13-dev
   
  +APR.xs has been reimplemented.  The problem with the previous
  +implementation is that a dead perl pool object could hijack a newly
  +created pool, which didn't belong to that object, but which happened
  +to be allocated at the same memory location. The problem is that
  +apr_pool_user_data_set/get has no mechanism to check whether the pool
  +has changed since it was last assigned to (it does but only in the
  +debug mode). It really needs some signature mechanism which can be
  +verified that the pool is still the same pool. Since apr_pool doesn't
  +have this feature, the reference counting has been reimplemented using
  +a plain sv reference. Several new (mainly hijacking) tests which badly
  +fail with the previous impelementation have been added. [Stas]
  +
   fix calling $r->subprocess_env() in a void context so that it only
   populates %ENV if also called with no arguments.  also, make sure it
   can be called more than once and still populate %ENV.
  
  
  

Mime
View raw message