Commit dadf82d6 authored by thomie's avatar thomie

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.
parent e8c04d4c
import Debug.QuickCheck
import Test.QuickCheck
import System.IO.Unsafe
import Control.Concurrent.Chan
import Control.Concurrent
......
0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests.
0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests.
0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests.
+++ OK, passed 100 tests.
+++ OK, passed 100 tests.
+++ OK, passed 100 tests.
import Debug.QuickCheck
import Test.QuickCheck
import System.IO.Unsafe
import Control.Concurrent.MVar
import Control.Concurrent
......
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.
Subproject commit 0741f656fdadc14960f55e1970080d4699371055
Subproject commit fbe2b7b9e163daa8fbe3c8f2dddc1132aa4e735f
......@@ -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, [''])
......
{-# 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")
"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
......@@ -2,7 +2,7 @@
module Main where
import Data.Generics
import Data.Generics hiding (ext2Q)
data MyMaybe a = MyNothing | MyJust a deriving (Data, Typeable)
......
......@@ -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))
......
T3787.hs:20:51: warning:
-XOverlappingInstances is deprecated: instead use per-instance pragmas OVERLAPPING/OVERLAPPABLE/OVERLAPS
......@@ -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 ()
......
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()
-- 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
......
......@@ -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
......
......@@ -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
......
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 }
{-# 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
......
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