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