ghc/tests/io/should_run/io018.hs

   1 -- !!! Testing RW handles
   2 module Main(main) where
   3
   4
   5 import IO
   6 import Directory (removeFile)
   7
   8 -- This test is weird, full marks to whoever dreamt it up!
   9
  10 main :: IO ()
  11 main = do
  12    let username = "io018.inout"
  13    cd <- openFile username ReadWriteMode
  14    removeFile username
  15    hSetBuffering stdin NoBuffering
  16    hSetBuffering stdout NoBuffering
  17    hSetBuffering cd NoBuffering
  18    hPutStr cd speakString
  19    hSeek cd AbsoluteSeek 0
  20    speak cd  `catch` \ err -> if isEOFError err then putStrLn "\nCaught EOF" else fail err
  21    hSeek cd AbsoluteSeek 0
  22    hSetBuffering cd LineBuffering
  23    speak cd  `catch` \ err -> if isEOFError err then putStrLn "\nCaught EOF" else fail err
  24    hSeek cd AbsoluteSeek 0
  25    hSetBuffering cd (BlockBuffering Nothing)
  26    speak cd  `catch` \ err -> if isEOFError err then putStrLn "\nCaught EOF" else fail err
  27
  28 speakString = "Someone wants to speak with you\n"
  29
  30 speak cd = do
  31      (do
  32         ready <- hReady cd
  33         if ready then
  34            hGetChar cd >>= putChar
  35          else
  36            return ()
  37         ready <- hReady stdin
  38         if ready then (do { ch <- getChar; hPutChar cd ch})
  39          else return ())
  40      speak cd
  41