[commit: ghc] master: Fix typecheck tests (--slow) (ca478ac)
git at git.haskell.org
git at git.haskell.org
Mon Mar 2 17:16:07 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/ca478acc3825852320abc45ed6bc8efa4e869ff3/ghc
>---------------------------------------------------------------
commit ca478acc3825852320abc45ed6bc8efa4e869ff3
Author: Thomas Miedema <thomasmiedema at gmail.com>
Date: Mon Mar 2 11:09:50 2015 -0600
Fix typecheck tests (--slow)
Summary:
Fallout from AMP, recent addition of -fwarn-redundant-constraints and others.
Some of these tests need `mtl` or `syb` to run.
Reviewers: austin
Reviewed By: austin
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D684
>---------------------------------------------------------------
ca478acc3825852320abc45ed6bc8efa4e869ff3
testsuite/tests/typecheck/should_compile/T4355.hs | 1 +
testsuite/tests/typecheck/should_compile/T4355.stderr | 4 ++--
testsuite/tests/typecheck/should_compile/tc223.hs | 1 +
testsuite/tests/typecheck/should_compile/tc232.hs | 8 ++++++++
testsuite/tests/typecheck/should_fail/tcfail126.hs | 1 +
testsuite/tests/typecheck/should_run/T4809_IdentityT.hs | 4 ++++
testsuite/tests/typecheck/should_run/T4809_XMLGenerator.hs | 8 ++++++++
testsuite/tests/typecheck/should_run/T9497a-run.stderr | 1 +
testsuite/tests/typecheck/should_run/T9497b-run.stderr | 1 +
testsuite/tests/typecheck/should_run/T9497c-run.stderr | 1 +
testsuite/tests/typecheck/should_run/tcrun045.stderr | 2 +-
11 files changed, 29 insertions(+), 3 deletions(-)
diff --git a/testsuite/tests/typecheck/should_compile/T4355.hs b/testsuite/tests/typecheck/should_compile/T4355.hs
index 712430d..7aecd2a 100644
--- a/testsuite/tests/typecheck/should_compile/T4355.hs
+++ b/testsuite/tests/typecheck/should_compile/T4355.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fno-warn-redundant-constraints -fno-warn-missing-methods #-}
{-# LANGUAGE DeriveDataTypeable, ExistentialQuantification, RankNTypes, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, FlexibleContexts, PatternGuards, DatatypeContexts #-}
module T4355 where
diff --git a/testsuite/tests/typecheck/should_compile/T4355.stderr b/testsuite/tests/typecheck/should_compile/T4355.stderr
index af072e6..a977ce0 100644
--- a/testsuite/tests/typecheck/should_compile/T4355.stderr
+++ b/testsuite/tests/typecheck/should_compile/T4355.stderr
@@ -1,3 +1,3 @@
-T4355.hs:1:172:
- Warning: -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
+T4355.hs:2:172: Warning:
+ -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
diff --git a/testsuite/tests/typecheck/should_compile/tc223.hs b/testsuite/tests/typecheck/should_compile/tc223.hs
index bf04ba3..fc8a9d1 100644
--- a/testsuite/tests/typecheck/should_compile/tc223.hs
+++ b/testsuite/tests/typecheck/should_compile/tc223.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fno-warn-deprecations #-}
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
module Foo where
diff --git a/testsuite/tests/typecheck/should_compile/tc232.hs b/testsuite/tests/typecheck/should_compile/tc232.hs
index c9f23d4..0e6450b 100644
--- a/testsuite/tests/typecheck/should_compile/tc232.hs
+++ b/testsuite/tests/typecheck/should_compile/tc232.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
-- This one foxed the constraint solver (Lint error)
-- See Trac #1494
@@ -8,6 +9,13 @@ import Control.Monad.State
newtype L m r = L (StateT Int m r)
+instance Functor (L m) where
+ fmap = undefined
+
+instance Applicative (L m) where
+ pure = undefined
+ (<*>) = undefined
+
instance Monad m => Monad (L m) where
(>>=) = undefined
return = undefined
diff --git a/testsuite/tests/typecheck/should_fail/tcfail126.hs b/testsuite/tests/typecheck/should_fail/tcfail126.hs
index 1ef2b48..20b0f55 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail126.hs
+++ b/testsuite/tests/typecheck/should_fail/tcfail126.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
{-# LANGUAGE RankNTypes, ExistentialQuantification #-}
-- An interesting interaction of universals and existentials, prompted by
diff --git a/testsuite/tests/typecheck/should_run/T4809_IdentityT.hs b/testsuite/tests/typecheck/should_run/T4809_IdentityT.hs
index 879dada..0289dec 100644
--- a/testsuite/tests/typecheck/should_run/T4809_IdentityT.hs
+++ b/testsuite/tests/typecheck/should_run/T4809_IdentityT.hs
@@ -6,6 +6,7 @@ module T4809_IdentityT
, XML(..)
) where
+import Control.Applicative
import Control.Monad (MonadPlus)
import Control.Monad.Trans (MonadTrans(lift), MonadIO(liftIO))
import T4809_XMLGenerator (XMLGenT(..), EmbedAsChild(..), Name)
@@ -20,6 +21,9 @@ data XML
newtype IdentityT m a = IdentityT { runIdentityT :: m a }
deriving (Functor, Monad, MonadIO, MonadPlus)
+instance Monad m => Applicative (IdentityT m) where
+instance Monad m => Alternative (IdentityT m) where
+
instance MonadTrans IdentityT where
lift = IdentityT
diff --git a/testsuite/tests/typecheck/should_run/T4809_XMLGenerator.hs b/testsuite/tests/typecheck/should_run/T4809_XMLGenerator.hs
index 9ee37e8..1b5cbfe 100644
--- a/testsuite/tests/typecheck/should_run/T4809_XMLGenerator.hs
+++ b/testsuite/tests/typecheck/should_run/T4809_XMLGenerator.hs
@@ -18,6 +18,8 @@
-----------------------------------------------------------------------------
module T4809_XMLGenerator where
+import Control.Applicative
+import Control.Monad
import Control.Monad.Trans
import Control.Monad.Cont (MonadCont)
import Control.Monad.Error (MonadError)
@@ -35,6 +37,12 @@ newtype XMLGenT m a = XMLGenT (m a)
deriving (Monad, Functor, MonadIO, MonadPlus, MonadWriter w, MonadReader r,
MonadState s, MonadRWS r w s, MonadCont, MonadError e)
+instance Monad m => Applicative (XMLGenT m) where
+ pure = return
+ (<*>) = ap
+
+instance Monad m => Alternative (XMLGenT m) where
+
-- | un-lift.
unXMLGenT :: XMLGenT m a -> m a
unXMLGenT (XMLGenT ma) = ma
diff --git a/testsuite/tests/typecheck/should_run/T9497a-run.stderr b/testsuite/tests/typecheck/should_run/T9497a-run.stderr
index aae24cf..192f78f 100644
--- a/testsuite/tests/typecheck/should_run/T9497a-run.stderr
+++ b/testsuite/tests/typecheck/should_run/T9497a-run.stderr
@@ -1,5 +1,6 @@
T9497a-run: T9497a-run.hs:2:8:
Found hole ‘_main’ with type: IO ()
+ Or perhaps ‘_main’ is mis-spelled, or not in scope
Relevant bindings include
main :: IO () (bound at T9497a-run.hs:2:1)
In the expression: _main
diff --git a/testsuite/tests/typecheck/should_run/T9497b-run.stderr b/testsuite/tests/typecheck/should_run/T9497b-run.stderr
index 62d858f..a53262e 100644
--- a/testsuite/tests/typecheck/should_run/T9497b-run.stderr
+++ b/testsuite/tests/typecheck/should_run/T9497b-run.stderr
@@ -1,5 +1,6 @@
T9497b-run: T9497b-run.hs:2:8:
Found hole ‘_main’ with type: IO ()
+ Or perhaps ‘_main’ is mis-spelled, or not in scope
Relevant bindings include
main :: IO () (bound at T9497b-run.hs:2:1)
In the expression: _main
diff --git a/testsuite/tests/typecheck/should_run/T9497c-run.stderr b/testsuite/tests/typecheck/should_run/T9497c-run.stderr
index be5d947..f991cd6 100644
--- a/testsuite/tests/typecheck/should_run/T9497c-run.stderr
+++ b/testsuite/tests/typecheck/should_run/T9497c-run.stderr
@@ -1,5 +1,6 @@
T9497c-run: T9497c-run.hs:2:8:
Found hole ‘_main’ with type: IO ()
+ Or perhaps ‘_main’ is mis-spelled, or not in scope
Relevant bindings include
main :: IO () (bound at T9497c-run.hs:2:1)
In the expression: _main
diff --git a/testsuite/tests/typecheck/should_run/tcrun045.stderr b/testsuite/tests/typecheck/should_run/tcrun045.stderr
index 4017279..c7a6616 100644
--- a/testsuite/tests/typecheck/should_run/tcrun045.stderr
+++ b/testsuite/tests/typecheck/should_run/tcrun045.stderr
@@ -1,6 +1,6 @@
tcrun045.hs:24:1:
Illegal implicit parameter ‘?imp::Int’
- In the context: (?imp::Int)
+ In the context: ?imp::Int
While checking the super-classes of class ‘D’
In the class declaration for ‘D’
More information about the ghc-commits
mailing list