On Thursday 18 October 2007, Philippe M. Chiasson wrote: > Any chance you can break the patch into multiple patches
This one adds ModPerl::InterpPool, ModPerl::TiPool and ModPerl::TiPoolConfig, changes ModPerl::Interpreter a bit and provides some basic testing. Torsten
Index: xs/maps/modperl_structures.map
===================================================================
--- xs/maps/modperl_structures.map (revision 2)
+++ xs/maps/modperl_structures.map (working copy)
@@ -12,3 +12,29 @@
< refcnt
- tid
</modperl_interp_t>
+
+<modperl_interp_pool_t>
+< server
+< tipool
+< parent
+</modperl_interp_pool_t>
+
+<modperl_tipool_t>
+- tiplock
+- available
+- idle
+- busy
+< in_use
+< size
+- data
+< cfg
+- func
+</modperl_tipool_t>
+
+<modperl_tipool_config_t>
+< start
+< min_spare
+< max_spare
+< max
+< max_requests
+</modperl_tipool_config_t>
Index: xs/maps/modperl_types.map
===================================================================
--- xs/maps/modperl_types.map (revision 2)
+++ xs/maps/modperl_types.map (working copy)
@@ -1,9 +1,11 @@
########## mod_perl types ##########
-struct modperl_filter_t | Apache2::OutputFilter
-struct modperl_interp_t | ModPerl::Interpreter
-modperl_interp_pool_t * | IV
-PerlInterpreter * | IV
+struct modperl_filter_t | Apache2::OutputFilter
+struct modperl_interp_t | ModPerl::Interpreter
+struct modperl_interp_pool_t | ModPerl::InterpPool
+struct modperl_tipool_t | ModPerl::TiPool
+struct modperl_tipool_config_t | ModPerl::TiPoolConfig
+PerlInterpreter * | IV
########## Perl types ##########
Index: xs/maps/modperl_functions.map
===================================================================
--- xs/maps/modperl_functions.map (revision 9)
+++ xs/maps/modperl_functions.map (working copy)
@@ -166,4 +166,4 @@
mpxs_Apache2__RequestRec_allow_override_opts
MODULE=ModPerl::Interpreter
- mpxs_ModPerl__Interpreter_current
+ mpxs_ModPerl__Interpreter_current | | class=Nullsv
Index: xs/ModPerl/Interpreter/ModPerl__Interpreter.h
===================================================================
--- xs/ModPerl/Interpreter/ModPerl__Interpreter.h (revision 2)
+++ xs/ModPerl/Interpreter/ModPerl__Interpreter.h (working copy)
@@ -15,7 +15,7 @@
*/
static MP_INLINE
-modperl_interp_t *mpxs_ModPerl__Interpreter_current(pTHX)
+modperl_interp_t *mpxs_ModPerl__Interpreter_current(pTHX_ SV *class)
{
return MP_THX_INTERP_GET(aTHX);
}
Index: xs/tables/current/ModPerl/FunctionTable.pm
===================================================================
--- xs/tables/current/ModPerl/FunctionTable.pm (revision 9)
+++ xs/tables/current/ModPerl/FunctionTable.pm (working copy)
@@ -8249,6 +8249,10 @@
{
'type' => 'PerlInterpreter *',
'name' => 'my_perl'
+ },
+ {
+ 'type' => 'SV *',
+ 'name' => 'class'
}
]
}
Index: xs/tables/current/Apache2/StructureTable.pm
===================================================================
--- xs/tables/current/Apache2/StructureTable.pm (revision 2)
+++ xs/tables/current/Apache2/StructureTable.pm (working copy)
@@ -3366,6 +3366,93 @@
'name' => 'tid'
}
]
+ },
+ {
+ 'type' => 'modperl_interp_pool_t',
+ 'elts' => [
+ {
+ 'type' => 'server_rec *',
+ 'name' => 'server'
+ },
+ {
+ 'type' => 'modperl_tipool_t *',
+ 'name' => 'tipool'
+ },
+ {
+ 'type' => 'modperl_tipool_config_t *',
+ 'name' => 'tipool_cfg'
+ },
+ {
+ 'type' => 'modperl_interp_t *',
+ 'name' => 'parent'
+ }
+ ]
+ },
+ {
+ 'type' => 'modperl_tipool_t',
+ 'elts' => [
+ {
+ 'type' => 'perl_mutex',
+ 'name' => 'tiplock'
+ },
+ {
+ 'type' => 'perl_cond',
+ 'name' => 'available'
+ },
+ {
+ 'type' => 'modperl_list_t *',
+ 'name' => 'idle'
+ },
+ {
+ 'type' => 'modperl_list_t *',
+ 'name' => 'busy'
+ },
+ {
+ 'type' => 'int',
+ 'name' => 'in_use'
+ },
+ {
+ 'type' => 'int',
+ 'name' => 'size'
+ },
+ {
+ 'type' => 'void *',
+ 'name' => 'data'
+ },
+ {
+ 'type' => 'modperl_tipool_config_t *',
+ 'name' => 'cfg'
+ },
+ {
+ 'type' => 'modperl_tipool_vtbl_t *',
+ 'name' => 'func'
+ }
+ ]
+ },
+ {
+ 'type' => 'modperl_tipool_config_t',
+ 'elts' => [
+ {
+ 'type' => 'int',
+ 'name' => 'start'
+ },
+ {
+ 'type' => 'int',
+ 'name' => 'min_spare'
+ },
+ {
+ 'type' => 'int',
+ 'name' => 'max_spare'
+ },
+ {
+ 'type' => 'int',
+ 'name' => 'max'
+ },
+ {
+ 'type' => 'int',
+ 'name' => 'max_requests'
+ }
+ ]
}
];
Index: t/response/TestModperl/interpreter.pm
===================================================================
--- t/response/TestModperl/interpreter.pm (revision 2)
+++ t/response/TestModperl/interpreter.pm (working copy)
@@ -1,7 +1,5 @@
package TestModperl::interpreter;
-# Modperl::Util tests
-
use strict;
use warnings FATAL => 'all';
@@ -9,25 +7,76 @@
use Apache::TestUtil;
use ModPerl::Interpreter ();
+use ModPerl::InterpPool ();
+use ModPerl::TiPool ();
+use ModPerl::TiPoolConfig ();
+use Apache2::MPM ();
use Apache2::Const -compile => 'OK';
sub handler {
my $r = shift;
- plan $r, tests => 5;
-
- my $interp = ModPerl::Interpreter::current();
- print STDERR Dumper($interp); use Data::Dumper;
- ok t_cmp ref($interp), 'ModPerl::Interpreter';
-
- ok $interp->num_requests > 0;
- ok $interp->refcnt > 0;
- ok $interp->mip > 0;
- ok $interp->perl > 0;
+ my $is_worker=Apache2::MPM->is_threaded;
+ plan $r, tests => $is_worker?17:5;
+
+ my $interp = ModPerl::Interpreter->current;
+
+ ok t_cmp(ref($interp), 'ModPerl::Interpreter',
+ 'interp is a ModPerl::Interpreter');
+
+ ok t_cmp($$interp==${ModPerl::Interpreter::current()}, !!1,
+ 'ModPerl::Interpreter->current == ModPerl::Interpreter::current');
+
+ my $mip = $interp->mip;
+
+ ok t_cmp(ref($mip), 'ModPerl::InterpPool',
+ 'interp->mip is a ModPerl::InterpPool');
+
+ ok t_cmp(${$mip->server}==${$r->server}, !!1,
+ 'mip->server == r->server');
+
+ ok t_cmp(ref($mip->parent), 'ModPerl::Interpreter',
+ 'mip->parent is a ModPerl::Interpreter');
+
+ if($is_worker) {
+ ok t_cmp($interp->perl!=0, !!1, 'interp->perl');
+ ok t_cmp($interp->num_requests>0, !!1, 'interp->num_requests');
+ ok t_cmp($interp->refcnt>0, !!1, 'interp->refcnt');
+
+ my $tipool = $mip->tipool;
+
+ ok t_cmp(ref($tipool), 'ModPerl::TiPool',
+ 'mip->tipool is a ModPerl::TiPool');
+
+ ok t_cmp($tipool->in_use!=0, !!1, 'tipool->in_use');
+
+ ok t_cmp($tipool->size!=0, !!1, 'tipool->size');
+
+ my $tipcfg = $tipool->cfg;
+
+ ok t_cmp(ref($tipcfg), 'ModPerl::TiPoolConfig',
+ 'tipool->cfg is a ModPerl::TiPoolConfig');
+
+ ok t_cmp($tipcfg->start!=0, !!1, 'tipcfg->start');
+
+ ok t_cmp($tipcfg->min_spare!=0, !!1, 'tipcfg->min_spare');
+
+ ok t_cmp($tipcfg->max_spare!=0, !!1, 'tipcfg->max_spare');
+
+ ok t_cmp($tipcfg->max!=0, !!1, 'tipcfg->max');
+
+ ok t_cmp($tipcfg->max_requests!=0, !!1, 'tipcfg->max_requests');
+ }
+
Apache2::Const::OK;
}
1;
__END__
+
+# Local Variables: #
+# mode: cperl #
+# cperl-indent-level: 4 #
+# End: #
signature.asc
Description: This is a digitally signed message part.
