winio: fixed bytestring reading interface.

4 files changed, 43 insertions, 3 deletions

diff --git a/libraries/base/GHC/IO/Handle/Text.hs b/libraries/base/GHC/IO/Handle/Text.hs
index fa5428cb35..ce6729cbb3 100644
--- a/libraries/base/GHC/IO/Handle/Text.hs
+++ b/libraries/base/GHC/IO/Handle/Text.hs
@@ -1017,10 +1017,13 @@ hGetBufSome h !ptr count
   | otherwise =
       wantReadableHandle_ "hGetBufSome" h $ \ h_@Handle__{..} -> do
          flushCharReadBuffer h_
-         buf@Buffer{ bufSize=sz } <- readIORef haByteBuffer
+         buf@Buffer{ bufSize=sz, bufOffset=offset } <- readIORef haByteBuffer
          if isEmptyBuffer buf
             then case count > sz of  -- large read? optimize it with a little special case:
-                    True -> RawIO.read haDevice (castPtr ptr) 0 count
+                    True -> do bytes <- RawIO.read haDevice (castPtr ptr) offset count
+                               -- Update buffer with actual bytes written.
+                               writeIORef haByteBuffer $! bufferAddOffset bytes buf
+                               return bytes
                     _ -> do (r,buf') <- Buffered.fillReadBuffer haDevice buf
                             if r == 0
                                then return 0
@@ -1074,7 +1077,9 @@ bufReadNBEmpty   h_@Handle__{..}
        m <- RawIO.readNonBlocking haDevice ptr offset count
        case m of
          Nothing -> return so_far
-         Just n  -> return (so_far + n)
+         Just n  -> do -- Update buffer with actual bytes written.
+                       writeIORef haByteBuffer $! bufferAddOffset n buf
+                       return (so_far + n)
 
  | otherwise = do
     --  buf <- readIORef haByteBuffer
diff --git a/libraries/base/tests/IO/all.T b/libraries/base/tests/IO/all.T
index c828975584..9475183b3c 100644
--- a/libraries/base/tests/IO/all.T
+++ b/libraries/base/tests/IO/all.T
@@ -149,3 +149,4 @@ test('T17414',
       high_memory_usage],
      compile_and_run, [''])
 test('T17510', expect_broken(17510), compile_and_run, [''])
+test('bytestringread001', extra_run_opts('test.data'), compile_and_run, [''])
diff --git a/libraries/base/tests/IO/bytestringread001.hs b/libraries/base/tests/IO/bytestringread001.hs
new file mode 100644
index 0000000000..e020efe711
--- /dev/null
+++ b/libraries/base/tests/IO/bytestringread001.hs
@@ -0,0 +1,33 @@
+import System.Environment

+import qualified Data.ByteString.Lazy as BL

+import Data.Word

+

+fold_tailrec :: (a -> b -> a) -> a -> [b] -> a

+fold_tailrec _ acc [] =

+    acc

+fold_tailrec foldFun acc (x : xs) =

+    fold_tailrec foldFun (foldFun acc x) xs

+

+fold_tailrec' :: (a -> b -> a) -> a -> [b] -> a

+fold_tailrec' _ acc [] =

+    acc

+fold_tailrec' foldFun acc (x : xs) =

+    let acc' = foldFun acc x

+    in seq acc' (fold_tailrec' foldFun acc' xs)

+

+main :: IO ()

+main =

+    do

+        args <- getArgs

+        let filename = head args

+

+        -- generate file

+        let dt = replicate (65 * 1024) 'a'

+        writeFile filename dt

+

+        byteString <- BL.readFile filename

+        let wordsList = BL.unpack byteString

+        -- wordsList is supposed to be lazy (bufferized)

+        let bytesCount = fold_tailrec (\acc word -> acc + 1) 0 wordsList

+        print ("Total bytes in " ++ filename ++ ": " 

+               ++ (show bytesCount))

diff --git a/libraries/base/tests/IO/bytestringread001.stdout b/libraries/base/tests/IO/bytestringread001.stdout
new file mode 100644
index 0000000000..03f5607472
--- /dev/null
+++ b/libraries/base/tests/IO/bytestringread001.stdout
@@ -0,0 +1 @@
+"Total bytes in test.data: 66560"