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