diff options
Diffstat (limited to 'testsuite/tests/lib/IOExts')
21 files changed, 371 insertions, 0 deletions
diff --git a/testsuite/tests/lib/IOExts/Makefile b/testsuite/tests/lib/IOExts/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/lib/IOExts/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/lib/IOExts/all.T b/testsuite/tests/lib/IOExts/all.T new file mode 100644 index 0000000000..518c8cccbd --- /dev/null +++ b/testsuite/tests/lib/IOExts/all.T @@ -0,0 +1,15 @@ +test('echo001', set_stdin("echo001.hs"), compile_and_run, ['']) + +test('hTell001', normal, compile_and_run, ['']) + +test('hTell002', normal, compile_and_run, ['']) + +test('performGC001', normal, compile_and_run, ['']) + +# optimisation screws up this test because some of the traces get commoned up +test('trace001', normal, compile_and_run, ['']) + +test('hGetBuf002', normal, compile_and_run, ['']) +test('hGetBuf003', normal, compile_and_run, ['']) +test('hPutBuf001', normal, compile_and_run, ['']) +test('hPutBuf002', extra_clean(['hPutBuf002.out']), compile_and_run, ['']) diff --git a/testsuite/tests/lib/IOExts/echo001.hs b/testsuite/tests/lib/IOExts/echo001.hs new file mode 100644 index 0000000000..7c803589bf --- /dev/null +++ b/testsuite/tests/lib/IOExts/echo001.hs @@ -0,0 +1,13 @@ +module Main(main) where + +import System.IO +import Data.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/testsuite/tests/lib/IOExts/echo001.stdout b/testsuite/tests/lib/IOExts/echo001.stdout new file mode 100644 index 0000000000..a9d7699954 --- /dev/null +++ b/testsuite/tests/lib/IOExts/echo001.stdout @@ -0,0 +1,14 @@ +False +MODULE MAIN(MAIN) WHERE + +IMPORT SYSTEM.IO +IMPORT DATA.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/testsuite/tests/lib/IOExts/hGetBuf002.hs b/testsuite/tests/lib/IOExts/hGetBuf002.hs new file mode 100644 index 0000000000..525eeb8e36 --- /dev/null +++ b/testsuite/tests/lib/IOExts/hGetBuf002.hs @@ -0,0 +1,22 @@ +import System.IO +import Foreign +import Foreign.C + +main = do test True; test False + +test blocking = do + h <- openBinaryFile "hGetBuf002.hs" ReadMode + + let sz = 42 + loop = do + b <- allocaBytes sz $ \ptr -> do + r <- (if blocking then hGetBuf else hGetBufNonBlocking) h ptr sz + if (r == 0) + then return True + else do s <- peekCStringLen (ptr,r) + putStr s + return False + if b then return () else loop -- tail call + + loop + diff --git a/testsuite/tests/lib/IOExts/hGetBuf002.stdout b/testsuite/tests/lib/IOExts/hGetBuf002.stdout new file mode 100644 index 0000000000..9cbe498c5c --- /dev/null +++ b/testsuite/tests/lib/IOExts/hGetBuf002.stdout @@ -0,0 +1,44 @@ +import System.IO +import Foreign +import Foreign.C + +main = do test True; test False + +test blocking = do + h <- openBinaryFile "hGetBuf002.hs" ReadMode + + let sz = 42 + loop = do + b <- allocaBytes sz $ \ptr -> do + r <- (if blocking then hGetBuf else hGetBufNonBlocking) h ptr sz + if (r == 0) + then return True + else do s <- peekCStringLen (ptr,r) + putStr s + return False + if b then return () else loop -- tail call + + loop + +import System.IO +import Foreign +import Foreign.C + +main = do test True; test False + +test blocking = do + h <- openBinaryFile "hGetBuf002.hs" ReadMode + + let sz = 42 + loop = do + b <- allocaBytes sz $ \ptr -> do + r <- (if blocking then hGetBuf else hGetBufNonBlocking) h ptr sz + if (r == 0) + then return True + else do s <- peekCStringLen (ptr,r) + putStr s + return False + if b then return () else loop -- tail call + + loop + diff --git a/testsuite/tests/lib/IOExts/hGetBuf003.hs b/testsuite/tests/lib/IOExts/hGetBuf003.hs new file mode 100644 index 0000000000..6eefdf90e8 --- /dev/null +++ b/testsuite/tests/lib/IOExts/hGetBuf003.hs @@ -0,0 +1,26 @@ +import System.IO +import Foreign +import Foreign.C +import Control.Monad + +main = do test True; test False + +test blocking = do + h <- openBinaryFile "hGetBuf003.hs" ReadMode + + let sz = 42 + loop = do + -- mix ordinary char buffering with hGetBuf + eof <- hIsEOF h + when (not eof) $ hGetChar h >>= putChar + b <- allocaBytes sz $ \ptr -> do + r <- (if blocking then hGetBuf else hGetBufNonBlocking) h ptr sz + if (r == 0) + then return True + else do s <- peekCStringLen (ptr,r) + putStr s + return False + if b then return () else loop -- tail call + + loop + diff --git a/testsuite/tests/lib/IOExts/hGetBuf003.stdout b/testsuite/tests/lib/IOExts/hGetBuf003.stdout new file mode 100644 index 0000000000..ffeb291563 --- /dev/null +++ b/testsuite/tests/lib/IOExts/hGetBuf003.stdout @@ -0,0 +1,52 @@ +import System.IO +import Foreign +import Foreign.C +import Control.Monad + +main = do test True; test False + +test blocking = do + h <- openBinaryFile "hGetBuf003.hs" ReadMode + + let sz = 42 + loop = do + -- mix ordinary char buffering with hGetBuf + eof <- hIsEOF h + when (not eof) $ hGetChar h >>= putChar + b <- allocaBytes sz $ \ptr -> do + r <- (if blocking then hGetBuf else hGetBufNonBlocking) h ptr sz + if (r == 0) + then return True + else do s <- peekCStringLen (ptr,r) + putStr s + return False + if b then return () else loop -- tail call + + loop + +import System.IO +import Foreign +import Foreign.C +import Control.Monad + +main = do test True; test False + +test blocking = do + h <- openBinaryFile "hGetBuf003.hs" ReadMode + + let sz = 42 + loop = do + -- mix ordinary char buffering with hGetBuf + eof <- hIsEOF h + when (not eof) $ hGetChar h >>= putChar + b <- allocaBytes sz $ \ptr -> do + r <- (if blocking then hGetBuf else hGetBufNonBlocking) h ptr sz + if (r == 0) + then return True + else do s <- peekCStringLen (ptr,r) + putStr s + return False + if b then return () else loop -- tail call + + loop + diff --git a/testsuite/tests/lib/IOExts/hPutBuf001.hs b/testsuite/tests/lib/IOExts/hPutBuf001.hs new file mode 100644 index 0000000000..fa7e076d41 --- /dev/null +++ b/testsuite/tests/lib/IOExts/hPutBuf001.hs @@ -0,0 +1,7 @@ +import System.IO +import Foreign +import Foreign.C + +main = do + hSetBinaryMode stdout True + withCStringLen "hello world\n" $ \(ptr,len) -> hPutBuf stdout ptr len diff --git a/testsuite/tests/lib/IOExts/hPutBuf001.stdout b/testsuite/tests/lib/IOExts/hPutBuf001.stdout new file mode 100644 index 0000000000..3b18e512db --- /dev/null +++ b/testsuite/tests/lib/IOExts/hPutBuf001.stdout @@ -0,0 +1 @@ +hello world diff --git a/testsuite/tests/lib/IOExts/hPutBuf002.hs b/testsuite/tests/lib/IOExts/hPutBuf002.hs new file mode 100644 index 0000000000..a7ea2eed03 --- /dev/null +++ b/testsuite/tests/lib/IOExts/hPutBuf002.hs @@ -0,0 +1,9 @@ +import System.IO +import Foreign +import Foreign.C + +-- !!! this test failed to write anything in GHC 5.00.2 +main = do + h <- openBinaryFile "hPutBuf002.out" ReadWriteMode + withCStringLen "hello world\n" $ \(ptr,len) -> hPutBuf h ptr len + hFileSize h >>= print diff --git a/testsuite/tests/lib/IOExts/hPutBuf002.stdout b/testsuite/tests/lib/IOExts/hPutBuf002.stdout new file mode 100644 index 0000000000..48082f72f0 --- /dev/null +++ b/testsuite/tests/lib/IOExts/hPutBuf002.stdout @@ -0,0 +1 @@ +12 diff --git a/testsuite/tests/lib/IOExts/hTell001.hs b/testsuite/tests/lib/IOExts/hTell001.hs new file mode 100644 index 0000000000..6b26eecb97 --- /dev/null +++ b/testsuite/tests/lib/IOExts/hTell001.hs @@ -0,0 +1,63 @@ +-- !!! Testing hGetPosn and hSetPosn +module Main(main) where + +import System.IO + +getPosnAndPrint h = do + x <- hTell h + v <- hGetChar h + putStrLn ("At position: " ++ show x ++ ", found: " ++ show v) + return x + +recordDoAndRepos h a = do + x <- getPosnAndPrint h + a + hSeek h AbsoluteSeek x + getPosnAndPrint h + return () + +recordDoAndRepos2 h a = do + x <- getPosnAndPrint h + a + hSeek h AbsoluteSeek x + getPosnAndPrint h + return () + +recordDoAndRepos3 h a = do + x <- getPosnAndPrint h + a + hSeek h SeekFromEnd (negate (x + 1)) + getPosnAndPrint h + return () + +file = "hTell001.hs" + +main :: IO () +main = do + h <- openBinaryFile file ReadMode + recordDoAndRepos h $ + recordDoAndRepos h $ + recordDoAndRepos h $ + recordDoAndRepos h $ + recordDoAndRepos h $ + putStrLn "" + hClose h + putStrLn "\nUsing hSeek/AbsoluteSeek: " + h <- openBinaryFile file ReadMode + recordDoAndRepos2 h $ + recordDoAndRepos2 h $ + recordDoAndRepos2 h $ + recordDoAndRepos2 h $ + recordDoAndRepos2 h $ + putStrLn "" + + hClose h + putStrLn "\nUsing hSeek/SeekFromEnd: " + putStrLn "(Don't worry if you're seeing differing numbers here, it might be down to '\\n' vs '\\r\\n')" + h <- openBinaryFile file ReadMode + recordDoAndRepos3 h $ + recordDoAndRepos3 h $ + recordDoAndRepos3 h $ + recordDoAndRepos3 h $ + recordDoAndRepos3 h $ + putStrLn "" diff --git a/testsuite/tests/lib/IOExts/hTell001.stdout b/testsuite/tests/lib/IOExts/hTell001.stdout new file mode 100644 index 0000000000..7e22e69a93 --- /dev/null +++ b/testsuite/tests/lib/IOExts/hTell001.stdout @@ -0,0 +1,38 @@ +At position: 0, found: '-' +At position: 1, found: '-' +At position: 2, found: ' ' +At position: 3, found: '!' +At position: 4, found: '!' + +At position: 4, found: '!' +At position: 3, found: '!' +At position: 2, found: ' ' +At position: 1, found: '-' +At position: 0, found: '-' + +Using hSeek/AbsoluteSeek: +At position: 0, found: '-' +At position: 1, found: '-' +At position: 2, found: ' ' +At position: 3, found: '!' +At position: 4, found: '!' + +At position: 4, found: '!' +At position: 3, found: '!' +At position: 2, found: ' ' +At position: 1, found: '-' +At position: 0, found: '-' + +Using hSeek/SeekFromEnd: +(Don't worry if you're seeing differing numbers here, it might be down to '\n' vs '\r\n') +At position: 0, found: '-' +At position: 1, found: '-' +At position: 2, found: ' ' +At position: 3, found: '!' +At position: 4, found: '!' + +At position: 1376, found: 'n' +At position: 1377, found: ' ' +At position: 1378, found: '"' +At position: 1379, found: '"' +At position: 1380, found: '\n' diff --git a/testsuite/tests/lib/IOExts/hTell002.hs b/testsuite/tests/lib/IOExts/hTell002.hs new file mode 100644 index 0000000000..b790db8fe8 --- /dev/null +++ b/testsuite/tests/lib/IOExts/hTell002.hs @@ -0,0 +1,33 @@ +-- !!! Testing hSeek +module Main(main) where + +import System.Directory +import System.IO + +main :: IO () +main = do + h <- openFile "tst-seek" WriteMode + hSetEncoding h utf8 -- hSeek/hTell work with Unicode streams + hPutStr h "test string1" + -- seek to EOF should be cool.. + hSeek h SeekFromEnd 0 + hPutStr h "test string2" + -- seek past EOF should now also be cool.. + hSeek h SeekFromEnd 3 + hPutStr h "test string3" + hSeek h AbsoluteSeek 13 + hPutStr h "test string4" + x <- hTell h + print x + hSeek h AbsoluteSeek 30 + x1 <- hTell h + hPutStr h "人間虫" -- we should be able to output Unicode too + x2 <- hTell h + print (x2 - x1) + hPutStr h "filler" + hClose h + h <- openFile "tst-seek" ReadMode + hSetEncoding h utf8 + str <- hGetContents h + putStrLn str + removeFile "tst-seek" diff --git a/testsuite/tests/lib/IOExts/hTell002.stdout b/testsuite/tests/lib/IOExts/hTell002.stdout Binary files differnew file mode 100644 index 0000000000..52696f8a2c --- /dev/null +++ b/testsuite/tests/lib/IOExts/hTell002.stdout diff --git a/testsuite/tests/lib/IOExts/performGC001.hs b/testsuite/tests/lib/IOExts/performGC001.hs new file mode 100644 index 0000000000..f14dab004c --- /dev/null +++ b/testsuite/tests/lib/IOExts/performGC001.hs @@ -0,0 +1,5 @@ +-- !!! test System.Mem.performGC + +import System.Mem + +main = performGC diff --git a/testsuite/tests/lib/IOExts/performGC001.stdout b/testsuite/tests/lib/IOExts/performGC001.stdout new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/lib/IOExts/performGC001.stdout diff --git a/testsuite/tests/lib/IOExts/trace001.hs b/testsuite/tests/lib/IOExts/trace001.hs new file mode 100644 index 0000000000..2ed61d486e --- /dev/null +++ b/testsuite/tests/lib/IOExts/trace001.hs @@ -0,0 +1,10 @@ +import System.IO +import Debug.Trace + +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/testsuite/tests/lib/IOExts/trace001.stderr b/testsuite/tests/lib/IOExts/trace001.stderr new file mode 100644 index 0000000000..dfe965af21 --- /dev/null +++ b/testsuite/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/testsuite/tests/lib/IOExts/trace001.stdout b/testsuite/tests/lib/IOExts/trace001.stdout new file mode 100644 index 0000000000..23ddbb4550 --- /dev/null +++ b/testsuite/tests/lib/IOExts/trace001.stdout @@ -0,0 +1 @@ +FISH
\ No newline at end of file |