Hey Ben, thanks for your quick reply. I think there's a problem. On 14/05/2018 15.36, Ben Gamari wrote:
I believe the relevant implementation is the RawIO instance defined in GHC.IO.FD. The read implementation in particular is GHC.IO.FD.readRawBufferPtr. There is a useful Note directly above this function.
Reading through the code at
http://hackage.haskell.org/package/base-4.11.1.0/docs/src/GHC.IO.FD.html#rea...
The first line jumped to my eye:
| isNonBlocking fd = unsafe_read -- unsafe is ok, it can't block
This looks suspicious.
And indeed, the following program does NOT keep printing things in the printing thread, and instead blocks for 30 seconds:
```
module Main where
import Control.Concurrent
import Control.Monad
import qualified Data.ByteString as BS
import System.Environment
main :: IO ()
main = do
args <- getArgs
case args of
[file] -> do
forkIO $ forever $ do
putStrLn "still running"
threadDelay 100000 -- 0.1 s
bs <- BS.readFile file
putStrLn $ "Read " ++ show (BS.length bs) ++ " bytes"
_ -> error "Pass 1 argument (a file)"
```
when compiled with
~/.stack/programs/x86_64-linux/ghc-8.2.2/bin/ghc --make -O -threaded blocking-regular-file-read-test.hs
on my Ubuntu 16.04 and on a 2GB file like
./blocking-regular-file-read-test /mnt/images/ubuntu-18.04-desktop-amd64.iso
And `strace -f -e open,read` on it shows:
open("/mnt/images/ubuntu-18.04-desktop-amd64.iso", O_RDONLY|O_NOCTTY|O_NONBLOCK) = 11
read(11,