[commit: base] master: Fix #7522 by checking for empty byte buffers a little more (d714cc4)

[Max Bolingbroke]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/base

On branch  : master

https://github.com/ghc/packages-base/commit/d714cc4ac2f889407f5baf004044bbe913e79249

>---------------------------------------------------------------

commit d714cc4ac2f889407f5baf004044bbe913e79249
Author: Max Bolingbroke <batterseapower at hotmail.com>
Date:   Wed Apr 10 21:13:28 2013 +0100

    Fix #7522 by checking for empty byte buffers a little more
    
    Quite a few lines have changed but that is mostly comments.

>---------------------------------------------------------------

 GHC/IO/Encoding/Types.hs   |   13 +++++--------
 GHC/IO/Handle/Internals.hs |   32 +++++++++++++++++++++++++++++---
 2 files changed, 34 insertions(+), 11 deletions(-)

diff --git a/GHC/IO/Encoding/Types.hs b/GHC/IO/Encoding/Types.hs
index 6147d01..e31c067 100644
--- a/GHC/IO/Encoding/Types.hs
+++ b/GHC/IO/Encoding/Types.hs
@@ -41,17 +41,14 @@ data BufferCodec from to state = BufferCodec {
    -- if there is either not enough room in @to@, or @from@ does not
    -- contain a complete multibyte sequence.
    --
+   -- If multiple CodingProgress returns are possible, OutputUnderflow must be
+   -- preferred to InvalidSequence. This allows GHC's IO library to assume that
+   -- if we observe InvalidSequence there is at least a single element available
+   -- in the output buffer.
+   --
    -- The fact that as many elements as possible are translated is used by the IO
    -- library in order to report translation errors at the point they
    -- actually occur, rather than when the buffer is translated.
-   --
-   -- To allow us to use iconv as a BufferCode efficiently, character buffers are
-   -- defined to contain lone surrogates instead of those private use characters that
-   -- are used for roundtripping. Thus, Chars poked and peeked from a character buffer
-   -- must undergo surrogatifyRoundtripCharacter and desurrogatifyRoundtripCharacter
-   -- respectively.
-   --
-   -- For more information on this, see Note [Roundtripping] in GHC.IO.Encoding.Failure.
   
   recover :: Buffer from -> Buffer to -> IO (Buffer from, Buffer to),
    -- ^ The @recover@ function is used to continue decoding
diff --git a/GHC/IO/Handle/Internals.hs b/GHC/IO/Handle/Internals.hs
index 79228d3..855e31c 100644
--- a/GHC/IO/Handle/Internals.hs
+++ b/GHC/IO/Handle/Internals.hs
@@ -378,7 +378,15 @@ streamEncode codec from to = go (from, to)
       -- underflow particularly, and we want to delay errors about invalid
       -- sequences as far as possible.
       case why of
-        Encoding.InvalidSequence | bufL from == bufL from' -> recover codec from' to' >>= go
+        Encoding.InvalidSequence | bufL from == bufL from' -> do
+          -- NB: it is OK to call recover here. Because we saw InvalidSequence, by the invariants
+          -- on "encode" it must be the case that there is at least one elements available in the output
+          -- buffer. Furthermore, clearly there is at least one element in the input buffer since we found
+          -- something invalid there!
+          --debugIO $ "Before streamEncode recovery: from=" ++ summaryBuffer from' ++ ", to=" ++ summaryBuffer to'
+          (from', to') <- recover codec from' to'
+          --debugIO $ "After streamEncode recovery: from=" ++ summaryBuffer from' ++ ", to=" ++ summaryBuffer to'
+          go (from', to')
         _ -> return (from', to')
 
 -- -----------------------------------------------------------------------------
@@ -802,6 +810,16 @@ debugIO s
 -- Read characters into the provided buffer.  Return when any
 -- characters are available; raise an exception if the end of 
 -- file is reached.
+--
+-- In uses of readTextDevice within base, the input buffer is either:
+--   * empty
+--   * or contains a single \r (when doing newline translation)
+--
+-- The input character buffer must have a capacity at least 1 greater
+-- than the number of elements it currently contains.
+--
+-- Users of this function expect that the buffer returned contains
+-- at least 1 more character than the input buffer.
 readTextDevice :: Handle__ -> CharBuffer -> IO CharBuffer
 readTextDevice h_ at Handle__{..} cbuf = do
   --
@@ -832,9 +850,13 @@ readTextDevice h_ at Handle__{..} cbuf = do
   debugIO ("readTextDevice after decoding: cbuf=" ++ summaryBuffer cbuf' ++ 
         " bbuf=" ++ summaryBuffer bbuf2)
 
+  -- We can't return from readTextDevice without reading at least a single extra character,
+  -- so check that we have managed to achieve that
   writeIORef haByteBuffer bbuf2
-  if bufR cbuf' == bufR cbuf -- no new characters
-     then readTextDevice' h_ bbuf2 cbuf -- we need more bytes to make a Char
+  if bufR cbuf' == bufR cbuf
+     -- we need more bytes to make a Char. NB: bbuf2 may be empty (even though bbuf1 wasn't) when we
+     -- are using an encoding that can skip bytes without outputting characters, such as UTF8//IGNORE
+     then readTextDevice' h_ bbuf2 cbuf
      else return cbuf'
 
 -- we have an incomplete byte sequence at the end of the buffer: try to
@@ -853,7 +875,11 @@ readTextDevice' h_ at Handle__{..} bbuf0 cbuf0 = do
   (r,bbuf2) <- Buffered.fillReadBuffer haDevice bbuf1
   if r == 0
    then do
+     -- bbuf2 can be empty here when we encounter an invalid byte sequence at the end of the input
+     -- with a //IGNORE codec which consumes bytes without outputting characters
+     if isEmptyBuffer bbuf2 then ioe_EOF else do
      (bbuf3, cbuf1) <- recover decoder bbuf2 cbuf0
+     debugIO ("readTextDevice' after recovery: bbuf=" ++ summaryBuffer bbuf3 ++ ", cbuf=" ++ summaryBuffer cbuf1)
      writeIORef haByteBuffer bbuf3
      -- We should recursively invoke readTextDevice after recovery,
      -- if recovery did not add at least one new character to the buffer: