Commit 561d44cc authored by Simon Marlow's avatar Simon Marlow

add test for #2122

parent 03cb3d79
{-
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.Environment
import System.Posix.IO
fp = "2122-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 `Prelude.catch` (\e -> error ("openFile 1: " ++ show e))
when causeFailure $ do
h2 <- openFile fp ReadMode `Prelude.catch` (\e -> error ("openFile 2: " ++ show e))
hClose h2
hClose h1
removeFile fp
writeFile fp (show [1..100]) `Prelude.catch` (\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 Nothing defaultFileFlags `Prelude.catch` (\e -> error ("openFile 1: " ++ show e))
when causeFailure $ do
fd2 <- openFd fp ReadOnly Nothing defaultFileFlags `Prelude.catch` (\e -> error ("openFile 2: " ++ show e))
closeFd fd2
closeFd fd1
removeFile fp
writeFile fp (show [1..100]) `Prelude.catch` (\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 `Prelude.catch` (\e -> error ("openFile 1: " ++ show e))
h2 <- openFile fp ReadMode `Prelude.catch` (\e -> error ("openFile 2: " ++ show e))
removeFile fp
writeFile fp (show [1..100]) `Prelude.catch` (\e -> error ("writeFile: " ++ show e))
print =<< hGetContents h1
print =<< hGetContents h2
hClose h2
hClose h1
......@@ -102,3 +102,5 @@ test('concio001', skip, run_command, ['$MAKE -s --no-print-directory test.concio
test('concio001.thr', skip, run_command, ['$MAKE -s --no-print-directory test.concio001.thr'])
test('concio002', reqlib('process'), compile_and_run, [''])
test('2122', extra_clean(['2122-test']), compile_and_run, [''])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment