Commit b8d7b8fa authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Update tests following changes in base

parent c4b81e3d
......@@ -22,6 +22,7 @@ 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
......@@ -37,26 +38,26 @@ main = do
-- or when compiled.
test :: Bool -> IO ()
test causeFailure =
do h1 <- openFile fp ReadMode `Prelude.catch` (\e -> error ("openFile 1: " ++ show e))
do h1 <- openFile fp ReadMode `catchIOError` (\e -> error ("openFile 1: " ++ show e))
when causeFailure $ do
h2 <- openFile fp ReadMode `Prelude.catch` (\e -> error ("openFile 2: " ++ show e))
h2 <- openFile fp ReadMode `catchIOError` (\e -> error ("openFile 2: " ++ show e))
hClose h2
hClose h1
removeFile fp
writeFile fp (show [1..100]) `Prelude.catch` (\e -> error ("writeFile: " ++ show e))
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 Nothing defaultFileFlags `Prelude.catch` (\e -> error ("openFile 1: " ++ show e))
do fd1 <- openFd fp ReadOnly Nothing defaultFileFlags `catchIOError` (\e -> error ("openFile 1: " ++ show e))
when causeFailure $ do
fd2 <- openFd fp ReadOnly Nothing defaultFileFlags `Prelude.catch` (\e -> error ("openFile 2: " ++ show e))
fd2 <- openFd fp ReadOnly Nothing defaultFileFlags `catchIOError` (\e -> error ("openFile 2: " ++ show e))
closeFd fd2
closeFd fd1
removeFile fp
writeFile fp (show [1..100]) `Prelude.catch` (\e -> error ("writeFile: " ++ show e))
writeFile fp (show [1..100]) `catchIOError` (\e -> error ("writeFile: " ++ show e))
-}
{-
......@@ -64,10 +65,10 @@ test2 causeFailure =
-- 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))
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]) `Prelude.catch` (\e -> error ("writeFile: " ++ show e))
writeFile fp (show [1..100]) `catchIOError` (\e -> error ("writeFile: " ++ show e))
print =<< hGetContents h1
print =<< hGetContents h2
hClose h2
......
import System.IO.Error
-- test for a bug in GHC <= 4.08.2: handles were being left locked after
-- being shown in an error message.
main = do
getContents
catch getChar (\e -> print e >> return 'x')
catch getChar (\e -> print e >> return 'x')
catchIOError getChar (\e -> print e >> return 'x')
catchIOError getChar (\e -> print e >> return 'x')
......@@ -18,5 +18,5 @@ test file bufmode = do
h <- openFile file ReadMode
hSetEncoding h utf8
hSetBuffering h bufmode
e <- try $ forever $ hGetChar h >>= putChar
e <- tryIOError $ forever $ hGetChar h >>= putChar
print (e :: Either IOError ())
......@@ -19,5 +19,5 @@ test file enc_name = do
h <- openFile file ReadMode
enc <- mkTextEncoding enc_name
hSetEncoding h enc
e <- try $ forever $ hGetChar h >>= putChar
e <- tryIOError $ forever $ hGetChar h >>= putChar
print (e :: Either IOError ())
......@@ -12,8 +12,6 @@ import GHC.IO.Encoding (TextEncoding, mkTextEncoding)
import Data.Char
import Data.Word
import Prelude hiding (catch)
decode :: TextEncoding -> [Word8] -> IO String
decode enc xs = withArrayLen xs (\sz p -> peekCStringLen enc (castPtr p, sz)) `catch` \e -> return (show (e :: IOException))
......
......@@ -20,7 +20,7 @@ main = do
checkedPutStr "Hello αβγ\n" -- we should write at least the "Hello "
checkedPutStr str = do
r <- try $ putStr str
r <- tryIOError $ putStr str
case r of
Right _ -> return ()
Left e -> printf "Caught %s while trying to write %s\n"
......
......@@ -4,9 +4,10 @@ module Main(main) where
import Control.Monad
import System.Directory ( removeFile, doesFileExist )
import System.IO
import System.IO.Error
main = do
sz <- hFileSize stdin `catch` (\ _ -> return (-1))
sz <- hFileSize stdin `catchIOError` (\ _ -> return (-1))
print sz
let fn = "hFileSize002.out"
f <- doesFileExist fn
......
......@@ -4,15 +4,16 @@ module Main(main) where
import Control.Monad
import System.Directory ( removeFile, doesFileExist )
import System.IO
import System.IO.Error
main = do
hFlush stdin `catch` \ _ -> putStrLn "No can do - flushing read-only handles isn't legal"
hFlush stdin `catchIOError` \ _ -> putStrLn "No can do - flushing read-only handles isn't legal"
putStr "Hello,"
hFlush stdout
putStr "Hello - "
hFlush stderr
hdl <- openFile "hFlush001.hs" ReadMode
hFlush hdl `catch` \ _ -> putStrLn "No can do - flushing read-only handles isn't legal"
hFlush hdl `catchIOError` \ _ -> putStrLn "No can do - flushing read-only handles isn't legal"
hClose hdl
remove
hdl <- openFile "hFlush001.out" WriteMode
......
......@@ -6,8 +6,9 @@
-- However, we don't believe that this is the right behaviour.
import System.IO
import System.IO.Error
main = catch loop (\e -> print e)
main = catchIOError loop (\e -> print e)
loop = do
hSetBuffering stdin LineBuffering
......
......@@ -23,6 +23,6 @@ main = do
copy :: Handle -> Handle -> IO ()
copy hIn hOut =
try (hGetChar hIn) >>=
tryIOError (hGetChar hIn) >>=
either (\ err -> if isEOFError err then return () else error "copy")
( \ x -> hPutChar hOut x >> copy hIn hOut)
-- !!! hIsEOF (on stdout)
import System.IO ( hIsEOF, stdout )
import System.IO.Error
main = do
flg <- hIsEOF stdout `catch` \ _ -> putStrLn "hIsEOF failed" >> return False
flg <- hIsEOF stdout `catchIOError` \ _ -> putStrLn "hIsEOF failed" >> return False
print flg
......@@ -3,9 +3,10 @@
-- hReady should throw and EOF exception at the end of a file. Trac #1063.
import System.IO
import System.IO.Error
main = do
h <- openFile "hReady001.hs" ReadMode
hReady h >>= print
hSeek h SeekFromEnd 0
(hReady h >> return ()) `catch` print
(hReady h >> return ()) `catchIOError` print
......@@ -5,4 +5,4 @@ import System.IO.Error
main = do
h <- openFile "hSeek004.out" AppendMode
try (hSeek h AbsoluteSeek 0) >>= print
tryIOError (hSeek h AbsoluteSeek 0) >>= print
......@@ -2,6 +2,7 @@
module Main(main) where
import System.IO
import System.IO.Error
queryBuffering :: String -> Handle -> IO ()
queryBuffering handle_nm handle = do
......@@ -23,7 +24,7 @@ main = do
hSetBuffering stdin (BlockBuffering Nothing)
queryBuffering "stdin" stdin
let bmo = BlockBuffering (Just (-3))
hSetBuffering stdin bmo `catch` \ _ -> putStrLn ("Caught illegal op: hSetBuffering stdin " ++ showParen True (showsPrec 9 bmo) [])
hSetBuffering stdin bmo `catchIOError` \ _ -> putStrLn ("Caught illegal op: hSetBuffering stdin " ++ showParen True (showsPrec 9 bmo) [])
putChar '\n'
......@@ -42,7 +43,7 @@ main = do
queryBuffering "stdout" stdout
hPutStr stdout "Hello stdout 5"
let bmo = BlockBuffering (Just (-3))
hSetBuffering stdout bmo `catch` \ _ -> putStrLn ("Caught illegal op: hSetBuffering stdout " ++ showParen True (showsPrec 9 bmo) [])
hSetBuffering stdout bmo `catchIOError` \ _ -> putStrLn ("Caught illegal op: hSetBuffering stdout " ++ showParen True (showsPrec 9 bmo) [])
putChar '\n'
......@@ -61,7 +62,7 @@ main = do
queryBuffering "stderr" stderr
hPutStr stderr "Hello stderr 5"
let bmo = BlockBuffering (Just (-3))
hSetBuffering stderr bmo `catch` \ _ -> putStrLn ("Caught illegal op: hSetBuffering stderr " ++ showParen True (showsPrec 9 bmo) [])
hSetBuffering stderr bmo `catchIOError` \ _ -> putStrLn ("Caught illegal op: hSetBuffering stderr " ++ showParen True (showsPrec 9 bmo) [])
ls <- hGetContents stdin
ls' <- putLine ls
......
......@@ -7,7 +7,7 @@ import Data.Maybe
main = do
h <- openFile "ioeGetErrorString001.hs" ReadMode
hSeek h SeekFromEnd 0
(hGetChar h >> return ()) `catch`
(hGetChar h >> return ()) `catchIOError`
\e -> if isEOFError e
then print (ioeGetErrorString e)
else putStrLn "failed."
......@@ -6,7 +6,7 @@ import System.IO.Error
main = do
h <- openFile "ioeGetFileName001.hs" ReadMode
hSeek h SeekFromEnd 0
(hGetChar h >> return ()) `catch`
(hGetChar h >> return ()) `catchIOError`
\e -> if isEOFError e
then print (ioeGetFileName e)
else putStrLn "failed."
......@@ -7,7 +7,7 @@ import Data.Maybe
main = do
h <- openFile "ioeGetHandle001.hs" ReadMode
hSeek h SeekFromEnd 0
(hGetChar h >> return ()) `catch`
(hGetChar h >> return ()) `catchIOError`
\e -> if isEOFError e && fromJust (ioeGetHandle e) == h
then putStrLn "ok."
else putStrLn "failed."
......@@ -25,14 +25,14 @@ main = do
-- hSetBuffering cd NoBuffering
hPutStr cd speakString
hSeek cd AbsoluteSeek 0
speak cd `catch` \ err -> if isEOFError err then putStrLn "\nCaught EOF" else ioError err
speak cd `catchIOError` \ err -> if isEOFError err then putStrLn "\nCaught EOF" else ioError err
hSeek cd AbsoluteSeek 0
hSetBuffering cd LineBuffering
speak cd `catch` \ err -> if isEOFError err then putStrLn "\nCaught EOF" else ioError err
speak cd `catchIOError` \ err -> if isEOFError err then putStrLn "\nCaught EOF" else ioError err
return ()
hSeek cd AbsoluteSeek 0
hSetBuffering cd (BlockBuffering Nothing)
speak cd `catch` \ err -> if isEOFError err then putStrLn "\nCaught EOF" else ioError err
speak cd `catchIOError` \ err -> if isEOFError err then putStrLn "\nCaught EOF" else ioError err
speakString = "##############################\n"
......
{-# LANGUAGE ScopedTypeVariables #-}
import Control.Exception
import Prelude hiding (catch)
-- enumFrom on basic numeric types should be strict
-- (possibly a bug in the Haskell Report: it specifies that
......
module Main where
import Prelude hiding (catch)
import Control.Exception
import System.IO.Error hiding (catch, try)
import System.IO.Error
main = do
ioTest
......
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