That looks very similar to the mp2 test.
t/filter/TestFilter/both_str_req_proxy.pm
Since you didn't run the mp2 test suite at all I'd suggest to start there.
I'd be happy to run a few cases, if you can point me to some documentation.
Absolutely: http://perl.apache.org/docs/2.0/os/win32/index.html Courtesy of Randy Kobes, the brave win32 warrior.
I'll try to play with it and see if I can reproduce it. Mind you, I'm not running on win32.
I'm curious whether you __can__ reproduce it then, since the problem seems related to threading...
Yes, I should be able to, building perl with special patches (attached) and build arguments. There are unpolished yet and therefore not a part of the core. The patches are courtesy of Jan Dubois. After applying these patches, to build perl you need to add:
./Configure -des [...] \ -Accflags="-DPERL_IMPLICIT_CONTEXT -DPERL_TRACK_MEMPOOL"
Again, you don't need to do that on Win32. You need that to try to emulate perl's memory managment on win32, which differs from the rest of platforms. So with this patch I run the mp2 test suite without a hitch, so if you can modify the test that I've mentioned (closest one to your case) to break, I'll be able to fix it.
You can verify it by simply running tomcat in the backend, and reverse proxy http://localhost:8080/manager, you will see the same behavior.
right, "simply running tomcat"...
Much simpler then setting up Exchange I can tell you ;-)
:) __________________________________________________________________ Stas Bekman JAm_pH ------> Just Another mod_perl Hacker http://stason.org/ mod_perl Guide ---> http://perl.apache.org mailto:[EMAIL PROTECTED] http://use.perl.org http://apacheweek.com http://modperlbook.org http://apache.org http://ticketmaster.com
--- 1/perl-5.8.3/util.c 2003-12-18 12:48:02.000000000 -0800
+++ perl-5.8.3/util.c 2004-01-21 17:15:41.000000000 -0800
@@ -60,6 +60,9 @@
my_exit(1);
}
#endif /* HAS_64K_LIMIT */
+#if defined(PERL_IMPLICIT_CONTEXT) && defined(PERL_TRACK_MEMPOOL)
+ size += sizeof(aTHX);
+#endif
#ifdef DEBUGGING
if ((long)size < 0)
Perl_croak_nocontext("panic: malloc");
@@ -67,8 +70,13 @@
ptr = (Malloc_t)PerlMem_malloc(size?size:1); /* malloc(0) is NASTY on our system */
PERL_ALLOC_CHECK(ptr);
DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) malloc %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size));
- if (ptr != Nullch)
+ if (ptr != Nullch) {
+#if defined(PERL_IMPLICIT_CONTEXT) && defined(PERL_TRACK_MEMPOOL)
+ *(PerlInterpreter**)ptr = aTHX;
+ ptr = (Malloc_t)((char*)ptr+sizeof(aTHX));
+#endif
return ptr;
+ }
else if (PL_nomemok)
return Nullch;
else {
@@ -104,6 +112,12 @@
if (!where)
return safesysmalloc(size);
+#if defined(PERL_IMPLICIT_CONTEXT) && defined(PERL_TRACK_MEMPOOL)
+ where = (Malloc_t)((char*)where-sizeof(aTHX));
+ size += sizeof(aTHX);
+ if (*(PerlInterpreter**)where != aTHX)
+ Perl_croak_nocontext("panic: realloc from wrong pool");
+#endif
#ifdef DEBUGGING
if ((long)size < 0)
Perl_croak_nocontext("panic: realloc");
@@ -114,8 +128,12 @@
DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) rfree\n",PTR2UV(where),(long)PL_an++));
DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) realloc %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size));
- if (ptr != Nullch)
+ if (ptr != Nullch) {
+#if defined(PERL_IMPLICIT_CONTEXT) && defined(PERL_TRACK_MEMPOOL)
+ ptr = (Malloc_t)((char*)ptr+sizeof(aTHX));
+#endif
return ptr;
+ }
else if (PL_nomemok)
return Nullch;
else {
@@ -131,11 +149,16 @@
Free_t
Perl_safesysfree(Malloc_t where)
{
-#ifdef PERL_IMPLICIT_SYS
+#if defined(PERL_IMPLICIT_CONTEXT) || defined(PERL_TRACK_MEMPOOL)
dTHX;
#endif
DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) free\n",PTR2UV(where),(long)PL_an++));
if (where) {
+#if defined(PERL_IMPLICIT_CONTEXT) && defined(PERL_TRACK_MEMPOOL)
+ where = (Malloc_t)((char*)where-sizeof(aTHX));
+ if (*(PerlInterpreter**)where != aTHX)
+ Perl_croak_nocontext("panic: free from wrong pool");
+#endif
/*SUPPRESS 701*/
PerlMem_free(where);
}
@@ -161,11 +184,18 @@
Perl_croak_nocontext("panic: calloc");
#endif
size *= count;
+#if defined(PERL_IMPLICIT_CONTEXT) && defined(PERL_TRACK_MEMPOOL)
+ size += sizeof(aTHX);
+#endif
ptr = (Malloc_t)PerlMem_malloc(size?size:1); /* malloc(0) is NASTY on our system */
PERL_ALLOC_CHECK(ptr);
DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) calloc %ld x %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)count,(long)size));
if (ptr != Nullch) {
memset((void*)ptr, 0, size);
+#if defined(PERL_IMPLICIT_CONTEXT) && defined(PERL_TRACK_MEMPOOL)
+ *(PerlInterpreter**)ptr = aTHX;
+ ptr = (Malloc_t)((char*)ptr+sizeof(aTHX));
+#endif
return ptr;
}
else if (PL_nomemok)
diff -ur 1/perl-5.8.3/perl.h perl-5.8.3/perl.h
--- 1/perl-5.8.3/perl.h 2003-12-14 12:25:21.000000000 -0800
+++ perl-5.8.3/perl.h 2004-01-24 16:16:23.000000000 -0800
@@ -122,6 +122,18 @@
# define pTHX_2 3
# define pTHX_3 4
# define pTHX_4 5
+# if defined(PERL_TRACK_MEMPOOL) && defined(PERL_IMPLICIT_CONTEXT)
+# define CHECK_MEMPOOL(p) \
+ if (*(PerlInterpreter**)((char*)p-sizeof(aTHX)) != aTHX) { \
+ int *nowhere = NULL; \
+ Perl_warn(aTHX_ "panic: modifying memory from wrong pool"); \
+ *nowhere = 0; \
+ }
+# endif
+#endif
+
+#ifndef CHECK_MEMPOOL
+# define CHECK_MEMPOOL(p)
#endif
#define STATIC static
diff -ur 1/perl-5.8.3/sv.c perl-5.8.3/sv.c
--- 1/perl-5.8.3/sv.c 2004-01-14 05:40:13.000000000 -0800
+++ perl-5.8.3/sv.c 2004-01-24 16:35:32.000000000 -0800
@@ -170,6 +170,21 @@
} STMT_END
+#if defined(PERL_IMPLICIT_CONTEXT) && defined(PERL_TRACK_MEMPOOL)
+STATIC SV*
+S_new_SV()
+{
+ SV* sv = safemalloc(sizeof(SV));
+ SvANY(sv) = 0;
+ SvREFCNT(sv) = 1;
+ SvFLAGS(sv) = 0;
+ return sv;
+}
+
+# define new_SV(p) (p)=S_new_SV()
+# define del_SV(p) safefree((char*)p)
+#else
+
/* new_SV(): return a new, empty SV head */
#ifdef DEBUG_LEAKING_SCALARS
@@ -253,6 +268,7 @@
#endif /* DEBUGGING */
+#endif
/*
=head1 SV Manipulation Functions
@@ -1633,6 +1649,7 @@
SvFAKE_off(sv);
SvREADONLY_off(sv);
}
+ CHECK_MEMPOOL(sv);
New(703, s, newlen, char);
if (SvPVX(sv) && SvCUR(sv)) {
Move(SvPVX(sv), s, (newlen < SvCUR(sv)) ? newlen : SvCUR(sv), char);
@@ -10580,6 +10597,23 @@
EXTERN_C PerlInterpreter *
perl_clone_host(PerlInterpreter* proto_perl, UV flags);
+#if defined(PERL_IMPLICIT_CONTEXT) && defined(PERL_TRACK_MEMPOOL)
+STATIC void
+S_sv_initpv(pTHX_ SV *sv, const char *ptr)
+{
+ STRLEN len = strlen(ptr);
+ sv_upgrade(sv, SVt_PV);
+ New(703, SvPVX(sv), len+1, char);
+ Move(ptr, SvPVX(sv), len+1, char);
+ SvCUR(sv) = len;
+ SvLEN(sv) = len+1;
+ SvPOK_only_UTF8(sv);
+}
+# define sv_initpv(sv, ptr) S_sv_initpv(aTHX_ sv, ptr)
+#else
+# define sv_initpv(sv, ptr) sv_setpv(sv, ptr)
+#endif
+
PerlInterpreter *
perl_clone(PerlInterpreter *proto_perl, UV flags)
{
@@ -10818,9 +10852,9 @@
#endif
PL_encoding = sv_dup(proto_perl->Iencoding, param);
- sv_setpvn(PERL_DEBUG_PAD(0), "", 0); /* For regex debugging. */
- sv_setpvn(PERL_DEBUG_PAD(1), "", 0); /* ext/re needs these */
- sv_setpvn(PERL_DEBUG_PAD(2), "", 0); /* even without DEBUGGING. */
+ sv_initpv(PERL_DEBUG_PAD(0), ""); /* For regex debugging. */
+ sv_initpv(PERL_DEBUG_PAD(1), ""); /* ext/re needs these */
+ sv_initpv(PERL_DEBUG_PAD(2), ""); /* even without DEBUGGING. */
/* Clone the regex array */
PL_regex_padav = newAV();-- Report problems: http://perl.apache.org/bugs/ Mail list info: http://perl.apache.org/maillist/modperl.html List etiquette: http://perl.apache.org/maillist/email-etiquette.html
