summaryrefslogtreecommitdiff
path: root/ghc/tests/lib/IO/readwrite002.hs
blob: cd6e34db1ee6c9903841079631a2e1a771bb51cd (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
-- !!! Testing RW handles 
import IO
import Directory (removeFile, doesFileExist)
import Monad
#if defined(__MINGW32__)
import PrelHandle(hSetBinaryMode)
#endif

-- This test is weird, full marks to whoever dreamt it up!

main :: IO ()
main = do
   let username = "readwrite002.inout"
   f <- doesFileExist username
   when f (removeFile username)
   cd <- openFile username ReadWriteMode
#  if defined(__MINGW32__)
   hSetBinaryMode cd True
#  endif
   hSetBuffering stdin NoBuffering
   hSetBuffering stdout NoBuffering
   hSetBuffering cd NoBuffering
   hPutStr cd speakString
   hSeek cd AbsoluteSeek 0
   speak cd  `catch` \ err -> if isEOFError err then putStrLn "\nCaught EOF" else ioError err
   hSeek cd AbsoluteSeek 0
   hSetBuffering cd LineBuffering
   speak cd  `catch` \ err -> if isEOFError err then putStrLn "\nCaught EOF" else ioError err
   hSeek cd AbsoluteSeek 0
   hSetBuffering cd (BlockBuffering Nothing)
   speak cd  `catch` \ err -> if isEOFError err then putStrLn "\nCaught EOF" else ioError err

speakString = "##############################\n"

speak cd = do
     (do
        ready <- hReady cd
        if ready then 
	   hGetChar cd >>= putChar
	 else
	   return ()
        ready <- hReady stdin
        if ready then (do { ch <- getChar; hPutChar cd ch})
         else return ())
     speak cd