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 2002/10/22 04:42:04 UTC

cvs commit: modperl-2.0/t/response/TestModperl env.pm

dougm       2002/10/21 19:42:03

  Modified:    .        Changes
               src/modules/perl modperl_env.c modperl_env.h
                        modperl_perl_global.c
               t/response/TestModperl env.pm
  Log:
  fix delete $ENV{$key} bug
  
  Revision  Changes    Path
  1.56      +2 -0      modperl-2.0/Changes
  
  Index: Changes
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/Changes,v
  retrieving revision 1.55
  retrieving revision 1.56
  diff -u -r1.55 -r1.56
  --- Changes	21 Oct 2002 20:21:33 -0000	1.55
  +++ Changes	22 Oct 2002 02:42:03 -0000	1.56
  @@ -10,6 +10,8 @@
   
   =item 1.99_08-dev
   
  +fix delete $ENV{$key} bug
  +
   fix parse_args compat method to support non-ascii characters
   [Walery Studennikov <de...@sama.ru>]
   
  
  
  
  1.26      +4 -1      modperl-2.0/src/modules/perl/modperl_env.c
  
  Index: modperl_env.c
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_env.c,v
  retrieving revision 1.25
  retrieving revision 1.26
  diff -u -r1.25 -r1.26
  --- modperl_env.c	1 Jun 2002 23:42:07 -0000	1.25
  +++ modperl_env.c	22 Oct 2002 02:42:03 -0000	1.26
  @@ -15,6 +15,7 @@
       else {
           SV *sv = newSVpv(elt->val, 0);
           hv_store(hv, elt->key, klen, sv, FALSE);
  +        modperl_envelem_tie(sv, elt->key, klen);
           svp = &sv;
       }
   
  @@ -143,8 +144,10 @@
       modperl_env_untie(mg_flags);
   
       while (ent->key) {
  +        SV *sv = newSVpvn(ent->val, ent->vlen);
           hv_store(hv, ent->key, ent->klen,
  -                 newSVpvn(ent->val, ent->vlen), ent->hash);
  +                 sv, ent->hash);
  +        modperl_envelem_tie(sv, ent->key, ent->klen);
           ent++;
       }
   
  
  
  
  1.13      +3 -0      modperl-2.0/src/modules/perl/modperl_env.h
  
  Index: modperl_env.h
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_env.h,v
  retrieving revision 1.12
  retrieving revision 1.13
  diff -u -r1.12 -r1.13
  --- modperl_env.h	30 May 2002 23:35:02 -0000	1.12
  +++ modperl_env.h	22 Oct 2002 02:42:03 -0000	1.13
  @@ -11,6 +11,9 @@
   #define modperl_env_tie(mg_flags) \
       MP_magical_tie(ENVHV, mg_flags)
   
  +#define modperl_envelem_tie(sv, key, klen) \
  +    sv_magic(sv, Nullsv, 'e', key, klen)
  +
   void modperl_env_hash_keys(void);
   
   void modperl_env_clear(pTHX);
  
  
  
  1.15      +49 -1     modperl-2.0/src/modules/perl/modperl_perl_global.c
  
  Index: modperl_perl_global.c
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_global.c,v
  retrieving revision 1.14
  retrieving revision 1.15
  diff -u -r1.14 -r1.15
  --- modperl_perl_global.c	15 Nov 2001 01:25:00 -0000	1.14
  +++ modperl_perl_global.c	22 Oct 2002 02:42:03 -0000	1.15
  @@ -170,11 +170,56 @@
       *avcv->av = avcv->origav;
   }
   
  +/*
  + * newHVhv is not good enough since it does not copy magic.
  + * XXX: 5.8.0+ newHVhv has some code thats faster than hv_iternext
  + */
  +static HV *copyENV(pTHX_ HV *ohv)
  +{
  +    HE *entry, *hv_eiter;
  +    I32 hv_riter;
  +    register HV *hv;
  +    STRLEN hv_max = HvMAX(ohv);
  +    STRLEN hv_fill = HvFILL(ohv);
  +
  +    hv = newHV();
  +    while (hv_max && hv_max + 1 >= hv_fill * 2) {
  +	hv_max = hv_max / 2;	/* Is always 2^n-1 */
  +    }
  +
  +    HvMAX(hv) = hv_max;
  +
  +    if (!hv_fill) {
  +	return hv;
  +    }
  +
  +    hv_riter = HvRITER(ohv);	/* current root of iterator */
  +    hv_eiter = HvEITER(ohv);	/* current entry of iterator */
  +	
  +    hv_iterinit(ohv);
  +    while ((entry = hv_iternext(ohv))) {
  +        SV *sv = newSVsv(HeVAL(entry));
  +        modperl_envelem_tie(sv, HeKEY(entry), HeKLEN(entry));
  +        hv_store(hv, HeKEY(entry), HeKLEN(entry),
  +                 sv, HeHASH(entry));
  +    }
  +
  +    HvRITER(ohv) = hv_riter;
  +    HvEITER(ohv) = hv_eiter;
  +
  +    hv_magic(hv, Nullgv, 'E');    
  +
  +    TAINT_NOT;
  +
  +    return hv;
  +}
  +
   static void
   modperl_perl_global_gvhv_save(pTHX_ modperl_perl_global_gvhv_t *gvhv)
   {
  -    U32 mg_flags;
       HV *hv = GvHV(gvhv->gv);
  +#if 0
  +    U32 mg_flags;
       MAGIC *mg = SvMAGIC(hv);
   
       /*
  @@ -201,6 +246,9 @@
           /* XXX: maybe newHVhv should do this? */
           hv_magic(gvhv->tmphv, Nullgv, mg->mg_type);
       }
  +#else
  +    gvhv->tmphv = copyENV(aTHX_ hv);
  +#endif
   
       gvhv->orighv = hv;
       GvHV(gvhv->gv) = gvhv->tmphv;
  
  
  
  1.3       +9 -1      modperl-2.0/t/response/TestModperl/env.pm
  
  Index: env.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/t/response/TestModperl/env.pm,v
  retrieving revision 1.2
  retrieving revision 1.3
  diff -u -r1.2 -r1.3
  --- env.pm	11 Apr 2002 11:08:44 -0000	1.2
  +++ env.pm	22 Oct 2002 02:42:03 -0000	1.3
  @@ -7,13 +7,14 @@
   use APR::Table ();
   
   use Apache::Test;
  +use Apache::TestUtil;
   
   use Apache::Const -compile => 'OK';
   
   sub handler {
       my $r = shift;
   
  -    plan $r, tests => 20;
  +    plan $r, tests => 20 + keys(%ENV);
   
       my $env = $r->subprocess_env;
   
  @@ -59,6 +60,13 @@
   
       ok $ENV{SERVER_SOFTWARE};
       ok $env->get('SERVER_SOFTWARE');
  +
  +    #Make sure each key can be deleted
  +
  +    for my $key (sort keys %ENV) {
  +        eval { delete $ENV{$key}; };
  +        ok t_cmp('', $@, $key);
  +    }
   
       Apache::OK;
   }