I am going to post a more detailled explanation of the following patch in a little bit, but it takes care of one more *big* bug that would basically segfault against threads Perl as soon as perl-level threads were spawned. Not good.
The patches fixes that part for me, and the test suite is looking much happier by now. Before I check this in, I need to clean things up a little more and I am worried this could introduce the usual Win32 breakeage and possibly against Perl 5.6, all and any testing certainly welcome from the folks already jumping to 5.10 Failed Test Stat Wstat Total Fail List of Failed ------------------------------------------------------------------------------- t/directive/perlloadmodule.t 255 65280 ?? ?? ?? t/directive/perlrequire.t 2 1 1 t/perl/ithreads2.t 255 65280 ?? ?? ?? 6 tests and 17 subtests skipped. Failed 3/244 test scripts. 1/2631 subtests failed. Files=244, Tests=2631, 208 wallclock secs (142.38 cusr + 18.50 csys = 160.88 CPU) Not quite "works with Perl 5.10" yet, but getting there. -- Philippe M. Chiasson GPG: F9BFE0C2480E7680 1AE53631CB32A107 88C3A5A5 http://gozer.ectoplasm.org/ m/gozer\@(apache|cpan|ectoplasm)\.org/
Index: Changes
===================================================================
--- Changes (revision 617957)
+++ Changes (working copy)
@@ -12,6 +12,9 @@
=item 2.0.4-dev
+Fix a crash when spawning Perl threads with Perl 5.10
+[Gozer]
+
Fix erratic behaviour when filters were used with Perl 5.10
[Gozer]
Index: lib/ModPerl/WrapXS.pm
===================================================================
--- lib/ModPerl/WrapXS.pm (revision 617957)
+++ lib/ModPerl/WrapXS.pm (working copy)
@@ -597,6 +597,7 @@
if ($module eq 'APR::Pool') {
print $fh " modperl_opt_interp_unselect =
APR_RETRIEVE_OPTIONAL_FN(modperl_interp_unselect);\n\n";
+ print $fh " modperl_opt_thx_interp_get =
APR_RETRIEVE_OPTIONAL_FN(modperl_thx_interp_get);\n\n";
}
close $fh;
Index: xs/APR/Pool/APR__Pool.h
===================================================================
--- xs/APR/Pool/APR__Pool.h (revision 617957)
+++ xs/APR/Pool/APR__Pool.h (working copy)
@@ -42,6 +42,7 @@
#include "apr_optional.h"
static
APR_OPTIONAL_FN_TYPE(modperl_interp_unselect) *modperl_opt_interp_unselect;
+APR_OPTIONAL_FN_TYPE(modperl_thx_interp_get) *modperl_opt_thx_interp_get;
#endif
#define MP_APR_POOL_SV_HAS_OWNERSHIP(sv) mpxs_pool_is_custom(sv)
@@ -95,9 +96,11 @@
/* make sure interpreter is not putback into the mip \
* until this cleanup has run. \
*/ \
- if ((acct->interp = MP_THX_INTERP_GET(aTHX))) { \
+ if (modperl_opt_thx_interp_get) { \
+ if ((acct->interp = modperl_opt_thx_interp_get(aTHX))) { \
acct->interp->refcnt++; \
} \
+ } \
} STMT_END
#else /* !USE_ITHREADS */
@@ -335,9 +338,11 @@
/* make sure interpreter is not putback into the mip
* until this cleanup has run.
*/
- if ((data->interp = MP_THX_INTERP_GET(data->perl))) {
+ if (modperl_opt_thx_interp_get) {
+ if ((data->interp = modperl_opt_thx_interp_get(data->perl))) {
data->interp->refcnt++;
}
+ }
#endif
apr_pool_cleanup_register(p, data,
Index: xs/tables/current/ModPerl/FunctionTable.pm
===================================================================
--- xs/tables/current/ModPerl/FunctionTable.pm (revision 617957)
+++ xs/tables/current/ModPerl/FunctionTable.pm (working copy)
@@ -5044,7 +5044,31 @@
'args' => []
},
{
+ 'return_type' => 'modperl_interp_t *',
+ 'name' => 'modperl_thx_interp_get',
+ 'args' => [
+ {
+ 'type' => 'PerlInterpreter *',
+ 'name' => 'thx',
+ },
+ ],
+ },
+ {
'return_type' => 'void',
+ 'name' => 'modperl_thx_interp_set',
+ 'args' => [
+ {
+ 'type' => 'PerlInterpreter *',
+ 'name' => 'thx',
+ },
+ {
+ 'type' => 'modperl_interp_t *',
+ 'name' => 'interp',
+ },
+ ],
+ },
+ {
+ 'return_type' => 'void',
'name' => 'modperl_tipool_add',
'args' => [
{
Index: src/modules/perl/mod_perl.c
===================================================================
--- src/modules/perl/mod_perl.c (revision 617957)
+++ src/modules/perl/mod_perl.c (working copy)
@@ -835,6 +835,7 @@
#ifdef USE_ITHREADS
APR_REGISTER_OPTIONAL_FN(modperl_interp_unselect);
+ APR_REGISTER_OPTIONAL_FN(modperl_thx_interp_get);
#endif
/* for <IfDefine MODPERL2> and Apache2->define("MODPERL2") */
Index: src/modules/perl/mod_perl.h
===================================================================
--- src/modules/perl/mod_perl.h (revision 617957)
+++ src/modules/perl/mod_perl.h (working copy)
@@ -149,6 +149,7 @@
#define MODPERL_HOOK_REALLY_REALLY_FIRST (-20)
APR_DECLARE_OPTIONAL_FN(apr_status_t,modperl_interp_unselect,(void *));
+APR_DECLARE_OPTIONAL_FN(modperl_interp_t
*,modperl_thx_interp_get,(PerlInterpreter *));
/*
* perl context overriding and restoration is required when
Index: src/modules/perl/modperl_interp.c
===================================================================
--- src/modules/perl/modperl_interp.c (revision 617957)
+++ src/modules/perl/modperl_interp.c (working copy)
@@ -291,7 +291,7 @@
MpInterpIN_USE_Off(interp);
MpInterpPUTBACK_Off(interp);
- MP_THX_INTERP_SET(interp->perl, NULL);
+ modperl_thx_interp_set(interp->perl, NULL);
modperl_tipool_putback_data(mip->tipool, data, interp->num_requests);
@@ -506,7 +506,7 @@
/* set context (THX) for this thread */
PERL_SET_CONTEXT(interp->perl);
- MP_THX_INTERP_SET(interp->perl, interp);
+ modperl_thx_interp_set(interp->perl, interp);
return interp;
}
@@ -575,6 +575,23 @@
}
}
+#define MP_THX_INTERP_KEY "modperl2::thx_interp_key"
+modperl_interp_t *modperl_thx_interp_get(PerlInterpreter *thx)
+{
+ modperl_interp_t *interp;
+ dTHXa(thx);
+ SV **svp = hv_fetch(PL_modglobal, MP_THX_INTERP_KEY,
strlen(MP_THX_INTERP_KEY), 0);
+ interp = INT2PTR(modperl_interp_t *, SvIV(*svp));
+ return interp;
+}
+
+void modperl_thx_interp_set(PerlInterpreter *thx, modperl_interp_t *interp)
+{
+ dTHXa(thx);
+ hv_store(PL_modglobal, MP_THX_INTERP_KEY, strlen(MP_THX_INTERP_KEY),
newSViv(PTR2IV(interp)), 0);
+ return;
+}
+
#else
void modperl_interp_init(server_rec *s, apr_pool_t *p,
Index: src/modules/perl/modperl_interp.h
===================================================================
--- src/modules/perl/modperl_interp.h (revision 617957)
+++ src/modules/perl/modperl_interp.h (working copy)
@@ -24,43 +24,9 @@
#ifdef USE_ITHREADS
-/*
- * HvPMROOT will never be used by Perl with PL_modglobal.
- * so we have stolen it as a quick way to stash the interp
- * pointer.
- *
- * However in 5.9.3 HvPMROOT was completely removed, so we have moved
- * to use another struct member that's hopefully won't be used by
- * anybody else. But if we can find a better place to store the
- * pointer to the current mod_perl interpreter object it'd be a much
- * cleaner solution. of course it must be really fast.
- */
-#ifndef HvPMROOT
-# if MP_PERL_VERSION_AT_LEAST(5, 9, 5)
-#define MP_THX_INTERP_GET(thx) \
- (modperl_interp_t *)
((XPVMG*)SvANY(*Perl_Imodglobal_ptr(thx)))->xmg_u.xmg_magic
-# else
-#define MP_THX_INTERP_GET(thx) \
- (modperl_interp_t *)
((XPVMG*)SvANY(*Perl_Imodglobal_ptr(thx)))->xmg_magic
-# endif
-#else
-#define MP_THX_INTERP_GET(thx) \
- (modperl_interp_t *)HvPMROOT(*Perl_Imodglobal_ptr(thx))
-#endif
+modperl_interp_t *modperl_thx_interp_get(PerlInterpreter *thx);
+void modperl_thx_interp_set(PerlInterpreter *thx, modperl_interp_t *interp);
-#ifndef HvPMROOT
-# if MP_PERL_VERSION_AT_LEAST(5, 9, 5)
-#define MP_THX_INTERP_SET(thx, interp) \
- ((XPVMG*)SvANY(*Perl_Imodglobal_ptr(thx)))->xmg_u.xmg_magic =
(MAGIC*)interp
-# else
-#define MP_THX_INTERP_SET(thx, interp) \
- ((XPVMG*)SvANY(*Perl_Imodglobal_ptr(thx)))->xmg_magic = (MAGIC*)interp
-# endif
-#else
-#define MP_THX_INTERP_SET(thx, interp) \
- HvPMROOT(*Perl_Imodglobal_ptr(thx)) = (PMOP*)interp
-#endif
-
const char *modperl_interp_scope_desc(modperl_interp_scope_e scope);
void modperl_interp_clone_init(modperl_interp_t *interp);
signature.asc
Description: OpenPGP digital signature
