[project @ 2000-07-25 15:48:16 by simonmar]

Add test for handle finalization bug, fixed in
  1.60      +1 -2      fptools/ghc/lib/std/PrelHandle.lhs
  1.15      +4 -10     fptools/ghc/lib/std/PrelIO.lhs

diff --git a/ghc/tests/io/should_run/io033.hs b/ghc/tests/io/should_run/io033.hs
new file mode 100644 (file)
index 0000000..33c9ed7
--- /dev/null
+++ b/ghc/tests/io/should_run/io033.hs
@@ -0,0 +1,27 @@
+--- !!! test for bug in handle finalization fixed in 
+--- !!!  1.60      +1 -2      fptools/ghc/lib/std/PrelHandle.lhs
+--- !!!  1.15      +4 -10     fptools/ghc/lib/std/PrelIO.lhs
+
+module Main (main) where
+
+import IO
+import System
+
+doTest :: IO ()
+doTest = do
+  sd <- openFile "io033.hs" ReadWriteMode
+  result <- hGetContents sd
+  slurp result
+  hClose sd
+  if "" `elem` lines (filter (/= '\r') result)
+   then
+    putStrLn "ok"
+   else
+    putStrLn "fail"
+
+slurp :: String -> IO ()
+slurp [] = return ()
+slurp (x:xs) = x `seq` slurp xs
+
+main :: IO ()
+main = sequence_ (take 50 (repeat doTest))

diff --git a/ghc/tests/io/should_run/io033.stdout b/ghc/tests/io/should_run/io033.stdout
new file mode 100644 (file)
index 0000000..806cc80
--- /dev/null
+++ b/ghc/tests/io/should_run/io033.stdout
@@ -0,0 +1,50 @@
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok