stas2004/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 ChangesPath
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 - 1.63
+++ WrapXS.pm 31 Jan 2004 10:06:59 - 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 -2modperl-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 - 1.7
+++ pool.pm 31 Jan 2004 10:06:59 - 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 ki
