diff options
Diffstat (limited to 'testsuite/tests/ghc-regress/lib/Concurrent')
15 files changed, 0 insertions, 656 deletions
diff --git a/testsuite/tests/ghc-regress/lib/Concurrent/4876.hs b/testsuite/tests/ghc-regress/lib/Concurrent/4876.hs deleted file mode 100644 index 68c2a871b8..0000000000 --- a/testsuite/tests/ghc-regress/lib/Concurrent/4876.hs +++ /dev/null @@ -1,19 +0,0 @@ -import System.Random -import Control.Concurrent.SampleVar -import Control.Concurrent -import Control.Monad - -produce, consume :: SampleVar Int -> IO () -produce svar = do - b <- isEmptySampleVar svar - if b then writeSampleVar svar 3 else return () - -consume svar = readSampleVar svar >>= print - -main = do - svar <- newEmptySampleVar - m <- newEmptyMVar - forkIO $ consume svar >> putMVar m () - threadDelay 100000 -- 100 ms - produce svar - takeMVar m -- deadlocked before the fix in #4876 diff --git a/testsuite/tests/ghc-regress/lib/Concurrent/4876.stdout b/testsuite/tests/ghc-regress/lib/Concurrent/4876.stdout deleted file mode 100644 index 00750edc07..0000000000 --- a/testsuite/tests/ghc-regress/lib/Concurrent/4876.stdout +++ /dev/null @@ -1 +0,0 @@ -3 diff --git a/testsuite/tests/ghc-regress/lib/Concurrent/Chan001.hs b/testsuite/tests/ghc-regress/lib/Concurrent/Chan001.hs deleted file mode 100644 index e4b668ac48..0000000000 --- a/testsuite/tests/ghc-regress/lib/Concurrent/Chan001.hs +++ /dev/null @@ -1,109 +0,0 @@ -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/testsuite/tests/ghc-regress/lib/Concurrent/Chan001.stdout b/testsuite/tests/ghc-regress/lib/Concurrent/Chan001.stdout deleted file mode 100644 index 53bfa8a381..0000000000 --- a/testsuite/tests/ghc-regress/lib/Concurrent/Chan001.stdout +++ /dev/null @@ -1,3 +0,0 @@ -0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests. -0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests. -0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests. diff --git a/testsuite/tests/ghc-regress/lib/Concurrent/MVar001.hs b/testsuite/tests/ghc-regress/lib/Concurrent/MVar001.hs deleted file mode 100644 index f787470c51..0000000000 --- a/testsuite/tests/ghc-regress/lib/Concurrent/MVar001.hs +++ /dev/null @@ -1,148 +0,0 @@ -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/testsuite/tests/ghc-regress/lib/Concurrent/MVar001.stdout b/testsuite/tests/ghc-regress/lib/Concurrent/MVar001.stdout deleted file mode 100644 index 65be56c733..0000000000 --- a/testsuite/tests/ghc-regress/lib/Concurrent/MVar001.stdout +++ /dev/null @@ -1,6 +0,0 @@ -0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests. -0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests. -0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests. -0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests. -0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests. -0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests. diff --git a/testsuite/tests/ghc-regress/lib/Concurrent/Makefile b/testsuite/tests/ghc-regress/lib/Concurrent/Makefile deleted file mode 100644 index 1c39d1c1fe..0000000000 --- a/testsuite/tests/ghc-regress/lib/Concurrent/Makefile +++ /dev/null @@ -1,3 +0,0 @@ -TOP=../../../.. -include $(TOP)/mk/boilerplate.mk -include $(TOP)/mk/test.mk diff --git a/testsuite/tests/ghc-regress/lib/Concurrent/QSem001.hs b/testsuite/tests/ghc-regress/lib/Concurrent/QSem001.hs deleted file mode 100644 index 1f255997e7..0000000000 --- a/testsuite/tests/ghc-regress/lib/Concurrent/QSem001.hs +++ /dev/null @@ -1,93 +0,0 @@ -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
-
diff --git a/testsuite/tests/ghc-regress/lib/Concurrent/QSem001.stdout b/testsuite/tests/ghc-regress/lib/Concurrent/QSem001.stdout deleted file mode 100644 index 7288d19270..0000000000 --- a/testsuite/tests/ghc-regress/lib/Concurrent/QSem001.stdout +++ /dev/null @@ -1,2 +0,0 @@ -OK, passed 100 tests. -OK, passed 100 tests. diff --git a/testsuite/tests/ghc-regress/lib/Concurrent/QSemN001.hs b/testsuite/tests/ghc-regress/lib/Concurrent/QSemN001.hs deleted file mode 100644 index c31d6a6964..0000000000 --- a/testsuite/tests/ghc-regress/lib/Concurrent/QSemN001.hs +++ /dev/null @@ -1,96 +0,0 @@ -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
-
diff --git a/testsuite/tests/ghc-regress/lib/Concurrent/QSemN001.stdout b/testsuite/tests/ghc-regress/lib/Concurrent/QSemN001.stdout deleted file mode 100644 index 7288d19270..0000000000 --- a/testsuite/tests/ghc-regress/lib/Concurrent/QSemN001.stdout +++ /dev/null @@ -1,2 +0,0 @@ -OK, passed 100 tests. -OK, passed 100 tests. diff --git a/testsuite/tests/ghc-regress/lib/Concurrent/SampleVar001.hs b/testsuite/tests/ghc-regress/lib/Concurrent/SampleVar001.hs deleted file mode 100644 index def86c5d54..0000000000 --- a/testsuite/tests/ghc-regress/lib/Concurrent/SampleVar001.hs +++ /dev/null @@ -1,132 +0,0 @@ --------------------------------------------------------------------------------
--- 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]
diff --git a/testsuite/tests/ghc-regress/lib/Concurrent/SampleVar001.stdout b/testsuite/tests/ghc-regress/lib/Concurrent/SampleVar001.stdout deleted file mode 100644 index 65be56c733..0000000000 --- a/testsuite/tests/ghc-regress/lib/Concurrent/SampleVar001.stdout +++ /dev/null @@ -1,6 +0,0 @@ -0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests. -0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests. -0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests. -0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests. -0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests. -0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests. diff --git a/testsuite/tests/ghc-regress/lib/Concurrent/ThreadDelay001.hs b/testsuite/tests/ghc-regress/lib/Concurrent/ThreadDelay001.hs deleted file mode 100644 index c60f997039..0000000000 --- a/testsuite/tests/ghc-regress/lib/Concurrent/ThreadDelay001.hs +++ /dev/null @@ -1,26 +0,0 @@ - --- Test that threadDelay actually sleeps for (at least) as long as we --- ask it - -module Main (main) where - -import Control.Concurrent -import Control.Monad -import System.Time - -main = mapM_ delay (0 : take 11 (iterate (*5) 1)) - -delay n = do - tS <- getClockTime - threadDelay n - tE <- getClockTime - - let req = fromIntegral n * 10 ^ (6 :: Int) - obs = case normalizeTimeDiff (diffClockTimes tE tS) of - TimeDiff 0 0 0 0 0 s ps -> 10^12 * fromIntegral s + ps - diff = obs - req - diff' :: Double - diff' = fromIntegral diff / 10^(12 :: Int) - - when (obs < req) $ print (tS, tE, req, obs, diff, diff') - diff --git a/testsuite/tests/ghc-regress/lib/Concurrent/all.T b/testsuite/tests/ghc-regress/lib/Concurrent/all.T deleted file mode 100644 index 004c6a1226..0000000000 --- a/testsuite/tests/ghc-regress/lib/Concurrent/all.T +++ /dev/null @@ -1,10 +0,0 @@ -setTestOpts(only_compiler_types(['ghc'])) - -test('SampleVar001', reqlib('QuickCheck'), compile_and_run, ['-package QuickCheck']) -test('4876', reqlib('random'), compile_and_run, ['']) # another SampleVar test - -test('Chan001', reqlib('QuickCheck'), compile_and_run, ['-package QuickCheck']) -test('MVar001', reqlib('QuickCheck'), compile_and_run, ['-package QuickCheck']) -test('QSemN001', reqlib('QuickCheck'), compile_and_run, ['-package QuickCheck']) -test('QSem001', reqlib('QuickCheck'), compile_and_run, ['-package QuickCheck']) -test('ThreadDelay001', normal, compile_and_run, ['']) |