Testsuite: delete Windows line endings [skip ci] (#11631)

6 files changed, 405 insertions, 405 deletions

diff --git a/libraries/base/tests/Concurrent/Chan001.hs b/libraries/base/tests/Concurrent/Chan001.hs
index e4b668ac48..ad3b8ff8d6 100644
--- a/libraries/base/tests/Concurrent/Chan001.hs
+++ b/libraries/base/tests/Concurrent/Chan001.hs
@@ -1,109 +1,109 @@
-import Debug.QuickCheck

-import System.IO.Unsafe

-import Control.Concurrent.Chan

-import Control.Concurrent

-import Control.Monad

-

-data Action = NewChan | ReadChan | WriteChan Int | IsEmptyChan | ReturnInt Int

-	    | ReturnBool Bool

-  deriving (Eq,Show)

-

-

-main = do 

-  t <- myThreadId

-  forkIO (threadDelay 1000000 >> killThread t)

-	-- just in case we deadlock

-  testChan

-

-testChan :: IO ()

-testChan = do

-  quickCheck prop_NewIs_NewRet

-  quickCheck prop_NewWriteIs_NewRet

-  quickCheck prop_NewWriteRead_NewRet

-

-

-prop_NewIs_NewRet = 

-  [NewChan,IsEmptyChan] =^ [NewChan,ReturnBool True]

-

-prop_NewWriteIs_NewRet n = 

-  [NewChan,WriteChan n,IsEmptyChan] =^ [NewChan,WriteChan n,ReturnBool False]

-

-prop_NewWriteRead_NewRet n = 

-  [NewChan,WriteChan n,ReadChan] =^ [NewChan,ReturnInt n]

-

-

-perform :: [Action] -> IO ([Bool],[Int])

-perform [] = return ([],[])

-

-perform (a:as) =

-  case a of

-    ReturnInt v	 -> liftM (\(b,l) -> (b,v:l)) (perform as)

-    ReturnBool v -> liftM (\(b,l) -> (v:b,l)) (perform as)

-    NewChan      -> newChan >>= \chan -> perform' chan as    

-    _		 -> error $ "Please use NewChan as first action"

-

-

-perform' :: Chan Int -> [Action] -> IO ([Bool],[Int])

-perform' _ [] = return ([],[])

-

-perform' chan (a:as) =

-  case a of

-    ReturnInt v	 -> liftM (\(b,l) -> (b,v:l)) (perform' chan as)

-    ReturnBool v -> liftM (\(b,l) -> (v:b,l)) (perform' chan as)

-    ReadChan     -> liftM2 (\v (b,l) -> (b,v:l)) (readChan chan) 

-			        (perform' chan as)

-    WriteChan n  -> writeChan chan n >> perform' chan as

-    IsEmptyChan  -> liftM2 (\v (b,l) -> (v:b,l)) (isEmptyChan chan)

-				(perform' chan as)

-    _		     -> error $ "If you want to use " ++ show a 

-				++ " please use the =^ operator"

-

-

-actions :: Gen [Action]

-actions =

-  liftM (NewChan:) (actions' 0)

-

-

-actions' :: Int -> Gen [Action]

-actions' contents =

-  oneof ([return [],

-	  liftM (IsEmptyChan:) (actions' contents),

-	  liftM2 (:) (liftM WriteChan arbitrary) (actions' (contents+1))]

-	  ++

-	  if contents==0

-	     then []

-	     else [liftM (ReadChan:) (actions' (contents-1))])

-

-

-(=^) :: [Action] -> [Action] -> Property

-c =^ c' =

-  forAll (actions' (delta 0 c))

-	 (\suff -> observe c suff == observe c' suff)

-  where observe x suff = unsafePerformIO (perform (x++suff))

-

-

-(^=^) :: [Action] -> [Action] -> Property

-c ^=^ c' =

-  forAll actions

-	 (\pref -> forAll (actions' (delta 0 (pref++c)))

-			  (\suff -> observe c pref suff == 

-				      observe c' pref suff))

-  where observe x pref suff = unsafePerformIO (perform (pref++x++suff))

-

-

-delta :: Int -> [Action] -> Int

-delta i [] = i

-

-delta i (ReturnInt _:as) = delta i as

-

-delta i (ReturnBool _:as) = delta i as

-

-delta _ (NewChan:as) = delta 0 as

-

-delta i (WriteChan _:as) = delta (i+1) as

-

-delta i (ReadChan:as) = delta (if i==0

-				  then error "read on empty Chan"

-				  else i-1) as

-

-delta i (IsEmptyChan:as) = delta i as

+import Debug.QuickCheck
+import System.IO.Unsafe
+import Control.Concurrent.Chan
+import Control.Concurrent
+import Control.Monad
+
+data Action = NewChan | ReadChan | WriteChan Int | IsEmptyChan | ReturnInt Int
+            | ReturnBool Bool
+  deriving (Eq,Show)
+
+
+main = do
+  t <- myThreadId
+  forkIO (threadDelay 1000000 >> killThread t)
+        -- just in case we deadlock
+  testChan
+
+testChan :: IO ()
+testChan = do
+  quickCheck prop_NewIs_NewRet
+  quickCheck prop_NewWriteIs_NewRet
+  quickCheck prop_NewWriteRead_NewRet
+
+
+prop_NewIs_NewRet =
+  [NewChan,IsEmptyChan] =^ [NewChan,ReturnBool True]
+
+prop_NewWriteIs_NewRet n =
+  [NewChan,WriteChan n,IsEmptyChan] =^ [NewChan,WriteChan n,ReturnBool False]
+
+prop_NewWriteRead_NewRet n =
+  [NewChan,WriteChan n,ReadChan] =^ [NewChan,ReturnInt n]
+
+
+perform :: [Action] -> IO ([Bool],[Int])
+perform [] = return ([],[])
+
+perform (a:as) =
+  case a of
+    ReturnInt v  -> liftM (\(b,l) -> (b,v:l)) (perform as)
+    ReturnBool v -> liftM (\(b,l) -> (v:b,l)) (perform as)
+    NewChan      -> newChan >>= \chan -> perform' chan as
+    _            -> error $ "Please use NewChan as first action"
+
+
+perform' :: Chan Int -> [Action] -> IO ([Bool],[Int])
+perform' _ [] = return ([],[])
+
+perform' chan (a:as) =
+  case a of
+    ReturnInt v  -> liftM (\(b,l) -> (b,v:l)) (perform' chan as)
+    ReturnBool v -> liftM (\(b,l) -> (v:b,l)) (perform' chan as)
+    ReadChan     -> liftM2 (\v (b,l) -> (b,v:l)) (readChan chan)
+                                (perform' chan as)
+    WriteChan n  -> writeChan chan n >> perform' chan as
+    IsEmptyChan  -> liftM2 (\v (b,l) -> (v:b,l)) (isEmptyChan chan)
+                                (perform' chan as)
+    _                -> error $ "If you want to use " ++ show a
+                                ++ " please use the =^ operator"
+
+
+actions :: Gen [Action]
+actions =
+  liftM (NewChan:) (actions' 0)
+
+
+actions' :: Int -> Gen [Action]
+actions' contents =
+  oneof ([return [],
+          liftM (IsEmptyChan:) (actions' contents),
+          liftM2 (:) (liftM WriteChan arbitrary) (actions' (contents+1))]
+          ++
+          if contents==0
+             then []
+             else [liftM (ReadChan:) (actions' (contents-1))])
+
+
+(=^) :: [Action] -> [Action] -> Property
+c =^ c' =
+  forAll (actions' (delta 0 c))
+         (\suff -> observe c suff == observe c' suff)
+  where observe x suff = unsafePerformIO (perform (x++suff))
+
+
+(^=^) :: [Action] -> [Action] -> Property
+c ^=^ c' =
+  forAll actions
+         (\pref -> forAll (actions' (delta 0 (pref++c)))
+                          (\suff -> observe c pref suff ==
+                                      observe c' pref suff))
+  where observe x pref suff = unsafePerformIO (perform (pref++x++suff))
+
+
+delta :: Int -> [Action] -> Int
+delta i [] = i
+
+delta i (ReturnInt _:as) = delta i as
+
+delta i (ReturnBool _:as) = delta i as
+
+delta _ (NewChan:as) = delta 0 as
+
+delta i (WriteChan _:as) = delta (i+1) as
+
+delta i (ReadChan:as) = delta (if i==0
+                                  then error "read on empty Chan"
+                                  else i-1) as
+
+delta i (IsEmptyChan:as) = delta i as
diff --git a/libraries/base/tests/Concurrent/MVar001.hs b/libraries/base/tests/Concurrent/MVar001.hs
index f787470c51..5c0c160b18 100644
--- a/libraries/base/tests/Concurrent/MVar001.hs
+++ b/libraries/base/tests/Concurrent/MVar001.hs
@@ -1,148 +1,148 @@
-import Debug.QuickCheck

-import System.IO.Unsafe

-import Control.Concurrent.MVar

-import Control.Concurrent

-import Control.Monad

-

-

-data Action = NewEmptyMVar | NewMVar Int | TakeMVar | ReadMVar | PutMVar Int

-	    | SwapMVar Int | IsEmptyMVar | ReturnInt Int | ReturnBool Bool

-  deriving (Eq,Show)

-

-main = do 

-  t <- myThreadId

-  forkIO (threadDelay 1000000 >> killThread t)

-	-- just in case we deadlock

-  testMVar

-

-testMVar :: IO ()

-testMVar = do

-  quickCheck prop_NewEIs_NewERet

-  quickCheck prop_NewIs_NewRet

-  quickCheck prop_NewTake_NewRet

-  quickCheck prop_NewEPutTake_NewERet

-  quickCheck prop_NewRead_NewRet

-  quickCheck prop_NewSwap_New

-

-

-prop_NewEIs_NewERet = 

-  [NewEmptyMVar,IsEmptyMVar] =^ [NewEmptyMVar,ReturnBool True]

-

-prop_NewIs_NewRet n = 

-  [NewMVar n,IsEmptyMVar] =^ [NewMVar n,ReturnBool False]

-

-prop_NewTake_NewRet n =

-  [NewMVar n,TakeMVar] =^ [NewEmptyMVar,ReturnInt n]

-

-prop_NewEPutTake_NewERet n = 

-  [NewEmptyMVar,PutMVar n,TakeMVar] =^ 

-    [NewEmptyMVar,ReturnInt n]

-

-prop_NewRead_NewRet n = 

-  [NewMVar n,ReadMVar] =^ [NewMVar n,ReturnInt n]

-

-prop_NewSwap_New m n =

-  [NewMVar m,SwapMVar n] =^ [NewMVar n]

-

-

-perform :: [Action] -> IO ([Bool],[Int])

-perform [] = return ([],[])

-

-perform (a:as) =

-  case a of

-    ReturnInt v	 -> liftM (\(b,l) -> (b,v:l)) (perform as)

-    ReturnBool v -> liftM (\(b,l) -> (v:b,l)) (perform as)

-    NewEmptyMVar -> newEmptyMVar >>= \mv -> perform' mv as

-    NewMVar n    -> newMVar n >>= \mv -> perform' mv as    

-    _		 -> error $ "Please use NewMVar or NewEmptyMVar as first "

-			    ++ "action"

-

-

-perform' :: MVar Int -> [Action] -> IO ([Bool],[Int])

-perform' _ [] = return ([],[])

-

-perform' mv (a:as) =

-  case a of

-    ReturnInt v	 -> liftM (\(b,l) -> (b,v:l)) (perform' mv as)

-    ReturnBool v -> liftM (\(b,l) -> (v:b,l)) (perform' mv as)

-    TakeMVar     -> liftM2 (\v (b,l) -> (b,v:l)) (takeMVar mv) 

-			        (perform' mv as)

-    ReadMVar     -> liftM2 (\v (b,l) -> (b,v:l)) (readMVar mv) 

-			        (perform' mv as)

-    PutMVar n    -> putMVar mv n >> perform' mv as

-    SwapMVar n	 -> swapMVar mv n >> perform' mv as

-    IsEmptyMVar  -> liftM2 (\v (b,l) -> (v:b,l)) (isEmptyMVar mv)

-				(perform' mv as)

-    _		 -> error $ "If you want to use " ++ show a 

-			    ++ " please use the =^ operator"

-

-

-actions :: Gen [Action]

-actions = do

-  oneof [liftM (NewEmptyMVar:) (actions' True),

-	 liftM2 (:) (liftM NewMVar arbitrary) (actions' False)] 

-

-

-actions' :: Bool -> Gen [Action]

-actions' empty =

-  oneof ([return [],

-	  liftM (IsEmptyMVar:) (actions' empty)] ++

-	  if empty

-	     then [liftM2 (:) (liftM PutMVar arbitrary) (actions' False)]

-	     else []

-	  ++

-	  if empty

-	     then []

-	     else [liftM (TakeMVar:) (actions' True)]

-	  ++

-	  if empty

-	     then []

-	     else [liftM (ReadMVar:) (actions' False)]

-	  ++

-	  if empty

-	     then []

-	     else [liftM2 (:) (liftM SwapMVar arbitrary) (actions' False)]   )

-

-

-(=^) :: [Action] -> [Action] -> Property

-c =^ c' =

-  forAll (actions' (delta True c))

-	 (\suff -> observe c suff == observe c' suff)

-  where observe x suff = unsafePerformIO (perform (x++suff))

-

-

-(^=^) :: [Action] -> [Action] -> Property

-c ^=^ c' =

-  forAll actions

-	 (\pref -> forAll (actions' (delta True (pref++c)))

-			  (\suff -> observe c pref suff == 

-				      observe c' pref suff))

-  where observe x pref suff = unsafePerformIO (perform (pref++x++suff))

-

-

-delta :: Bool -> [Action] -> Bool

-delta b [] = b

-

-delta b (ReturnInt _:as) = delta b as

-

-delta b (ReturnBool _:as) = delta b as

-

-delta _ (NewEmptyMVar:as) = delta True as

-

-delta _ (NewMVar _:as) = delta False as

-

-delta b (TakeMVar:as) = delta (if b

-				  then error "take on empty MVar"

-				  else True) as

-

-delta b (ReadMVar:as) = delta (if b

-				  then error "read on empty MVar"

-				  else False) as

-

-delta _ (PutMVar _:as) = delta False as

-

-delta b (SwapMVar _:as) = delta (if b

-				  then error "swap on empty MVar"

-				  else False) as

-

-delta b (IsEmptyMVar:as) = delta b as

+import Debug.QuickCheck
+import System.IO.Unsafe
+import Control.Concurrent.MVar
+import Control.Concurrent
+import Control.Monad
+
+
+data Action = NewEmptyMVar | NewMVar Int | TakeMVar | ReadMVar | PutMVar Int
+            | SwapMVar Int | IsEmptyMVar | ReturnInt Int | ReturnBool Bool
+  deriving (Eq,Show)
+
+main = do
+  t <- myThreadId
+  forkIO (threadDelay 1000000 >> killThread t)
+        -- just in case we deadlock
+  testMVar
+
+testMVar :: IO ()
+testMVar = do
+  quickCheck prop_NewEIs_NewERet
+  quickCheck prop_NewIs_NewRet
+  quickCheck prop_NewTake_NewRet
+  quickCheck prop_NewEPutTake_NewERet
+  quickCheck prop_NewRead_NewRet
+  quickCheck prop_NewSwap_New
+
+
+prop_NewEIs_NewERet =
+  [NewEmptyMVar,IsEmptyMVar] =^ [NewEmptyMVar,ReturnBool True]
+
+prop_NewIs_NewRet n =
+  [NewMVar n,IsEmptyMVar] =^ [NewMVar n,ReturnBool False]
+
+prop_NewTake_NewRet n =
+  [NewMVar n,TakeMVar] =^ [NewEmptyMVar,ReturnInt n]
+
+prop_NewEPutTake_NewERet n =
+  [NewEmptyMVar,PutMVar n,TakeMVar] =^
+    [NewEmptyMVar,ReturnInt n]
+
+prop_NewRead_NewRet n =
+  [NewMVar n,ReadMVar] =^ [NewMVar n,ReturnInt n]
+
+prop_NewSwap_New m n =
+  [NewMVar m,SwapMVar n] =^ [NewMVar n]
+
+
+perform :: [Action] -> IO ([Bool],[Int])
+perform [] = return ([],[])
+
+perform (a:as) =
+  case a of
+    ReturnInt v  -> liftM (\(b,l) -> (b,v:l)) (perform as)
+    ReturnBool v -> liftM (\(b,l) -> (v:b,l)) (perform as)
+    NewEmptyMVar -> newEmptyMVar >>= \mv -> perform' mv as
+    NewMVar n    -> newMVar n >>= \mv -> perform' mv as
+    _            -> error $ "Please use NewMVar or NewEmptyMVar as first "
+                            ++ "action"
+
+
+perform' :: MVar Int -> [Action] -> IO ([Bool],[Int])
+perform' _ [] = return ([],[])
+
+perform' mv (a:as) =
+  case a of
+    ReturnInt v  -> liftM (\(b,l) -> (b,v:l)) (perform' mv as)
+    ReturnBool v -> liftM (\(b,l) -> (v:b,l)) (perform' mv as)
+    TakeMVar     -> liftM2 (\v (b,l) -> (b,v:l)) (takeMVar mv)
+                                (perform' mv as)
+    ReadMVar     -> liftM2 (\v (b,l) -> (b,v:l)) (readMVar mv)
+                                (perform' mv as)
+    PutMVar n    -> putMVar mv n >> perform' mv as
+    SwapMVar n   -> swapMVar mv n >> perform' mv as
+    IsEmptyMVar  -> liftM2 (\v (b,l) -> (v:b,l)) (isEmptyMVar mv)
+                                (perform' mv as)
+    _            -> error $ "If you want to use " ++ show a
+                            ++ " please use the =^ operator"
+
+
+actions :: Gen [Action]
+actions = do
+  oneof [liftM (NewEmptyMVar:) (actions' True),
+         liftM2 (:) (liftM NewMVar arbitrary) (actions' False)]
+
+
+actions' :: Bool -> Gen [Action]
+actions' empty =
+  oneof ([return [],
+          liftM (IsEmptyMVar:) (actions' empty)] ++
+          if empty
+             then [liftM2 (:) (liftM PutMVar arbitrary) (actions' False)]
+             else []
+          ++
+          if empty
+             then []
+             else [liftM (TakeMVar:) (actions' True)]
+          ++
+          if empty
+             then []
+             else [liftM (ReadMVar:) (actions' False)]
+          ++
+          if empty
+             then []
+             else [liftM2 (:) (liftM SwapMVar arbitrary) (actions' False)]   )
+
+
+(=^) :: [Action] -> [Action] -> Property
+c =^ c' =
+  forAll (actions' (delta True c))
+         (\suff -> observe c suff == observe c' suff)
+  where observe x suff = unsafePerformIO (perform (x++suff))
+
+
+(^=^) :: [Action] -> [Action] -> Property
+c ^=^ c' =
+  forAll actions
+         (\pref -> forAll (actions' (delta True (pref++c)))
+                          (\suff -> observe c pref suff ==
+                                      observe c' pref suff))
+  where observe x pref suff = unsafePerformIO (perform (pref++x++suff))
+
+
+delta :: Bool -> [Action] -> Bool
+delta b [] = b
+
+delta b (ReturnInt _:as) = delta b as
+
+delta b (ReturnBool _:as) = delta b as
+
+delta _ (NewEmptyMVar:as) = delta True as
+
+delta _ (NewMVar _:as) = delta False as
+
+delta b (TakeMVar:as) = delta (if b
+                                  then error "take on empty MVar"
+                                  else True) as
+
+delta b (ReadMVar:as) = delta (if b
+                                  then error "read on empty MVar"
+                                  else False) as
+
+delta _ (PutMVar _:as) = delta False as
+
+delta b (SwapMVar _:as) = delta (if b
+                                  then error "swap on empty MVar"
+                                  else False) as
+
+delta b (IsEmptyMVar:as) = delta b as
diff --git a/libraries/base/tests/IO/T7853.hs b/libraries/base/tests/IO/T7853.hs
index 382942efff..e46795ec9d 100644
--- a/libraries/base/tests/IO/T7853.hs
+++ b/libraries/base/tests/IO/T7853.hs
@@ -1,28 +1,28 @@
-import qualified Data.ByteString as BS

-import System.IO

-import GHC.Foreign

-import Control.Exception

-import Data.Word

-

-decode :: TextEncoding -> BS.ByteString -> IO (Either SomeException String)

-decode enc bs = try $ BS.useAsCStringLen bs $ peekCStringLen enc

-

-main :: IO ()

-main = mapM_ go [ ["01111111"] -- (just fits into 1 byte)

-                , ["11000010", "10000000"] -- (just large enough for 2 bytes)

-                , ["11000001", "10111111"] -- (overlong: only 7 bits, so should fit into 1 byte)

-                , ["11011111", "10111111"] -- (just fits into 2 bytes)

-                , ["11100000", "10100000", "10000000"] -- (just large enough for 3 bytes)

-                , ["11100000", "10011111", "10111111"] -- (overlong: only 11 bits, so should fit into 2 bytes)

-                , ["11101111", "10111111", "10111111"] -- (just fits into 3 bytes)

-                , ["11110000", "10010000", "10000000", "10000000"] -- (just large enough for 4 bytes)

-                , ["11110000", "10001111", "10111111", "10111111"] -- (overlong: only 16 bits, so should fit into 3 bytes)

-                , ["11110100", "10001111", "10111111", "10111111"] -- (largest allowed codepoint)

-                , ["11110111", "10111111", "10111111", "10111111"] -- (just fits into 4 bytes but disallowed by RFC3629)

-                ]

-  where go xs = decode utf8 (BS.pack (map toByte xs)) >>= either (\_ -> putStrLn "Error") print

-

-toByte :: String -> Word8

-toByte [] = 0

-toByte ('1':xs) = (2 ^ length xs) + toByte xs

-toByte ('0':xs) = toByte xs

+import qualified Data.ByteString as BS
+import System.IO
+import GHC.Foreign
+import Control.Exception
+import Data.Word
+
+decode :: TextEncoding -> BS.ByteString -> IO (Either SomeException String)
+decode enc bs = try $ BS.useAsCStringLen bs $ peekCStringLen enc
+
+main :: IO ()
+main = mapM_ go [ ["01111111"] -- (just fits into 1 byte)
+                , ["11000010", "10000000"] -- (just large enough for 2 bytes)
+                , ["11000001", "10111111"] -- (overlong: only 7 bits, so should fit into 1 byte)
+                , ["11011111", "10111111"] -- (just fits into 2 bytes)
+                , ["11100000", "10100000", "10000000"] -- (just large enough for 3 bytes)
+                , ["11100000", "10011111", "10111111"] -- (overlong: only 11 bits, so should fit into 2 bytes)
+                , ["11101111", "10111111", "10111111"] -- (just fits into 3 bytes)
+                , ["11110000", "10010000", "10000000", "10000000"] -- (just large enough for 4 bytes)
+                , ["11110000", "10001111", "10111111", "10111111"] -- (overlong: only 16 bits, so should fit into 3 bytes)
+                , ["11110100", "10001111", "10111111", "10111111"] -- (largest allowed codepoint)
+                , ["11110111", "10111111", "10111111", "10111111"] -- (just fits into 4 bytes but disallowed by RFC3629)
+                ]
+  where go xs = decode utf8 (BS.pack (map toByte xs)) >>= either (\_ -> putStrLn "Error") print
+
+toByte :: String -> Word8
+toByte [] = 0
+toByte ('1':xs) = (2 ^ length xs) + toByte xs
+toByte ('0':xs) = toByte xs
diff --git a/libraries/base/tests/IO/encoding004.hs b/libraries/base/tests/IO/encoding004.hs
index 1819df6d37..62ef5d6a93 100644
--- a/libraries/base/tests/IO/encoding004.hs
+++ b/libraries/base/tests/IO/encoding004.hs
@@ -1,107 +1,107 @@
-import System.IO

-import System.Directory

-import Data.Char

-import System.Process

-import Control.Monad

-import qualified Data.ByteString as BS

-import System.Environment

-import System.Exit

-import System.FilePath

-import Data.Maybe

-import qualified Data.Map as M

-import GHC.Foreign

-import Control.Exception

-

-

-decode :: TextEncoding -> BS.ByteString -> IO (Either SomeException String)

-decode enc bs = try $ BS.useAsCStringLen bs $ peekCStringLen enc

-

-encode :: TextEncoding -> String -> IO (Either SomeException BS.ByteString)

-encode enc cs = try $ withCStringLen enc cs $ BS.packCStringLen

-

-decodeEncode :: TextEncoding -> BS.ByteString -> IO (Either SomeException BS.ByteString)

-decodeEncode enc bs = decode enc bs `bind` encode enc

-

-encodedecode :: TextEncoding -> String -> IO (Either SomeException String)

-encodedecode enc bs = encode enc bs `bind` decode enc

-

-bind mx fxmy = do

-    ei_e_cs <- mx

-    case ei_e_cs of

-        Left e   -> return (Left e)

-        Right cs -> fxmy cs

-

-

-main :: IO ()

-main = forM_ [ ("CP936",  2, "CP936",      Just "CP936-UTF8")  -- Representative (roundtrippable) DBCS

-             , ("CP1251", 1, "CP1251",     Just "CP1251-UTF8") -- Representative SBCS

-             , ("UTF-8",  4, "CP936-UTF8", Nothing)            -- Sanity check

-             ] $ \(enc_name, max_byte_length, file, mb_utf8_file) -> do

-    putStrLn $ "== " ++ enc_name

-

-    let fp = "encoded-data" </> file <.> "txt"

-    enc <- mkTextEncoding enc_name

-    bs <- BS.readFile fp

-    

-    -- In a DBCS you should never fail to encode truncated input for two consecutive truncation points,

-    -- assuming that the input file is actually error free:

-    testTruncations enc max_byte_length bs

-

-    -- Should be able to roundtrip arbitrary rubbish, as long as we use the right encoding

-    roundtrip_enc <- mkTextEncoding (enc_name ++ "//ROUNDTRIP")

-    testRoundtripping roundtrip_enc bs

-

-    -- Just check that we actually decode to the right thing, for good measure

-    case mb_utf8_file of

-      Nothing -> return ()

-      Just utf8_file -> do

-        utf8_bs <- BS.readFile ("encoded-data" </> utf8_file <.> "txt")

-        Right expected <- decode utf8 utf8_bs

-        Right actual   <- decode enc  bs

-        unless (expected == actual) $ do

-            putStrLn (bsDiff 0 actual expected)

-

-forTruncations :: BS.ByteString -> (BS.ByteString -> IO a) -> IO [a]

-forTruncations bs f = forSplits bs $ \before _ -> f before

-

-forSplits :: BS.ByteString -> (BS.ByteString -> BS.ByteString -> IO a) -> IO [a]

-forSplits bs f = forM [(800 * block) + ix | block <- [0..len `div` 800], ix <- [0..100]] $ \i -> uncurry f (BS.splitAt i bs)

-    where len = BS.length bs

-

-testTruncations :: TextEncoding -> Int -> BS.ByteString -> IO ()

-testTruncations enc max_byte_length bs = do

-    failures <- fmap catMaybes $ forTruncations bs $ testTruncation enc

-

-    let failure_map = M.fromList failures

-    forM_ failures $ \(i, e) -> do

-        let js = [i+1..i+(max_byte_length - 1)]

-        case sequence (map (`M.lookup` failure_map) js) of

-            Nothing -> return ()

-            Just es -> putStrLn ("Failed on consecutive truncated byte indexes " ++ show (i:js) ++ " (" ++ show (e:es) ++ ")")

-

-testTruncation :: TextEncoding -> BS.ByteString -> IO (Maybe (Int, SomeException))

-testTruncation enc expected = do

-        --putStr (show i ++ ": ") >> hFlush stdout

-        ei_e_actual <- decodeEncode enc expected

-        case ei_e_actual of

-            Left  e      -> return (Just (BS.length expected, e))

-            Right actual | expected /= actual -> error $ "Mismatch on success when truncating at byte index " ++ show (BS.length expected)

-                         | otherwise          -> return Nothing

-

-testRoundtripping :: TextEncoding -> BS.ByteString -> IO ()

-testRoundtripping roundtrip_enc bs = void $ forSplits bs $ \before after -> do

-    let expected = before `BS.append` (fromIntegral (BS.length before `mod` 256) `BS.cons` after)

-    Right actual <- decodeEncode roundtrip_enc expected

-    when (actual /= expected) $ do

-        let i_str = show (BS.length before)

-        putStrLn $ "Failed to roundtrip given mutant byte at index " ++ i_str ++ " (" ++ bsDiff 0 (BS.unpack actual) (BS.unpack expected) ++ ")"

-        -- Possibly useful for debugging porpoises:

-        --BS.writeFile (i_str ++ ".expected") expected

-        --BS.writeFile (i_str ++ ".actual")   actual

-

-bsDiff :: (Show a, Eq a) => Int -> [a] -> [a] -> String

-bsDiff _ [] [] = error "bsDiff"

-bsDiff _ [] bs = "actual " ++ show (length bs) ++ " elements shorter than expected"

-bsDiff _ as [] = "expected " ++ show (length as) ++ " elements shorter than actual"

-bsDiff i (a:as) (b:bs) | a == b    = bsDiff (i + 1) as bs

-                       | otherwise = show a ++ " /= " ++ show b ++ " at index " ++ show i

+import System.IO
+import System.Directory
+import Data.Char
+import System.Process
+import Control.Monad
+import qualified Data.ByteString as BS
+import System.Environment
+import System.Exit
+import System.FilePath
+import Data.Maybe
+import qualified Data.Map as M
+import GHC.Foreign
+import Control.Exception
+
+
+decode :: TextEncoding -> BS.ByteString -> IO (Either SomeException String)
+decode enc bs = try $ BS.useAsCStringLen bs $ peekCStringLen enc
+
+encode :: TextEncoding -> String -> IO (Either SomeException BS.ByteString)
+encode enc cs = try $ withCStringLen enc cs $ BS.packCStringLen
+
+decodeEncode :: TextEncoding -> BS.ByteString -> IO (Either SomeException BS.ByteString)
+decodeEncode enc bs = decode enc bs `bind` encode enc
+
+encodedecode :: TextEncoding -> String -> IO (Either SomeException String)
+encodedecode enc bs = encode enc bs `bind` decode enc
+
+bind mx fxmy = do
+    ei_e_cs <- mx
+    case ei_e_cs of
+        Left e   -> return (Left e)
+        Right cs -> fxmy cs
+
+
+main :: IO ()
+main = forM_ [ ("CP936",  2, "CP936",      Just "CP936-UTF8")  -- Representative (roundtrippable) DBCS
+             , ("CP1251", 1, "CP1251",     Just "CP1251-UTF8") -- Representative SBCS
+             , ("UTF-8",  4, "CP936-UTF8", Nothing)            -- Sanity check
+             ] $ \(enc_name, max_byte_length, file, mb_utf8_file) -> do
+    putStrLn $ "== " ++ enc_name
+
+    let fp = "encoded-data" </> file <.> "txt"
+    enc <- mkTextEncoding enc_name
+    bs <- BS.readFile fp
+
+    -- In a DBCS you should never fail to encode truncated input for two consecutive truncation points,
+    -- assuming that the input file is actually error free:
+    testTruncations enc max_byte_length bs
+
+    -- Should be able to roundtrip arbitrary rubbish, as long as we use the right encoding
+    roundtrip_enc <- mkTextEncoding (enc_name ++ "//ROUNDTRIP")
+    testRoundtripping roundtrip_enc bs
+
+    -- Just check that we actually decode to the right thing, for good measure
+    case mb_utf8_file of
+      Nothing -> return ()
+      Just utf8_file -> do
+        utf8_bs <- BS.readFile ("encoded-data" </> utf8_file <.> "txt")
+        Right expected <- decode utf8 utf8_bs
+        Right actual   <- decode enc  bs
+        unless (expected == actual) $ do
+            putStrLn (bsDiff 0 actual expected)
+
+forTruncations :: BS.ByteString -> (BS.ByteString -> IO a) -> IO [a]
+forTruncations bs f = forSplits bs $ \before _ -> f before
+
+forSplits :: BS.ByteString -> (BS.ByteString -> BS.ByteString -> IO a) -> IO [a]
+forSplits bs f = forM [(800 * block) + ix | block <- [0..len `div` 800], ix <- [0..100]] $ \i -> uncurry f (BS.splitAt i bs)
+    where len = BS.length bs
+
+testTruncations :: TextEncoding -> Int -> BS.ByteString -> IO ()
+testTruncations enc max_byte_length bs = do
+    failures <- fmap catMaybes $ forTruncations bs $ testTruncation enc
+
+    let failure_map = M.fromList failures
+    forM_ failures $ \(i, e) -> do
+        let js = [i+1..i+(max_byte_length - 1)]
+        case sequence (map (`M.lookup` failure_map) js) of
+            Nothing -> return ()
+            Just es -> putStrLn ("Failed on consecutive truncated byte indexes " ++ show (i:js) ++ " (" ++ show (e:es) ++ ")")
+
+testTruncation :: TextEncoding -> BS.ByteString -> IO (Maybe (Int, SomeException))
+testTruncation enc expected = do
+        --putStr (show i ++ ": ") >> hFlush stdout
+        ei_e_actual <- decodeEncode enc expected
+        case ei_e_actual of
+            Left  e      -> return (Just (BS.length expected, e))
+            Right actual | expected /= actual -> error $ "Mismatch on success when truncating at byte index " ++ show (BS.length expected)
+                         | otherwise          -> return Nothing
+
+testRoundtripping :: TextEncoding -> BS.ByteString -> IO ()
+testRoundtripping roundtrip_enc bs = void $ forSplits bs $ \before after -> do
+    let expected = before `BS.append` (fromIntegral (BS.length before `mod` 256) `BS.cons` after)
+    Right actual <- decodeEncode roundtrip_enc expected
+    when (actual /= expected) $ do
+        let i_str = show (BS.length before)
+        putStrLn $ "Failed to roundtrip given mutant byte at index " ++ i_str ++ " (" ++ bsDiff 0 (BS.unpack actual) (BS.unpack expected) ++ ")"
+        -- Possibly useful for debugging porpoises:
+        --BS.writeFile (i_str ++ ".expected") expected
+        --BS.writeFile (i_str ++ ".actual")   actual
+
+bsDiff :: (Show a, Eq a) => Int -> [a] -> [a] -> String
+bsDiff _ [] [] = error "bsDiff"
+bsDiff _ [] bs = "actual " ++ show (length bs) ++ " elements shorter than expected"
+bsDiff _ as [] = "expected " ++ show (length as) ++ " elements shorter than actual"
+bsDiff i (a:as) (b:bs) | a == b    = bsDiff (i + 1) as bs
+                       | otherwise = show a ++ " /= " ++ show b ++ " at index " ++ show i
diff --git a/libraries/base/tests/IO/hGetLine001.hs b/libraries/base/tests/IO/hGetLine001.hs
index b5950623ea..358e92aa9c 100644
--- a/libraries/base/tests/IO/hGetLine001.hs
+++ b/libraries/base/tests/IO/hGetLine001.hs
@@ -5,9 +5,9 @@ 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 
+                  if b then return ()
+                       else do l <- hGetLine h; putStrLn l; loop h
+  loop stdin
 
   h <- openFile "hGetLine001.hs" ReadMode
 
diff --git a/libraries/base/tests/IO/hReady002.hs b/libraries/base/tests/IO/hReady002.hs
index 6db22a13fc..b8b648065b 100644
--- a/libraries/base/tests/IO/hReady002.hs
+++ b/libraries/base/tests/IO/hReady002.hs
@@ -1,10 +1,10 @@
--- test for bug #4078

-import System.IO

-import Control.Concurrent

-import System.Exit

-

-main = do

-  m <- newEmptyMVar

-  forkIO $ do threadDelay 500000; putMVar m Nothing

-  forkIO $ do hReady stdin >>= putMVar m . Just

-  takeMVar m >>= print

+-- test for bug #4078
+import System.IO
+import Control.Concurrent
+import System.Exit
+
+main = do
+  m <- newEmptyMVar
+  forkIO $ do threadDelay 500000; putMVar m Nothing
+  forkIO $ do hReady stdin >>= putMVar m . Just
+  takeMVar m >>= print