You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by do...@apache.org on 2001/12/23 06:46:29 UTC
cvs commit: modperl-2.0/src/modules/perl mod_perl.c modperl_perl_includes.h
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