1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
# please insert nothing before this line: -*- mode: cperl; cperl-indent-level: 4; cperl-continued-statement-offset: 4; indent-tabs-mode: nil -*-
package TestPerl::ithreads3;
use strict;
use warnings FATAL => 'all';
use Apache2::RequestRec;
use Apache2::RequestIO;
use Apache2::RequestUtil;
use APR::Pool;
use Apache2::Const -compile => 'OK', 'DECLINED';
# XXX: These tests rely on the assumption that the virtual host is not
# otherwise accessed. In this case the same interpreter is chosen
# for each phase. The $counter counts them.
# Of course if only 1 interp is configured it must be hit each time.
my $counter=0;
sub response {
my $r=shift;
$r->content_type('text/plain');
$r->print($counter);
return Apache2::Const::OK;
}
sub count { $counter++; return Apache2::Const::DECLINED; }
sub clear_pool {
delete $_[0]->pnotes->{my_pool};
return Apache2::Const::DECLINED;
}
sub trans {
my $r=shift;
my $test=$r->args;
$counter=0;
if( $test eq '1' ) {
# this is to check for a bug in modperl_response_handler versus
# modperl_response_handler_cgi. The former used to allocate an
# extra interpreter for its work. In both cases $counter should be
# 2 in the response phase
$r->push_handlers( PerlMapToStorageHandler=>__PACKAGE__.'::count' );
$r->push_handlers( PerlFixupHandler=>__PACKAGE__.'::count' );
}
elsif( $test eq '2' ) {
# now add an extra PerlCleanupHandler. It is run each time the
# interp is released. So it is run after Trans, MapToStorage and
# Fixup. In the response phase $counter should be 5. After Response
# it is run again but that is after.
# This used to eat up all interpreters because modperl_interp_unselect
# calls modperl_config_request_cleanup that allocates a new interp
# to handle the cleanup. When this interp is then unselected
# modperl_interp_unselect gets called again but the cleanup handler is
# still installed. So the cycle starts again until all interpreters
# are in use or the stack runs out. Then the thread is locked infinitely
# or a segfault appears.
$r->push_handlers( PerlMapToStorageHandler=>__PACKAGE__.'::count' );
$r->push_handlers( PerlFixupHandler=>__PACKAGE__.'::count' );
$r->push_handlers( PerlCleanupHandler=>__PACKAGE__.'::count' );
}
elsif( $test eq '3' ) {
# a subpool adds an extra reference to the interp. So it is preserved
# and bound to the request until the pool is destroyed. So the cleanup
# handler is run only once after Fixup. Hence the counter is 3.
$r->push_handlers( PerlMapToStorageHandler=>__PACKAGE__.'::count' );
$r->push_handlers( PerlFixupHandler=>__PACKAGE__.'::count' );
$r->push_handlers( PerlCleanupHandler=>__PACKAGE__.'::count' );
$r->pnotes->{my_pool}=$r->pool->new;
$r->push_handlers( PerlFixupHandler=>__PACKAGE__.'::clear_pool' );
}
return Apache2::Const::DECLINED;
}
1;
__END__
# APACHE_TEST_CONFIG_ORDER 942
<VirtualHost TestPerl::ithreads3>
<IfDefine PERL_USEITHREADS>
# a new interpreter pool
PerlOptions +Parent
PerlInterpStart 3
PerlInterpMax 3
PerlInterpMinSpare 1
PerlInterpMaxSpare 3
PerlInterpScope handler
</IfDefine>
# use test system's @INC
PerlSwitches -I@serverroot@
PerlRequire "conf/modperl_inc.pl"
PerlModule TestPerl::ithreads3
<Location /modperl>
SetHandler modperl
PerlResponseHandler TestPerl::ithreads3::response
</Location>
<Location /perl-script>
SetHandler perl-script
PerlResponseHandler TestPerl::ithreads3::response
</Location>
PerlTransHandler TestPerl::ithreads3::trans
</VirtualHost>
|
