diff options
| author | Andreas Klebinger <klebinger.andreas@gmx.at> | 2020-01-20 19:10:35 +0100 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2020-07-15 16:41:02 -0400 |
| commit | e176b625689563d2ccfbfec46e664d17824f1968 (patch) | |
| tree | 4fce93377c9c5dd8718be1acfb94d57b8cbe7997 | |
| parent | f1e0be824523c6687e3d8588c46a57b2cd22ecc1 (diff) | |
| download | haskell-e176b625689563d2ccfbfec46e664d17824f1968.tar.gz | |
winio: Fix output truncation for writes larger than buffer size
| -rw-r--r-- | libraries/base/GHC/IO/Buffer.hs | 2 | ||||
| -rw-r--r-- | libraries/base/GHC/IO/Handle/Text.hs | 15 |
2 files changed, 12 insertions, 5 deletions
diff --git a/libraries/base/GHC/IO/Buffer.hs b/libraries/base/GHC/IO/Buffer.hs index f169ae6f5f..844818357f 100644 --- a/libraries/base/GHC/IO/Buffer.hs +++ b/libraries/base/GHC/IO/Buffer.hs @@ -202,7 +202,7 @@ data Buffer e bufRaw :: !(RawBuffer e), bufState :: BufferState, bufSize :: !Int, -- in elements, not bytes - bufOffset :: !Word64, -- start location for next read + bufOffset :: !Word64, -- start location for next read/write bufL :: !Int, -- offset of first item in the buffer bufR :: !Int -- offset of last item + 1 } diff --git a/libraries/base/GHC/IO/Handle/Text.hs b/libraries/base/GHC/IO/Handle/Text.hs index a934af0007..64559e30df 100644 --- a/libraries/base/GHC/IO/Handle/Text.hs +++ b/libraries/base/GHC/IO/Handle/Text.hs @@ -857,10 +857,17 @@ bufWrite h_@Handle__{..} ptr count can_block = -- if we can fit in the buffer, then just loop if count < size then bufWrite h_ ptr count can_block - else if can_block - then do writeChunk h_ (castPtr ptr) offset count - return count - else writeChunkNonBlocking h_ (castPtr ptr) offset count + else do + !bytes <- if can_block + then do writeChunk h_ (castPtr ptr) offset count + return count + else writeChunkNonBlocking h_ (castPtr ptr) offset count + -- Even if we bypass the buffer we must update the offset for the buffer + -- for future writes. + !buf <- readIORef haByteBuffer + writeIORef haByteBuffer $! bufferAddOffset bytes buf + return bytes + writeChunk :: Handle__ -> Ptr Word8 -> Word64 -> Int -> IO () writeChunk h_@Handle__{..} ptr offset bytes |