diff options
author | Thomas Miedema <thomasmiedema@gmail.com> | 2016-02-22 21:32:51 +0100 |
---|---|---|
committer | Thomas Miedema <thomasmiedema@gmail.com> | 2016-02-23 12:27:58 +0100 |
commit | d5e8b3940e8f190e9ad94e044014162bcb808c3a (patch) | |
tree | 08b50be66f2ac62e9f7ab52a558c8b7e9f196849 | |
parent | 6074c108b66ec9cd2230852addb60782a8b17e0a (diff) | |
download | haskell-d5e8b3940e8f190e9ad94e044014162bcb808c3a.tar.gz |
Testsuite: delete Windows line endings [skip ci] (#11631)
33 files changed, 674 insertions, 674 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 diff --git a/testsuite/tests/arityanal/f0.hs b/testsuite/tests/arityanal/f0.hs index f2b7794b99..2499aa6f2c 100644 --- a/testsuite/tests/arityanal/f0.hs +++ b/testsuite/tests/arityanal/f0.hs @@ -1,6 +1,6 @@ -module F0 where
-
-f0 :: Int -> Int -> Int -> Int
-f0 x y = if (x>0) then let v = x + y
- in \z -> v+z
- else \z-> 1
\ No newline at end of file +module F0 where + +f0 :: Int -> Int -> Int -> Int +f0 x y = if (x>0) then let v = x + y + in \z -> v+z + else \z-> 1 diff --git a/testsuite/tests/arityanal/f1.hs b/testsuite/tests/arityanal/f1.hs index 5de291945e..71ccfe4d16 100644 --- a/testsuite/tests/arityanal/f1.hs +++ b/testsuite/tests/arityanal/f1.hs @@ -1,10 +1,10 @@ -module F1 where
-
-f1 = let h1 n x = if x<n then let v = h1 n (x+1)
- in \y -> v (x+y)
- else \y -> y
- in h1 5 1 5
-
-g = \x1-> \x2-> \x3-> \x4-> \x5-> x1+x2+x3+x4+x5
-s f = f 3
-h = s g 6 7 8
\ No newline at end of file +module F1 where + +f1 = let h1 n x = if x<n then let v = h1 n (x+1) + in \y -> v (x+y) + else \y -> y + in h1 5 1 5 + +g = \x1-> \x2-> \x3-> \x4-> \x5-> x1+x2+x3+x4+x5 +s f = f 3 +h = s g 6 7 8 diff --git a/testsuite/tests/arityanal/f10.hs b/testsuite/tests/arityanal/f10.hs index bee91d7820..12d4009a53 100644 --- a/testsuite/tests/arityanal/f10.hs +++ b/testsuite/tests/arityanal/f10.hs @@ -1,8 +1,8 @@ -module F10 where
-
-f10f = \h -> (h 1 2, h 3)
-f10g = \x -> \y -> x+y
-f10h = f10f f10g
-f10x1 = fst f10h
-f10x2 = snd f10h
-f10 = f10x2 f10x1
+module F10 where + +f10f = \h -> (h 1 2, h 3) +f10g = \x -> \y -> x+y +f10h = f10f f10g +f10x1 = fst f10h +f10x2 = snd f10h +f10 = f10x2 f10x1 diff --git a/testsuite/tests/arityanal/f11.hs b/testsuite/tests/arityanal/f11.hs index f94d3adec0..9fd32c2fb5 100644 --- a/testsuite/tests/arityanal/f11.hs +++ b/testsuite/tests/arityanal/f11.hs @@ -1,10 +1,10 @@ -module F11 where
-
-fib 0 = 1
-fib 1 = 1
-fib n = fib (n-1) + fib (n-2)
-
-f11f = \z -> let x = fib 1000
- in \y -> x+y
-
-f11 = (f11f 5 6, f11f 7 8)
+module F11 where + +fib 0 = 1 +fib 1 = 1 +fib n = fib (n-1) + fib (n-2) + +f11f = \z -> let x = fib 1000 + in \y -> x+y + +f11 = (f11f 5 6, f11f 7 8) diff --git a/testsuite/tests/arityanal/f12.hs b/testsuite/tests/arityanal/f12.hs index 35e82edc9f..dfc043b84c 100644 --- a/testsuite/tests/arityanal/f12.hs +++ b/testsuite/tests/arityanal/f12.hs @@ -1,5 +1,5 @@ -module F12 where
-
-f12 = let f g x = g x
- h = (+)
- in f h 4 5
+module F12 where + +f12 = let f g x = g x + h = (+) + in f h 4 5 diff --git a/testsuite/tests/arityanal/f13.hs b/testsuite/tests/arityanal/f13.hs index 1b7a779c37..5ab7823b0d 100644 --- a/testsuite/tests/arityanal/f13.hs +++ b/testsuite/tests/arityanal/f13.hs @@ -1,8 +1,8 @@ -module F13 where
-
-f13 x y = let f13f = if (x>0) then \z -> z x y
- else \z -> y
- f13h = let v = f13f 5
- in \w -> w + v
- in \u -> f13h u
-
+module F13 where + +f13 x y = let f13f = if (x>0) then \z -> z x y + else \z -> y + f13h = let v = f13f 5 + in \w -> w + v + in \u -> f13h u + diff --git a/testsuite/tests/arityanal/f14.hs b/testsuite/tests/arityanal/f14.hs index a908b6622b..1f2c19ed92 100644 --- a/testsuite/tests/arityanal/f14.hs +++ b/testsuite/tests/arityanal/f14.hs @@ -1,5 +1,5 @@ -module F14 where
-
-f14 n x = if x<n then let v = f14 n (x+1)
- in \y -> v (x+y)
- else \y -> y
+module F14 where + +f14 n x = if x<n then let v = f14 n (x+1) + in \y -> v (x+y) + else \y -> y diff --git a/testsuite/tests/arityanal/f15.hs b/testsuite/tests/arityanal/f15.hs index 7e1d5dfa16..0ad77e3a3f 100644 --- a/testsuite/tests/arityanal/f15.hs +++ b/testsuite/tests/arityanal/f15.hs @@ -1,5 +1,5 @@ -module F15 where
-
-f15f = \h -> h 1
-f15g = \x -> x+1
-f15 = f15f f15g
\ No newline at end of file +module F15 where + +f15f = \h -> h 1 +f15g = \x -> x+1 +f15 = f15f f15g diff --git a/testsuite/tests/arityanal/f2.hs b/testsuite/tests/arityanal/f2.hs index bdc06e45f2..39ddae0f06 100644 --- a/testsuite/tests/arityanal/f2.hs +++ b/testsuite/tests/arityanal/f2.hs @@ -1,7 +1,7 @@ -module F2 where
-
-f2f = \h -> \x -> h x 0
-f2 = let g = \x -> \y -> if (x > 0)
- then g (x-1) (x+y)
- else y
- in f2f g 5
\ No newline at end of file +module F2 where + +f2f = \h -> \x -> h x 0 +f2 = let g = \x -> \y -> if (x > 0) + then g (x-1) (x+y) + else y + in f2f g 5 diff --git a/testsuite/tests/arityanal/f3.hs b/testsuite/tests/arityanal/f3.hs index f8210e6f0f..a54f25b78e 100644 --- a/testsuite/tests/arityanal/f3.hs +++ b/testsuite/tests/arityanal/f3.hs @@ -1,8 +1,8 @@ -module F3 where
-
-fac :: Int -> Int
-fac x = if (x==0) then 1
- else x*fac (x-1)
-
-f3 = let v = fac
- in \y -> v y
\ No newline at end of file +module F3 where + +fac :: Int -> Int +fac x = if (x==0) then 1 + else x*fac (x-1) + +f3 = let v = fac + in \y -> v y diff --git a/testsuite/tests/arityanal/f4.hs b/testsuite/tests/arityanal/f4.hs index 29c3e8d4ab..3c70acae4a 100644 --- a/testsuite/tests/arityanal/f4.hs +++ b/testsuite/tests/arityanal/f4.hs @@ -1,7 +1,7 @@ -module F4 where
-
-f4h :: (Int -> Int) -> Int -> Int
-f4h f x = if x==0 then (f x)
- else f4h f (x-1) -- + (f x)
-f4g = \y->y+1
-f4 = f4h f4g 9
\ No newline at end of file +module F4 where + +f4h :: (Int -> Int) -> Int -> Int +f4h f x = if x==0 then (f x) + else f4h f (x-1) -- + (f x) +f4g = \y->y+1 +f4 = f4h f4g 9 diff --git a/testsuite/tests/arityanal/f5.hs b/testsuite/tests/arityanal/f5.hs index 96c8450270..7595866195 100644 --- a/testsuite/tests/arityanal/f5.hs +++ b/testsuite/tests/arityanal/f5.hs @@ -1,7 +1,7 @@ -module F5 where
-
--- result not satisfiable
-f5g h z = (h z) + 1
-f5h f x g = f x + f5g g x -- + (f (x+1))
-f5y = (\y -> y+1)
-f5 = f5h f5y 0 f5y
\ No newline at end of file +module F5 where + +-- result not satisfiable +f5g h z = (h z) + 1 +f5h f x g = f x + f5g g x -- + (f (x+1)) +f5y = (\y -> y+1) +f5 = f5h f5y 0 f5y diff --git a/testsuite/tests/arityanal/f6.hs b/testsuite/tests/arityanal/f6.hs index ba1e453c3f..b45951d6a2 100644 --- a/testsuite/tests/arityanal/f6.hs +++ b/testsuite/tests/arityanal/f6.hs @@ -1,5 +1,5 @@ -module F6 where
-
-f6f = \h -> \x -> h x 0
-f6t = \y -> \z -> y + z
-f6 = f6f f6t 3
\ No newline at end of file +module F6 where + +f6f = \h -> \x -> h x 0 +f6t = \y -> \z -> y + z +f6 = f6f f6t 3 diff --git a/testsuite/tests/arityanal/f7.hs b/testsuite/tests/arityanal/f7.hs index 44241c5ae1..fb68ada9c2 100644 --- a/testsuite/tests/arityanal/f7.hs +++ b/testsuite/tests/arityanal/f7.hs @@ -1,5 +1,5 @@ -module F7 where
-
-f7f = \x -> x
-f7g = \z -> \y -> z+y
-f7 = f7f f7g 2 3
+module F7 where + +f7f = \x -> x +f7g = \z -> \y -> z+y +f7 = f7f f7g 2 3 diff --git a/testsuite/tests/arityanal/f8.hs b/testsuite/tests/arityanal/f8.hs index 1c960556b5..6abb2b87e9 100644 --- a/testsuite/tests/arityanal/f8.hs +++ b/testsuite/tests/arityanal/f8.hs @@ -1,5 +1,5 @@ -module F8 where
-
-f8f b x y = let g = \z -> x+y+z
- in if b then y else g (x*x)
-f8 = f8f True 1 2
\ No newline at end of file +module F8 where + +f8f b x y = let g = \z -> x+y+z + in if b then y else g (x*x) +f8 = f8f True 1 2 diff --git a/testsuite/tests/arityanal/f9.hs b/testsuite/tests/arityanal/f9.hs index e991cfd478..1d53d89174 100644 --- a/testsuite/tests/arityanal/f9.hs +++ b/testsuite/tests/arityanal/f9.hs @@ -1,4 +1,4 @@ -module F9 where
-
-f91 = let f = \n -> if n<=100 then f (f (n+11)) else n-10
- in f 10
\ No newline at end of file +module F9 where + +f91 = let f = \n -> if n<=100 then f (f (n+11)) else n-10 + in f 10 diff --git a/testsuite/tests/arityanal/prim.hs b/testsuite/tests/arityanal/prim.hs index 5b91ad24f2..b5a854cb4d 100644 --- a/testsuite/tests/arityanal/prim.hs +++ b/testsuite/tests/arityanal/prim.hs @@ -1,7 +1,7 @@ -module Prim where
-
-map2 f [] = []
-map2 f (x:xs) = f x : map2 f xs
-
-zipWith2 f [] [] = []
-zipWith2 f (a:x) (b:y) = (f a b):zipWith2 f x y
\ No newline at end of file +module Prim where + +map2 f [] = [] +map2 f (x:xs) = f x : map2 f xs + +zipWith2 f [] [] = [] +zipWith2 f (a:x) (b:y) = (f a b):zipWith2 f x y diff --git a/testsuite/tests/codeGen/should_compile/cg005.hs b/testsuite/tests/codeGen/should_compile/cg005.hs index a25ad4250a..62e11ece66 100644 --- a/testsuite/tests/codeGen/should_compile/cg005.hs +++ b/testsuite/tests/codeGen/should_compile/cg005.hs @@ -1,20 +1,20 @@ -module Bug where
-
-import Foreign hiding ( unsafePerformIO )
-import Foreign.ForeignPtr
-import Data.Char
-import System.IO.Unsafe
-
-data PackedString = PS !(ForeignPtr Word8) !Int !Int
-
-(!) :: PackedString -> Int -> Word8
-(PS x s _l) ! i
- = unsafePerformIO $ withForeignPtr x $ \p -> peekElemOff p (s+i)
-
-w2c :: Word8 -> Char
-w2c = chr . fromIntegral
-
-indexPS :: PackedString -> Int -> Char
-indexPS theps i | i < 0 = error "Negative index in indexPS"
- | otherwise = w2c $ theps ! i
-
+module Bug where + +import Foreign hiding ( unsafePerformIO ) +import Foreign.ForeignPtr +import Data.Char +import System.IO.Unsafe + +data PackedString = PS !(ForeignPtr Word8) !Int !Int + +(!) :: PackedString -> Int -> Word8 +(PS x s _l) ! i + = unsafePerformIO $ withForeignPtr x $ \p -> peekElemOff p (s+i) + +w2c :: Word8 -> Char +w2c = chr . fromIntegral + +indexPS :: PackedString -> Int -> Char +indexPS theps i | i < 0 = error "Negative index in indexPS" + | otherwise = w2c $ theps ! i + diff --git a/testsuite/tests/deSugar/should_compile/GadtOverlap.hs b/testsuite/tests/deSugar/should_compile/GadtOverlap.hs index 89187414a3..a362671f2c 100644 --- a/testsuite/tests/deSugar/should_compile/GadtOverlap.hs +++ b/testsuite/tests/deSugar/should_compile/GadtOverlap.hs @@ -1,20 +1,20 @@ -{-# LANGUAGE GADTs #-}
-
-module Gadt where
-
-data T a where
- T1 :: T Int
- T2 :: T a
- T3 :: T Bool
-
-f :: T Int -> Bool
-f T1 = True
-f T2 = False
-
-g :: T Bool -> Bool
-g T2 = True
-g T3 = False
-
-h :: T a -> Bool
-h T1 = True
-h T2 = False
+{-# LANGUAGE GADTs #-} + +module Gadt where + +data T a where + T1 :: T Int + T2 :: T a + T3 :: T Bool + +f :: T Int -> Bool +f T1 = True +f T2 = False + +g :: T Bool -> Bool +g T2 = True +g T3 = False + +h :: T a -> Bool +h T1 = True +h T2 = False diff --git a/testsuite/tests/deSugar/should_compile/T4870.hs b/testsuite/tests/deSugar/should_compile/T4870.hs index fefcdb194b..1aa4a73aaa 100644 --- a/testsuite/tests/deSugar/should_compile/T4870.hs +++ b/testsuite/tests/deSugar/should_compile/T4870.hs @@ -1,10 +1,10 @@ -module T4870 where
-
-import T4870a
-
-data D = D
-
-instance C D where
- c x = x
-
-{-# SPECIALIZE f :: D #-}
+module T4870 where + +import T4870a + +data D = D + +instance C D where + c x = x + +{-# SPECIALIZE f :: D #-} diff --git a/testsuite/tests/deSugar/should_compile/T4870a.hs b/testsuite/tests/deSugar/should_compile/T4870a.hs index a4c59a5b66..a52346c232 100644 --- a/testsuite/tests/deSugar/should_compile/T4870a.hs +++ b/testsuite/tests/deSugar/should_compile/T4870a.hs @@ -1,8 +1,8 @@ -module T4870a where
-
-class C a where c :: a -> a
-
-{-# INLINABLE f #-}
-f :: (C a) => a
-f = c f
-
+module T4870a where + +class C a where c :: a -> a + +{-# INLINABLE f #-} +f :: (C a) => a +f = c f + diff --git a/testsuite/tests/deSugar/should_compile/T5117.hs b/testsuite/tests/deSugar/should_compile/T5117.hs index 15f9c796f0..e396cc5d0f 100644 --- a/testsuite/tests/deSugar/should_compile/T5117.hs +++ b/testsuite/tests/deSugar/should_compile/T5117.hs @@ -1,17 +1,17 @@ -{-# LANGUAGE OverloadedStrings #-}
-module BadWarning where
-
-data MyString = MyString String
-
-f1 (MyString "a") = undefined
-f1 (MyString "bb") = undefined
-f1 _ = undefined
-
-f2 (MyString "aa") = undefined
-f2 (MyString "bb") = undefined
-f2 _ = undefined
-
--- Genuine overlap here!
-f3(MyString ('a':_)) = undefined
-f3 (MyString "a") = undefined
-f3 _ = undefined
+{-# LANGUAGE OverloadedStrings #-} +module BadWarning where + +data MyString = MyString String + +f1 (MyString "a") = undefined +f1 (MyString "bb") = undefined +f1 _ = undefined + +f2 (MyString "aa") = undefined +f2 (MyString "bb") = undefined +f2 _ = undefined + +-- Genuine overlap here! +f3(MyString ('a':_)) = undefined +f3 (MyString "a") = undefined +f3 _ = undefined diff --git a/testsuite/tests/deSugar/should_compile/T5252.hs b/testsuite/tests/deSugar/should_compile/T5252.hs index e2498c4089..70a4531688 100644 --- a/testsuite/tests/deSugar/should_compile/T5252.hs +++ b/testsuite/tests/deSugar/should_compile/T5252.hs @@ -1,13 +1,13 @@ --- Trac #5252
--- Killed 7.03 when compiled witout -O,
--- because it could not see that x had a product type
--- but MkS still unpacked it
-
-module T5252 where
-import T5252a
-
-blah :: S -> T
-blah (MkS x _) = x
-
-
-
+-- Trac #5252 +-- Killed 7.03 when compiled witout -O, +-- because it could not see that x had a product type +-- but MkS still unpacked it + +module T5252 where +import T5252a + +blah :: S -> T +blah (MkS x _) = x + + + diff --git a/testsuite/tests/deSugar/should_compile/T5252a.hs b/testsuite/tests/deSugar/should_compile/T5252a.hs index ff1704a566..ab187a0d66 100644 --- a/testsuite/tests/deSugar/should_compile/T5252a.hs +++ b/testsuite/tests/deSugar/should_compile/T5252a.hs @@ -1,5 +1,5 @@ -module T5252a( S(..), T ) where
-
-data T = MkT Int Int
-
-data S = MkS {-# UNPACK #-}!T Int
+module T5252a( S(..), T ) where + +data T = MkT Int Int + +data S = MkS {-# UNPACK #-}!T Int diff --git a/testsuite/tests/deSugar/should_compile/ds055.hs b/testsuite/tests/deSugar/should_compile/ds055.hs index 0fe593dd9a..7f494fefd1 100644 --- a/testsuite/tests/deSugar/should_compile/ds055.hs +++ b/testsuite/tests/deSugar/should_compile/ds055.hs @@ -1,29 +1,29 @@ {-# LANGUAGE ExistentialQuantification, DeriveDataTypeable #-} -
--- This module requires quite trick desugaring,
--- because of the context in the existentials
--- It broke a pre 6.4 GHC
-
-module Foo where
-
- import Data.Data
-
- data Item = forall a. (Data a) => Leaf Bool a
- | forall a. (Data a) => Branch Bool a Int Int
- deriving (Typeable)
-
-
- instance Data Item where
- gfoldl k z (Leaf b v) = z (Leaf b) `k` v
- gfoldl k z (Branch b v a1 a2) = z (\x -> Branch b x a1 a2) `k` v
- gunfold _ _ _ = error "urk"
- toConstr (Leaf _ _) = leafConstr
- toConstr (Branch _ _ _ _) = branchConstr
- dataTypeOf _ = itemDataType
-
- itemDataType = mkDataType "Subliminal.Item" [leafConstr, branchConstr]
- leafConstr = mkConstr itemDataType "Leaf" [] Prefix
- branchConstr = mkConstr itemDataType "Branch" [] Prefix
-
-
-
+ +-- This module requires quite trick desugaring, +-- because of the context in the existentials +-- It broke a pre 6.4 GHC + +module Foo where + + import Data.Data + + data Item = forall a. (Data a) => Leaf Bool a + | forall a. (Data a) => Branch Bool a Int Int + deriving (Typeable) + + + instance Data Item where + gfoldl k z (Leaf b v) = z (Leaf b) `k` v + gfoldl k z (Branch b v a1 a2) = z (\x -> Branch b x a1 a2) `k` v + gunfold _ _ _ = error "urk" + toConstr (Leaf _ _) = leafConstr + toConstr (Branch _ _ _ _) = branchConstr + dataTypeOf _ = itemDataType + + itemDataType = mkDataType "Subliminal.Item" [leafConstr, branchConstr] + leafConstr = mkConstr itemDataType "Leaf" [] Prefix + branchConstr = mkConstr itemDataType "Branch" [] Prefix + + + diff --git a/testsuite/tests/deSugar/should_run/T3382.hs b/testsuite/tests/deSugar/should_run/T3382.hs index 800256a1f0..d04a622d70 100644 --- a/testsuite/tests/deSugar/should_run/T3382.hs +++ b/testsuite/tests/deSugar/should_run/T3382.hs @@ -1,14 +1,14 @@ -{-# OPTIONS_GHC -XOverloadedStrings #-}
-module Main where
-
-import Data.String
-
-instance IsString Int where
- fromString x = 1337
-
-f :: Int -> String
-f "hello" = "correct"
-f _ = "false"
-
-main = do print $ f 1337
- print $ f 1338
+{-# OPTIONS_GHC -XOverloadedStrings #-} +module Main where + +import Data.String + +instance IsString Int where + fromString x = 1337 + +f :: Int -> String +f "hello" = "correct" +f _ = "false" + +main = do print $ f 1337 + print $ f 1338 diff --git a/testsuite/tests/deSugar/should_run/dsrun021.hs b/testsuite/tests/deSugar/should_run/dsrun021.hs index 7489f77a4a..11df6d48d0 100644 --- a/testsuite/tests/deSugar/should_run/dsrun021.hs +++ b/testsuite/tests/deSugar/should_run/dsrun021.hs @@ -1,22 +1,22 @@ --- Transformation stress test
-
-{-# OPTIONS_GHC -XTransformListComp #-}
-
-module Main where
-
-import Data.List(takeWhile)
-import GHC.Exts(sortWith)
-
-employees = [ ("Simon", "MS", 80)
- , ("Erik", "MS", 100)
- , ("Phil", "Ed", 40)
- , ("Gordon", "Ed", 45)
- , ("Paul", "Yale", 60)]
-
-main = putStrLn (show output)
- where
- output = [ (dept, salary)
- | (name, dept, salary) <- employees
- , then sortWith by salary
- , then filter by salary > 50
- , then take 1 ]
\ No newline at end of file +-- Transformation stress test + +{-# OPTIONS_GHC -XTransformListComp #-} + +module Main where + +import Data.List(takeWhile) +import GHC.Exts(sortWith) + +employees = [ ("Simon", "MS", 80) + , ("Erik", "MS", 100) + , ("Phil", "Ed", 40) + , ("Gordon", "Ed", 45) + , ("Paul", "Yale", 60)] + +main = putStrLn (show output) + where + output = [ (dept, salary) + | (name, dept, salary) <- employees + , then sortWith by salary + , then filter by salary > 50 + , then take 1 ] |