Commit d5e8b394 authored by thomie's avatar thomie

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

parent 6074c108
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
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
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