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.

2 files changed, 13 insertions, 6 deletions

diff --git a/ext/PerlIO-encoding/encoding.xs b/ext/PerlIO-encoding/encoding.xs
index 3f27dec740..114b7e115d 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 71ba493f67..0c6bcda9fe 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",