[project @ 1998-08-11 15:59:13 by sof]

Testing ReadWrite handles

diff --git a/ghc/tests/io/should_run/Makefile b/ghc/tests/io/should_run/Makefile
index 0acc082..bc747f6 100644 (file)
--- a/ghc/tests/io/should_run/Makefile
+++ b/ghc/tests/io/should_run/Makefile
@@ -10,6 +10,7 @@ io011_HC_OPTS += -fglasgow-exts
 io004_RUNTEST_OPTS += -x 42
 io016_RUNTEST_OPTS += io016.hs io016.out
 io017_RUNTEST_OPTS += -i io017.stdin
+io018_RUNTEST_OPTS += -i io018.hs
 io021_RUNTEST_OPTS += -i io021.hs
 io022_RUNTEST_OPTS += -i io022.hs
 io028_RUNTEST_OPTS += -i io028.hs

diff --git a/ghc/tests/io/should_run/io018.hs b/ghc/tests/io/should_run/io018.hs
index 915b47b..984ecb2 100644 (file)
--- a/ghc/tests/io/should_run/io018.hs
+++ b/ghc/tests/io/should_run/io018.hs
@@ -1,29 +1,41 @@
--- 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 Directory (removeFile)
 
-main =   let username = "io018.inout"      in
-         openFile username ReadWriteMode    >>=        \ cd          ->
-         removeFile username               >>
-         hSetBuffering stdin NoBuffering    >>
-         hSetBuffering stdout NoBuffering   >>
-         hSetBuffering cd NoBuffering       >>
-         hPutStr cd speakString             >>
-         speak cd
+-- This test is weird, full marks to whoever dreamt it up!
 
-speakString = "Someone wants to speak with you\n"
+main :: IO ()
+main = do
+   let username = "io018.inout"
+   cd <- openFile username ReadWriteMode
+   removeFile username
+   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 fail err
+   hSeek cd AbsoluteSeek 0
+   hSetBuffering cd LineBuffering
+   speak cd  `catch` \ err -> if isEOFError err then putStrLn "\nCaught EOF" else fail err
+   hSeek cd AbsoluteSeek 0
+   hSetBuffering cd (BlockBuffering Nothing)
+   speak cd  `catch` \ err -> if isEOFError err then putStrLn "\nCaught EOF" else fail err
 
-speak cd = return ()
-{-
-         (hReady cd                         >>=        \ ready       ->
-         if ready then (hGetChar cd >>= putChar)
-         else return ()                     >>
+speakString = "Someone wants to speak with you\n"
 
-         hReady stdin                       >>=        \ ready       ->
-         if ready then (getChar >>= hPutChar cd)
-         else return ())                    >>
+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
 
-         speak cd
--}

diff --git a/ghc/tests/io/should_run/io018.stdout b/ghc/tests/io/should_run/io018.stdout
index e69de29..18c9dbc 100644 (file)
--- a/ghc/tests/io/should_run/io018.stdout
+++ b/ghc/tests/io/should_run/io018.stdout
@@ -0,0 +1,6 @@
+Smoewnst pa ihyu
+Caught EOF
+Smoewnst pa ihyu
+Caught EOF
+Smoewnst pa ihyu
+Caught EOF

diff --git a/ghc/tests/io/should_run/io031.hs b/ghc/tests/io/should_run/io031.hs
new file mode 100644 (file)
index 0000000..38e5d38
--- /dev/null
+++ b/ghc/tests/io/should_run/io031.hs
@@ -0,0 +1,20 @@
+--!!! RW files 
+module Main(main) where
+
+import IO
+import Directory ( removeFile )
+
+main = do 
+  hdl <- openFile "io031.inout" ReadWriteMode
+  removeFile "io031.inout"
+  hSetBuffering hdl LineBuffering
+  hPutStr hdl "as"
+  hSeek hdl AbsoluteSeek 0
+  ch <- hGetChar hdl
+  print ch
+  hPutStr hdl "ase"
+  hSeek hdl AbsoluteSeek 0
+  putChar '\n'
+  ls <- hGetContents hdl
+  putStrLn ls
+

diff --git a/ghc/tests/io/should_run/io031.stdout b/ghc/tests/io/should_run/io031.stdout
new file mode 100644 (file)
index 0000000..e33ba06
--- /dev/null
+++ b/ghc/tests/io/should_run/io031.stdout
@@ -0,0 +1,3 @@
+'a'
+
+aase