[Git][ghc/ghc][master] winio: fixed bytestring reading interface.

[Marge Bot]

 Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
0fd3d360 by Tamar Christina at 2020-10-09T08:50:51-04:00
winio: fixed bytestring reading interface.

- - - - -


4 changed files:

- libraries/base/GHC/IO/Handle/Text.hs
- libraries/base/tests/IO/all.T
- + libraries/base/tests/IO/bytestringread001.hs
- + libraries/base/tests/IO/bytestringread001.stdout


Changes:

=====================================
libraries/base/GHC/IO/Handle/Text.hs
=====================================
@@ -1017,10 +1017,13 @@ hGetBufSome h !ptr count
   | otherwise =
       wantReadableHandle_ "hGetBufSome" h $ \ h_ at Handle__{..} -> do
          flushCharReadBuffer h_
-         buf at Buffer{ bufSize=sz } <- readIORef haByteBuffer
+         buf at 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_ at 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


=====================================
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, [''])


=====================================
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))


=====================================
libraries/base/tests/IO/bytestringread001.stdout
=====================================
@@ -0,0 +1 @@
+"Total bytes in test.data: 66560"



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0fd3d360cab977e00fb6d90d0519962227b029bb

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0fd3d360cab977e00fb6d90d0519962227b029bb
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20201009/1d9515f6/attachment-0001.html>