Commit 165d3d5d authored by Vladislav Zavialov's avatar Vladislav Zavialov Committed by Ben Gamari
Browse files

Enable -Wcompat=error in the testsuite

Enabling -Werror=compat in the testsuite allows us to easily see the
impact that a new warning has on code. It also means that in the period
between adding the warning and making the actual breaking change, all
new test cases that are being added to the testsuite will be
forwards-compatible. This is good because it will make the actual
breaking change contain less irrelevant testsuite updates.

Things that -Wcompat warns about are things that are going to break in
the future, so we can be proactive and keep our testsuite
forwards-compatible.

This patch consists of two main changes:

* Add `TEST_HC_OPTS += -Werror=compat` to the testsuite configuration.
* Fix all broken test cases.

Test Plan: Validate

Reviewers: hvr, goldfire, bgamari, simonpj, RyanGlScott

Reviewed By: goldfire, RyanGlScott

Subscribers: rwbarton, carter

GHC Trac Issues: #15278

Differential Revision: https://phabricator.haskell.org/D5200
parent 058c2813
{-# LANGUAGE PolyKinds, DataKinds, KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses, TypeFamilies #-}
module CatPairs where
import Prelude hiding (id, (.))
import Data.Kind (Type)
import Control.Monad ((>=>))
import Control.Category
......@@ -9,8 +11,8 @@ import Control.Category
-- Taken from Twan van Laarhoven:
-- http://twanvl.nl/blog/haskell/categories-over-pairs-of-types
type family Fst (xy :: (*,*)) :: *
type family Snd (xy :: (*,*)) :: *
type family Fst (xy :: (Type, Type)) :: Type
type family Snd (xy :: (Type, Type)) :: Type
type instance Fst '(x,y) = x
type instance Snd '(x,y) = y
......
......@@ -53,6 +53,9 @@ TEST_HC_OPTS += -fdiagnostics-color=never
TEST_HC_OPTS += -fno-diagnostics-show-caret
endif
# See Trac #15278.
TEST_HC_OPTS += -Werror=compat
# Add the no-debug-output last as it is often convenient to copy the test invocation
# removing this line.
TEST_HC_OPTS += -dno-debug-output
......
......@@ -16,9 +16,10 @@ T10767.hs:43:1: Warning:
-}
import Data.Proxy
import Data.Kind (Type)
class SpecList a where
type List a :: *
type List a :: Type
slCase :: List a -> b -> (a -> List a -> b) -> b
......
......@@ -3,6 +3,8 @@
module T12944 () where
import Data.Kind (Type)
class AdditiveGroup v where
(^+^) :: v -> v -> v
negateV :: v -> v
......@@ -10,7 +12,7 @@ class AdditiveGroup v where
v ^-^ v' = v ^+^ negateV v'
class AdditiveGroup v => VectorSpace v where
type Scalar v :: *
type Scalar v :: Type
(*^) :: Scalar v -> v -> v
data Poly1 a = Poly1 a a
......
......@@ -3,6 +3,7 @@
-- runtime exception
{-# LANGUAGE NoMonadFailDesugaring #-}
{-# OPTIONS -Wno-missing-monadfail-instances #-}
import Control.Monad
import Data.Maybe
......
......@@ -6,7 +6,7 @@ import Data.Kind
data Proxy k (a :: k) = P
x :: Proxy * Int
x :: Proxy Type Int
x = P
y :: Proxy Bool True
......
......@@ -5,16 +5,16 @@ module Dep3 where
import Data.Kind
import GHC.Exts ( Constraint )
type Star1 = *
type Star1 = Type
data Id1 (a :: Star1) where
Id1 :: a -> Id1 a
data Id1' :: Star1 -> * where
data Id1' :: Star1 -> Type where
Id1' :: a -> Id1' a
type family Star2 x where
Star2 x = *
Star2 x = Type
data Id2a (a :: Star2 Constraint) = Id2a a
......@@ -22,5 +22,5 @@ data Id2a (a :: Star2 Constraint) = Id2a a
data Id2 (a :: Star2 Constraint) where
Id2 :: a -> Id2 a
data Id2' :: Star2 Constraint -> * where
data Id2' :: Star2 Constraint -> Type where
Id2' :: a -> Id2' a
......@@ -5,7 +5,7 @@ module KindEqualities where
import Data.Kind
data TyRep1 :: * -> * where
data TyRep1 :: Type -> Type where
TyInt1 :: TyRep1 Int
TyBool1 :: TyRep1 Bool
......@@ -15,13 +15,13 @@ zero1 TyBool1 = False
data Proxy (a :: k) = P
data TyRep :: forall k. k -> * where
data TyRep :: forall k. k -> Type where
TyInt :: TyRep Int
TyBool :: TyRep Bool
TyMaybe :: TyRep Maybe
TyApp :: TyRep a -> TyRep b -> TyRep (a b)
zero :: forall (a :: *). TyRep a -> a
zero :: forall (a :: Type). TyRep a -> a
zero TyInt = 0
zero TyBool = False
zero (TyApp TyMaybe _) = Nothing
......@@ -8,7 +8,7 @@ import GHC.Exts ( Any )
data Kind = Star | Arr Kind Kind
data Ty :: Kind -> * where
data Ty :: Kind -> Type where
TInt :: Ty Star
TBool :: Ty Star
TMaybe :: Ty (Arr Star Star)
......@@ -22,7 +22,7 @@ data TyRep (k :: Kind) (t :: Ty k) where
TyApp :: TyRep (Arr k1 k2) a -> TyRep k1 b -> TyRep k2 (TApp a b)
type family IK (k :: Kind)
type instance IK Star = *
type instance IK Star = Type
type instance IK (Arr k1 k2) = IK k1 -> IK k2
$(return []) -- necessary because the following instances depend on the
......
......@@ -5,7 +5,7 @@ module KindLevels where
import Data.Kind
data A
data B :: A -> *
data C :: B a -> *
data D :: C b -> *
data E :: D c -> *
data B :: A -> Type
data C :: B a -> Type
data D :: C b -> Type
data E :: D c -> Type
......@@ -104,7 +104,7 @@ type family Primitive (a :: k) :: Constraint where
Primitive _ = (() :: Constraint)
data TypeRep (a :: k) where
TyCon :: forall (a :: k). (Primitive a, Typeable k) => TyCon a -> TypeRep a
TyCon :: forall k (a :: k). (Primitive a, Typeable k) => TyCon a -> TypeRep a
TyApp :: TypeRep a -> TypeRep b -> TypeRep (a b)
-- Equality on TypeReps
......@@ -121,7 +121,7 @@ eqT _ _ = Nothing
-- Existentials
data TyConX where
TyConX :: forall (a :: k). (Primitive a, Typeable k) => TyCon a -> TyConX
TyConX :: forall k (a :: k). (Primitive a, Typeable k) => TyCon a -> TyConX
instance Read TyConX where
readsPrec _ "Int" = [(TyConX Int, "")]
......@@ -408,11 +408,11 @@ loadTable name schema = do
-- propositions. In Haskell, these inductively defined propositions take the form of
-- GADTs. In their original form, they would look like this:
{-
data InProof :: Column -> Schema -> * where
data InProof :: Column -> Schema -> Type where
InHere :: InProof col (col ': schTail)
InThere :: InProof col cols -> InProof col (a ': cols)
data SubsetProof :: Schema -> Schema -> * where
data SubsetProof :: Schema -> Schema -> Type where
SubsetEmpty :: SubsetProof '[] s'
SubsetCons :: InProof col s' -> SubsetProof cols s'
-> SubsetProof (col ': cols) s'
......
......@@ -3,6 +3,6 @@ module T11311 where
import Data.Kind
foo :: ()
foo = (id :: * -> *) undefined `seq` ()
foo = (id :: Type -> Type) undefined `seq` ()
main = print foo
......@@ -4,4 +4,4 @@ module T11635 where
import Data.Kind
data X (a :: forall k. k -> * ) b = X
data X (a :: forall k. k -> Type) b = X
{-# LANGUAGE ExplicitForAll, PolyKinds #-}
{-# OPTIONS -Wcompat #-}
{-# OPTIONS -Wcompat -Wno-error=implicit-kind-vars #-}
module T15264 where
......
......@@ -24,7 +24,7 @@ class SDecide k where
instance SDecide () where
test = undefined
test1 :: forall (a :: k). SDecide (Rep k) => Proxy a
test1 :: forall k (a :: k). SDecide (Rep k) => Proxy a
test1 = seq (test @_ @(PFrom a)) Proxy
test2 :: forall (a :: ()). Proxy a
......
......@@ -5,7 +5,7 @@ module T9632 where
import Data.Kind
data B = T | F
data P :: B -> *
data P :: B -> Type
type B' = B
data P' :: B' -> *
data P' :: B' -> Type
......@@ -5,5 +5,5 @@ module GADTVars where
import Data.Kind
import Data.Proxy
data T (k1 :: *) (k2 :: *) (a :: k2) (b :: k2) where
MkT :: T x1 * (Proxy (y :: x1), z) z
data T (k1 :: Type) (k2 :: Type) (a :: k2) (b :: k2) where
MkT :: T x1 Type (Proxy (y :: x1), z) z
......@@ -3,6 +3,6 @@ module T11311 where
import Data.Kind
foo :: ()
foo = (id :: * -> *) undefined `seq` ()
foo = (id :: Type -> Type) undefined `seq` ()
main = print foo
......@@ -8,7 +8,7 @@ import Data.Kind
type ConstantT a b = a
newtype T f (a :: ConstantT * f) = T (f a)
newtype T f (a :: ConstantT Type f) = T (f a)
deriving Functor
data family TFam1 (f :: k1) (a :: k2)
......@@ -16,5 +16,5 @@ newtype instance TFam1 f (ConstantT a f) = TFam1 (f a)
deriving Functor
data family TFam2 (f :: k1) (a :: k2)
newtype instance TFam2 f (a :: ConstantT * f) = TFam2 (f a)
newtype instance TFam2 f (a :: ConstantT Type f) = TFam2 (f a)
deriving Functor
......@@ -6,15 +6,15 @@ module T11732c where
import Data.Kind
class Cat k (cat :: k -> k -> *) where
class Cat k (cat :: k -> k -> Type) where
catId :: cat a a
catComp :: cat b c -> cat a b -> cat a c
instance Cat * (->) where
instance Cat Type (->) where
catId = id
catComp = (.)
newtype Fun2 a b = Fun2 (a -> b) deriving (Cat *)
newtype Fun2 a b = Fun2 (a -> b) deriving (Cat Type)
-- The ticket says this should work:
-- newtype Fun1 a b = Fun1 (a -> b) deriving (Cat k)
......
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