diff options
Diffstat (limited to 'ghc/tests/lib')
105 files changed, 1495 insertions, 0 deletions
diff --git a/ghc/tests/lib/CPUTime/CPUTime001.hs b/ghc/tests/lib/CPUTime/CPUTime001.hs new file mode 100644 index 0000000000..807bbb7895 --- /dev/null +++ b/ghc/tests/lib/CPUTime/CPUTime001.hs @@ -0,0 +1,26 @@ +-- !!! Test getCPUTime + +import IO +import CPUTime + +main :: IO () +main = do + t28 <- timeFib 28 + t29 <- timeFib 29 + t30 <- timeFib 30 + print (t28 <= t29, t29 <= t30) + +timeFib :: Integer -> IO Integer +timeFib n = do + start <- getCPUTime + print (nfib n) + end <- getCPUTime + return (end - start) + +nfib :: Integer -> Integer +nfib n + | n <= 1 = 1 + | otherwise = (n1 + n2 + 1) + where + n1 = nfib (n-1) + n2 = nfib (n-2) diff --git a/ghc/tests/lib/CPUTime/CPUTime001.stdout b/ghc/tests/lib/CPUTime/CPUTime001.stdout new file mode 100644 index 0000000000..032e7595f0 --- /dev/null +++ b/ghc/tests/lib/CPUTime/CPUTime001.stdout @@ -0,0 +1,4 @@ +1028457 +1664079 +2692537 +(True,True) diff --git a/ghc/tests/lib/Directory/currentDirectory001.hs b/ghc/tests/lib/Directory/currentDirectory001.hs new file mode 100644 index 0000000000..bcf9b96ce3 --- /dev/null +++ b/ghc/tests/lib/Directory/currentDirectory001.hs @@ -0,0 +1,20 @@ +import Directory (getCurrentDirectory, setCurrentDirectory, + createDirectory, removeDirectory, getDirectoryContents) + +main = do + oldpwd <- getCurrentDirectory + createDirectory "foo" + setCurrentDirectory "foo" + ~[n1, n2] <- getDirectoryContents "." + if dot n1 && dot n2 + then do + setCurrentDirectory oldpwd + removeDirectory "foo" + putStr "Okay\n" + else + ioError (userError "Oops") + +dot :: String -> Bool +dot "." = True +dot ".." = True +dot _ = False diff --git a/ghc/tests/lib/Directory/currentDirectory001.stdout b/ghc/tests/lib/Directory/currentDirectory001.stdout new file mode 100644 index 0000000000..1ddd42bbe7 --- /dev/null +++ b/ghc/tests/lib/Directory/currentDirectory001.stdout @@ -0,0 +1 @@ +Okay diff --git a/ghc/tests/lib/Directory/directory001.hs b/ghc/tests/lib/Directory/directory001.hs new file mode 100644 index 0000000000..0df9e00c90 --- /dev/null +++ b/ghc/tests/lib/Directory/directory001.hs @@ -0,0 +1,18 @@ +import IO + +import Directory +import IOExts (trace) + +main = do + createDirectory "foo" + h <- openFile "foo/bar" WriteMode + hPutStr h "Okay\n" + hClose h + renameFile "foo/bar" "foo/baz" + renameDirectory "foo" "bar" + h <- openFile "bar/baz" ReadMode + stuff <- hGetContents h + putStr stuff +-- hClose h -- an error ! + removeFile "bar/baz" + removeDirectory "bar" diff --git a/ghc/tests/lib/Directory/directory001.stdout b/ghc/tests/lib/Directory/directory001.stdout new file mode 100644 index 0000000000..1ddd42bbe7 --- /dev/null +++ b/ghc/tests/lib/Directory/directory001.stdout @@ -0,0 +1 @@ +Okay diff --git a/ghc/tests/lib/Directory/getDirectoryContents001.hs b/ghc/tests/lib/Directory/getDirectoryContents001.hs new file mode 100644 index 0000000000..829a9f9df4 --- /dev/null +++ b/ghc/tests/lib/Directory/getDirectoryContents001.hs @@ -0,0 +1,7 @@ +import Directory (getDirectoryContents) +import List (sort, isPrefixOf) + +main = do + names <- getDirectoryContents "." + let names' = filter (isPrefixOf "io009") names + putStrLn (unlines (sort names')) diff --git a/ghc/tests/lib/Directory/getDirectoryContents001.stdout b/ghc/tests/lib/Directory/getDirectoryContents001.stdout new file mode 100644 index 0000000000..55dab93156 --- /dev/null +++ b/ghc/tests/lib/Directory/getDirectoryContents001.stdout @@ -0,0 +1,5 @@ +io009.bin +io009.hs +io009.o +io009.stdout + diff --git a/ghc/tests/lib/Directory/getPermissions001.hs b/ghc/tests/lib/Directory/getPermissions001.hs new file mode 100644 index 0000000000..97faf05d58 --- /dev/null +++ b/ghc/tests/lib/Directory/getPermissions001.hs @@ -0,0 +1,9 @@ +import Directory + +main = do + p <- getPermissions "." + print p + p <- getPermissions "io034.hs" + print p + p <- getPermissions "io034.bin" + print p diff --git a/ghc/tests/lib/Directory/getPermissions001.stdout b/ghc/tests/lib/Directory/getPermissions001.stdout new file mode 100644 index 0000000000..b827957934 --- /dev/null +++ b/ghc/tests/lib/Directory/getPermissions001.stdout @@ -0,0 +1,3 @@ +Permissions{readable=True,writable=True,executable=False,searchable=True} +Permissions{readable=True,writable=True,executable=False,searchable=False} +Permissions{readable=True,writable=True,executable=True,searchable=False} diff --git a/ghc/tests/lib/Directory/getPermissions001.stdout-mingw b/ghc/tests/lib/Directory/getPermissions001.stdout-mingw new file mode 100644 index 0000000000..b200d03aed --- /dev/null +++ b/ghc/tests/lib/Directory/getPermissions001.stdout-mingw @@ -0,0 +1,3 @@ +Permissions{readable=True,writable=True,executable=True,searchable=True} +Permissions{readable=True,writable=True,executable=True,searchable=True} +Permissions{readable=True,writable=True,executable=True,searchable=True} diff --git a/ghc/tests/lib/IO/IOError001.hs b/ghc/tests/lib/IO/IOError001.hs new file mode 100644 index 0000000000..dee7f31e29 --- /dev/null +++ b/ghc/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/ghc/tests/lib/IO/IOError001.stdout b/ghc/tests/lib/IO/IOError001.stdout new file mode 100644 index 0000000000..4a50380db8 --- /dev/null +++ b/ghc/tests/lib/IO/IOError001.stdout @@ -0,0 +1,8 @@ +illegal operation +Action: hGetChar +Handle: {loc=<stdin>,type=semi-closed,buffering=block (8192)} +File: <stdin> +illegal operation +Action: hGetChar +Handle: {loc=<stdin>,type=semi-closed,buffering=block (8192)} +File: <stdin> diff --git a/ghc/tests/lib/IO/IOError001.stdout-mingw b/ghc/tests/lib/IO/IOError001.stdout-mingw new file mode 100644 index 0000000000..f906a77aa7 --- /dev/null +++ b/ghc/tests/lib/IO/IOError001.stdout-mingw @@ -0,0 +1,10 @@ +illegal operation +Action: hGetChar +Handle: {loc=stdin,type=semi-closed,buffering=block (512)} + +Reason: handle is closed +illegal operation +Action: hGetChar +Handle: {loc=stdin,type=semi-closed,buffering=block (512)} + +Reason: handle is closed diff --git a/ghc/tests/lib/IO/Makefile b/ghc/tests/lib/IO/Makefile new file mode 100644 index 0000000000..9d3e242b3a --- /dev/null +++ b/ghc/tests/lib/IO/Makefile @@ -0,0 +1,30 @@ +# ----------------------------------------------------------------------------- +# $Id: Makefile,v 1.1 2001/05/18 16:54:08 simonmar Exp $ + +TOP = ../.. + +include $(TOP)/mk/boilerplate.mk + +ifeq "$(TARGETPLATFORM)" "i386-unknown-mingw32" +# io018 should run +OMITTED_RUNTESTS = io005.run io018.run io033.run +endif + +include $(TOP)/mk/should_run.mk + +SRC_HC_OPTS += -dcore-lint + +hSetBuffering002_RUNTEST_OPTS += -i hSetBuffering002.hs +hSetBuffering003_RUNTEST_OPTS += -i hSetBuffering003.hs +misc001_RUNTEST_OPTS += misc001.hs misc001.out +hGetChar001_RUNTEST_OPTS += -i hGetChar001.stdin +openFile002_RUNTEST_OPTS += -x 1 +IOError001_RUNTEST_OPTS += -o1 IOError001.stdout-mingw +readwrite002_RUNTEST_OPTS += -i readwrite002.hs +hGetLine001_RUNTEST_OPTS += -i hGetLine001.hs + +.PRECIOUS: %.o %.bin + +CLEAN_FILES += *.out* *.inout + +include $(TOP)/mk/target.mk diff --git a/ghc/tests/lib/IO/finalization001.hs b/ghc/tests/lib/IO/finalization001.hs new file mode 100644 index 0000000000..a4b4b28ab2 --- /dev/null +++ b/ghc/tests/lib/IO/finalization001.hs @@ -0,0 +1,27 @@ +--- !!! 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 IO +import System + +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/ghc/tests/lib/IO/finalization001.stdout b/ghc/tests/lib/IO/finalization001.stdout new file mode 100644 index 0000000000..ec04732f97 --- /dev/null +++ b/ghc/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/ghc/tests/lib/IO/hClose001.hs b/ghc/tests/lib/IO/hClose001.hs new file mode 100644 index 0000000000..fe237d33ef --- /dev/null +++ b/ghc/tests/lib/IO/hClose001.hs @@ -0,0 +1,5 @@ +import IO + +main = do + hClose stderr + hPutStr stderr "junk" `catch` \ err -> if isIllegalOperation err then putStr "Okay\n" else error "Not okay\n" diff --git a/ghc/tests/lib/IO/hClose001.stdout b/ghc/tests/lib/IO/hClose001.stdout new file mode 100644 index 0000000000..1ddd42bbe7 --- /dev/null +++ b/ghc/tests/lib/IO/hClose001.stdout @@ -0,0 +1 @@ +Okay diff --git a/ghc/tests/lib/IO/hFileSize001.hs b/ghc/tests/lib/IO/hFileSize001.hs new file mode 100644 index 0000000000..6326425095 --- /dev/null +++ b/ghc/tests/lib/IO/hFileSize001.hs @@ -0,0 +1,8 @@ +import IO + +-- !!! test hFileSize + +main = do + h <- openFile "hFileSize001.hs" ReadMode + sz <- hFileSize h + print sz diff --git a/ghc/tests/lib/IO/hFileSize001.stdout b/ghc/tests/lib/IO/hFileSize001.stdout new file mode 100644 index 0000000000..d136d6a714 --- /dev/null +++ b/ghc/tests/lib/IO/hFileSize001.stdout @@ -0,0 +1 @@ +125 diff --git a/ghc/tests/lib/IO/hFileSize002.hs b/ghc/tests/lib/IO/hFileSize002.hs new file mode 100644 index 0000000000..d2213bfc4a --- /dev/null +++ b/ghc/tests/lib/IO/hFileSize002.hs @@ -0,0 +1,35 @@ +-- !!! Testing IO.hFileSize +module Main(main) where + +import IO +import Directory ( removeFile, doesFileExist ) +import Monad + +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/ghc/tests/lib/IO/hFileSize002.stdout b/ghc/tests/lib/IO/hFileSize002.stdout new file mode 100644 index 0000000000..23dd734048 --- /dev/null +++ b/ghc/tests/lib/IO/hFileSize002.stdout @@ -0,0 +1,5 @@ +-1 +9 +18 +27 +36 diff --git a/ghc/tests/lib/IO/hFlush001.hs b/ghc/tests/lib/IO/hFlush001.hs new file mode 100644 index 0000000000..059b3adc1a --- /dev/null +++ b/ghc/tests/lib/IO/hFlush001.hs @@ -0,0 +1,31 @@ +-- !!! Flushing +module Main(main) where + +import IO +import Directory ( removeFile, doesFileExist ) +import Monad + +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/ghc/tests/lib/IO/hFlush001.stdout b/ghc/tests/lib/IO/hFlush001.stdout new file mode 100644 index 0000000000..0954a7a0b4 --- /dev/null +++ b/ghc/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/ghc/tests/lib/IO/hGetBuffering001.hs b/ghc/tests/lib/IO/hGetBuffering001.hs new file mode 100644 index 0000000000..9b956b0073 --- /dev/null +++ b/ghc/tests/lib/IO/hGetBuffering001.hs @@ -0,0 +1,21 @@ +import 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/ghc/tests/lib/IO/hGetBuffering001.stdout b/ghc/tests/lib/IO/hGetBuffering001.stdout new file mode 100644 index 0000000000..75b9a133d9 --- /dev/null +++ b/ghc/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/ghc/tests/lib/IO/hGetChar001.hs b/ghc/tests/lib/IO/hGetChar001.hs new file mode 100644 index 0000000000..18ba4fe40b --- /dev/null +++ b/ghc/tests/lib/IO/hGetChar001.hs @@ -0,0 +1,18 @@ +import 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/ghc/tests/lib/IO/hGetChar001.stdin b/ghc/tests/lib/IO/hGetChar001.stdin new file mode 100644 index 0000000000..2510fcaec3 --- /dev/null +++ b/ghc/tests/lib/IO/hGetChar001.stdin @@ -0,0 +1,2 @@ +42 +-7 diff --git a/ghc/tests/lib/IO/hGetChar001.stdout b/ghc/tests/lib/IO/hGetChar001.stdout new file mode 100644 index 0000000000..47d4185c64 --- /dev/null +++ b/ghc/tests/lib/IO/hGetChar001.stdout @@ -0,0 +1 @@ +Enter an integer: Enter another integer: Their sum is 35 diff --git a/ghc/tests/lib/IO/hGetLine001.hs b/ghc/tests/lib/IO/hGetLine001.hs new file mode 100644 index 0000000000..cb60e0625b --- /dev/null +++ b/ghc/tests/lib/IO/hGetLine001.hs @@ -0,0 +1,22 @@ +-- !!! testing hGetLine + +import 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 + 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/ghc/tests/lib/IO/hGetLine001.stdout b/ghc/tests/lib/IO/hGetLine001.stdout new file mode 100644 index 0000000000..3ace789b81 --- /dev/null +++ b/ghc/tests/lib/IO/hGetLine001.stdout @@ -0,0 +1,88 @@ +-- !!! testing hGetLine + +import 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 + 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 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 + 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 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 + 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 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 + 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/ghc/tests/lib/IO/hGetPosn001.hs b/ghc/tests/lib/IO/hGetPosn001.hs new file mode 100644 index 0000000000..b952ab87ad --- /dev/null +++ b/ghc/tests/lib/IO/hGetPosn001.hs @@ -0,0 +1,27 @@ +-- !!! Test file positioning + +module Main(main) where + +import IO +import Monad + +import Directory (removeFile, doesFileExist) + +main = do + hIn <- openFile "hGetPosn001.in" ReadMode + f <- doesFileExist "hGetPosn001.out" + when f (removeFile "hGetPosn001.out") + hOut <- openFile "hGetPosn001.out" ReadWriteMode + bof <- hGetPosn hIn + 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/ghc/tests/lib/IO/hGetPosn001.in b/ghc/tests/lib/IO/hGetPosn001.in new file mode 100644 index 0000000000..2e2537150f --- /dev/null +++ b/ghc/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/ghc/tests/lib/IO/hGetPosn001.stdout b/ghc/tests/lib/IO/hGetPosn001.stdout new file mode 100644 index 0000000000..7ac3cc54f0 --- /dev/null +++ b/ghc/tests/lib/IO/hGetPosn001.stdout @@ -0,0 +1,4 @@ +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/ghc/tests/lib/IO/hIsEOF001.hs b/ghc/tests/lib/IO/hIsEOF001.hs new file mode 100644 index 0000000000..b63c1d41db --- /dev/null +++ b/ghc/tests/lib/IO/hIsEOF001.hs @@ -0,0 +1,7 @@ +-- !!! hIsEOF (on stdout) + +import IO ( hIsEOF, stdout ) + +main = do + flg <- hIsEOF stdout `catch` \ _ -> putStrLn "hIsEOF failed" >> return False + print flg diff --git a/ghc/tests/lib/IO/hIsEOF001.stdout b/ghc/tests/lib/IO/hIsEOF001.stdout new file mode 100644 index 0000000000..76460ac50a --- /dev/null +++ b/ghc/tests/lib/IO/hIsEOF001.stdout @@ -0,0 +1,2 @@ +hIsEOF failed +False diff --git a/ghc/tests/lib/IO/hIsEOF002.hs b/ghc/tests/lib/IO/hIsEOF002.hs new file mode 100644 index 0000000000..a12f9b95ce --- /dev/null +++ b/ghc/tests/lib/IO/hIsEOF002.hs @@ -0,0 +1,48 @@ +-- !!! test hIsEOF in various buffering situations + +import 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/ghc/tests/lib/IO/hIsEOF002.stdout b/ghc/tests/lib/IO/hIsEOF002.stdout new file mode 100644 index 0000000000..3aa5e1a64d --- /dev/null +++ b/ghc/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/ghc/tests/lib/IO/hReady001.hs b/ghc/tests/lib/IO/hReady001.hs new file mode 100644 index 0000000000..f31f69d017 --- /dev/null +++ b/ghc/tests/lib/IO/hReady001.hs @@ -0,0 +1,11 @@ +-- !!! hReady test + + -- hReady should probably return False at the end of a file, + -- but in GHC it returns True (known bug). + +import IO + +main = do + h <- openFile "hReady001.hs" ReadMode + hSeek h SeekFromEnd 0 + hReady h >>= print diff --git a/ghc/tests/lib/IO/hSeek001.hs b/ghc/tests/lib/IO/hSeek001.hs new file mode 100644 index 0000000000..a2053a143b --- /dev/null +++ b/ghc/tests/lib/IO/hSeek001.hs @@ -0,0 +1,29 @@ +-- !!! Test seeking + +import 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/ghc/tests/lib/IO/hSeek001.in b/ghc/tests/lib/IO/hSeek001.in new file mode 100644 index 0000000000..e85d5b4528 --- /dev/null +++ b/ghc/tests/lib/IO/hSeek001.in @@ -0,0 +1 @@ +abcdefghijklmnopqrstuvwxyz
\ No newline at end of file diff --git a/ghc/tests/lib/IO/hSeek001.stdout b/ghc/tests/lib/IO/hSeek001.stdout new file mode 100644 index 0000000000..ab6c1d751b --- /dev/null +++ b/ghc/tests/lib/IO/hSeek001.stdout @@ -0,0 +1,7 @@ +z +x +w +z +a +k +z diff --git a/ghc/tests/lib/IO/hSeek002.hs b/ghc/tests/lib/IO/hSeek002.hs new file mode 100644 index 0000000000..a23481f2bf --- /dev/null +++ b/ghc/tests/lib/IO/hSeek002.hs @@ -0,0 +1,24 @@ +-- !!! Testing EOF (and the clearing of it) +module Main(main) where + +import IO +import 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/ghc/tests/lib/IO/hSeek002.stdout b/ghc/tests/lib/IO/hSeek002.stdout new file mode 100644 index 0000000000..8069fe32b0 --- /dev/null +++ b/ghc/tests/lib/IO/hSeek002.stdout @@ -0,0 +1,5 @@ +False +True +False +True +False diff --git a/ghc/tests/lib/IO/hSeek003.hs b/ghc/tests/lib/IO/hSeek003.hs new file mode 100644 index 0000000000..d0ecf92f44 --- /dev/null +++ b/ghc/tests/lib/IO/hSeek003.hs @@ -0,0 +1,50 @@ +-- !!! file positions (hGetPosn and hSetPosn) +module Main(main) where + +import IO +import 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/ghc/tests/lib/IO/hSeek003.stdout b/ghc/tests/lib/IO/hSeek003.stdout new file mode 100644 index 0000000000..7c765c5bc5 --- /dev/null +++ b/ghc/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/ghc/tests/lib/IO/hSeek004.hs b/ghc/tests/lib/IO/hSeek004.hs new file mode 100644 index 0000000000..464fa05bc3 --- /dev/null +++ b/ghc/tests/lib/IO/hSeek004.hs @@ -0,0 +1,7 @@ +-- !!! can't seek an AppendMode handle + +import IO + +main = do + h <- openFile "hSeek004.out" AppendMode + try (hSeek h AbsoluteSeek 0) >>= print diff --git a/ghc/tests/lib/IO/hSeek004.stdout b/ghc/tests/lib/IO/hSeek004.stdout new file mode 100644 index 0000000000..308399259f --- /dev/null +++ b/ghc/tests/lib/IO/hSeek004.stdout @@ -0,0 +1,5 @@ +Left illegal operation +Action: hSeek +Handle: {loc=hSeek004.out,type=writable (append),buffering=block (8192)} +Reason: handle is not seekable +File: hSeek004.out diff --git a/ghc/tests/lib/IO/hSetBuffering002.hs b/ghc/tests/lib/IO/hSetBuffering002.hs new file mode 100644 index 0000000000..396d4353c9 --- /dev/null +++ b/ghc/tests/lib/IO/hSetBuffering002.hs @@ -0,0 +1,6 @@ +import IO + +main = + hSetBuffering stdin NoBuffering >> + hSetBuffering stdout NoBuffering >> + interact id diff --git a/ghc/tests/lib/IO/hSetBuffering002.stdout b/ghc/tests/lib/IO/hSetBuffering002.stdout new file mode 100644 index 0000000000..396d4353c9 --- /dev/null +++ b/ghc/tests/lib/IO/hSetBuffering002.stdout @@ -0,0 +1,6 @@ +import IO + +main = + hSetBuffering stdin NoBuffering >> + hSetBuffering stdout NoBuffering >> + interact id diff --git a/ghc/tests/lib/IO/hSetBuffering003.hs b/ghc/tests/lib/IO/hSetBuffering003.hs new file mode 100644 index 0000000000..424be16465 --- /dev/null +++ b/ghc/tests/lib/IO/hSetBuffering003.hs @@ -0,0 +1,79 @@ +-- !!! Reconfiguring the buffering of a handle +module Main(main) where + +import 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/ghc/tests/lib/IO/hSetBuffering003.stderr b/ghc/tests/lib/IO/hSetBuffering003.stderr new file mode 100644 index 0000000000..a4cf8779b4 --- /dev/null +++ b/ghc/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/ghc/tests/lib/IO/hSetBuffering003.stdout b/ghc/tests/lib/IO/hSetBuffering003.stdout new file mode 100644 index 0000000000..7768773198 --- /dev/null +++ b/ghc/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/ghc/tests/lib/IO/ioeGetErrorString001.hs b/ghc/tests/lib/IO/ioeGetErrorString001.hs new file mode 100644 index 0000000000..b2f84f6a11 --- /dev/null +++ b/ghc/tests/lib/IO/ioeGetErrorString001.hs @@ -0,0 +1,12 @@ +-- !!! test ioeGetErrorString + +import IO +import 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/ghc/tests/lib/IO/ioeGetErrorString001.stdout b/ghc/tests/lib/IO/ioeGetErrorString001.stdout new file mode 100644 index 0000000000..0b8daea55a --- /dev/null +++ b/ghc/tests/lib/IO/ioeGetErrorString001.stdout @@ -0,0 +1 @@ +"end of file" diff --git a/ghc/tests/lib/IO/ioeGetFileName001.hs b/ghc/tests/lib/IO/ioeGetFileName001.hs new file mode 100644 index 0000000000..73434bb7e4 --- /dev/null +++ b/ghc/tests/lib/IO/ioeGetFileName001.hs @@ -0,0 +1,11 @@ +-- !!! test ioeGetFileName + +import IO + +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/ghc/tests/lib/IO/ioeGetFileName001.stdout b/ghc/tests/lib/IO/ioeGetFileName001.stdout new file mode 100644 index 0000000000..7377ad409d --- /dev/null +++ b/ghc/tests/lib/IO/ioeGetFileName001.stdout @@ -0,0 +1 @@ +Just "ioeGetFileName001.hs" diff --git a/ghc/tests/lib/IO/ioeGetHandle001.hs b/ghc/tests/lib/IO/ioeGetHandle001.hs new file mode 100644 index 0000000000..0d041e0591 --- /dev/null +++ b/ghc/tests/lib/IO/ioeGetHandle001.hs @@ -0,0 +1,12 @@ +-- !!! test ioeGetHandle + +import IO +import 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/ghc/tests/lib/IO/ioeGetHandle001.stdout b/ghc/tests/lib/IO/ioeGetHandle001.stdout new file mode 100644 index 0000000000..90b5016eff --- /dev/null +++ b/ghc/tests/lib/IO/ioeGetHandle001.stdout @@ -0,0 +1 @@ +ok. diff --git a/ghc/tests/lib/IO/isEOF001.hs b/ghc/tests/lib/IO/isEOF001.hs new file mode 100644 index 0000000000..c5f552f6b7 --- /dev/null +++ b/ghc/tests/lib/IO/isEOF001.hs @@ -0,0 +1,3 @@ +import IO + +main = isEOF >>= print diff --git a/ghc/tests/lib/IO/isEOF001.stdout b/ghc/tests/lib/IO/isEOF001.stdout new file mode 100644 index 0000000000..0ca95142bb --- /dev/null +++ b/ghc/tests/lib/IO/isEOF001.stdout @@ -0,0 +1 @@ +True diff --git a/ghc/tests/lib/IO/misc001.hs b/ghc/tests/lib/IO/misc001.hs new file mode 100644 index 0000000000..c536f7d03a --- /dev/null +++ b/ghc/tests/lib/IO/misc001.hs @@ -0,0 +1,24 @@ +import IO + +import System (getArgs) +import Char (toUpper) +import Directory (removeFile, doesFileExist) + +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/ghc/tests/lib/IO/misc001.stdout b/ghc/tests/lib/IO/misc001.stdout new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/tests/lib/IO/misc001.stdout diff --git a/ghc/tests/lib/IO/openFile001.hs b/ghc/tests/lib/IO/openFile001.hs new file mode 100644 index 0000000000..02e14034aa --- /dev/null +++ b/ghc/tests/lib/IO/openFile001.hs @@ -0,0 +1,10 @@ +-- !!! test that a file opened in ReadMode can't be written to + +import IO + +main = do + hIn <- openFile "openFile001.hs" ReadMode + hPutStr hIn "test" `catch` \ err -> + if isIllegalOperation err + then putStrLn "ok." + else error "Oh dear\n" diff --git a/ghc/tests/lib/IO/openFile001.stdout b/ghc/tests/lib/IO/openFile001.stdout new file mode 100644 index 0000000000..90b5016eff --- /dev/null +++ b/ghc/tests/lib/IO/openFile001.stdout @@ -0,0 +1 @@ +ok. diff --git a/ghc/tests/lib/IO/openFile002.hs b/ghc/tests/lib/IO/openFile002.hs new file mode 100644 index 0000000000..70d2a7ddd6 --- /dev/null +++ b/ghc/tests/lib/IO/openFile002.hs @@ -0,0 +1,6 @@ +import Char +import IO + +-- !!! Open a non-existent file for reading (should fail) + +main = openFile "<nonexistent>" ReadMode diff --git a/ghc/tests/lib/IO/openFile002.stderr b/ghc/tests/lib/IO/openFile002.stderr new file mode 100644 index 0000000000..f40db1ed2d --- /dev/null +++ b/ghc/tests/lib/IO/openFile002.stderr @@ -0,0 +1,6 @@ + +Fail: does not exist +Action: openFile +Reason: No such file or directory +File: <nonexistent> + diff --git a/ghc/tests/lib/IO/openFile003.hs b/ghc/tests/lib/IO/openFile003.hs new file mode 100644 index 0000000000..77900f04c1 --- /dev/null +++ b/ghc/tests/lib/IO/openFile003.hs @@ -0,0 +1,13 @@ +import IO + +-- !!! Open a directory (should fail) + +main = do + r <- try (openFile "." ReadMode) + print r + r <- try (openFile "." WriteMode) + print r + r <- try (openFile "." AppendMode) + print r + r <- try (openFile "." ReadWriteMode) + print r diff --git a/ghc/tests/lib/IO/openFile003.stdout b/ghc/tests/lib/IO/openFile003.stdout new file mode 100644 index 0000000000..eb69ce3f0a --- /dev/null +++ b/ghc/tests/lib/IO/openFile003.stdout @@ -0,0 +1,16 @@ +Left inappropriate type +Action: openFile +Reason: is a directory +File: . +Left inappropriate type +Action: openFile +Reason: Is a directory +File: . +Left inappropriate type +Action: openFile +Reason: Is a directory +File: . +Left inappropriate type +Action: openFile +Reason: Is a directory +File: . diff --git a/ghc/tests/lib/IO/openFile004.hs b/ghc/tests/lib/IO/openFile004.hs new file mode 100644 index 0000000000..da6443f014 --- /dev/null +++ b/ghc/tests/lib/IO/openFile004.hs @@ -0,0 +1,23 @@ +-- !!! Open a non-existent file for writing + +import Char +import IO +import Directory +import Monad + +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/ghc/tests/lib/IO/openFile004.stdout b/ghc/tests/lib/IO/openFile004.stdout new file mode 100644 index 0000000000..3b18e512db --- /dev/null +++ b/ghc/tests/lib/IO/openFile004.stdout @@ -0,0 +1 @@ +hello world diff --git a/ghc/tests/lib/IO/openFile005.hs b/ghc/tests/lib/IO/openFile005.hs new file mode 100644 index 0000000000..fd2dfa8c41 --- /dev/null +++ b/ghc/tests/lib/IO/openFile005.hs @@ -0,0 +1,44 @@ +-- !!! test multiple-reader single-writer locking semantics + +import IO + +file1 = "openFile005.out1" +file2 = "openFile005.out2" + +main = do + -- two writes (should fail) + h <- openFile file1 WriteMode + try (openFile file1 WriteMode) >>= print + hClose h + + -- write and an append (should fail) + h <- openFile file1 WriteMode + try (openFile file1 AppendMode) >>= print + hClose h + + -- read/write and a write (should fail) + h <- openFile file1 ReadWriteMode + try (openFile file1 WriteMode) >>= print + hClose h + + -- read and a read/write (should fail) + h <- openFile file1 ReadMode + try (openFile file1 ReadWriteMode) >>= print + hClose h + + -- write and a read (should fail) + h <- openFile file1 WriteMode + try (openFile file1 ReadMode) >>= print + hClose h + + -- two writes, different files (silly, but should succeed) + h1 <- openFile file1 WriteMode + h2 <- openFile file2 WriteMode + hClose h1 + hClose h2 + + -- two reads, should succeed + h1 <- openFile file1 ReadMode + h2 <- openFile file1 ReadMode + hClose h1 + hClose h2 diff --git a/ghc/tests/lib/IO/openFile005.stdout b/ghc/tests/lib/IO/openFile005.stdout new file mode 100644 index 0000000000..6899c848df --- /dev/null +++ b/ghc/tests/lib/IO/openFile005.stdout @@ -0,0 +1,20 @@ +Left resource busy +Action: openFile +Reason: file is locked +File: openFile005.out1 +Left resource busy +Action: openFile +Reason: file is locked +File: openFile005.out1 +Left resource busy +Action: openFile +Reason: file is locked +File: openFile005.out1 +Left resource busy +Action: openFile +Reason: file is locked +File: openFile005.out1 +Left resource busy +Action: openFile +Reason: file is locked +File: openFile005.out1 diff --git a/ghc/tests/lib/IO/openFile006.hs b/ghc/tests/lib/IO/openFile006.hs new file mode 100644 index 0000000000..9a91886053 --- /dev/null +++ b/ghc/tests/lib/IO/openFile006.hs @@ -0,0 +1,14 @@ +-- !!! opening a file in WriteMode better truncate it + +import IO + +main = do + h <- openFile "openFile006.out" AppendMode + hPutStrLn h "hello, world" + size <- hFileSize h + print size + hClose h + + h <- openFile "openFile006.out" WriteMode + size <- hFileSize h + print size diff --git a/ghc/tests/lib/IO/openFile006.stdout b/ghc/tests/lib/IO/openFile006.stdout new file mode 100644 index 0000000000..33a9dbad99 --- /dev/null +++ b/ghc/tests/lib/IO/openFile006.stdout @@ -0,0 +1,2 @@ +13 +0 diff --git a/ghc/tests/lib/IO/putStr001.hs b/ghc/tests/lib/IO/putStr001.hs new file mode 100644 index 0000000000..48b3add3f3 --- /dev/null +++ b/ghc/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/ghc/tests/lib/IO/putStr001.stdout b/ghc/tests/lib/IO/putStr001.stdout new file mode 100644 index 0000000000..a5c1966771 --- /dev/null +++ b/ghc/tests/lib/IO/putStr001.stdout @@ -0,0 +1 @@ +Hello, world diff --git a/ghc/tests/lib/IO/readwrite001.hs b/ghc/tests/lib/IO/readwrite001.hs new file mode 100644 index 0000000000..69b41ca50b --- /dev/null +++ b/ghc/tests/lib/IO/readwrite001.hs @@ -0,0 +1,22 @@ +-- !!! RW files +module Main(main) where + +import IO +import Directory ( removeFile, doesFileExist ) +import 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/ghc/tests/lib/IO/readwrite001.stdout b/ghc/tests/lib/IO/readwrite001.stdout new file mode 100644 index 0000000000..e33ba0613d --- /dev/null +++ b/ghc/tests/lib/IO/readwrite001.stdout @@ -0,0 +1,3 @@ +'a' + +aase diff --git a/ghc/tests/lib/IO/readwrite002.hs b/ghc/tests/lib/IO/readwrite002.hs new file mode 100644 index 0000000000..3257cd6be0 --- /dev/null +++ b/ghc/tests/lib/IO/readwrite002.hs @@ -0,0 +1,40 @@ +-- !!! Testing RW handles +import IO +import Directory (removeFile, doesFileExist) +import Monad + +-- 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 +-- hSetBinaryMode cd True + 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 + 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/ghc/tests/lib/IO/readwrite002.stdout b/ghc/tests/lib/IO/readwrite002.stdout new file mode 100644 index 0000000000..9aed0284d7 --- /dev/null +++ b/ghc/tests/lib/IO/readwrite002.stdout @@ -0,0 +1,9 @@ +############### + +Caught EOF +############### + +Caught EOF +############### + +Caught EOF diff --git a/ghc/tests/lib/IOExts/echo001.hs b/ghc/tests/lib/IOExts/echo001.hs new file mode 100644 index 0000000000..a00ca35286 --- /dev/null +++ b/ghc/tests/lib/IOExts/echo001.hs @@ -0,0 +1,14 @@ +module Main(main) where + +import IO +import IOExts +import Char + +main = do + isT <- hIsTerminalDevice stdin + flg <- if not isT then return False else hGetEcho stdin + print flg + if not isT then hSetEcho stdin False else return () + hSetBuffering stdin NoBuffering + interact (map toUpper) + diff --git a/ghc/tests/lib/IOExts/echo001.stdout b/ghc/tests/lib/IOExts/echo001.stdout new file mode 100644 index 0000000000..73f06fdb1c --- /dev/null +++ b/ghc/tests/lib/IOExts/echo001.stdout @@ -0,0 +1,15 @@ +False +MODULE MAIN(MAIN) WHERE + +IMPORT IO +IMPORT IOEXTS +IMPORT CHAR + +MAIN = DO + IST <- HISTERMINALDEVICE STDIN + FLG <- IF NOT IST THEN RETURN FALSE ELSE HGETECHO STDIN + PRINT FLG + IF NOT IST THEN HSETECHO STDIN FALSE ELSE RETURN () + HSETBUFFERING STDIN NOBUFFERING + INTERACT (MAP TOUPPER) + diff --git a/ghc/tests/lib/IOExts/trace001.hs b/ghc/tests/lib/IOExts/trace001.hs new file mode 100644 index 0000000000..5e340e056a --- /dev/null +++ b/ghc/tests/lib/IOExts/trace001.hs @@ -0,0 +1,10 @@ +import IO +import IOExts + +main = do + hPutStr stderr + (trace (trace (trace (trace (trace (trace (trace + "one" "fish") "two") "fish") "red") "fish") "blue") "fish") + hPutStr stdout + (trace (trace (trace (trace (trace (trace (trace + "one" "fish") "two") "fish") "red") "fish") "blue") "fish") diff --git a/ghc/tests/lib/IOExts/trace001.stderr b/ghc/tests/lib/IOExts/trace001.stderr new file mode 100644 index 0000000000..3b8ac7ae24 --- /dev/null +++ b/ghc/tests/lib/IOExts/trace001.stderr @@ -0,0 +1,14 @@ +one +fish +two +fish +red +fish +blue +fishone +fish +two +fish +red +fish +blue diff --git a/ghc/tests/lib/IOExts/trace001.stdout b/ghc/tests/lib/IOExts/trace001.stdout new file mode 100644 index 0000000000..5b19477993 --- /dev/null +++ b/ghc/tests/lib/IOExts/trace001.stdout @@ -0,0 +1 @@ +fish
\ No newline at end of file diff --git a/ghc/tests/lib/System/Makefile b/ghc/tests/lib/System/Makefile new file mode 100644 index 0000000000..9947e9902b --- /dev/null +++ b/ghc/tests/lib/System/Makefile @@ -0,0 +1,35 @@ +TOP = ../.. + +include $(TOP)/mk/boilerplate.mk + +ifeq "$(TARGETPLATFORM)" "i386-unknown-mingw32" +# io018 should run +OMITTED_RUNTESTS = io005.run io018.run io033.run +endif + +include $(TOP)/mk/should_run.mk + +SRC_HC_OPTS += -dcore-lint +io010_HC_OPTS += -fglasgow-exts +io011_HC_OPTS += -fglasgow-exts -package lang +io018_HC_OPTS += -fglasgow-exts -package lang +io022_HC_OPTS += -fglasgow-exts -package lang +io032_HC_OPTS += -fglasgow-exts -package lang +io035_HC_OPTS += -package lang + +io003_RUNTEST_OPTS += -o1 io003.stdout-mingw +io004_RUNTEST_OPTS += -x 42 +io016_RUNTEST_OPTS += io016.hs io016.out +io017_RUNTEST_OPTS += -i io017.stdin +io018_RUNTEST_OPTS += -i io018.hs +io021_RUNTEST_OPTS += -i io021.hs +io022_RUNTEST_OPTS += -i io022.hs +io028_RUNTEST_OPTS += -i io028.hs +io034_RUNTEST_OPTS += -o1 io034.stdout-mingw +io035_RUNTEST_OPTS += -o1 io035.stdout-mingw + +.PRECIOUS: %.o %.bin + +CLEAN_FILES += *.out *.inout + +include $(TOP)/mk/target.mk diff --git a/ghc/tests/lib/System/exitWith001.hs b/ghc/tests/lib/System/exitWith001.hs new file mode 100644 index 0000000000..69d2221743 --- /dev/null +++ b/ghc/tests/lib/System/exitWith001.hs @@ -0,0 +1,3 @@ +import System (exitWith, ExitCode(..)) + +main = exitWith (ExitFailure 42) diff --git a/ghc/tests/lib/System/exitWith001.stdout b/ghc/tests/lib/System/exitWith001.stdout new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/tests/lib/System/exitWith001.stdout diff --git a/ghc/tests/lib/System/getArgs001.hs b/ghc/tests/lib/System/getArgs001.hs new file mode 100644 index 0000000000..93fff71be5 --- /dev/null +++ b/ghc/tests/lib/System/getArgs001.hs @@ -0,0 +1,9 @@ +import System (getProgName, getArgs) + +main = + getProgName >>= \ argv0 -> + putStr argv0 >> + getArgs >>= \ argv -> + sequence (map (\ x -> putChar ' ' >> putStr x) argv) >> + putChar '\n' + diff --git a/ghc/tests/lib/System/getArgs001.stdout b/ghc/tests/lib/System/getArgs001.stdout new file mode 100644 index 0000000000..3d23060901 --- /dev/null +++ b/ghc/tests/lib/System/getArgs001.stdout @@ -0,0 +1 @@ +io003.bin diff --git a/ghc/tests/lib/System/getArgs001.stdout-mingw b/ghc/tests/lib/System/getArgs001.stdout-mingw new file mode 100644 index 0000000000..ef48076a32 --- /dev/null +++ b/ghc/tests/lib/System/getArgs001.stdout-mingw @@ -0,0 +1 @@ +C:\TEMP\fptools-head\fptools\ghc\tests\io\should_run\io003.bin diff --git a/ghc/tests/lib/System/getEnv001.hs b/ghc/tests/lib/System/getEnv001.hs new file mode 100644 index 0000000000..e06fe6c776 --- /dev/null +++ b/ghc/tests/lib/System/getEnv001.hs @@ -0,0 +1,15 @@ +import System (getEnv) + +import IO ( isDoesNotExistError ) + +main :: IO () +main = do + term <- getEnv "TERM" + putStrLn "Got $TERM" + fish <- getEnv "One fish, two fish, red fish, blue fish" `catch` getEnv_except + putStrLn fish + +getEnv_except :: IOError -> IO String +getEnv_except ioe + | isDoesNotExistError ioe = return "" + | otherwise = ioError ioe diff --git a/ghc/tests/lib/System/getEnv001.stdout b/ghc/tests/lib/System/getEnv001.stdout new file mode 100644 index 0000000000..da3acde026 --- /dev/null +++ b/ghc/tests/lib/System/getEnv001.stdout @@ -0,0 +1,2 @@ +Got $TERM + diff --git a/ghc/tests/lib/System/system001.hs b/ghc/tests/lib/System/system001.hs new file mode 100644 index 0000000000..ac12847e52 --- /dev/null +++ b/ghc/tests/lib/System/system001.hs @@ -0,0 +1,13 @@ +-- Not run on mingw, because of /dev/null use + +import System (system, ExitCode(..), exitWith) + +main = + system "cat dog 1>/dev/null 2>&1" >>= \ ec -> + case ec of + ExitSuccess -> putStr "What?!?\n" >> ioError (userError "dog succeeded") + ExitFailure _ -> + system "cat io005.hs 2>/dev/null" >>= \ ec -> + case ec of + ExitSuccess -> exitWith ExitSuccess + ExitFailure _ -> putStr "What?!?\n" >> ioError (userError "cat failed") diff --git a/ghc/tests/lib/System/system001.stdout b/ghc/tests/lib/System/system001.stdout new file mode 100644 index 0000000000..ac12847e52 --- /dev/null +++ b/ghc/tests/lib/System/system001.stdout @@ -0,0 +1,13 @@ +-- Not run on mingw, because of /dev/null use + +import System (system, ExitCode(..), exitWith) + +main = + system "cat dog 1>/dev/null 2>&1" >>= \ ec -> + case ec of + ExitSuccess -> putStr "What?!?\n" >> ioError (userError "dog succeeded") + ExitFailure _ -> + system "cat io005.hs 2>/dev/null" >>= \ ec -> + case ec of + ExitSuccess -> exitWith ExitSuccess + ExitFailure _ -> putStr "What?!?\n" >> ioError (userError "cat failed") diff --git a/ghc/tests/lib/should_run/time001.hs b/ghc/tests/lib/Time/time001.hs index 30c7280d37..30c7280d37 100644 --- a/ghc/tests/lib/should_run/time001.hs +++ b/ghc/tests/lib/Time/time001.hs diff --git a/ghc/tests/lib/should_run/time001.stdout b/ghc/tests/lib/Time/time001.stdout index c2e987e94e..c2e987e94e 100644 --- a/ghc/tests/lib/should_run/time001.stdout +++ b/ghc/tests/lib/Time/time001.stdout diff --git a/ghc/tests/lib/should_run/time002.hs b/ghc/tests/lib/Time/time002.hs index d3c3e42ad3..d3c3e42ad3 100644 --- a/ghc/tests/lib/should_run/time002.hs +++ b/ghc/tests/lib/Time/time002.hs diff --git a/ghc/tests/lib/should_run/time002.stdout b/ghc/tests/lib/Time/time002.stdout index 587579af91..587579af91 100644 --- a/ghc/tests/lib/should_run/time002.stdout +++ b/ghc/tests/lib/Time/time002.stdout diff --git a/ghc/tests/lib/Time/time003.hs b/ghc/tests/lib/Time/time003.hs new file mode 100644 index 0000000000..ac2c72dfd4 --- /dev/null +++ b/ghc/tests/lib/Time/time003.hs @@ -0,0 +1,24 @@ +import Time + +main :: IO () +main = do + time <- getClockTime + let l = length (show time) + print (l == 28 || l == 29) -- "CEST" vs "UTC" vs "GMT" vs... + let (CalendarTime year month mday hour min sec psec + wday yday timezone gmtoff isdst) = toUTCTime time + time2 = wdays !! fromEnum wday ++ + (' ' : months !! fromEnum month) ++ + (' ' : shows2 mday (' ' : shows2 hour (':' : shows2 min (':' : shows2 sec + (' ' : timezone ++ ' ' : shows year "\n"))))) + l2 = length time2 + print (l == 28 || l == 29) + + where + wdays = ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"] + months = ["Jan", "Feb", "Mar", "Apr", "May", "Jun", + "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"] + shows2 x = showString (pad2 x) + pad2 x = case show x of + c@[_] -> '0' : c + cs -> cs diff --git a/ghc/tests/lib/Time/time003.stdout b/ghc/tests/lib/Time/time003.stdout new file mode 100644 index 0000000000..dbde422651 --- /dev/null +++ b/ghc/tests/lib/Time/time003.stdout @@ -0,0 +1,2 @@ +True +True diff --git a/ghc/tests/lib/Time/time004.hs b/ghc/tests/lib/Time/time004.hs new file mode 100644 index 0000000000..31fd567689 --- /dev/null +++ b/ghc/tests/lib/Time/time004.hs @@ -0,0 +1,10 @@ +import Time + +main :: IO () +main = do + time <- getClockTime + let (CalendarTime year month mday hour min sec psec + wday yday timezone gmtoff isdst) = toUTCTime time + time' = toClockTime (CalendarTime (year - 1) month mday hour min sec psec + wday yday timezone gmtoff isdst) + print (length (show time) == length (show time')) diff --git a/ghc/tests/lib/Time/time004.stdout b/ghc/tests/lib/Time/time004.stdout new file mode 100644 index 0000000000..0ca95142bb --- /dev/null +++ b/ghc/tests/lib/Time/time004.stdout @@ -0,0 +1 @@ +True |