diff options
author | Thomas Miedema <thomasmiedema@gmail.com> | 2016-04-25 16:58:34 +0200 |
---|---|---|
committer | Thomas Miedema <thomasmiedema@gmail.com> | 2016-04-26 10:50:05 +0200 |
commit | dadf82d61f3cced61e9ccc35a5219e0b32cfee9e (patch) | |
tree | 5cedbbc76fcb69f1dda1be2b131fd5be0c64f08c | |
parent | e8c04d4ca5c78c6b68dab840ea53af42eee99364 (diff) | |
download | haskell-dadf82d61f3cced61e9ccc35a5219e0b32cfee9e.tar.gz |
Testsuite: fixup lots of tests
These aren't run very often, because they require external libraries.
https://ghc.haskell.org/trac/ghc/wiki/Building/RunningTests/Running#AdditionalPackages
maessen-hashtab still doesn't compile, QuickCheck api changed.
Update submodule hpc.
-rw-r--r-- | libraries/base/tests/Concurrent/Chan001.hs | 2 | ||||
-rw-r--r-- | libraries/base/tests/Concurrent/Chan001.stdout | 6 | ||||
-rw-r--r-- | libraries/base/tests/Concurrent/MVar001.hs | 2 | ||||
-rw-r--r-- | libraries/base/tests/Concurrent/MVar001.stdout | 12 | ||||
m--------- | libraries/hpc | 0 | ||||
-rw-r--r-- | testsuite/tests/codeGen/should_run/all.T | 2 | ||||
-rw-r--r-- | testsuite/tests/codeGen/should_run/cgrun025.hs | 12 | ||||
-rw-r--r-- | testsuite/tests/codeGen/should_run/cgrun025.stderr | 12 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_run/T3087.hs | 2 | ||||
-rw-r--r-- | testsuite/tests/indexed-types/should_compile/T3787.hs | 11 | ||||
-rw-r--r-- | testsuite/tests/indexed-types/should_compile/T3787.stderr | 3 | ||||
-rw-r--r-- | testsuite/tests/module/T1074.hs | 1 | ||||
-rw-r--r-- | testsuite/tests/module/T1074.stderr | 6 | ||||
-rw-r--r-- | testsuite/tests/module/mod133.hs | 14 | ||||
-rw-r--r-- | testsuite/tests/programs/galois_raytrace/Eval.hs | 19 | ||||
-rw-r--r-- | testsuite/tests/programs/maessen-hashtab/HashTest.hs | 9 | ||||
-rw-r--r-- | testsuite/tests/rebindable/DoParamM.stderr | 62 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_compile/tc232.hs | 2 |
18 files changed, 105 insertions, 72 deletions
diff --git a/libraries/base/tests/Concurrent/Chan001.hs b/libraries/base/tests/Concurrent/Chan001.hs index ad3b8ff8d6..e1b164e586 100644 --- a/libraries/base/tests/Concurrent/Chan001.hs +++ b/libraries/base/tests/Concurrent/Chan001.hs @@ -1,4 +1,4 @@ -import Debug.QuickCheck +import Test.QuickCheck import System.IO.Unsafe import Control.Concurrent.Chan import Control.Concurrent diff --git a/libraries/base/tests/Concurrent/Chan001.stdout b/libraries/base/tests/Concurrent/Chan001.stdout index 53bfa8a381..ab7b91a0bc 100644 --- a/libraries/base/tests/Concurrent/Chan001.stdout +++ b/libraries/base/tests/Concurrent/Chan001.stdout @@ -1,3 +1,3 @@ -0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests. -0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests. -0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests. ++++ 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 index 5c0c160b18..6062cbfa46 100644 --- a/libraries/base/tests/Concurrent/MVar001.hs +++ b/libraries/base/tests/Concurrent/MVar001.hs @@ -1,4 +1,4 @@ -import Debug.QuickCheck +import Test.QuickCheck import System.IO.Unsafe import Control.Concurrent.MVar import Control.Concurrent diff --git a/libraries/base/tests/Concurrent/MVar001.stdout b/libraries/base/tests/Concurrent/MVar001.stdout index 65be56c733..9430cca9d6 100644 --- a/libraries/base/tests/Concurrent/MVar001.stdout +++ b/libraries/base/tests/Concurrent/MVar001.stdout @@ -1,6 +1,6 @@ -0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests. -0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests. -0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests. -0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests. -0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests. -0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests. ++++ 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/hpc b/libraries/hpc -Subproject 0741f656fdadc14960f55e1970080d469937105 +Subproject fbe2b7b9e163daa8fbe3c8f2dddc1132aa4e735 diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T index c91395105a..1175f222e3 100644 --- a/testsuite/tests/codeGen/should_run/all.T +++ b/testsuite/tests/codeGen/should_run/all.T @@ -25,7 +25,7 @@ test('cgrun021', normal, compile_and_run, ['']) test('cgrun022', normal, compile_and_run, ['']) test('cgrun024', normal, compile_and_run, ['']) test('cgrun025', - [reqlib('regex-compat'), extra_run_opts('cg025.hs'), exit_code(1)], + [reqlib('regex-compat'), extra_run_opts('cgrun025.hs'), exit_code(1)], compile_and_run, ['-package regex-compat']) test('cgrun026', normal, compile_and_run, ['']) test('cgrun027', normal, compile_and_run, ['']) diff --git a/testsuite/tests/codeGen/should_run/cgrun025.hs b/testsuite/tests/codeGen/should_run/cgrun025.hs index 8df8945088..f9633ee204 100644 --- a/testsuite/tests/codeGen/should_run/cgrun025.hs +++ b/testsuite/tests/codeGen/should_run/cgrun025.hs @@ -1,15 +1,17 @@ +{-# LANGUAGE ScopedTypeVariables #-} -- !!! test various I/O Requests -- -- -import IO -import System +import Control.Exception +import System.Environment +import System.IO import Debug.Trace (trace) import Text.Regex -import Maybe +import Data.Maybe main = do prog <- getProgName - let Just (name:_) = matchRegex (mkRegex ".*(cg025)") prog + let Just (name:_) = matchRegex (mkRegex ".*(cgrun025)") prog hPutStr stderr (shows name "\n") args <- getArgs hPutStr stderr (shows args "\n") @@ -20,4 +22,4 @@ main = do file_cts <- readFile (head args) hPutStr stderr file_cts trace "hello, trace" $ - catch (getEnv "__WURBLE__" >> return ()) (\ e -> error "hello, error") + catch (getEnv "__WURBLE__" >> return ()) (\ (e :: SomeException) -> error "hello, error") diff --git a/testsuite/tests/codeGen/should_run/cgrun025.stderr b/testsuite/tests/codeGen/should_run/cgrun025.stderr index a62fc44c04..2668913b85 100644 --- a/testsuite/tests/codeGen/should_run/cgrun025.stderr +++ b/testsuite/tests/codeGen/should_run/cgrun025.stderr @@ -1,14 +1,16 @@ "cgrun025" ["cgrun025.hs"] GOT PATH +{-# LANGUAGE ScopedTypeVariables #-} -- !!! test various I/O Requests -- -- -import IO -import System +import Control.Exception +import System.Environment +import System.IO import Debug.Trace (trace) import Text.Regex -import Maybe +import Data.Maybe main = do prog <- getProgName @@ -23,6 +25,8 @@ main = do file_cts <- readFile (head args) hPutStr stderr file_cts trace "hello, trace" $ - catch (getEnv "__WURBLE__" >> return ()) (\ e -> error "hello, error") + catch (getEnv "__WURBLE__" >> return ()) (\ (e :: SomeException) -> error "hello, error") hello, trace cgrun025: hello, error +CallStack (from HasCallStack): + error, called at cgrun025.hs:25:75 in main:Main diff --git a/testsuite/tests/deriving/should_run/T3087.hs b/testsuite/tests/deriving/should_run/T3087.hs index 7cba3d9609..9d3be0744d 100644 --- a/testsuite/tests/deriving/should_run/T3087.hs +++ b/testsuite/tests/deriving/should_run/T3087.hs @@ -2,7 +2,7 @@ module Main where -import Data.Generics +import Data.Generics hiding (ext2Q) data MyMaybe a = MyNothing | MyJust a deriving (Data, Typeable) diff --git a/testsuite/tests/indexed-types/should_compile/T3787.hs b/testsuite/tests/indexed-types/should_compile/T3787.hs index a52c27f4d5..9c679f840e 100644 --- a/testsuite/tests/indexed-types/should_compile/T3787.hs +++ b/testsuite/tests/indexed-types/should_compile/T3787.hs @@ -24,7 +24,7 @@ module T3787 where import Control.Concurrent (forkIO) import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar) -import Control.Monad (liftM, liftM2, when) +import Control.Monad (liftM, liftM2, when, ap) import Control.Monad.Identity import Control.Monad.Trans (MonadTrans(..)) @@ -77,8 +77,15 @@ data TrampolineState s m r = -- | Computation is suspended, its remainder is embedded in the functor /s/. | Suspend! (s (Trampoline s m r)) +instance (Functor s, Monad m) => Functor (Trampoline s m) where + fmap = liftM + +instance (Functor s, Monad m) => Applicative (Trampoline s m) where + pure x = Trampoline (pure (Done x)) + (<*>) = ap + instance (Functor s, Monad m) => Monad (Trampoline s m) where - return x = Trampoline (return (Done x)) + return = pure t >>= f = Trampoline (bounce t >>= apply f) where apply f (Done x) = bounce (f x) apply f (Suspend s) = return (Suspend (fmap (>>= f) s)) diff --git a/testsuite/tests/indexed-types/should_compile/T3787.stderr b/testsuite/tests/indexed-types/should_compile/T3787.stderr new file mode 100644 index 0000000000..e4da42e230 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T3787.stderr @@ -0,0 +1,3 @@ + +T3787.hs:20:51: warning: + -XOverlappingInstances is deprecated: instead use per-instance pragmas OVERLAPPING/OVERLAPPABLE/OVERLAPS diff --git a/testsuite/tests/module/T1074.hs b/testsuite/tests/module/T1074.hs index 75a07c13f4..ece70bf9df 100644 --- a/testsuite/tests/module/T1074.hs +++ b/testsuite/tests/module/T1074.hs @@ -2,6 +2,7 @@ module Test where import qualified Control.Monad (ap) +-- Test that GHC warns about the following unused import: import qualified Control.Monad.Reader foo :: IO () diff --git a/testsuite/tests/module/T1074.stderr b/testsuite/tests/module/T1074.stderr index 53b33604b9..14e56e8c07 100644 --- a/testsuite/tests/module/T1074.stderr +++ b/testsuite/tests/module/T1074.stderr @@ -1,5 +1,5 @@ -T1074.hs:5:1: Warning: - The qualified import of `Control.Monad.Reader' is redundant - except perhaps to import instances from `Control.Monad.Reader' +T1074.hs:6:1: warning: [-Wunused-imports (in -Wextra)] + The qualified import of ‘Control.Monad.Reader’ is redundant + except perhaps to import instances from ‘Control.Monad.Reader’ To import instances alone, use: import Control.Monad.Reader() diff --git a/testsuite/tests/module/mod133.hs b/testsuite/tests/module/mod133.hs index be05057ac9..f56ec1d02d 100644 --- a/testsuite/tests/module/mod133.hs +++ b/testsuite/tests/module/mod133.hs @@ -1,16 +1,24 @@ --- Control.Monad.Error re-exports Control.Monad.Fix. +-- Control.Monad.Except re-exports Control.Monad.Fix. -- This test checks that the subordinate-name test -- for a class operation (when renaming the instance decl) -- works correctly. module ShouldCompile where -import Control.Monad.Error +import Control.Monad +import Control.Monad.Except data Foo a = Foo a +instance Functor Foo where + fmap = liftM + +instance Applicative Foo where + pure = Foo + (<*>) = ap + instance Monad Foo where - return a = Foo a + return = pure (Foo a) >>= k = k a instance MonadFix Foo where diff --git a/testsuite/tests/programs/galois_raytrace/Eval.hs b/testsuite/tests/programs/galois_raytrace/Eval.hs index 5939d4750b..bd9d419400 100644 --- a/testsuite/tests/programs/galois_raytrace/Eval.hs +++ b/testsuite/tests/programs/galois_raytrace/Eval.hs @@ -5,6 +5,7 @@ module Eval where +import Control.Monad import Data.Array import Geometry @@ -22,9 +23,16 @@ class Monad m => MonadEval m where newtype Pure a = Pure a deriving Show +instance Functor Pure where + fmap = liftM + +instance Applicative Pure where + pure = Pure + (<*>) = ap + instance Monad Pure where Pure x >>= k = k x - return = Pure + return = pure fail s = error s instance MonadEval Pure where @@ -286,11 +294,18 @@ newtype Abs a = Abs { runAbs :: Int -> AbsState a } data AbsState a = AbsState a !Int | AbsFail String +instance Functor Abs where + fmap = liftM + +instance Applicative Abs where + pure x = Abs (\ n -> AbsState x n) + (<*>) = ap + instance Monad Abs where (Abs fn) >>= k = Abs (\ s -> case fn s of AbsState r s' -> runAbs (k r) s' AbsFail m -> AbsFail m) - return x = Abs (\ n -> AbsState x n) + return = pure fail s = Abs (\ n -> AbsFail s) instance MonadEval Abs where diff --git a/testsuite/tests/programs/maessen-hashtab/HashTest.hs b/testsuite/tests/programs/maessen-hashtab/HashTest.hs index 51c60c0640..59795bb89e 100644 --- a/testsuite/tests/programs/maessen-hashtab/HashTest.hs +++ b/testsuite/tests/programs/maessen-hashtab/HashTest.hs @@ -34,7 +34,6 @@ instance Arbitrary Action where (5, liftM2 Insert arbitrary arbitrary), (3, liftM2 Update arbitrary arbitrary), (1, fmap Delete arbitrary)] - coarbitrary = error "coarbitrary Action" simA :: [Action] -> [Either Bool [Int]] simA = fst . foldl sim ([],[]) @@ -94,12 +93,10 @@ instance Show a => Show (List a) where instance Arbitrary HashFun where arbitrary = frequency [(20,return (HF hashInt)), (1,return (HF (const 0)))] - coarbitrary = error "coarbitrary HashFun" instance Arbitrary Empty where arbitrary = fmap mkE arbitrary where mkE (HF hf) = E {e = new (==) hf, hfe=HF hf} - coarbitrary = error "coarbitrary Empty" instance Arbitrary a => Arbitrary (List a) where arbitrary = do @@ -107,7 +104,6 @@ instance Arbitrary a => Arbitrary (List a) where (1,return (4096*2)), (0, return (1024*1024))] resize sz $ fmap L $ sized vector - coarbitrary = error "coarbitrary (List a)" instance Arbitrary MkH where arbitrary = do @@ -115,7 +111,6 @@ instance Arbitrary MkH where L list <- arbitrary let mkH act = H { h = act, hfh = hf } return (mkH . fromList (unHF hf) $ list) - coarbitrary = error "coarbitrary MkH" (==~) :: (Eq a) => IO a -> IO a -> Bool act1 ==~ act2 = unsafePerformIO act1 == unsafePerformIO act2 @@ -251,9 +246,7 @@ te :: (Testable a) => String -> a -> IO () -- te name prop = putStrLn name >> verboseCheck prop te name prop = do putStr name - check (defaultConfig{configMaxTest = 500, - configMaxFail = 10000, - configEvery = \_ _ -> "" }) prop + quickCheckWith stdArgs { maxSuccess = 500, maxSize = 10000 } prop main :: IO () main = do diff --git a/testsuite/tests/rebindable/DoParamM.stderr b/testsuite/tests/rebindable/DoParamM.stderr index 09d2370737..6328d086b6 100644 --- a/testsuite/tests/rebindable/DoParamM.stderr +++ b/testsuite/tests/rebindable/DoParamM.stderr @@ -1,34 +1,34 @@ -DoParamM.hs:146:25: - Couldn't match expected type `Int' with actual type `Char' - In the second argument of `(==)', namely v' - In the first argument of `return', namely `(v == v')' - In a stmt of a 'do' block: return (v == v') +DoParamM.hs:146:25: error: + • Couldn't match expected type ‘Int’ with actual type ‘Char’ + • In the second argument of ‘(==)’, namely ‘v'’ + In the first argument of ‘return’, namely ‘(v == v')’ + In a stmt of a 'do' block: return (v == v') -DoParamM.hs:286:28: - Couldn't match type `Unlocked' with `Locked' - Expected type: LIO Locked Locked () - Actual type: LIO Unlocked Locked () - In a stmt of a 'do' block: tlock2_do - In the expression: - do { tlock2_do; - tlock2_do } - In an equation for `tlock4_do': - tlock4_do - = do { tlock2_do; - tlock2_do } +DoParamM.hs:286:28: error: + • Couldn't match type ‘Unlocked’ with ‘Locked’ + Expected type: LIO Locked Locked () + Actual type: LIO Unlocked Locked () + • In a stmt of a 'do' block: tlock2_do + In the expression: + do { tlock2_do; + tlock2_do } + In an equation for ‘tlock4_do’: + tlock4_do + = do { tlock2_do; + tlock2_do } -DoParamM.hs:302:37: - Couldn't match type `Locked' with `Unlocked' - Expected type: LIO Unlocked Unlocked () - Actual type: LIO Locked Unlocked () - In a stmt of a 'do' block: unlock - In the expression: - do { tlock2_do; - unlock; - unlock } - In an equation for `tlock4'_do': - tlock4'_do - = do { tlock2_do; - unlock; - unlock } +DoParamM.hs:302:37: error: + • Couldn't match type ‘Locked’ with ‘Unlocked’ + Expected type: LIO Unlocked Unlocked () + Actual type: LIO Locked Unlocked () + • In a stmt of a 'do' block: unlock + In the expression: + do { tlock2_do; + unlock; + unlock } + In an equation for ‘tlock4'_do’: + tlock4'_do + = do { tlock2_do; + unlock; + unlock } diff --git a/testsuite/tests/typecheck/should_compile/tc232.hs b/testsuite/tests/typecheck/should_compile/tc232.hs index 0e6450b066..9d5ede32c8 100644 --- a/testsuite/tests/typecheck/should_compile/tc232.hs +++ b/testsuite/tests/typecheck/should_compile/tc232.hs @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} --- This one foxed the constraint solver (Lint error) +-- This one fixed the constraint solver (Lint error) -- See Trac #1494 module ShouldCompile where |