1# please insert nothing before this line: -*- mode: cperl; cperl-indent-level: 4; cperl-continued-statement-offset: 4; indent-tabs-mode: nil -*-
2package TestAPR::pool;
3
4use strict;
5use warnings FATAL => 'all';
6
7use Apache::Test;
8use Apache::TestUtil;
9use Apache::TestTrace;
10
11use Apache2::RequestRec ();
12use APR::Pool ();
13use APR::Table ();
14
15use Apache2::Const -compile => 'OK';
16
17use TestAPRlib::pool;
18
19sub handler {
20    my $r = shift;
21
22    plan $r, tests => 4 + TestAPRlib::pool::num_of_tests();
23
24    ### native pools ###
25
26    # explicit destroy shouldn't destroy native pools
27    {
28        my $p = $r->pool;
29
30        my $count = TestAPRlib::pool::ancestry_count($p);
31        t_debug "\$r->pool has 2 or more ancestors (found $count)";
32        ok $count >= 2;
33
34        $p->cleanup_register(\&set_cleanup, [$r, 'native destroy']);
35
36        $p->destroy;
37
38        my @notes = $r->notes->get('cleanup');
39
40        ok t_cmp(scalar(@notes), 0, "should be 0 notes");
41
42        $r->notes->clear;
43    }
44
45
46    # implicit DESTROY shouldn't destroy native pools
47    {
48        {
49            my $p = $r->pool;
50
51            my $count = TestAPRlib::pool::ancestry_count($p);
52            t_debug "\$r->pool has 2 or more ancestors (found $count)";
53            ok $count >= 2;
54
55            $p->cleanup_register(\&set_cleanup, [$r, 'native scoped']);
56        }
57
58        my @notes = $r->notes->get('cleanup');
59
60        ok t_cmp(scalar(@notes), 0, "should be 0 notes");
61
62        $r->notes->clear;
63    }
64
65    TestAPRlib::pool::test();
66
67    Apache2::Const::OK;
68}
69
70sub set_cleanup {
71    my $arg = shift;
72    debug "setting cleanup note: $arg->[1]";
73    $arg->[0]->notes->set(cleanup => $arg->[1]);
74    1;
75}
76
77
781;
79