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: