Copy tests from GHC testsuite; part of #1161.
authorPaolo Capriotti <p.capriotti@gmail.com>
Fri, 9 Mar 2012 11:42:24 +0000 (11:42 +0000)
committerPaolo Capriotti <p.capriotti@gmail.com>
Fri, 9 Mar 2012 13:04:46 +0000 (13:04 +0000)
278 files changed:
tests/4006.hs [new file with mode: 0644]
tests/4006.stdout [new file with mode: 0644]
tests/Concurrent/4876.hs [new file with mode: 0644]
tests/Concurrent/4876.stdout [new file with mode: 0644]
tests/Concurrent/Chan001.hs [new file with mode: 0644]
tests/Concurrent/Chan001.stdout [new file with mode: 0644]
tests/Concurrent/MVar001.hs [new file with mode: 0644]
tests/Concurrent/MVar001.stdout [new file with mode: 0644]
tests/Concurrent/Makefile [new file with mode: 0644]
tests/Concurrent/QSem001.hs [new file with mode: 0644]
tests/Concurrent/QSem001.stdout [new file with mode: 0644]
tests/Concurrent/QSemN001.hs [new file with mode: 0644]
tests/Concurrent/QSemN001.stdout [new file with mode: 0644]
tests/Concurrent/SampleVar001.hs [new file with mode: 0644]
tests/Concurrent/SampleVar001.stdout [new file with mode: 0644]
tests/Concurrent/ThreadDelay001.hs [new file with mode: 0644]
tests/Concurrent/all.T [new file with mode: 0644]
tests/IO/2122.hs [new file with mode: 0644]
tests/IO/3307.hs [new file with mode: 0644]
tests/IO/3307.stdout [new file with mode: 0644]
tests/IO/4808.hs [new file with mode: 0644]
tests/IO/4808.stderr [new file with mode: 0644]
tests/IO/4808.stdout [new file with mode: 0644]
tests/IO/4855.hs [new file with mode: 0644]
tests/IO/4855.stderr [new file with mode: 0644]
tests/IO/4895.hs [new file with mode: 0644]
tests/IO/4895.stdout [new file with mode: 0644]
tests/IO/IOError001.hs [new file with mode: 0644]
tests/IO/IOError001.stdout [new file with mode: 0644]
tests/IO/IOError001.stdout-hugs [new file with mode: 0644]
tests/IO/IOError002.hs [new file with mode: 0644]
tests/IO/IOError002.stdout [new file with mode: 0644]
tests/IO/Makefile [new file with mode: 0644]
tests/IO/T4144.hs [new file with mode: 0644]
tests/IO/T4144.stdout [new file with mode: 0644]
tests/IO/all.T [new file with mode: 0644]
tests/IO/concio001.hs [new file with mode: 0644]
tests/IO/concio001.stdout [new file with mode: 0644]
tests/IO/concio001.thr.stdout [new file with mode: 0644]
tests/IO/concio002.hs [new file with mode: 0644]
tests/IO/concio002.stdout [new file with mode: 0644]
tests/IO/countReaders001.hs [new file with mode: 0644]
tests/IO/countReaders001.stdout [new file with mode: 0644]
tests/IO/countReaders001.stdout-i386-unknown-mingw32 [new file with mode: 0644]
tests/IO/decodingerror001.hs [new file with mode: 0644]
tests/IO/decodingerror001.in1 [new file with mode: 0644]
tests/IO/decodingerror001.in2 [new file with mode: 0644]
tests/IO/decodingerror001.stdout [new file with mode: 0644]
tests/IO/decodingerror002.hs [new file with mode: 0644]
tests/IO/decodingerror002.in [new file with mode: 0644]
tests/IO/decodingerror002.stdout [new file with mode: 0644]
tests/IO/encoding001.hs [new file with mode: 0644]
tests/IO/encoding002.hs [new file with mode: 0644]
tests/IO/encoding002.stdout [new file with mode: 0644]
tests/IO/encodingerror001.hs [new file with mode: 0644]
tests/IO/encodingerror001.stdout [new file with mode: 0644]
tests/IO/environment001.hs [new file with mode: 0644]
tests/IO/environment001.stdout [new file with mode: 0644]
tests/IO/finalization001.hs [new file with mode: 0644]
tests/IO/finalization001.stdout [new file with mode: 0644]
tests/IO/hClose001.hs [new file with mode: 0644]
tests/IO/hClose001.stdout [new file with mode: 0644]
tests/IO/hClose002.hs [new file with mode: 0644]
tests/IO/hClose002.stdout [new file with mode: 0644]
tests/IO/hClose002.stdout-i386-unknown-solaris2 [new file with mode: 0644]
tests/IO/hClose003.hs [new file with mode: 0644]
tests/IO/hClose003.stdout [new file with mode: 0644]
tests/IO/hDuplicateTo001.hs [new file with mode: 0644]
tests/IO/hDuplicateTo001.stderr [new file with mode: 0644]
tests/IO/hFileSize001.hs [new file with mode: 0644]
tests/IO/hFileSize001.stdout [new file with mode: 0644]
tests/IO/hFileSize001.stdout-mingw [new file with mode: 0644]
tests/IO/hFileSize002.hs [new file with mode: 0644]
tests/IO/hFileSize002.stdout [new file with mode: 0644]
tests/IO/hFlush001.hs [new file with mode: 0644]
tests/IO/hFlush001.stdout [new file with mode: 0644]
tests/IO/hGetBuf001.hs [new file with mode: 0644]
tests/IO/hGetBuf001.stdout [new file with mode: 0644]
tests/IO/hGetBuffering001.hs [new file with mode: 0644]
tests/IO/hGetBuffering001.stdout [new file with mode: 0644]
tests/IO/hGetChar001.hs [new file with mode: 0644]
tests/IO/hGetChar001.stdin [new file with mode: 0644]
tests/IO/hGetChar001.stdout [new file with mode: 0644]
tests/IO/hGetLine001.hs [new file with mode: 0644]
tests/IO/hGetLine001.stdout [new file with mode: 0644]
tests/IO/hGetLine002.hs [new file with mode: 0644]
tests/IO/hGetLine002.stdin [new file with mode: 0644]
tests/IO/hGetLine002.stdout [new file with mode: 0644]
tests/IO/hGetLine002.stdout-hugs [new file with mode: 0644]
tests/IO/hGetLine003.hs [new file with mode: 0644]
tests/IO/hGetLine003.stdin [new file with mode: 0644]
tests/IO/hGetLine003.stdout [new file with mode: 0644]
tests/IO/hGetPosn001.hs [new file with mode: 0644]
tests/IO/hGetPosn001.in [new file with mode: 0644]
tests/IO/hGetPosn001.stdout [new file with mode: 0644]
tests/IO/hGetPosn001.stdout-hugs [new file with mode: 0644]
tests/IO/hIsEOF001.hs [new file with mode: 0644]
tests/IO/hIsEOF001.stdout [new file with mode: 0644]
tests/IO/hIsEOF002.hs [new file with mode: 0644]
tests/IO/hIsEOF002.stdout [new file with mode: 0644]
tests/IO/hReady001.hs [new file with mode: 0644]
tests/IO/hReady001.stdout [new file with mode: 0644]
tests/IO/hReady002.hs [new file with mode: 0644]
tests/IO/hReady002.stdout [new file with mode: 0644]
tests/IO/hSeek001.hs [new file with mode: 0644]
tests/IO/hSeek001.in [new file with mode: 0644]
tests/IO/hSeek001.stdout [new file with mode: 0644]
tests/IO/hSeek002.hs [new file with mode: 0644]
tests/IO/hSeek002.stdout [new file with mode: 0644]
tests/IO/hSeek003.hs [new file with mode: 0644]
tests/IO/hSeek003.stdout [new file with mode: 0644]
tests/IO/hSeek004.hs [new file with mode: 0644]
tests/IO/hSeek004.stdout [new file with mode: 0644]
tests/IO/hSeek004.stdout-mingw [new file with mode: 0644]
tests/IO/hSetBuffering002.hs [new file with mode: 0644]
tests/IO/hSetBuffering002.stdout [new file with mode: 0644]
tests/IO/hSetBuffering003.hs [new file with mode: 0644]
tests/IO/hSetBuffering003.stderr [new file with mode: 0644]
tests/IO/hSetBuffering003.stdout [new file with mode: 0644]
tests/IO/hSetBuffering004.hs [new file with mode: 0644]
tests/IO/hSetBuffering004.stdout [new file with mode: 0644]
tests/IO/hSetEncoding001.hs [new file with mode: 0644]
tests/IO/hSetEncoding001.in [new file with mode: 0644]
tests/IO/hSetEncoding001.stdout [new file with mode: 0644]
tests/IO/hSetEncoding002.hs [new file with mode: 0644]
tests/IO/hSetEncoding002.stdout [new file with mode: 0644]
tests/IO/ioeGetErrorString001.hs [new file with mode: 0644]
tests/IO/ioeGetErrorString001.stdout [new file with mode: 0644]
tests/IO/ioeGetFileName001.hs [new file with mode: 0644]
tests/IO/ioeGetFileName001.stdout [new file with mode: 0644]
tests/IO/ioeGetHandle001.hs [new file with mode: 0644]
tests/IO/ioeGetHandle001.stdout [new file with mode: 0644]
tests/IO/isEOF001.hs [new file with mode: 0644]
tests/IO/isEOF001.stdout [new file with mode: 0644]
tests/IO/latin1 [new file with mode: 0644]
tests/IO/misc001.hs [new file with mode: 0644]
tests/IO/misc001.stdout [new file with mode: 0644]
tests/IO/newline001.hs [new file with mode: 0644]
tests/IO/openFile001.hs [new file with mode: 0644]
tests/IO/openFile001.stdout [new file with mode: 0644]
tests/IO/openFile002.hs [new file with mode: 0644]
tests/IO/openFile002.stderr [new file with mode: 0644]
tests/IO/openFile002.stderr-hugs [new file with mode: 0644]
tests/IO/openFile003.hs [new file with mode: 0644]
tests/IO/openFile003.stdout [new file with mode: 0644]
tests/IO/openFile003.stdout-i386-unknown-mingw32 [new file with mode: 0644]
tests/IO/openFile003.stdout-i386-unknown-solaris2 [new file with mode: 0644]
tests/IO/openFile003.stdout-mingw [new file with mode: 0644]
tests/IO/openFile003.stdout-mips-sgi-irix [new file with mode: 0644]
tests/IO/openFile003.stdout-sparc-sun-solaris2 [new file with mode: 0644]
tests/IO/openFile004.hs [new file with mode: 0644]
tests/IO/openFile004.stdout [new file with mode: 0644]
tests/IO/openFile005.hs [new file with mode: 0644]
tests/IO/openFile005.stdout [new file with mode: 0644]
tests/IO/openFile005.stdout-i386-unknown-mingw32 [new file with mode: 0644]
tests/IO/openFile006.hs [new file with mode: 0644]
tests/IO/openFile006.stdout [new file with mode: 0644]
tests/IO/openFile007.hs [new file with mode: 0644]
tests/IO/openFile007.stdout [new file with mode: 0644]
tests/IO/openFile007.stdout-i386-unknown-mingw32 [new file with mode: 0644]
tests/IO/openFile008.hs [new file with mode: 0644]
tests/IO/openTempFile001.hs [new file with mode: 0644]
tests/IO/putStr001.hs [new file with mode: 0644]
tests/IO/putStr001.stdout [new file with mode: 0644]
tests/IO/readFile001.hs [new file with mode: 0644]
tests/IO/readFile001.stdout [new file with mode: 0644]
tests/IO/readFile001.stdout-i386-unknown-mingw32 [new file with mode: 0644]
tests/IO/readwrite001.hs [new file with mode: 0644]
tests/IO/readwrite001.stdout [new file with mode: 0644]
tests/IO/readwrite002.hs [new file with mode: 0644]
tests/IO/readwrite002.stdout [new file with mode: 0644]
tests/IO/readwrite003.hs [new file with mode: 0644]
tests/IO/readwrite003.stdout [new file with mode: 0644]
tests/IO/utf8-test [new file with mode: 0644]
tests/Memo1.lhs [new file with mode: 0644]
tests/Memo2.lhs [new file with mode: 0644]
tests/addr001.hs [new file with mode: 0644]
tests/addr001.stdout [new file with mode: 0644]
tests/addr001.stdout-alpha-dec-osf3 [new file with mode: 0644]
tests/addr001.stdout-mips-sgi-irix [new file with mode: 0644]
tests/addr001.stdout-ws-64 [new file with mode: 0644]
tests/addr001.stdout-x86_64-unknown-openbsd [new file with mode: 0644]
tests/all.T
tests/char001.hs [new file with mode: 0644]
tests/char001.stdout [new file with mode: 0644]
tests/char002.hs [new file with mode: 0644]
tests/char002.stdout [new file with mode: 0644]
tests/cstring001.hs [new file with mode: 0644]
tests/dynamic001.hs [new file with mode: 0644]
tests/dynamic001.stdout [new file with mode: 0644]
tests/dynamic002.hs [new file with mode: 0644]
tests/dynamic002.stdout [new file with mode: 0644]
tests/dynamic003.hs [new file with mode: 0644]
tests/dynamic003.stdout [new file with mode: 0644]
tests/dynamic004.hs [new file with mode: 0644]
tests/dynamic004.stdout [new file with mode: 0644]
tests/dynamic005.hs [new file with mode: 0644]
tests/dynamic005.stdout [new file with mode: 0644]
tests/echo001.hs [new file with mode: 0644]
tests/echo001.stdout [new file with mode: 0644]
tests/enum01.hs [new file with mode: 0644]
tests/enum01.stdout [new file with mode: 0644]
tests/enum01.stdout-alpha-dec-osf3 [new file with mode: 0644]
tests/enum01.stdout-hugs [new file with mode: 0644]
tests/enum01.stdout-ws-64 [new file with mode: 0644]
tests/enum02.hs [new file with mode: 0644]
tests/enum02.stdout [new file with mode: 0644]
tests/enum02.stdout-alpha-dec-osf3 [new file with mode: 0644]
tests/enum02.stdout-hugs [new file with mode: 0644]
tests/enum02.stdout-mips-sgi-irix [new file with mode: 0644]
tests/enum02.stdout-ws-64 [new file with mode: 0644]
tests/enum02.stdout-x86_64-unknown-openbsd [new file with mode: 0644]
tests/enum03.hs [new file with mode: 0644]
tests/enum03.stdout [new file with mode: 0644]
tests/enum03.stdout-alpha-dec-osf3 [new file with mode: 0644]
tests/enum03.stdout-hugs [new file with mode: 0644]
tests/enum03.stdout-mips-sgi-irix [new file with mode: 0644]
tests/enum03.stdout-ws-64 [new file with mode: 0644]
tests/enum03.stdout-x86_64-unknown-openbsd [new file with mode: 0644]
tests/enum04.hs [new file with mode: 0644]
tests/enum04.stdout [new file with mode: 0644]
tests/exceptionsrun001.hs [new file with mode: 0644]
tests/exceptionsrun001.stdout [new file with mode: 0644]
tests/exceptionsrun002.hs [new file with mode: 0644]
tests/exceptionsrun002.stdout [new file with mode: 0644]
tests/hGetBuf002.hs [new file with mode: 0644]
tests/hGetBuf002.stdout [new file with mode: 0644]
tests/hGetBuf003.hs [new file with mode: 0644]
tests/hGetBuf003.stdout [new file with mode: 0644]
tests/hPutBuf001.hs [new file with mode: 0644]
tests/hPutBuf001.stdout [new file with mode: 0644]
tests/hPutBuf002.hs [new file with mode: 0644]
tests/hPutBuf002.stdout [new file with mode: 0644]
tests/hTell001.hs [new file with mode: 0644]
tests/hTell001.stdout [new file with mode: 0644]
tests/hTell002.hs [new file with mode: 0644]
tests/hTell002.stdout [new file with mode: 0644]
tests/length001.hs [new file with mode: 0644]
tests/length001.stdout [new file with mode: 0644]
tests/list001.hs [new file with mode: 0644]
tests/list001.stdout [new file with mode: 0644]
tests/list001.stdout-ghc [new file with mode: 0644]
tests/list002.hs [new file with mode: 0644]
tests/list002.stdout [new file with mode: 0644]
tests/list003.hs [new file with mode: 0644]
tests/list003.stdout [new file with mode: 0644]
tests/memo001.hs [new file with mode: 0644]
tests/memo001.stdout [new file with mode: 0644]
tests/memo002.hs [new file with mode: 0644]
tests/memo002.stdout [new file with mode: 0644]
tests/packedstring001.hs [new file with mode: 0644]
tests/packedstring001.stdout [new file with mode: 0644]
tests/performGC001.hs [new file with mode: 0644]
tests/performGC001.stdout [new file with mode: 0644]
tests/rand001.hs [new file with mode: 0644]
tests/rand001.stdout [new file with mode: 0644]
tests/ratio001.hs [new file with mode: 0644]
tests/ratio001.stdout [new file with mode: 0644]
tests/ratio001.stdout-ghc [new file with mode: 0644]
tests/reads001.hs [new file with mode: 0644]
tests/reads001.stdout [new file with mode: 0644]
tests/show001.hs [new file with mode: 0644]
tests/show001.stdout [new file with mode: 0644]
tests/stableptr001.hs [new file with mode: 0644]
tests/stableptr001.stdout [new file with mode: 0644]
tests/stableptr003.hs [new file with mode: 0644]
tests/stableptr004.hs [new file with mode: 0644]
tests/stableptr004.stdout [new file with mode: 0644]
tests/stableptr005.hs [new file with mode: 0644]
tests/stableptr005.stdout [new file with mode: 0644]
tests/text001.hs [new file with mode: 0644]
tests/text001.stdout [new file with mode: 0644]
tests/trace001.hs [new file with mode: 0644]
tests/trace001.stderr [new file with mode: 0644]
tests/trace001.stdout [new file with mode: 0644]
tests/tup001.hs [new file with mode: 0644]
tests/tup001.stdout [new file with mode: 0644]
tests/weak001.hs [new file with mode: 0644]

diff --git a/tests/4006.hs b/tests/4006.hs
new file mode 100644 (file)
index 0000000..662b0f6
--- /dev/null
@@ -0,0 +1,8 @@
+import System.Process
+
+testUnicode :: String -> IO String
+testUnicode str = readProcess "printf" ["%s", str] ""
+
+main = do
+    testUnicode "It works here" >>= putStrLn
+    testUnicode "А здесь сломалось" >>= putStrLn
diff --git a/tests/4006.stdout b/tests/4006.stdout
new file mode 100644 (file)
index 0000000..9db8a8c
--- /dev/null
@@ -0,0 +1,2 @@
+It works here
+А здесь сломалось
diff --git a/tests/Concurrent/4876.hs b/tests/Concurrent/4876.hs
new file mode 100644 (file)
index 0000000..68c2a87
--- /dev/null
@@ -0,0 +1,19 @@
+import System.Random
+import Control.Concurrent.SampleVar
+import Control.Concurrent
+import Control.Monad
+
+produce, consume :: SampleVar Int -> IO ()
+produce svar = do
+   b <- isEmptySampleVar svar
+   if b then writeSampleVar svar 3 else return ()
+
+consume svar = readSampleVar svar >>= print
+
+main = do
+   svar <- newEmptySampleVar
+   m <- newEmptyMVar
+   forkIO $ consume svar >> putMVar m ()
+   threadDelay 100000     -- 100 ms
+   produce svar
+   takeMVar m -- deadlocked before the fix in #4876
diff --git a/tests/Concurrent/4876.stdout b/tests/Concurrent/4876.stdout
new file mode 100644 (file)
index 0000000..00750ed
--- /dev/null
@@ -0,0 +1 @@
+3
diff --git a/tests/Concurrent/Chan001.hs b/tests/Concurrent/Chan001.hs
new file mode 100644 (file)
index 0000000..e4b668a
--- /dev/null
@@ -0,0 +1,109 @@
+import Debug.QuickCheck\r
+import System.IO.Unsafe\r
+import Control.Concurrent.Chan\r
+import Control.Concurrent\r
+import Control.Monad\r
+\r
+data Action = NewChan | ReadChan | WriteChan Int | IsEmptyChan | ReturnInt Int\r
+           | ReturnBool Bool\r
+  deriving (Eq,Show)\r
+\r
+\r
+main = do \r
+  t <- myThreadId\r
+  forkIO (threadDelay 1000000 >> killThread t)\r
+       -- just in case we deadlock\r
+  testChan\r
+\r
+testChan :: IO ()\r
+testChan = do\r
+  quickCheck prop_NewIs_NewRet\r
+  quickCheck prop_NewWriteIs_NewRet\r
+  quickCheck prop_NewWriteRead_NewRet\r
+\r
+\r
+prop_NewIs_NewRet = \r
+  [NewChan,IsEmptyChan] =^ [NewChan,ReturnBool True]\r
+\r
+prop_NewWriteIs_NewRet n = \r
+  [NewChan,WriteChan n,IsEmptyChan] =^ [NewChan,WriteChan n,ReturnBool False]\r
+\r
+prop_NewWriteRead_NewRet n = \r
+  [NewChan,WriteChan n,ReadChan] =^ [NewChan,ReturnInt n]\r
+\r
+\r
+perform :: [Action] -> IO ([Bool],[Int])\r
+perform [] = return ([],[])\r
+\r
+perform (a:as) =\r
+  case a of\r
+    ReturnInt v         -> liftM (\(b,l) -> (b,v:l)) (perform as)\r
+    ReturnBool v -> liftM (\(b,l) -> (v:b,l)) (perform as)\r
+    NewChan      -> newChan >>= \chan -> perform' chan as    \r
+    _           -> error $ "Please use NewChan as first action"\r
+\r
+\r
+perform' :: Chan Int -> [Action] -> IO ([Bool],[Int])\r
+perform' _ [] = return ([],[])\r
+\r
+perform' chan (a:as) =\r
+  case a of\r
+    ReturnInt v         -> liftM (\(b,l) -> (b,v:l)) (perform' chan as)\r
+    ReturnBool v -> liftM (\(b,l) -> (v:b,l)) (perform' chan as)\r
+    ReadChan     -> liftM2 (\v (b,l) -> (b,v:l)) (readChan chan) \r
+                               (perform' chan as)\r
+    WriteChan n  -> writeChan chan n >> perform' chan as\r
+    IsEmptyChan  -> liftM2 (\v (b,l) -> (v:b,l)) (isEmptyChan chan)\r
+                               (perform' chan as)\r
+    _               -> error $ "If you want to use " ++ show a \r
+                               ++ " please use the =^ operator"\r
+\r
+\r
+actions :: Gen [Action]\r
+actions =\r
+  liftM (NewChan:) (actions' 0)\r
+\r
+\r
+actions' :: Int -> Gen [Action]\r
+actions' contents =\r
+  oneof ([return [],\r
+         liftM (IsEmptyChan:) (actions' contents),\r
+         liftM2 (:) (liftM WriteChan arbitrary) (actions' (contents+1))]\r
+         ++\r
+         if contents==0\r
+            then []\r
+            else [liftM (ReadChan:) (actions' (contents-1))])\r
+\r
+\r
+(=^) :: [Action] -> [Action] -> Property\r
+c =^ c' =\r
+  forAll (actions' (delta 0 c))\r
+        (\suff -> observe c suff == observe c' suff)\r
+  where observe x suff = unsafePerformIO (perform (x++suff))\r
+\r
+\r
+(^=^) :: [Action] -> [Action] -> Property\r
+c ^=^ c' =\r
+  forAll actions\r
+        (\pref -> forAll (actions' (delta 0 (pref++c)))\r
+                         (\suff -> observe c pref suff == \r
+                                     observe c' pref suff))\r
+  where observe x pref suff = unsafePerformIO (perform (pref++x++suff))\r
+\r
+\r
+delta :: Int -> [Action] -> Int\r
+delta i [] = i\r
+\r
+delta i (ReturnInt _:as) = delta i as\r
+\r
+delta i (ReturnBool _:as) = delta i as\r
+\r
+delta _ (NewChan:as) = delta 0 as\r
+\r
+delta i (WriteChan _:as) = delta (i+1) as\r
+\r
+delta i (ReadChan:as) = delta (if i==0\r
+                                 then error "read on empty Chan"\r
+                                 else i-1) as\r
+\r
+delta i (IsEmptyChan:as) = delta i as\r
diff --git a/tests/Concurrent/Chan001.stdout b/tests/Concurrent/Chan001.stdout
new file mode 100644 (file)
index 0000000..53bfa8a
--- /dev/null
@@ -0,0 +1,3 @@
+0\b1\b2\b3\b4\b5\b6\b7\b8\b9\b10\b\b11\b\b12\b\b13\b\b14\b\b15\b\b16\b\b17\b\b18\b\b19\b\b20\b\b21\b\b22\b\b23\b\b24\b\b25\b\b26\b\b27\b\b28\b\b29\b\b30\b\b31\b\b32\b\b33\b\b34\b\b35\b\b36\b\b37\b\b38\b\b39\b\b40\b\b41\b\b42\b\b43\b\b44\b\b45\b\b46\b\b47\b\b48\b\b49\b\b50\b\b51\b\b52\b\b53\b\b54\b\b55\b\b56\b\b57\b\b58\b\b59\b\b60\b\b61\b\b62\b\b63\b\b64\b\b65\b\b66\b\b67\b\b68\b\b69\b\b70\b\b71\b\b72\b\b73\b\b74\b\b75\b\b76\b\b77\b\b78\b\b79\b\b80\b\b81\b\b82\b\b83\b\b84\b\b85\b\b86\b\b87\b\b88\b\b89\b\b90\b\b91\b\b92\b\b93\b\b94\b\b95\b\b96\b\b97\b\b98\b\b99\b\bOK, passed 100 tests.
+0\b1\b2\b3\b4\b5\b6\b7\b8\b9\b10\b\b11\b\b12\b\b13\b\b14\b\b15\b\b16\b\b17\b\b18\b\b19\b\b20\b\b21\b\b22\b\b23\b\b24\b\b25\b\b26\b\b27\b\b28\b\b29\b\b30\b\b31\b\b32\b\b33\b\b34\b\b35\b\b36\b\b37\b\b38\b\b39\b\b40\b\b41\b\b42\b\b43\b\b44\b\b45\b\b46\b\b47\b\b48\b\b49\b\b50\b\b51\b\b52\b\b53\b\b54\b\b55\b\b56\b\b57\b\b58\b\b59\b\b60\b\b61\b\b62\b\b63\b\b64\b\b65\b\b66\b\b67\b\b68\b\b69\b\b70\b\b71\b\b72\b\b73\b\b74\b\b75\b\b76\b\b77\b\b78\b\b79\b\b80\b\b81\b\b82\b\b83\b\b84\b\b85\b\b86\b\b87\b\b88\b\b89\b\b90\b\b91\b\b92\b\b93\b\b94\b\b95\b\b96\b\b97\b\b98\b\b99\b\bOK, passed 100 tests.
+0\b1\b2\b3\b4\b5\b6\b7\b8\b9\b10\b\b11\b\b12\b\b13\b\b14\b\b15\b\b16\b\b17\b\b18\b\b19\b\b20\b\b21\b\b22\b\b23\b\b24\b\b25\b\b26\b\b27\b\b28\b\b29\b\b30\b\b31\b\b32\b\b33\b\b34\b\b35\b\b36\b\b37\b\b38\b\b39\b\b40\b\b41\b\b42\b\b43\b\b44\b\b45\b\b46\b\b47\b\b48\b\b49\b\b50\b\b51\b\b52\b\b53\b\b54\b\b55\b\b56\b\b57\b\b58\b\b59\b\b60\b\b61\b\b62\b\b63\b\b64\b\b65\b\b66\b\b67\b\b68\b\b69\b\b70\b\b71\b\b72\b\b73\b\b74\b\b75\b\b76\b\b77\b\b78\b\b79\b\b80\b\b81\b\b82\b\b83\b\b84\b\b85\b\b86\b\b87\b\b88\b\b89\b\b90\b\b91\b\b92\b\b93\b\b94\b\b95\b\b96\b\b97\b\b98\b\b99\b\bOK, passed 100 tests.
diff --git a/tests/Concurrent/MVar001.hs b/tests/Concurrent/MVar001.hs
new file mode 100644 (file)
index 0000000..f787470
--- /dev/null
@@ -0,0 +1,148 @@
+import Debug.QuickCheck\r
+import System.IO.Unsafe\r
+import Control.Concurrent.MVar\r
+import Control.Concurrent\r
+import Control.Monad\r
+\r
+\r
+data Action = NewEmptyMVar | NewMVar Int | TakeMVar | ReadMVar | PutMVar Int\r
+           | SwapMVar Int | IsEmptyMVar | ReturnInt Int | ReturnBool Bool\r
+  deriving (Eq,Show)\r
+\r
+main = do \r
+  t <- myThreadId\r
+  forkIO (threadDelay 1000000 >> killThread t)\r
+       -- just in case we deadlock\r
+  testMVar\r
+\r
+testMVar :: IO ()\r
+testMVar = do\r
+  quickCheck prop_NewEIs_NewERet\r
+  quickCheck prop_NewIs_NewRet\r
+  quickCheck prop_NewTake_NewRet\r
+  quickCheck prop_NewEPutTake_NewERet\r
+  quickCheck prop_NewRead_NewRet\r
+  quickCheck prop_NewSwap_New\r
+\r
+\r
+prop_NewEIs_NewERet = \r
+  [NewEmptyMVar,IsEmptyMVar] =^ [NewEmptyMVar,ReturnBool True]\r
+\r
+prop_NewIs_NewRet n = \r
+  [NewMVar n,IsEmptyMVar] =^ [NewMVar n,ReturnBool False]\r
+\r
+prop_NewTake_NewRet n =\r
+  [NewMVar n,TakeMVar] =^ [NewEmptyMVar,ReturnInt n]\r
+\r
+prop_NewEPutTake_NewERet n = \r
+  [NewEmptyMVar,PutMVar n,TakeMVar] =^ \r
+    [NewEmptyMVar,ReturnInt n]\r
+\r
+prop_NewRead_NewRet n = \r
+  [NewMVar n,ReadMVar] =^ [NewMVar n,ReturnInt n]\r
+\r
+prop_NewSwap_New m n =\r
+  [NewMVar m,SwapMVar n] =^ [NewMVar n]\r
+\r
+\r
+perform :: [Action] -> IO ([Bool],[Int])\r
+perform [] = return ([],[])\r
+\r
+perform (a:as) =\r
+  case a of\r
+    ReturnInt v         -> liftM (\(b,l) -> (b,v:l)) (perform as)\r
+    ReturnBool v -> liftM (\(b,l) -> (v:b,l)) (perform as)\r
+    NewEmptyMVar -> newEmptyMVar >>= \mv -> perform' mv as\r
+    NewMVar n    -> newMVar n >>= \mv -> perform' mv as    \r
+    _           -> error $ "Please use NewMVar or NewEmptyMVar as first "\r
+                           ++ "action"\r
+\r
+\r
+perform' :: MVar Int -> [Action] -> IO ([Bool],[Int])\r
+perform' _ [] = return ([],[])\r
+\r
+perform' mv (a:as) =\r
+  case a of\r
+    ReturnInt v         -> liftM (\(b,l) -> (b,v:l)) (perform' mv as)\r
+    ReturnBool v -> liftM (\(b,l) -> (v:b,l)) (perform' mv as)\r
+    TakeMVar     -> liftM2 (\v (b,l) -> (b,v:l)) (takeMVar mv) \r
+                               (perform' mv as)\r
+    ReadMVar     -> liftM2 (\v (b,l) -> (b,v:l)) (readMVar mv) \r
+                               (perform' mv as)\r
+    PutMVar n    -> putMVar mv n >> perform' mv as\r
+    SwapMVar n  -> swapMVar mv n >> perform' mv as\r
+    IsEmptyMVar  -> liftM2 (\v (b,l) -> (v:b,l)) (isEmptyMVar mv)\r
+                               (perform' mv as)\r
+    _           -> error $ "If you want to use " ++ show a \r
+                           ++ " please use the =^ operator"\r
+\r
+\r
+actions :: Gen [Action]\r
+actions = do\r
+  oneof [liftM (NewEmptyMVar:) (actions' True),\r
+        liftM2 (:) (liftM NewMVar arbitrary) (actions' False)] \r
+\r
+\r
+actions' :: Bool -> Gen [Action]\r
+actions' empty =\r
+  oneof ([return [],\r
+         liftM (IsEmptyMVar:) (actions' empty)] ++\r
+         if empty\r
+            then [liftM2 (:) (liftM PutMVar arbitrary) (actions' False)]\r
+            else []\r
+         ++\r
+         if empty\r
+            then []\r
+            else [liftM (TakeMVar:) (actions' True)]\r
+         ++\r
+         if empty\r
+            then []\r
+            else [liftM (ReadMVar:) (actions' False)]\r
+         ++\r
+         if empty\r
+            then []\r
+            else [liftM2 (:) (liftM SwapMVar arbitrary) (actions' False)]   )\r
+\r
+\r
+(=^) :: [Action] -> [Action] -> Property\r
+c =^ c' =\r
+  forAll (actions' (delta True c))\r
+        (\suff -> observe c suff == observe c' suff)\r
+  where observe x suff = unsafePerformIO (perform (x++suff))\r
+\r
+\r
+(^=^) :: [Action] -> [Action] -> Property\r
+c ^=^ c' =\r
+  forAll actions\r
+        (\pref -> forAll (actions' (delta True (pref++c)))\r
+                         (\suff -> observe c pref suff == \r
+                                     observe c' pref suff))\r
+  where observe x pref suff = unsafePerformIO (perform (pref++x++suff))\r
+\r
+\r
+delta :: Bool -> [Action] -> Bool\r
+delta b [] = b\r
+\r
+delta b (ReturnInt _:as) = delta b as\r
+\r
+delta b (ReturnBool _:as) = delta b as\r
+\r
+delta _ (NewEmptyMVar:as) = delta True as\r
+\r
+delta _ (NewMVar _:as) = delta False as\r
+\r
+delta b (TakeMVar:as) = delta (if b\r
+                                 then error "take on empty MVar"\r
+                                 else True) as\r
+\r
+delta b (ReadMVar:as) = delta (if b\r
+                                 then error "read on empty MVar"\r
+                                 else False) as\r
+\r
+delta _ (PutMVar _:as) = delta False as\r
+\r
+delta b (SwapMVar _:as) = delta (if b\r
+                                 then error "swap on empty MVar"\r
+                                 else False) as\r
+\r
+delta b (IsEmptyMVar:as) = delta b as\r
diff --git a/tests/Concurrent/MVar001.stdout b/tests/Concurrent/MVar001.stdout
new file mode 100644 (file)
index 0000000..65be56c
--- /dev/null
@@ -0,0 +1,6 @@
+0\b1\b2\b3\b4\b5\b6\b7\b8\b9\b10\b\b11\b\b12\b\b13\b\b14\b\b15\b\b16\b\b17\b\b18\b\b19\b\b20\b\b21\b\b22\b\b23\b\b24\b\b25\b\b26\b\b27\b\b28\b\b29\b\b30\b\b31\b\b32\b\b33\b\b34\b\b35\b\b36\b\b37\b\b38\b\b39\b\b40\b\b41\b\b42\b\b43\b\b44\b\b45\b\b46\b\b47\b\b48\b\b49\b\b50\b\b51\b\b52\b\b53\b\b54\b\b55\b\b56\b\b57\b\b58\b\b59\b\b60\b\b61\b\b62\b\b63\b\b64\b\b65\b\b66\b\b67\b\b68\b\b69\b\b70\b\b71\b\b72\b\b73\b\b74\b\b75\b\b76\b\b77\b\b78\b\b79\b\b80\b\b81\b\b82\b\b83\b\b84\b\b85\b\b86\b\b87\b\b88\b\b89\b\b90\b\b91\b\b92\b\b93\b\b94\b\b95\b\b96\b\b97\b\b98\b\b99\b\bOK, passed 100 tests.
+0\b1\b2\b3\b4\b5\b6\b7\b8\b9\b10\b\b11\b\b12\b\b13\b\b14\b\b15\b\b16\b\b17\b\b18\b\b19\b\b20\b\b21\b\b22\b\b23\b\b24\b\b25\b\b26\b\b27\b\b28\b\b29\b\b30\b\b31\b\b32\b\b33\b\b34\b\b35\b\b36\b\b37\b\b38\b\b39\b\b40\b\b41\b\b42\b\b43\b\b44\b\b45\b\b46\b\b47\b\b48\b\b49\b\b50\b\b51\b\b52\b\b53\b\b54\b\b55\b\b56\b\b57\b\b58\b\b59\b\b60\b\b61\b\b62\b\b63\b\b64\b\b65\b\b66\b\b67\b\b68\b\b69\b\b70\b\b71\b\b72\b\b73\b\b74\b\b75\b\b76\b\b77\b\b78\b\b79\b\b80\b\b81\b\b82\b\b83\b\b84\b\b85\b\b86\b\b87\b\b88\b\b89\b\b90\b\b91\b\b92\b\b93\b\b94\b\b95\b\b96\b\b97\b\b98\b\b99\b\bOK, passed 100 tests.
+0\b1\b2\b3\b4\b5\b6\b7\b8\b9\b10\b\b11\b\b12\b\b13\b\b14\b\b15\b\b16\b\b17\b\b18\b\b19\b\b20\b\b21\b\b22\b\b23\b\b24\b\b25\b\b26\b\b27\b\b28\b\b29\b\b30\b\b31\b\b32\b\b33\b\b34\b\b35\b\b36\b\b37\b\b38\b\b39\b\b40\b\b41\b\b42\b\b43\b\b44\b\b45\b\b46\b\b47\b\b48\b\b49\b\b50\b\b51\b\b52\b\b53\b\b54\b\b55\b\b56\b\b57\b\b58\b\b59\b\b60\b\b61\b\b62\b\b63\b\b64\b\b65\b\b66\b\b67\b\b68\b\b69\b\b70\b\b71\b\b72\b\b73\b\b74\b\b75\b\b76\b\b77\b\b78\b\b79\b\b80\b\b81\b\b82\b\b83\b\b84\b\b85\b\b86\b\b87\b\b88\b\b89\b\b90\b\b91\b\b92\b\b93\b\b94\b\b95\b\b96\b\b97\b\b98\b\b99\b\bOK, passed 100 tests.
+0\b1\b2\b3\b4\b5\b6\b7\b8\b9\b10\b\b11\b\b12\b\b13\b\b14\b\b15\b\b16\b\b17\b\b18\b\b19\b\b20\b\b21\b\b22\b\b23\b\b24\b\b25\b\b26\b\b27\b\b28\b\b29\b\b30\b\b31\b\b32\b\b33\b\b34\b\b35\b\b36\b\b37\b\b38\b\b39\b\b40\b\b41\b\b42\b\b43\b\b44\b\b45\b\b46\b\b47\b\b48\b\b49\b\b50\b\b51\b\b52\b\b53\b\b54\b\b55\b\b56\b\b57\b\b58\b\b59\b\b60\b\b61\b\b62\b\b63\b\b64\b\b65\b\b66\b\b67\b\b68\b\b69\b\b70\b\b71\b\b72\b\b73\b\b74\b\b75\b\b76\b\b77\b\b78\b\b79\b\b80\b\b81\b\b82\b\b83\b\b84\b\b85\b\b86\b\b87\b\b88\b\b89\b\b90\b\b91\b\b92\b\b93\b\b94\b\b95\b\b96\b\b97\b\b98\b\b99\b\bOK, passed 100 tests.
+0\b1\b2\b3\b4\b5\b6\b7\b8\b9\b10\b\b11\b\b12\b\b13\b\b14\b\b15\b\b16\b\b17\b\b18\b\b19\b\b20\b\b21\b\b22\b\b23\b\b24\b\b25\b\b26\b\b27\b\b28\b\b29\b\b30\b\b31\b\b32\b\b33\b\b34\b\b35\b\b36\b\b37\b\b38\b\b39\b\b40\b\b41\b\b42\b\b43\b\b44\b\b45\b\b46\b\b47\b\b48\b\b49\b\b50\b\b51\b\b52\b\b53\b\b54\b\b55\b\b56\b\b57\b\b58\b\b59\b\b60\b\b61\b\b62\b\b63\b\b64\b\b65\b\b66\b\b67\b\b68\b\b69\b\b70\b\b71\b\b72\b\b73\b\b74\b\b75\b\b76\b\b77\b\b78\b\b79\b\b80\b\b81\b\b82\b\b83\b\b84\b\b85\b\b86\b\b87\b\b88\b\b89\b\b90\b\b91\b\b92\b\b93\b\b94\b\b95\b\b96\b\b97\b\b98\b\b99\b\bOK, passed 100 tests.
+0\b1\b2\b3\b4\b5\b6\b7\b8\b9\b10\b\b11\b\b12\b\b13\b\b14\b\b15\b\b16\b\b17\b\b18\b\b19\b\b20\b\b21\b\b22\b\b23\b\b24\b\b25\b\b26\b\b27\b\b28\b\b29\b\b30\b\b31\b\b32\b\b33\b\b34\b\b35\b\b36\b\b37\b\b38\b\b39\b\b40\b\b41\b\b42\b\b43\b\b44\b\b45\b\b46\b\b47\b\b48\b\b49\b\b50\b\b51\b\b52\b\b53\b\b54\b\b55\b\b56\b\b57\b\b58\b\b59\b\b60\b\b61\b\b62\b\b63\b\b64\b\b65\b\b66\b\b67\b\b68\b\b69\b\b70\b\b71\b\b72\b\b73\b\b74\b\b75\b\b76\b\b77\b\b78\b\b79\b\b80\b\b81\b\b82\b\b83\b\b84\b\b85\b\b86\b\b87\b\b88\b\b89\b\b90\b\b91\b\b92\b\b93\b\b94\b\b95\b\b96\b\b97\b\b98\b\b99\b\bOK, passed 100 tests.
diff --git a/tests/Concurrent/Makefile b/tests/Concurrent/Makefile
new file mode 100644 (file)
index 0000000..4ca7751
--- /dev/null
@@ -0,0 +1,7 @@
+# This Makefile runs the tests using GHC's testsuite framework.  It
+# assumes the package is part of a GHC build tree with the testsuite
+# installed in ../../../testsuite.
+
+TOP=../../../../testsuite
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/tests/Concurrent/QSem001.hs b/tests/Concurrent/QSem001.hs
new file mode 100644 (file)
index 0000000..1f25599
--- /dev/null
@@ -0,0 +1,93 @@
+import Debug.QuickCheck\r
+import System.IO.Unsafe\r
+import Control.Concurrent.QSem\r
+import Control.Concurrent\r
+import Control.Monad\r
+\r
+\r
+main = do \r
+  t <- myThreadId\r
+  forkIO (threadDelay 1000000 >> killThread t)\r
+       -- just in case we deadlock\r
+  testQSem\r
+\r
+data Action = NewQSem Int | SignalQSem | WaitQSem\r
+  deriving (Eq,Show)\r
+\r
+\r
+testQSem :: IO ()\r
+testQSem = do\r
+  quietCheck prop_SignalWait\r
+  quietCheck prop_WaitSignal\r
+\r
+quietCheck = check defaultConfig{configEvery = \n args -> ""}\r
+\r
+prop_SignalWait n = \r
+  n>=0 ==> [NewQSem n,SignalQSem,WaitQSem] =^ [NewQSem n]\r
+\r
+prop_WaitSignal n = \r
+  n>=1 ==> [NewQSem n,WaitQSem,SignalQSem] =^ [NewQSem n]\r
+\r
+\r
+perform :: [Action] -> IO ()\r
+perform [] = return ()\r
+\r
+perform (a:as) =\r
+  case a of\r
+    NewQSem n    -> newQSem n >>= \qs -> perform' qs as\r
+    _           -> error $ "Please use NewQSem as first action" ++ show a\r
+\r
+\r
+perform' :: QSem -> [Action] -> IO ()\r
+perform' _ [] = return ()\r
+\r
+perform' qs (a:as) =\r
+  case a of\r
+    SignalQSem       -> signalQSem qs >> perform' qs as\r
+    WaitQSem         -> waitQSem qs >> perform' qs as\r
+    _               -> error $ "If you want to use " ++ show a \r
+                               ++ " please use the =^ operator"\r
+   \r
+\r
+actions :: Gen [Action]\r
+actions = do\r
+  i <- arbitrary\r
+  liftM (NewQSem i:) (actions' i) \r
+\r
+\r
+actions' :: Int -> Gen [Action]\r
+actions' quantity =\r
+  oneof ([return [],\r
+         liftM (SignalQSem:) (actions' (quantity+1))] ++\r
+         if quantity<=0\r
+            then []\r
+            else [liftM (WaitQSem:) (actions' (quantity-1))])  \r
+\r
+\r
+(=^) :: [Action] -> [Action] -> Property\r
+c =^ c' =\r
+  forAll (actions' (delta 0 c))\r
+        (\suff -> observe c suff == observe c' suff)\r
+  where observe x suff = unsafePerformIO (perform (x++suff))\r
+\r
+\r
+(^=^) :: [Action] -> [Action] -> Property\r
+c ^=^ c' =\r
+  forAll actions\r
+        (\pref -> forAll (actions' (delta 0 (pref++c)))\r
+                         (\suff -> observe c pref suff == \r
+                                     observe c' pref suff))\r
+  where observe x pref suff = unsafePerformIO (perform (pref++x++suff))\r
+\r
+\r
+delta :: Int -> [Action] -> Int\r
+delta i [] = i\r
+\r
+delta _ (NewQSem i:as) = delta i as\r
+\r
+delta i (SignalQSem:as) = delta (i+1) as\r
+\r
+delta i (WaitQSem:as) = delta (if i<=0\r
+                                 then error "wait on 'empty' QSem"\r
+                                 else i-1) as\r
+\r
diff --git a/tests/Concurrent/QSem001.stdout b/tests/Concurrent/QSem001.stdout
new file mode 100644 (file)
index 0000000..7288d19
--- /dev/null
@@ -0,0 +1,2 @@
+OK, passed 100 tests.
+OK, passed 100 tests.
diff --git a/tests/Concurrent/QSemN001.hs b/tests/Concurrent/QSemN001.hs
new file mode 100644 (file)
index 0000000..c31d6a6
--- /dev/null
@@ -0,0 +1,96 @@
+import Debug.QuickCheck\r
+import System.IO.Unsafe\r
+import Control.Concurrent.QSemN\r
+import Control.Concurrent\r
+import Control.Monad\r
+\r
+\r
+main = do \r
+  t <- myThreadId\r
+  forkIO (threadDelay 1000000 >> killThread t)\r
+       -- just in case we deadlock\r
+  testQSemN\r
+\r
+data Action = NewQSemN Int | SignalQSemN Int | WaitQSemN Int\r
+  deriving (Eq,Show)\r
+\r
+\r
+testQSemN :: IO ()\r
+testQSemN = do\r
+  quietCheck prop_SignalWait\r
+  quietCheck prop_WaitSignal\r
+\r
+quietCheck = check defaultConfig{configEvery = \n args -> ""}\r
+\r
+\r
+prop_SignalWait l m n = l+m>=n ==> \r
+  [NewQSemN l,SignalQSemN m,WaitQSemN n] =^ [NewQSemN (l+m-n)]\r
+\r
+prop_WaitSignal l m n = l>=m ==> \r
+  [NewQSemN l,WaitQSemN m,SignalQSemN n] =^ [NewQSemN (l-m+n)]\r
+\r
+\r
+perform :: [Action] -> IO [Int]\r
+perform [] = return []\r
+\r
+perform (a:as) =\r
+  case a of\r
+    NewQSemN n   -> newQSemN n >>= \qs -> perform' qs as\r
+    _           -> error $ "Please use NewQSemN as first action" ++ show a\r
+\r
+\r
+perform' :: QSemN -> [Action] -> IO [Int]\r
+perform' _ [] = return []\r
+\r
+perform' qs (a:as) =\r
+  case a of\r
+    SignalQSemN n    -> signalQSemN qs n >> perform' qs as\r
+    WaitQSemN n      -> waitQSemN qs n >> perform' qs as\r
+    _               -> error $ "If you want to use " ++ show a \r
+                               ++ " please use the =^ operator"\r
+   \r
+\r
+actions :: Gen [Action]\r
+actions = do\r
+  i <- arbitrary\r
+  liftM (NewQSemN i:) (actions' i) \r
+\r
+\r
+actions' :: Int -> Gen [Action]\r
+actions' quantity =\r
+  oneof ([return [],\r
+         do i<- choose (0,maxBound)\r
+            liftM (SignalQSemN i:) (actions' (quantity+i))] ++\r
+         if quantity<=0\r
+            then []\r
+            else [do i<- choose (0,quantity)\r
+                     liftM (WaitQSemN i:) (actions' (quantity-i))])  \r
+\r
+\r
+(=^) :: [Action] -> [Action] -> Property\r
+c =^ c' =\r
+  forAll (actions' (delta 0 c))\r
+        (\suff -> observe c suff == observe c' suff)\r
+  where observe x suff = unsafePerformIO (perform (x++suff))\r
+\r
+\r
+(^=^) :: [Action] -> [Action] -> Property\r
+c ^=^ c' =\r
+  forAll actions\r
+        (\pref -> forAll (actions' (delta 0 (pref++c)))\r
+                         (\suff -> observe c pref suff == \r
+                                     observe c' pref suff))\r
+  where observe x pref suff = unsafePerformIO (perform (pref++x++suff))\r
+\r
+\r
+delta :: Int -> [Action] -> Int\r
+delta i [] = i\r
+\r
+delta _ (NewQSemN i:as) = delta i as\r
+\r
+delta i (SignalQSemN n:as) = delta (i+n) as\r
+\r
+delta i (WaitQSemN n:as) = delta (if i<n\r
+                                 then error "wait on 'empty' QSemN"\r
+                                 else i-n) as\r
+\r
diff --git a/tests/Concurrent/QSemN001.stdout b/tests/Concurrent/QSemN001.stdout
new file mode 100644 (file)
index 0000000..7288d19
--- /dev/null
@@ -0,0 +1,2 @@
+OK, passed 100 tests.
+OK, passed 100 tests.
diff --git a/tests/Concurrent/SampleVar001.hs b/tests/Concurrent/SampleVar001.hs
new file mode 100644 (file)
index 0000000..def86c5
--- /dev/null
@@ -0,0 +1,132 @@
+-------------------------------------------------------------------------------\r
+-- Module      :  SampleVarTest\r
+-------------------------------------------------------------------------------\r
+\r
+import Debug.QuickCheck\r
+import System.IO.Unsafe\r
+import Control.Concurrent\r
+import Control.Concurrent.SampleVar\r
+import Control.Monad\r
+\r
+\r
+data Action = NewEmptySampleVar | NewSampleVar Int | EmptySampleVar \r
+           | ReadSampleVar | WriteSampleVar Int | IsEmptySampleVar \r
+           | ReturnInt Int | ReturnBool Bool\r
+  deriving (Eq,Show)\r
+\r
+\r
+main = do \r
+  t <- myThreadId\r
+  forkIO (threadDelay 1000000 >> killThread t)\r
+       -- just in case we deadlock\r
+  testSampleVar\r
+\r
+testSampleVar :: IO ()\r
+testSampleVar = do\r
+  quickCheck prop_NewEIs_NewERet\r
+  quickCheck prop_NewIs_NewRet\r
+  quickCheck prop_NewRead_NewRet\r
+  quickCheck prop_NewEWriteRead_NewERet\r
+  quickCheck prop_WriteEmpty_Empty\r
+  quickCheck prop_WriteRead_Ret\r
+\r
+\r
+\r
+perform :: [Action] -> IO ([Bool],[Int])\r
+perform [] = return ([],[])\r
+\r
+perform (a:as) =\r
+  case a of\r
+    ReturnInt v              -> liftM (\(b,l) -> (b,v:l)) (perform as)\r
+    ReturnBool v      -> liftM (\(b,l) -> (v:b,l)) (perform as)\r
+    NewEmptySampleVar -> newEmptySampleVar >>= \sv -> perform' sv as\r
+    NewSampleVar n    -> newSampleVar n >>= \sv -> perform' sv as    \r
+\r
+\r
+perform' :: SampleVar Int -> [Action] -> IO ([Bool],[Int])\r
+perform' _ [] = return ([],[])\r
+\r
+perform' sv (a:as) =\r
+  case a of\r
+    ReturnInt v              -> liftM (\(b,l) -> (b,v:l)) (perform' sv as)\r
+    ReturnBool v      -> liftM (\(b,l) -> (v:b,l)) (perform' sv as)\r
+    EmptySampleVar    -> emptySampleVar sv >> perform' sv as\r
+    ReadSampleVar     -> liftM2 (\v (b,l) -> (b,v:l)) (readSampleVar sv) \r
+                               (perform' sv as)\r
+    WriteSampleVar n  -> writeSampleVar sv n >> perform' sv as\r
+    IsEmptySampleVar  -> liftM2 (\v (b,l) -> (v:b,l)) (isEmptySampleVar sv)\r
+                               (perform' sv as)\r
+\r
+\r
+actions :: Gen [Action]\r
+actions = do\r
+  oneof [liftM (NewEmptySampleVar:) (actions' True),\r
+        liftM2 (:) (liftM NewSampleVar arbitrary) (actions' False)] \r
+\r
+\r
+actions' :: Bool -> Gen [Action]\r
+actions' empty =\r
+  oneof ([return [],\r
+         liftM (IsEmptySampleVar:) (actions' empty),\r
+         liftM (EmptySampleVar:) (actions' True),\r
+         liftM2 (:) (liftM WriteSampleVar arbitrary) (actions' False)] ++\r
+         if empty\r
+            then []\r
+            else [liftM (ReadSampleVar:) (actions' True)])  \r
+\r
+\r
+(=^) :: [Action] -> [Action] -> Property\r
+c =^ c' =\r
+  forAll (actions' (delta True c))\r
+        (\suff -> observe c suff == observe c' suff)\r
+  where observe x suff = unsafePerformIO (perform (x++suff))\r
+\r
+\r
+(^=^) :: [Action] -> [Action] -> Property\r
+c ^=^ c' =\r
+  forAll actions\r
+        (\pref -> forAll (actions' (delta True (pref++c)))\r
+                         (\suff -> observe c pref suff == \r
+                                     observe c' pref suff))\r
+  where observe x pref suff = unsafePerformIO (perform (pref++x++suff))\r
+\r
+\r
+delta :: Bool -> [Action] -> Bool\r
+delta b [] = b\r
+\r
+delta b (ReturnInt _:as) = delta b as\r
+\r
+delta b (ReturnBool _:as) = delta b as\r
+\r
+delta _ (NewEmptySampleVar:as) = delta True as\r
+\r
+delta _ (NewSampleVar _:as) = delta False as\r
+\r
+delta _ (EmptySampleVar:as) = delta True as\r
+\r
+delta b (ReadSampleVar:as) = delta (if b\r
+                                      then error "read on empty SampleVar"\r
+                                      else True) as \r
+delta _ (WriteSampleVar _:as) = delta False as\r
+\r
+delta b (IsEmptySampleVar:as) = delta b as\r
+\r
+\r
+prop_NewEIs_NewERet = \r
+  [NewEmptySampleVar,IsEmptySampleVar] =^ [NewEmptySampleVar,ReturnBool True]\r
+\r
+prop_NewIs_NewRet n = \r
+  [NewSampleVar n,IsEmptySampleVar] =^ [NewSampleVar n,ReturnBool False]\r
+\r
+prop_NewRead_NewRet n =\r
+  [NewSampleVar n,ReadSampleVar] =^ [NewEmptySampleVar,ReturnInt n]\r
+\r
+prop_NewEWriteRead_NewERet n = \r
+  [NewEmptySampleVar,WriteSampleVar n,ReadSampleVar] =^ \r
+    [NewEmptySampleVar,ReturnInt n]\r
+\r
+prop_WriteEmpty_Empty n = \r
+  [WriteSampleVar n,EmptySampleVar] ^=^ [EmptySampleVar]\r
+\r
+prop_WriteRead_Ret n = \r
+  [WriteSampleVar n,ReadSampleVar] ^=^ [EmptySampleVar,ReturnInt n]\r
diff --git a/tests/Concurrent/SampleVar001.stdout b/tests/Concurrent/SampleVar001.stdout
new file mode 100644 (file)
index 0000000..65be56c
--- /dev/null
@@ -0,0 +1,6 @@
+0\b1\b2\b3\b4\b5\b6\b7\b8\b9\b10\b\b11\b\b12\b\b13\b\b14\b\b15\b\b16\b\b17\b\b18\b\b19\b\b20\b\b21\b\b22\b\b23\b\b24\b\b25\b\b26\b\b27\b\b28\b\b29\b\b30\b\b31\b\b32\b\b33\b\b34\b\b35\b\b36\b\b37\b\b38\b\b39\b\b40\b\b41\b\b42\b\b43\b\b44\b\b45\b\b46\b\b47\b\b48\b\b49\b\b50\b\b51\b\b52\b\b53\b\b54\b\b55\b\b56\b\b57\b\b58\b\b59\b\b60\b\b61\b\b62\b\b63\b\b64\b\b65\b\b66\b\b67\b\b68\b\b69\b\b70\b\b71\b\b72\b\b73\b\b74\b\b75\b\b76\b\b77\b\b78\b\b79\b\b80\b\b81\b\b82\b\b83\b\b84\b\b85\b\b86\b\b87\b\b88\b\b89\b\b90\b\b91\b\b92\b\b93\b\b94\b\b95\b\b96\b\b97\b\b98\b\b99\b\bOK, passed 100 tests.
+0\b1\b2\b3\b4\b5\b6\b7\b8\b9\b10\b\b11\b\b12\b\b13\b\b14\b\b15\b\b16\b\b17\b\b18\b\b19\b\b20\b\b21\b\b22\b\b23\b\b24\b\b25\b\b26\b\b27\b\b28\b\b29\b\b30\b\b31\b\b32\b\b33\b\b34\b\b35\b\b36\b\b37\b\b38\b\b39\b\b40\b\b41\b\b42\b\b43\b\b44\b\b45\b\b46\b\b47\b\b48\b\b49\b\b50\b\b51\b\b52\b\b53\b\b54\b\b55\b\b56\b\b57\b\b58\b\b59\b\b60\b\b61\b\b62\b\b63\b\b64\b\b65\b\b66\b\b67\b\b68\b\b69\b\b70\b\b71\b\b72\b\b73\b\b74\b\b75\b\b76\b\b77\b\b78\b\b79\b\b80\b\b81\b\b82\b\b83\b\b84\b\b85\b\b86\b\b87\b\b88\b\b89\b\b90\b\b91\b\b92\b\b93\b\b94\b\b95\b\b96\b\b97\b\b98\b\b99\b\bOK, passed 100 tests.
+0\b1\b2\b3\b4\b5\b6\b7\b8\b9\b10\b\b11\b\b12\b\b13\b\b14\b\b15\b\b16\b\b17\b\b18\b\b19\b\b20\b\b21\b\b22\b\b23\b\b24\b\b25\b\b26\b\b27\b\b28\b\b29\b\b30\b\b31\b\b32\b\b33\b\b34\b\b35\b\b36\b\b37\b\b38\b\b39\b\b40\b\b41\b\b42\b\b43\b\b44\b\b45\b\b46\b\b47\b\b48\b\b49\b\b50\b\b51\b\b52\b\b53\b\b54\b\b55\b\b56\b\b57\b\b58\b\b59\b\b60\b\b61\b\b62\b\b63\b\b64\b\b65\b\b66\b\b67\b\b68\b\b69\b\b70\b\b71\b\b72\b\b73\b\b74\b\b75\b\b76\b\b77\b\b78\b\b79\b\b80\b\b81\b\b82\b\b83\b\b84\b\b85\b\b86\b\b87\b\b88\b\b89\b\b90\b\b91\b\b92\b\b93\b\b94\b\b95\b\b96\b\b97\b\b98\b\b99\b\bOK, passed 100 tests.
+0\b1\b2\b3\b4\b5\b6\b7\b8\b9\b10\b\b11\b\b12\b\b13\b\b14\b\b15\b\b16\b\b17\b\b18\b\b19\b\b20\b\b21\b\b22\b\b23\b\b24\b\b25\b\b26\b\b27\b\b28\b\b29\b\b30\b\b31\b\b32\b\b33\b\b34\b\b35\b\b36\b\b37\b\b38\b\b39\b\b40\b\b41\b\b42\b\b43\b\b44\b\b45\b\b46\b\b47\b\b48\b\b49\b\b50\b\b51\b\b52\b\b53\b\b54\b\b55\b\b56\b\b57\b\b58\b\b59\b\b60\b\b61\b\b62\b\b63\b\b64\b\b65\b\b66\b\b67\b\b68\b\b69\b\b70\b\b71\b\b72\b\b73\b\b74\b\b75\b\b76\b\b77\b\b78\b\b79\b\b80\b\b81\b\b82\b\b83\b\b84\b\b85\b\b86\b\b87\b\b88\b\b89\b\b90\b\b91\b\b92\b\b93\b\b94\b\b95\b\b96\b\b97\b\b98\b\b99\b\bOK, passed 100 tests.
+0\b1\b2\b3\b4\b5\b6\b7\b8\b9\b10\b\b11\b\b12\b\b13\b\b14\b\b15\b\b16\b\b17\b\b18\b\b19\b\b20\b\b21\b\b22\b\b23\b\b24\b\b25\b\b26\b\b27\b\b28\b\b29\b\b30\b\b31\b\b32\b\b33\b\b34\b\b35\b\b36\b\b37\b\b38\b\b39\b\b40\b\b41\b\b42\b\b43\b\b44\b\b45\b\b46\b\b47\b\b48\b\b49\b\b50\b\b51\b\b52\b\b53\b\b54\b\b55\b\b56\b\b57\b\b58\b\b59\b\b60\b\b61\b\b62\b\b63\b\b64\b\b65\b\b66\b\b67\b\b68\b\b69\b\b70\b\b71\b\b72\b\b73\b\b74\b\b75\b\b76\b\b77\b\b78\b\b79\b\b80\b\b81\b\b82\b\b83\b\b84\b\b85\b\b86\b\b87\b\b88\b\b89\b\b90\b\b91\b\b92\b\b93\b\b94\b\b95\b\b96\b\b97\b\b98\b\b99\b\bOK, passed 100 tests.
+0\b1\b2\b3\b4\b5\b6\b7\b8\b9\b10\b\b11\b\b12\b\b13\b\b14\b\b15\b\b16\b\b17\b\b18\b\b19\b\b20\b\b21\b\b22\b\b23\b\b24\b\b25\b\b26\b\b27\b\b28\b\b29\b\b30\b\b31\b\b32\b\b33\b\b34\b\b35\b\b36\b\b37\b\b38\b\b39\b\b40\b\b41\b\b42\b\b43\b\b44\b\b45\b\b46\b\b47\b\b48\b\b49\b\b50\b\b51\b\b52\b\b53\b\b54\b\b55\b\b56\b\b57\b\b58\b\b59\b\b60\b\b61\b\b62\b\b63\b\b64\b\b65\b\b66\b\b67\b\b68\b\b69\b\b70\b\b71\b\b72\b\b73\b\b74\b\b75\b\b76\b\b77\b\b78\b\b79\b\b80\b\b81\b\b82\b\b83\b\b84\b\b85\b\b86\b\b87\b\b88\b\b89\b\b90\b\b91\b\b92\b\b93\b\b94\b\b95\b\b96\b\b97\b\b98\b\b99\b\bOK, passed 100 tests.
diff --git a/tests/Concurrent/ThreadDelay001.hs b/tests/Concurrent/ThreadDelay001.hs
new file mode 100644 (file)
index 0000000..c60f997
--- /dev/null
@@ -0,0 +1,26 @@
+
+-- Test that threadDelay actually sleeps for (at least) as long as we
+-- ask it
+
+module Main (main) where
+
+import Control.Concurrent
+import Control.Monad
+import System.Time
+
+main = mapM_ delay (0 : take 11 (iterate (*5) 1))
+
+delay n = do
+  tS <- getClockTime
+  threadDelay n
+  tE <- getClockTime
+
+  let req = fromIntegral n * 10 ^ (6 :: Int)
+      obs = case normalizeTimeDiff (diffClockTimes tE tS) of
+                TimeDiff 0 0 0 0 0 s ps -> 10^12 * fromIntegral s + ps
+      diff = obs - req
+      diff' :: Double
+      diff' = fromIntegral diff /  10^(12 :: Int)
+
+  when (obs < req) $ print (tS, tE, req, obs, diff, diff')
+
diff --git a/tests/Concurrent/all.T b/tests/Concurrent/all.T
new file mode 100644 (file)
index 0000000..004c6a1
--- /dev/null
@@ -0,0 +1,10 @@
+setTestOpts(only_compiler_types(['ghc']))
+
+test('SampleVar001', reqlib('QuickCheck'), compile_and_run, ['-package QuickCheck'])
+test('4876', reqlib('random'), compile_and_run, ['']) # another SampleVar test
+
+test('Chan001',      reqlib('QuickCheck'), compile_and_run, ['-package QuickCheck'])
+test('MVar001',      reqlib('QuickCheck'), compile_and_run, ['-package QuickCheck'])
+test('QSemN001',     reqlib('QuickCheck'), compile_and_run, ['-package QuickCheck'])
+test('QSem001',      reqlib('QuickCheck'), compile_and_run, ['-package QuickCheck'])
+test('ThreadDelay001', normal, compile_and_run, [''])
diff --git a/tests/IO/2122.hs b/tests/IO/2122.hs
new file mode 100644 (file)
index 0000000..6807f34
--- /dev/null
@@ -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/tests/IO/3307.hs b/tests/IO/3307.hs
new file mode 100644 (file)
index 0000000..fb1a360
--- /dev/null
@@ -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/tests/IO/3307.stdout b/tests/IO/3307.stdout
new file mode 100644 (file)
index 0000000..8b26b5f
--- /dev/null
@@ -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/tests/IO/4808.hs b/tests/IO/4808.hs
new file mode 100644 (file)
index 0000000..5d64762
--- /dev/null
@@ -0,0 +1,13 @@
+import System.IO
+import GHC.IO.Handle
+import GHC.IO.FD as FD
+
+main = do
+  writeFile "4808.test" "This is some test data"
+  (fd, _) <- FD.openFile "4808.test" ReadWriteMode False
+  hdl <- mkDuplexHandle fd "4808.test" Nothing nativeNewlineMode
+  hClose hdl
+  (fd2, _) <- FD.openFile "4808.test" ReadWriteMode False
+  print (fdFD fd == fdFD fd2) -- should be True
+  hGetLine hdl >>= print -- should fail with an exception
+
diff --git a/tests/IO/4808.stderr b/tests/IO/4808.stderr
new file mode 100644 (file)
index 0000000..25396c9
--- /dev/null
@@ -0,0 +1 @@
+4808: 4808.test: hGetLine: illegal operation (handle is closed)
diff --git a/tests/IO/4808.stdout b/tests/IO/4808.stdout
new file mode 100644 (file)
index 0000000..0ca9514
--- /dev/null
@@ -0,0 +1 @@
+True
diff --git a/tests/IO/4855.hs b/tests/IO/4855.hs
new file mode 100644 (file)
index 0000000..fa862aa
--- /dev/null
@@ -0,0 +1,3 @@
+import Debug.Trace
+
+main = trace "我爱我的电脑" $ return ()
\ No newline at end of file
diff --git a/tests/IO/4855.stderr b/tests/IO/4855.stderr
new file mode 100644 (file)
index 0000000..558550e
--- /dev/null
@@ -0,0 +1 @@
+我爱我的电脑
diff --git a/tests/IO/4895.hs b/tests/IO/4895.hs
new file mode 100644 (file)
index 0000000..bb37915
--- /dev/null
@@ -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/tests/IO/4895.stdout b/tests/IO/4895.stdout
new file mode 100644 (file)
index 0000000..f599e28
--- /dev/null
@@ -0,0 +1 @@
+10
diff --git a/tests/IO/IOError001.hs b/tests/IO/IOError001.hs
new file mode 100644 (file)
index 0000000..dee7f31
--- /dev/null
@@ -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/tests/IO/IOError001.stdout b/tests/IO/IOError001.stdout
new file mode 100644 (file)
index 0000000..1e689bb
--- /dev/null
@@ -0,0 +1,2 @@
+<stdin>: hGetChar: illegal operation (handle is closed)
+<stdin>: hGetChar: illegal operation (handle is closed)
diff --git a/tests/IO/IOError001.stdout-hugs b/tests/IO/IOError001.stdout-hugs
new file mode 100644 (file)
index 0000000..036084a
--- /dev/null
@@ -0,0 +1,2 @@
+<stdin>: getChar: illegal operation (handle is semi-closed)
+<stdin>: getChar: illegal operation (handle is semi-closed)
diff --git a/tests/IO/IOError002.hs b/tests/IO/IOError002.hs
new file mode 100644 (file)
index 0000000..144e627
--- /dev/null
@@ -0,0 +1,5 @@
+-- !!! IOErrors should have Eq defined
+
+import System.IO
+
+main = print (userError "urk" == userError "urk")
diff --git a/tests/IO/IOError002.stdout b/tests/IO/IOError002.stdout
new file mode 100644 (file)
index 0000000..0ca9514
--- /dev/null
@@ -0,0 +1 @@
+True
diff --git a/tests/IO/Makefile b/tests/IO/Makefile
new file mode 100644 (file)
index 0000000..a8bdf08
--- /dev/null
@@ -0,0 +1,52 @@
+# This Makefile runs the tests using GHC's testsuite framework.  It
+# assumes the package is part of a GHC build tree with the testsuite
+# installed in ../../../testsuite.
+
+TOP=../../../../testsuite
+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/tests/IO/T4144.hs b/tests/IO/T4144.hs
new file mode 100644 (file)
index 0000000..ca14363
--- /dev/null
@@ -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/tests/IO/T4144.stdout b/tests/IO/T4144.stdout
new file mode 100644 (file)
index 0000000..8b8441b
--- /dev/null
@@ -0,0 +1 @@
+"test"
diff --git a/tests/IO/all.T b/tests/IO/all.T
new file mode 100644 (file)
index 0000000..38cdabc
--- /dev/null
@@ -0,0 +1,161 @@
+# -*- 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',  extra_clean(['openFile003Dir']), 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',
+     [if_msys(expect_fail), # See trac #5599
+      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('decodingerror002',normal, compile_and_run, [''])
+
+encoding001Encodings = ["utf8", "utf8_bom", "utf16", "utf16le",
+                        "utf16be", "utf32", "utf32le", "utf32be"]
+encoding001CleanFiles = []
+for e in encoding001Encodings:
+    encoding001CleanFiles.append('encoding001.' + e)
+for e1 in encoding001Encodings:
+    for e2 in encoding001Encodings:
+        encoding001CleanFiles.append('encoding001.' + e1 + '.' + e2)
+test('encoding001',
+     extra_clean(encoding001CleanFiles),
+     compile_and_run, [''])
+
+test('encoding002', normal, compile_and_run, [''])
+
+test('environment001',
+     [if_msys(expect_fail), # See trac #5599
+      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('T4144', normal, compile_and_run, [''])
+
+test('encodingerror001', normal, compile_and_run, [''])
+
+test('4808', [exit_code(1), extra_clean(['4808.test'])], compile_and_run, [''])
+test('4895', normal, compile_and_run, [''])
diff --git a/tests/IO/concio001.hs b/tests/IO/concio001.hs
new file mode 100644 (file)
index 0000000..786a311
--- /dev/null
@@ -0,0 +1,6 @@
+import Control.Concurrent
+
+main = do
+  forkIO $ do threadDelay  100000; putStrLn "child"
+  getLine
+  putStrLn "parent"
diff --git a/tests/IO/concio001.stdout b/tests/IO/concio001.stdout
new file mode 100644 (file)
index 0000000..141a8cd
--- /dev/null
@@ -0,0 +1,2 @@
+child
+parent
diff --git a/tests/IO/concio001.thr.stdout b/tests/IO/concio001.thr.stdout
new file mode 100644 (file)
index 0000000..141a8cd
--- /dev/null
@@ -0,0 +1,2 @@
+child
+parent
diff --git a/tests/IO/concio002.hs b/tests/IO/concio002.hs
new file mode 100644 (file)
index 0000000..60a2ed2
--- /dev/null
@@ -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/tests/IO/concio002.stdout b/tests/IO/concio002.stdout
new file mode 100644 (file)
index 0000000..32640ae
--- /dev/null
@@ -0,0 +1,4 @@
+parent1
+child
+msg
+parent2
diff --git a/tests/IO/countReaders001.hs b/tests/IO/countReaders001.hs
new file mode 100644 (file)
index 0000000..2648ae7
--- /dev/null
@@ -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/tests/IO/countReaders001.stdout b/tests/IO/countReaders001.stdout
new file mode 100644 (file)
index 0000000..41644bf
--- /dev/null
@@ -0,0 +1 @@
+Left countReaders001.txt: openFile: resource busy (file is locked)
diff --git a/tests/IO/countReaders001.stdout-i386-unknown-mingw32 b/tests/IO/countReaders001.stdout-i386-unknown-mingw32
new file mode 100644 (file)
index 0000000..bf80d9d
--- /dev/null
@@ -0,0 +1 @@
+Left countReaders001.txt: openFile: permission denied (Permission denied)
diff --git a/tests/IO/decodingerror001.hs b/tests/IO/decodingerror001.hs
new file mode 100644 (file)
index 0000000..6c9dca1
--- /dev/null
@@ -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/tests/IO/decodingerror001.in1 b/tests/IO/decodingerror001.in1
new file mode 100644 (file)
index 0000000..7686e7b
--- /dev/null
@@ -0,0 +1 @@
+UTF8 error:\80after error
diff --git a/tests/IO/decodingerror001.in2 b/tests/IO/decodingerror001.in2
new file mode 100644 (file)
index 0000000..fe33bd3
--- /dev/null
@@ -0,0 +1 @@
+UTF8 incomplete sequence at end:ð\90
\ No newline at end of file
diff --git a/tests/IO/decodingerror001.stdout b/tests/IO/decodingerror001.stdout
new file mode 100644 (file)
index 0000000..24ca1a9
--- /dev/null
@@ -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)
+UTF8 incomplete sequence at end:Left decodingerror001.in2: hGetChar: invalid argument (invalid byte sequence)
+UTF8 incomplete sequence at end:Left decodingerror001.in2: hGetChar: invalid argument (invalid byte sequence)
+UTF8 incomplete sequence at end:Left decodingerror001.in2: hGetChar: invalid argument (invalid byte sequence)
+UTF8 incomplete sequence at end:Left decodingerror001.in2: hGetChar: invalid argument (invalid byte sequence)
diff --git a/tests/IO/decodingerror002.hs b/tests/IO/decodingerror002.hs
new file mode 100644 (file)
index 0000000..db610bd
--- /dev/null
@@ -0,0 +1,23 @@
+import Control.Monad
+import System.IO
+import System.IO.Error
+import GHC.IO.Handle (hSetEncoding)
+
+main = do
+  -- Explicitly set stdout encoding so that the UTF8//ROUNDTRIP
+  -- test is always able to write the surrogate byte out without error.
+  enc <- mkTextEncoding "UTF-8//ROUNDTRIP"
+  hSetEncoding stdout enc
+  alltests "decodingerror002.in"
+
+alltests file = mapM (test file)  ["UTF-8",
+                                   "UTF-8//IGNORE",
+                                   "UTF-8//TRANSLIT",
+                                   "UTF-8//ROUNDTRIP"]
+
+test file enc_name = do
+  h <- openFile file ReadMode
+  enc <- mkTextEncoding enc_name
+  hSetEncoding h enc
+  e <- try $ forever $ hGetChar h >>= putChar
+  print (e :: Either IOError ())
diff --git a/tests/IO/decodingerror002.in b/tests/IO/decodingerror002.in
new file mode 100644 (file)
index 0000000..195ee38
--- /dev/null
@@ -0,0 +1 @@
\ No newline at end of file
diff --git a/tests/IO/decodingerror002.stdout b/tests/IO/decodingerror002.stdout
new file mode 100644 (file)
index 0000000..e1cef33
--- /dev/null
@@ -0,0 +1,4 @@
+Left decodingerror002.in: hGetChar: invalid argument (invalid byte sequence)
+Left decodingerror002.in: hGetChar: end of file
+�Left decodingerror002.in: hGetChar: end of file
+ÈLeft decodingerror002.in: hGetChar: end of file
diff --git a/tests/IO/encoding001.hs b/tests/IO/encoding001.hs
new file mode 100644 (file)
index 0000000..9480abb
--- /dev/null
@@ -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/tests/IO/encoding002.hs b/tests/IO/encoding002.hs
new file mode 100644 (file)
index 0000000..65d60a3
--- /dev/null
@@ -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/tests/IO/encoding002.stdout b/tests/IO/encoding002.stdout
new file mode 100644 (file)
index 0000000..0cc885b
--- /dev/null
@@ -0,0 +1,61 @@
+== UTF-8: roundtripping
+[72,105,237,178,128,33]
+"Hi\56557\56498\56448!"
+[72,105,237,178,128,33]
+True
+
+== UTF-8: decoding
+"recoverDecode: invalid argument (invalid byte sequence)"
+"Hi!"
+"Hi\65533\65533\65533!"
+"Hi\56557\56498\56448!"
+== 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\56575\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\56543\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\56557\56498\56448\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\56448\56498\56557!"
+== 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/tests/IO/encodingerror001.hs b/tests/IO/encodingerror001.hs
new file mode 100644 (file)
index 0000000..327b490
--- /dev/null
@@ -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/tests/IO/encodingerror001.stdout b/tests/IO/encodingerror001.stdout
new file mode 100644 (file)
index 0000000..7406cd9
--- /dev/null
@@ -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/tests/IO/environment001.hs b/tests/IO/environment001.hs
new file mode 100644 (file)
index 0000000..11d7912
--- /dev/null
@@ -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/tests/IO/environment001.stdout b/tests/IO/environment001.stdout
new file mode 100644 (file)
index 0000000..2434d0c
--- /dev/null
@@ -0,0 +1,6 @@
+马克斯
+Test 1: 3
+说
+Test 2: 1
+你好!
+Test 3: 3
diff --git a/tests/IO/finalization001.hs b/tests/IO/finalization001.hs
new file mode 100644 (file)
index 0000000..44828a6
--- /dev/null
@@ -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" ReadMode
+  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/tests/IO/finalization001.stdout b/tests/IO/finalization001.stdout
new file mode 100644 (file)
index 0000000..ec04732
--- /dev/null
@@ -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/tests/IO/hClose001.hs b/tests/IO/hClose001.hs
new file mode 100644 (file)
index 0000000..8d31447
--- /dev/null
@@ -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/tests/IO/hClose001.stdout b/tests/IO/hClose001.stdout
new file mode 100644 (file)
index 0000000..1ddd42b
--- /dev/null
@@ -0,0 +1 @@
+Okay
diff --git a/tests/IO/hClose002.hs b/tests/IO/hClose002.hs
new file mode 100644 (file)
index 0000000..ebf26b4
--- /dev/null
@@ -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/tests/IO/hClose002.stdout b/tests/IO/hClose002.stdout
new file mode 100644 (file)
index 0000000..f26be4a
--- /dev/null
@@ -0,0 +1,4 @@
+Left hClose002.tmp: hClose: invalid argument (Bad file descriptor)
+Right ()
+Right ()
+Right ()
diff --git a/tests/IO/hClose002.stdout-i386-unknown-solaris2 b/tests/IO/hClose002.stdout-i386-unknown-solaris2
new file mode 100644 (file)
index 0000000..39a24de
--- /dev/null
@@ -0,0 +1,4 @@
+Left hClose002.tmp: hClose: invalid argument (Bad file number)
+Right ()
+Right ()
+Right ()
diff --git a/tests/IO/hClose003.hs b/tests/IO/hClose003.hs
new file mode 100644 (file)
index 0000000..cbaf49d
--- /dev/null
@@ -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/tests/IO/hClose003.stdout b/tests/IO/hClose003.stdout
new file mode 100644 (file)
index 0000000..d12f84d
--- /dev/null
@@ -0,0 +1,4 @@
+Right ()
+False
+Left <file descriptor: X>: hClose: resource vanished (Broken pipe)
+False
diff --git a/tests/IO/hDuplicateTo001.hs b/tests/IO/hDuplicateTo001.hs
new file mode 100644 (file)
index 0000000..5a1484a
--- /dev/null
@@ -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/tests/IO/hDuplicateTo001.stderr b/tests/IO/hDuplicateTo001.stderr
new file mode 100644 (file)
index 0000000..14a3143
--- /dev/null
@@ -0,0 +1,2 @@
+h: True
+stdout: 1
diff --git a/tests/IO/hFileSize001.hs b/tests/IO/hFileSize001.hs
new file mode 100644 (file)
index 0000000..62b3e88
--- /dev/null
@@ -0,0 +1,8 @@
+import System.IO
+
+-- !!! test hFileSize
+
+main = do
+    h  <- openFile "hFileSize001.hs" ReadMode
+    sz <- hFileSize h
+    print sz
diff --git a/tests/IO/hFileSize001.stdout b/tests/IO/hFileSize001.stdout
new file mode 100644 (file)
index 0000000..94361d4
--- /dev/null
@@ -0,0 +1 @@
+132
diff --git a/tests/IO/hFileSize001.stdout-mingw b/tests/IO/hFileSize001.stdout-mingw
new file mode 100644 (file)
index 0000000..6a4573e
--- /dev/null
@@ -0,0 +1 @@
+133
diff --git a/tests/IO/hFileSize002.hs b/tests/IO/hFileSize002.hs
new file mode 100644 (file)
index 0000000..6c1ad2f
--- /dev/null
@@ -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/tests/IO/hFileSize002.stdout b/tests/IO/hFileSize002.stdout
new file mode 100644 (file)
index 0000000..23dd734
--- /dev/null
@@ -0,0 +1,5 @@
+-1
+9
+18
+27
+36
diff --git a/tests/IO/hFlush001.hs b/tests/IO/hFlush001.hs
new file mode 100644 (file)
index 0000000..78c7b7e
--- /dev/null
@@ -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/tests/IO/hFlush001.stdout b/tests/IO/hFlush001.stdout
new file mode 100644 (file)
index 0000000..0954a7a
--- /dev/null
@@ -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/tests/IO/hGetBuf001.hs b/tests/IO/hGetBuf001.hs
new file mode 100644 (file)
index 0000000..eea599e
--- /dev/null
@@ -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/tests/IO/hGetBuf001.stdout b/tests/IO/hGetBuf001.stdout
new file mode 100644 (file)
index 0000000..694ff4e
--- /dev/null
@@ -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/tests/IO/hGetBuffering001.hs b/tests/IO/hGetBuffering001.hs
new file mode 100644 (file)
index 0000000..83188b2
--- /dev/null
@@ -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/tests/IO/hGetBuffering001.stdout b/tests/IO/hGetBuffering001.stdout
new file mode 100644 (file)
index 0000000..75b9a13
--- /dev/null
@@ -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/tests/IO/hGetChar001.hs b/tests/IO/hGetChar001.hs
new file mode 100644 (file)
index 0000000..f5ca666
--- /dev/null
@@ -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/tests/IO/hGetChar001.stdin b/tests/IO/hGetChar001.stdin
new file mode 100644 (file)
index 0000000..2510fca
--- /dev/null
@@ -0,0 +1,2 @@
+42
+-7
diff --git a/tests/IO/hGetChar001.stdout b/tests/IO/hGetChar001.stdout
new file mode 100644 (file)
index 0000000..47d4185
--- /dev/null
@@ -0,0 +1 @@
+Enter an integer: Enter another integer: Their sum is 35
diff --git a/tests/IO/hGetLine001.hs b/tests/IO/hGetLine001.hs
new file mode 100644 (file)
index 0000000..b595062
--- /dev/null
@@ -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/tests/IO/hGetLine001.stdout b/tests/IO/hGetLine001.stdout
new file mode 100644 (file)
index 0000000..3e023db
--- /dev/null
@@ -0,0 +1,100 @@
+-- !!! testing hGetLine\r
+\r
+import System.IO\r
+\r
+-- one version of 'cat'\r
+main = do\r
+  let loop h = do b <- hIsEOF h\r
+                 if b then return ()\r
+                      else do l <- hGetLine h; putStrLn l; loop h\r
+  loop stdin \r
+\r
+  h <- openFile "hGetLine001.hs" ReadMode\r
+\r
+  hSetBinaryMode stdout True\r
+\r
+  hSetBuffering h NoBuffering\r
+  loop h\r
+\r
+  hSeek h AbsoluteSeek 0\r
+  hSetBuffering h LineBuffering\r
+  loop h\r
+\r
+  hSeek h AbsoluteSeek 0\r
+  hSetBuffering h (BlockBuffering (Just 83))\r
+  loop h\r
+-- !!! testing hGetLine\r
+\r
+import System.IO\r
+\r
+-- one version of 'cat'\r
+main = do\r
+  let loop h = do b <- hIsEOF h\r
+                 if b then return ()\r
+                      else do l <- hGetLine h; putStrLn l; loop h\r
+  loop stdin \r
+\r
+  h <- openFile "hGetLine001.hs" ReadMode\r
+\r
+  hSetBinaryMode stdout True\r
+\r
+  hSetBuffering h NoBuffering\r
+  loop h\r
+\r
+  hSeek h AbsoluteSeek 0\r
+  hSetBuffering h LineBuffering\r
+  loop h\r
+\r
+  hSeek h AbsoluteSeek 0\r
+  hSetBuffering h (BlockBuffering (Just 83))\r
+  loop h\r
+-- !!! testing hGetLine\r
+\r
+import System.IO\r
+\r
+-- one version of 'cat'\r
+main = do\r
+  let loop h = do b <- hIsEOF h\r
+                 if b then return ()\r
+                      else do l <- hGetLine h; putStrLn l; loop h\r
+  loop stdin \r
+\r
+  h <- openFile "hGetLine001.hs" ReadMode\r
+\r
+  hSetBinaryMode stdout True\r
+\r
+  hSetBuffering h NoBuffering\r
+  loop h\r
+\r
+  hSeek h AbsoluteSeek 0\r
+  hSetBuffering h LineBuffering\r
+  loop h\r
+\r
+  hSeek h AbsoluteSeek 0\r
+  hSetBuffering h (BlockBuffering (Just 83))\r
+  loop h\r
+-- !!! testing hGetLine\r
+\r
+import System.IO\r
+\r
+-- one version of 'cat'\r
+main = do\r
+  let loop h = do b <- hIsEOF h\r
+                 if b then return ()\r
+                      else do l <- hGetLine h; putStrLn l; loop h\r
+  loop stdin \r
+\r
+  h <- openFile "hGetLine001.hs" ReadMode\r
+\r
+  hSetBinaryMode stdout True\r
+\r
+  hSetBuffering h NoBuffering\r
+  loop h\r
+\r
+  hSeek h AbsoluteSeek 0\r
+  hSetBuffering h LineBuffering\r
+  loop h\r
+\r
+  hSeek h AbsoluteSeek 0\r
+  hSetBuffering h (BlockBuffering (Just 83))\r
+  loop h\r
diff --git a/tests/IO/hGetLine002.hs b/tests/IO/hGetLine002.hs
new file mode 100644 (file)
index 0000000..5c08b71
--- /dev/null
@@ -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/tests/IO/hGetLine002.stdin b/tests/IO/hGetLine002.stdin
new file mode 100644 (file)
index 0000000..808eafd
--- /dev/null
@@ -0,0 +1 @@
+this line doesn't end with a newline
\ No newline at end of file
diff --git a/tests/IO/hGetLine002.stdout b/tests/IO/hGetLine002.stdout
new file mode 100644 (file)
index 0000000..0ec29ad
--- /dev/null
@@ -0,0 +1,2 @@
+this line doesn't end with a newline
+<stdin>: hGetLine: end of file
diff --git a/tests/IO/hGetLine002.stdout-hugs b/tests/IO/hGetLine002.stdout-hugs
new file mode 100644 (file)
index 0000000..ed87135
--- /dev/null
@@ -0,0 +1,2 @@
+this line doesn't end with a newline
+<stdin>: IO.hGetChar: end of file (end of file)
diff --git a/tests/IO/hGetLine003.hs b/tests/IO/hGetLine003.hs
new file mode 100644 (file)
index 0000000..cc03c60
--- /dev/null
@@ -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/tests/IO/hGetLine003.stdin b/tests/IO/hGetLine003.stdin
new file mode 100644 (file)
index 0000000..b8b74a4
--- /dev/null
@@ -0,0 +1 @@
+this line doesn't end with a newline
diff --git a/tests/IO/hGetLine003.stdout b/tests/IO/hGetLine003.stdout
new file mode 100644 (file)
index 0000000..6daac48
--- /dev/null
@@ -0,0 +1,2 @@
+this line doesn't end with a newline
+done
diff --git a/tests/IO/hGetPosn001.hs b/tests/IO/hGetPosn001.hs
new file mode 100644 (file)
index 0000000..5a0d7d4
--- /dev/null
@@ -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/tests/IO/hGetPosn001.in b/tests/IO/hGetPosn001.in
new file mode 100644 (file)
index 0000000..2e25371
--- /dev/null
@@ -0,0 +1,2 @@
+123456789*123456789*123456789*123456789*123456789*123456789*123456789*12
+         1         2         3         4         5         6         7  
diff --git a/tests/IO/hGetPosn001.stdout b/tests/IO/hGetPosn001.stdout
new file mode 100644 (file)
index 0000000..10adafd
--- /dev/null
@@ -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/tests/IO/hGetPosn001.stdout-hugs b/tests/IO/hGetPosn001.stdout-hugs
new file mode 100644 (file)
index 0000000..56e989c
--- /dev/null
@@ -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/tests/IO/hIsEOF001.hs b/tests/IO/hIsEOF001.hs
new file mode 100644 (file)
index 0000000..2e5dbdc
--- /dev/null
@@ -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/tests/IO/hIsEOF001.stdout b/tests/IO/hIsEOF001.stdout
new file mode 100644 (file)
index 0000000..76460ac
--- /dev/null
@@ -0,0 +1,2 @@
+hIsEOF failed
+False
diff --git a/tests/IO/hIsEOF002.hs b/tests/IO/hIsEOF002.hs
new file mode 100644 (file)
index 0000000..26f5abd
--- /dev/null
@@ -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/tests/IO/hIsEOF002.stdout b/tests/IO/hIsEOF002.stdout
new file mode 100644 (file)
index 0000000..3aa5e1a
--- /dev/null
@@ -0,0 +1,16 @@
+True
+False
+'\n'
+True
+False
+'\n'
+True
+False
+'\n'
+True
+False
+'\n'
+True
+True
+False
+'x'
diff --git a/tests/IO/hReady001.hs b/tests/IO/hReady001.hs
new file mode 100644 (file)
index 0000000..00888da
--- /dev/null
@@ -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/tests/IO/hReady001.stdout b/tests/IO/hReady001.stdout
new file mode 100644 (file)
index 0000000..af35f80
--- /dev/null
@@ -0,0 +1,2 @@
+True
+hReady001.hs: hWaitForInput: end of file
diff --git a/tests/IO/hReady002.hs b/tests/IO/hReady002.hs
new file mode 100644 (file)
index 0000000..6db22a1
--- /dev/null
@@ -0,0 +1,10 @@
+-- test for bug #4078\r
+import System.IO\r
+import Control.Concurrent\r
+import System.Exit\r
+\r
+main = do\r
+  m <- newEmptyMVar\r
+  forkIO $ do threadDelay 500000; putMVar m Nothing\r
+  forkIO $ do hReady stdin >>= putMVar m . Just\r
+  takeMVar m >>= print\r
diff --git a/tests/IO/hReady002.stdout b/tests/IO/hReady002.stdout
new file mode 100644 (file)
index 0000000..6217d00
--- /dev/null
@@ -0,0 +1 @@
+Just False\r
diff --git a/tests/IO/hSeek001.hs b/tests/IO/hSeek001.hs
new file mode 100644 (file)
index 0000000..d05068e
--- /dev/null
@@ -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/tests/IO/hSeek001.in b/tests/IO/hSeek001.in
new file mode 100644 (file)
index 0000000..e85d5b4
--- /dev/null
@@ -0,0 +1 @@
+abcdefghijklmnopqrstuvwxyz
\ No newline at end of file
diff --git a/tests/IO/hSeek001.stdout b/tests/IO/hSeek001.stdout
new file mode 100644 (file)
index 0000000..ab6c1d7
--- /dev/null
@@ -0,0 +1,7 @@
+z
+x
+w
+z
+a
+k
+z
diff --git a/tests/IO/hSeek002.hs b/tests/IO/hSeek002.hs
new file mode 100644 (file)
index 0000000..8c9153c
--- /dev/null
@@ -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/tests/IO/hSeek002.stdout b/tests/IO/hSeek002.stdout
new file mode 100644 (file)
index 0000000..8069fe3
--- /dev/null
@@ -0,0 +1,5 @@
+False
+True
+False
+True
+False
diff --git a/tests/IO/hSeek003.hs b/tests/IO/hSeek003.hs
new file mode 100644 (file)
index 0000000..0340057
--- /dev/null
@@ -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/tests/IO/hSeek003.stdout b/tests/IO/hSeek003.stdout
new file mode 100644 (file)
index 0000000..7c765c5
--- /dev/null
@@ -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/tests/IO/hSeek004.hs b/tests/IO/hSeek004.hs
new file mode 100644 (file)
index 0000000..9ad7c13
--- /dev/null
@@ -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/tests/IO/hSeek004.stdout b/tests/IO/hSeek004.stdout
new file mode 100644 (file)
index 0000000..d2671a6
--- /dev/null
@@ -0,0 +1 @@
+Left hSeek004.out: hSeek: illegal operation (handle is not seekable)
diff --git a/tests/IO/hSeek004.stdout-mingw b/tests/IO/hSeek004.stdout-mingw
new file mode 100644 (file)
index 0000000..7d8e707
--- /dev/null
@@ -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/tests/IO/hSetBuffering002.hs b/tests/IO/hSetBuffering002.hs
new file mode 100644 (file)
index 0000000..3f55302
--- /dev/null
@@ -0,0 +1,6 @@
+import System.IO
+
+main = 
+    hSetBuffering stdin NoBuffering    >>
+    hSetBuffering stdout NoBuffering   >>
+    interact id
diff --git a/tests/IO/hSetBuffering002.stdout b/tests/IO/hSetBuffering002.stdout
new file mode 100644 (file)
index 0000000..3f55302
--- /dev/null
@@ -0,0 +1,6 @@
+import System.IO
+
+main = 
+    hSetBuffering stdin NoBuffering    >>
+    hSetBuffering stdout NoBuffering   >>
+    interact id
diff --git a/tests/IO/hSetBuffering003.hs b/tests/IO/hSetBuffering003.hs
new file mode 100644 (file)
index 0000000..74d399e
--- /dev/null
@@ -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/tests/IO/hSetBuffering003.stderr b/tests/IO/hSetBuffering003.stderr
new file mode 100644 (file)
index 0000000..a4cf877
--- /dev/null
@@ -0,0 +1 @@
+Hello stderr 1Hello stderr 2Hello stderr 3Hello stderr 4Hello stderr 5
\ No newline at end of file
diff --git a/tests/IO/hSetBuffering003.stdout b/tests/IO/hSetBuffering003.stdout
new file mode 100644 (file)
index 0000000..7768773
--- /dev/null
@@ -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/tests/IO/hSetBuffering004.hs b/tests/IO/hSetBuffering004.hs
new file mode 100644 (file)
index 0000000..eaee682
--- /dev/null
@@ -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/tests/IO/hSetBuffering004.stdout b/tests/IO/hSetBuffering004.stdout
new file mode 100644 (file)
index 0000000..7766eec
--- /dev/null
@@ -0,0 +1 @@
+'-'
diff --git a/tests/IO/hSetEncoding001.hs b/tests/IO/hSetEncoding001.hs
new file mode 100644 (file)
index 0000000..95f570d
--- /dev/null
@@ -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/tests/IO/hSetEncoding001.in b/tests/IO/hSetEncoding001.in
new file mode 100644 (file)
index 0000000..03f2974
Binary files /dev/null and b/tests/IO/hSetEncoding001.in differ
diff --git a/tests/IO/hSetEncoding001.stdout b/tests/IO/hSetEncoding001.stdout
new file mode 100644 (file)
index 0000000..a1d38ff
--- /dev/null
@@ -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/tests/IO/hSetEncoding002.hs b/tests/IO/hSetEncoding002.hs
new file mode 100644 (file)
index 0000000..35c4e1c
--- /dev/null
@@ -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/tests/IO/hSetEncoding002.stdout b/tests/IO/hSetEncoding002.stdout
new file mode 100644 (file)
index 0000000..d3b4b91
--- /dev/null
@@ -0,0 +1 @@
diff --git a/tests/IO/ioeGetErrorString001.hs b/tests/IO/ioeGetErrorString001.hs
new file mode 100644 (file)
index 0000000..5621136
--- /dev/null
@@ -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/tests/IO/ioeGetErrorString001.stdout b/tests/IO/ioeGetErrorString001.stdout
new file mode 100644 (file)
index 0000000..0b8daea
--- /dev/null
@@ -0,0 +1 @@
+"end of file"
diff --git a/tests/IO/ioeGetFileName001.hs b/tests/IO/ioeGetFileName001.hs
new file mode 100644 (file)
index 0000000..12c70c9
--- /dev/null
@@ -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/tests/IO/ioeGetFileName001.stdout b/tests/IO/ioeGetFileName001.stdout
new file mode 100644 (file)
index 0000000..7377ad4
--- /dev/null
@@ -0,0 +1 @@
+Just "ioeGetFileName001.hs"
diff --git a/tests/IO/ioeGetHandle001.hs b/tests/IO/ioeGetHandle001.hs
new file mode 100644 (file)
index 0000000..a9ef58a
--- /dev/null
@@ -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/tests/IO/ioeGetHandle001.stdout b/tests/IO/ioeGetHandle001.stdout
new file mode 100644 (file)
index 0000000..90b5016
--- /dev/null
@@ -0,0 +1 @@
+ok.
diff --git a/tests/IO/isEOF001.hs b/tests/IO/isEOF001.hs
new file mode 100644 (file)
index 0000000..bb20570
--- /dev/null
@@ -0,0 +1,3 @@
+import System.IO
+
+main = isEOF >>= print
diff --git a/tests/IO/isEOF001.stdout b/tests/IO/isEOF001.stdout
new file mode 100644 (file)
index 0000000..0ca9514
--- /dev/null
@@ -0,0 +1 @@
+True
diff --git a/tests/IO/latin1 b/tests/IO/latin1
new file mode 100644 (file)
index 0000000..a634257
--- /dev/null
@@ -0,0 +1,5 @@
+c0    | À   Á   Â   Ã   Ä   Å   Æ   Ç   È   É   Ê   Ë   Ì   Í   Î   Ï
+d0    | Ð   Ñ   Ò   Ó   Ô   Õ   Ö   ×   Ø   Ù   Ú   Û   Ü   Ý   Þ   ß
+e0    | à   á   â   ã   ä   å   æ   ç   è   é   ê   ë   ì   í   î   ï
+f0    | ð   ñ   ò   ó   ô   õ   ö   ÷   ø   ù   ú   û   ü   ý   þ   ÿ
+X
\ No newline at end of file
diff --git a/tests/IO/misc001.hs b/tests/IO/misc001.hs
new file mode 100644 (file)
index 0000000..9f9f3e9
--- /dev/null
@@ -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/tests/IO/misc001.stdout b/tests/IO/misc001.stdout
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/tests/IO/newline001.hs b/tests/IO/newline001.hs
new file mode 100644 (file)
index 0000000..b12a65b
--- /dev/null
@@ -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/tests/IO/openFile001.hs b/tests/IO/openFile001.hs
new file mode 100644 (file)
index 0000000..f34f093
--- /dev/null
@@ -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/tests/IO/openFile001.stdout b/tests/IO/openFile001.stdout
new file mode 100644 (file)
index 0000000..90b5016
--- /dev/null
@@ -0,0 +1 @@
+ok.
diff --git a/tests/IO/openFile002.hs b/tests/IO/openFile002.hs
new file mode 100644 (file)
index 0000000..8382262
--- /dev/null
@@ -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/tests/IO/openFile002.stderr b/tests/IO/openFile002.stderr
new file mode 100644 (file)
index 0000000..b011f34
--- /dev/null
@@ -0,0 +1 @@
+openFile002: nonexistent: openFile: does not exist (No such file or directory)
diff --git a/tests/IO/openFile002.stderr-hugs b/tests/IO/openFile002.stderr-hugs
new file mode 100644 (file)
index 0000000..aa76710
--- /dev/null
@@ -0,0 +1 @@
+openFile002: nonexistent: IO.openFile: does not exist (file does not exist)
diff --git a/tests/IO/openFile003.hs b/tests/IO/openFile003.hs
new file mode 100644 (file)
index 0000000..f3c640f
--- /dev/null
@@ -0,0 +1,17 @@
+import System.Directory
+import System.IO
+import System.IO.Error
+
+-- !!! Open a directory (should fail)
+
+main = do
+  let dir = "openFile003Dir"
+  createDirectoryIfMissing False dir
+  r <- tryIOError (openFile dir ReadMode)
+  print r
+  r <- tryIOError (openFile dir WriteMode)
+  print r
+  r <- tryIOError (openFile dir AppendMode)
+  print r
+  r <- tryIOError (openFile dir ReadWriteMode)
+  print r
diff --git a/tests/IO/openFile003.stdout b/tests/IO/openFile003.stdout
new file mode 100644 (file)
index 0000000..3621518
--- /dev/null
@@ -0,0 +1,4 @@
+Left openFile003Dir: openFile: inappropriate type (is a directory)
+Left openFile003Dir: openFile: inappropriate type (Is a directory)
+Left openFile003Dir: openFile: inappropriate type (Is a directory)
+Left openFile003Dir: openFile: inappropriate type (Is a directory)
diff --git a/tests/IO/openFile003.stdout-i386-unknown-mingw32 b/tests/IO/openFile003.stdout-i386-unknown-mingw32
new file mode 100644 (file)
index 0000000..bf99bcf
--- /dev/null
@@ -0,0 +1,4 @@
+Left openFile003Dir: openFile: permission denied (Permission denied)\r
+Left openFile003Dir: openFile: permission denied (Permission denied)\r
+Left openFile003Dir: openFile: permission denied (Permission denied)\r
+Left openFile003Dir: openFile: permission denied (Permission denied)\r
diff --git a/tests/IO/openFile003.stdout-i386-unknown-solaris2 b/tests/IO/openFile003.stdout-i386-unknown-solaris2
new file mode 100644 (file)
index 0000000..6a78a2a
--- /dev/null
@@ -0,0 +1,4 @@
+Left openFile003Dir: openFile: inappropriate type (is a directory)
+Left openFile003Dir: openFile: invalid argument (Invalid argument)
+Left openFile003Dir: openFile: invalid argument (Invalid argument)
+Left openFile003Dir: openFile: invalid argument (Invalid argument)
diff --git a/tests/IO/openFile003.stdout-mingw b/tests/IO/openFile003.stdout-mingw
new file mode 100644 (file)
index 0000000..2f63d8c
--- /dev/null
@@ -0,0 +1,16 @@
+Left permission denied
+Action: openFile
+Reason: Permission denied
+File: openFile003Dir
+Left permission denied
+Action: openFile
+Reason: Permission denied
+File: openFile003Dir
+Left permission denied
+Action: openFile
+Reason: Permission denied
+File: openFile003Dir
+Left permission denied
+Action: openFile
+Reason: Permission denied
+File: openFile003Dir
diff --git a/tests/IO/openFile003.stdout-mips-sgi-irix b/tests/IO/openFile003.stdout-mips-sgi-irix
new file mode 100644 (file)
index 0000000..6a78a2a
--- /dev/null
@@ -0,0 +1,4 @@
+Left openFile003Dir: openFile: inappropriate type (is a directory)
+Left openFile003Dir: openFile: invalid argument (Invalid argument)
+Left openFile003Dir: openFile: invalid argument (Invalid argument)
+Left openFile003Dir: openFile: invalid argument (Invalid argument)
diff --git a/tests/IO/openFile003.stdout-sparc-sun-solaris2 b/tests/IO/openFile003.stdout-sparc-sun-solaris2
new file mode 100644 (file)
index 0000000..6a78a2a
--- /dev/null
@@ -0,0 +1,4 @@
+Left openFile003Dir: openFile: inappropriate type (is a directory)
+Left openFile003Dir: openFile: invalid argument (Invalid argument)
+Left openFile003Dir: openFile: invalid argument (Invalid argument)
+Left openFile003Dir: openFile: invalid argument (Invalid argument)
diff --git a/tests/IO/openFile004.hs b/tests/IO/openFile004.hs
new file mode 100644 (file)
index 0000000..4124abb
--- /dev/null
@@ -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/tests/IO/openFile004.stdout b/tests/IO/openFile004.stdout
new file mode 100644 (file)
index 0000000..3b18e51
--- /dev/null
@@ -0,0 +1 @@
+hello world
diff --git a/tests/IO/openFile005.hs b/tests/IO/openFile005.hs
new file mode 100644 (file)
index 0000000..d8a8f83
--- /dev/null
@@ -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/tests/IO/openFile005.stdout b/tests/IO/openFile005.stdout
new file mode 100644 (file)
index 0000000..1a4b843
--- /dev/null
@@ -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/tests/IO/openFile005.stdout-i386-unknown-mingw32 b/tests/IO/openFile005.stdout-i386-unknown-mingw32
new file mode 100644 (file)
index 0000000..bf22798
--- /dev/null
@@ -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/tests/IO/openFile006.hs b/tests/IO/openFile006.hs
new file mode 100644 (file)
index 0000000..63cfea1
--- /dev/null
@@ -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/tests/IO/openFile006.stdout b/tests/IO/openFile006.stdout
new file mode 100644 (file)
index 0000000..368283e
--- /dev/null
@@ -0,0 +1,2 @@
+12
+0
diff --git a/tests/IO/openFile007.hs b/tests/IO/openFile007.hs
new file mode 100644 (file)
index 0000000..e39ed65
--- /dev/null
@@ -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/tests/IO/openFile007.stdout b/tests/IO/openFile007.stdout
new file mode 100644 (file)
index 0000000..4966904
--- /dev/null
@@ -0,0 +1,2 @@
+Left openFile007.out: openFile: resource busy (file is locked)
+hello, world
diff --git a/tests/IO/openFile007.stdout-i386-unknown-mingw32 b/tests/IO/openFile007.stdout-i386-unknown-mingw32
new file mode 100644 (file)
index 0000000..26f0afe
--- /dev/null
@@ -0,0 +1,2 @@
+Left openFile007.out: openFile: permission denied (Permission denied)
+hello, world
diff --git a/tests/IO/openFile008.hs b/tests/IO/openFile008.hs
new file mode 100644 (file)
index 0000000..9c1a1c4
--- /dev/null
@@ -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/tests/IO/openTempFile001.hs b/tests/IO/openTempFile001.hs
new file mode 100644 (file)
index 0000000..36598e6
--- /dev/null
@@ -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/tests/IO/putStr001.hs b/tests/IO/putStr001.hs
new file mode 100644 (file)
index 0000000..48b3add
--- /dev/null
@@ -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/tests/IO/putStr001.stdout b/tests/IO/putStr001.stdout
new file mode 100644 (file)
index 0000000..a5c1966
--- /dev/null
@@ -0,0 +1 @@
+Hello, world
diff --git a/tests/IO/readFile001.hs b/tests/IO/readFile001.hs
new file mode 100644 (file)
index 0000000..e4a2b34
--- /dev/null
@@ -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/tests/IO/readFile001.stdout b/tests/IO/readFile001.stdout
new file mode 100644 (file)
index 0000000..cfb7570
--- /dev/null
@@ -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/tests/IO/readFile001.stdout-i386-unknown-mingw32 b/tests/IO/readFile001.stdout-i386-unknown-mingw32
new file mode 100644 (file)
index 0000000..d086f3a
--- /dev/null
@@ -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/tests/IO/readwrite001.hs b/tests/IO/readwrite001.hs
new file mode 100644 (file)
index 0000000..4a94ef1
--- /dev/null
@@ -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/tests/IO/readwrite001.stdout b/tests/IO/readwrite001.stdout
new file mode 100644 (file)
index 0000000..e33ba06
--- /dev/null
@@ -0,0 +1,3 @@
+'a'
+
+aase
diff --git a/tests/IO/readwrite002.hs b/tests/IO/readwrite002.hs
new file mode 100644 (file)
index 0000000..4bb607e
--- /dev/null
@@ -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/tests/IO/readwrite002.stdout b/tests/IO/readwrite002.stdout
new file mode 100644 (file)
index 0000000..9aed028
--- /dev/null
@@ -0,0 +1,9 @@
+###############
+
+Caught EOF
+###############
+
+Caught EOF
+###############
+
+Caught EOF
diff --git a/tests/IO/readwrite003.hs b/tests/IO/readwrite003.hs
new file mode 100644 (file)
index 0000000..d7ee78d
--- /dev/null
@@ -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/tests/IO/readwrite003.stdout b/tests/IO/readwrite003.stdout
new file mode 100644 (file)
index 0000000..6b45228
--- /dev/null
@@ -0,0 +1,4 @@
+ab
+yz
+ef
+gh
\ No newline at end of file
diff --git a/tests/IO/utf8-test b/tests/IO/utf8-test
new file mode 100644 (file)
index 0000000..7d0f35a
--- /dev/null
@@ -0,0 +1,3 @@
+(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ)
+𝑎𝑏𝑐𝑑𝑒𝑓𝑔𝑖𝑗𝑘𝑙𝑚𝑛𝑜𝑝𝑞𝑟𝑠𝑡𝑢𝑣𝑤𝑥𝑦𝑧
+X
\ No newline at end of file
diff --git a/tests/Memo1.lhs b/tests/Memo1.lhs
new file mode 100644 (file)
index 0000000..796f612
--- /dev/null
@@ -0,0 +1,142 @@
+% $Id: Memo.lhs,v 1.1 2005/12/16 10:46:05 simonmar Exp $
+%
+% (c) The GHC Team, 1999
+%
+% Hashing memo tables.
+
+\begin{code}
+{-# LANGUAGE CPP #-}
+
+module Memo1
+       {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-}
+#ifndef __PARALLEL_HASKELL__
+       ( memo          -- :: (a -> b) -> a -> b
+       , memoSized     -- :: Int -> (a -> b) -> a -> b
+       ) 
+#endif
+       where
+
+#ifndef __PARALLEL_HASKELL__
+
+import System.Mem.StableName   ( StableName, makeStableName, hashStableName )
+import System.Mem.Weak         ( Weak, mkWeakPtr, mkWeak, deRefWeak, finalize )
+import Data.Array.IO           ( IOArray, newArray, readArray, writeArray )
+import System.IO.Unsafe                ( unsafePerformIO )
+import Control.Concurrent.MVar ( MVar, newMVar, putMVar, takeMVar )
+\end{code}
+
+-----------------------------------------------------------------------------
+Memo table representation.
+
+The representation is this: a fixed-size hash table where each bucket
+is a list of table entries, of the form (key,value).
+
+The key in this case is (StableName key), and we use hashStableName to
+hash it.
+
+It's important that we can garbage collect old entries in the table
+when the key is no longer reachable in the heap.  Hence the value part
+of each table entry is (Weak val), where the weak pointer "key" is the
+key for our memo table, and 'val' is the value of this memo table
+entry.  When the key becomes unreachable, a finalizer will fire and
+remove this entry from the hash bucket, and further attempts to
+dereference the weak pointer will return Nothing.  References from
+'val' to the key are ignored (see the semantics of weak pointers in
+the documentation).
+
+\begin{code}
+type MemoTable key val
+       = MVar (
+           Int,        -- current table size
+           IOArray Int [MemoEntry key val]   -- hash table
+          )
+
+-- a memo table entry: compile with -funbox-strict-fields to eliminate
+-- the boxes around the StableName and Weak fields.
+data MemoEntry key val = MemoEntry !(StableName key) !(Weak val)
+\end{code}
+
+We use an MVar to the hash table, so that several threads may safely
+access it concurrently.  This includes the finalization threads that
+remove entries from the table.
+
+ToDo: Can efficiency be improved at all?
+
+\begin{code}
+memo :: (a -> b) -> a -> b
+memo f = memoSized default_table_size f
+
+default_table_size = 1001
+
+-- Our memo functions are *strict*.  Lazy memo functions tend to be
+-- less useful because it is less likely you'll get a memo table hit
+-- for a thunk.  This change was made to match Hugs's Memo
+-- implementation, and as the result of feedback from Conal Elliot
+-- <conal@microsoft.com>.
+
+memoSized :: Int -> (a -> b) -> a -> b
+memoSized size f = strict (lazyMemoSized size f)
+
+strict = ($!)
+
+lazyMemoSized :: Int -> (a -> b) -> a -> b
+lazyMemoSized size f =
+   let (table,weak) = unsafePerformIO (
+               do { tbl <- newArray (0,size) []
+                  ; mvar <- newMVar (size,tbl)
+                  ; weak <- mkWeakPtr mvar (Just (table_finalizer tbl size))
+                  ; return (mvar,weak)
+                  })
+   in  memo' f table weak
+
+table_finalizer :: IOArray Int [MemoEntry key val] -> Int -> IO ()
+table_finalizer table size = 
+   sequence_ [ finalizeBucket i | i <- [0..size] ]
+ where
+   finalizeBucket i = do
+      bucket <- readArray table i 
+      sequence_ [ finalize w | MemoEntry _ w <- bucket ]
+
+memo' :: (a -> b) -> MemoTable a b -> Weak (MemoTable a b) -> a -> b
+memo' f ref weak_ref = \k -> unsafePerformIO $ do
+   stable_key <- makeStableName k
+   (size, table) <- takeMVar ref
+   let hash_key = hashStableName stable_key `mod` size
+   bucket <- readArray table hash_key
+   lkp <- lookupSN stable_key bucket
+
+   case lkp of
+     Just result -> do
+       putMVar ref (size,table)
+       return result
+     Nothing -> do
+       let result = f k
+       weak <- mkWeak k result (Just (finalizer hash_key stable_key weak_ref))
+       writeArray table hash_key (MemoEntry stable_key weak : bucket)
+       putMVar ref (size,table)
+       return result
+
+finalizer :: Int -> StableName a -> Weak (MemoTable a b) -> IO ()
+finalizer hash_key stable_key weak_ref = 
+  do r <- deRefWeak weak_ref 
+     case r of
+       Nothing -> return ()
+       Just mvar -> do
+               (size,table) <- takeMVar mvar
+               bucket <- readArray table hash_key
+               let new_bucket = [ e | e@(MemoEntry sn weak) <- bucket, 
+                                      sn /= stable_key ]
+               writeArray table hash_key new_bucket
+               putMVar mvar (size,table)
+
+lookupSN :: StableName key -> [MemoEntry key val] -> IO (Maybe val)
+lookupSN sn [] = sn `seq` return Nothing -- make it strict in sn
+lookupSN sn (MemoEntry sn' weak : xs)
+   | sn == sn'  = do maybe_item <- deRefWeak weak
+                    case maybe_item of
+                       Nothing -> error ("dead weak pair: " ++ 
+                                               show (hashStableName sn))
+                       Just v  -> return (Just v)
+   | otherwise  = lookupSN sn xs
+#endif
+\end{code}
diff --git a/tests/Memo2.lhs b/tests/Memo2.lhs
new file mode 100644 (file)
index 0000000..5193ec2
--- /dev/null
@@ -0,0 +1,142 @@
+% $Id: Memo.lhs,v 1.1 2005/12/16 10:46:05 simonmar Exp $
+%
+% (c) The GHC Team, 1999
+%
+% Hashing memo tables.
+
+\begin{code}
+{-# LANGUAGE CPP #-}
+
+module Memo2
+       {-# DEPRECATED "This module is unmaintained, and will disappear soon" #-}
+#ifndef __PARALLEL_HASKELL__
+       ( memo          -- :: (a -> b) -> a -> b
+       , memoSized     -- :: Int -> (a -> b) -> a -> b
+       ) 
+#endif
+       where
+
+#ifndef __PARALLEL_HASKELL__
+
+import System.Mem.StableName   ( StableName, makeStableName, hashStableName )
+import System.Mem.Weak         ( Weak, mkWeakPtr, mkWeak, deRefWeak, finalize )
+import Data.Array.IO           ( IOArray, newArray, readArray, writeArray )
+import System.IO.Unsafe                ( unsafePerformIO )
+import Control.Concurrent.MVar ( MVar, newMVar, putMVar, takeMVar )
+\end{code}
+
+-----------------------------------------------------------------------------
+Memo table representation.
+
+The representation is this: a fixed-size hash table where each bucket
+is a list of table entries, of the form (key,value).
+
+The key in this case is (StableName key), and we use hashStableName to
+hash it.
+
+It's important that we can garbage collect old entries in the table
+when the key is no longer reachable in the heap.  Hence the value part
+of each table entry is (Weak val), where the weak pointer "key" is the
+key for our memo table, and 'val' is the value of this memo table
+entry.  When the key becomes unreachable, a finalizer will fire and
+remove this entry from the hash bucket, and further attempts to
+dereference the weak pointer will return Nothing.  References from
+'val' to the key are ignored (see the semantics of weak pointers in
+the documentation).
+
+\begin{code}
+type MemoTable key val
+       = MVar (
+           Int,        -- current table size
+           IOArray Int [MemoEntry key val]   -- hash table
+          )
+
+-- a memo table entry: compile with -funbox-strict-fields to eliminate
+-- the boxes around the StableName and Weak fields.
+data MemoEntry key val = MemoEntry !(StableName key) !(Weak val)
+\end{code}
+
+We use an MVar to the hash table, so that several threads may safely
+access it concurrently.  This includes the finalization threads that
+remove entries from the table.
+
+ToDo: Can efficiency be improved at all?
+
+\begin{code}
+memo :: (a -> b) -> a -> b
+memo f = memoSized default_table_size f
+
+default_table_size = 1001
+
+-- Our memo functions are *strict*.  Lazy memo functions tend to be
+-- less useful because it is less likely you'll get a memo table hit
+-- for a thunk.  This change was made to match Hugs's Memo
+-- implementation, and as the result of feedback from Conal Elliot
+-- <conal@microsoft.com>.
+
+memoSized :: Int -> (a -> b) -> a -> b
+memoSized size f = strict (lazyMemoSized size f)
+
+strict = ($!)
+
+lazyMemoSized :: Int -> (a -> b) -> a -> b
+lazyMemoSized size f =
+   let (table,weak) = unsafePerformIO (
+               do { tbl <- newArray (0,size) []
+                  ; mvar <- newMVar (size,tbl)
+                  ; weak <- mkWeakPtr mvar (Just (table_finalizer tbl size))
+                  ; return (mvar,weak)
+                  })
+   in  memo' f table weak
+
+table_finalizer :: IOArray Int [MemoEntry key val] -> Int -> IO ()
+table_finalizer table size = 
+   sequence_ [ finalizeBucket i | i <- [0..size] ]
+ where
+   finalizeBucket i = do
+      bucket <- readArray table i 
+      sequence_ [ finalize w | MemoEntry _ w <- bucket ]
+
+memo' :: (a -> b) -> MemoTable a b -> Weak (MemoTable a b) -> a -> b
+memo' f ref weak_ref = \k -> unsafePerformIO $ do
+   stable_key <- makeStableName k
+   (size, table) <- takeMVar ref
+   let hash_key = hashStableName stable_key `mod` size
+   bucket <- readArray table hash_key
+   lkp <- lookupSN stable_key bucket
+
+   case lkp of
+     Just result -> do
+       putMVar ref (size,table)
+       return result
+     Nothing -> do
+       let result = f k
+       weak <- mkWeak k result (Just (finalizer hash_key stable_key weak_ref))
+       writeArray table hash_key (MemoEntry stable_key weak : bucket)
+       putMVar ref (size,table)
+       return result
+
+finalizer :: Int -> StableName a -> Weak (MemoTable a b) -> IO ()
+finalizer hash_key stable_key weak_ref = 
+  do r <- deRefWeak weak_ref 
+     case r of
+       Nothing -> return ()
+       Just mvar -> do
+               (size,table) <- takeMVar mvar
+               bucket <- readArray table hash_key
+               let new_bucket = [ e | e@(MemoEntry sn weak) <- bucket, 
+                                      sn /= stable_key ]
+               writeArray table hash_key new_bucket
+               putMVar mvar (size,table)
+
+lookupSN :: StableName key -> [MemoEntry key val] -> IO (Maybe val)
+lookupSN sn [] = sn `seq` return Nothing -- make it strict in sn
+lookupSN sn (MemoEntry sn' weak : xs)
+   | sn == sn'  = do maybe_item <- deRefWeak weak
+                    case maybe_item of
+                       Nothing -> error ("dead weak pair: " ++ 
+                                               show (hashStableName sn))
+                       Just v  -> return (Just v)
+   | otherwise  = lookupSN sn xs
+#endif
+\end{code}
diff --git a/tests/addr001.hs b/tests/addr001.hs
new file mode 100644 (file)
index 0000000..436a066
--- /dev/null
@@ -0,0 +1,10 @@
+-- !!! Testing that Show for Addr is OK..
+module Main(main) where
+
+import Foreign.Ptr
+
+main :: IO ()
+main = do
+  print (nullPtr `plusPtr` maxBound)
+  print (nullPtr `plusPtr` minBound)
+
diff --git a/tests/addr001.stdout b/tests/addr001.stdout
new file mode 100644 (file)
index 0000000..e098b1b
--- /dev/null
@@ -0,0 +1,2 @@
+0x7fffffff
+0x80000000
diff --git a/tests/addr001.stdout-alpha-dec-osf3 b/tests/addr001.stdout-alpha-dec-osf3
new file mode 100644 (file)
index 0000000..f38ea71
--- /dev/null
@@ -0,0 +1,2 @@
+0x7fffffffffffffff
+0x8000000000000000
diff --git a/tests/addr001.stdout-mips-sgi-irix b/tests/addr001.stdout-mips-sgi-irix
new file mode 100644 (file)
index 0000000..f38ea71
--- /dev/null
@@ -0,0 +1,2 @@
+0x7fffffffffffffff
+0x8000000000000000
diff --git a/tests/addr001.stdout-ws-64 b/tests/addr001.stdout-ws-64
new file mode 100644 (file)
index 0000000..f38ea71
--- /dev/null
@@ -0,0 +1,2 @@
+0x7fffffffffffffff
+0x8000000000000000
diff --git a/tests/addr001.stdout-x86_64-unknown-openbsd b/tests/addr001.stdout-x86_64-unknown-openbsd
new file mode 100644 (file)
index 0000000..f38ea71
--- /dev/null
@@ -0,0 +1,2 @@
+0x7fffffffffffffff
+0x8000000000000000
index 582a542..13f25f0 100644 (file)
@@ -32,3 +32,87 @@ test('ioref001',
      compile_and_run,
      ['+RTS -K64m -RTS'])
 
+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, [''])
+
+test('char001',        normal, compile_and_run, [''])
+test('char002',        normal, compile_and_run, [''])
+
+test('cstring001',     normal, compile_and_run, [''])
+
+test('length001',
+     # This fails without -O, as it relies on a RULE being applied
+     expect_fail_for(['normal', 'threaded1', 'llvm']),
+     compile_and_run,
+     [''])
+
+test('ratio001',       normal, compile_and_run, [''])
+
+test('rand001',                reqlib('random'), compile_and_run, [''])
+test('reads001',               normal, compile_and_run, [''])
+test('show001',                normal, compile_and_run, [''])
+test('text001',                normal, compile_and_run, [''])
+
+test('tup001',         normal, compile_and_run, [''])
+
+test('addr001',                normal, compile_and_run, [''])
+test('dynamic001',      normal, compile_and_run, [''])
+test('dynamic002',      normal, compile_and_run, [''])
+test('dynamic003',      extra_run_opts('+RTS -K32m -RTS'), compile_and_run, [''])
+test('dynamic004',      normal, compile_and_run, [''])
+test('dynamic005',      normal, compile_and_run, [''])
+test('enum01',          skip_if_fast, compile_and_run, ['-cpp'])
+test('enum02',                 skip_if_fast, compile_and_run, ['-cpp'])
+test('enum03',                 skip_if_fast, compile_and_run, ['-cpp'])
+test('enum04',                 normal, compile_and_run, [''])
+test('exceptionsrun001',       normal, compile_and_run, [''])
+test('exceptionsrun002',       normal, compile_and_run, [''])
+test('list001' ,       skip_if_fast, compile_and_run, [''])
+test('list002', skip_if_fast, compile_and_run, [''])
+test('list003', skip_if_fast, compile_and_run, [''])
+
+test('memo001',
+     [skip_if_fast,
+      extra_run_opts('+RTS -A10k -RTS'),
+      extra_clean(['Memo1.hi', 'Memo1.o'])],
+     multimod_compile_and_run,
+     ['memo001',''])
+
+test('memo002',
+     [skip_if_fast,
+      extra_run_opts('20'),
+      extra_clean(['Memo2.hi', 'Memo2.o'])],
+       multimod_compile_and_run, ['memo002',''])
+
+test('packedstring001', reqlib('packedstring'), compile_and_run, ['-package packedstring'])
+
+test('stableptr001',
+     [skip_if_fast, extra_run_opts('+RTS -K8m -RTS')],
+     compile_and_run, [''])
+test('stableptr003', normal, compile_and_run, [''])
+test('stableptr004', extra_run_opts('+RTS -K4m -RTS'), compile_and_run, [''])
+test('stableptr005', normal, compile_and_run, [''])
+
+test('weak001', normal, compile_and_run, [''])
+
+# In the 65001 codepage, we can't even cat the expected output on msys:
+#     $ cat 4006.stdout
+#     It works here
+#     cat: write error: Permission denied
+# Seems to be a known problem, e.g.
+#     http://mingw-users.1079350.n2.nabble.com/Bug-re-Unicode-on-the-console-td3121717.html
+test('4006', if_msys(expect_fail), compile_and_run, [''])
+
diff --git a/tests/char001.hs b/tests/char001.hs
new file mode 100644 (file)
index 0000000..2fb0edc
--- /dev/null
@@ -0,0 +1,43 @@
+-- !!! Testing the behaviour of Char.lexLitChar a little..
+
+-- [March 2003]  We now allow \X and \O as escapes although the 
+-- spec only permits \x and \o.  Seems more consistent. 
+
+module Main where
+
+import Data.Char
+
+lex' str = do
+  putStr ("lex " ++ str ++ " = ")
+  print (lex str)
+
+hexes = do
+  lex' "'\\X00'"
+  lex' "'\\x0f2'"
+  lex' "'\\xf2'"
+  lex' "'\\xf2t'"
+  lex' "'\\X24'"
+  lex' "'\\x24b'"
+  lex' "'\\Xa4b'"
+  lex' "'\\xa4bg'"
+
+octs = do
+  lex' "'\\o00'"
+  lex' "'\\o05'"
+  lex' "'\\o50'"
+  lex' "'\\o72'"
+  lex' "'\\o82'"
+  lex' "'\\O24'"
+  lex' "'\\O000024'"
+  lex' "'\\024b'"
+  lex' "'\\o14b'"
+  lex' "'\\0a4bg'"
+
+main = do
+  hexes
+  octs
+
+
+
+
+
diff --git a/tests/char001.stdout b/tests/char001.stdout
new file mode 100644 (file)
index 0000000..0c13ac7
--- /dev/null
@@ -0,0 +1,18 @@
+lex '\X00' = [("'\\X00'","")]
+lex '\x0f2' = [("'\\x0f2'","")]
+lex '\xf2' = [("'\\xf2'","")]
+lex '\xf2t' = []
+lex '\X24' = [("'\\X24'","")]
+lex '\x24b' = [("'\\x24b'","")]
+lex '\Xa4b' = [("'\\Xa4b'","")]
+lex '\xa4bg' = []
+lex '\o00' = [("'\\o00'","")]
+lex '\o05' = [("'\\o05'","")]
+lex '\o50' = [("'\\o50'","")]
+lex '\o72' = [("'\\o72'","")]
+lex '\o82' = []
+lex '\O24' = [("'\\O24'","")]
+lex '\O000024' = [("'\\O000024'","")]
+lex '\024b' = []
+lex '\o14b' = []
+lex '\0a4bg' = []
diff --git a/tests/char002.hs b/tests/char002.hs
new file mode 100644 (file)
index 0000000..60b8b03
--- /dev/null
@@ -0,0 +1,7 @@
+-- !!! tests for large character values in literals
+import Data.Char
+main = do
+  print (ord '\xffff')
+  print (ord '\o7777')
+  print (ord '\65535')
+  print (map ord "\xffff\o7777\65535")
diff --git a/tests/char002.stdout b/tests/char002.stdout
new file mode 100644 (file)
index 0000000..5190ad9
--- /dev/null
@@ -0,0 +1,4 @@
+65535
+4095
+65535
+[65535,4095,65535]
diff --git a/tests/cstring001.hs b/tests/cstring001.hs
new file mode 100644 (file)
index 0000000..38d0d25
--- /dev/null
@@ -0,0 +1,18 @@
+import Control.Monad
+import Foreign.C.String
+
+test_strings = ["Hello World", replicate 10000 'a']
+
+assertEqual :: (Eq a, Show a) => a -> a -> IO ()
+assertEqual x y = if x == y then return () else error $ "assertEqual: " ++ show x ++ " /= " ++ show y
+
+main = do
+    -- Try roundtripping some ASCII strings through the locale encoding
+    forM test_strings $ \try_str -> do
+        got_str <- withCString try_str peekCString
+        got_str `assertEqual` try_str
+
+    -- Try roundtripping some ASCII strings with lengths through the locale encoding
+    forM test_strings $ \try_str -> do
+        got_str <- withCStringLen try_str peekCStringLen
+        got_str `assertEqual` try_str
diff --git a/tests/dynamic001.hs b/tests/dynamic001.hs
new file mode 100644 (file)
index 0000000..7a3fd51
--- /dev/null
@@ -0,0 +1,107 @@
+-- !!! Dynamic library regression tests
+module Main(main) where
+
+import Data.Dynamic
+
+main :: IO ()
+main = do
+   test   "toDyn"   toDyn_list
+   testIO "fromDyn" fromDyn_test
+
+toDyn_list :: [Dynamic]
+toDyn_list =
+    [ toDyn (1::Int)
+    , toDyn ('a')
+    , toDyn False
+    , toDyn ((-1.0)::Float)
+    , toDyn (0.0::Double)
+    , toDyn (1394::Integer)
+    , toDyn (print "hello")
+    , toDyn toDyn_list
+    , toDyn ([]::[Int])
+    , toDyn (Nothing  :: Maybe Int)
+    , toDyn ((Just 2) :: Maybe Int)
+    , toDyn ((Just 2) :: Maybe Int)
+    , toDyn ((Left 3) :: Either Int Bool)
+    , toDyn ((Right 3) :: Either Char Int)
+    , toDyn ()
+    , toDyn LT
+    , toDyn ((),2::Int)
+    , toDyn ((),2::Int,'a')
+    , toDyn ((),2::Int,'a',1.0::Double)
+    , toDyn ((),2::Int,'a',1.0::Double,Nothing::Maybe Bool)
+    , toDyn ((+) :: Int -> Int -> Int)
+    , toDyn ((+) :: Integer -> Integer -> Integer)
+    , toDyn ((++) :: [Char] -> [Char] -> [Char])
+    ]
+
+-- Testing the conversion from Dynamic values:
+fromDyn_test :: IO ()
+fromDyn_test = do
+   print (fromDyn (toDyn (1::Int)) (0::Int))
+   print (fromDyn (toDyn ('a'::Char)) (0::Int))
+   print (fromDyn (toDyn 'a') 'b')
+   print (fromDyn (toDyn (1::Float)) (0::Float))
+   print (fromDyn (toDyn (2::Float)) (0::Int))
+   print (fromDyn (toDyn (3::Double)) (0::Double))
+   print (fromDyn (toDyn (4::Double)) (0::Int))
+   print (fromDyn (toDyn (5::Integer)) (0::Integer))
+   print (fromDyn (toDyn (6::Integer)) False)
+   print (fromDyn (toDyn [1,3,5::Integer]) ([]::[Integer]))
+   print (fromDyn (toDyn (Just True)) (Nothing::Maybe Bool))
+   print (fromDyn (toDyn (Left True::Either Bool Bool)) (Right False :: Either Bool Bool))
+   print (fromDyn (toDyn LT) GT)
+   print (fromDyn (toDyn ((+1)::Int->Int)) False)
+   print ((fromDyn (toDyn ((+1)::Int->Int)) ((+2)::Int->Int)) 3)
+   print ((fromDyn (toDyn ((++)::[Int]->[Int]->[Int])) ((undefined)::[Int]->[Int]->[Int])) [1] [2])
+
+    
+-- Misc test utilities:
+test :: Show a => String -> [a] -> IO ()
+test str ls = do
+  putStrLn ("*** Testing: " ++ str ++ " ***")
+  putStrLn (showListLn ls)
+
+testIO :: String -> IO () -> IO ()
+testIO str tst = do
+  putStrLn ("*** Testing: " ++ str ++ " ***")
+  tst
+
+
+-- showListLn presents a list in a diff-friendly format.
+-- showListLn [a1,..an]
+--  =>
+--      [ a1
+--      , a2
+--      ..
+--      , an
+--      ]
+--   
+showListLn :: Show a => [a] -> String
+showListLn [] = ""
+showListLn ls = '[' : ' ' : go ls
+ where
+   go    [x] = show x ++ "\n]"
+   go (x:xs) = show x ++ '\n':',':' ':go xs
+
+{-
+test8 = toDyn (mkAppTy listTc)
+test9 :: Float
+test9 = fromDyn test8 0
+
+printf :: String -> [Dynamic] -> IO ()
+printf str args = putStr (decode str args)
+ where
+  decode [] [] = []
+  decode ('%':'n':cs) (d:ds) =
+    (\ v -> show v++decode cs ds) (fromDyn  d (0::Int))
+  decode ('%':'c':cs) (d:ds) =
+    (\ v -> show v++decode cs ds) (fromDyn  d ('\0'))
+  decode ('%':'b':cs) (d:ds) =
+    (\ v -> show v++decode cs ds) (fromDyn  d (False::Bool))
+  decode (x:xs) ds = x:decode xs ds
+
+test10 :: IO ()
+test10 = printf "%n = %c, that much is %b\n" [toDyn (3::Int),toDyn 'a', toDyn False]
+
+-}
diff --git a/tests/dynamic001.stdout b/tests/dynamic001.stdout
new file mode 100644 (file)
index 0000000..c2d365a
--- /dev/null
@@ -0,0 +1,42 @@
+*** Testing: toDyn ***
+[ <<Int>>
+, <<Char>>
+, <<Bool>>
+, <<Float>>
+, <<Double>>
+, <<Integer>>
+, <<IO ()>>
+, <<[Dynamic]>>
+, <<[Int]>>
+, <<Maybe Int>>
+, <<Maybe Int>>
+, <<Maybe Int>>
+, <<Either Int Bool>>
+, <<Either Char Int>>
+, <<()>>
+, <<Ordering>>
+, <<((),Int)>>
+, <<((),Int,Char)>>
+, <<((),Int,Char,Double)>>
+, <<((),Int,Char,Double,(Maybe Bool))>>
+, <<Int -> Int -> Int>>
+, <<Integer -> Integer -> Integer>>
+, <<[Char] -> [Char] -> [Char]>>
+]
+*** Testing: fromDyn ***
+1
+0
+'a'
+1.0
+0
+3.0
+0
+5
+False
+[1,3,5]
+Just True
+Left True
+LT
+False
+4
+[1,2]
diff --git a/tests/dynamic002.hs b/tests/dynamic002.hs
new file mode 100644 (file)
index 0000000..6d53d2e
--- /dev/null
@@ -0,0 +1,91 @@
+-- !!! Testing Typeable instances
+module Main(main) where
+
+import Data.Dynamic
+import Data.Array
+import Data.Array.MArray
+import Data.Array.ST
+import Data.Array.IO
+import Data.Array.Unboxed
+import Data.Complex
+import Data.Int
+import Data.Word
+import Data.IORef
+import System.IO
+import Control.Monad.ST
+import System.Mem.StableName
+import System.Mem.Weak
+import Foreign.StablePtr
+import Control.Exception
+import Foreign.C.Types
+
+main :: IO ()
+main = do
+   print (typeOf (undefined :: [()]))
+   print (typeOf (undefined :: ()))
+   print (typeOf (undefined :: ((),())))
+   print (typeOf (undefined :: ((),(),())))
+   print (typeOf (undefined :: ((),(),(),())))
+   print (typeOf (undefined :: ((),(),(),(),())))
+   print (typeOf (undefined :: (() -> ())))
+   print (typeOf (undefined :: (Array () ())))
+   print (typeOf (undefined :: Bool))
+   print (typeOf (undefined :: Char))
+   print (typeOf (undefined :: (Complex ())))
+   print (typeOf (undefined :: Double))
+   print (typeOf (undefined :: (Either () ())))
+   print (typeOf (undefined :: Float))
+   print (typeOf (undefined :: Handle))
+   print (typeOf (undefined :: Int))
+   print (typeOf (undefined :: Integer))
+   print (typeOf (undefined :: IO ()))
+   print (typeOf (undefined :: (Maybe ())))
+   print (typeOf (undefined :: Ordering))
+
+   print (typeOf (undefined :: Dynamic))
+   print (typeOf (undefined :: (IORef ())))
+   print (typeOf (undefined :: Int8))
+   print (typeOf (undefined :: Int16))
+   print (typeOf (undefined :: Int32))
+   print (typeOf (undefined :: Int64))
+   print (typeOf (undefined :: (ST () ())))
+   print (typeOf (undefined :: (StableName ())))
+   print (typeOf (undefined :: (StablePtr ())))
+   print (typeOf (undefined :: TyCon))
+   print (typeOf (undefined :: TypeRep))
+   print (typeOf (undefined :: Word8))
+   print (typeOf (undefined :: Word16))
+   print (typeOf (undefined :: Word32))
+   print (typeOf (undefined :: Word64))
+
+   print (typeOf (undefined :: ArithException))
+   print (typeOf (undefined :: AsyncException))
+   print (typeOf (undefined :: (IOArray () ())))
+   print (typeOf (undefined :: (IOUArray () ())))
+   print (typeOf (undefined :: (STArray () () ())))
+   print (typeOf (undefined :: (STUArray () () ())))
+   print (typeOf (undefined :: (StableName ())))
+   print (typeOf (undefined :: (StablePtr ())))
+   print (typeOf (undefined :: (UArray () ())))
+   print (typeOf (undefined :: (Weak ())))
+
+   print (typeOf (undefined :: CChar))
+   print (typeOf (undefined :: CSChar))
+   print (typeOf (undefined :: CUChar))
+   print (typeOf (undefined :: CShort))
+   print (typeOf (undefined :: CUShort))
+   print (typeOf (undefined :: CInt))
+   print (typeOf (undefined :: CUInt))
+   print (typeOf (undefined :: CLong))
+   print (typeOf (undefined :: CULong))
+   print (typeOf (undefined :: CLLong))
+   print (typeOf (undefined :: CULLong))
+   print (typeOf (undefined :: CFloat))
+   print (typeOf (undefined :: CDouble))
+
+   print (typeOf (undefined :: CPtrdiff))
+   print (typeOf (undefined :: CSize))
+   print (typeOf (undefined :: CWchar))
+   print (typeOf (undefined :: CSigAtomic))
+   print (typeOf (undefined :: CClock))
+   print (typeOf (undefined :: CTime))
diff --git a/tests/dynamic002.stdout b/tests/dynamic002.stdout
new file mode 100644 (file)
index 0000000..8b55566
--- /dev/null
@@ -0,0 +1,64 @@
+[()]
+()
+((),())
+((),(),())
+((),(),(),())
+((),(),(),(),())
+() -> ()
+Array () ()
+Bool
+Char
+Complex ()
+Double
+Either () ()
+Float
+Handle
+Int
+Integer
+IO ()
+Maybe ()
+Ordering
+Dynamic
+IORef ()
+Int8
+Int16
+Int32
+Int64
+ST () ()
+StableName ()
+StablePtr ()
+TyCon
+TypeRep
+Word8
+Word16
+Word32
+Word64
+ArithException
+AsyncException
+IOArray () ()
+IOUArray () ()
+STArray () () ()
+STUArray () () ()
+StableName ()
+StablePtr ()
+UArray () ()
+Weak ()
+CChar
+CSChar
+CUChar
+CShort
+CUShort
+CInt
+CUInt
+CLong
+CULong
+CLLong
+CULLong
+CFloat
+CDouble
+CPtrdiff
+CSize
+CWchar
+CSigAtomic
+CClock
+CTime
diff --git a/tests/dynamic003.hs b/tests/dynamic003.hs
new file mode 100644 (file)
index 0000000..fae8bdb
--- /dev/null
@@ -0,0 +1,12 @@
+module Main where
+
+-- Test generation of large TypeReps
+-- (can be used as a benchmark)
+
+import Data.Typeable
+
+f :: Typeable a => Int -> a -> TypeRep
+f 0 a = typeOf a
+f n a = f (n-1) [a]
+
+main = print (f 50000 () == f 50001 ())
diff --git a/tests/dynamic003.stdout b/tests/dynamic003.stdout
new file mode 100644 (file)
index 0000000..bc59c12
--- /dev/null
@@ -0,0 +1 @@
+False
diff --git a/tests/dynamic004.hs b/tests/dynamic004.hs
new file mode 100644 (file)
index 0000000..e6b7a82
--- /dev/null
@@ -0,0 +1,36 @@
+module Main where
+
+import Data.Typeable
+import Data.Typeable.Internal
+import GHC.Fingerprint
+import Text.Printf
+
+f :: Typeable a => Int -> a -> [TypeRep]
+f 0 a = []
+f n a = typeOf a : f (n-1) [a]
+
+-- pointwise compare 1000x1001 TypeReps, there should be exactly 1000 equalities
+-- (can be used as a benchmark)
+main = print $ length [ t1 | t1 <- f 1000 (), t2 <- f 1001 (), t1 == t2 ]
+
+{-
+ DEBUGGING code to help find bugs in the TypeRep implementation when
+ this test fails:
+
+ where
+   g (x:xs) (y:ys)
+     | x == y = g xs ys
+     | otherwise = do
+         print x
+         case x of
+           TypeRep f1 (TyCon f2 _ _ _) [TypeRep f3 _ _] ->
+              printf "f1: %s\nf2: %s\nf3: %s\n" (show_fp f1) (show_fp f2) (show_fp f3)
+         case y of
+           TypeRep f1 (TyCon f2 _ _ _) [TypeRep f3 _ _] ->
+              printf "f1: %s\nf2: %s\nf3: %s\n" (show_fp f1) (show_fp f2) (show_fp f3)
+   g _ _ = return ()
+
+   show_fp :: Fingerprint -> String
+   show_fp (Fingerprint h l) =
+       printf "%x %x" h l
+-}
diff --git a/tests/dynamic004.stdout b/tests/dynamic004.stdout
new file mode 100644 (file)
index 0000000..83b33d2
--- /dev/null
@@ -0,0 +1 @@
+1000
diff --git a/tests/dynamic005.hs b/tests/dynamic005.hs
new file mode 100644 (file)
index 0000000..e90aeea
--- /dev/null
@@ -0,0 +1,14 @@
+module Main where
+
+import Data.Typeable
+
+f :: Typeable a => Int -> a -> [TypeRep]
+f 0 a = []
+f n a = typeOf a : f (n-1) [a]
+
+-- pointwise compare 1000x1000 different TypeReps, there should be no equalities
+-- (can be used as a benchmark)
+
+main = print $ length [ t1 | t1 <- replicate 1000 (f 10 ()),
+                             t2 <- replicate 1000 (f 10 'a'),
+                             t1 == t2 ]
diff --git a/tests/dynamic005.stdout b/tests/dynamic005.stdout
new file mode 100644 (file)
index 0000000..573541a
--- /dev/null
@@ -0,0 +1 @@
+0
diff --git a/tests/echo001.hs b/tests/echo001.hs
new file mode 100644 (file)
index 0000000..7c80358
--- /dev/null
@@ -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/tests/echo001.stdout b/tests/echo001.stdout
new file mode 100644 (file)
index 0000000..a9d7699
--- /dev/null
@@ -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/tests/enum01.hs b/tests/enum01.hs
new file mode 100644 (file)
index 0000000..d817866
--- /dev/null
@@ -0,0 +1,526 @@
+-- !!! Testing the Prelude's Enum instances.
+module Main(main) where
+
+import Control.Exception
+import Prelude hiding (catch)
+import Data.Char
+import Data.Ratio
+
+main = do
+   -- Enum Int
+  putStrLn "Testing Enum Int: "
+  testEnumInt
+   -- Enum Integer
+  putStrLn "Testing Enum Integer: "
+  testEnumInteger
+   -- Enum Char
+  putStrLn "Testing Enum Char: "
+  testEnumChar
+   -- Enum ()
+  putStrLn "Testing Enum (): "
+  testEnumUnit
+   -- Enum Ordering
+  putStrLn "Testing Enum Ordering (derived): "
+  testEnumOrdering
+   -- Enum Bool
+  putStrLn "Testing Enum Bool: "
+  testEnumBool
+   -- Enum Rational
+  putStrLn "Testing Enum Rational: "
+  testEnumRational
+   -- Enum (Ratio Int)
+  putStrLn "Testing Enum (Ratio Int): "
+  testEnumRatioInt
+
+{- 
+  Here's the properties that's supposed to
+  hold for arithmetic sequences over Int:
+
+   - [e1..]    = [e1, (e1+1), (e1+2), ..., maxBound]
+
+   - [e1,e2..] = [e1, (e1+i), (e1+2*i), ... upper]
+                 where
+                 i = e2 - e1
+                 upper
+                  | i >  0 = maxBound
+                  | i <  0 = minBound
+                  | i == 0 = maxBound -- this really shouldn't matter (I feel.)
+   - [e1..e3] = [e1, (e1+i), (e1+2*i),..e3]
+                where
+                i
+                 | e3 >= e1 = 1
+                 | e3 <  e1 = (-1)
+    
+   - [e1,e2..e3] = res
+                   where
+                   i = e2 - e1
+                   
+                   res
+                    | i >= 0 && e3 <  e1 = []
+                    | i <  0 && e3 >= e1 = []  -- (*)
+                    | otherwise          = [e1, (e1+i), (e1 + 2*i), .. e3]
+
+   Note:
+     (*) - I think this instead should be (i < 0 && e3 > e1), since, as is,
+
+            [x,(x+1) ..x] = [x] 
+            [x,(x-1) ..x] = []
+
+           which does not look right, symmetrically speaking.
+
+
+   The same properties hold for other Prelude types that
+   are instances of Enum as well as being Bounded.
+   
+   For non-Bounded types (e.g., Float and Double), the properties are similar,
+   except that the boundary tests become slightly different, i.e., when an
+   element becomes greater than (e3 + i/2) (or less than (e3 + i/2) for negative
+   i.)
+
+  Q - does [(x::Double)..] have an upper bound? (ditto for Float.)
+
+  OK - on with the regression testing.
+-}
+
+#define printTest(x) (do{ putStr ( "    " ++ "x" ++ " = " ) ; print (x) })
+
+
+testEnumInt :: IO ()
+testEnumInt = do
+     -- succ
+  printTest ((succ (0::Int)))
+  printTest ((succ (minBound::Int)))
+  mayBomb   (printTest ((succ (maxBound::Int))))
+
+     -- pred
+  printTest (pred (1::Int))
+  printTest (pred (maxBound::Int))
+  mayBomb   (printTest (pred (minBound::Int))) 
+
+     -- toEnum
+  printTest ((map (toEnum::Int->Int) [1,minBound,maxBound]))
+
+     -- fromEnum
+  printTest ((map fromEnum [(1::Int),minBound,maxBound]))
+
+     -- [x..] aka enumFrom
+  printTest ((take 7 [(1::Int)..]))
+  printTest ((take 7 [((maxBound::Int)-5)..])) -- just in case it doesn't catch the upper bound..
+  
+     -- [x,y..] aka enumFromThen
+  printTest ((take 7 [(1::Int),2..]))
+  printTest ((take 7 [(1::Int),7..]))
+  printTest ((take 7 [(1::Int),1..]))
+  printTest ((take 7 [(1::Int),0..]))
+  printTest ((take 7 [(5::Int),2..]))
+  let x = (minBound::Int) + 1
+  printTest ((take 7 [x, x-1 ..]))
+  let x = (minBound::Int) + 5
+  printTest ((take 7 [x, x-1 ..]))
+  let x = (maxBound::Int) - 5
+  printTest ((take 7 [x, (x+1) ..]))
+
+       -- Test overflow conditions
+  printTest (([minBound::Int,1..]))
+  printTest (([minBound::Int,0..]))
+  printTest (([minBound::Int,-1..]))
+  printTest (([maxBound::Int,1..]))
+  printTest (([maxBound::Int,0..]))
+  printTest (([maxBound::Int,-1..]))
+
+     -- [x..y] aka enumFromTo
+  printTest ((take 7 ([(1::Int) .. 5])))
+  printTest ((take 4 ([(1::Int) .. 1])))
+  printTest ((take 7 ([(1::Int) .. 0])))
+  printTest ((take 7 ([(5::Int) .. 0])))
+  printTest ((take 7 ([(maxBound-(5::Int)) .. maxBound])))
+  printTest ((take 7 ([(minBound+(5::Int)) .. minBound])))
+
+     -- [x,y..z] aka enumFromThenTo
+  printTest ((take 7 [(5::Int),4..1]))
+  printTest ((take 7 [(5::Int),3..1]))
+  printTest ((take 7 [(5::Int),3..2]))
+  printTest ((take 7 [(1::Int),2..1]))
+  printTest ((take 7 [(2::Int),1..2]))
+  printTest ((take 7 [(2::Int),1..1]))
+  printTest ((take 7 [(2::Int),3..1]))
+
+       -- Test overflow conditions
+  printTest (([minBound, 1..maxBound::Int]))
+  printTest (([minBound, 0..maxBound::Int]))
+  printTest (([minBound,-1..maxBound::Int]))
+  printTest (([minBound,-1..maxBound-1::Int]))
+  printTest (([minBound,-1..maxBound-2::Int]))
+
+  printTest (([maxBound, 1..minBound::Int]))
+  printTest (([maxBound, 0..minBound::Int]))
+  printTest (([maxBound, 0..minBound+1::Int]))
+  printTest (([maxBound, 0..minBound+2::Int]))
+  printTest (([maxBound,-1..minBound::Int]))
+
+  let x = (maxBound::Int) - 4
+  printTest ((take 7 [x,(x+1)..maxBound]))
+  let x = (minBound::Int) + 5
+  printTest ((take 7 [x,(x-1)..minBound]))
+
+testEnumChar :: IO ()
+testEnumChar = do
+     -- succ
+  printTest ((succ 'a'))
+  printTest ((succ (minBound::Char)))
+  mayBomb (printTest ((succ (maxBound::Char))))
+
+     -- pred
+  printTest ((pred 'b'))
+  printTest (pred (maxBound::Char))
+  mayBomb (printTest (pred (minBound::Char)))
+
+     -- toEnum
+  printTest ((map (toEnum::Int->Char) [123,ord (minBound::Char), ord(maxBound::Char)]))
+  mayBomb (printTest ((toEnum::Int->Char) (minBound::Int)))
+
+     -- fromEnum
+  printTest ((map fromEnum ['X',minBound,maxBound]))
+
+     -- [x..] aka enumFrom
+  -- printTest ((take 7 ['\NUL' .. ]))
+  do{ putStr ( "    " ++ "(take 7 ['\\NUL' .. ])" ++ " = " ) ; print (take 7 ['\NUL' .. ]) }
+  -- printTest ((take 7 ['\250' .. ]))
+  do{ putStr ( "    " ++ "(take 7 ['\\250' .. ])" ++ " = " ) ; print (take 7 ['\250' .. ]) }
+  
+     -- [x,y..] aka enumFromThen
+  printTest ((take 7 ['a','b'..]))
+  printTest ((take 7 ['a','e'..]))
+  printTest ((take 7 ['a','a'..]))
+  printTest ((take 7 ['z','y'..]))
+  printTest ((take 7 ['z','v'..]))
+  let x = '\1'
+  -- printTest ((take 7 ['\1', '\0' ..]))
+  do{ putStr ( "    " ++ "(take 7 ['\\1', '\\0' ..])" ++ " = " ) ; print (take 7 ['\1', '\0' ..]) }
+  let x = '\5'
+  -- printTest ((take 7 ['\5', '\4' ..]))
+  do{ putStr ( "    " ++ "(take 7 ['\\5', '\\4' ..])" ++ " = " ) ; print (take 7 ['\5', '\4' ..]) }
+  let x = (maxBound::Int) - 5
+  -- printTest ((take 7 ['\250', '\251' ..]))
+  do{ putStr ( "    " ++ "(take 7 ['\\250', '\\251' ..])" ++ " = " ) ; print (take 7 ['\250', '\251' ..]) }
+
+     -- [x..y] aka enumFromTo
+  printTest ((take 7 (['a' .. 'e'])))
+  printTest ((take 4 (['a' .. 'a'])))
+  printTest ((take 7 (['b' .. 'a'])))
+  printTest ((take 7 (['e' .. 'a'])))
+  -- printTest ((take 7 (['\250' .. '\255'])))
+  do{ putStr ( "    " ++ "(take 7 (['\\250' .. '\\255']))" ++ " = " ) ; print (take 7 (['\250' .. '\255'])) }
+  -- printTest ((take 7 (['\5' .. '\0'])))
+  do{ putStr ( "    " ++ "(take 7 (['\\5' .. '\\0']))" ++ " = " ) ; print (take 7 (['\5' .. '\0'])) }
+
+     -- [x,y..z] aka enumFromThenTo
+  printTest ((take 7 ['f','e' .. 'b']))
+  printTest ((take 7 ['g','e' .. 'b']))
+  printTest ((take 7 ['g','d' .. 'c']))
+  printTest ((take 7 ['b','c' .. 'b']))
+  printTest ((take 7 ['c','b' .. 'c']))
+  printTest ((take 7 ['c','b' .. 'b']))
+  printTest ((take 7 ['c','d' .. 'b']))
+  -- printTest ((take 7 ['\251', '\252' .. maxBound]))
+  do{ putStr ( "    " ++ "(take 7 ['\\251', '\\252' .. maxBound])" ++ " = " ) ; print (take 7 ['\251', '\252' .. maxBound]) }
+  -- printTest ((take 7 ['\5', '\4' .. minBound]))
+  do{ putStr ( "    " ++ "(take 7 ['\\5', '\\4' .. minBound])" ++ " = " ) ; print (take 7 ['\5', '\4' .. minBound]) }
+
+
+testEnumUnit :: IO ()
+testEnumUnit = do
+   -- succ:
+  mayBomb (printTest ((succ ())))
+  mayBomb (printTest ((succ (minBound::()))))
+  mayBomb (printTest ((succ (maxBound::()))))
+       
+   -- pred:
+  mayBomb (printTest ((pred ())))
+  mayBomb (printTest ((pred (minBound::()))))
+  mayBomb (printTest ((pred (maxBound::()))))
+
+   -- toEnum:
+  printTest ((toEnum 0)::())
+  mayBomb   (printTest ((toEnum 1)::()))
+
+   -- fromEnum:
+  printTest ((fromEnum ()))
+
+   -- enumFrom:
+  printTest ((take 7 [()..]))
+
+   -- enumFromThen:
+  printTest ((take 7 [(),()..]))
+
+   -- enumFromTo
+  printTest ((take 7 [()..()]))
+
+   -- enumFromThenTo
+  printTest ((take 7 [(),()..()]))
+
+testEnumOrdering :: IO ()
+testEnumOrdering = do
+   -- succ:
+  printTest ((succ LT))
+  printTest ((succ (minBound::Ordering)))
+  mayBomb (printTest ((succ (maxBound::Ordering))))
+       
+   -- pred:
+  printTest ((pred GT))
+  printTest ((pred (maxBound::Ordering)))
+  mayBomb (printTest ((pred (minBound::Ordering))))
+
+   -- toEnum:
+  printTest ((toEnum 0)::Ordering)
+  mayBomb   (printTest ((toEnum 5)::Ordering))
+
+   -- fromEnum:
+  printTest ((fromEnum LT))
+  printTest ((fromEnum EQ))
+  printTest ((fromEnum GT))
+
+   -- enumFrom:
+  printTest (([LT ..]))
+  printTest (([EQ ..]))
+  printTest (([GT ..]))
+
+   -- enumFromThen:
+  printTest (([LT,EQ ..]))
+  printTest (([EQ,GT ..]))
+  printTest (([EQ,LT ..]))
+  printTest (([LT,GT ..]))
+  printTest (([GT,LT ..]))
+  printTest (take 7 (([GT,GT ..])))
+  printTest (take 7 (([LT,LT ..])))
+
+   -- enumFromTo
+  printTest (([LT .. GT]))
+  printTest (([LT .. EQ]))
+  printTest (([LT .. LT]))
+  printTest (([GT .. LT]))
+  printTest (([GT .. EQ]))
+  printTest (([GT .. GT]))
+
+   -- enumFromThenTo
+  printTest (([LT,EQ .. GT]))
+  printTest (([GT,EQ .. LT]))
+  printTest (([GT,EQ .. EQ]))
+  printTest (([GT,EQ .. GT]))
+  printTest (([GT,EQ .. LT]))
+  printTest (([LT,EQ .. LT]))
+  printTest (([LT,EQ .. GT]))
+  printTest (take 7 (([LT,LT .. GT])))
+  printTest (take 7 (([GT,GT .. LT])))
+
+testEnumBool :: IO ()
+testEnumBool = do
+   -- succ:
+  printTest ((succ False))
+  printTest ((succ (minBound::Bool)))
+  mayBomb (printTest ((succ (maxBound::Bool))))
+       
+   -- pred:
+  printTest ((pred True))
+  printTest ((pred (maxBound::Bool)))
+  mayBomb (printTest ((pred (minBound::Bool))))
+
+   -- toEnum:
+  printTest ((toEnum 0)::Bool)
+  mayBomb   (printTest ((toEnum 5)::Bool))
+
+   -- fromEnum:
+  printTest ((fromEnum False))
+  printTest ((fromEnum True))
+
+   -- enumFrom:
+  printTest (([False ..]))
+  printTest (([True ..]))
+
+   -- enumFromThen:
+  printTest (([False,True ..]))
+  printTest (([True,False ..]))
+  printTest ((take 7 ([False,False ..])))
+  printTest ((take 7 ([True,True ..])))
+
+   -- enumFromTo
+  printTest (([False .. True]))
+  printTest (([True .. False]))
+
+   -- enumFromThenTo
+  printTest (take 7 ([False,False .. False]))
+  printTest (take 7 ([False,False .. True]))
+  printTest (take 7 ([False,True .. False]))
+  printTest (take 7 ([False,True .. True]))
+  printTest (take 7 ([True,False .. False]))
+  printTest (take 7 ([True,False .. True]))
+  printTest (take 7 ([True,True .. False]))
+  printTest (take 7 ([True,True .. True]))
+
+
+testEnumInteger :: IO ()
+testEnumInteger = do
+     -- succ
+  printTest ((succ (0::Integer)))
+  printTest ((succ ((-1)::Integer)))
+
+     -- pred
+  printTest (pred (1::Integer))
+  printTest (pred (0::Integer))
+
+     -- toEnum
+  printTest ((map (toEnum::Int->Integer) [1,minBound,maxBound]))
+
+     -- fromEnum
+  printTest ((map fromEnum [(1::Integer),42,45]))
+
+     -- [x..] aka enumFrom
+  printTest ((take 7 [(1::Integer)..]))
+  printTest ((take 7 [(-5::Integer)..]))
+  
+     -- [x,y..] aka enumFromThen
+  printTest ((take 7 [(1::Integer),2..]))
+  printTest ((take 7 [(1::Integer),7..]))
+  printTest ((take 7 [(1::Integer),1..]))
+  printTest ((take 7 [(1::Integer),0..]))
+  printTest ((take 7 [(5::Integer),2..]))
+
+     -- [x..y] aka enumFromTo
+  printTest ((take 7 ([(1::Integer) .. 5])))
+  printTest ((take 4 ([(1::Integer) .. 1])))
+  printTest ((take 7 ([(1::Integer) .. 0])))
+  printTest ((take 7 ([(5::Integer) .. 0])))
+
+     -- [x,y..z] aka enumFromThenTo
+  printTest ((take 7 [(5::Integer),4..1]))
+  printTest ((take 7 [(5::Integer),3..1]))
+  printTest ((take 7 [(5::Integer),3..2]))
+  printTest ((take 7 [(1::Integer),2..1]))
+  printTest ((take 7 [(2::Integer),1..2]))
+  printTest ((take 7 [(2::Integer),1..1]))
+  printTest ((take 7 [(2::Integer),3..1]))
+
+testEnumRational :: IO ()
+testEnumRational = do
+     -- succ
+  printTest ((succ (0::Rational)))
+  printTest ((succ ((-1)::Rational)))
+
+     -- pred
+  printTest (pred (1::Rational))
+  printTest (pred (0::Rational))
+
+     -- toEnum
+  printTest ((map (toEnum::Int->Rational) [1,minBound,maxBound]))
+
+     -- fromEnum
+  printTest ((map fromEnum [(1::Rational),42,45]))
+
+     -- [x..] aka enumFrom
+  printTest ((take 7 [(1::Rational)..]))
+  printTest ((take 7 [(-5::Rational)..]))
+  
+     -- [x,y..] aka enumFromThen
+  printTest ((take 7 [(1::Rational),2..]))
+  printTest ((take 7 [(1::Rational),7..]))
+  printTest ((take 7 [(1::Rational),1..]))
+  printTest ((take 7 [(1::Rational),0..]))
+  printTest ((take 7 [(5::Rational),2..]))
+
+     -- [x..y] aka enumFromTo
+  printTest ((take 7 ([(1::Rational) .. 5])))
+  printTest ((take 4 ([(1::Rational) .. 1])))
+  printTest ((take 7 ([(1::Rational) .. 0])))
+  printTest ((take 7 ([(5::Rational) .. 0])))
+
+     -- [x,y..z] aka enumFromThenTo
+  printTest ((take 7 [(5::Rational),4..1]))
+  printTest ((take 7 [(5::Rational),3..1]))
+  printTest ((take 7 [(5::Rational),3..2]))
+  printTest ((take 7 [(1::Rational),2..1]))
+  printTest ((take 7 [(2::Rational),1..2]))
+  printTest ((take 7 [(2::Rational),1..1]))
+  printTest ((take 7 [(2::Rational),3..1]))
+
+testEnumRatioInt :: IO ()
+testEnumRatioInt = do
+     -- succ
+  printTest ((succ (0::Ratio Int)))
+  printTest ((succ ((-1)::Ratio Int)))
+
+     -- pred
+  printTest (pred (1::Ratio Int))
+  printTest (pred (0::Ratio Int))
+
+     -- toEnum
+  printTest ((map (toEnum::Int->Ratio Int) [1,minBound,maxBound]))
+
+     -- fromEnum
+  printTest ((map fromEnum [(1::Ratio Int),42,45]))
+
+     -- [x..] aka enumFrom
+  printTest ((take 7 [(1::Ratio Int)..]))
+  printTest ((take 7 [(-5::Ratio Int)..]))
+  printTest ((take 7 [((toEnum ((maxBound::Int)-5))::Ratio Int)..]))
+  
+     -- [x,y..] aka enumFromThen
+  printTest ((take 7 [(1::Ratio Int),2..]))
+  printTest ((take 7 [(1::Ratio Int),7..]))
+  printTest ((take 7 [(1::Ratio Int),1..]))
+  printTest ((take 7 [(1::Ratio Int),0..]))
+  printTest ((take 7 [(5::Ratio Int),2..]))
+  let x = (toEnum ((minBound::Int) + 1))::Ratio Int
+  printTest ((take 7 [x, x-1 ..]))
+  let x = (toEnum ((minBound::Int) + 5))::Ratio Int
+  printTest ((take 7 [x, x-1 ..]))
+  let x = (toEnum ((maxBound::Int) - 5))::Ratio Int
+  printTest ((take 7 [x, (x+1) ..]))
+
+     -- [x..y] aka enumFromTo
+  printTest ((take 7 ([(1::Ratio Int) .. 5])))
+  printTest ((take 4 ([(1::Ratio Int) .. 1])))
+  printTest ((take 7 ([(1::Ratio Int) .. 0])))
+  printTest ((take 7 ([(5::Ratio Int) .. 0])))
+  let x = (toEnum (maxBound - (5::Int))) :: Ratio Int
+  let y = (toEnum (maxBound::Int)) :: Ratio Int
+  printTest ((take 7 ([x..y])))
+  let x = (toEnum (minBound + (5::Int))) :: Ratio Int
+  let y = (toEnum (minBound::Int)) :: Ratio Int
+  printTest ((take 7 ([x..y])))
+
+     -- [x,y..z] aka enumFromThenTo
+  printTest ((take 7 [(5::Ratio Int),4..1]))
+  printTest ((take 7 [(5::Ratio Int),3..1]))
+  printTest ((take 7 [(5::Ratio Int),3..2]))
+  printTest ((take 7 [(1::Ratio Int),2..1]))
+  printTest ((take 7 [(2::Ratio Int),1..2]))
+  printTest ((take 7 [(2::Ratio Int),1..1]))
+  printTest ((take 7 [(2::Ratio Int),3..1]))
+
+  let x = (toEnum ((maxBound::Int) - 4)) :: Ratio Int
+  let y = (toEnum (maxBound::Int)) :: Ratio Int
+  printTest ((take 7 [x,(x+1)..y]))
+  let x = (toEnum ((minBound::Int) + 5)) :: Ratio Int
+  let y = (toEnum (minBound::Int)) :: Ratio Int
+  printTest ((take 7 [x,(x-1)..y]))
+
+--
+--
+--  Utils
+--
+--
+
+
+mayBomb x = catch x (\(ErrorCall e) -> putStrLn ("error " ++ show e))
+   `catch` (\e -> putStrLn ("Fail: " ++ show (e :: SomeException)))
+
+test :: Show a => String -> String -> a -> IO ()
+test test_nm expected val = do
+   putStr test_nm
+   if expected == got then
+      putStrLn ": SUCCEEDED"
+    else do
+      putStr   ": FAILED"
+      putStrLn ("( expected: " ++ show expected ++ " , got: " ++ show got ++ " )")
+  where
+   got = show val
diff --git a/tests/enum01.stdout b/tests/enum01.stdout
new file mode 100644 (file)
index 0000000..71e5bd6
--- /dev/null
@@ -0,0 +1,246 @@
+Testing Enum Int: 
+    (succ (0::Int)) = 1
+    (succ (minBound::Int)) = -2147483647
+    (succ (maxBound::Int)) = error "Prelude.Enum.succ{Int}: tried to take `succ' of maxBound"
+    pred (1::Int) = 0
+    pred (maxBound::Int) = 2147483646
+    pred (minBound::Int) = error "Prelude.Enum.pred{Int}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Int) [1,minBound,maxBound]) = [1,-2147483648,2147483647]
+    (map fromEnum [(1::Int),minBound,maxBound]) = [1,-2147483648,2147483647]
+    (take 7 [(1::Int)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int)-5)..]) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 [(1::Int),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-2147483647,-2147483648]
+    (take 7 [x, x-1 ..]) = [-2147483643,-2147483644,-2147483645,-2147483646,-2147483647,-2147483648]
+    (take 7 [x, (x+1) ..]) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    ([minBound::Int,1..]) = [-2147483648,1]
+    ([minBound::Int,0..]) = [-2147483648,0]
+    ([minBound::Int,-1..]) = [-2147483648,-1,2147483646]
+    ([maxBound::Int,1..]) = [2147483647,1,-2147483645]
+    ([maxBound::Int,0..]) = [2147483647,0,-2147483647]
+    ([maxBound::Int,-1..]) = [2147483647,-1]
+    (take 7 ([(1::Int) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int) .. 1])) = [1]
+    (take 7 ([(1::Int) .. 0])) = []
+    (take 7 ([(5::Int) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int)) .. maxBound])) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 ([(minBound+(5::Int)) .. minBound])) = []
+    (take 7 [(5::Int),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int),3..1]) = [5,3,1]
+    (take 7 [(5::Int),3..2]) = [5,3]
+    (take 7 [(1::Int),2..1]) = [1]
+    (take 7 [(2::Int),1..2]) = [2]
+    (take 7 [(2::Int),1..1]) = [2,1]
+    (take 7 [(2::Int),3..1]) = []
+    ([minBound, 1..maxBound::Int]) = [-2147483648,1]
+    ([minBound, 0..maxBound::Int]) = [-2147483648,0]
+    ([minBound,-1..maxBound::Int]) = [-2147483648,-1,2147483646]
+    ([minBound,-1..maxBound-1::Int]) = [-2147483648,-1,2147483646]
+    ([minBound,-1..maxBound-2::Int]) = [-2147483648,-1]
+    ([maxBound, 1..minBound::Int]) = [2147483647,1,-2147483645]
+    ([maxBound, 0..minBound::Int]) = [2147483647,0,-2147483647]
+    ([maxBound, 0..minBound+1::Int]) = [2147483647,0,-2147483647]
+    ([maxBound, 0..minBound+2::Int]) = [2147483647,0]
+    ([maxBound,-1..minBound::Int]) = [2147483647,-1]
+    (take 7 [x,(x+1)..maxBound]) = [2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 [x,(x-1)..minBound]) = [-2147483643,-2147483644,-2147483645,-2147483646,-2147483647,-2147483648]
+Testing Enum Integer: 
+    (succ (0::Integer)) = 1
+    (succ ((-1)::Integer)) = 0
+    pred (1::Integer) = 0
+    pred (0::Integer) = -1
+    (map (toEnum::Int->Integer) [1,minBound,maxBound]) = [1,-2147483648,2147483647]
+    (map fromEnum [(1::Integer),42,45]) = [1,42,45]
+    (take 7 [(1::Integer)..]) = [1,2,3,4,5,6,7]
+    (take 7 [(-5::Integer)..]) = [-5,-4,-3,-2,-1,0,1]
+    (take 7 [(1::Integer),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Integer),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Integer),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Integer),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Integer),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 ([(1::Integer) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Integer) .. 1])) = [1]
+    (take 7 ([(1::Integer) .. 0])) = []
+    (take 7 ([(5::Integer) .. 0])) = []
+    (take 7 [(5::Integer),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Integer),3..1]) = [5,3,1]
+    (take 7 [(5::Integer),3..2]) = [5,3]
+    (take 7 [(1::Integer),2..1]) = [1]
+    (take 7 [(2::Integer),1..2]) = [2]
+    (take 7 [(2::Integer),1..1]) = [2,1]
+    (take 7 [(2::Integer),3..1]) = []
+Testing Enum Char: 
+    (succ 'a') = 'b'
+    (succ (minBound::Char)) = '\SOH'
+    (succ (maxBound::Char)) = error "Prelude.Enum.Char.succ: bad argument"
+    (pred 'b') = 'a'
+    pred (maxBound::Char) = '\1114110'
+    pred (minBound::Char) = error "Prelude.Enum.Char.pred: bad argument"
+    (map (toEnum::Int->Char) [123,ord (minBound::Char), ord(maxBound::Char)]) = "{\NUL\1114111"
+    (toEnum::Int->Char) (minBound::Int) = error "Prelude.chr: bad argument: (-2147483648)"
+    (map fromEnum ['X',minBound,maxBound]) = [88,0,1114111]
+    (take 7 ['\NUL' .. ]) = "\NUL\SOH\STX\ETX\EOT\ENQ\ACK"
+    (take 7 ['\250' .. ]) = "\250\251\252\253\254\255\256"
+    (take 7 ['a','b'..]) = "abcdefg"
+    (take 7 ['a','e'..]) = "aeimquy"
+    (take 7 ['a','a'..]) = "aaaaaaa"
+    (take 7 ['z','y'..]) = "zyxwvut"
+    (take 7 ['z','v'..]) = "zvrnjfb"
+    (take 7 ['\1', '\0' ..]) = "\SOH\NUL"
+    (take 7 ['\5', '\4' ..]) = "\ENQ\EOT\ETX\STX\SOH\NUL"
+    (take 7 ['\250', '\251' ..]) = "\250\251\252\253\254\255\256"
+    (take 7 (['a' .. 'e'])) = "abcde"
+    (take 4 (['a' .. 'a'])) = "a"
+    (take 7 (['b' .. 'a'])) = ""
+    (take 7 (['e' .. 'a'])) = ""
+    (take 7 (['\250' .. '\255'])) = "\250\251\252\253\254\255"
+    (take 7 (['\5' .. '\0'])) = ""
+    (take 7 ['f','e' .. 'b']) = "fedcb"
+    (take 7 ['g','e' .. 'b']) = "gec"
+    (take 7 ['g','d' .. 'c']) = "gd"
+    (take 7 ['b','c' .. 'b']) = "b"
+    (take 7 ['c','b' .. 'c']) = "c"
+    (take 7 ['c','b' .. 'b']) = "cb"
+    (take 7 ['c','d' .. 'b']) = ""
+    (take 7 ['\251', '\252' .. maxBound]) = "\251\252\253\254\255\256\257"
+    (take 7 ['\5', '\4' .. minBound]) = "\ENQ\EOT\ETX\STX\SOH\NUL"
+Testing Enum (): 
+    (succ ()) = error "Prelude.Enum.().succ: bad argument"
+    (succ (minBound::())) = error "Prelude.Enum.().succ: bad argument"
+    (succ (maxBound::())) = error "Prelude.Enum.().succ: bad argument"
+    (pred ()) = error "Prelude.Enum.().pred: bad argument"
+    (pred (minBound::())) = error "Prelude.Enum.().pred: bad argument"
+    (pred (maxBound::())) = error "Prelude.Enum.().pred: bad argument"
+    (toEnum 0)::() = ()
+    (toEnum 1)::() = error "Prelude.Enum.().toEnum: bad argument"
+    (fromEnum ()) = 0
+    (take 7 [()..]) = [()]
+    (take 7 [(),()..]) = [(),(),(),(),(),(),()]
+    (take 7 [()..()]) = [()]
+    (take 7 [(),()..()]) = [(),(),(),(),(),(),()]
+Testing Enum Ordering (derived): 
+    (succ LT) = EQ
+    (succ (minBound::Ordering)) = EQ
+    (succ (maxBound::Ordering)) = error "Prelude.Enum.Ordering.succ: bad argument"
+    (pred GT) = EQ
+    (pred (maxBound::Ordering)) = EQ
+    (pred (minBound::Ordering)) = error "Prelude.Enum.Ordering.pred: bad argument"
+    (toEnum 0)::Ordering = LT
+    (toEnum 5)::Ordering = error "Prelude.Enum.Ordering.toEnum: bad argument"
+    (fromEnum LT) = 0
+    (fromEnum EQ) = 1
+    (fromEnum GT) = 2
+    ([LT ..]) = [LT,EQ,GT]
+    ([EQ ..]) = [EQ,GT]
+    ([GT ..]) = [GT]
+    ([LT,EQ ..]) = [LT,EQ,GT]
+    ([EQ,GT ..]) = [EQ,GT]
+    ([EQ,LT ..]) = [EQ,LT]
+    ([LT,GT ..]) = [LT,GT]
+    ([GT,LT ..]) = [GT,LT]
+    take 7 (([GT,GT ..])) = [GT,GT,GT,GT,GT,GT,GT]
+    take 7 (([LT,LT ..])) = [LT,LT,LT,LT,LT,LT,LT]
+    ([LT .. GT]) = [LT,EQ,GT]
+    ([LT .. EQ]) = [LT,EQ]
+    ([LT .. LT]) = [LT]
+    ([GT .. LT]) = []
+    ([GT .. EQ]) = []
+    ([GT .. GT]) = [GT]
+    ([LT,EQ .. GT]) = [LT,EQ,GT]
+    ([GT,EQ .. LT]) = [GT,EQ,LT]
+    ([GT,EQ .. EQ]) = [GT,EQ]
+    ([GT,EQ .. GT]) = [GT]
+    ([GT,EQ .. LT]) = [GT,EQ,LT]
+    ([LT,EQ .. LT]) = [LT]
+    ([LT,EQ .. GT]) = [LT,EQ,GT]
+    take 7 (([LT,LT .. GT])) = [LT,LT,LT,LT,LT,LT,LT]
+    take 7 (([GT,GT .. LT])) = []
+Testing Enum Bool: 
+    (succ False) = True
+    (succ (minBound::Bool)) = True
+    (succ (maxBound::Bool)) = error "Prelude.Enum.Bool.succ: bad argument"
+    (pred True) = False
+    (pred (maxBound::Bool)) = False
+    (pred (minBound::Bool)) = error "Prelude.Enum.Bool.pred: bad argument"
+    (toEnum 0)::Bool = False
+    (toEnum 5)::Bool = error "Prelude.Enum.Bool.toEnum: bad argument"
+    (fromEnum False) = 0
+    (fromEnum True) = 1
+    ([False ..]) = [False,True]
+    ([True ..]) = [True]
+    ([False,True ..]) = [False,True]
+    ([True,False ..]) = [True,False]
+    (take 7 ([False,False ..])) = [False,False,False,False,False,False,False]
+    (take 7 ([True,True ..])) = [True,True,True,True,True,True,True]
+    ([False .. True]) = [False,True]
+    ([True .. False]) = []
+    take 7 ([False,False .. False]) = [False,False,False,False,False,False,False]
+    take 7 ([False,False .. True]) = [False,False,False,False,False,False,False]
+    take 7 ([False,True .. False]) = [False]
+    take 7 ([False,True .. True]) = [False,True]
+    take 7 ([True,False .. False]) = [True,False]
+    take 7 ([True,False .. True]) = [True]
+    take 7 ([True,True .. False]) = []
+    take 7 ([True,True .. True]) = [True,True,True,True,True,True,True]
+Testing Enum Rational: 
+    (succ (0::Rational)) = 1 % 1
+    (succ ((-1)::Rational)) = 0 % 1
+    pred (1::Rational) = 0 % 1
+    pred (0::Rational) = (-1) % 1
+    (map (toEnum::Int->Rational) [1,minBound,maxBound]) = [1 % 1,(-2147483648) % 1,2147483647 % 1]
+    (map fromEnum [(1::Rational),42,45]) = [1,42,45]
+    (take 7 [(1::Rational)..]) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1,6 % 1,7 % 1]
+    (take 7 [(-5::Rational)..]) = [(-5) % 1,(-4) % 1,(-3) % 1,(-2) % 1,(-1) % 1,0 % 1,1 % 1]
+    (take 7 [(1::Rational),2..]) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1,6 % 1,7 % 1]
+    (take 7 [(1::Rational),7..]) = [1 % 1,7 % 1,13 % 1,19 % 1,25 % 1,31 % 1,37 % 1]
+    (take 7 [(1::Rational),1..]) = [1 % 1,1 % 1,1 % 1,1 % 1,1 % 1,1 % 1,1 % 1]
+    (take 7 [(1::Rational),0..]) = [1 % 1,0 % 1,(-1) % 1,(-2) % 1,(-3) % 1,(-4) % 1,(-5) % 1]
+    (take 7 [(5::Rational),2..]) = [5 % 1,2 % 1,(-1) % 1,(-4) % 1,(-7) % 1,(-10) % 1,(-13) % 1]
+    (take 7 ([(1::Rational) .. 5])) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1]
+    (take 4 ([(1::Rational) .. 1])) = [1 % 1]
+    (take 7 ([(1::Rational) .. 0])) = []
+    (take 7 ([(5::Rational) .. 0])) = []
+    (take 7 [(5::Rational),4..1]) = [5 % 1,4 % 1,3 % 1,2 % 1,1 % 1]
+    (take 7 [(5::Rational),3..1]) = [5 % 1,3 % 1,1 % 1]
+    (take 7 [(5::Rational),3..2]) = [5 % 1,3 % 1,1 % 1]
+    (take 7 [(1::Rational),2..1]) = [1 % 1]
+    (take 7 [(2::Rational),1..2]) = [2 % 1]
+    (take 7 [(2::Rational),1..1]) = [2 % 1,1 % 1]
+    (take 7 [(2::Rational),3..1]) = []
+Testing Enum (Ratio Int): 
+    (succ (0::Ratio Int)) = 1 % 1
+    (succ ((-1)::Ratio Int)) = 0 % 1
+    pred (1::Ratio Int) = 0 % 1
+    pred (0::Ratio Int) = (-1) % 1
+    (map (toEnum::Int->Ratio Int) [1,minBound,maxBound]) = [1 % 1,(-2147483648) % 1,2147483647 % 1]
+    (map fromEnum [(1::Ratio Int),42,45]) = [1,42,45]
+    (take 7 [(1::Ratio Int)..]) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1,6 % 1,7 % 1]
+    (take 7 [(-5::Ratio Int)..]) = [(-5) % 1,(-4) % 1,(-3) % 1,(-2) % 1,(-1) % 1,0 % 1,1 % 1]
+    (take 7 [((toEnum ((maxBound::Int)-5))::Ratio Int)..]) = [2147483642 % 1,2147483643 % 1,2147483644 % 1,2147483645 % 1,2147483646 % 1,2147483647 % 1,(-2147483648) % 1]
+    (take 7 [(1::Ratio Int),2..]) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1,6 % 1,7 % 1]
+    (take 7 [(1::Ratio Int),7..]) = [1 % 1,7 % 1,13 % 1,19 % 1,25 % 1,31 % 1,37 % 1]
+    (take 7 [(1::Ratio Int),1..]) = [1 % 1,1 % 1,1 % 1,1 % 1,1 % 1,1 % 1,1 % 1]
+    (take 7 [(1::Ratio Int),0..]) = [1 % 1,0 % 1,(-1) % 1,(-2) % 1,(-3) % 1,(-4) % 1,(-5) % 1]
+    (take 7 [(5::Ratio Int),2..]) = [5 % 1,2 % 1,(-1) % 1,(-4) % 1,(-7) % 1,(-10) % 1,(-13) % 1]
+    (take 7 [x, x-1 ..]) = [(-2147483647) % 1,(-2147483648) % 1,2147483647 % 1,2147483646 % 1,2147483645 % 1,2147483644 % 1,2147483643 % 1]
+    (take 7 [x, x-1 ..]) = [(-2147483643) % 1,(-2147483644) % 1,(-2147483645) % 1,(-2147483646) % 1,(-2147483647) % 1,(-2147483648) % 1,2147483647 % 1]
+    (take 7 [x, (x+1) ..]) = [2147483642 % 1,2147483643 % 1,2147483644 % 1,2147483645 % 1,2147483646 % 1,2147483647 % 1,(-2147483648) % 1]
+    (take 7 ([(1::Ratio Int) .. 5])) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1]
+    (take 4 ([(1::Ratio Int) .. 1])) = [1 % 1]
+    (take 7 ([(1::Ratio Int) .. 0])) = []
+    (take 7 ([(5::Ratio Int) .. 0])) = []
+    (take 7 ([x..y])) = [2147483642 % 1,2147483643 % 1,2147483644 % 1,2147483645 % 1,2147483646 % 1,2147483647 % 1]
+    (take 7 ([x..y])) = []
+    (take 7 [(5::Ratio Int),4..1]) = [5 % 1,4 % 1,3 % 1,2 % 1,1 % 1]
+    (take 7 [(5::Ratio Int),3..1]) = [5 % 1,3 % 1,1 % 1]
+    (take 7 [(5::Ratio Int),3..2]) = [5 % 1,3 % 1,1 % 1]
+    (take 7 [(1::Ratio Int),2..1]) = [1 % 1]
+    (take 7 [(2::Ratio Int),1..2]) = [2 % 1]
+    (take 7 [(2::Ratio Int),1..1]) = [2 % 1,1 % 1]
+    (take 7 [(2::Ratio Int),3..1]) = []
+    (take 7 [x,(x+1)..y]) = [2147483643 % 1,2147483644 % 1,2147483645 % 1,2147483646 % 1,2147483647 % 1]
+    (take 7 [x,(x-1)..y]) = [(-2147483643) % 1,(-2147483644) % 1,(-2147483645) % 1,(-2147483646) % 1,(-2147483647) % 1,(-2147483648) % 1]
diff --git a/tests/enum01.stdout-alpha-dec-osf3 b/tests/enum01.stdout-alpha-dec-osf3
new file mode 100644 (file)
index 0000000..63ba3e2
--- /dev/null
@@ -0,0 +1,230 @@
+Testing Enum Int: 
+    (succ (0::Int)) = 1
+    (succ (minBound::Int)) = -9223372036854775807
+    (succ (maxBound::Int)) = error "Prelude.Enum.succ{Int}: tried to take `succ' of maxBound"
+    pred (1::Int) = 0
+    pred (maxBound::Int) = 9223372036854775806
+    pred (minBound::Int) = error "Prelude.Enum.pred{Int}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Int) [1,minBound,maxBound]) = [1,-9223372036854775808,9223372036854775807]
+    (map fromEnum [(1::Int),minBound,maxBound]) = [1,-9223372036854775808,9223372036854775807]
+    (take 7 [(1::Int)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int)-5)..]) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 [(1::Int),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-9223372036854775807,-9223372036854775808]
+    (take 7 [x, x-1 ..]) = [-9223372036854775803,-9223372036854775804,-9223372036854775805,-9223372036854775806,-9223372036854775807,-9223372036854775808]
+    (take 7 [x, (x+1) ..]) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 ([(1::Int) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int) .. 1])) = [1]
+    (take 7 ([(1::Int) .. 0])) = []
+    (take 7 ([(5::Int) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int)) .. maxBound])) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 ([(minBound+(5::Int)) .. minBound])) = []
+    (take 7 [(5::Int),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int),3..1]) = [5,3,1]
+    (take 7 [(5::Int),3..2]) = [5,3]
+    (take 7 [(1::Int),2..1]) = [1]
+    (take 7 [(2::Int),1..2]) = [2]
+    (take 7 [(2::Int),1..1]) = [2,1]
+    (take 7 [(2::Int),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 [x,(x-1)..minBound]) = [-9223372036854775803,-9223372036854775804,-9223372036854775805,-9223372036854775806,-9223372036854775807,-9223372036854775808]
+Testing Enum Integer: 
+    (succ (0::Integer)) = 1
+    (succ ((-1)::Integer)) = 0
+    pred (1::Integer) = 0
+    pred (0::Integer) = -1
+    (map (toEnum::Int->Integer) [1,minBound,maxBound]) = [1,-9223372036854775808,9223372036854775807]
+    (map fromEnum [(1::Integer),42,45]) = [1,42,45]
+    (take 7 [(1::Integer)..]) = [1,2,3,4,5,6,7]
+    (take 7 [(-5::Integer)..]) = [-5,-4,-3,-2,-1,0,1]
+    (take 7 [(1::Integer),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Integer),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Integer),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Integer),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Integer),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 ([(1::Integer) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Integer) .. 1])) = [1]
+    (take 7 ([(1::Integer) .. 0])) = []
+    (take 7 ([(5::Integer) .. 0])) = []
+    (take 7 [(5::Integer),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Integer),3..1]) = [5,3,1]
+    (take 7 [(5::Integer),3..2]) = [5,3]
+    (take 7 [(1::Integer),2..1]) = [1]
+    (take 7 [(2::Integer),1..2]) = [2]
+    (take 7 [(2::Integer),1..1]) = [2,1]
+    (take 7 [(2::Integer),3..1]) = []
+Testing Enum Char: 
+    (succ 'a') = 'b'
+    (succ (minBound::Char)) = '\SOH'
+    (succ (maxBound::Char)) = error "Prelude.Enum.Char.succ: bad argument"
+    (pred 'b') = 'a'
+    pred (maxBound::Char) = '\1114110'
+    pred (minBound::Char) = error "Prelude.Enum.Char.pred: bad argument"
+    (map (toEnum::Int->Char) [123,ord (minBound::Char), ord(maxBound::Char)]) = "{\NUL\1114111"
+    (toEnum::Int->Char) (minBound::Int) = error "Prelude.chr: bad argument"
+    (map fromEnum ['X',minBound,maxBound]) = [88,0,1114111]
+    (take 7 ['\NUL' .. ]) = "\NUL\SOH\STX\ETX\EOT\ENQ\ACK"
+    (take 7 ['\250' .. ]) = "\250\251\252\253\254\255\256"
+    (take 7 ['a','b'..]) = "abcdefg"
+    (take 7 ['a','e'..]) = "aeimquy"
+    (take 7 ['a','a'..]) = "aaaaaaa"
+    (take 7 ['z','y'..]) = "zyxwvut"
+    (take 7 ['z','v'..]) = "zvrnjfb"
+    (take 7 ['\1', '\0' ..]) = "\SOH\NUL"
+    (take 7 ['\5', '\4' ..]) = "\ENQ\EOT\ETX\STX\SOH\NUL"
+    (take 7 ['\250', '\251' ..]) = "\250\251\252\253\254\255\256"
+    (take 7 (['a' .. 'e'])) = "abcde"
+    (take 4 (['a' .. 'a'])) = "a"
+    (take 7 (['b' .. 'a'])) = ""
+    (take 7 (['e' .. 'a'])) = ""
+    (take 7 (['\250' .. '\255'])) = "\250\251\252\253\254\255"
+    (take 7 (['\5' .. '\0'])) = ""
+    (take 7 ['f','e' .. 'b']) = "fedcb"
+    (take 7 ['g','e' .. 'b']) = "gec"
+    (take 7 ['g','d' .. 'c']) = "gd"
+    (take 7 ['b','c' .. 'b']) = "b"
+    (take 7 ['c','b' .. 'c']) = "c"
+    (take 7 ['c','b' .. 'b']) = "cb"
+    (take 7 ['c','d' .. 'b']) = ""
+    (take 7 ['\251', '\252' .. maxBound]) = "\251\252\253\254\255\256\257"
+    (take 7 ['\5', '\4' .. minBound]) = "\ENQ\EOT\ETX\STX\SOH\NUL"
+Testing Enum (): 
+    (succ ()) = error "Prelude.Enum.().succ: bad argument"
+    (succ (minBound::())) = error "Prelude.Enum.().succ: bad argument"
+    (succ (maxBound::())) = error "Prelude.Enum.().succ: bad argument"
+    (pred ()) = error "Prelude.Enum.().pred: bad argument"
+    (pred (minBound::())) = error "Prelude.Enum.().pred: bad argument"
+    (pred (maxBound::())) = error "Prelude.Enum.().pred: bad argument"
+    (toEnum 0)::() = ()
+    (toEnum 1)::() = error "Prelude.Enum.().toEnum: bad argument"
+    (fromEnum ()) = 0
+    (take 7 [()..]) = [()]
+    (take 7 [(),()..]) = [(),(),(),(),(),(),()]
+    (take 7 [()..()]) = [()]
+    (take 7 [(),()..()]) = [(),(),(),(),(),(),()]
+Testing Enum Ordering (derived): 
+    (succ LT) = EQ
+    (succ (minBound::Ordering)) = EQ
+    (succ (maxBound::Ordering)) = error "Prelude.Enum.Ordering.succ: bad argument"
+    (pred GT) = EQ
+    (pred (maxBound::Ordering)) = EQ
+    (pred (minBound::Ordering)) = error "Prelude.Enum.Ordering.pred: bad argument"
+    (toEnum 0)::Ordering = LT
+    (toEnum 5)::Ordering = error "Prelude.Enum.Ordering.toEnum: bad argument"
+    (fromEnum LT) = 0
+    (fromEnum EQ) = 1
+    (fromEnum GT) = 2
+    ([LT ..]) = [LT,EQ,GT]
+    ([EQ ..]) = [EQ,GT]
+    ([GT ..]) = [GT]
+    ([LT,EQ ..]) = [LT,EQ,GT]
+    ([EQ,GT ..]) = [EQ,GT]
+    ([EQ,LT ..]) = [EQ,LT]
+    ([LT,GT ..]) = [LT,GT]
+    ([GT,LT ..]) = [GT,LT]
+    take 7 (([GT,GT ..])) = [GT,GT,GT,GT,GT,GT,GT]
+    take 7 (([LT,LT ..])) = [LT,LT,LT,LT,LT,LT,LT]
+    ([LT .. GT]) = [LT,EQ,GT]
+    ([LT .. EQ]) = [LT,EQ]
+    ([LT .. LT]) = [LT]
+    ([GT .. LT]) = []
+    ([GT .. EQ]) = []
+    ([GT .. GT]) = [GT]
+    ([LT,EQ .. GT]) = [LT,EQ,GT]
+    ([GT,EQ .. LT]) = [GT,EQ,LT]
+    ([GT,EQ .. EQ]) = [GT,EQ]
+    ([GT,EQ .. GT]) = [GT]
+    ([GT,EQ .. LT]) = [GT,EQ,LT]
+    ([LT,EQ .. LT]) = [LT]
+    ([LT,EQ .. GT]) = [LT,EQ,GT]
+    take 7 (([LT,LT .. GT])) = [LT,LT,LT,LT,LT,LT,LT]
+    take 7 (([GT,GT .. LT])) = []
+Testing Enum Bool: 
+    (succ False) = True
+    (succ (minBound::Bool)) = True
+    (succ (maxBound::Bool)) = error "Prelude.Enum.Bool.succ: bad argument"
+    (pred True) = False
+    (pred (maxBound::Bool)) = False
+    (pred (minBound::Bool)) = error "Prelude.Enum.Bool.pred: bad argument"
+    (toEnum 0)::Bool = False
+    (toEnum 5)::Bool = error "Prelude.Enum.Bool.toEnum: bad argument"
+    (fromEnum False) = 0
+    (fromEnum True) = 1
+    ([False ..]) = [False,True]
+    ([True ..]) = [True]
+    ([False,True ..]) = [False,True]
+    ([True,False ..]) = [True,False]
+    (take 7 ([False,False ..])) = [False,False,False,False,False,False,False]
+    (take 7 ([True,True ..])) = [True,True,True,True,True,True,True]
+    ([False .. True]) = [False,True]
+    ([True .. False]) = []
+    take 7 ([False,False .. False]) = [False,False,False,False,False,False,False]
+    take 7 ([False,False .. True]) = [False,False,False,False,False,False,False]
+    take 7 ([False,True .. False]) = [False]
+    take 7 ([False,True .. True]) = [False,True]
+    take 7 ([True,False .. False]) = [True,False]
+    take 7 ([True,False .. True]) = [True]
+    take 7 ([True,True .. False]) = []
+    take 7 ([True,True .. True]) = [True,True,True,True,True,True,True]
+Testing Enum Rational: 
+    (succ (0::Rational)) = 1%1
+    (succ ((-1)::Rational)) = 0%1
+    pred (1::Rational) = 0%1
+    pred (0::Rational) = (-1)%1
+    (map (toEnum::Int->Rational) [1,minBound,maxBound]) = [1%1,(-9223372036854775808)%1,9223372036854775807%1]
+    (map fromEnum [(1::Rational),42,45]) = [1,42,45]
+    (take 7 [(1::Rational)..]) = [1%1,2%1,3%1,4%1,5%1,6%1,7%1]
+    (take 7 [(-5::Rational)..]) = [(-5)%1,(-4)%1,(-3)%1,(-2)%1,(-1)%1,0%1,1%1]
+    (take 7 [(1::Rational),2..]) = [1%1,2%1,3%1,4%1,5%1,6%1,7%1]
+    (take 7 [(1::Rational),7..]) = [1%1,7%1,13%1,19%1,25%1,31%1,37%1]
+    (take 7 [(1::Rational),1..]) = [1%1,1%1,1%1,1%1,1%1,1%1,1%1]
+    (take 7 [(1::Rational),0..]) = [1%1,0%1,(-1)%1,(-2)%1,(-3)%1,(-4)%1,(-5)%1]
+    (take 7 [(5::Rational),2..]) = [5%1,2%1,(-1)%1,(-4)%1,(-7)%1,(-10)%1,(-13)%1]
+    (take 7 ([(1::Rational) .. 5])) = [1%1,2%1,3%1,4%1,5%1]
+    (take 4 ([(1::Rational) .. 1])) = [1%1]
+    (take 7 ([(1::Rational) .. 0])) = []
+    (take 7 ([(5::Rational) .. 0])) = []
+    (take 7 [(5::Rational),4..1]) = [5%1,4%1,3%1,2%1,1%1]
+    (take 7 [(5::Rational),3..1]) = [5%1,3%1,1%1]
+    (take 7 [(5::Rational),3..2]) = [5%1,3%1,1%1]
+    (take 7 [(1::Rational),2..1]) = [1%1]
+    (take 7 [(2::Rational),1..2]) = [2%1]
+    (take 7 [(2::Rational),1..1]) = [2%1,1%1]
+    (take 7 [(2::Rational),3..1]) = []
+Testing Enum (Ratio Int): 
+    (succ (0::Ratio Int)) = 1%1
+    (succ ((-1)::Ratio Int)) = 0%1
+    pred (1::Ratio Int) = 0%1
+    pred (0::Ratio Int) = (-1)%1
+    (map (toEnum::Int->Ratio Int) [1,minBound,maxBound]) = [1%1,(-9223372036854775808)%1,9223372036854775807%1]
+    (map fromEnum [(1::Ratio Int),42,45]) = [1,42,45]
+    (take 7 [(1::Ratio Int)..]) = [1%1,2%1,3%1,4%1,5%1,6%1,7%1]
+    (take 7 [(-5::Ratio Int)..]) = [(-5)%1,(-4)%1,(-3)%1,(-2)%1,(-1)%1,0%1,1%1]
+    (take 7 [((toEnum ((maxBound::Int)-5))::Ratio Int)..]) = [9223372036854775802%1,9223372036854775803%1,9223372036854775804%1,9223372036854775805%1,9223372036854775806%1,9223372036854775807%1,(-9223372036854775808)%1]
+    (take 7 [(1::Ratio Int),2..]) = [1%1,2%1,3%1,4%1,5%1,6%1,7%1]
+    (take 7 [(1::Ratio Int),7..]) = [1%1,7%1,13%1,19%1,25%1,31%1,37%1]
+    (take 7 [(1::Ratio Int),1..]) = [1%1,1%1,1%1,1%1,1%1,1%1,1%1]
+    (take 7 [(1::Ratio Int),0..]) = [1%1,0%1,(-1)%1,(-2)%1,(-3)%1,(-4)%1,(-5)%1]
+    (take 7 [(5::Ratio Int),2..]) = [5%1,2%1,(-1)%1,(-4)%1,(-7)%1,(-10)%1,(-13)%1]
+    (take 7 [x, x-1 ..]) = [(-9223372036854775807)%1,(-9223372036854775808)%1,9223372036854775807%1,9223372036854775806%1,9223372036854775805%1,9223372036854775804%1,9223372036854775803%1]
+    (take 7 [x, x-1 ..]) = [(-9223372036854775803)%1,(-9223372036854775804)%1,(-9223372036854775805)%1,(-9223372036854775806)%1,(-9223372036854775807)%1,(-9223372036854775808)%1,9223372036854775807%1]
+    (take 7 [x, (x+1) ..]) = [9223372036854775802%1,9223372036854775803%1,9223372036854775804%1,9223372036854775805%1,9223372036854775806%1,9223372036854775807%1,(-9223372036854775808)%1]
+    (take 7 ([(1::Ratio Int) .. 5])) = [1%1,2%1,3%1,4%1,5%1]
+    (take 4 ([(1::Ratio Int) .. 1])) = [1%1]
+    (take 7 ([(1::Ratio Int) .. 0])) = []
+    (take 7 ([(5::Ratio Int) .. 0])) = []
+    (take 7 ([x..y])) = [9223372036854775802%1,9223372036854775803%1,9223372036854775804%1,9223372036854775805%1,9223372036854775806%1,9223372036854775807%1]
+    (take 7 ([x..y])) = []
+    (take 7 [(5::Ratio Int),4..1]) = [5%1,4%1,3%1,2%1,1%1]
+    (take 7 [(5::Ratio Int),3..1]) = [5%1,3%1,1%1]
+    (take 7 [(5::Ratio Int),3..2]) = [5%1,3%1,1%1]
+    (take 7 [(1::Ratio Int),2..1]) = [1%1]
+    (take 7 [(2::Ratio Int),1..2]) = [2%1]
+    (take 7 [(2::Ratio Int),1..1]) = [2%1,1%1]
+    (take 7 [(2::Ratio Int),3..1]) = []
+    (take 7 [x,(x+1)..y]) = [9223372036854775803%1,9223372036854775804%1,9223372036854775805%1,9223372036854775806%1,9223372036854775807%1]
+    (take 7 [x,(x-1)..y]) = [(-9223372036854775803)%1,(-9223372036854775804)%1,(-9223372036854775805)%1,(-9223372036854775806)%1,(-9223372036854775807)%1,(-9223372036854775808)%1]
diff --git a/tests/enum01.stdout-hugs b/tests/enum01.stdout-hugs
new file mode 100644 (file)
index 0000000..41bb64d
--- /dev/null
@@ -0,0 +1,246 @@
+Testing Enum Int: 
+    (succ (0::Int)) = 1
+    (succ (minBound::Int)) = -2147483647
+    (succ (maxBound::Int)) = error "succ: applied to maxBound"
+    pred (1::Int) = 0
+    pred (maxBound::Int) = 2147483646
+    pred (minBound::Int) = error "pred: applied to minBound"
+    (map (toEnum::Int->Int) [1,minBound,maxBound]) = [1,-2147483648,2147483647]
+    (map fromEnum [(1::Int),minBound,maxBound]) = [1,-2147483648,2147483647]
+    (take 7 [(1::Int)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int)-5)..]) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 [(1::Int),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-2147483647,-2147483648]
+    (take 7 [x, x-1 ..]) = [-2147483643,-2147483644,-2147483645,-2147483646,-2147483647,-2147483648]
+    (take 7 [x, (x+1) ..]) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    ([minBound::Int,1..]) = [-2147483648,1]
+    ([minBound::Int,0..]) = [-2147483648,0]
+    ([minBound::Int,-1..]) = [-2147483648,-1,2147483646]
+    ([maxBound::Int,1..]) = [2147483647,1,-2147483645]
+    ([maxBound::Int,0..]) = [2147483647,0,-2147483647]
+    ([maxBound::Int,-1..]) = [2147483647,-1]
+    (take 7 ([(1::Int) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int) .. 1])) = [1]
+    (take 7 ([(1::Int) .. 0])) = []
+    (take 7 ([(5::Int) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int)) .. maxBound])) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 ([(minBound+(5::Int)) .. minBound])) = []
+    (take 7 [(5::Int),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int),3..1]) = [5,3,1]
+    (take 7 [(5::Int),3..2]) = [5,3]
+    (take 7 [(1::Int),2..1]) = [1]
+    (take 7 [(2::Int),1..2]) = [2]
+    (take 7 [(2::Int),1..1]) = [2,1]
+    (take 7 [(2::Int),3..1]) = []
+    ([minBound, 1..maxBound::Int]) = [-2147483648,1]
+    ([minBound, 0..maxBound::Int]) = [-2147483648,0]
+    ([minBound,-1..maxBound::Int]) = [-2147483648,-1,2147483646]
+    ([minBound,-1..maxBound-1::Int]) = [-2147483648,-1,2147483646]
+    ([minBound,-1..maxBound-2::Int]) = [-2147483648,-1]
+    ([maxBound, 1..minBound::Int]) = [2147483647,1,-2147483645]
+    ([maxBound, 0..minBound::Int]) = [2147483647,0,-2147483647]
+    ([maxBound, 0..minBound+1::Int]) = [2147483647,0,-2147483647]
+    ([maxBound, 0..minBound+2::Int]) = [2147483647,0]
+    ([maxBound,-1..minBound::Int]) = [2147483647,-1]
+    (take 7 [x,(x+1)..maxBound]) = [2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 [x,(x-1)..minBound]) = [-2147483643,-2147483644,-2147483645,-2147483646,-2147483647,-2147483648]
+Testing Enum Integer: 
+    (succ (0::Integer)) = 1
+    (succ ((-1)::Integer)) = 0
+    pred (1::Integer) = 0
+    pred (0::Integer) = -1
+    (map (toEnum::Int->Integer) [1,minBound,maxBound]) = [1,-2147483648,2147483647]
+    (map fromEnum [(1::Integer),42,45]) = [1,42,45]
+    (take 7 [(1::Integer)..]) = [1,2,3,4,5,6,7]
+    (take 7 [(-5::Integer)..]) = [-5,-4,-3,-2,-1,0,1]
+    (take 7 [(1::Integer),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Integer),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Integer),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Integer),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Integer),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 ([(1::Integer) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Integer) .. 1])) = [1]
+    (take 7 ([(1::Integer) .. 0])) = []
+    (take 7 ([(5::Integer) .. 0])) = []
+    (take 7 [(5::Integer),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Integer),3..1]) = [5,3,1]
+    (take 7 [(5::Integer),3..2]) = [5,3]
+    (take 7 [(1::Integer),2..1]) = [1]
+    (take 7 [(2::Integer),1..2]) = [2]
+    (take 7 [(2::Integer),1..1]) = [2,1]
+    (take 7 [(2::Integer),3..1]) = []
+Testing Enum Char: 
+    (succ 'a') = 'b'
+    (succ (minBound::Char)) = '\SOH'
+    (succ (maxBound::Char)) = error "chr: out of range"
+    (pred 'b') = 'a'
+    pred (maxBound::Char) = '\1114110'
+    pred (minBound::Char) = error "chr: out of range"
+    (map (toEnum::Int->Char) [123,ord (minBound::Char), ord(maxBound::Char)]) = "{\NUL\1114111"
+    (toEnum::Int->Char) (minBound::Int) = error "chr: out of range"
+    (map fromEnum ['X',minBound,maxBound]) = [88,0,1114111]
+    (take 7 ['\NUL' .. ]) = "\NUL\SOH\STX\ETX\EOT\ENQ\ACK"
+    (take 7 ['\250' .. ]) = "\250\251\252\253\254\255\256"
+    (take 7 ['a','b'..]) = "abcdefg"
+    (take 7 ['a','e'..]) = "aeimquy"
+    (take 7 ['a','a'..]) = "aaaaaaa"
+    (take 7 ['z','y'..]) = "zyxwvut"
+    (take 7 ['z','v'..]) = "zvrnjfb"
+    (take 7 ['\1', '\0' ..]) = "\SOH\NUL"
+    (take 7 ['\5', '\4' ..]) = "\ENQ\EOT\ETX\STX\SOH\NUL"
+    (take 7 ['\250', '\251' ..]) = "\250\251\252\253\254\255\256"
+    (take 7 (['a' .. 'e'])) = "abcde"
+    (take 4 (['a' .. 'a'])) = "a"
+    (take 7 (['b' .. 'a'])) = ""
+    (take 7 (['e' .. 'a'])) = ""
+    (take 7 (['\250' .. '\255'])) = "\250\251\252\253\254\255"
+    (take 7 (['\5' .. '\0'])) = ""
+    (take 7 ['f','e' .. 'b']) = "fedcb"
+    (take 7 ['g','e' .. 'b']) = "gec"
+    (take 7 ['g','d' .. 'c']) = "gd"
+    (take 7 ['b','c' .. 'b']) = "b"
+    (take 7 ['c','b' .. 'c']) = "c"
+    (take 7 ['c','b' .. 'b']) = "cb"
+    (take 7 ['c','d' .. 'b']) = ""
+    (take 7 ['\251', '\252' .. maxBound]) = "\251\252\253\254\255\256\257"
+    (take 7 ['\5', '\4' .. minBound]) = "\ENQ\EOT\ETX\STX\SOH\NUL"
+Testing Enum (): 
+    (succ ()) = Fail: pattern match failure
+    (succ (minBound::())) = Fail: pattern match failure
+    (succ (maxBound::())) = Fail: pattern match failure
+    (pred ()) = Fail: pattern match failure
+    (pred (minBound::())) = Fail: pattern match failure
+    (pred (maxBound::())) = Fail: pattern match failure
+    (toEnum 0)::() = ()
+    (toEnum 1)::() = Fail: pattern match failure
+    (fromEnum ()) = 0
+    (take 7 [()..]) = [()]
+    (take 7 [(),()..]) = [(),(),(),(),(),(),()]
+    (take 7 [()..()]) = [()]
+    (take 7 [(),()..()]) = [(),(),(),(),(),(),()]
+Testing Enum Ordering (derived): 
+    (succ LT) = EQ
+    (succ (minBound::Ordering)) = EQ
+    (succ (maxBound::Ordering)) = error "toEnum: out of range"
+    (pred GT) = EQ
+    (pred (maxBound::Ordering)) = EQ
+    (pred (minBound::Ordering)) = error "toEnum: out of range"
+    (toEnum 0)::Ordering = LT
+    (toEnum 5)::Ordering = error "toEnum: out of range"
+    (fromEnum LT) = 0
+    (fromEnum EQ) = 1
+    (fromEnum GT) = 2
+    ([LT ..]) = [LT,EQ,GT]
+    ([EQ ..]) = [EQ,GT]
+    ([GT ..]) = [GT]
+    ([LT,EQ ..]) = [LT,EQ,GT]
+    ([EQ,GT ..]) = [EQ,GT]
+    ([EQ,LT ..]) = [EQ,LT]
+    ([LT,GT ..]) = [LT,GT]
+    ([GT,LT ..]) = [GT,LT]
+    take 7 (([GT,GT ..])) = [GT,GT,GT,GT,GT,GT,GT]
+    take 7 (([LT,LT ..])) = [LT,LT,LT,LT,LT,LT,LT]
+    ([LT .. GT]) = [LT,EQ,GT]
+    ([LT .. EQ]) = [LT,EQ]
+    ([LT .. LT]) = [LT]
+    ([GT .. LT]) = []
+    ([GT .. EQ]) = []
+    ([GT .. GT]) = [GT]
+    ([LT,EQ .. GT]) = [LT,EQ,GT]
+    ([GT,EQ .. LT]) = [GT,EQ,LT]
+    ([GT,EQ .. EQ]) = [GT,EQ]
+    ([GT,EQ .. GT]) = [GT]
+    ([GT,EQ .. LT]) = [GT,EQ,LT]
+    ([LT,EQ .. LT]) = [LT]
+    ([LT,EQ .. GT]) = [LT,EQ,GT]
+    take 7 (([LT,LT .. GT])) = [LT,LT,LT,LT,LT,LT,LT]
+    take 7 (([GT,GT .. LT])) = []
+Testing Enum Bool: 
+    (succ False) = True
+    (succ (minBound::Bool)) = True
+    (succ (maxBound::Bool)) = error "toEnum: out of range"
+    (pred True) = False
+    (pred (maxBound::Bool)) = False
+    (pred (minBound::Bool)) = error "toEnum: out of range"
+    (toEnum 0)::Bool = False
+    (toEnum 5)::Bool = error "toEnum: out of range"
+    (fromEnum False) = 0
+    (fromEnum True) = 1
+    ([False ..]) = [False,True]
+    ([True ..]) = [True]
+    ([False,True ..]) = [False,True]
+    ([True,False ..]) = [True,False]
+    (take 7 ([False,False ..])) = [False,False,False,False,False,False,False]
+    (take 7 ([True,True ..])) = [True,True,True,True,True,True,True]
+    ([False .. True]) = [False,True]
+    ([True .. False]) = []
+    take 7 ([False,False .. False]) = [False,False,False,False,False,False,False]
+    take 7 ([False,False .. True]) = [False,False,False,False,False,False,False]
+    take 7 ([False,True .. False]) = [False]
+    take 7 ([False,True .. True]) = [False,True]
+    take 7 ([True,False .. False]) = [True,False]
+    take 7 ([True,False .. True]) = [True]
+    take 7 ([True,True .. False]) = []
+    take 7 ([True,True .. True]) = [True,True,True,True,True,True,True]
+Testing Enum Rational: 
+    (succ (0::Rational)) = 1 % 1
+    (succ ((-1)::Rational)) = 0 % 1
+    pred (1::Rational) = 0 % 1
+    pred (0::Rational) = (-1) % 1
+    (map (toEnum::Int->Rational) [1,minBound,maxBound]) = [1 % 1,(-2147483648) % 1,2147483647 % 1]
+    (map fromEnum [(1::Rational),42,45]) = [1,42,45]
+    (take 7 [(1::Rational)..]) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1,6 % 1,7 % 1]
+    (take 7 [(-5::Rational)..]) = [(-5) % 1,(-4) % 1,(-3) % 1,(-2) % 1,(-1) % 1,0 % 1,1 % 1]
+    (take 7 [(1::Rational),2..]) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1,6 % 1,7 % 1]
+    (take 7 [(1::Rational),7..]) = [1 % 1,7 % 1,13 % 1,19 % 1,25 % 1,31 % 1,37 % 1]
+    (take 7 [(1::Rational),1..]) = [1 % 1,1 % 1,1 % 1,1 % 1,1 % 1,1 % 1,1 % 1]
+    (take 7 [(1::Rational),0..]) = [1 % 1,0 % 1,(-1) % 1,(-2) % 1,(-3) % 1,(-4) % 1,(-5) % 1]
+    (take 7 [(5::Rational),2..]) = [5 % 1,2 % 1,(-1) % 1,(-4) % 1,(-7) % 1,(-10) % 1,(-13) % 1]
+    (take 7 ([(1::Rational) .. 5])) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1]
+    (take 4 ([(1::Rational) .. 1])) = [1 % 1]
+    (take 7 ([(1::Rational) .. 0])) = []
+    (take 7 ([(5::Rational) .. 0])) = []
+    (take 7 [(5::Rational),4..1]) = [5 % 1,4 % 1,3 % 1,2 % 1,1 % 1]
+    (take 7 [(5::Rational),3..1]) = [5 % 1,3 % 1,1 % 1]
+    (take 7 [(5::Rational),3..2]) = [5 % 1,3 % 1,1 % 1]
+    (take 7 [(1::Rational),2..1]) = [1 % 1]
+    (take 7 [(2::Rational),1..2]) = [2 % 1]
+    (take 7 [(2::Rational),1..1]) = [2 % 1,1 % 1]
+    (take 7 [(2::Rational),3..1]) = []
+Testing Enum (Ratio Int): 
+    (succ (0::Ratio Int)) = 1 % 1
+    (succ ((-1)::Ratio Int)) = 0 % 1
+    pred (1::Ratio Int) = 0 % 1
+    pred (0::Ratio Int) = (-1) % 1
+    (map (toEnum::Int->Ratio Int) [1,minBound,maxBound]) = [1 % 1,(-2147483648) % 1,2147483647 % 1]
+    (map fromEnum [(1::Ratio Int),42,45]) = [1,42,45]
+    (take 7 [(1::Ratio Int)..]) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1,6 % 1,7 % 1]
+    (take 7 [(-5::Ratio Int)..]) = [(-5) % 1,(-4) % 1,(-3) % 1,(-2) % 1,(-1) % 1,0 % 1,1 % 1]
+    (take 7 [((toEnum ((maxBound::Int)-5))::Ratio Int)..]) = [2147483642 % 1,2147483643 % 1,2147483644 % 1,2147483645 % 1,2147483646 % 1,2147483647 % 1,(-2147483648) % 1]
+    (take 7 [(1::Ratio Int),2..]) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1,6 % 1,7 % 1]
+    (take 7 [(1::Ratio Int),7..]) = [1 % 1,7 % 1,13 % 1,19 % 1,25 % 1,31 % 1,37 % 1]
+    (take 7 [(1::Ratio Int),1..]) = [1 % 1,1 % 1,1 % 1,1 % 1,1 % 1,1 % 1,1 % 1]
+    (take 7 [(1::Ratio Int),0..]) = [1 % 1,0 % 1,(-1) % 1,(-2) % 1,(-3) % 1,(-4) % 1,(-5) % 1]
+    (take 7 [(5::Ratio Int),2..]) = [5 % 1,2 % 1,(-1) % 1,(-4) % 1,(-7) % 1,(-10) % 1,(-13) % 1]
+    (take 7 [x, x-1 ..]) = [(-2147483647) % 1,(-2147483648) % 1,2147483647 % 1,2147483646 % 1,2147483645 % 1,2147483644 % 1,2147483643 % 1]
+    (take 7 [x, x-1 ..]) = [(-2147483643) % 1,(-2147483644) % 1,(-2147483645) % 1,(-2147483646) % 1,(-2147483647) % 1,(-2147483648) % 1,2147483647 % 1]
+    (take 7 [x, (x+1) ..]) = [2147483642 % 1,2147483643 % 1,2147483644 % 1,2147483645 % 1,2147483646 % 1,2147483647 % 1,(-2147483648) % 1]
+    (take 7 ([(1::Ratio Int) .. 5])) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1]
+    (take 4 ([(1::Ratio Int) .. 1])) = [1 % 1]
+    (take 7 ([(1::Ratio Int) .. 0])) = []
+    (take 7 ([(5::Ratio Int) .. 0])) = []
+    (take 7 ([x..y])) = [2147483642 % 1,2147483643 % 1,2147483644 % 1,2147483645 % 1,2147483646 % 1,2147483647 % 1]
+    (take 7 ([x..y])) = []
+    (take 7 [(5::Ratio Int),4..1]) = [5 % 1,4 % 1,3 % 1,2 % 1,1 % 1]
+    (take 7 [(5::Ratio Int),3..1]) = [5 % 1,3 % 1,1 % 1]
+    (take 7 [(5::Ratio Int),3..2]) = [5 % 1,3 % 1,1 % 1]
+    (take 7 [(1::Ratio Int),2..1]) = [1 % 1]
+    (take 7 [(2::Ratio Int),1..2]) = [2 % 1]
+    (take 7 [(2::Ratio Int),1..1]) = [2 % 1,1 % 1]
+    (take 7 [(2::Ratio Int),3..1]) = []
+    (take 7 [x,(x+1)..y]) = [2147483643 % 1,2147483644 % 1,2147483645 % 1,2147483646 % 1,2147483647 % 1]
+    (take 7 [x,(x-1)..y]) = [(-2147483643) % 1,(-2147483644) % 1,(-2147483645) % 1,(-2147483646) % 1,(-2147483647) % 1,(-2147483648) % 1]
diff --git a/tests/enum01.stdout-ws-64 b/tests/enum01.stdout-ws-64
new file mode 100644 (file)
index 0000000..3804dd2
--- /dev/null
@@ -0,0 +1,246 @@
+Testing Enum Int: 
+    (succ (0::Int)) = 1
+    (succ (minBound::Int)) = -9223372036854775807
+    (succ (maxBound::Int)) = error "Prelude.Enum.succ{Int}: tried to take `succ' of maxBound"
+    pred (1::Int) = 0
+    pred (maxBound::Int) = 9223372036854775806
+    pred (minBound::Int) = error "Prelude.Enum.pred{Int}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Int) [1,minBound,maxBound]) = [1,-9223372036854775808,9223372036854775807]
+    (map fromEnum [(1::Int),minBound,maxBound]) = [1,-9223372036854775808,9223372036854775807]
+    (take 7 [(1::Int)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int)-5)..]) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 [(1::Int),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-9223372036854775807,-9223372036854775808]
+    (take 7 [x, x-1 ..]) = [-9223372036854775803,-9223372036854775804,-9223372036854775805,-9223372036854775806,-9223372036854775807,-9223372036854775808]
+    (take 7 [x, (x+1) ..]) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    ([minBound::Int,1..]) = [-9223372036854775808,1]
+    ([minBound::Int,0..]) = [-9223372036854775808,0]
+    ([minBound::Int,-1..]) = [-9223372036854775808,-1,9223372036854775806]
+    ([maxBound::Int,1..]) = [9223372036854775807,1,-9223372036854775805]
+    ([maxBound::Int,0..]) = [9223372036854775807,0,-9223372036854775807]
+    ([maxBound::Int,-1..]) = [9223372036854775807,-1]
+    (take 7 ([(1::Int) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int) .. 1])) = [1]
+    (take 7 ([(1::Int) .. 0])) = []
+    (take 7 ([(5::Int) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int)) .. maxBound])) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 ([(minBound+(5::Int)) .. minBound])) = []
+    (take 7 [(5::Int),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int),3..1]) = [5,3,1]
+    (take 7 [(5::Int),3..2]) = [5,3]
+    (take 7 [(1::Int),2..1]) = [1]
+    (take 7 [(2::Int),1..2]) = [2]
+    (take 7 [(2::Int),1..1]) = [2,1]
+    (take 7 [(2::Int),3..1]) = []
+    ([minBound, 1..maxBound::Int]) = [-9223372036854775808,1]
+    ([minBound, 0..maxBound::Int]) = [-9223372036854775808,0]
+    ([minBound,-1..maxBound::Int]) = [-9223372036854775808,-1,9223372036854775806]
+    ([minBound,-1..maxBound-1::Int]) = [-9223372036854775808,-1,9223372036854775806]
+    ([minBound,-1..maxBound-2::Int]) = [-9223372036854775808,-1]
+    ([maxBound, 1..minBound::Int]) = [9223372036854775807,1,-9223372036854775805]
+    ([maxBound, 0..minBound::Int]) = [9223372036854775807,0,-9223372036854775807]
+    ([maxBound, 0..minBound+1::Int]) = [9223372036854775807,0,-9223372036854775807]
+    ([maxBound, 0..minBound+2::Int]) = [9223372036854775807,0]
+    ([maxBound,-1..minBound::Int]) = [9223372036854775807,-1]
+    (take 7 [x,(x+1)..maxBound]) = [9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 [x,(x-1)..minBound]) = [-9223372036854775803,-9223372036854775804,-9223372036854775805,-9223372036854775806,-9223372036854775807,-9223372036854775808]
+Testing Enum Integer: 
+    (succ (0::Integer)) = 1
+    (succ ((-1)::Integer)) = 0
+    pred (1::Integer) = 0
+    pred (0::Integer) = -1
+    (map (toEnum::Int->Integer) [1,minBound,maxBound]) = [1,-9223372036854775808,9223372036854775807]
+    (map fromEnum [(1::Integer),42,45]) = [1,42,45]
+    (take 7 [(1::Integer)..]) = [1,2,3,4,5,6,7]
+    (take 7 [(-5::Integer)..]) = [-5,-4,-3,-2,-1,0,1]
+    (take 7 [(1::Integer),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Integer),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Integer),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Integer),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Integer),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 ([(1::Integer) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Integer) .. 1])) = [1]
+    (take 7 ([(1::Integer) .. 0])) = []
+    (take 7 ([(5::Integer) .. 0])) = []
+    (take 7 [(5::Integer),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Integer),3..1]) = [5,3,1]
+    (take 7 [(5::Integer),3..2]) = [5,3]
+    (take 7 [(1::Integer),2..1]) = [1]
+    (take 7 [(2::Integer),1..2]) = [2]
+    (take 7 [(2::Integer),1..1]) = [2,1]
+    (take 7 [(2::Integer),3..1]) = []
+Testing Enum Char: 
+    (succ 'a') = 'b'
+    (succ (minBound::Char)) = '\SOH'
+    (succ (maxBound::Char)) = error "Prelude.Enum.Char.succ: bad argument"
+    (pred 'b') = 'a'
+    pred (maxBound::Char) = '\1114110'
+    pred (minBound::Char) = error "Prelude.Enum.Char.pred: bad argument"
+    (map (toEnum::Int->Char) [123,ord (minBound::Char), ord(maxBound::Char)]) = "{\NUL\1114111"
+    (toEnum::Int->Char) (minBound::Int) = error "Prelude.chr: bad argument: (-9223372036854775808)"
+    (map fromEnum ['X',minBound,maxBound]) = [88,0,1114111]
+    (take 7 ['\NUL' .. ]) = "\NUL\SOH\STX\ETX\EOT\ENQ\ACK"
+    (take 7 ['\250' .. ]) = "\250\251\252\253\254\255\256"
+    (take 7 ['a','b'..]) = "abcdefg"
+    (take 7 ['a','e'..]) = "aeimquy"
+    (take 7 ['a','a'..]) = "aaaaaaa"
+    (take 7 ['z','y'..]) = "zyxwvut"
+    (take 7 ['z','v'..]) = "zvrnjfb"
+    (take 7 ['\1', '\0' ..]) = "\SOH\NUL"
+    (take 7 ['\5', '\4' ..]) = "\ENQ\EOT\ETX\STX\SOH\NUL"
+    (take 7 ['\250', '\251' ..]) = "\250\251\252\253\254\255\256"
+    (take 7 (['a' .. 'e'])) = "abcde"
+    (take 4 (['a' .. 'a'])) = "a"
+    (take 7 (['b' .. 'a'])) = ""
+    (take 7 (['e' .. 'a'])) = ""
+    (take 7 (['\250' .. '\255'])) = "\250\251\252\253\254\255"
+    (take 7 (['\5' .. '\0'])) = ""
+    (take 7 ['f','e' .. 'b']) = "fedcb"
+    (take 7 ['g','e' .. 'b']) = "gec"
+    (take 7 ['g','d' .. 'c']) = "gd"
+    (take 7 ['b','c' .. 'b']) = "b"
+    (take 7 ['c','b' .. 'c']) = "c"
+    (take 7 ['c','b' .. 'b']) = "cb"
+    (take 7 ['c','d' .. 'b']) = ""
+    (take 7 ['\251', '\252' .. maxBound]) = "\251\252\253\254\255\256\257"
+    (take 7 ['\5', '\4' .. minBound]) = "\ENQ\EOT\ETX\STX\SOH\NUL"
+Testing Enum (): 
+    (succ ()) = error "Prelude.