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/xs/tables/current/ModPerl FunctionTable.pm
Date Fri, 14 May 2004 07:40:31 GMT
stas        2004/05/14 00:40:31

  Modified:    t/response/TestAPR pool.pm
               xs/APR/Pool APR__Pool.h
               xs/maps  apr_functions.map
               xs/tables/current/ModPerl FunctionTable.pm
  Log:
  APR::Pool now has destroy() and clear() available + tests
  
  Revision  Changes    Path
  1.11      +56 -26    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.10
  retrieving revision 1.11
  diff -u -u -r1.10 -r1.11
  --- pool.pm	14 May 2004 02:58:41 -0000	1.10
  +++ pool.pm	14 May 2004 07:40:31 -0000	1.11
  @@ -16,11 +16,11 @@
   sub handler {
       my $r = shift;
   
  -    plan $r, tests => 66;
  +    plan $r, tests => 75;
   
       ### native pools ###
   
  -    # explicit DESTROY shouldn't destroy native pools
  +    # explicit destroy shouldn't destroy native pools
       {
           my $p = $r->pool;
   
  @@ -28,9 +28,9 @@
           t_debug "\$r->pool has 2 or more ancestors (found $count)";
           ok $count >= 2;
   
  -        $p->cleanup_register(\&set_cleanup, [$r, 'native DESTROY']);
  +        $p->cleanup_register(\&set_cleanup, [$r, 'native destroy']);
   
  -        $p->DESTROY;
  +        $p->destroy;
   
           my @notes = $r->notes->get('cleanup');
   
  @@ -63,23 +63,23 @@
       ### custom pools ###
   
   
  -    # test: explicit pool object DESTROY destroys the custom pool
  +    # test: explicit pool object destroy destroys the custom pool
       {
           my $p = APR::Pool->new;
   
  -        $p->cleanup_register(\&set_cleanup, [$r, 'new DESTROY']);
  +        $p->cleanup_register(\&set_cleanup, [$r, 'new destroy']);
   
           ok t_cmp(1, ancestry_count($p),
                    "a new pool has one ancestor: the global pool");
   
  -        # explicity DESTROY the object
  -        $p->DESTROY;
  +        # explicity destroy the object
  +        $p->destroy;
   
           my @notes = $r->notes->get('cleanup');
   
           ok t_cmp(1, scalar(@notes), "should be 1 note");
   
  -        ok t_cmp('new DESTROY', $notes[0]);
  +        ok t_cmp('new destroy', $notes[0]);
   
           $r->notes->clear;
       }
  @@ -128,7 +128,7 @@
           my ($pp, $sp) = both_pools_create_ok($r);
   
           # destroying $pp should destroy the subpool $sp too
  -        $pp->DESTROY;
  +        $pp->destroy;
   
           both_pools_destroy_ok($r);
   
  @@ -141,8 +141,8 @@
       {
           my ($pp, $sp) = both_pools_create_ok($r);
   
  -        $sp->DESTROY;
  -        $pp->DESTROY;
  +        $sp->destroy;
  +        $pp->destroy;
   
           both_pools_destroy_ok($r);
   
  @@ -157,8 +157,8 @@
       {
           my ($pp, $sp) = both_pools_create_ok($r);
   
  -        $pp->DESTROY;
  -        $sp->DESTROY;
  +        $pp->destroy;
  +        $sp->destroy;
   
           both_pools_destroy_ok($r);
   
  @@ -173,7 +173,7 @@
           my ($pp, $sp) = both_pools_create_ok($r);
   
           # parent pool destroys child pool
  -        $pp->DESTROY;
  +        $pp->destroy;
   
           # this should "gracefully" fail, since $sp's guts were
           # destroyed when the parent pool was destroyed
  @@ -203,13 +203,13 @@
           my $pp2;
           {
               my $pp = APR::Pool->new;
  -            $pp->DESTROY;
  +            $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
  +            # destroyed 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
  @@ -226,7 +226,7 @@
   
           # next make sure that $pp2's pool is still alive
           $pp2->cleanup_register(\&set_cleanup, [$r, 'overtake']);
  -        $pp2->DESTROY;
  +        $pp2->destroy;
   
           my @notes = $r->notes->get('cleanup');
   
  @@ -259,7 +259,7 @@
               my $pp = APR::Pool->new;
               my $sp = $pp->new;
               # parent destroys $sp
  -            $pp->DESTROY;
  +            $pp->destroy;
   
               # hopefully these pool will take over the $pp and $sp
               # allocations
  @@ -272,7 +272,7 @@
           $r->notes->clear;
   
           # parent pool destroys child pool
  -        $pp2->DESTROY;
  +        $pp2->destroy;
   
           both_pools_destroy_ok($r);
   
  @@ -300,7 +300,7 @@
           $r->notes->clear;
   
           # now the last copy is gone and the cleanup hooks will be called
  -        $cp->DESTROY;
  +        $cp->destroy;
   
           @notes = $r->notes->get('cleanup');
           ok t_cmp(1, scalar(@notes), "should be 1 note");
  @@ -308,7 +308,6 @@
   
           $r->notes->clear;
       }
  -
       {
           # and another variation
           my $pp = $r->pool->new;
  @@ -318,14 +317,14 @@
           my $pp2 = $sp->parent_get;
   
           # parent destroys children
  -        $pp->DESTROY;
  +        $pp->destroy;
   
           # grand parent ($r->pool) is undestroyable (core pool)
  -        $gp->DESTROY;
  +        $gp->destroy;
   
           # now all custom pools are destroyed - $sp and $pp2 point nowhere
  -        $pp2->DESTROY;
  -        $sp->DESTROY;
  +        $pp2->destroy;
  +        $sp->destroy;
   
           ok 1;
       }
  @@ -388,6 +387,37 @@
           t_server_log_error_is_expected();
           $p->cleanup_register(\&non_existing1, 1);
       }
  +
  +    ### $p->clear ###
  +    {
  +        my ($pp, $sp) = both_pools_create_ok($r);
  +        $pp->clear;
  +        # both pools should have run their cleanups
  +        both_pools_destroy_ok($r);
  +
  +        # sub-pool $sp should be now bogus, as clear() destroys
  +        # subpools
  +        eval { $sp->parent_get };
  +        ok t_cmp(qr/invalid pool object/,
  +                 $@,
  +                 "clear destroys sub pools");
  +
  +        # now we should be able to use the parent pool without
  +        # allocating it
  +        $pp->cleanup_register(\&set_cleanup, [$r, 're-using pool']);
  +        $pp->destroy;
  +
  +        my @notes = $r->notes->get('cleanup');
  +        ok t_cmp('re-using pool', $notes[0]);
  +
  +        $r->notes->clear;
  +    }
  +
  +
  +
  +
  +
  +
   
       # other stuff
       {
  
  
  
  1.14      +33 -0     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.13
  retrieving revision 1.14
  diff -u -u -r1.13 -r1.14
  --- APR__Pool.h	14 May 2004 02:37:28 -0000	1.13
  +++ APR__Pool.h	14 May 2004 07:40:31 -0000	1.14
  @@ -155,6 +155,39 @@
       }
   }
   
  +static MP_INLINE void mpxs_APR__Pool_clear(pTHX_ SV *obj)
  +{
  +    apr_pool_t *p = mp_xs_sv2_APR__Pool(obj);
  +    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, "parent pool (0x%lx) is a core pool",
  +                      (unsigned long)p);
  +        apr_pool_clear(p);
  +        return;
  +    }
  +
  +    MP_POOL_TRACE(MP_FUNC,
  +                  "parent pool (0x%lx) is a custom pool, sv 0x%lx",
  +                  (unsigned long)p,
  +                  (unsigned long)data->sv);
  +
  +    apr_pool_clear(p);
  +
  +    /* apr_pool_clear removes all the user data, so we need to restore
  +     * it. Since clear triggers mpxs_apr_pool_cleanup call, our
  +     * object's guts get nuked too, so we need to restore them too */
  +
  +    /* this is sv_setref_pv, but for an existing object */
  +    sv_setiv(newSVrv(obj, "APR::Pool"), PTR2IV((void*)p));
  +    data->sv = SvRV(obj);
  +
  +    /* reinstall the user data */
  +    apr_pool_userdata_set(data, MP_APR_POOL_NEW, NULL, p);
  +}
  +
  +
   typedef struct {
       SV *cv;
       SV *arg;
  
  
  
  1.74      +4 -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.73
  retrieving revision 1.74
  diff -u -u -r1.73 -r1.74
  --- apr_functions.map	4 May 2004 06:14:44 -0000	1.73
  +++ apr_functions.map	14 May 2004 07:40:31 -0000	1.74
  @@ -156,9 +156,11 @@
   MODULE=APR::Pool
   -apr_pool_num_bytes | | p, recurse=0 #only available with -DAPR_POOL_DEBUG
    apr_pool_cleanup_for_exec
  - apr_pool_clear
  +-apr_pool_clear
  +mpxs_APR__Pool_clear
   >apr_pool_clear_debug
  - apr_pool_destroy
  +-apr_pool_destroy
  + DEFINE_destroy | mpxs_apr_pool_DESTROY | SV *:obj
    DEFINE_DESTROY | mpxs_apr_pool_DESTROY | SV *:obj
   >apr_pool_destroy_debug
    SV *:DEFINE_new | mpxs_apr_pool_create | SV *:parent_pool_obj
  
  
  
  1.156     +19 -1     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.155
  retrieving revision 1.156
  diff -u -u -r1.155 -r1.156
  --- FunctionTable.pm	10 May 2004 20:11:02 -0000	1.155
  +++ FunctionTable.pm	14 May 2004 07:40:31 -0000	1.156
  @@ -2,7 +2,7 @@
   
   # !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   # ! WARNING: generated by ModPerl::ParseSource/0.01
  -# !          Mon May 10 13:02:13 2004
  +# !          Thu May 13 22:34:11 2004
   # !          do NOT edit, any changes will be lost !
   # !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   
  @@ -5430,6 +5430,24 @@
         {
           'type' => 'apr_bucket *',
           'name' => 'bucket'
  +      }
  +    ]
  +  },
  +  {
  +    'return_type' => 'void',
  +    'name' => 'mpxs_APR__Pool_clear',
  +    'attr' => [
  +      'static',
  +      '__inline__'
  +    ],
  +    'args' => [
  +      {
  +        'type' => 'PerlInterpreter *',
  +        'name' => 'my_perl'
  +      },
  +      {
  +        'type' => 'SV *',
  +        'name' => 'obj'
         }
       ]
     },
  
  
  

Mime
View raw message