dougm 01/12/22 21:46:29 Modified: src/modules/perl mod_perl.c modperl_perl_includes.h Log: nasty workaround for bug fixed in bleedperl (11536 + 11553) in $foo = \*STDOUT; where the reference would get a copy of STDOUT without the tie magic. (recentish changes that re-tied STDOUT every request uncovered an instance of the bug during 'make test') Revision Changes Path 1.100 +55 -0 modperl-2.0/src/modules/perl/mod_perl.c Index: mod_perl.c =================================================================== RCS file: /home/cvs/modperl-2.0/src/modules/perl/mod_perl.c,v retrieving revision 1.99 retrieving revision 1.100 diff -u -r1.99 -r1.100 --- mod_perl.c 2001/12/11 23:20:34 1.99 +++ mod_perl.c 2001/12/23 05:46:29 1.100 @@ -42,12 +42,67 @@ apr_pool_t *p = MP_boot_data.p; \ server_rec *s = MP_boot_data.s +#if defined(USE_ITHREADS) && defined(MP_PERL_5_6_1) +# define MP_REFGEN_FIXUP +#endif + +#ifdef MP_REFGEN_FIXUP + +/* + * nasty workaround for bug fixed in bleedperl (11536 + 11553) + * XXX: when 5.8.0 is released + stable, we will require 5.8.0 + * if ithreads are enabled. + */ +static OP * (*MP_pp_srefgen_ptr)(pTHX) = NULL; + +static OP *modperl_pp_srefgen(pTHX) +{ + dSP; + OP *o; + SV *sv = *SP; + + if (SvPADTMP(sv) && IS_PADGV(sv)) { + /* prevent S_refto from making a copy of the GV, + * tricking it to SvREFCNT_inc and point to this one instead. + */ + SvPADTMP_off(sv); + } + else { + sv = Nullsv; + } + + /* o = Perl_pp_srefgen(aTHX) */ + o = MP_pp_srefgen_ptr(aTHX); + + if (sv) { + /* restore original flags */ + SvPADTMP_on(sv); + } + + return o; +} + +static void modperl_refgen_ops_fixup(void) +{ + /* XXX: OP_REFGEN suffers a similar problem */ + if (!MP_pp_srefgen_ptr) { + MP_pp_srefgen_ptr = PL_ppaddr[OP_SREFGEN]; + PL_ppaddr[OP_SREFGEN] = MEMBER_TO_FPTR(modperl_pp_srefgen); + } +} + +#endif /* MP_REFGEN_FIXUP */ + static void modperl_boot(void *data) { MP_dBOOT_DATA; dTHX; /* XXX: not too worried since this only happens at startup */ int i; +#ifdef MP_REFGEN_FIXUP + modperl_refgen_ops_fixup(); +#endif + modperl_env_clear(aTHX); modperl_env_default_populate(aTHX); 1.9 +4 -0 modperl-2.0/src/modules/perl/modperl_perl_includes.h Index: modperl_perl_includes.h =================================================================== RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_includes.h,v retrieving revision 1.8 retrieving revision 1.9 diff -u -r1.8 -r1.9 --- modperl_perl_includes.h 2001/11/07 03:14:54 1.8 +++ modperl_perl_includes.h 2001/12/23 05:46:29 1.9 @@ -35,6 +35,10 @@ #include "perl.h" #include "XSUB.h" +#if (PERL_REVISION == 5) && (PERL_VERSION == 6) && (PERL_SUBVERSION == 1) +# define MP_PERL_5_6_1 +#endif + #ifdef PERL_CORE # ifndef croak # define croak Perl_croak_nocontext