In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/e9a8753af0f0f92b6ebd38e85f4b6a815f978eed?hp=42037ad6a00723dfac1ddfb747c39cf563f1fab4>
- Log ----------------------------------------------------------------- commit e9a8753af0f0f92b6ebd38e85f4b6a815f978eed Author: Father Chrysostomos <[email protected]> Date: Sun Oct 14 23:09:56 2012 -0700 Make PerlIO::encoding even more resilient to moving buffers Commit 667763bdbf was not good enough. If the buffer passed to an encode method is reallocated, it may be smaller than the size (bufsiz) stored inside the encoding layer. So we need to extend the buffer in that case and make sure the buffer pointer is not pointing to freed memory. The test as modified by this commit causes malloc errors on stderr when I try it without the encoding.xs changes. ----------------------------------------------------------------------- Summary of changes: ext/PerlIO-encoding/encoding.xs | 6 +++++- ext/PerlIO-encoding/t/encoding.t | 13 ++++++++----- 2 files changed, 13 insertions(+), 6 deletions(-) diff --git a/ext/PerlIO-encoding/encoding.xs b/ext/PerlIO-encoding/encoding.xs index 3f27dec..114b7e1 100644 --- a/ext/PerlIO-encoding/encoding.xs +++ b/ext/PerlIO-encoding/encoding.xs @@ -443,8 +443,12 @@ PerlIOEncode_flush(pTHX_ PerlIO * f) } if (!SvPOKp(e->bufsv) || SvTHINKFIRST(e->bufsv)) (void)SvPV_force_nolen(e->bufsv); - if ((STDCHAR *)SvPVX(e->bufsv) != e->base.buf) + if ((STDCHAR *)SvPVX(e->bufsv) != e->base.buf) { + e->base.ptr = SvEND(e->bufsv); + e->base.end = SvPVX(e->bufsv) + (e->base.end-e->base.buf); e->base.buf = (STDCHAR *)SvPVX(e->bufsv); + } + (void)PerlIOEncode_get_base(aTHX_ f); if (SvCUR(e->bufsv)) { /* Did not all translate */ e->base.ptr = e->base.buf+SvCUR(e->bufsv); diff --git a/ext/PerlIO-encoding/t/encoding.t b/ext/PerlIO-encoding/t/encoding.t index 71ba493..0c6bcda 100644 --- a/ext/PerlIO-encoding/t/encoding.t +++ b/ext/PerlIO-encoding/t/encoding.t @@ -138,10 +138,10 @@ package Extensive { $leftovers = $'; } if ($chk) { - my $x = ' ' x 8000; # prevent realloc from simply extending the buffer - $_[1] = ' ' x 8000; # make SvPVX point elsewhere - $_[1] = $leftovers; - } + undef $_[1]; + my @x = (' ') x 8000; # reuse the just-freed buffer + $_[1] = $leftovers; # SvPVX now points elsewhere and is shorter + } # than bufsiz $buf; } no warnings 'once'; @@ -151,8 +151,11 @@ open my $fh, ">:encoding(extensive)", \$buf; $fh->autoflush; print $fh "doughnut\n"; print $fh "quaffee\n"; +# Print something longer than the buffer that encode() shrunk: +print $fh "The beech leaves beech leaves on the beach by the beech.\n"; close $fh; -is $buf, "doughnut\nquaffee\n", 'buffer realloc during encoding'; +is $buf, "doughnut\nquaffee\nThe beech leaves beech leaves on the beach by" + ." the beech.\n", 'buffer realloc during encoding'; $buf = "Sheila surely shod Sean\nin shoddy shoes.\n"; open $fh, "<:encoding(extensive)", \$buf; is join("", <$fh>), "Sheila surely shod Sean\nin shoddy shoes.\n", -- Perl5 Master Repository
