Commit 13631d00 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Remove tests for removed modules

parent 5428d110
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
import Debug.QuickCheck
import System.IO.Unsafe
import Control.Concurrent.QSem
import Control.Concurrent
import Control.Monad
main = do
t <- myThreadId
forkIO (threadDelay 1000000 >> killThread t)
-- just in case we deadlock
testQSem
data Action = NewQSem Int | SignalQSem | WaitQSem
deriving (Eq,Show)
testQSem :: IO ()
testQSem = do
quietCheck prop_SignalWait
quietCheck prop_WaitSignal
quietCheck = check defaultConfig{configEvery = \n args -> ""}
prop_SignalWait n =
n>=0 ==> [NewQSem n,SignalQSem,WaitQSem] =^ [NewQSem n]
prop_WaitSignal n =
n>=1 ==> [NewQSem n,WaitQSem,SignalQSem] =^ [NewQSem n]
perform :: [Action] -> IO ()
perform [] = return ()
perform (a:as) =
case a of
NewQSem n -> newQSem n >>= \qs -> perform' qs as
_ -> error $ "Please use NewQSem as first action" ++ show a
perform' :: QSem -> [Action] -> IO ()
perform' _ [] = return ()
perform' qs (a:as) =
case a of
SignalQSem -> signalQSem qs >> perform' qs as
WaitQSem -> waitQSem qs >> perform' qs as
_ -> error $ "If you want to use " ++ show a
++ " please use the =^ operator"
actions :: Gen [Action]
actions = do
i <- arbitrary
liftM (NewQSem i:) (actions' i)
actions' :: Int -> Gen [Action]
actions' quantity =
oneof ([return [],
liftM (SignalQSem:) (actions' (quantity+1))] ++
if quantity<=0
then []
else [liftM (WaitQSem:) (actions' (quantity-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 _ (NewQSem i:as) = delta i as
delta i (SignalQSem:as) = delta (i+1) as
delta i (WaitQSem:as) = delta (if i<=0
then error "wait on 'empty' QSem"
else i-1) as
OK, passed 100 tests.
OK, passed 100 tests.
import Debug.QuickCheck
import System.IO.Unsafe
import Control.Concurrent.QSemN
import Control.Concurrent
import Control.Monad
main = do
t <- myThreadId
forkIO (threadDelay 1000000 >> killThread t)
-- just in case we deadlock
testQSemN
data Action = NewQSemN Int | SignalQSemN Int | WaitQSemN Int
deriving (Eq,Show)
testQSemN :: IO ()
testQSemN = do
quietCheck prop_SignalWait
quietCheck prop_WaitSignal
quietCheck = check defaultConfig{configEvery = \n args -> ""}
prop_SignalWait l m n = l+m>=n ==>
[NewQSemN l,SignalQSemN m,WaitQSemN n] =^ [NewQSemN (l+m-n)]
prop_WaitSignal l m n = l>=m ==>
[NewQSemN l,WaitQSemN m,SignalQSemN n] =^ [NewQSemN (l-m+n)]
perform :: [Action] -> IO [Int]
perform [] = return []
perform (a:as) =
case a of
NewQSemN n -> newQSemN n >>= \qs -> perform' qs as
_ -> error $ "Please use NewQSemN as first action" ++ show a
perform' :: QSemN -> [Action] -> IO [Int]
perform' _ [] = return []
perform' qs (a:as) =
case a of
SignalQSemN n -> signalQSemN qs n >> perform' qs as
WaitQSemN n -> waitQSemN qs n >> perform' qs as
_ -> error $ "If you want to use " ++ show a
++ " please use the =^ operator"
actions :: Gen [Action]
actions = do
i <- arbitrary
liftM (NewQSemN i:) (actions' i)
actions' :: Int -> Gen [Action]
actions' quantity =
oneof ([return [],
do i<- choose (0,maxBound)
liftM (SignalQSemN i:) (actions' (quantity+i))] ++
if quantity<=0
then []
else [do i<- choose (0,quantity)
liftM (WaitQSemN i:) (actions' (quantity-i))])
(=^) :: [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 _ (NewQSemN i:as) = delta i as
delta i (SignalQSemN n:as) = delta (i+n) as
delta i (WaitQSemN n:as) = delta (if i<n
then error "wait on 'empty' QSemN"
else i-n) as
OK, passed 100 tests.
OK, passed 100 tests.
-------------------------------------------------------------------------------
-- Module : SampleVarTest
-------------------------------------------------------------------------------
import Debug.QuickCheck
import System.IO.Unsafe
import Control.Concurrent
import Control.Concurrent.SampleVar
import Control.Monad
data Action = NewEmptySampleVar | NewSampleVar Int | EmptySampleVar
| ReadSampleVar | WriteSampleVar Int | IsEmptySampleVar
| ReturnInt Int | ReturnBool Bool
deriving (Eq,Show)
main = do
t <- myThreadId
forkIO (threadDelay 1000000 >> killThread t)
-- just in case we deadlock
testSampleVar
testSampleVar :: IO ()
testSampleVar = do
quickCheck prop_NewEIs_NewERet
quickCheck prop_NewIs_NewRet
quickCheck prop_NewRead_NewRet
quickCheck prop_NewEWriteRead_NewERet
quickCheck prop_WriteEmpty_Empty
quickCheck prop_WriteRead_Ret
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)
NewEmptySampleVar -> newEmptySampleVar >>= \sv -> perform' sv as
NewSampleVar n -> newSampleVar n >>= \sv -> perform' sv as
perform' :: SampleVar Int -> [Action] -> IO ([Bool],[Int])
perform' _ [] = return ([],[])
perform' sv (a:as) =
case a of
ReturnInt v -> liftM (\(b,l) -> (b,v:l)) (perform' sv as)
ReturnBool v -> liftM (\(b,l) -> (v:b,l)) (perform' sv as)
EmptySampleVar -> emptySampleVar sv >> perform' sv as
ReadSampleVar -> liftM2 (\v (b,l) -> (b,v:l)) (readSampleVar sv)
(perform' sv as)
WriteSampleVar n -> writeSampleVar sv n >> perform' sv as
IsEmptySampleVar -> liftM2 (\v (b,l) -> (v:b,l)) (isEmptySampleVar sv)
(perform' sv as)
actions :: Gen [Action]
actions = do
oneof [liftM (NewEmptySampleVar:) (actions' True),
liftM2 (:) (liftM NewSampleVar arbitrary) (actions' False)]
actions' :: Bool -> Gen [Action]
actions' empty =
oneof ([return [],
liftM (IsEmptySampleVar:) (actions' empty),
liftM (EmptySampleVar:) (actions' True),
liftM2 (:) (liftM WriteSampleVar arbitrary) (actions' False)] ++
if empty
then []
else [liftM (ReadSampleVar:) (actions' True)])
(=^) :: [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 _ (NewEmptySampleVar:as) = delta True as
delta _ (NewSampleVar _:as) = delta False as
delta _ (EmptySampleVar:as) = delta True as
delta b (ReadSampleVar:as) = delta (if b
then error "read on empty SampleVar"
else True) as
delta _ (WriteSampleVar _:as) = delta False as
delta b (IsEmptySampleVar:as) = delta b as
prop_NewEIs_NewERet =
[NewEmptySampleVar,IsEmptySampleVar] =^ [NewEmptySampleVar,ReturnBool True]
prop_NewIs_NewRet n =
[NewSampleVar n,IsEmptySampleVar] =^ [NewSampleVar n,ReturnBool False]
prop_NewRead_NewRet n =
[NewSampleVar n,ReadSampleVar] =^ [NewEmptySampleVar,ReturnInt n]
prop_NewEWriteRead_NewERet n =
[NewEmptySampleVar,WriteSampleVar n,ReadSampleVar] =^
[NewEmptySampleVar,ReturnInt n]
prop_WriteEmpty_Empty n =
[WriteSampleVar n,EmptySampleVar] ^=^ [EmptySampleVar]
prop_WriteRead_Ret n =
[WriteSampleVar n,ReadSampleVar] ^=^ [EmptySampleVar,ReturnInt n]
0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests.
0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests.
0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests.
0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests.
0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests.
0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests.
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('Chan002', extra_run_opts('100'), compile_and_run, [''])
test('Chan003', extra_run_opts('200'), compile_and_run, [''])
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, [''])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment