diff options
author | David Terei <davidterei@gmail.com> | 2011-07-20 11:09:03 -0700 |
---|---|---|
committer | David Terei <davidterei@gmail.com> | 2011-07-20 11:26:35 -0700 |
commit | 16514f272fb42af6e9c7674a9bd6c9dce369231f (patch) | |
tree | e4f332b45fe65e2a7a2451be5674f887b42bf199 /testsuite/tests/lib/IO | |
parent | ebd422aed41048476aa61dd4c520d43becd78682 (diff) | |
download | haskell-16514f272fb42af6e9c7674a9bd6c9dce369231f.tar.gz |
Move tests from tests/ghc-regress/* to just tests/*
Diffstat (limited to 'testsuite/tests/lib/IO')
157 files changed, 3081 insertions, 0 deletions
diff --git a/testsuite/tests/lib/IO/2122.hs b/testsuite/tests/lib/IO/2122.hs new file mode 100644 index 0000000000..6807f3476a --- /dev/null +++ b/testsuite/tests/lib/IO/2122.hs @@ -0,0 +1,76 @@ +{- + +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 +-- Used by test2: +-- 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 +-} + diff --git a/testsuite/tests/lib/IO/3307.hs b/testsuite/tests/lib/IO/3307.hs new file mode 100644 index 0000000000..fb1a360ea2 --- /dev/null +++ b/testsuite/tests/lib/IO/3307.hs @@ -0,0 +1,52 @@ +import Control.Exception + +import System.Directory +import System.Environment +import System.IO + +import Data.Char +import Data.List + +import GHC.IO.Encoding + +main = do + hSetBuffering stdout NoBuffering + + -- 1) A file name arriving via an argument + putStrLn "Test 1" + [file] <- getArgs + print $ map ord file + readFile file >>= putStr + + -- 2) A file name arriving via getDirectoryContents + putStrLn "Test 2" + [file] <- fmap (filter ("chinese-file-" `isPrefixOf`)) $ getDirectoryContents "." + print $ map ord file + readFile file >>= putStr + + -- 3) A file name occurring literally in the program + -- The file is created with a UTF-8 file name as well, so this will only work in Windows or a + -- UTF-8 locale, or this string will be encoded in some non-UTF-8 way and won't match. + putStrLn "Test 3" + let file = "chinese-file-小说" + print $ map ord file + readFile file >>= putStr + + -- 4) A file name arriving via another file. + -- Again, the file is created with UTF-8 contents, so we read it in that encoding. + -- Once again, on non-Windows this may fail in a non-UTF-8 locale because we could encode the valid + -- filename string into a useless non-UTF-8 byte sequence. + putStrLn "Test 4" + str <- readFileAs utf8 "chinese-name" + let file = dropTrailingSpace str + print $ map ord file + readFile file >>= putStr + +readFileAs :: TextEncoding -> FilePath -> IO String +readFileAs enc fp = do + h <- openFile fp ReadMode + hSetEncoding h enc + hGetContents h + +dropTrailingSpace :: String -> String +dropTrailingSpace = reverse . dropWhile (not . isAlphaNum) . reverse diff --git a/testsuite/tests/lib/IO/3307.stdout b/testsuite/tests/lib/IO/3307.stdout new file mode 100644 index 0000000000..8b26b5ff1d --- /dev/null +++ b/testsuite/tests/lib/IO/3307.stdout @@ -0,0 +1,12 @@ +Test 1 +[99,104,105,110,101,115,101,45,102,105,108,101,45,23567,35828] +Ni hao +Test 2 +[99,104,105,110,101,115,101,45,102,105,108,101,45,23567,35828] +Ni hao +Test 3 +[99,104,105,110,101,115,101,45,102,105,108,101,45,23567,35828] +Ni hao +Test 4 +[99,104,105,110,101,115,101,45,102,105,108,101,45,23567,35828] +Ni hao diff --git a/testsuite/tests/lib/IO/4808.hs b/testsuite/tests/lib/IO/4808.hs new file mode 100644 index 0000000000..97ca344bb4 --- /dev/null +++ b/testsuite/tests/lib/IO/4808.hs @@ -0,0 +1,12 @@ +import System.IO +import GHC.IO.Handle +import GHC.IO.FD as FD + +main = do + (fd, _) <- FD.openFile "4808.hs" ReadWriteMode False + hdl <- mkDuplexHandle fd "4808.hs" Nothing nativeNewlineMode + hClose hdl + (fd2, _) <- FD.openFile "4808.hs" ReadWriteMode False + print (fdFD fd == fdFD fd2) -- should be True + hGetLine hdl >>= print -- should fail with an exception + diff --git a/testsuite/tests/lib/IO/4808.stderr b/testsuite/tests/lib/IO/4808.stderr new file mode 100644 index 0000000000..cccd936d05 --- /dev/null +++ b/testsuite/tests/lib/IO/4808.stderr @@ -0,0 +1 @@ +4808: 4808.hs: hGetLine: illegal operation (handle is closed) diff --git a/testsuite/tests/lib/IO/4808.stdout b/testsuite/tests/lib/IO/4808.stdout new file mode 100644 index 0000000000..0ca95142bb --- /dev/null +++ b/testsuite/tests/lib/IO/4808.stdout @@ -0,0 +1 @@ +True diff --git a/testsuite/tests/lib/IO/4855.hs b/testsuite/tests/lib/IO/4855.hs new file mode 100644 index 0000000000..fa862aaf14 --- /dev/null +++ b/testsuite/tests/lib/IO/4855.hs @@ -0,0 +1,3 @@ +import Debug.Trace + +main = trace "我爱我的电脑" $ return ()
\ No newline at end of file diff --git a/testsuite/tests/lib/IO/4855.stderr b/testsuite/tests/lib/IO/4855.stderr new file mode 100644 index 0000000000..558550e229 --- /dev/null +++ b/testsuite/tests/lib/IO/4855.stderr @@ -0,0 +1 @@ +我爱我的电脑 diff --git a/testsuite/tests/lib/IO/4895.hs b/testsuite/tests/lib/IO/4895.hs new file mode 100644 index 0000000000..bb37915e19 --- /dev/null +++ b/testsuite/tests/lib/IO/4895.hs @@ -0,0 +1,9 @@ +module Main where +import Foreign.Marshal.Alloc +import System.IO + +main = do + h <- openBinaryFile "4895.hs" ReadMode + allocaBytes 10 $ \ptr -> hGetBuf h ptr 10 + some <- allocaBytes 10 $ \ptr -> hGetBufSome h ptr 10 + print some diff --git a/testsuite/tests/lib/IO/4895.stdout b/testsuite/tests/lib/IO/4895.stdout new file mode 100644 index 0000000000..f599e28b8a --- /dev/null +++ b/testsuite/tests/lib/IO/4895.stdout @@ -0,0 +1 @@ +10 diff --git a/testsuite/tests/lib/IO/IOError001.hs b/testsuite/tests/lib/IO/IOError001.hs new file mode 100644 index 0000000000..dee7f31e29 --- /dev/null +++ b/testsuite/tests/lib/IO/IOError001.hs @@ -0,0 +1,7 @@ + +-- 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') diff --git a/testsuite/tests/lib/IO/IOError001.stdout b/testsuite/tests/lib/IO/IOError001.stdout new file mode 100644 index 0000000000..1e689bb0f9 --- /dev/null +++ b/testsuite/tests/lib/IO/IOError001.stdout @@ -0,0 +1,2 @@ +<stdin>: hGetChar: illegal operation (handle is closed) +<stdin>: hGetChar: illegal operation (handle is closed) diff --git a/testsuite/tests/lib/IO/IOError001.stdout-hugs b/testsuite/tests/lib/IO/IOError001.stdout-hugs new file mode 100644 index 0000000000..036084a006 --- /dev/null +++ b/testsuite/tests/lib/IO/IOError001.stdout-hugs @@ -0,0 +1,2 @@ +<stdin>: getChar: illegal operation (handle is semi-closed) +<stdin>: getChar: illegal operation (handle is semi-closed) diff --git a/testsuite/tests/lib/IO/IOError002.hs b/testsuite/tests/lib/IO/IOError002.hs new file mode 100644 index 0000000000..144e62783b --- /dev/null +++ b/testsuite/tests/lib/IO/IOError002.hs @@ -0,0 +1,5 @@ +-- !!! IOErrors should have Eq defined + +import System.IO + +main = print (userError "urk" == userError "urk") diff --git a/testsuite/tests/lib/IO/IOError002.stdout b/testsuite/tests/lib/IO/IOError002.stdout new file mode 100644 index 0000000000..0ca95142bb --- /dev/null +++ b/testsuite/tests/lib/IO/IOError002.stdout @@ -0,0 +1 @@ +True diff --git a/testsuite/tests/lib/IO/Makefile b/testsuite/tests/lib/IO/Makefile new file mode 100644 index 0000000000..6808f5f868 --- /dev/null +++ b/testsuite/tests/lib/IO/Makefile @@ -0,0 +1,48 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +test.concio001: + $(TEST_HC) $(TEST_HC_OPTS) --make -fforce-recomp -v0 concio001 -o concio001 + (sleep 1; echo x) | ./concio001 + +test.concio001.thr: + $(TEST_HC) $(TEST_HC_OPTS) --make -fforce-recomp -v0 -threaded concio001 -o concio001 + (sleep 1; echo x) | ./concio001 + +# NB. utf8-test should *not* have a final newline. The last char should be 'X'. +utf16-test: utf8-test + iconv -f UTF-8 -t UTF-16 <utf8-test >utf16-test + +utf16le-test: utf8-test + iconv -f UTF-8 -t UTF-16LE <utf8-test >utf16le-test + +utf16be-test: utf8-test + iconv -f UTF-8 -t UTF-16BE <utf8-test >utf16be-test + +utf32-test: utf8-test + iconv -f UTF-8 -t UTF-32 <utf8-test >utf32-test + +utf32le-test: utf8-test + iconv -f UTF-8 -t UTF-32LE <utf8-test >utf32le-test + +utf32be-test: utf8-test + iconv -f UTF-8 -t UTF-32BE <utf8-test >utf32be-test + +utf8-bom-test: utf16-test + iconv -f UTF-16LE -t UTF-8 <utf16-test >utf8-bom-test + +hSetEncoding001.in : latin1 utf8-test utf16le-test utf16be-test utf16-test utf32le-test utf32be-test utf32-test utf8-bom-test + cat >$@ latin1 utf8-test utf16le-test utf16be-test utf16-test utf32-test utf32le-test utf32be-test utf8-bom-test + +environment001-test: + "$(TEST_HC)" --make -fforce-recomp -v0 environment001.hs -o environment001 + GHC_TEST=马克斯 ./environment001 说 + +3307-test: + "$(TEST_HC)" --make -fforce-recomp -v0 3307.hs -o 3307 + echo Ni hao > chinese-file-小说 + echo chinese-file-小说 > chinese-name + # The tests are run in whatever the default locale is. This is almost always UTF-8, + # but in cmd on Windows it will be the non-Unicode CP850 locale. + ./3307 chinese-file-小说 diff --git a/testsuite/tests/lib/IO/T4113.hs b/testsuite/tests/lib/IO/T4113.hs new file mode 100644 index 0000000000..3bc8096baa --- /dev/null +++ b/testsuite/tests/lib/IO/T4113.hs @@ -0,0 +1,20 @@ + +module Main (main) where + +import Control.Exception +import Prelude hiding (catch) +import System.Directory + +main :: IO () +main = do doit "" + doit "/no/such/file" + +doit :: FilePath -> IO () +doit fp = do fp' <- canonicalizePath fp + print (fp, mangle fp') + `catch` \e -> putStrLn ("Exception: " ++ show (e :: IOException)) + where -- On Windows, "/no/such/file" -> "C:\\no\\such\\file", so + -- we remove the drive letter so as to get consistent output + mangle (_ : ':' : xs) = "drive:" ++ xs + mangle xs = xs + diff --git a/testsuite/tests/lib/IO/T4113.stdout b/testsuite/tests/lib/IO/T4113.stdout new file mode 100644 index 0000000000..86a7e9e295 --- /dev/null +++ b/testsuite/tests/lib/IO/T4113.stdout @@ -0,0 +1,2 @@ +Exception: : canonicalizePath: does not exist (No such file or directory) +Exception: /no/such/file: canonicalizePath: does not exist (No such file or directory) diff --git a/testsuite/tests/lib/IO/T4113.stdout-i386-unknown-mingw32 b/testsuite/tests/lib/IO/T4113.stdout-i386-unknown-mingw32 new file mode 100644 index 0000000000..16f302c475 --- /dev/null +++ b/testsuite/tests/lib/IO/T4113.stdout-i386-unknown-mingw32 @@ -0,0 +1,2 @@ +Exception: getFullPathName: invalid argument (The filename, directory name, or volume label syntax is incorrect.)
+("/no/such/file","drive:\\no\\such\\file")
diff --git a/testsuite/tests/lib/IO/T4144.hs b/testsuite/tests/lib/IO/T4144.hs new file mode 100644 index 0000000000..ca14363682 --- /dev/null +++ b/testsuite/tests/lib/IO/T4144.hs @@ -0,0 +1,115 @@ +{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-} +module Main (main) where + +import Control.Applicative +import Control.Concurrent.MVar +import Control.Monad + +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 +import Data.ByteString.Char8() +import Data.ByteString.Unsafe as B +import Data.ByteString.Internal (memcpy) +import Data.Typeable (Typeable) +import Data.Word + +import Foreign + +import GHC.IO.Buffer +import GHC.IO.BufferedIO +import GHC.IO.Device +import GHC.IO.Handle + +import System.IO + +-- | Create a seakable read-handle from a bytestring +bsHandle :: ByteString -> FilePath -> IO Handle +bsHandle bs fp + = newBsDevice bs >>= \dev -> + mkFileHandle dev fp ReadMode Nothing noNewlineTranslation + +data BSIODevice + = BSIODevice + ByteString + (MVar Int) -- Position + deriving Typeable + +newBsDevice :: ByteString -> IO BSIODevice +newBsDevice bs = BSIODevice bs <$> newMVar 0 + +remaining :: BSIODevice -> IO Int +remaining (BSIODevice bs mPos) + = do + let bsLen = B.length bs + withMVar mPos $ \pos -> return (bsLen - pos) + +sizeBS :: BSIODevice -> Int +sizeBS (BSIODevice bs _) = B.length bs + +seekBS :: BSIODevice -> SeekMode -> Int -> IO () +seekBS dev AbsoluteSeek pos + | pos < 0 = error "Cannot seek to a negative position!" + | pos > sizeBS dev = error "Cannot seek past end of handle!" + | otherwise = case dev of + BSIODevice _ mPos + -> modifyMVar_ mPos $ \_ -> return pos +seekBS dev SeekFromEnd pos = seekBS dev AbsoluteSeek (sizeBS dev - pos) +seekBS dev RelativeSeek pos + = case dev of + BSIODevice _bs mPos + -> modifyMVar_ mPos $ \curPos -> + let newPos = curPos + pos + in if newPos < 0 || newPos > sizeBS dev + then error "Cannot seek outside of handle!" + else return newPos + +tellBS :: BSIODevice -> IO Int +tellBS (BSIODevice _ mPos) = readMVar mPos + +dupBS :: BSIODevice -> IO BSIODevice +dupBS (BSIODevice bs mPos) = BSIODevice bs <$> (readMVar mPos >>= newMVar) + +readBS :: BSIODevice -> Ptr Word8 -> Int -> IO Int +readBS dev@(BSIODevice bs mPos) buff amount + = do + rem <- remaining dev + if amount > rem + then readBS dev buff rem + else B.unsafeUseAsCString bs $ \ptr -> + do + memcpy buff (castPtr ptr) (fromIntegral amount) + modifyMVar_ mPos (return . (+amount)) + return amount + +instance BufferedIO BSIODevice where + newBuffer dev buffState = newByteBuffer (sizeBS dev) buffState + fillReadBuffer dev buff = readBuf dev buff + fillReadBuffer0 dev buff + = do + (amount, buff') <- fillReadBuffer dev buff + return (if amount == 0 then Nothing else Just amount, buff') + +instance RawIO BSIODevice where + read = readBS + readNonBlocking dev buff n = Just `liftM` readBS dev buff n + +instance IODevice BSIODevice where + ready _ True _ = return False -- read only + ready _ False _ = return True -- always ready + + close _ = return () + isTerminal _ = return False + isSeekable _ = return True + seek dev seekMode pos = seekBS dev seekMode (fromIntegral pos) + tell dev = fromIntegral <$> tellBS dev + getSize dev = return $ fromIntegral $ sizeBS dev + setEcho _ _ = error "Not a terminal device" + getEcho _ = error "Not a terminal device" + setRaw _ _ = error "Raw mode not supported" + devType _ = return RegularFile + dup = dupBS + dup2 _ _ = error "Dup2 not supported" + + +main = bsHandle "test" "<fake file>" >>= Data.ByteString.Char8.hGetContents >>= print diff --git a/testsuite/tests/lib/IO/T4144.stdout b/testsuite/tests/lib/IO/T4144.stdout new file mode 100644 index 0000000000..8b8441b91d --- /dev/null +++ b/testsuite/tests/lib/IO/T4144.stdout @@ -0,0 +1 @@ +"test" diff --git a/testsuite/tests/lib/IO/all.T b/testsuite/tests/lib/IO/all.T new file mode 100644 index 0000000000..cf557a6b96 --- /dev/null +++ b/testsuite/tests/lib/IO/all.T @@ -0,0 +1,173 @@ +# -*- coding: utf-8 -*- + +def expect_fail_if_windows(opts): + f = if_platform('i386-unknown-mingw32', expect_fail); + return f(opts); + +test('IOError001', compose(omit_ways(['ghci']), set_stdin('IOError001.hs')), + compile_and_run, ['']) + +test('IOError002', normal, compile_and_run, ['']) +test('finalization001', normal, compile_and_run, ['']) +test('hClose001', extra_clean(['hClose001.tmp']), compile_and_run, ['']) +test('hClose002', extra_clean(['hClose002.tmp']), compile_and_run, ['']) +test('hClose003', reqlib('unix'), compile_and_run, ['-package unix']) +test('hFileSize001', normal, compile_and_run, ['']) +test('hFileSize002', + [omit_ways(['ghci']), + extra_clean(['hFileSize002.out'])], + compile_and_run, ['']) +test('hFlush001', + extra_clean(['hFlush001.out']), + compile_and_run, ['']) + +test('hGetBuffering001', + compose(omit_ways(['ghci']), set_stdin('hGetBuffering001.hs')), + compile_and_run, ['']) + +test('hGetChar001', normal, compile_and_run, ['']) +test('hGetLine001', set_stdin('hGetLine001.hs'), compile_and_run, ['-cpp']) +test('hGetLine002', normal, compile_and_run, ['']) +test('hGetLine003', normal, compile_and_run, ['']) +test('hGetPosn001', + extra_clean(['hGetPosn001.out']), + compile_and_run, ['-cpp']) +test('hIsEOF001', normal, compile_and_run, ['']) +test('hIsEOF002', extra_clean(['hIsEOF002.out']), compile_and_run, ['-cpp']) + +test('hReady001', normal, compile_and_run, ['-cpp']) + +# hReady002 tests that hReady returns False for a pipe that has no +# data to read. It relies on piping input from 'sleep 1', which doesn't +# work for the 'ghci' way because in that case we already pipe input from +# a script, so hence omit_ways(['ghci']) +test('hReady002', [ no_stdin, cmd_prefix('sleep 1 |'), + omit_ways(['ghci']) ], + compile_and_run, ['']) + +test('hSeek001', normal, compile_and_run, ['']) +test('hSeek002', normal, compile_and_run, ['-cpp']) +test('hSeek003', normal, compile_and_run, ['-cpp']) +test('hSeek004', extra_clean(['hSeek004.out']), compile_and_run, ['-cpp']) + +test('hSetBuffering002', set_stdin('hSetBuffering002.hs'), compile_and_run, ['']) + +test('hSetBuffering003', compose(omit_ways(['ghci']), + set_stdin('hSetBuffering003.hs')), + compile_and_run, ['']) + +test('hSetBuffering004', set_stdin('hSetBuffering004.hs'), compile_and_run, ['']) + +test('ioeGetErrorString001', normal, compile_and_run, ['-cpp']) +test('ioeGetFileName001', normal, compile_and_run, ['-cpp']) +test('ioeGetHandle001', normal, compile_and_run, ['-cpp']) +test('isEOF001', normal, compile_and_run, ['']) + +test('misc001', + [extra_run_opts('misc001.hs misc001.out'), + extra_clean(['misc001.out'])], + compile_and_run, ['']) + +test('openFile001', normal, compile_and_run, ['']) +test('openFile002', exit_code(1), compile_and_run, ['']) +test('openFile003', normal, compile_and_run, ['']) +test('openFile004', extra_clean(['openFile004.out']), compile_and_run, ['']) +test('openFile005', + [if_compiler_type('hugs', expect_fail), + extra_clean(['openFile005.out1', 'openFile005.out2'])], + compile_and_run, ['']) +test('openFile006', extra_clean(['openFile006.out']), compile_and_run, ['']) +test('openFile007', + [if_compiler_type('hugs', expect_fail), + extra_clean(['openFile007.out'])], + compile_and_run, ['']) +test('openFile008', cmd_prefix('ulimit -n 1024; '), compile_and_run, ['']) + +test('putStr001', normal, compile_and_run, ['']) +test('readFile001', + [if_compiler_type('hugs', expect_fail), + extra_clean(['readFile001.out'])], + compile_and_run, ['']) +test('readwrite001', + extra_clean(['readwrite001.inout']), + compile_and_run, + ['-cpp']) + + +test('readwrite002', + [omit_ways(['ghci']), + set_stdin('readwrite002.hs'), + extra_clean(['readwrite002.inout'])], + compile_and_run, ['-cpp']) + +test('readwrite003', extra_clean(['readwrite003.txt']), compile_and_run, ['']) + +test('hGetBuf001', compose(only_compiler_types(['ghc']), + compose(skip_if_fast, + expect_fail_if_windows)), compile_and_run, ['-package unix']) + +test('hDuplicateTo001', extra_clean(['tmp']), compile_and_run, ['']) + +test('countReaders001', + extra_clean(['countReaders001.txt']), + compile_and_run, ['']) + +test('concio001', skip, run_command, ['$MAKE -s --no-print-directory test.concio001']) +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, ['']) +test('3307', + [extra_clean(['chinese-file-小说', 'chinese-name'])], + run_command, + ['$MAKE -s --no-print-directory 3307-test']) +test('4855', normal, compile_and_run, ['']) + +test('hSetEncoding001',extra_run_opts('hSetEncoding001.in'), compile_and_run, ['']) +test('decodingerror001',normal, compile_and_run, ['']) + +test('encoding001', + extra_clean([ + 'encoding001.utf16', 'encoding001.utf16.utf16be', + 'encoding001.utf16.utf16le', 'encoding001.utf16.utf32', + 'encoding001.utf16.utf32be', 'encoding001.utf16.utf32le', + 'encoding001.utf16.utf8', 'encoding001.utf16be', + 'encoding001.utf16be.utf16', 'encoding001.utf16be.utf16le', + 'encoding001.utf16be.utf32', 'encoding001.utf16be.utf32be', + 'encoding001.utf16be.utf32le', 'encoding001.utf16be.utf8', + 'encoding001.utf16le', 'encoding001.utf16le.utf16', + 'encoding001.utf16le.utf16be', 'encoding001.utf16le.utf32', + 'encoding001.utf16le.utf32be', 'encoding001.utf16le.utf32le', + 'encoding001.utf16le.utf8', 'encoding001.utf32', + 'encoding001.utf32.utf16', 'encoding001.utf32.utf16be', + 'encoding001.utf32.utf16le', 'encoding001.utf32.utf32be', + 'encoding001.utf32.utf32le', 'encoding001.utf32.utf8', + 'encoding001.utf32be', 'encoding001.utf32be.utf16', + 'encoding001.utf32be.utf16be', 'encoding001.utf32be.utf16le', + 'encoding001.utf32be.utf32', 'encoding001.utf32be.utf32le', + 'encoding001.utf32be.utf8', 'encoding001.utf32le', + 'encoding001.utf32le.utf16', 'encoding001.utf32le.utf16be', + 'encoding001.utf32le.utf16le', 'encoding001.utf32le.utf32', + 'encoding001.utf32le.utf32be', 'encoding001.utf32le.utf8', + 'encoding001.utf8', 'encoding001.utf8.utf16', + 'encoding001.utf8.utf16be', 'encoding001.utf8.utf16le', + 'encoding001.utf8.utf32', 'encoding001.utf8.utf32be', + 'encoding001.utf8.utf32le']), + compile_and_run, ['']) + +test('encoding002', normal, compile_and_run, ['']) + +test('environment001', extra_clean(['environment001']), run_command, ['$MAKE -s --no-print-directory environment001-test']) + +test('newline001', extra_clean(['newline001.out']), compile_and_run, ['']) + +test('openTempFile001', normal, compile_and_run, ['']) +test('T4113', normal, compile_and_run, ['']) + +test('T4144', normal, compile_and_run, ['']) + +test('encodingerror001', normal, compile_and_run, ['']) + +test('4808', exit_code(1), compile_and_run, ['']) +test('4895', normal, compile_and_run, ['']) diff --git a/testsuite/tests/lib/IO/concio001.hs b/testsuite/tests/lib/IO/concio001.hs new file mode 100644 index 0000000000..786a311ce5 --- /dev/null +++ b/testsuite/tests/lib/IO/concio001.hs @@ -0,0 +1,6 @@ +import Control.Concurrent + +main = do + forkIO $ do threadDelay 100000; putStrLn "child" + getLine + putStrLn "parent" diff --git a/testsuite/tests/lib/IO/concio001.stdout b/testsuite/tests/lib/IO/concio001.stdout new file mode 100644 index 0000000000..141a8cd80c --- /dev/null +++ b/testsuite/tests/lib/IO/concio001.stdout @@ -0,0 +1,2 @@ +child +parent diff --git a/testsuite/tests/lib/IO/concio001.thr.stdout b/testsuite/tests/lib/IO/concio001.thr.stdout new file mode 100644 index 0000000000..141a8cd80c --- /dev/null +++ b/testsuite/tests/lib/IO/concio001.thr.stdout @@ -0,0 +1,2 @@ +child +parent diff --git a/testsuite/tests/lib/IO/concio002.hs b/testsuite/tests/lib/IO/concio002.hs new file mode 100644 index 0000000000..60a2ed2a89 --- /dev/null +++ b/testsuite/tests/lib/IO/concio002.hs @@ -0,0 +1,14 @@ +import System.Process +import System.IO +import Control.Concurrent + +main = do + (hin,hout,herr,ph) <- runInteractiveProcess "cat" [] Nothing Nothing + forkIO $ do threadDelay 100000 + putStrLn "child" + hFlush stdout + hPutStrLn hin "msg" + hFlush hin + putStrLn "parent1" + hGetLine hout >>= putStrLn + putStrLn "parent2" diff --git a/testsuite/tests/lib/IO/concio002.stdout b/testsuite/tests/lib/IO/concio002.stdout new file mode 100644 index 0000000000..32640aede5 --- /dev/null +++ b/testsuite/tests/lib/IO/concio002.stdout @@ -0,0 +1,4 @@ +parent1 +child +msg +parent2 diff --git a/testsuite/tests/lib/IO/countReaders001.hs b/testsuite/tests/lib/IO/countReaders001.hs new file mode 100644 index 0000000000..2648ae77ae --- /dev/null +++ b/testsuite/tests/lib/IO/countReaders001.hs @@ -0,0 +1,17 @@ +-- test for trac #629. We need to keep track of how many readers +-- there are rather than closing the first read handle causing the +-- lock to be released. + +import System.IO +import System.IO.Error + +file = "countReaders001.txt" + +main = do + writeFile file "foo" + + h1 <- openFile file ReadMode + h2 <- openFile file ReadMode + hClose h1 + tryIOError (openFile file AppendMode) >>= print + diff --git a/testsuite/tests/lib/IO/countReaders001.stdout b/testsuite/tests/lib/IO/countReaders001.stdout new file mode 100644 index 0000000000..41644bff37 --- /dev/null +++ b/testsuite/tests/lib/IO/countReaders001.stdout @@ -0,0 +1 @@ +Left countReaders001.txt: openFile: resource busy (file is locked) diff --git a/testsuite/tests/lib/IO/countReaders001.stdout-i386-unknown-mingw32 b/testsuite/tests/lib/IO/countReaders001.stdout-i386-unknown-mingw32 new file mode 100644 index 0000000000..bf80d9dc12 --- /dev/null +++ b/testsuite/tests/lib/IO/countReaders001.stdout-i386-unknown-mingw32 @@ -0,0 +1 @@ +Left countReaders001.txt: openFile: permission denied (Permission denied) diff --git a/testsuite/tests/lib/IO/decodingerror001.hs b/testsuite/tests/lib/IO/decodingerror001.hs new file mode 100644 index 0000000000..6c9dca1489 --- /dev/null +++ b/testsuite/tests/lib/IO/decodingerror001.hs @@ -0,0 +1,22 @@ +import Control.Monad +import System.IO +import System.IO.Error +import GHC.IO.Encoding (utf8) +import GHC.IO.Handle (hSetEncoding) + +testfiles = ["decodingerror001.in1", "decodingerror001.in2"] + +main = mapM_ alltests testfiles + +alltests file = mapM (test file) [NoBuffering, + LineBuffering, + BlockBuffering Nothing, + BlockBuffering (Just 9), + BlockBuffering (Just 23) ] + +test file bufmode = do + h <- openFile file ReadMode + hSetEncoding h utf8 + hSetBuffering h bufmode + e <- try $ forever $ hGetChar h >>= putChar + print (e :: Either IOError ()) diff --git a/testsuite/tests/lib/IO/decodingerror001.in1 b/testsuite/tests/lib/IO/decodingerror001.in1 new file mode 100644 index 0000000000..7686e7b2f4 --- /dev/null +++ b/testsuite/tests/lib/IO/decodingerror001.in1 @@ -0,0 +1 @@ +UTF8 error:after error diff --git a/testsuite/tests/lib/IO/decodingerror001.in2 b/testsuite/tests/lib/IO/decodingerror001.in2 new file mode 100644 index 0000000000..fe33bd3883 --- /dev/null +++ b/testsuite/tests/lib/IO/decodingerror001.in2 @@ -0,0 +1 @@ +UTF8 incomplete sequence at end:
\ No newline at end of file diff --git a/testsuite/tests/lib/IO/decodingerror001.stdout b/testsuite/tests/lib/IO/decodingerror001.stdout new file mode 100644 index 0000000000..21e5208c79 --- /dev/null +++ b/testsuite/tests/lib/IO/decodingerror001.stdout @@ -0,0 +1,10 @@ +UTF8 error:Left decodingerror001.in1: hGetChar: invalid argument (invalid byte sequence) +UTF8 error:Left decodingerror001.in1: hGetChar: invalid argument (invalid byte sequence) +UTF8 error:Left decodingerror001.in1: hGetChar: invalid argument (invalid byte sequence) +UTF8 error:Left decodingerror001.in1: hGetChar: invalid argument (invalid byte sequence) +UTF8 error:Left decodingerror001.in1: hGetChar: invalid argument (invalid byte sequence) +UTF8 incomplete sequence at end:Left decodingerror001.in2: hGetChar: invalid argument (invalid byte sequence for this encoding) +UTF8 incomplete sequence at end:Left decodingerror001.in2: hGetChar: invalid argument (invalid byte sequence for this encoding) +UTF8 incomplete sequence at end:Left decodingerror001.in2: hGetChar: invalid argument (invalid byte sequence for this encoding) +UTF8 incomplete sequence at end:Left decodingerror001.in2: hGetChar: invalid argument (invalid byte sequence for this encoding) +UTF8 incomplete sequence at end:Left decodingerror001.in2: hGetChar: invalid argument (invalid byte sequence for this encoding) diff --git a/testsuite/tests/lib/IO/encoding001.hs b/testsuite/tests/lib/IO/encoding001.hs new file mode 100644 index 0000000000..3135155feb --- /dev/null +++ b/testsuite/tests/lib/IO/encoding001.hs @@ -0,0 +1,71 @@ +import Control.Monad +import System.IO +import GHC.IO.Encoding +import GHC.IO.Handle +import Data.Bits +import Data.Word +import Data.Char +import System.FilePath +import System.Exit + +file = "encoding001" + +encodings = [(utf8, "utf8"), + (utf8_bom,"utf8_bom"), + (utf16, "utf16"), + (utf16le,"utf16le"), + (utf16be,"utf16be"), + (utf32, "utf32"), + (utf32le,"utf32le"), + (utf32be,"utf32be")] + +main = do + -- make a UTF-32BE file + h <- openBinaryFile (file <.> "utf32be") WriteMode + let expand32 :: Word32 -> [Char] + expand32 x = [ + chr (fromIntegral (x `shiftR` 24) .&. 0xff), + chr (fromIntegral (x `shiftR` 16) .&. 0xff), + chr (fromIntegral (x `shiftR` 8) .&. 0xff), + chr (fromIntegral x .&. 0xff) ] + hPutStr h (concatMap expand32 [ 0, 32 .. 0xD7ff ]) + -- We avoid the private-use characters at 0xEF00..0xEFFF + -- that reserved for GHC's PEP383 roundtripping implementation. + -- + -- The reason is that currently normal text containing those + -- characters will be mangled, even if we aren't using an encoding + -- created using //ROUNDTRIP. + hPutStr h (concatMap expand32 [ 0xE000, 0xE000+32 .. 0xEEFF ]) + hPutStr h (concatMap expand32 [ 0xF000, 0xF000+32 .. 0x10FFFF ]) + hClose h + + -- convert the UTF-32BE file into each other encoding + forM_ encodings $ \(enc,name) -> do + when (name /= "utf32be") $ do + hin <- openFile (file <.> "utf32be") ReadMode + hSetEncoding hin utf32be + hout <- openFile (file <.> name) WriteMode + hSetEncoding hout enc + hGetContents hin >>= hPutStr hout + hClose hin + hClose hout + + forM_ [ (from,to) | from <- encodings, to <- encodings, snd from /= snd to ] + $ \((fromenc,fromname),(toenc,toname)) -> do + hin <- openFile (file <.> fromname) ReadMode + hSetEncoding hin fromenc + hout <- openFile (file <.> toname <.> fromname) WriteMode + hSetEncoding hout toenc + hGetContents hin >>= hPutStr hout + hClose hin + hClose hout + + h1 <- openBinaryFile (file <.> toname) ReadMode + h2 <- openBinaryFile (file <.> toname <.> fromname) ReadMode + str1 <- hGetContents h1 + str2 <- hGetContents h2 + when (str1 /= str2) $ do + putStrLn (file <.> toname ++ " and " ++ file <.> toname <.> fromname ++ " differ") + exitWith (ExitFailure 1) + hClose h1 + hClose h2 diff --git a/testsuite/tests/lib/IO/encoding002.hs b/testsuite/tests/lib/IO/encoding002.hs new file mode 100644 index 0000000000..65d60a3993 --- /dev/null +++ b/testsuite/tests/lib/IO/encoding002.hs @@ -0,0 +1,67 @@ +import Control.Monad + +import System.IO +import Control.Exception + +import Foreign.Marshal.Array +import Foreign.Ptr + +import GHC.Foreign +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)) + +encode :: TextEncoding -> String -> IO [Word8] +encode enc cs = withCStringLen enc cs (\(p, sz) -> peekArray sz (castPtr p)) `catch` \e -> return (const [] (e :: IOException)) + +asc :: Char -> Word8 +asc = fromIntegral . ord + +families = [ ([asc 'H', asc 'i', 0xED, 0xB2, 0x80, asc '!'], + ["UTF-8", "UTF-8//IGNORE", "UTF-8//TRANSLIT", "UTF-8//ROUNDTRIP"]) + , ([asc 'H', 0, asc 'i', 0, 0xFF, 0xDF, 0xFF, 0xDF, asc '!', 0], + ["UTF-16LE", "UTF-16LE//IGNORE", "UTF-16LE//TRANSLIT", "UTF-16LE//ROUNDTRIP"]) + , ([0, asc 'H', 0, asc 'i', 0xDF, 0xFF, 0xDF, 0xFF, 0, asc '!'], + ["UTF-16BE", "UTF-16BE//IGNORE", "UTF-16BE//TRANSLIT", "UTF-16BE//ROUNDTRIP"]) + , ([asc 'H', 0, 0, 0, asc 'i', 0, 0, 0, 0xED, 0xB2, 0x80, 0, asc '!', 0, 0, 0], + ["UTF-32LE", "UTF-32LE//IGNORE", "UTF-32LE//TRANSLIT", "UTF-32LE//ROUNDTRIP"]) + , ([0, 0, 0, asc 'H', 0, 0, 0, asc 'i', 0, 0x80, 0xB2, 0xED, 0, 0, 0, asc '!'], + ["UTF-32BE", "UTF-32BE//IGNORE", "UTF-32BE//TRANSLIT", "UTF-32BE//ROUNDTRIP"]) + ] + +main = do + surrogate_enc <- mkTextEncoding "UTF-8//ROUNDTRIP" + + -- Test that invalid input is correctly roundtripped as surrogates + -- This only works for the UTF-8 UTF since it is the only UTF which + -- is an ASCII superset. + putStrLn $ "== UTF-8: roundtripping" + let invalid_bytes = [asc 'H', asc 'i', 0xED, 0xB2, 0x80, asc '!'] + surrogates <- decode surrogate_enc invalid_bytes + invalid_bytes' <- encode surrogate_enc surrogates + print invalid_bytes + print surrogates + print invalid_bytes' + print (invalid_bytes == invalid_bytes') + putStrLn "" + + forM families $ \(invalid_bytes, enc_names) -> do + encs <- mapM mkTextEncoding enc_names + let name = head enc_names + + -- How we deal with decoding errors in the various modes: + putStrLn $ "== " ++ name ++ ": decoding" + forM encs $ \enc -> decode enc invalid_bytes >>= print + + -- How about encoding errors, particularly those from embedded surrogates? + putStrLn $ "== " ++ name ++ ": encoding" + forM encs $ \enc -> encode enc "Hi\xDC80!" >>= print + + putStrLn "" diff --git a/testsuite/tests/lib/IO/encoding002.stdout b/testsuite/tests/lib/IO/encoding002.stdout new file mode 100644 index 0000000000..70addd37f5 --- /dev/null +++ b/testsuite/tests/lib/IO/encoding002.stdout @@ -0,0 +1,61 @@ +== UTF-8: roundtripping +[72,105,237,178,128,33] +"Hi\61421\61362\61312!" +[72,105,237,178,128,33] +True + +== UTF-8: decoding +"recoverDecode: invalid argument (invalid byte sequence)" +"Hi!" +"Hi\65533\65533\65533!" +"Hi\61421\61362\61312!" +== UTF-8: encoding +[] +[72,105,33] +[72,105,63,33] +[72,105,128,33] + +== UTF-16LE: decoding +"recoverDecode: invalid argument (invalid byte sequence)" +"Hi\65503\8671" +"Hi\65533\65503\8671\65533" +"Hi\61439\65503\8671\NUL" +== UTF-16LE: encoding +[] +[72,0,105,0,33,0] +[72,0,105,0,63,0,33,0] +[72,0,105,0,128,33,0] + +== UTF-16BE: decoding +"recoverDecode: invalid argument (invalid byte sequence)" +"Hi\65503\65280" +"Hi\65533\65503\65280\65533" +"Hi\61407\65503\65280!" +== UTF-16BE: encoding +[] +[0,72,0,105,0,33] +[0,72,0,105,0,63,0,33] +[0,72,0,105,128,0,33] + +== UTF-32LE: decoding +"recoverDecode: invalid argument (invalid byte sequence)" +"Hi\8448" +"Hi\65533\65533\65533\8448\65533" +"Hi\61421\61362\61312\8448\NUL" +== UTF-32LE: encoding +[] +[72,0,0,0,105,0,0,0,33,0,0,0] +[72,0,0,0,105,0,0,0,63,0,0,0,33,0,0,0] +[72,0,0,0,105,0,0,0,128,33,0,0,0] + +== UTF-32BE: decoding +"recoverDecode: invalid argument (invalid byte sequence)" +"Hi!" +"Hi\65533\65533\65533\65533!" +"Hi\NUL\61312\61362\61421!" +== UTF-32BE: encoding +[] +[0,0,0,72,0,0,0,105,0,0,0,33] +[0,0,0,72,0,0,0,105,0,0,0,63,0,0,0,33] +[0,0,0,72,0,0,0,105,128,0,0,0,33] + diff --git a/testsuite/tests/lib/IO/encodingerror001.hs b/testsuite/tests/lib/IO/encodingerror001.hs new file mode 100644 index 0000000000..327b490adb --- /dev/null +++ b/testsuite/tests/lib/IO/encodingerror001.hs @@ -0,0 +1,27 @@ +import System.IO +import System.IO.Error +import Text.Printf +import Control.Monad + +main = do + hSetEncoding stdout latin1 + forM [NoBuffering, + LineBuffering, + BlockBuffering Nothing, + BlockBuffering (Just 3), + BlockBuffering (Just 9), + BlockBuffering (Just 32)] $ \b -> do + hSetBuffering stdout b + checkedPutStr "test 1\n" + checkedPutStr "ě\n" -- nothing gets written + checkedPutStr "test 2\n" + checkedPutStr "Hέllo\n" -- we should write at least the 'H' + checkedPutStr "test 3\n" + checkedPutStr "Hello αβγ\n" -- we should write at least the "Hello " + +checkedPutStr str = do + r <- try $ putStr str + case r of + Right _ -> return () + Left e -> printf "Caught %s while trying to write %s\n" + (show e) (show str) diff --git a/testsuite/tests/lib/IO/encodingerror001.stdout b/testsuite/tests/lib/IO/encodingerror001.stdout new file mode 100644 index 0000000000..7406cd9168 --- /dev/null +++ b/testsuite/tests/lib/IO/encodingerror001.stdout @@ -0,0 +1,36 @@ +test 1 +Caught <stdout>: hPutChar: invalid argument (invalid character) while trying to write "\283\n" +test 2 +HCaught <stdout>: hPutChar: invalid argument (invalid character) while trying to write "H\941llo\n" +test 3 +Hello Caught <stdout>: hPutChar: invalid argument (invalid character) while trying to write "Hello \945\946\947\n" +test 1 +Caught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "\283\n" +test 2 +HCaught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "H\941llo\n" +test 3 +Hello Caught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "Hello \945\946\947\n" +test 1 +Caught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "\283\n" +test 2 +HCaught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "H\941llo\n" +test 3 +Hello Caught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "Hello \945\946\947\n" +test 1 +Caught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "\283\n" +test 2 +HCaught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "H\941llo\n" +test 3 +Hello Caught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "Hello \945\946\947\n" +test 1 +Caught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "\283\n" +test 2 +HCaught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "H\941llo\n" +test 3 +Hello Caught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "Hello \945\946\947\n" +test 1 +Caught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "\283\n" +test 2 +HCaught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "H\941llo\n" +test 3 +Hello Caught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "Hello \945\946\947\n" diff --git a/testsuite/tests/lib/IO/environment001.hs b/testsuite/tests/lib/IO/environment001.hs new file mode 100644 index 0000000000..11d7912cdd --- /dev/null +++ b/testsuite/tests/lib/IO/environment001.hs @@ -0,0 +1,16 @@ +import System.Environment + +main = do + var0 <- getEnv "GHC_TEST" + putStrLn var0 + -- The length proves that we actually decoded it properly, not just read it + -- in as latin1 or something (#3308, #3307) + putStrLn ("Test 1: " ++ show (length var0)) + + [arg0] <- getArgs + putStrLn arg0 + putStrLn ("Test 2: " ++ show (length arg0)) + + [arg1] <- withArgs ["你好!"] getArgs + putStrLn arg1 + putStrLn ("Test 3: " ++ show (length arg1)) diff --git a/testsuite/tests/lib/IO/environment001.stdout b/testsuite/tests/lib/IO/environment001.stdout new file mode 100644 index 0000000000..2434d0c14d --- /dev/null +++ b/testsuite/tests/lib/IO/environment001.stdout @@ -0,0 +1,6 @@ +马克斯 +Test 1: 3 +说 +Test 2: 1 +你好! +Test 3: 3 diff --git a/testsuite/tests/lib/IO/finalization001.hs b/testsuite/tests/lib/IO/finalization001.hs new file mode 100644 index 0000000000..2bf6353453 --- /dev/null +++ b/testsuite/tests/lib/IO/finalization001.hs @@ -0,0 +1,26 @@ +--- !!! 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 System.IO + +doTest :: IO () +doTest = do + sd <- openFile "finalization001.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 200 (repeat doTest)) diff --git a/testsuite/tests/lib/IO/finalization001.stdout b/testsuite/tests/lib/IO/finalization001.stdout new file mode 100644 index 0000000000..ec04732f97 --- /dev/null +++ b/testsuite/tests/lib/IO/finalization001.stdout @@ -0,0 +1,200 @@ +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 +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 +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 +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 diff --git a/testsuite/tests/lib/IO/hClose001.hs b/testsuite/tests/lib/IO/hClose001.hs new file mode 100644 index 0000000000..8d31447e95 --- /dev/null +++ b/testsuite/tests/lib/IO/hClose001.hs @@ -0,0 +1,8 @@ +import System.IO +import System.IO.Error + +main = do + h <- openFile "hClose001.tmp" WriteMode + hPutStr h "junk" + hClose h + hPutStr h "junk" `catchIOError` \ err -> if isIllegalOperation err then putStr "Okay\n" else error "Not okay\n" diff --git a/testsuite/tests/lib/IO/hClose001.stdout b/testsuite/tests/lib/IO/hClose001.stdout new file mode 100644 index 0000000000..1ddd42bbe7 --- /dev/null +++ b/testsuite/tests/lib/IO/hClose001.stdout @@ -0,0 +1 @@ +Okay diff --git a/testsuite/tests/lib/IO/hClose002.hs b/testsuite/tests/lib/IO/hClose002.hs new file mode 100644 index 0000000000..ebf26b4663 --- /dev/null +++ b/testsuite/tests/lib/IO/hClose002.hs @@ -0,0 +1,32 @@ +import System.IO +import Control.Exception + +import qualified GHC.IO.Device as IODevice +import GHC.IO.Handle +import GHC.IO.Handle.Internals +import GHC.IO.Handle.Types +import System.Posix.Internals + +main = do + h <- openFile "hClose002.tmp" WriteMode + -- close the FD without telling the IO library: + naughtyClose h + -- first hClose will raise an exception, but close the + -- Handle anyway: + showPossibleException (hClose h) + -- second hClose should success (Handle is already closed) + showPossibleException (hClose h) + -- this should succeed (checking that the lock on the file has + -- been released: + h <- openFile "hClose002.tmp" ReadMode + showPossibleException (hClose h) + showPossibleException (hClose h) + +showPossibleException :: IO () -> IO () +showPossibleException f = do e <- try f + print (e :: Either SomeException ()) + +naughtyClose h = + withHandle_ "naughtyClose" h $ \ Handle__{haDevice=dev} -> do + IODevice.close dev + diff --git a/testsuite/tests/lib/IO/hClose002.stdout b/testsuite/tests/lib/IO/hClose002.stdout new file mode 100644 index 0000000000..f26be4ab07 --- /dev/null +++ b/testsuite/tests/lib/IO/hClose002.stdout @@ -0,0 +1,4 @@ +Left hClose002.tmp: hClose: invalid argument (Bad file descriptor) +Right () +Right () +Right () diff --git a/testsuite/tests/lib/IO/hClose002.stdout-i386-unknown-solaris2 b/testsuite/tests/lib/IO/hClose002.stdout-i386-unknown-solaris2 new file mode 100644 index 0000000000..39a24de031 --- /dev/null +++ b/testsuite/tests/lib/IO/hClose002.stdout-i386-unknown-solaris2 @@ -0,0 +1,4 @@ +Left hClose002.tmp: hClose: invalid argument (Bad file number) +Right () +Right () +Right () diff --git a/testsuite/tests/lib/IO/hClose003.hs b/testsuite/tests/lib/IO/hClose003.hs new file mode 100644 index 0000000000..cbaf49d6db --- /dev/null +++ b/testsuite/tests/lib/IO/hClose003.hs @@ -0,0 +1,42 @@ +-- Test for #3128, file descriptor leak when hClose fails + +import System.IO +import Control.Exception +import Data.Char + +import System.Posix +import qualified GHC.IO.Device as IODevice +import GHC.IO.Handle +import GHC.IO.Handle.Internals +import GHC.IO.Handle.Types +import System.Posix.Internals + +main = do + (read,write) <- createPipe + hread <- fdToHandle read + hwrite <- fdToHandle write + + -- close the FD without telling the IO library: + showPossibleException (hClose hread) + hIsOpen hread >>= print + + -- put some data in the Handle's write buffer: + hPutStr hwrite "testing" + -- now try to close the Handle: + showPossibleException (hClose hwrite) + hIsOpen hwrite >>= print + +showPossibleException :: IO () -> IO () +showPossibleException f = do + e <- try f + putStrLn (sanitise (show (e :: Either SomeException ()))) + where + -- we don't care which file descriptor it is + sanitise [] = [] + sanitise (x:xs) = if isDigit x then ('X':(sanitise' xs)) else (x:(sanitise xs)) + sanitise' [] = [] + sanitise' (x:xs) = if isDigit x then (sanitise' xs) else (x:(sanitise xs)) + +naughtyClose h = + withHandle_ "naughtyClose" h $ \ Handle__{haDevice=dev} -> do + IODevice.close dev diff --git a/testsuite/tests/lib/IO/hClose003.stdout b/testsuite/tests/lib/IO/hClose003.stdout new file mode 100644 index 0000000000..d12f84d7d7 --- /dev/null +++ b/testsuite/tests/lib/IO/hClose003.stdout @@ -0,0 +1,4 @@ +Right () +False +Left <file descriptor: X>: hClose: resource vanished (Broken pipe) +False diff --git a/testsuite/tests/lib/IO/hDuplicateTo001.hs b/testsuite/tests/lib/IO/hDuplicateTo001.hs new file mode 100644 index 0000000000..5a1484a012 --- /dev/null +++ b/testsuite/tests/lib/IO/hDuplicateTo001.hs @@ -0,0 +1,24 @@ +import GHC.Handle +import GHC.IOBase +import System.IO +import Control.Concurrent.MVar +import Data.Typeable +import qualified GHC.IO.FD as FD + +main = do + h <- openFile "tmp" WriteMode + hDuplicateTo h stdout + + fdh <- getfd h + fdstdout <- getfd stdout + hPutStrLn stderr ("h: " ++ show (fdh /= fdstdout) ++ "\nstdout: " ++ show fdstdout) + + hClose h + putStrLn "bla" + + +getfd h@(FileHandle _ mvar) = do + withMVar mvar $ \h__@Handle__{haDevice=dev} -> + case cast dev of + Just fd -> return (FD.fdFD fd) + Nothing -> error "getfd" diff --git a/testsuite/tests/lib/IO/hDuplicateTo001.stderr b/testsuite/tests/lib/IO/hDuplicateTo001.stderr new file mode 100644 index 0000000000..14a31438a6 --- /dev/null +++ b/testsuite/tests/lib/IO/hDuplicateTo001.stderr @@ -0,0 +1,2 @@ +h: True +stdout: 1 diff --git a/testsuite/tests/lib/IO/hFileSize001.hs b/testsuite/tests/lib/IO/hFileSize001.hs new file mode 100644 index 0000000000..62b3e88b9c --- /dev/null +++ b/testsuite/tests/lib/IO/hFileSize001.hs @@ -0,0 +1,8 @@ +import System.IO + +-- !!! test hFileSize + +main = do + h <- openFile "hFileSize001.hs" ReadMode + sz <- hFileSize h + print sz diff --git a/testsuite/tests/lib/IO/hFileSize001.stdout b/testsuite/tests/lib/IO/hFileSize001.stdout new file mode 100644 index 0000000000..94361d49fd --- /dev/null +++ b/testsuite/tests/lib/IO/hFileSize001.stdout @@ -0,0 +1 @@ +132 diff --git a/testsuite/tests/lib/IO/hFileSize001.stdout-mingw b/testsuite/tests/lib/IO/hFileSize001.stdout-mingw new file mode 100644 index 0000000000..6a4573e805 --- /dev/null +++ b/testsuite/tests/lib/IO/hFileSize001.stdout-mingw @@ -0,0 +1 @@ +133 diff --git a/testsuite/tests/lib/IO/hFileSize002.hs b/testsuite/tests/lib/IO/hFileSize002.hs new file mode 100644 index 0000000000..6c1ad2f57a --- /dev/null +++ b/testsuite/tests/lib/IO/hFileSize002.hs @@ -0,0 +1,35 @@ +-- !!! Testing IO.hFileSize +module Main(main) where + +import Control.Monad +import System.Directory ( removeFile, doesFileExist ) +import System.IO + +main = do + sz <- hFileSize stdin `catch` (\ _ -> return (-1)) + print sz + let fn = "hFileSize002.out" + f <- doesFileExist fn + when f (removeFile fn) + hdl <- openFile fn WriteMode + hPutStr hdl "file_size" + -- with default buffering + sz <- hFileSize hdl + print sz + + hSetBuffering hdl NoBuffering + hPutStr hdl "file_size" + -- with no buffering + sz <- hFileSize hdl + print sz + hSetBuffering hdl LineBuffering + hPutStr hdl "file_size" + -- with line buffering + sz <- hFileSize hdl + print sz + hSetBuffering hdl (BlockBuffering (Just 4)) + -- with block buffering + hPutStr hdl "file_size" + sz <- hFileSize hdl + print sz + hClose hdl diff --git a/testsuite/tests/lib/IO/hFileSize002.stdout b/testsuite/tests/lib/IO/hFileSize002.stdout new file mode 100644 index 0000000000..23dd734048 --- /dev/null +++ b/testsuite/tests/lib/IO/hFileSize002.stdout @@ -0,0 +1,5 @@ +-1 +9 +18 +27 +36 diff --git a/testsuite/tests/lib/IO/hFlush001.hs b/testsuite/tests/lib/IO/hFlush001.hs new file mode 100644 index 0000000000..78c7b7eeb3 --- /dev/null +++ b/testsuite/tests/lib/IO/hFlush001.hs @@ -0,0 +1,31 @@ +-- !!! Flushing +module Main(main) where + +import Control.Monad +import System.Directory ( removeFile, doesFileExist ) +import System.IO + +main = do + hFlush stdin `catch` \ _ -> 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" + hClose hdl + remove + hdl <- openFile "hFlush001.out" WriteMode + hFlush hdl + hClose hdl + remove + hdl <- openFile "hFlush001.out" AppendMode + hFlush hdl + hClose hdl + remove + hdl <- openFile "hFlush001.out" ReadWriteMode + hFlush hdl + hClose hdl + where remove = do + f <- doesFileExist "hFlush001.out" + when f (removeFile "hFlush001.out") diff --git a/testsuite/tests/lib/IO/hFlush001.stdout b/testsuite/tests/lib/IO/hFlush001.stdout new file mode 100644 index 0000000000..0954a7a0b4 --- /dev/null +++ b/testsuite/tests/lib/IO/hFlush001.stdout @@ -0,0 +1,2 @@ +No can do - flushing read-only handles isn't legal +Hello,Hello - No can do - flushing read-only handles isn't legal diff --git a/testsuite/tests/lib/IO/hGetBuf001.hs b/testsuite/tests/lib/IO/hGetBuf001.hs new file mode 100644 index 0000000000..eea599ea74 --- /dev/null +++ b/testsuite/tests/lib/IO/hGetBuf001.hs @@ -0,0 +1,218 @@ +-- !!! Testing hGetBuf(NonBlocking), hPutBuf(NonBlocking) + +import System.Posix +import System.IO +import Control.Concurrent +import Foreign +import Foreign.C +import System.Exit +import Control.Exception +import Control.Monad + + +main = do + -- test should run quickly, but arrange to kill it if it hangs for any reason: + main_t <- myThreadId + forkIO $ do + threadDelay 10000000 + throwTo main_t (ErrorCall "killed") + + zipWithM_ ($) + [ f rbuf wbuf + | f <- [hGetBufTest, hGetBufNBTest, hGetBufSomeTest], + rbuf <- [buf1,buf2,buf3], + wbuf <- [buf1,buf2,buf3] + ] + [1..] + +msg = "hello!" +msg_length = length msg + +buf1 = NoBuffering +buf2 = BlockBuffering (Just 5) +buf3 = BlockBuffering (Just 10) + +-- chosen to be larger than buf2 & smaller than buf3, so that we exercise +-- all code paths: +read_size = 8 :: Int + +-- ---------------------------------------------------------------------------- + +-- hGetBuf/hPutBuf: +-- - test that it always reads all the data that is available +-- (with buffer size <, =, > message size). +-- - test that at the EOF, it returns a short read. +-- - the writing end is using hPutBuf, with various buffer sizes, and +-- doing an hFlush at the end of each write. + +hGetBufTest rbuf wbuf n = do + (read,write) <- createPipe + hread <- fdToHandle read + hwrite <- fdToHandle write + m1 <- newEmptyMVar + m2 <- newEmptyMVar + finished <- newEmptyMVar + hSetBuffering hread rbuf + hSetBuffering hwrite wbuf + forkIO (readProc m1 m2 finished hread) + writeProc m1 m2 hwrite + takeMVar finished + putStrLn ("test " ++ show n ++ " OK") + + +readProc :: MVar () -> MVar () -> MVar () -> Handle -> IO () +readProc m1 m2 finished h = do + buf <- mallocBytes 20 + let + loop 0 = return () + loop n = do putMVar m2 (); takeMVar m1 + r <- hGetBuf h buf msg_length + if (r /= msg_length) + then do hPutStr stderr ("error: " ++ show r) + exitFailure + else do s <- peekCStringLen (buf,r) + hPutStr stdout (show n ++ " ") + loop (n-1) + loop 100 + hPutStr stdout "\n" + putMVar m2 (); takeMVar m1 + r <- hGetBuf h buf read_size -- EOF, should get short read + s <- peekCStringLen (buf,r) + putStrLn ("got " ++ show r ++ ": " ++ s) + r <- hGetBuf h buf read_size -- EOF, should get zero-length read + s <- peekCStringLen (buf,r) + putStrLn ("got " ++ show r ++ ": " ++ s) + hClose h + putMVar finished () + +writeProc :: MVar () -> MVar () -> Handle -> IO () +writeProc m1 m2 h = do + let + loop 0 = return () + loop n = + withCStringLen msg $ \ (s,len) -> do + takeMVar m2 + hPutBuf h s len + hFlush h + putMVar m1 () + loop (n-1) + + loop 100 + takeMVar m2 + withCString "end" $ \s -> do + hPutBuf h s 3 + putMVar m1 () + hClose h + +-- ----------------------------------------------------------------------------- +-- hGetBufNonBlocking: + +hGetBufNBTest rbuf wbuf n = do + (read,write) <- createPipe + hread <- fdToHandle read + hwrite <- fdToHandle write + m1 <- newEmptyMVar + m2 <- newEmptyMVar + finished <- newEmptyMVar + hSetBuffering hread rbuf + hSetBuffering hwrite wbuf + forkIO (readProcNB m1 m2 finished hread) + writeProcNB m1 m2 hwrite + takeMVar finished + putStrLn ("test " ++ show n ++ " OK") + + +readProcNB :: MVar () -> MVar () -> MVar () -> Handle -> IO () +readProcNB m1 m2 finished h = do + buf <- mallocBytes 20 + + -- first, test that we can do a non-blocking read: + r <- hGetBufNonBlocking h buf read_size + s <- peekCStringLen (buf,r) + putStrLn ("got " ++ show r ++ ": " ++ s) + + let + loop 0 = return () + loop n = do putMVar m2 (); takeMVar m1 + r <- hGetBufNonBlocking h buf read_size + if (r /= msg_length) + then do hPutStr stderr ("error: " ++ show r) + exitFailure + else do s <- peekCStringLen (buf,r) + hPutStr stdout (show n ++ " ") + loop (n-1) + loop 100 + hPutStr stdout "\n" + putMVar m2 (); takeMVar m1 + r <- hGetBufNonBlocking h buf read_size -- EOF, should get short read + s <- peekCStringLen (buf,r) + putStrLn ("got " ++ show r ++ ": " ++ s) + r <- hGetBufNonBlocking h buf read_size -- EOF, should get zero-length read + s <- peekCStringLen (buf,r) + putStrLn ("got " ++ show r ++ ": " ++ s) + hClose h + putMVar finished () + +writeProcNB :: MVar () -> MVar () -> Handle -> IO () +writeProcNB m1 m2 h = do + let + loop 0 = return () + loop n = + withCStringLen msg $ \ (s,len) -> do + takeMVar m2 + hPutBufNonBlocking h s len + hFlush h + putMVar m1 () + loop (n-1) + + loop 100 + takeMVar m2 + withCString "end" $ \s -> do + hPutBuf h s 3 + hFlush h + putMVar m1 () + hClose h + +-- ----------------------------------------------------------------------------- +-- hGetBufSome: + +hGetBufSomeTest rbuf wbuf n = do + (read,write) <- createPipe + hread <- fdToHandle read + hwrite <- fdToHandle write + m1 <- newEmptyMVar + m2 <- newEmptyMVar + finished <- newEmptyMVar + hSetBuffering hread rbuf + hSetBuffering hwrite wbuf + forkIO (readProcSome m1 m2 finished hread) + writeProcNB m1 m2 hwrite + takeMVar finished + putStrLn ("test " ++ show n ++ " OK") + + +readProcSome :: MVar () -> MVar () -> MVar () -> Handle -> IO () +readProcSome m1 m2 finished h = do + buf <- mallocBytes 20 + + let + loop 0 = return () + loop n = do putMVar m2 (); takeMVar m1 + r <- hGetBufSome h buf read_size + if (r /= msg_length) + then do hPutStr stderr ("error: " ++ show r) + exitFailure + else do s <- peekCStringLen (buf,r) + hPutStr stdout (show n ++ " ") + loop (n-1) + loop 100 + hPutStr stdout "\n" + putMVar m2 (); takeMVar m1 + r <- hGetBufSome h buf read_size -- EOF, should get short read + s <- peekCStringLen (buf,r) + putStrLn ("got " ++ show r ++ ": " ++ s) + r <- hGetBufSome h buf read_size -- EOF, should get zero-length read + s <- peekCStringLen (buf,r) + putStrLn ("got " ++ show r ++ ": " ++ s) + hClose h + putMVar finished () diff --git a/testsuite/tests/lib/IO/hGetBuf001.stdout b/testsuite/tests/lib/IO/hGetBuf001.stdout new file mode 100644 index 0000000000..694ff4eedf --- /dev/null +++ b/testsuite/tests/lib/IO/hGetBuf001.stdout @@ -0,0 +1,117 @@ +100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 +got 3: end +got 0: +test 1 OK +100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 +got 3: end +got 0: +test 2 OK +100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 +got 3: end +got 0: +test 3 OK +100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 +got 3: end +got 0: +test 4 OK +100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 +got 3: end +got 0: +test 5 OK +100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 +got 3: end +got 0: +test 6 OK +100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 +got 3: end +got 0: +test 7 OK +100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 +got 3: end +got 0: +test 8 OK +100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 +got 3: end +got 0: +test 9 OK +got 0: +100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 +got 3: end +got 0: +test 10 OK +got 0: +100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 +got 3: end +got 0: +test 11 OK +got 0: +100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 +got 3: end +got 0: +test 12 OK +got 0: +100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 +got 3: end +got 0: +test 13 OK +got 0: +100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 +got 3: end +got 0: +test 14 OK +got 0: +100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 +got 3: end +got 0: +test 15 OK +got 0: +100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 +got 3: end +got 0: +test 16 OK +got 0: +100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 +got 3: end +got 0: +test 17 OK +got 0: +100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 +got 3: end +got 0: +test 18 OK +100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 +got 3: end +got 0: +test 19 OK +100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 +got 3: end +got 0: +test 20 OK +100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 +got 3: end +got 0: +test 21 OK +100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 +got 3: end +got 0: +test 22 OK +100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 +got 3: end +got 0: +test 23 OK +100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 +got 3: end +got 0: +test 24 OK +100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 +got 3: end +got 0: +test 25 OK +100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 +got 3: end +got 0: +test 26 OK +100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 +got 3: end +got 0: +test 27 OK diff --git a/testsuite/tests/lib/IO/hGetBuffering001.hs b/testsuite/tests/lib/IO/hGetBuffering001.hs new file mode 100644 index 0000000000..83188b2796 --- /dev/null +++ b/testsuite/tests/lib/IO/hGetBuffering001.hs @@ -0,0 +1,21 @@ +import System.IO + +main = + sequence (map hIsOpen [stdin, stdout, stderr]) >>= \ opens -> + print opens >> + sequence (map hIsClosed [stdin, stdout, stderr]) >>= \ closeds -> + print closeds >> + sequence (map hIsReadable [stdin, stdout, stderr]) >>= \ readables -> + print readables >> + sequence (map hIsWritable [stdin, stdout, stderr]) >>= \ writables -> + print writables >> + sequence (map hIsBlockBuffered [stdin, stdout, stderr]) >>= \ buffereds -> + print buffereds >> + sequence (map hIsLineBuffered [stdin, stdout, stderr]) >>= \ buffereds -> + print buffereds >> + sequence (map hIsNotBuffered [stdin, stdout, stderr]) >>= \ buffereds -> + print buffereds + where + hIsBlockBuffered h = hGetBuffering h >>= \ b -> return $ case b of { BlockBuffering _ -> True; _ -> False } + hIsLineBuffered h = hGetBuffering h >>= \ b -> return $ case b of { LineBuffering -> True; _ -> False } + hIsNotBuffered h = hGetBuffering h >>= \ b -> return $ case b of { NoBuffering -> True; _ -> False } diff --git a/testsuite/tests/lib/IO/hGetBuffering001.stdout b/testsuite/tests/lib/IO/hGetBuffering001.stdout new file mode 100644 index 0000000000..75b9a133d9 --- /dev/null +++ b/testsuite/tests/lib/IO/hGetBuffering001.stdout @@ -0,0 +1,7 @@ +[True,True,True] +[False,False,False] +[True,False,False] +[False,True,True] +[True,True,False] +[False,False,False] +[False,False,True] diff --git a/testsuite/tests/lib/IO/hGetChar001.hs b/testsuite/tests/lib/IO/hGetChar001.hs new file mode 100644 index 0000000000..f5ca666828 --- /dev/null +++ b/testsuite/tests/lib/IO/hGetChar001.hs @@ -0,0 +1,18 @@ +import System.IO + +main = do + hSetBuffering stdout NoBuffering + putStr "Enter an integer: " + x1 <- readLine + putStr "Enter another integer: " + x2 <- readLine + putStr ("Their sum is " ++ show (read x1 + read x2 :: Int) ++ "\n") + + where readLine = do + eof <- isEOF + if eof then return [] else do + c <- getChar + if c `elem` ['\n','\r'] + then return [] + else do cs <- readLine + return (c:cs) diff --git a/testsuite/tests/lib/IO/hGetChar001.stdin b/testsuite/tests/lib/IO/hGetChar001.stdin new file mode 100644 index 0000000000..2510fcaec3 --- /dev/null +++ b/testsuite/tests/lib/IO/hGetChar001.stdin @@ -0,0 +1,2 @@ +42 +-7 diff --git a/testsuite/tests/lib/IO/hGetChar001.stdout b/testsuite/tests/lib/IO/hGetChar001.stdout new file mode 100644 index 0000000000..47d4185c64 --- /dev/null +++ b/testsuite/tests/lib/IO/hGetChar001.stdout @@ -0,0 +1 @@ +Enter an integer: Enter another integer: Their sum is 35 diff --git a/testsuite/tests/lib/IO/hGetLine001.hs b/testsuite/tests/lib/IO/hGetLine001.hs new file mode 100644 index 0000000000..b5950623ea --- /dev/null +++ b/testsuite/tests/lib/IO/hGetLine001.hs @@ -0,0 +1,25 @@ +-- !!! testing hGetLine + +import System.IO + +-- one version of 'cat' +main = do + let loop h = do b <- hIsEOF h + if b then return () + else do l <- hGetLine h; putStrLn l; loop h + loop stdin + + h <- openFile "hGetLine001.hs" ReadMode + + hSetBinaryMode stdout True + + hSetBuffering h NoBuffering + loop h + + hSeek h AbsoluteSeek 0 + hSetBuffering h LineBuffering + loop h + + hSeek h AbsoluteSeek 0 + hSetBuffering h (BlockBuffering (Just 83)) + loop h diff --git a/testsuite/tests/lib/IO/hGetLine001.stdout b/testsuite/tests/lib/IO/hGetLine001.stdout new file mode 100644 index 0000000000..3e023db8f5 --- /dev/null +++ b/testsuite/tests/lib/IO/hGetLine001.stdout @@ -0,0 +1,100 @@ +-- !!! testing hGetLine
+
+import System.IO
+
+-- one version of 'cat'
+main = do
+ let loop h = do b <- hIsEOF h
+ if b then return ()
+ else do l <- hGetLine h; putStrLn l; loop h
+ loop stdin
+
+ h <- openFile "hGetLine001.hs" ReadMode
+
+ hSetBinaryMode stdout True
+
+ hSetBuffering h NoBuffering
+ loop h
+
+ hSeek h AbsoluteSeek 0
+ hSetBuffering h LineBuffering
+ loop h
+
+ hSeek h AbsoluteSeek 0
+ hSetBuffering h (BlockBuffering (Just 83))
+ loop h
+-- !!! testing hGetLine
+
+import System.IO
+
+-- one version of 'cat'
+main = do
+ let loop h = do b <- hIsEOF h
+ if b then return ()
+ else do l <- hGetLine h; putStrLn l; loop h
+ loop stdin
+
+ h <- openFile "hGetLine001.hs" ReadMode
+
+ hSetBinaryMode stdout True
+
+ hSetBuffering h NoBuffering
+ loop h
+
+ hSeek h AbsoluteSeek 0
+ hSetBuffering h LineBuffering
+ loop h
+
+ hSeek h AbsoluteSeek 0
+ hSetBuffering h (BlockBuffering (Just 83))
+ loop h
+-- !!! testing hGetLine
+
+import System.IO
+
+-- one version of 'cat'
+main = do
+ let loop h = do b <- hIsEOF h
+ if b then return ()
+ else do l <- hGetLine h; putStrLn l; loop h
+ loop stdin
+
+ h <- openFile "hGetLine001.hs" ReadMode
+
+ hSetBinaryMode stdout True
+
+ hSetBuffering h NoBuffering
+ loop h
+
+ hSeek h AbsoluteSeek 0
+ hSetBuffering h LineBuffering
+ loop h
+
+ hSeek h AbsoluteSeek 0
+ hSetBuffering h (BlockBuffering (Just 83))
+ loop h
+-- !!! testing hGetLine
+
+import System.IO
+
+-- one version of 'cat'
+main = do
+ let loop h = do b <- hIsEOF h
+ if b then return ()
+ else do l <- hGetLine h; putStrLn l; loop h
+ loop stdin
+
+ h <- openFile "hGetLine001.hs" ReadMode
+
+ hSetBinaryMode stdout True
+
+ hSetBuffering h NoBuffering
+ loop h
+
+ hSeek h AbsoluteSeek 0
+ hSetBuffering h LineBuffering
+ loop h
+
+ hSeek h AbsoluteSeek 0
+ hSetBuffering h (BlockBuffering (Just 83))
+ loop h
diff --git a/testsuite/tests/lib/IO/hGetLine002.hs b/testsuite/tests/lib/IO/hGetLine002.hs new file mode 100644 index 0000000000..5c08b716d1 --- /dev/null +++ b/testsuite/tests/lib/IO/hGetLine002.hs @@ -0,0 +1,16 @@ +-- !!! testing hGetLine on a file without a final '\n'. + +-- According to the Haskell 98 report, getLine should discard a line without a +-- closing newline character (see implementation of getLine). +-- +-- However, we don't believe that this is the right behaviour. + +import System.IO + +main = catch loop (\e -> print e) + +loop = do + hSetBuffering stdin LineBuffering + l <- hGetLine stdin + putStrLn l + loop diff --git a/testsuite/tests/lib/IO/hGetLine002.stdin b/testsuite/tests/lib/IO/hGetLine002.stdin new file mode 100644 index 0000000000..808eafd54b --- /dev/null +++ b/testsuite/tests/lib/IO/hGetLine002.stdin @@ -0,0 +1 @@ +this line doesn't end with a newline
\ No newline at end of file diff --git a/testsuite/tests/lib/IO/hGetLine002.stdout b/testsuite/tests/lib/IO/hGetLine002.stdout new file mode 100644 index 0000000000..0ec29ade8f --- /dev/null +++ b/testsuite/tests/lib/IO/hGetLine002.stdout @@ -0,0 +1,2 @@ +this line doesn't end with a newline +<stdin>: hGetLine: end of file diff --git a/testsuite/tests/lib/IO/hGetLine002.stdout-hugs b/testsuite/tests/lib/IO/hGetLine002.stdout-hugs new file mode 100644 index 0000000000..ed871357b7 --- /dev/null +++ b/testsuite/tests/lib/IO/hGetLine002.stdout-hugs @@ -0,0 +1,2 @@ +this line doesn't end with a newline +<stdin>: IO.hGetChar: end of file (end of file) diff --git a/testsuite/tests/lib/IO/hGetLine003.hs b/testsuite/tests/lib/IO/hGetLine003.hs new file mode 100644 index 0000000000..cc03c604aa --- /dev/null +++ b/testsuite/tests/lib/IO/hGetLine003.hs @@ -0,0 +1,9 @@ +import System.IO + +main = f stdin + where f h = do p <- hIsEOF h + if p then putStrLn "done" + else do l <- hGetLine h + putStrLn l + f h + diff --git a/testsuite/tests/lib/IO/hGetLine003.stdin b/testsuite/tests/lib/IO/hGetLine003.stdin new file mode 100644 index 0000000000..b8b74a4b1e --- /dev/null +++ b/testsuite/tests/lib/IO/hGetLine003.stdin @@ -0,0 +1 @@ +this line doesn't end with a newline diff --git a/testsuite/tests/lib/IO/hGetLine003.stdout b/testsuite/tests/lib/IO/hGetLine003.stdout new file mode 100644 index 0000000000..6daac48252 --- /dev/null +++ b/testsuite/tests/lib/IO/hGetLine003.stdout @@ -0,0 +1,2 @@ +this line doesn't end with a newline +done diff --git a/testsuite/tests/lib/IO/hGetPosn001.hs b/testsuite/tests/lib/IO/hGetPosn001.hs new file mode 100644 index 0000000000..5a0d7d4827 --- /dev/null +++ b/testsuite/tests/lib/IO/hGetPosn001.hs @@ -0,0 +1,28 @@ +-- !!! Test file positioning + +module Main(main) where + +import Control.Monad +import System.Directory (removeFile, doesFileExist) +import System.IO +import System.IO.Error + +main = do + hIn <- openFile "hGetPosn001.in" ReadMode + f <- doesFileExist "hGetPosn001.out" + when f (removeFile "hGetPosn001.out") + hOut <- openFile "hGetPosn001.out" ReadWriteMode + bof <- hGetPosn hIn + putStrLn (show bof) -- you can show HandlePosns + copy hIn hOut + hSetPosn bof + copy hIn hOut + hSeek hOut AbsoluteSeek 0 + stuff <- hGetContents hOut + putStr stuff + +copy :: Handle -> Handle -> IO () +copy hIn hOut = + try (hGetChar hIn) >>= + either (\ err -> if isEOFError err then return () else error "copy") + ( \ x -> hPutChar hOut x >> copy hIn hOut) diff --git a/testsuite/tests/lib/IO/hGetPosn001.in b/testsuite/tests/lib/IO/hGetPosn001.in new file mode 100644 index 0000000000..2e2537150f --- /dev/null +++ b/testsuite/tests/lib/IO/hGetPosn001.in @@ -0,0 +1,2 @@ +123456789*123456789*123456789*123456789*123456789*123456789*123456789*12 + 1 2 3 4 5 6 7 diff --git a/testsuite/tests/lib/IO/hGetPosn001.stdout b/testsuite/tests/lib/IO/hGetPosn001.stdout new file mode 100644 index 0000000000..10adafd933 --- /dev/null +++ b/testsuite/tests/lib/IO/hGetPosn001.stdout @@ -0,0 +1,5 @@ +{handle: hGetPosn001.in} at position 0 +123456789*123456789*123456789*123456789*123456789*123456789*123456789*12 + 1 2 3 4 5 6 7 +123456789*123456789*123456789*123456789*123456789*123456789*123456789*12 + 1 2 3 4 5 6 7 diff --git a/testsuite/tests/lib/IO/hGetPosn001.stdout-hugs b/testsuite/tests/lib/IO/hGetPosn001.stdout-hugs new file mode 100644 index 0000000000..56e989c493 --- /dev/null +++ b/testsuite/tests/lib/IO/hGetPosn001.stdout-hugs @@ -0,0 +1,5 @@ +<handle> at position 0 +123456789*123456789*123456789*123456789*123456789*123456789*123456789*12 + 1 2 3 4 5 6 7 +123456789*123456789*123456789*123456789*123456789*123456789*123456789*12 + 1 2 3 4 5 6 7 diff --git a/testsuite/tests/lib/IO/hIsEOF001.hs b/testsuite/tests/lib/IO/hIsEOF001.hs new file mode 100644 index 0000000000..2e5dbdcb0a --- /dev/null +++ b/testsuite/tests/lib/IO/hIsEOF001.hs @@ -0,0 +1,7 @@ +-- !!! hIsEOF (on stdout) + +import System.IO ( hIsEOF, stdout ) + +main = do + flg <- hIsEOF stdout `catch` \ _ -> putStrLn "hIsEOF failed" >> return False + print flg diff --git a/testsuite/tests/lib/IO/hIsEOF001.stdout b/testsuite/tests/lib/IO/hIsEOF001.stdout new file mode 100644 index 0000000000..76460ac50a --- /dev/null +++ b/testsuite/tests/lib/IO/hIsEOF001.stdout @@ -0,0 +1,2 @@ +hIsEOF failed +False diff --git a/testsuite/tests/lib/IO/hIsEOF002.hs b/testsuite/tests/lib/IO/hIsEOF002.hs new file mode 100644 index 0000000000..26f5abd9a7 --- /dev/null +++ b/testsuite/tests/lib/IO/hIsEOF002.hs @@ -0,0 +1,48 @@ +-- !!! test hIsEOF in various buffering situations + +import System.IO + +main = do + h <- openFile "hIsEOF002.hs" ReadMode + hSetBuffering h NoBuffering + hSeek h SeekFromEnd 0 + hIsEOF h >>= print + hSeek h SeekFromEnd (-1) + hIsEOF h >>= print + hGetChar h >>= print + + hSetBuffering h LineBuffering + hSeek h SeekFromEnd 0 + hIsEOF h >>= print + hSeek h SeekFromEnd (-1) + hIsEOF h >>= print + hGetChar h >>= print + + hSetBuffering h (BlockBuffering (Just 1)) + hSeek h SeekFromEnd 0 + hIsEOF h >>= print + hSeek h SeekFromEnd (-1) + hIsEOF h >>= print + hGetChar h >>= print + + hSetBuffering h (BlockBuffering Nothing) + hSeek h SeekFromEnd 0 + hIsEOF h >>= print + hSeek h SeekFromEnd (-1) + hIsEOF h >>= print + hGetChar h >>= print + hClose h + + h <- openFile "hIsEOF002.out" WriteMode + hPutStrLn h "hello, world" + hClose h + + h <- openFile "hIsEOF002.out" ReadWriteMode + hSetBuffering h NoBuffering + hSeek h SeekFromEnd 0 + hIsEOF h >>= print + hPutChar h 'x' + hIsEOF h >>= print + hSeek h SeekFromEnd (-1) + hIsEOF h >>= print + hGetChar h >>= print diff --git a/testsuite/tests/lib/IO/hIsEOF002.stdout b/testsuite/tests/lib/IO/hIsEOF002.stdout new file mode 100644 index 0000000000..3aa5e1a64d --- /dev/null +++ b/testsuite/tests/lib/IO/hIsEOF002.stdout @@ -0,0 +1,16 @@ +True +False +'\n' +True +False +'\n' +True +False +'\n' +True +False +'\n' +True +True +False +'x' diff --git a/testsuite/tests/lib/IO/hReady001.hs b/testsuite/tests/lib/IO/hReady001.hs new file mode 100644 index 0000000000..00888dac2d --- /dev/null +++ b/testsuite/tests/lib/IO/hReady001.hs @@ -0,0 +1,11 @@ +-- !!! hReady test + + -- hReady should throw and EOF exception at the end of a file. Trac #1063. + +import System.IO + +main = do + h <- openFile "hReady001.hs" ReadMode + hReady h >>= print + hSeek h SeekFromEnd 0 + (hReady h >> return ()) `catch` print diff --git a/testsuite/tests/lib/IO/hReady001.stdout b/testsuite/tests/lib/IO/hReady001.stdout new file mode 100644 index 0000000000..af35f80533 --- /dev/null +++ b/testsuite/tests/lib/IO/hReady001.stdout @@ -0,0 +1,2 @@ +True +hReady001.hs: hWaitForInput: end of file diff --git a/testsuite/tests/lib/IO/hReady002.hs b/testsuite/tests/lib/IO/hReady002.hs new file mode 100644 index 0000000000..6db22a13fc --- /dev/null +++ b/testsuite/tests/lib/IO/hReady002.hs @@ -0,0 +1,10 @@ +-- test for bug #4078
+import System.IO
+import Control.Concurrent
+import System.Exit
+
+main = do
+ m <- newEmptyMVar
+ forkIO $ do threadDelay 500000; putMVar m Nothing
+ forkIO $ do hReady stdin >>= putMVar m . Just
+ takeMVar m >>= print
diff --git a/testsuite/tests/lib/IO/hReady002.stdout b/testsuite/tests/lib/IO/hReady002.stdout new file mode 100644 index 0000000000..6217d00e10 --- /dev/null +++ b/testsuite/tests/lib/IO/hReady002.stdout @@ -0,0 +1 @@ +Just False
diff --git a/testsuite/tests/lib/IO/hSeek001.hs b/testsuite/tests/lib/IO/hSeek001.hs new file mode 100644 index 0000000000..d05068e955 --- /dev/null +++ b/testsuite/tests/lib/IO/hSeek001.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE CPP #-} +-- !!! Test seeking + +import System.IO + +main = do + h <- openFile "hSeek001.in" ReadMode + True <- hIsSeekable h + hSeek h SeekFromEnd (-1) + z <- hGetChar h + putStr (z:"\n") + hSeek h SeekFromEnd (-3) + x <- hGetChar h + putStr (x:"\n") + hSeek h RelativeSeek (-2) + w <- hGetChar h + putStr (w:"\n") + hSeek h RelativeSeek 2 + z <- hGetChar h + putStr (z:"\n") + hSeek h AbsoluteSeek (0) + a <- hGetChar h + putStr (a:"\n") + hSeek h AbsoluteSeek (10) + k <- hGetChar h + putStr (k:"\n") + hSeek h AbsoluteSeek (25) + z <- hGetChar h + putStr (z:"\n") + hClose h diff --git a/testsuite/tests/lib/IO/hSeek001.in b/testsuite/tests/lib/IO/hSeek001.in new file mode 100644 index 0000000000..e85d5b4528 --- /dev/null +++ b/testsuite/tests/lib/IO/hSeek001.in @@ -0,0 +1 @@ +abcdefghijklmnopqrstuvwxyz
\ No newline at end of file diff --git a/testsuite/tests/lib/IO/hSeek001.stdout b/testsuite/tests/lib/IO/hSeek001.stdout new file mode 100644 index 0000000000..ab6c1d751b --- /dev/null +++ b/testsuite/tests/lib/IO/hSeek001.stdout @@ -0,0 +1,7 @@ +z +x +w +z +a +k +z diff --git a/testsuite/tests/lib/IO/hSeek002.hs b/testsuite/tests/lib/IO/hSeek002.hs new file mode 100644 index 0000000000..8c9153cfaa --- /dev/null +++ b/testsuite/tests/lib/IO/hSeek002.hs @@ -0,0 +1,25 @@ +-- !!! Testing EOF (and the clearing of it) + +module Main(main) where + +import System.IO +import System.Directory ( removeFile ) + +main :: IO () +main = do + hdl <- openFile "hSeek002.hs" ReadMode + flg <- hIsEOF hdl + print flg + hSeek hdl SeekFromEnd 0 + flg <- hIsEOF hdl + print flg + hSeek hdl SeekFromEnd (-1) + flg <- hIsEOF hdl + print flg + hGetChar hdl + flg <- hIsEOF hdl + print flg + hSeek hdl SeekFromEnd (-1) + flg <- hIsEOF hdl + print flg + hClose hdl diff --git a/testsuite/tests/lib/IO/hSeek002.stdout b/testsuite/tests/lib/IO/hSeek002.stdout new file mode 100644 index 0000000000..8069fe32b0 --- /dev/null +++ b/testsuite/tests/lib/IO/hSeek002.stdout @@ -0,0 +1,5 @@ +False +True +False +True +False diff --git a/testsuite/tests/lib/IO/hSeek003.hs b/testsuite/tests/lib/IO/hSeek003.hs new file mode 100644 index 0000000000..03400573c4 --- /dev/null +++ b/testsuite/tests/lib/IO/hSeek003.hs @@ -0,0 +1,51 @@ +-- !!! file positions (hGetPosn and hSetPosn) + +module Main(main) where + +import System.IO +import Control.Monad ( sequence ) + +testPosns :: Handle -> BufferMode -> IO () +testPosns hdl bmo = do + hSetBuffering hdl bmo + putStrLn ("Testing positioning with buffer mode set to: " ++ show bmo) + testPositioning hdl + +bmo_ls = [NoBuffering, LineBuffering, BlockBuffering Nothing, + BlockBuffering (Just 511),BlockBuffering (Just 3), BlockBuffering (Just 11)] + +main = do + hdl <- openFile "hSeek003.hs" ReadMode + sequence (zipWith testPosns (repeat hdl) bmo_ls) + hClose hdl + +testPositioning hdl = do + hSeek hdl AbsoluteSeek 0 -- go to the beginning of the file again. + ps <- getFilePosns 10 hdl + hSeek hdl AbsoluteSeek 0 + putStr "First ten chars: " + ls <- hGetChars 10 hdl + putStrLn ls + -- go to the end + hSeek hdl SeekFromEnd 0 + ls <- sequence (map (\ p -> hSetPosn p >> hGetChar hdl) ps) + putStr "First ten chars: " + putStrLn ls + + -- position ourselves in the middle. + sz <- hFileSize hdl + hSeek hdl AbsoluteSeek (sz `div` 2) + ls <- sequence (map (\ p -> hSetPosn p >> hGetChar hdl) ps) + putStr "First ten chars: " + putStrLn ls + +hGetChars :: Int -> Handle -> IO String +hGetChars n h = sequence (replicate n (hGetChar h)) + +getFilePosns :: Int -> Handle -> IO [HandlePosn] +getFilePosns 0 h = return [] +getFilePosns x h = do + p <- hGetPosn h + hGetChar h + ps <- getFilePosns (x-1) h + return (p:ps) diff --git a/testsuite/tests/lib/IO/hSeek003.stdout b/testsuite/tests/lib/IO/hSeek003.stdout new file mode 100644 index 0000000000..7c765c5bc5 --- /dev/null +++ b/testsuite/tests/lib/IO/hSeek003.stdout @@ -0,0 +1,24 @@ +Testing positioning with buffer mode set to: NoBuffering +First ten chars: -- !!! fil +First ten chars: -- !!! fil +First ten chars: -- !!! fil +Testing positioning with buffer mode set to: LineBuffering +First ten chars: -- !!! fil +First ten chars: -- !!! fil +First ten chars: -- !!! fil +Testing positioning with buffer mode set to: BlockBuffering Nothing +First ten chars: -- !!! fil +First ten chars: -- !!! fil +First ten chars: -- !!! fil +Testing positioning with buffer mode set to: BlockBuffering (Just 511) +First ten chars: -- !!! fil +First ten chars: -- !!! fil +First ten chars: -- !!! fil +Testing positioning with buffer mode set to: BlockBuffering (Just 3) +First ten chars: -- !!! fil +First ten chars: -- !!! fil +First ten chars: -- !!! fil +Testing positioning with buffer mode set to: BlockBuffering (Just 11) +First ten chars: -- !!! fil +First ten chars: -- !!! fil +First ten chars: -- !!! fil diff --git a/testsuite/tests/lib/IO/hSeek004.hs b/testsuite/tests/lib/IO/hSeek004.hs new file mode 100644 index 0000000000..9ad7c13e7f --- /dev/null +++ b/testsuite/tests/lib/IO/hSeek004.hs @@ -0,0 +1,8 @@ +-- !!! can't seek an AppendMode handle + +import System.IO +import System.IO.Error + +main = do + h <- openFile "hSeek004.out" AppendMode + try (hSeek h AbsoluteSeek 0) >>= print diff --git a/testsuite/tests/lib/IO/hSeek004.stdout b/testsuite/tests/lib/IO/hSeek004.stdout new file mode 100644 index 0000000000..d2671a6361 --- /dev/null +++ b/testsuite/tests/lib/IO/hSeek004.stdout @@ -0,0 +1 @@ +Left hSeek004.out: hSeek: illegal operation (handle is not seekable) diff --git a/testsuite/tests/lib/IO/hSeek004.stdout-mingw b/testsuite/tests/lib/IO/hSeek004.stdout-mingw new file mode 100644 index 0000000000..7d8e7076ee --- /dev/null +++ b/testsuite/tests/lib/IO/hSeek004.stdout-mingw @@ -0,0 +1,5 @@ +Left illegal operation +Action: hSeek +Handle: {loc=hSeek004.out,type=writable (append),binary=True,buffering=block (512)} +Reason: handle is not seekable +File: hSeek004.out diff --git a/testsuite/tests/lib/IO/hSetBuffering002.hs b/testsuite/tests/lib/IO/hSetBuffering002.hs new file mode 100644 index 0000000000..3f553029da --- /dev/null +++ b/testsuite/tests/lib/IO/hSetBuffering002.hs @@ -0,0 +1,6 @@ +import System.IO + +main = + hSetBuffering stdin NoBuffering >> + hSetBuffering stdout NoBuffering >> + interact id diff --git a/testsuite/tests/lib/IO/hSetBuffering002.stdout b/testsuite/tests/lib/IO/hSetBuffering002.stdout new file mode 100644 index 0000000000..3f553029da --- /dev/null +++ b/testsuite/tests/lib/IO/hSetBuffering002.stdout @@ -0,0 +1,6 @@ +import System.IO + +main = + hSetBuffering stdin NoBuffering >> + hSetBuffering stdout NoBuffering >> + interact id diff --git a/testsuite/tests/lib/IO/hSetBuffering003.hs b/testsuite/tests/lib/IO/hSetBuffering003.hs new file mode 100644 index 0000000000..74d399e4ff --- /dev/null +++ b/testsuite/tests/lib/IO/hSetBuffering003.hs @@ -0,0 +1,79 @@ +-- !!! Reconfiguring the buffering of a handle +module Main(main) where + +import System.IO + +queryBuffering :: String -> Handle -> IO () +queryBuffering handle_nm handle = do + bufm <- hGetBuffering handle + putStrLn ("Buffering for " ++ handle_nm ++ " is: " ++ show bufm) + +main = do + queryBuffering "stdin" stdin + queryBuffering "stdout" stdout + queryBuffering "stderr" stderr + + -- twiddling the setting for stdin. + hSetBuffering stdin NoBuffering + queryBuffering "stdin" stdin + hSetBuffering stdin LineBuffering + queryBuffering "stdin" stdin + hSetBuffering stdin (BlockBuffering (Just 2)) + queryBuffering "stdin" stdin + 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) []) + + putChar '\n' + + -- twiddling the buffering for stdout + hPutStr stdout "Hello stdout 1" + hSetBuffering stdout NoBuffering + queryBuffering "stdout" stdout + hPutStr stdout "Hello stdout 2" + hSetBuffering stdout LineBuffering + queryBuffering "stdout" stdout + hPutStr stdout "Hello stdout 3" + hSetBuffering stdout (BlockBuffering (Just 2)) + queryBuffering "stdout" stdout + hPutStr stdout "Hello stdout 4" + hSetBuffering stdout (BlockBuffering Nothing) + 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) []) + + putChar '\n' + + -- twiddling the buffering for stderr + hPutStr stderr "Hello stderr 1" + hSetBuffering stderr NoBuffering + queryBuffering "stderr" stderr + hPutStr stderr "Hello stderr 2" + hSetBuffering stderr LineBuffering + queryBuffering "stderr" stderr + hPutStr stderr "Hello stderr 3" + hSetBuffering stderr (BlockBuffering (Just 2)) + queryBuffering "stderr" stderr + hPutStr stderr "Hello stderr 4" + hSetBuffering stderr (BlockBuffering Nothing) + 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) []) + + ls <- hGetContents stdin + ls' <- putLine ls + hSetBuffering stdin NoBuffering + putLine ls' + return () + +putLine :: String -> IO String +putLine [] = return [] +putLine (x:xs) = do + putChar x + case x of + '\n' -> return xs + _ -> putLine xs + diff --git a/testsuite/tests/lib/IO/hSetBuffering003.stderr b/testsuite/tests/lib/IO/hSetBuffering003.stderr new file mode 100644 index 0000000000..a4cf8779b4 --- /dev/null +++ b/testsuite/tests/lib/IO/hSetBuffering003.stderr @@ -0,0 +1 @@ +Hello stderr 1Hello stderr 2Hello stderr 3Hello stderr 4Hello stderr 5
\ No newline at end of file diff --git a/testsuite/tests/lib/IO/hSetBuffering003.stdout b/testsuite/tests/lib/IO/hSetBuffering003.stdout new file mode 100644 index 0000000000..7768773198 --- /dev/null +++ b/testsuite/tests/lib/IO/hSetBuffering003.stdout @@ -0,0 +1,22 @@ +Buffering for stdin is: BlockBuffering Nothing +Buffering for stdout is: BlockBuffering Nothing +Buffering for stderr is: NoBuffering +Buffering for stdin is: NoBuffering +Buffering for stdin is: LineBuffering +Buffering for stdin is: BlockBuffering (Just 2) +Buffering for stdin is: BlockBuffering Nothing +Caught illegal op: hSetBuffering stdin (BlockBuffering (Just (-3))) + +Hello stdout 1Buffering for stdout is: NoBuffering +Hello stdout 2Buffering for stdout is: LineBuffering +Hello stdout 3Buffering for stdout is: BlockBuffering (Just 2) +Hello stdout 4Buffering for stdout is: BlockBuffering Nothing +Hello stdout 5Caught illegal op: hSetBuffering stdout (BlockBuffering (Just (-3))) + +Buffering for stderr is: NoBuffering +Buffering for stderr is: LineBuffering +Buffering for stderr is: BlockBuffering (Just 2) +Buffering for stderr is: BlockBuffering Nothing +Caught illegal op: hSetBuffering stderr (BlockBuffering (Just (-3))) +-- !!! Reconfiguring the buffering of a handle +module Main(main) where diff --git a/testsuite/tests/lib/IO/hSetBuffering004.hs b/testsuite/tests/lib/IO/hSetBuffering004.hs new file mode 100644 index 0000000000..eaee6826d2 --- /dev/null +++ b/testsuite/tests/lib/IO/hSetBuffering004.hs @@ -0,0 +1,9 @@ +-- test for #2678 +module Main (main) where + +import System.IO + +main :: IO () +main = do hSetBuffering stdin NoBuffering + hLookAhead stdin >>= print + hSetBuffering stdin LineBuffering diff --git a/testsuite/tests/lib/IO/hSetBuffering004.stdout b/testsuite/tests/lib/IO/hSetBuffering004.stdout new file mode 100644 index 0000000000..7766eec971 --- /dev/null +++ b/testsuite/tests/lib/IO/hSetBuffering004.stdout @@ -0,0 +1 @@ +'-' diff --git a/testsuite/tests/lib/IO/hSetEncoding001.hs b/testsuite/tests/lib/IO/hSetEncoding001.hs new file mode 100644 index 0000000000..95f570d094 --- /dev/null +++ b/testsuite/tests/lib/IO/hSetEncoding001.hs @@ -0,0 +1,49 @@ +import System.IO +import GHC.IO.Handle +import GHC.IO.Encoding +import System.Environment + +-- Test switching encodings +-- The test file is built by the Makefile + +main = do + [file] <- getArgs + test file NoBuffering + test file (BlockBuffering Nothing) + test file (BlockBuffering (Just 5)) + +test file buf = do + hSetEncoding stdout utf8 + h <- openBinaryFile file ReadMode + hSetBuffering stdout buf + putStrLn "no encoding:" + getUntilX h + hSetEncoding h utf8 + putStrLn "UTF8:" + getUntilX h + hSetEncoding h utf16le + putStrLn "UTF16LE:" + getUntilX h + hSetEncoding h utf16be + putStrLn "UTF16BE:" + getUntilX h + hSetEncoding h utf16 + putStrLn "UTF16:" + getUntilX h + hSetEncoding h utf32 + putStrLn "UTF32:" + getUntilX h + hSetEncoding h utf32le + putStrLn "UTF32LE:" + getUntilX h + hSetEncoding h utf32be + putStrLn "UTF32BE:" + getUntilX h + hSetEncoding h utf8_bom + putStrLn "UTF8-BOM:" + getUntilX h + hIsEOF h >>= print + +getUntilX h = do + c <- hGetChar h + if c == 'X' then return () else do putChar c; getUntilX h diff --git a/testsuite/tests/lib/IO/hSetEncoding001.in b/testsuite/tests/lib/IO/hSetEncoding001.in Binary files differnew file mode 100644 index 0000000000..03f297441d --- /dev/null +++ b/testsuite/tests/lib/IO/hSetEncoding001.in diff --git a/testsuite/tests/lib/IO/hSetEncoding001.stdout b/testsuite/tests/lib/IO/hSetEncoding001.stdout new file mode 100644 index 0000000000..a1d38ffd77 --- /dev/null +++ b/testsuite/tests/lib/IO/hSetEncoding001.stdout @@ -0,0 +1,90 @@ +no encoding: +c0 | À Á Â Ã Ä Å Æ Ç È É Ê Ë Ì Í Î Ï +d0 | Ð Ñ Ò Ó Ô Õ Ö × Ø Ù Ú Û Ü Ý Þ ß +e0 | à á â ã ä å æ ç è é ê ë ì í î ï +f0 | ð ñ ò ó ô õ ö ÷ ø ù ú û ü ý þ ÿ +UTF8: +(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ) +𝑎𝑏𝑐𝑑𝑒𝑓𝑔𝑖𝑗𝑘𝑙𝑚𝑛𝑜𝑝𝑞𝑟𝑠𝑡𝑢𝑣𝑤𝑥𝑦𝑧 +UTF16LE: +(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ) +𝑎𝑏𝑐𝑑𝑒𝑓𝑔𝑖𝑗𝑘𝑙𝑚𝑛𝑜𝑝𝑞𝑟𝑠𝑡𝑢𝑣𝑤𝑥𝑦𝑧 +UTF16BE: +(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ) +𝑎𝑏𝑐𝑑𝑒𝑓𝑔𝑖𝑗𝑘𝑙𝑚𝑛𝑜𝑝𝑞𝑟𝑠𝑡𝑢𝑣𝑤𝑥𝑦𝑧 +UTF16: +(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ) +𝑎𝑏𝑐𝑑𝑒𝑓𝑔𝑖𝑗𝑘𝑙𝑚𝑛𝑜𝑝𝑞𝑟𝑠𝑡𝑢𝑣𝑤𝑥𝑦𝑧 +UTF32: +(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ) +𝑎𝑏𝑐𝑑𝑒𝑓𝑔𝑖𝑗𝑘𝑙𝑚𝑛𝑜𝑝𝑞𝑟𝑠𝑡𝑢𝑣𝑤𝑥𝑦𝑧 +UTF32LE: +(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ) +𝑎𝑏𝑐𝑑𝑒𝑓𝑔𝑖𝑗𝑘𝑙𝑚𝑛𝑜𝑝𝑞𝑟𝑠𝑡𝑢𝑣𝑤𝑥𝑦𝑧 +UTF32BE: +(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ) +𝑎𝑏𝑐𝑑𝑒𝑓𝑔𝑖𝑗𝑘𝑙𝑚𝑛𝑜𝑝𝑞𝑟𝑠𝑡𝑢𝑣𝑤𝑥𝑦𝑧 +UTF8-BOM: +(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ) +𝑎𝑏𝑐𝑑𝑒𝑓𝑔𝑖𝑗𝑘𝑙𝑚𝑛𝑜𝑝𝑞𝑟𝑠𝑡𝑢𝑣𝑤𝑥𝑦𝑧 +True +no encoding: +c0 | À Á Â Ã Ä Å Æ Ç È É Ê Ë Ì Í Î Ï +d0 | Ð Ñ Ò Ó Ô Õ Ö × Ø Ù Ú Û Ü Ý Þ ß +e0 | à á â ã ä å æ ç è é ê ë ì í î ï +f0 | ð ñ ò ó ô õ ö ÷ ø ù ú û ü ý þ ÿ +UTF8: +(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ) +𝑎𝑏𝑐𝑑𝑒𝑓𝑔𝑖𝑗𝑘𝑙𝑚𝑛𝑜𝑝𝑞𝑟𝑠𝑡𝑢𝑣𝑤𝑥𝑦𝑧 +UTF16LE: +(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ) +𝑎𝑏𝑐𝑑𝑒𝑓𝑔𝑖𝑗𝑘𝑙𝑚𝑛𝑜𝑝𝑞𝑟𝑠𝑡𝑢𝑣𝑤𝑥𝑦𝑧 +UTF16BE: +(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ) +𝑎𝑏𝑐𝑑𝑒𝑓𝑔𝑖𝑗𝑘𝑙𝑚𝑛𝑜𝑝𝑞𝑟𝑠𝑡𝑢𝑣𝑤𝑥𝑦𝑧 +UTF16: +(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ) +𝑎𝑏𝑐𝑑𝑒𝑓𝑔𝑖𝑗𝑘𝑙𝑚𝑛𝑜𝑝𝑞𝑟𝑠𝑡𝑢𝑣𝑤𝑥𝑦𝑧 +UTF32: +(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ) +𝑎𝑏𝑐𝑑𝑒𝑓𝑔𝑖𝑗𝑘𝑙𝑚𝑛𝑜𝑝𝑞𝑟𝑠𝑡𝑢𝑣𝑤𝑥𝑦𝑧 +UTF32LE: +(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ) +𝑎𝑏𝑐𝑑𝑒𝑓𝑔𝑖𝑗𝑘𝑙𝑚𝑛𝑜𝑝𝑞𝑟𝑠𝑡𝑢𝑣𝑤𝑥𝑦𝑧 +UTF32BE: +(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ) +𝑎𝑏𝑐𝑑𝑒𝑓𝑔𝑖𝑗𝑘𝑙𝑚𝑛𝑜𝑝𝑞𝑟𝑠𝑡𝑢𝑣𝑤𝑥𝑦𝑧 +UTF8-BOM: +(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ) +𝑎𝑏𝑐𝑑𝑒𝑓𝑔𝑖𝑗𝑘𝑙𝑚𝑛𝑜𝑝𝑞𝑟𝑠𝑡𝑢𝑣𝑤𝑥𝑦𝑧 +True +no encoding: +c0 | À Á Â Ã Ä Å Æ Ç È É Ê Ë Ì Í Î Ï +d0 | Ð Ñ Ò Ó Ô Õ Ö × Ø Ù Ú Û Ü Ý Þ ß +e0 | à á â ã ä å æ ç è é ê ë ì í î ï +f0 | ð ñ ò ó ô õ ö ÷ ø ù ú û ü ý þ ÿ +UTF8: +(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ) +𝑎𝑏𝑐𝑑𝑒𝑓𝑔𝑖𝑗𝑘𝑙𝑚𝑛𝑜𝑝𝑞𝑟𝑠𝑡𝑢𝑣𝑤𝑥𝑦𝑧 +UTF16LE: +(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ) +𝑎𝑏𝑐𝑑𝑒𝑓𝑔𝑖𝑗𝑘𝑙𝑚𝑛𝑜𝑝𝑞𝑟𝑠𝑡𝑢𝑣𝑤𝑥𝑦𝑧 +UTF16BE: +(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ) +𝑎𝑏𝑐𝑑𝑒𝑓𝑔𝑖𝑗𝑘𝑙𝑚𝑛𝑜𝑝𝑞𝑟𝑠𝑡𝑢𝑣𝑤𝑥𝑦𝑧 +UTF16: +(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ) +𝑎𝑏𝑐𝑑𝑒𝑓𝑔𝑖𝑗𝑘𝑙𝑚𝑛𝑜𝑝𝑞𝑟𝑠𝑡𝑢𝑣𝑤𝑥𝑦𝑧 +UTF32: +(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ) +𝑎𝑏𝑐𝑑𝑒𝑓𝑔𝑖𝑗𝑘𝑙𝑚𝑛𝑜𝑝𝑞𝑟𝑠𝑡𝑢𝑣𝑤𝑥𝑦𝑧 +UTF32LE: +(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ) +𝑎𝑏𝑐𝑑𝑒𝑓𝑔𝑖𝑗𝑘𝑙𝑚𝑛𝑜𝑝𝑞𝑟𝑠𝑡𝑢𝑣𝑤𝑥𝑦𝑧 +UTF32BE: +(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ) +𝑎𝑏𝑐𝑑𝑒𝑓𝑔𝑖𝑗𝑘𝑙𝑚𝑛𝑜𝑝𝑞𝑟𝑠𝑡𝑢𝑣𝑤𝑥𝑦𝑧 +UTF8-BOM: +(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ) +𝑎𝑏𝑐𝑑𝑒𝑓𝑔𝑖𝑗𝑘𝑙𝑚𝑛𝑜𝑝𝑞𝑟𝑠𝑡𝑢𝑣𝑤𝑥𝑦𝑧 +True diff --git a/testsuite/tests/lib/IO/hSetEncoding002.hs b/testsuite/tests/lib/IO/hSetEncoding002.hs new file mode 100644 index 0000000000..35c4e1ce19 --- /dev/null +++ b/testsuite/tests/lib/IO/hSetEncoding002.hs @@ -0,0 +1,13 @@ +-- test for #4066 + +import System.IO + +import GHC.IO.FD as FD (stdout) +import GHC.IO.Handle.FD as FD (fdToHandle) +import GHC.IO.Handle ( mkDuplexHandle ) + +main = do + h <- mkDuplexHandle FD.stdout "stdout" Nothing noNewlineTranslation + hSetEncoding h utf8 + hPutStrLn h "ö" + hClose h diff --git a/testsuite/tests/lib/IO/hSetEncoding002.stdout b/testsuite/tests/lib/IO/hSetEncoding002.stdout new file mode 100644 index 0000000000..d3b4b915a1 --- /dev/null +++ b/testsuite/tests/lib/IO/hSetEncoding002.stdout @@ -0,0 +1 @@ +ö diff --git a/testsuite/tests/lib/IO/ioeGetErrorString001.hs b/testsuite/tests/lib/IO/ioeGetErrorString001.hs new file mode 100644 index 0000000000..5621136a55 --- /dev/null +++ b/testsuite/tests/lib/IO/ioeGetErrorString001.hs @@ -0,0 +1,13 @@ +-- !!! test ioeGetErrorString + +import System.IO +import System.IO.Error +import Data.Maybe + +main = do + h <- openFile "ioeGetErrorString001.hs" ReadMode + hSeek h SeekFromEnd 0 + (hGetChar h >> return ()) `catch` + \e -> if isEOFError e + then print (ioeGetErrorString e) + else putStrLn "failed." diff --git a/testsuite/tests/lib/IO/ioeGetErrorString001.stdout b/testsuite/tests/lib/IO/ioeGetErrorString001.stdout new file mode 100644 index 0000000000..0b8daea55a --- /dev/null +++ b/testsuite/tests/lib/IO/ioeGetErrorString001.stdout @@ -0,0 +1 @@ +"end of file" diff --git a/testsuite/tests/lib/IO/ioeGetFileName001.hs b/testsuite/tests/lib/IO/ioeGetFileName001.hs new file mode 100644 index 0000000000..12c70c98b4 --- /dev/null +++ b/testsuite/tests/lib/IO/ioeGetFileName001.hs @@ -0,0 +1,12 @@ +-- !!! test ioeGetFileName + +import System.IO +import System.IO.Error + +main = do + h <- openFile "ioeGetFileName001.hs" ReadMode + hSeek h SeekFromEnd 0 + (hGetChar h >> return ()) `catch` + \e -> if isEOFError e + then print (ioeGetFileName e) + else putStrLn "failed." diff --git a/testsuite/tests/lib/IO/ioeGetFileName001.stdout b/testsuite/tests/lib/IO/ioeGetFileName001.stdout new file mode 100644 index 0000000000..7377ad409d --- /dev/null +++ b/testsuite/tests/lib/IO/ioeGetFileName001.stdout @@ -0,0 +1 @@ +Just "ioeGetFileName001.hs" diff --git a/testsuite/tests/lib/IO/ioeGetHandle001.hs b/testsuite/tests/lib/IO/ioeGetHandle001.hs new file mode 100644 index 0000000000..a9ef58a8ca --- /dev/null +++ b/testsuite/tests/lib/IO/ioeGetHandle001.hs @@ -0,0 +1,13 @@ +-- !!! test ioeGetHandle + +import System.IO +import System.IO.Error +import Data.Maybe + +main = do + h <- openFile "ioeGetHandle001.hs" ReadMode + hSeek h SeekFromEnd 0 + (hGetChar h >> return ()) `catch` + \e -> if isEOFError e && fromJust (ioeGetHandle e) == h + then putStrLn "ok." + else putStrLn "failed." diff --git a/testsuite/tests/lib/IO/ioeGetHandle001.stdout b/testsuite/tests/lib/IO/ioeGetHandle001.stdout new file mode 100644 index 0000000000..90b5016eff --- /dev/null +++ b/testsuite/tests/lib/IO/ioeGetHandle001.stdout @@ -0,0 +1 @@ +ok. diff --git a/testsuite/tests/lib/IO/isEOF001.hs b/testsuite/tests/lib/IO/isEOF001.hs new file mode 100644 index 0000000000..bb205703f8 --- /dev/null +++ b/testsuite/tests/lib/IO/isEOF001.hs @@ -0,0 +1,3 @@ +import System.IO + +main = isEOF >>= print diff --git a/testsuite/tests/lib/IO/isEOF001.stdout b/testsuite/tests/lib/IO/isEOF001.stdout new file mode 100644 index 0000000000..0ca95142bb --- /dev/null +++ b/testsuite/tests/lib/IO/isEOF001.stdout @@ -0,0 +1 @@ +True diff --git a/testsuite/tests/lib/IO/latin1 b/testsuite/tests/lib/IO/latin1 new file mode 100644 index 0000000000..a634257fbf --- /dev/null +++ b/testsuite/tests/lib/IO/latin1 @@ -0,0 +1,5 @@ +c0 | +d0 | +e0 | +f0 | +X
\ No newline at end of file diff --git a/testsuite/tests/lib/IO/misc001.hs b/testsuite/tests/lib/IO/misc001.hs new file mode 100644 index 0000000000..9f9f3e98d0 --- /dev/null +++ b/testsuite/tests/lib/IO/misc001.hs @@ -0,0 +1,24 @@ +import System.IO + +import Data.Char (toUpper) +import System.Directory (removeFile, doesFileExist) +import System.Environment (getArgs) + +main = do + [f1,f2] <- getArgs + h1 <- openFile f1 ReadMode + f <- doesFileExist f2 + if f then removeFile f2 else return () + h2 <- openFile f2 WriteMode + copyFile h1 h2 + hClose h1 + hClose h2 + +copyFile h1 h2 = do + eof <- hIsEOF h1 + if eof + then return () + else do + c <- hGetChar h1 + c <- hPutChar h2 (toUpper c) + copyFile h1 h2 diff --git a/testsuite/tests/lib/IO/misc001.stdout b/testsuite/tests/lib/IO/misc001.stdout new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/lib/IO/misc001.stdout diff --git a/testsuite/tests/lib/IO/newline001.hs b/testsuite/tests/lib/IO/newline001.hs new file mode 100644 index 0000000000..b12a65bcaa --- /dev/null +++ b/testsuite/tests/lib/IO/newline001.hs @@ -0,0 +1,121 @@ +import System.IO +import GHC.IO.Handle +import Control.Monad +import Data.List + +newlines = ["\n","\r","\r\n","\n\r","\n\n","\r\r"] + +-- make sure the file ends in '\r': that's a tricky case for CRLF +-- conversion, because the IO library has to check whether there's a +-- following \n before returning the \r. +content = concat [ show i ++ t | (i,t) <- zip [1..100] (cycle newlines) ] + +filename = "newline001.out" + +fromCRLF [] = [] +fromCRLF ('\r':'\n':cs) = '\n' : fromCRLF cs +fromCRLF (c:cs) = c : fromCRLF cs + +toCRLF [] = [] +toCRLF ('\n':cs) = '\r':'\n': toCRLF cs +toCRLF (c:cs) = c : toCRLF cs + +main = do + h <- openBinaryFile filename WriteMode + hPutStr h content + hClose h + testinput NoBuffering + testinput LineBuffering + testinput (BlockBuffering Nothing) + testinput (BlockBuffering (Just 3)) + testinput (BlockBuffering (Just 7)) + testinput (BlockBuffering (Just 16)) + testoutput NoBuffering + testoutput LineBuffering + testoutput (BlockBuffering Nothing) + testoutput (BlockBuffering (Just 3)) + testoutput (BlockBuffering (Just 7)) + testoutput (BlockBuffering (Just 16)) + +testinput b = do + h <- openFile filename ReadMode + hSetBuffering h b + hSetNewlineMode h noNewlineTranslation + str <- hGetContents h + check "in1" b str content + hClose h + + h <- openFile filename ReadMode + hSetBuffering h b + hSetNewlineMode h noNewlineTranslation + str <- read_chars h + check "in2" b str content + hClose h + + h <- openFile filename ReadMode + hSetBuffering h b + hSetNewlineMode h noNewlineTranslation + str <- read_lines h + check "in3" b str content + hClose h + + h <- openFile filename ReadMode + hSetBuffering h b + hSetNewlineMode h NewlineMode{ inputNL=CRLF, outputNL=LF } + str <- hGetContents h + check "in4" b str (fromCRLF content) + hClose h + + h <- openFile filename ReadMode + hSetBuffering h b + hSetNewlineMode h NewlineMode{ inputNL=CRLF, outputNL=LF } + str <- read_chars h + check "in5" b str (fromCRLF content) + hClose h + + h <- openFile filename ReadMode + hSetBuffering h b + hSetNewlineMode h NewlineMode{ inputNL=CRLF, outputNL=LF } + str <- read_lines h + check "in6" b str (fromCRLF content) + hClose h + +testoutput b = do + h <- openFile filename WriteMode + hSetBuffering h b + hSetNewlineMode h NewlineMode{ inputNL=LF, outputNL=CRLF } + hPutStr h content + hClose h + h <- openBinaryFile filename ReadMode + str <- hGetContents h + check "out1" b (toCRLF content) str + hClose h + + h <- openFile filename WriteMode + hSetBuffering h b + hSetNewlineMode h NewlineMode{ inputNL=LF, outputNL=CRLF } + mapM_ (hPutChar h) content + hClose h + h <- openBinaryFile filename ReadMode + str <- hGetContents h + check "out2" b (toCRLF content) str + hClose h + +check s b str1 str2 = do + when (str1 /= str2) $ error ("failed: " ++ s ++ ", " ++ show b ++ '\n':show str1 ++ '\n':show str2) + +read_chars :: Handle -> IO String +read_chars h = loop h "" + where loop h acc = do + b <- hIsEOF h + if b then return (reverse acc) else do + c <- hGetChar h + loop h (c:acc) + +read_lines :: Handle -> IO String +read_lines h = loop h [] + where loop h acc = do + b <- hIsEOF h + if b then return (intercalate "\n" (reverse acc)) else do + l <- hGetLine h + loop h (l : acc) diff --git a/testsuite/tests/lib/IO/openFile001.hs b/testsuite/tests/lib/IO/openFile001.hs new file mode 100644 index 0000000000..f34f093d38 --- /dev/null +++ b/testsuite/tests/lib/IO/openFile001.hs @@ -0,0 +1,11 @@ +-- !!! test that a file opened in ReadMode can't be written to + +import System.IO +import System.IO.Error + +main = do + hIn <- openFile "openFile001.hs" ReadMode + hPutStr hIn "test" `catchIOError` \ err -> + if isIllegalOperation err + then putStrLn "ok." + else error "Oh dear\n" diff --git a/testsuite/tests/lib/IO/openFile001.stdout b/testsuite/tests/lib/IO/openFile001.stdout new file mode 100644 index 0000000000..90b5016eff --- /dev/null +++ b/testsuite/tests/lib/IO/openFile001.stdout @@ -0,0 +1 @@ +ok. diff --git a/testsuite/tests/lib/IO/openFile002.hs b/testsuite/tests/lib/IO/openFile002.hs new file mode 100644 index 0000000000..83822621f6 --- /dev/null +++ b/testsuite/tests/lib/IO/openFile002.hs @@ -0,0 +1,6 @@ +import Data.Char +import System.IO + +-- !!! Open a non-existent file for reading (should fail) + +main = openFile "nonexistent" ReadMode diff --git a/testsuite/tests/lib/IO/openFile002.stderr b/testsuite/tests/lib/IO/openFile002.stderr new file mode 100644 index 0000000000..b011f34146 --- /dev/null +++ b/testsuite/tests/lib/IO/openFile002.stderr @@ -0,0 +1 @@ +openFile002: nonexistent: openFile: does not exist (No such file or directory) diff --git a/testsuite/tests/lib/IO/openFile002.stderr-hugs b/testsuite/tests/lib/IO/openFile002.stderr-hugs new file mode 100644 index 0000000000..aa76710e44 --- /dev/null +++ b/testsuite/tests/lib/IO/openFile002.stderr-hugs @@ -0,0 +1 @@ +openFile002: nonexistent: IO.openFile: does not exist (file does not exist) diff --git a/testsuite/tests/lib/IO/openFile003.hs b/testsuite/tests/lib/IO/openFile003.hs new file mode 100644 index 0000000000..81b69c40ec --- /dev/null +++ b/testsuite/tests/lib/IO/openFile003.hs @@ -0,0 +1,14 @@ +import System.IO +import System.IO.Error + +-- !!! Open a directory (should fail) + +main = do + r <- tryIOError (openFile "." ReadMode) + print r + r <- tryIOError (openFile "." WriteMode) + print r + r <- tryIOError (openFile "." AppendMode) + print r + r <- tryIOError (openFile "." ReadWriteMode) + print r diff --git a/testsuite/tests/lib/IO/openFile003.stdout b/testsuite/tests/lib/IO/openFile003.stdout new file mode 100644 index 0000000000..57288459bd --- /dev/null +++ b/testsuite/tests/lib/IO/openFile003.stdout @@ -0,0 +1,4 @@ +Left .: openFile: inappropriate type (is a directory) +Left .: openFile: inappropriate type (Is a directory) +Left .: openFile: inappropriate type (Is a directory) +Left .: openFile: inappropriate type (Is a directory) diff --git a/testsuite/tests/lib/IO/openFile003.stdout-i386-unknown-mingw32 b/testsuite/tests/lib/IO/openFile003.stdout-i386-unknown-mingw32 new file mode 100644 index 0000000000..08eaf891f1 --- /dev/null +++ b/testsuite/tests/lib/IO/openFile003.stdout-i386-unknown-mingw32 @@ -0,0 +1,4 @@ +Left .: openFile: permission denied (Permission denied)
+Left .: openFile: permission denied (Permission denied)
+Left .: openFile: permission denied (Permission denied)
+Left .: openFile: permission denied (Permission denied)
diff --git a/testsuite/tests/lib/IO/openFile003.stdout-i386-unknown-solaris2 b/testsuite/tests/lib/IO/openFile003.stdout-i386-unknown-solaris2 new file mode 100644 index 0000000000..2cbf46b25f --- /dev/null +++ b/testsuite/tests/lib/IO/openFile003.stdout-i386-unknown-solaris2 @@ -0,0 +1,4 @@ +Left .: openFile: inappropriate type (is a directory) +Left .: openFile: invalid argument (Invalid argument) +Left .: openFile: invalid argument (Invalid argument) +Left .: openFile: invalid argument (Invalid argument) diff --git a/testsuite/tests/lib/IO/openFile003.stdout-mingw b/testsuite/tests/lib/IO/openFile003.stdout-mingw new file mode 100644 index 0000000000..f7d4410620 --- /dev/null +++ b/testsuite/tests/lib/IO/openFile003.stdout-mingw @@ -0,0 +1,16 @@ +Left permission denied +Action: openFile +Reason: Permission denied +File: . +Left permission denied +Action: openFile +Reason: Permission denied +File: . +Left permission denied +Action: openFile +Reason: Permission denied +File: . +Left permission denied +Action: openFile +Reason: Permission denied +File: . diff --git a/testsuite/tests/lib/IO/openFile003.stdout-mips-sgi-irix b/testsuite/tests/lib/IO/openFile003.stdout-mips-sgi-irix new file mode 100644 index 0000000000..2cbf46b25f --- /dev/null +++ b/testsuite/tests/lib/IO/openFile003.stdout-mips-sgi-irix @@ -0,0 +1,4 @@ +Left .: openFile: inappropriate type (is a directory) +Left .: openFile: invalid argument (Invalid argument) +Left .: openFile: invalid argument (Invalid argument) +Left .: openFile: invalid argument (Invalid argument) diff --git a/testsuite/tests/lib/IO/openFile003.stdout-sparc-sun-solaris2 b/testsuite/tests/lib/IO/openFile003.stdout-sparc-sun-solaris2 new file mode 100644 index 0000000000..2cbf46b25f --- /dev/null +++ b/testsuite/tests/lib/IO/openFile003.stdout-sparc-sun-solaris2 @@ -0,0 +1,4 @@ +Left .: openFile: inappropriate type (is a directory) +Left .: openFile: invalid argument (Invalid argument) +Left .: openFile: invalid argument (Invalid argument) +Left .: openFile: invalid argument (Invalid argument) diff --git a/testsuite/tests/lib/IO/openFile004.hs b/testsuite/tests/lib/IO/openFile004.hs new file mode 100644 index 0000000000..4124abb0de --- /dev/null +++ b/testsuite/tests/lib/IO/openFile004.hs @@ -0,0 +1,23 @@ +-- !!! Open a non-existent file for writing + +import Control.Monad +import Data.Char +import System.Directory +import System.IO + +file = "openFile004.out" + +main = do + b <- doesFileExist file + when b (removeFile file) + + h <- openFile file WriteMode + hPutStr h "hello world\n" + hClose h + + h <- openFile file ReadMode + let loop = do + b <- hIsEOF h + if b then return () + else do c <- hGetChar h; putChar c; loop + loop diff --git a/testsuite/tests/lib/IO/openFile004.stdout b/testsuite/tests/lib/IO/openFile004.stdout new file mode 100644 index 0000000000..3b18e512db --- /dev/null +++ b/testsuite/tests/lib/IO/openFile004.stdout @@ -0,0 +1 @@ +hello world diff --git a/testsuite/tests/lib/IO/openFile005.hs b/testsuite/tests/lib/IO/openFile005.hs new file mode 100644 index 0000000000..d8a8f83453 --- /dev/null +++ b/testsuite/tests/lib/IO/openFile005.hs @@ -0,0 +1,45 @@ +-- !!! test multiple-reader single-writer locking semantics + +import System.IO +import System.IO.Error + +file1 = "openFile005.out1" +file2 = "openFile005.out2" + +main = do + putStrLn "two writes (should fail)" + h <- openFile file1 WriteMode + tryIOError (openFile file1 WriteMode) >>= print + hClose h + + putStrLn "write and an append (should fail)" + h <- openFile file1 WriteMode + tryIOError (openFile file1 AppendMode) >>= print + hClose h + + putStrLn "read/write and a write (should fail)" + h <- openFile file1 ReadWriteMode + tryIOError (openFile file1 WriteMode) >>= print + hClose h + + putStrLn "read and a read/write (should fail)" + h <- openFile file1 ReadMode + tryIOError (openFile file1 ReadWriteMode) >>= print + hClose h + + putStrLn "write and a read (should fail)" + h <- openFile file1 WriteMode + tryIOError (openFile file1 ReadMode) >>= print + hClose h + + putStrLn "two writes, different files (silly, but should succeed)" + h1 <- openFile file1 WriteMode + h2 <- openFile file2 WriteMode + hClose h1 + hClose h2 + + putStrLn "two reads, should succeed" + h1 <- openFile file1 ReadMode + h2 <- openFile file1 ReadMode + hClose h1 + hClose h2 diff --git a/testsuite/tests/lib/IO/openFile005.stdout b/testsuite/tests/lib/IO/openFile005.stdout new file mode 100644 index 0000000000..1a4b843be0 --- /dev/null +++ b/testsuite/tests/lib/IO/openFile005.stdout @@ -0,0 +1,12 @@ +two writes (should fail) +Left openFile005.out1: openFile: resource busy (file is locked) +write and an append (should fail) +Left openFile005.out1: openFile: resource busy (file is locked) +read/write and a write (should fail) +Left openFile005.out1: openFile: resource busy (file is locked) +read and a read/write (should fail) +Left openFile005.out1: openFile: resource busy (file is locked) +write and a read (should fail) +Left openFile005.out1: openFile: resource busy (file is locked) +two writes, different files (silly, but should succeed) +two reads, should succeed diff --git a/testsuite/tests/lib/IO/openFile005.stdout-i386-unknown-mingw32 b/testsuite/tests/lib/IO/openFile005.stdout-i386-unknown-mingw32 new file mode 100644 index 0000000000..bf227989a9 --- /dev/null +++ b/testsuite/tests/lib/IO/openFile005.stdout-i386-unknown-mingw32 @@ -0,0 +1,12 @@ +two writes (should fail) +Left openFile005.out1: openFile: permission denied (Permission denied) +write and an append (should fail) +Left openFile005.out1: openFile: permission denied (Permission denied) +read/write and a write (should fail) +Left openFile005.out1: openFile: permission denied (Permission denied) +read and a read/write (should fail) +Left openFile005.out1: openFile: permission denied (Permission denied) +write and a read (should fail) +Left openFile005.out1: openFile: permission denied (Permission denied) +two writes, different files (silly, but should succeed) +two reads, should succeed diff --git a/testsuite/tests/lib/IO/openFile006.hs b/testsuite/tests/lib/IO/openFile006.hs new file mode 100644 index 0000000000..63cfea1a87 --- /dev/null +++ b/testsuite/tests/lib/IO/openFile006.hs @@ -0,0 +1,14 @@ +-- !!! opening a file in WriteMode better truncate it + +import System.IO + +main = do + h <- openFile "openFile006.out" AppendMode + hPutStr h "hello, world" + size <- hFileSize h + print size + hClose h + + h <- openFile "openFile006.out" WriteMode + size <- hFileSize h + print size diff --git a/testsuite/tests/lib/IO/openFile006.stdout b/testsuite/tests/lib/IO/openFile006.stdout new file mode 100644 index 0000000000..368283eb3d --- /dev/null +++ b/testsuite/tests/lib/IO/openFile006.stdout @@ -0,0 +1,2 @@ +12 +0 diff --git a/testsuite/tests/lib/IO/openFile007.hs b/testsuite/tests/lib/IO/openFile007.hs new file mode 100644 index 0000000000..e39ed6538f --- /dev/null +++ b/testsuite/tests/lib/IO/openFile007.hs @@ -0,0 +1,18 @@ +-- !!! check that we don't truncate files if the open fails + +import Control.Monad +import System.IO +import System.IO.Error + +tmp = "openFile007.out" + +main = do + h <- openFile tmp WriteMode + hPutStrLn h "hello, world" + + -- second open in write mode better fail, but better not truncate the file + tryIOError (openFile tmp WriteMode) >>= print + + hClose h + s <- readFile tmp -- make sure our "hello, world" is still there + putStr s diff --git a/testsuite/tests/lib/IO/openFile007.stdout b/testsuite/tests/lib/IO/openFile007.stdout new file mode 100644 index 0000000000..49669047ff --- /dev/null +++ b/testsuite/tests/lib/IO/openFile007.stdout @@ -0,0 +1,2 @@ +Left openFile007.out: openFile: resource busy (file is locked) +hello, world diff --git a/testsuite/tests/lib/IO/openFile007.stdout-i386-unknown-mingw32 b/testsuite/tests/lib/IO/openFile007.stdout-i386-unknown-mingw32 new file mode 100644 index 0000000000..26f0afe2b2 --- /dev/null +++ b/testsuite/tests/lib/IO/openFile007.stdout-i386-unknown-mingw32 @@ -0,0 +1,2 @@ +Left openFile007.out: openFile: permission denied (Permission denied) +hello, world diff --git a/testsuite/tests/lib/IO/openFile008.hs b/testsuite/tests/lib/IO/openFile008.hs new file mode 100644 index 0000000000..9c1a1c47f8 --- /dev/null +++ b/testsuite/tests/lib/IO/openFile008.hs @@ -0,0 +1,22 @@ +import System.IO +import System.Cmd +import System.FilePath +import Text.Printf +import System.Directory +import Control.Monad + +testdir = "openFile008_testdir" + +-- Test repeated opening/closing of 1000 files. This is useful for guaging +-- the performance of open/close and file locking. +main = do + system ("rm -rf " ++ testdir) + createDirectory testdir + let filenames = [testdir </> printf "file%03d" (n::Int) | n <- [1..1000]] + + forM_ [1..50] $ \_ -> do + hs <- mapM (\f -> openFile f WriteMode) filenames + mapM_ hClose hs + + mapM_ removeFile filenames + removeDirectory testdir diff --git a/testsuite/tests/lib/IO/openTempFile001.hs b/testsuite/tests/lib/IO/openTempFile001.hs new file mode 100644 index 0000000000..36598e6d5b --- /dev/null +++ b/testsuite/tests/lib/IO/openTempFile001.hs @@ -0,0 +1,13 @@ +module Main where + +import System.IO +import Control.Exception +import System.Directory + +main = bracket + (openTempFile "." "test.txt") + (\(f,_) -> removeFile f) + (\(f,h) -> do hPutStrLn h $ "\xa9" -- Copyright symbol + hClose h + s <- readFile f + if (s /= "\xa9\n") then error ("failed: " ++ s) else return ()) diff --git a/testsuite/tests/lib/IO/putStr001.hs b/testsuite/tests/lib/IO/putStr001.hs new file mode 100644 index 0000000000..48b3add3f3 --- /dev/null +++ b/testsuite/tests/lib/IO/putStr001.hs @@ -0,0 +1,6 @@ +-- !!! Testing output on stdout + +-- stdout is buffered, so test if its buffer +-- is flushed upon program termination. + +main = putStr "Hello, world\n" diff --git a/testsuite/tests/lib/IO/putStr001.stdout b/testsuite/tests/lib/IO/putStr001.stdout new file mode 100644 index 0000000000..a5c1966771 --- /dev/null +++ b/testsuite/tests/lib/IO/putStr001.stdout @@ -0,0 +1 @@ +Hello, world diff --git a/testsuite/tests/lib/IO/readFile001.hs b/testsuite/tests/lib/IO/readFile001.hs new file mode 100644 index 0000000000..e4a2b34cb7 --- /dev/null +++ b/testsuite/tests/lib/IO/readFile001.hs @@ -0,0 +1,26 @@ +-- !!! readFile test + +import System.IO +import System.IO.Error + +source = "readFile001.hs" +filename = "readFile001.out" + +main = do + s <- readFile source + h <- openFile filename WriteMode + hPutStrLn h s + hClose h + s <- readFile filename + + -- This open should fail, because the readFile hasn't been forced + -- and the file is therefore still locked. + tryIOError (openFile filename WriteMode) >>= print + + putStrLn s + + -- should be able to open it for writing now, because we've forced the + -- whole file. + h <- openFile filename WriteMode + + print h diff --git a/testsuite/tests/lib/IO/readFile001.stdout b/testsuite/tests/lib/IO/readFile001.stdout new file mode 100644 index 0000000000..cfb75708f9 --- /dev/null +++ b/testsuite/tests/lib/IO/readFile001.stdout @@ -0,0 +1,30 @@ +Left readFile001.out: openFile: resource busy (file is locked) +-- !!! readFile test + +import System.IO +import System.IO.Error + +source = "readFile001.hs" +filename = "readFile001.out" + +main = do + s <- readFile source + h <- openFile filename WriteMode + hPutStrLn h s + hClose h + s <- readFile filename + + -- This open should fail, because the readFile hasn't been forced + -- and the file is therefore still locked. + tryIOError (openFile filename WriteMode) >>= print + + putStrLn s + + -- should be able to open it for writing now, because we've forced the + -- whole file. + h <- openFile filename WriteMode + + print h + + +{handle: readFile001.out} diff --git a/testsuite/tests/lib/IO/readFile001.stdout-i386-unknown-mingw32 b/testsuite/tests/lib/IO/readFile001.stdout-i386-unknown-mingw32 new file mode 100644 index 0000000000..d086f3a209 --- /dev/null +++ b/testsuite/tests/lib/IO/readFile001.stdout-i386-unknown-mingw32 @@ -0,0 +1,30 @@ +Left readFile001.out: openFile: permission denied (Permission denied) +-- !!! readFile test + +import System.IO +import System.IO.Error + +source = "readFile001.hs" +filename = "readFile001.out" + +main = do + s <- readFile source + h <- openFile filename WriteMode + hPutStrLn h s + hClose h + s <- readFile filename + + -- This open should fail, because the readFile hasn't been forced + -- and the file is therefore still locked. + tryIOError (openFile filename WriteMode) >>= print + + putStrLn s + + -- should be able to open it for writing now, because we've forced the + -- whole file. + h <- openFile filename WriteMode + + print h + + +{handle: readFile001.out} diff --git a/testsuite/tests/lib/IO/readwrite001.hs b/testsuite/tests/lib/IO/readwrite001.hs new file mode 100644 index 0000000000..4a94ef10eb --- /dev/null +++ b/testsuite/tests/lib/IO/readwrite001.hs @@ -0,0 +1,23 @@ +-- !!! RW files + +module Main(main) where + +import System.IO +import System.Directory ( removeFile, doesFileExist ) +import Control.Monad + +main = do + f <- doesFileExist "readwrite001.inout" + when f (removeFile "readwrite001.inout") + hdl <- openFile "readwrite001.inout" ReadWriteMode + hSetBuffering hdl LineBuffering + hPutStr hdl "as" + hSeek hdl AbsoluteSeek 0 + ch <- hGetChar hdl + print ch + hPutStr hdl "ase" + hSeek hdl AbsoluteSeek 0 + putChar '\n' + ls <- hGetContents hdl + putStrLn ls + diff --git a/testsuite/tests/lib/IO/readwrite001.stdout b/testsuite/tests/lib/IO/readwrite001.stdout new file mode 100644 index 0000000000..e33ba0613d --- /dev/null +++ b/testsuite/tests/lib/IO/readwrite001.stdout @@ -0,0 +1,3 @@ +'a' + +aase diff --git a/testsuite/tests/lib/IO/readwrite002.hs b/testsuite/tests/lib/IO/readwrite002.hs new file mode 100644 index 0000000000..4bb607e395 --- /dev/null +++ b/testsuite/tests/lib/IO/readwrite002.hs @@ -0,0 +1,49 @@ +-- !!! Testing RW handles + +import System.IO +import System.IO.Error +import System.Directory (removeFile, doesFileExist) +import Control.Monad +import System.Cmd + +-- This test is weird, full marks to whoever dreamt it up! + +main :: IO () +main = do + let username = "readwrite002.inout" + f <- doesFileExist username + when f (removeFile username) + cd <- openFile username ReadWriteMode + + -- binary mode needed, otherwise newline translation gives + -- unpredictable results. + hSetBinaryMode cd True + +-- Leva buffering on to make things more interesting: +-- hSetBuffering stdin NoBuffering +-- hSetBuffering stdout NoBuffering +-- hSetBuffering cd NoBuffering + hPutStr cd speakString + hSeek cd AbsoluteSeek 0 + speak cd `catch` \ 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 + return () + hSeek cd AbsoluteSeek 0 + hSetBuffering cd (BlockBuffering Nothing) + speak cd `catch` \ err -> if isEOFError err then putStrLn "\nCaught EOF" else ioError err + +speakString = "##############################\n" + +speak cd = do + (do + ready <- hReady cd + if ready then + hGetChar cd >>= putChar + else + return () + ready <- hReady stdin + if ready then (do { ch <- getChar; hPutChar cd ch}) + else return ()) + speak cd diff --git a/testsuite/tests/lib/IO/readwrite002.stdout b/testsuite/tests/lib/IO/readwrite002.stdout new file mode 100644 index 0000000000..9aed0284d7 --- /dev/null +++ b/testsuite/tests/lib/IO/readwrite002.stdout @@ -0,0 +1,9 @@ +############### + +Caught EOF +############### + +Caught EOF +############### + +Caught EOF diff --git a/testsuite/tests/lib/IO/readwrite003.hs b/testsuite/tests/lib/IO/readwrite003.hs new file mode 100644 index 0000000000..d7ee78d637 --- /dev/null +++ b/testsuite/tests/lib/IO/readwrite003.hs @@ -0,0 +1,12 @@ +import System.IO + +file = "readwrite003.txt" + +main = do + writeFile file "ab\ncd\nef\ngh" + h <- openFile file ReadWriteMode + hGetLine h + hPutStrLn h "yz" + hClose h + h <- openBinaryFile file ReadMode + hGetContents h >>= putStr diff --git a/testsuite/tests/lib/IO/readwrite003.stdout b/testsuite/tests/lib/IO/readwrite003.stdout new file mode 100644 index 0000000000..6b4522804e --- /dev/null +++ b/testsuite/tests/lib/IO/readwrite003.stdout @@ -0,0 +1,4 @@ +ab +yz +ef +gh
\ No newline at end of file diff --git a/testsuite/tests/lib/IO/utf8-test b/testsuite/tests/lib/IO/utf8-test new file mode 100644 index 0000000000..7d0f35a448 --- /dev/null +++ b/testsuite/tests/lib/IO/utf8-test @@ -0,0 +1,3 @@ +(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ) +𝑎𝑏𝑐𝑑𝑒𝑓𝑔𝑖𝑗𝑘𝑙𝑚𝑛𝑜𝑝𝑞𝑟𝑠𝑡𝑢𝑣𝑤𝑥𝑦𝑧 +X
\ No newline at end of file |