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 Fri, 14 May 2004 02:37:28 GMT
stas        2004/05/13 19:37:28

  Modified:    t/response/TestAPR pool.pm
               xs/APR/Pool APR__Pool.h
               .        Changes
  Log:
  - now logging the errors happening in pool cleanup callbacks
  - add tests for anon and sub-as-string tests
  - add tests for bogus callbacks
  
  Revision  Changes    Path
  1.9       +49 -4     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.8
  retrieving revision 1.9
  diff -u -u -r1.8 -r1.9
  --- pool.pm	31 Jan 2004 10:06:59 -0000	1.8
  +++ pool.pm	14 May 2004 02:37:28 -0000	1.9
  @@ -16,11 +16,11 @@
   sub handler {
       my $r = shift;
   
  -    plan $r, tests => 62;
  +    plan $r, tests => 64;
   
       ### native pools ###
   
  -    # explicit and implicit DESTROY shouldn't destroy native pools
  +    # explicit DESTROY shouldn't destroy native pools
       {
           my $p = $r->pool;
   
  @@ -305,6 +305,8 @@
           @notes = $r->notes->get('cleanup');
           ok t_cmp(1, scalar(@notes), "should be 1 note");
           ok t_cmp('several references', $notes[0]);
  +
  +        $r->notes->clear;
       }
   
       {
  @@ -328,6 +330,49 @@
           ok 1;
       }
   
  +    # cleanup_register using a function name as a callback
  +    {
  +        {
  +            my $p = APR::Pool->new;
  +            $p->cleanup_register('set_cleanup', [$r, 'function name']);
  +        }
  +
  +        my @notes = $r->notes->get('cleanup');
  +        ok t_cmp('function name', $notes[0], "function name callback");
  +
  +        $r->notes->clear;
  +    }
  +
  +    # cleanup_register using a anon sub callback
  +    {
  +        {
  +            my $p = APR::Pool->new;
  +
  +            $p->cleanup_register(sub { &set_cleanup }, [$r, 'anon sub']);
  +        }
  +
  +        my @notes = $r->notes->get('cleanup');
  +        ok t_cmp('anon sub', $notes[0], "anon callback");
  +
  +        $r->notes->clear;
  +    }
  +
  +    # bogus callbacks unfortunately will fail only when the pool is
  +    # destroyed, and we have no way to propogate (and thus trap) those
  +    # errors. They are logged though. So as usual, one has to always
  +    # watch error_log (things like CGI::Carp's fatalsToBrowser) won't
  +    # quite be able to catch those.
  +    {
  +        my $p = APR::Pool->new;
  +        t_server_log_error_is_expected();
  +        $p->cleanup_register('some_bogus_non_existing', 1);
  +    }
  +    {
  +        my $p = APR::Pool->new;
  +        t_server_log_error_is_expected();
  +        $p->cleanup_register(\&non_existing1, 1);
  +    }
  +
       # other stuff
       {
           my $p = APR::Pool->new;
  @@ -363,14 +408,14 @@
   
   sub add_cleanup {
       my $arg = shift;
  -    debug "adding cleanup note";
  +    debug "adding cleanup note: $arg->[1]";
       $arg->[0]->notes->add(cleanup => $arg->[1]);
       1;
   }
   
   sub set_cleanup {
       my $arg = shift;
  -    debug "setting cleanup note";
  +    debug "setting cleanup note: $arg->[1]";
       $arg->[0]->notes->set(cleanup => $arg->[1]);
       1;
   }
  
  
  
  1.13      +7 -7      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.12
  retrieving revision 1.13
  diff -u -u -r1.12 -r1.13
  --- APR__Pool.h	9 May 2004 21:02:22 -0000	1.12
  +++ APR__Pool.h	14 May 2004 02:37:28 -0000	1.13
  @@ -172,7 +172,6 @@
   static apr_status_t mpxs_cleanup_run(void *data)
   {
       int count;
  -    apr_status_t status = APR_SUCCESS;
       mpxs_cleanup_t *cdata = (mpxs_cleanup_t *)data;
       dTHXa(cdata->perl);
       dSP;
  @@ -189,16 +188,12 @@
       SPAGAIN;
   
       if (count == 1) {
  -        status = POPi;
  +        POPs; /* the return value is ignored */
       }
   
       PUTBACK;
       FREETMPS;LEAVE;
   
  -    if (SvTRUE(ERRSV)) {
  -        /*XXX*/
  -    }
  -
       SvREFCNT_dec(cdata->cv);
       if (cdata->arg) {
           SvREFCNT_dec(cdata->arg);
  @@ -214,7 +209,12 @@
       }
   #endif
   
  -    return status;
  +    if (SvTRUE(ERRSV)) {
  +        Perl_croak(aTHX_ SvPV_nolen(ERRSV));
  +    }
  +    
  +    /* the return value is ignored by apr_pool_destroy anyway */
  +    return APR_SUCCESS;
   }
   
   /**
  
  
  
  1.368     +2 -0      modperl-2.0/Changes
  
  Index: Changes
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/Changes,v
  retrieving revision 1.367
  retrieving revision 1.368
  diff -u -u -r1.367 -r1.368
  --- Changes	7 May 2004 18:02:47 -0000	1.367
  +++ Changes	14 May 2004 02:37:28 -0000	1.368
  @@ -12,6 +12,8 @@
   
   =item 1.99_14-dev
   
  +now logging the errors happening in pool cleanup callbacks [Stas]
  +
   use the new Apache-Test attribute -minclient in the test suites. Now
   along with the default maxclients = minclients+1, we no longer should
   get 'server reached MaxClients setting' errors. [Stas]
  
  
  

Mime
View raw message