From: simonmar <unknown>
Date: Tue, 25 Jul 2000 15:48:16 +0000 (+0000)
Subject: [project @ 2000-07-25 15:48:16 by simonmar]
X-Git-Tag: Approximately_9120_patches~3948
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=5416852ed231e77687e07e795d18fb7de4ff20e9;p=ghc-hetmet.git

[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
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
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