diff options
author | Matthew Pickering <matthewtpickering@gmail.com> | 2021-12-08 16:56:15 +0000 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-12-22 14:47:40 -0500 |
commit | 3ed909118126a93f03ef17fed52eaf602b91ae1b (patch) | |
tree | 669ce30095f26b440cab35daf006b102a4c7c48f /libraries | |
parent | 09b6cb45505c2c32ddaffcdb930fb3f7873b2cfc (diff) | |
download | haskell-3ed909118126a93f03ef17fed52eaf602b91ae1b.tar.gz |
testsuite: Remove reqlib modifier
The reqlib modifer was supposed to indicate that a test needed a certain
library in order to work. If the library happened to be installed then
the test would run as normal.
However, CI has never run these tests as the packages have not been
installed and we don't want out tests to depend on things which might
get externally broken by updating the compiler.
The new strategy is to run these tests in head.hackage, where the tests
have been cabalised as well as possible. Some tests couldn't be
transferred into the normal style testsuite but it's better than never
running any of the reqlib tests. https://gitlab.haskell.org/ghc/head.hackage/-/merge_requests/169
A few submodules also had reqlib tests and have been updated to remove
it.
Closes #16264 #20032 #17764 #16561
Diffstat (limited to 'libraries')
22 files changed, 0 insertions, 441 deletions
diff --git a/libraries/base/tests/Concurrent/Chan001.hs b/libraries/base/tests/Concurrent/Chan001.hs deleted file mode 100644 index e1b164e586..0000000000 --- a/libraries/base/tests/Concurrent/Chan001.hs +++ /dev/null @@ -1,109 +0,0 @@ -import Test.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/Chan001.stdout b/libraries/base/tests/Concurrent/Chan001.stdout deleted file mode 100644 index ab7b91a0bc..0000000000 --- a/libraries/base/tests/Concurrent/Chan001.stdout +++ /dev/null @@ -1,3 +0,0 @@ -+++ OK, passed 100 tests. -+++ OK, passed 100 tests. -+++ OK, passed 100 tests. diff --git a/libraries/base/tests/Concurrent/MVar001.hs b/libraries/base/tests/Concurrent/MVar001.hs deleted file mode 100644 index 0d96a7eb27..0000000000 --- a/libraries/base/tests/Concurrent/MVar001.hs +++ /dev/null @@ -1,148 +0,0 @@ -import Test.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 = - 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/Concurrent/MVar001.stdout b/libraries/base/tests/Concurrent/MVar001.stdout deleted file mode 100644 index 9430cca9d6..0000000000 --- a/libraries/base/tests/Concurrent/MVar001.stdout +++ /dev/null @@ -1,6 +0,0 @@ -+++ OK, passed 100 tests. -+++ OK, passed 100 tests. -+++ OK, passed 100 tests. -+++ OK, passed 100 tests. -+++ OK, passed 100 tests. -+++ OK, passed 100 tests. diff --git a/libraries/base/tests/Concurrent/all.T b/libraries/base/tests/Concurrent/all.T index 38bf396cd7..f8826a08d3 100644 --- a/libraries/base/tests/Concurrent/all.T +++ b/libraries/base/tests/Concurrent/all.T @@ -1,7 +1,3 @@ -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('ThreadDelay001', normal, compile_and_run, ['']) diff --git a/libraries/base/tests/IO/all.T b/libraries/base/tests/IO/all.T index 2d4c85700f..7e54bb9ea2 100644 --- a/libraries/base/tests/IO/all.T +++ b/libraries/base/tests/IO/all.T @@ -11,7 +11,6 @@ test('IOError002', normal, compile_and_run, ['']) test('finalization001', normal, compile_and_run, ['']) test('hClose001', [], compile_and_run, ['']) test('hClose002', [normalise_win32_io_errors], compile_and_run, ['']) -test('hClose003', reqlib('unix'), compile_and_run, ['-package unix']) test('hFileSize001', normal, compile_and_run, ['']) test('hFileSize002', [omit_ways(['ghci'])], compile_and_run, ['']) test('hFlush001', [], compile_and_run, ['']) @@ -96,8 +95,6 @@ test('concio001', [normal, multi_cpu_race], test('concio001.thr', [extra_files(['concio001.hs']), multi_cpu_race], makefile_test, ['test.concio001.thr']) -test('concio002', reqlib('process'), compile_and_run, ['']) - test('T2122', [], compile_and_run, ['']) test('T3307', [], makefile_test, ['T3307-test']) test('T4855', normal, compile_and_run, ['']) diff --git a/libraries/base/tests/IO/concio002.hs b/libraries/base/tests/IO/concio002.hs deleted file mode 100644 index 60a2ed2a89..0000000000 --- a/libraries/base/tests/IO/concio002.hs +++ /dev/null @@ -1,14 +0,0 @@ -import System.Process -import System.IO -import Control.Concurrent - -main = do - (hin,hout,herr,ph) <- runInteractiveProcess "cat" [] Nothing Nothing - forkIO $ do threadDelay 100000 - putStrLn "child" - hFlush stdout - hPutStrLn hin "msg" - hFlush hin - putStrLn "parent1" - hGetLine hout >>= putStrLn - putStrLn "parent2" diff --git a/libraries/base/tests/IO/concio002.stdout b/libraries/base/tests/IO/concio002.stdout deleted file mode 100644 index 32640aede5..0000000000 --- a/libraries/base/tests/IO/concio002.stdout +++ /dev/null @@ -1,4 +0,0 @@ -parent1 -child -msg -parent2 diff --git a/libraries/base/tests/IO/hClose003.hs b/libraries/base/tests/IO/hClose003.hs deleted file mode 100644 index 6d962fd94e..0000000000 --- a/libraries/base/tests/IO/hClose003.hs +++ /dev/null @@ -1,42 +0,0 @@ --- Test for #3128, file descriptor leak when hClose fails - -import System.IO -import Control.Exception -import Data.Char - -import System.Posix -import qualified GHC.IO.Device as IODevice -import GHC.IO.Handle -import GHC.IO.Handle.Internals -import GHC.IO.Handle.Types -import System.Posix.Internals - -main = do - (read,write) <- createPipe - hread <- fdToHandle read - hwrite <- fdToHandle write - - -- close the FD without telling the IO library: - showPossibleException (hClose hread) - hIsOpen hread >>= print - - -- put some data in the Handle's write buffer: - hPutStr hwrite "testing" - -- now try to close the Handle: - showPossibleException (hClose hwrite) - hIsOpen hwrite >>= print - -showPossibleException :: IO () -> IO () -showPossibleException f = do - e <- try f - putStrLn (sanitise (show (e :: Either SomeException ()))) - where - -- we don't care which file descriptor it is - sanitise [] = [] - sanitise (x:xs) = if isDigit x then ('X':(sanitise' xs)) else (x:(sanitise xs)) - sanitise' [] = [] - sanitise' (x:xs) = if isDigit x then (sanitise' xs) else (x:(sanitise xs)) - -naughtyClose h = - withHandle_ "naughtyClose" h $ \ Handle__{haDevice=dev} -> - IODevice.close dev diff --git a/libraries/base/tests/IO/hClose003.stdout b/libraries/base/tests/IO/hClose003.stdout deleted file mode 100644 index d12f84d7d7..0000000000 --- a/libraries/base/tests/IO/hClose003.stdout +++ /dev/null @@ -1,4 +0,0 @@ -Right () -False -Left <file descriptor: X>: hClose: resource vanished (Broken pipe) -False diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T index ebbf81ec52..901b5c91f1 100644 --- a/libraries/base/tests/all.T +++ b/libraries/base/tests/all.T @@ -83,7 +83,6 @@ test('length001', test('ratio001', normal, compile_and_run, ['']) -test('rand001', reqlib('random'), compile_and_run, ['']) test('reads001', normal, compile_and_run, ['']) test('show001', normal, compile_and_run, ['']) test('text001', normal, compile_and_run, ['']) @@ -220,10 +219,8 @@ test('T9681', normal, compile_fail, ['']) test('T8089', [exit_code(99), run_timeout_multiplier(0.01)], compile_and_run, ['']) -test('hWaitForInput-accurate-socket', reqlib('unix'), compile_and_run, ['']) test('T8684', expect_broken(8684), compile_and_run, ['']) test('hWaitForInput-accurate-stdin', [expect_broken_for(16535, threaded_ways), omit_ways(['ghci'])], compile_and_run, ['']) -test('hWaitForInput-accurate-pipe', reqlib('unix'), compile_and_run, ['']) test('T9826',normal, compile_and_run,['']) test('T9848', [ collect_stats('bytes allocated') diff --git a/libraries/base/tests/hWaitForInput-accurate-pipe.hs b/libraries/base/tests/hWaitForInput-accurate-pipe.hs deleted file mode 100644 index 409c60c63c..0000000000 --- a/libraries/base/tests/hWaitForInput-accurate-pipe.hs +++ /dev/null @@ -1,23 +0,0 @@ -import Control.Concurrent -import Control.Monad -import GHC.Clock -import System.IO -import System.Posix.IO -import System.Timeout - -main :: IO () -main = do - (readPipe, _) <- createPipe - readPipeHandle <- fdToHandle readPipe - let nanoSecondsPerSecond = 1000 * 1000 * 1000 - let milliSecondsPerSecond = 1000 - let timeToSpend = 1 - let timeToSpendNano = timeToSpend * nanoSecondsPerSecond - let timeToSpendMilli = timeToSpend * milliSecondsPerSecond - start <- getMonotonicTimeNSec - b <- hWaitForInput readPipeHandle timeToSpendMilli - end <- getMonotonicTimeNSec - let timeSpentNano = fromIntegral $ end - start - let delta = timeSpentNano - timeToSpendNano - -- We can never wait for a shorter amount of time than specified - putStrLn $ "delta >= 0: " ++ show (delta > 0) diff --git a/libraries/base/tests/hWaitForInput-accurate-pipe.stdout b/libraries/base/tests/hWaitForInput-accurate-pipe.stdout deleted file mode 100644 index f1e939c51d..0000000000 --- a/libraries/base/tests/hWaitForInput-accurate-pipe.stdout +++ /dev/null @@ -1 +0,0 @@ -delta >= 0: True diff --git a/libraries/base/tests/hWaitForInput-accurate-socket.hs b/libraries/base/tests/hWaitForInput-accurate-socket.hs deleted file mode 100644 index ea3580edea..0000000000 --- a/libraries/base/tests/hWaitForInput-accurate-socket.hs +++ /dev/null @@ -1,48 +0,0 @@ -import Control.Concurrent -import Control.Monad -import Foreign.C -import GHC.Clock -import GHC.IO.Device -import GHC.IO.Handle.FD -import System.IO -import System.Posix.IO -import System.Posix.Types -import System.Timeout - -main :: IO () -main = do - socketHandle <- makeTestSocketHandle - let nanoSecondsPerSecond = 1000 * 1000 * 1000 - let milliSecondsPerSecond = 1000 - let timeToSpend = 1 - let timeToSpendNano = timeToSpend * nanoSecondsPerSecond - let timeToSpendMilli = timeToSpend * milliSecondsPerSecond - start <- getMonotonicTimeNSec - b <- hWaitForInput socketHandle timeToSpendMilli - end <- getMonotonicTimeNSec - let timeSpentNano = fromIntegral $ end - start - let delta = timeSpentNano - timeToSpendNano - -- We can never wait for a shorter amount of time than specified - putStrLn $ "delta >= 0: " ++ show (delta >= 0) - -foreign import ccall unsafe "socket" c_socket :: - CInt -> CInt -> CInt -> IO CInt - -makeTestSocketHandle :: IO Handle -makeTestSocketHandle = do - sockNum <- - c_socket - 1 -- PF_LOCAL - 2 -- SOCK_DGRAM - 0 - let fd = fromIntegral sockNum :: Fd - h <- - fdToHandle' - (fromIntegral fd) - (Just GHC.IO.Device.Stream) - True - "testsocket" - ReadMode - True - hSetBuffering h NoBuffering - pure h diff --git a/libraries/base/tests/hWaitForInput-accurate-socket.stdout b/libraries/base/tests/hWaitForInput-accurate-socket.stdout deleted file mode 100644 index f1e939c51d..0000000000 --- a/libraries/base/tests/hWaitForInput-accurate-socket.stdout +++ /dev/null @@ -1 +0,0 @@ -delta >= 0: True diff --git a/libraries/base/tests/rand001.hs b/libraries/base/tests/rand001.hs deleted file mode 100644 index 3567ae0dd8..0000000000 --- a/libraries/base/tests/rand001.hs +++ /dev/null @@ -1,22 +0,0 @@ -module Main(main) where - -import System.Random - -tstRnd rng = checkRange rng (genRnd 50 rng) - -genRnd n rng = take n (randomRs rng (mkStdGen 2)) - -checkRange (lo,hi) = all pred - where - pred - | lo <= hi = \ x -> x >= lo && x <= hi - | otherwise = \ x -> x >= hi && x <= lo - -main :: IO () -main = do - print (tstRnd (1,5::Double)) - print (tstRnd (1,5::Int)) - print (tstRnd (10,54::Integer)) - print (tstRnd ((-6),2::Int)) - print (tstRnd (2,(-6)::Int)) - diff --git a/libraries/base/tests/rand001.stdout b/libraries/base/tests/rand001.stdout deleted file mode 100644 index 2e883c51de..0000000000 --- a/libraries/base/tests/rand001.stdout +++ /dev/null @@ -1,5 +0,0 @@ -True -True -True -True -True diff --git a/libraries/ghc-compact/tests/all.T b/libraries/ghc-compact/tests/all.T index 97cc7bd40a..21b6738903 100644 --- a/libraries/ghc-compact/tests/all.T +++ b/libraries/ghc-compact/tests/all.T @@ -4,7 +4,6 @@ test('compact_simple', normal, compile_and_run, ['']) test('compact_loop', normal, compile_and_run, ['']) test('compact_append', normal, compile_and_run, ['']) test('compact_autoexpand', normal, compile_and_run, ['']) -test('compact_small_array', [reqlib('primitive')], compile_and_run, ['']) test('compact_simple_array', normal, compile_and_run, ['']) test('compact_huge_array', normal, compile_and_run, ['']) test('compact_serialize', normal, compile_and_run, ['']) diff --git a/libraries/hpc b/libraries/hpc -Subproject cf838c8853178c18a7c53dc229606da83a7b201 +Subproject 3648cd63d10e301f3f596efdcb1427a6a6a96cf diff --git a/libraries/process b/libraries/process -Subproject 5a42f025ade67891210a23dee591e3f82a5a74d +Subproject 7fd28338c82c89deb3e5db117e87633898046d7 diff --git a/libraries/stm b/libraries/stm -Subproject e966ebbdf5f6e9dd772c719b168a1e859f40de8 +Subproject a58fdfadbcfd2743944e6a3c4bc734cfbca8913 diff --git a/libraries/unix b/libraries/unix -Subproject 21437f20a41eb1a4c7d42fc402fe91350eb8b03 +Subproject 1f72ccec55c1b61299310b994754782103a617f |