cvs commit: modperl-2.0/xs/maps apr_functions.map

[do...@apache.org]

dougm       01/04/11 22:38:25

  Modified:    xs/APR/Pool APR__Pool.h
               xs/maps  apr_functions.map
  Added:       t/response/TestAPR pool.pm
  Log:
  add support for APR::Pool->cleanup and tests for APR::Pool
  
  Revision  Changes    Path
  1.1                  modperl-2.0/t/response/TestAPR/pool.pm
  
  Index: pool.pm
  ===================================================================
  package TestAPR::pool;
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  
  use Apache::Const -compile => 'OK';
  use APR::Pool ();
  
  sub cleanup {
      my $arg = shift;
      ok $arg == 33;
  }
  
  sub handler {
      my $r = shift;
  
      plan $r, tests => 3;
  
      my $p = APR::Pool->new;
  
      ok $p->isa('APR::Pool');
  
      my $num_bytes = $p->num_bytes;
  
      ok $num_bytes;
  
      $p->cleanup_register(\&cleanup, 33);
  
      $p->destroy;
  
      Apache::OK;
  }
  
  1;
  
  
  
  1.3       +63 -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.2
  retrieving revision 1.3
  diff -u -r1.2 -r1.3
  --- APR__Pool.h	2001/03/06 05:16:25	1.2
  +++ APR__Pool.h	2001/04/12 05:38:25	1.3
  @@ -7,3 +7,66 @@
       (void)apr_pool_create(&retval, parent);
       return retval;
   }
  +
  +/* XXX: need to properly deal with PerlInterpScope */
  +
  +typedef struct {
  +    SV *cv;
  +    SV *arg;
  +    apr_pool_t *p;
  +    PerlInterpreter *perl;
  +} mpxs_cleanup_t;
  +
  +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;
  +
  +    ENTER;SAVETMPS;
  +    PUSHMARK(SP);
  +    if (cdata->arg) {
  +        XPUSHs(cdata->arg);
  +    }
  +    PUTBACK;
  +
  +    count = call_sv(cdata->cv, G_SCALAR|G_EVAL);
  +
  +    if (count == 1) {
  +        status = POPi;
  +    }
  +
  +    PUTBACK;
  +    FREETMPS;LEAVE;
  +
  +    if (SvTRUE(ERRSV)) {
  +        /*XXX*/
  +    }
  +
  +    SvREFCNT_dec(cdata->cv);
  +    if (cdata->arg) {
  +        SvREFCNT_dec(cdata->arg);
  +    }
  +
  +    return status;
  +}
  +
  +static MP_INLINE void mpxs_apr_pool_cleanup_register(pTHX_ apr_pool_t *p,
  +                                                     SV *cv, SV *arg)
  +{
  +    mpxs_cleanup_t *data =
  +        (mpxs_cleanup_t *)apr_pcalloc(p, sizeof(*data));
  +
  +    data->cv = SvREFCNT_inc(cv);
  +    data->arg = arg ? SvREFCNT_inc(arg) : Nullsv;
  +    data->p = p;
  +#ifdef USE_ITHREADS
  +    data->perl = aTHX;
  +#endif
  +
  +    apr_pool_cleanup_register(p, data,
  +                              mpxs_cleanup_run,
  +                              apr_pool_cleanup_null);
  +}
  
  
  
  1.6       +1 -1      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.5
  retrieving revision 1.6
  diff -u -r1.5 -r1.6
  --- apr_functions.map	2001/04/10 04:01:15	1.5
  +++ apr_functions.map	2001/04/12 05:38:25	1.6
  @@ -122,7 +122,7 @@
    apr_pool_cleanup_kill
    apr_pool_cleanup_run
   -apr_pool_cleanup_null
  - apr_pool_cleanup_register
  + apr_pool_cleanup_register | mpxs_ | p, SV *:cv, SV *:arg=Nullsv
    apr_pool_sub_make
    apr_pool_note_subprocess
   -apr_palloc