winio: Fix offset set by bufReadEmpty.

bufReadEmpty returns the bytes read *including* content that
was already buffered,
But for calculating the offset we only care about the number
of bytes read into the new buffer.

4 files changed, 37 insertions, 21 deletions

diff --git a/libraries/base/GHC/IO/Handle.hs b/libraries/base/GHC/IO/Handle.hs
index 6b00706fc0..cdd878e3da 100644
--- a/libraries/base/GHC/IO/Handle.hs
+++ b/libraries/base/GHC/IO/Handle.hs
@@ -123,9 +123,10 @@ hFileSize handle =
               r <- IODevice.getSize dev
               debugIO $ "hFileSize: " ++ show r ++ " " ++ show handle
               if r /= -1
-                 then return r
-                 else ioException (IOError Nothing InappropriateType "hFileSize"
-                                   "not a regular file" Nothing Nothing)
+                then return r
+                else ioException (IOError Nothing InappropriateType "hFileSize"
+                                  "not a regular file" Nothing Nothing)
+
 
 
 -- | 'hSetFileSize' @hdl@ @size@ truncates the physical file with handle @hdl@ to @size@ bytes.
diff --git a/libraries/base/GHC/IO/Handle/Internals.hs b/libraries/base/GHC/IO/Handle/Internals.hs
index 55c18d24b8..6aee4bb619 100644
--- a/libraries/base/GHC/IO/Handle/Internals.hs
+++ b/libraries/base/GHC/IO/Handle/Internals.hs
@@ -51,7 +51,7 @@ module GHC.IO.Handle.Internals (
 
   HandleFinalizer, handleFinalizer,
 
-  debugIO,
+  debugIO, traceIO
  ) where
 
 import GHC.IO
@@ -268,7 +268,8 @@ checkWritableHandle act h_@Handle__{..}
 -- Wrapper for read operations.
 
 wantReadableHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
-wantReadableHandle fun h act = withHandle fun h (checkReadableHandle act)
+wantReadableHandle fun h act =
+  withHandle fun h (checkReadableHandle act)
 
 wantReadableHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
 wantReadableHandle_ fun h@(FileHandle  _ m)   act
@@ -832,6 +833,13 @@ debugIO s
          return ()
  | otherwise = return ()
 
+-- For development, like debugIO but always on.
+traceIO :: String -> IO ()
+traceIO s = do
+         _ <- withCStringLen (s ++ "\n") $
+                  \(p, len) -> c_write 1 (castPtr p) (fromIntegral len)
+         return ()
+
 -- ----------------------------------------------------------------------------
 -- Text input/output
 
diff --git a/libraries/base/GHC/IO/Handle/Text.hs b/libraries/base/GHC/IO/Handle/Text.hs
index 75a59c3897..ee0289f066 100644
--- a/libraries/base/GHC/IO/Handle/Text.hs
+++ b/libraries/base/GHC/IO/Handle/Text.hs
@@ -6,7 +6,7 @@
            , NondecreasingIndentation
            , MagicHash
   #-}
-{-# OPTIONS_GHC -Wno-name-shadowing #-}
+-- {-# OPTIONS_GHC -Wno-name-shadowing #-}
 {-# OPTIONS_GHC -Wno-unused-matches #-}
 {-# OPTIONS_HADDOCK not-home #-}
 
@@ -576,9 +576,9 @@ hPutcBuffered handle_@Handle__{..} c = do
                 LineBuffering -> True
                 _             -> False
 
-    putc buf@Buffer{ bufRaw=raw, bufR=w } c = do
+    putc buf@Buffer{ bufRaw=raw, bufR=w } c' = do
        debugIO ("putc: " ++ summaryBuffer buf)
-       w'  <- writeCharBuf raw w c
+       w'  <- writeCharBuf raw w c'
        return buf{ bufR = w' }
 
 -- ---------------------------------------------------------------------------
@@ -913,7 +913,7 @@ hGetBuf h !ptr count
   | count <  0 = illegalBufferSize h "hGetBuf" count
   | otherwise =
       wantReadableHandle_ "hGetBuf" h $ \ h_@Handle__{..} -> do
-          debugIO $ ":: hGetBuf - " ++ show h
+          debugIO $ ":: hGetBuf - " ++ show h ++ " - " ++ show count
           flushCharReadBuffer h_
           buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }
             <- readIORef haByteBuffer
@@ -954,26 +954,32 @@ bufReadNonEmpty h_@Handle__{..}
             ptr' = ptr `plusPtr` avail
 
         debugIO ("bufReadNonEmpty: " ++ summaryBuffer buf' ++ " s:" ++ show so_far' ++ " r:" ++ show remaining)
-        if remaining == 0
+        b <- if remaining == 0
            then return so_far'
            else bufReadEmpty h_ buf' ptr' so_far' remaining
+        debugIO ":: bufReadNonEmpty - done"
+        return b
 
 -- We want to read more data, but the buffer is empty. (buffL == buffR == 0)
 -- See also Note [INVARIANTS on Buffers] in Buffer.hs
 bufReadEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
 bufReadEmpty h_@Handle__{..}
-             buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz, bufOffset=bff }
+             buf@Buffer{ bufRaw=raw, bufR=w, bufL=_r, bufSize=sz, bufOffset=bff }
              ptr so_far count
  | count > sz
  = do
-        count <- loop haDevice 0 bff count
-        let buf1 = bufferAddOffset (fromIntegral count) buf
+        bytes_read <- loop haDevice 0 bff count
+        -- bytes_read includes so_far (content that was in the buffer)
+        -- but that is already accounted for in the old offset, so don't
+        -- count it twice.
+        let buf1 = bufferAddOffset (fromIntegral $ bytes_read - so_far) buf
         writeIORef haByteBuffer buf1
-        debugIO ("bufReadEmpty: " ++ summaryBuffer buf1)
-        return count
+        debugIO ("bufReadEmpty1.1: " ++ summaryBuffer buf1 ++ " read:" ++ show bytes_read)
+        return bytes_read
  | otherwise = do
         (r,buf') <- Buffered.fillReadBuffer haDevice buf
-        if r == 0
+        writeIORef haByteBuffer buf'
+        if r == 0 -- end of file reached
             then return so_far
             else do writeIORef haByteBuffer buf'
                     bufReadNonEmpty h_ buf' ptr so_far count
@@ -1067,7 +1073,7 @@ hGetBufNonBlocking h !ptr count
 
 bufReadNBEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
 bufReadNBEmpty   h_@Handle__{..}
-                 buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz
+                 buf@Buffer{ bufRaw=raw, bufR=w, bufL=_r, bufSize=sz
                            , bufOffset=offset }
                  ptr so_far count
   | count > sz = do
@@ -1077,15 +1083,15 @@ bufReadNBEmpty   h_@Handle__{..}
          Just n  -> return (so_far + n)
 
  | otherwise = do
-     buf <- readIORef haByteBuffer
+    --  buf <- readIORef haByteBuffer
      (r,buf') <- Buffered.fillReadBuffer0 haDevice buf
      case r of
        Nothing -> return so_far
        Just 0  -> return so_far
-       Just r  -> do
+       Just r'  -> do
          writeIORef haByteBuffer buf'
-         bufReadNBNonEmpty h_ buf' ptr so_far (min count r)
-                          -- NOTE: new count is    min count r
+         bufReadNBNonEmpty h_ buf' ptr so_far (min count r')
+                          -- NOTE: new count is    min count r'
                           -- so we will just copy the contents of the
                           -- buffer in the recursive call, and not
                           -- loop again.
diff --git a/libraries/base/GHC/IO/Windows/Handle.hsc b/libraries/base/GHC/IO/Windows/Handle.hsc
index d96ccc364e..1611ece011 100644
--- a/libraries/base/GHC/IO/Windows/Handle.hsc
+++ b/libraries/base/GHC/IO/Windows/Handle.hsc
@@ -482,6 +482,7 @@ hwndWriteNonBlocking hwnd ptr offset bytes
                              (startCB ptr) completionCB
        return $ fromIntegral $ ioValue val
   where
+    startCB :: Ptr a -> LPOVERLAPPED -> IO (Mgr.CbResult a1)
     startCB outBuf lpOverlapped = do
       debugIO ":: hwndWriteNonBlocking"
       -- See Note [ReadFile/WriteFile].