summaryrefslogtreecommitdiff
path: root/libraries/base
diff options
context:
space:
mode:
Diffstat (limited to 'libraries/base')
-rw-r--r--libraries/base/tests/Concurrent/Chan001.hs109
-rw-r--r--libraries/base/tests/Concurrent/Chan001.stdout3
-rw-r--r--libraries/base/tests/Concurrent/MVar001.hs148
-rw-r--r--libraries/base/tests/Concurrent/MVar001.stdout6
-rw-r--r--libraries/base/tests/Concurrent/all.T4
-rw-r--r--libraries/base/tests/IO/all.T3
-rw-r--r--libraries/base/tests/IO/concio002.hs14
-rw-r--r--libraries/base/tests/IO/concio002.stdout4
-rw-r--r--libraries/base/tests/IO/hClose003.hs42
-rw-r--r--libraries/base/tests/IO/hClose003.stdout4
-rw-r--r--libraries/base/tests/all.T3
-rw-r--r--libraries/base/tests/hWaitForInput-accurate-pipe.hs23
-rw-r--r--libraries/base/tests/hWaitForInput-accurate-pipe.stdout1
-rw-r--r--libraries/base/tests/hWaitForInput-accurate-socket.hs48
-rw-r--r--libraries/base/tests/hWaitForInput-accurate-socket.stdout1
-rw-r--r--libraries/base/tests/rand001.hs22
-rw-r--r--libraries/base/tests/rand001.stdout5
17 files changed, 0 insertions, 440 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
View Lorry Controller Status