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