Copy tests from GHC testsuite; part of #1161.
[packages/base.git] / tests / IO / 2122.hs
1 {-
2
3 Before running this, check that /tmp/test does not exist and
4 contain something important. Then do:
5
6 $ touch /tmp/test
7
8 If you do:
9
10 $ runhaskell Test.hs
11
12 it will work. If you do:
13
14 $ runhaskell Test.hs fail
15
16 it will fail every time with:
17
18 Test.hs: writeFile: /tmp/test: openFile: resource busy (file is locked)
19
20 -}
21
22 import Control.Monad
23 import System.Directory
24 import System.IO
25 import System.Environment
26 -- Used by test2:
27 -- import System.Posix.IO
28
29 fp = "2122-test"
30
31 main :: IO ()
32 main = do
33 writeFile fp "test"
34 test True
35
36 -- fails everytime when causeFailure is True in GHCi, with runhaskell,
37 -- or when compiled.
38 test :: Bool -> IO ()
39 test causeFailure =
40 do h1 <- openFile fp ReadMode `Prelude.catch` (\e -> error ("openFile 1: " ++ show e))
41 when causeFailure $ do
42 h2 <- openFile fp ReadMode `Prelude.catch` (\e -> error ("openFile 2: " ++ show e))
43 hClose h2
44 hClose h1
45 removeFile fp
46 writeFile fp (show [1..100]) `Prelude.catch` (\e -> error ("writeFile: " ++ show e))
47
48 {-
49 -- this version never fails (except in GHCi, if test has previously failed).
50 -- probably because openFd does not try to lock the file
51 test2 :: Bool -> IO ()
52 test2 causeFailure =
53 do fd1 <- openFd fp ReadOnly Nothing defaultFileFlags `Prelude.catch` (\e -> error ("openFile 1: " ++ show e))
54 when causeFailure $ do
55 fd2 <- openFd fp ReadOnly Nothing defaultFileFlags `Prelude.catch` (\e -> error ("openFile 2: " ++ show e))
56 closeFd fd2
57 closeFd fd1
58 removeFile fp
59 writeFile fp (show [1..100]) `Prelude.catch` (\e -> error ("writeFile: " ++ show e))
60 -}
61
62 {-
63 -- fails sometimes when run repeated in GHCi, but seems fine with
64 -- runhaskell or compiled
65 test3 :: IO ()
66 test3 =
67 do h1 <- openFile fp ReadMode `Prelude.catch` (\e -> error ("openFile 1: " ++ show e))
68 h2 <- openFile fp ReadMode `Prelude.catch` (\e -> error ("openFile 2: " ++ show e))
69 removeFile fp
70 writeFile fp (show [1..100]) `Prelude.catch` (\e -> error ("writeFile: " ++ show e))
71 print =<< hGetContents h1
72 print =<< hGetContents h2
73 hClose h2
74 hClose h1
75 -}
76