stas        2004/08/12 18:41:35

  Modified:    src/modules/perl modperl_bucket.c
               t/lib/TestAPRlib bucket.pm
               .        Changes
  Log:
  Fix a bug in APR::Bucket->new when a passed argument was of type
  PADTMP
  
  Revision  Changes    Path
  1.12      +17 -8     modperl-2.0/src/modules/perl/modperl_bucket.c
  
  Index: modperl_bucket.c
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_bucket.c,v
  retrieving revision 1.11
  retrieving revision 1.12
  diff -u -u -r1.11 -r1.12
  --- modperl_bucket.c  13 Jun 2004 05:39:09 -0000      1.11
  +++ modperl_bucket.c  13 Aug 2004 01:41:35 -0000      1.12
  @@ -85,22 +85,31 @@
       svbucket = (modperl_bucket_sv_t *)malloc(sizeof(*svbucket));
   
       bucket = apr_bucket_shared_make(bucket, svbucket, offset, len);
  +    if (!bucket) {
  +        free(svbucket);
  +        return NULL;
  +    }
   
       /* XXX: need to deal with PerlInterpScope */
   #ifdef USE_ITHREADS
       svbucket->perl = aTHX;
   #endif
  -    svbucket->sv = sv;
   
  -    if (!bucket) {
  -        free(svbucket);
  -        return NULL;
  +    /* PADTMP SVs belong to perl and can't be stored away, since perl
  +     * is going to reuse them, so we have no choice but to copy the
  +     * data away, before storing sv */
  +    if (SvPADTMP(sv)) {
  +        STRLEN len;
  +        char *pv = SvPV(sv, len);
  +        svbucket->sv = newSVpvn(pv, len);
       }
  -
  -    (void)SvREFCNT_inc(svbucket->sv);
  -
  +    else {
  +        svbucket->sv = sv;
  +        (void)SvREFCNT_inc(svbucket->sv);
  +    }
  +    
       MP_TRACE_f(MP_FUNC, "sv=0x%lx, refcnt=%d\n",
  -               (unsigned long)sv, SvREFCNT(sv));
  +               (unsigned long)svbucket->sv, SvREFCNT(svbucket->sv));
   
       bucket->type = &modperl_bucket_sv_type;
       bucket->free = free;
  
  
  
  1.2       +52 -1     modperl-2.0/t/lib/TestAPRlib/bucket.pm
  
  Index: bucket.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/t/lib/TestAPRlib/bucket.pm,v
  retrieving revision 1.1
  retrieving revision 1.2
  diff -u -u -r1.1 -r1.2
  --- bucket.pm 15 Jul 2004 15:25:36 -0000      1.1
  +++ bucket.pm 13 Aug 2004 01:41:35 -0000      1.2
  @@ -12,7 +12,7 @@
   use APR::BucketType ();
   
   sub num_of_tests {
  -    return 11;
  +    return 13;
   }
   
   sub test {
  @@ -70,6 +70,57 @@
                    qr/the length argument can't be bigger than the total/,
                    'new($data, $offset, $len_too_big)');
       }
  +
  +    # modification of the source variable, affects the data
  +    # inside the bucket
  +    {
  +        my $data = "A" x 10;
  +        my $orig = $data;
  +        my $b = APR::Bucket->new($data);
  +        $data =~ s/^..../BBBB/;
  +        $b->read(my $read);
  +        ok !t_cmp($read, $orig,
  +                 "data inside the bucket should get affected by " .
  +                 "the changes to the Perl variable it's created from");
  +    }
  +
  +
  +    # APR::Bucket->new() with the argument PADTMP (which happens when
  +    # some function is re-entered) and the same SV is passed to
  +    # different buckets, which must be detected and copied away.
  +    {
  +        my @buckets = ();
  +        my @data      = qw(ABCD EF);
  +        my @received     = ();
  +        for my $str (@data) {
  +            my $b = func($str);
  +            push @buckets, $b;
  +        }
  +
  +        # the creating of buckets and reading from them is done
  +        # separately on purpose
  +        for my $b (@buckets) {
  +            $b->read(my $out);
  +            push @received, $out;
  +            #Devel::Peek::Dump $out;
  +        }
  +
  +        # here we used to get: two pv: "ef\0d"\0, "ef"\0, as you can see
  +        # the first bucket had corrupted data.
  +        my @expected = map { lc } @data;
  +        ok t_cmp [EMAIL PROTECTED], [EMAIL PROTECTED], "new(PADTMP SV)";
  +
  +        # this function will pass the same SV to new(), causing two
  +        # buckets point to the same SV, and having the latest bucket's
  +        # data override the previous one
  +        sub func {
  +            my $data = shift;
  +            return APR::Bucket->new(lc $data);
  +        }
  +
  +    }
  +
  +
   
       # remove
       {
  
  
  
  1.443     +3 -0      modperl-2.0/Changes
  
  Index: Changes
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/Changes,v
  retrieving revision 1.442
  retrieving revision 1.443
  diff -u -u -r1.442 -r1.443
  --- Changes   12 Aug 2004 06:40:45 -0000      1.442
  +++ Changes   13 Aug 2004 01:41:35 -0000      1.443
  @@ -12,6 +12,9 @@
   
   =item 1.99_15-dev
   
  +Fix a bug in APR::Bucket->new when a passed argument was of type
  +PADTMP [Stas]
  +
   Apache::Connection changes [Stas, "Fred Moyer" <fred /about/
   taperfriendlymusic.org>]
   - readwrite => readonly:
  
  
  

Reply via email to