[project @ 2000-05-15 11:18:58 by rrt]

[ghc-hetmet.git] / ghc / tests / io / should_run / io018.hs

diff --git a/ghc/tests/io/should_run/io018.hs b/ghc/tests/io/should_run/io018.hs
index c34334e..6320c97 100644 (file)
--- a/ghc/tests/io/should_run/io018.hs
+++ b/ghc/tests/io/should_run/io018.hs
@@ -1,28 +1,43 @@
--- Sigbjorn and I don't understand what this test is meant to do
--- It simply hangs on stdin!
+-- !!! Testing RW handles 
+module Main(main) where
 
-import IO -- 1.3
+import IO
+import IOExts
+import Directory (removeFile, doesFileExist)
+import Monad
 
-import System(getArgs)
+-- This test is weird, full marks to whoever dreamt it up!
 
-main =   getArgs                            >>=        \ [user,host] ->
-         let username = (user ++ "@" ++ host) in
-         openFile username ReadWriteMode    >>=        \ cd          ->
-         hSetBuffering stdin NoBuffering    >>
-         hSetBuffering stdout NoBuffering   >>
-         hSetBuffering cd NoBuffering       >>
-         hPutStr cd speakString             >>
-         speak cd
+main :: IO ()
+main = do
+   let username = "io018.inout"
+   f <- doesFileExist username
+   when f (removeFile username)
+   cd <- openFile username ReadWriteMode
+   hSetBinaryMode cd True
+   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 = "Someone wants to speak with you\n"
 
-speak cd =
-         (hReady cd                         >>=        \ ready       ->
-         if ready then (hGetChar cd >>= putChar)
-         else return ()                     >>
-
-         hReady stdin                       >>=        \ ready       ->
-         if ready then (getChar >>= hPutChar cd)
-         else return ())                    >>
-
-         speak cd
+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