diff options
Diffstat (limited to 'testsuite/tests')
43 files changed, 91 insertions, 26 deletions
diff --git a/testsuite/tests/backpack/should_fail/bkpfail23.bkp b/testsuite/tests/backpack/should_fail/bkpfail23.bkp index 831ce42c72..55e533390c 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail23.bkp +++ b/testsuite/tests/backpack/should_fail/bkpfail23.bkp @@ -1,5 +1,5 @@ {-# LANGUAGE Haskell2010 #-} -{-# LANGUAGE GADTs, RoleAnnotations #-} +{-# LANGUAGE GADTs, TypeOperators, RoleAnnotations #-} unit p where signature H where type role F phantom diff --git a/testsuite/tests/deriving/should_compile/T14933.hs b/testsuite/tests/deriving/should_compile/T14933.hs index 5ab808365f..854f5f717a 100644 --- a/testsuite/tests/deriving/should_compile/T14933.hs +++ b/testsuite/tests/deriving/should_compile/T14933.hs @@ -2,9 +2,12 @@ {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + module T14933 where import Data.Kind (Type) +import Data.Type.Equality (type (~)) class Wrapped s where type Unwrapped s :: Type diff --git a/testsuite/tests/ghci/scripts/T12447.script b/testsuite/tests/ghci/scripts/T12447.script index 826dec0b63..3a30c65905 100644 --- a/testsuite/tests/ghci/scripts/T12447.script +++ b/testsuite/tests/ghci/scripts/T12447.script @@ -1,5 +1,5 @@ :set -XHaskell2010 -:set -XRankNTypes -XConstraintKinds -XTypeApplications +:set -XRankNTypes -XConstraintKinds -XTypeApplications -XTypeOperators import Data.Typeable diff --git a/testsuite/tests/ghci/scripts/ghci024.stdout b/testsuite/tests/ghci/scripts/ghci024.stdout index 20750f5817..db6a7b955e 100644 --- a/testsuite/tests/ghci/scripts/ghci024.stdout +++ b/testsuite/tests/ghci/scripts/ghci024.stdout @@ -16,6 +16,7 @@ warning settings: -Wsemigroup -Wstar-is-type -Wcompat-unqualified-imports + -Wtype-equality-out-of-scope ~~~~~~~~~~ Testing :set -a options currently set: none. base language is: GHC2021 diff --git a/testsuite/tests/ghci/scripts/ghci024.stdout-mingw32 b/testsuite/tests/ghci/scripts/ghci024.stdout-mingw32 index 1c03e5fab8..a693b73aaf 100644 --- a/testsuite/tests/ghci/scripts/ghci024.stdout-mingw32 +++ b/testsuite/tests/ghci/scripts/ghci024.stdout-mingw32 @@ -15,6 +15,7 @@ warning settings: -Wsemigroup -Wstar-is-type -Wcompat-unqualified-imports + -Wtype-equality-out-of-scope ~~~~~~~~~~ Testing :set -a options currently set: none. base language is: GHC2021 diff --git a/testsuite/tests/indexed-types/should_compile/InstEqContext2.hs b/testsuite/tests/indexed-types/should_compile/InstEqContext2.hs index ea356a44ad..f693837354 100644 --- a/testsuite/tests/indexed-types/should_compile/InstEqContext2.hs +++ b/testsuite/tests/indexed-types/should_compile/InstEqContext2.hs @@ -1,6 +1,6 @@ {-# LANGUAGE Haskell2010 #-} {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} -{-# LANGUAGE TypeFamilies, EmptyDataDecls #-} +{-# LANGUAGE TypeFamilies, TypeOperators, EmptyDataDecls #-} module InstEqContext2 where diff --git a/testsuite/tests/indexed-types/should_compile/T11361.hs b/testsuite/tests/indexed-types/should_compile/T11361.hs index 7534734790..d2dc75fe8f 100644 --- a/testsuite/tests/indexed-types/should_compile/T11361.hs +++ b/testsuite/tests/indexed-types/should_compile/T11361.hs @@ -1,5 +1,6 @@ {-# LANGUAGE Haskell2010 #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -- this is needed because |FamHelper a x| /< |Fam a x| -- This file compiled with -dunique-increment=-1 made GHC crash before diff --git a/testsuite/tests/indexed-types/should_compile/T15122.hs b/testsuite/tests/indexed-types/should_compile/T15122.hs index 49a3de642d..1730f3a826 100644 --- a/testsuite/tests/indexed-types/should_compile/T15122.hs +++ b/testsuite/tests/indexed-types/should_compile/T15122.hs @@ -1,6 +1,7 @@ {-# LANGUAGE Haskell2010 #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeInType #-} module T15122 where diff --git a/testsuite/tests/indexed-types/should_compile/T15352.hs b/testsuite/tests/indexed-types/should_compile/T15352.hs index 25c4640809..0bb4a2bc63 100644 --- a/testsuite/tests/indexed-types/should_compile/T15352.hs +++ b/testsuite/tests/indexed-types/should_compile/T15352.hs @@ -2,6 +2,7 @@ {-# LANGUAGE TypeInType #-} -- or PolyKinds {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} module T15352 where diff --git a/testsuite/tests/parser/should_fail/T12811.stderr b/testsuite/tests/parser/should_fail/T12811.stderr index 3dbf6bc342..ec4c79bef9 100644 --- a/testsuite/tests/parser/should_fail/T12811.stderr +++ b/testsuite/tests/parser/should_fail/T12811.stderr @@ -1,6 +1,6 @@ T12811.hs:5:15: error: Illegal operator ‘.’ in type ‘foral a . a’ - Use TypeOperators to allow operators in types + Suggested fix: Perhaps you intended to use TypeOperators T12811.hs:5:15: error: Not in scope: type constructor or class ‘.’ diff --git a/testsuite/tests/parser/should_fail/T15209.stderr b/testsuite/tests/parser/should_fail/T15209.stderr index 9d1e151cf2..fe1666c37e 100644 --- a/testsuite/tests/parser/should_fail/T15209.stderr +++ b/testsuite/tests/parser/should_fail/T15209.stderr @@ -1,2 +1,4 @@ -T15209.hs:6:10: error: Not in scope: type constructor or class ‘~#’ +T15209.hs:6:10: error: + Not in scope: type constructor or class ‘~#’ + Suggested fix: Perhaps use ‘~’ (imported from Prelude) diff --git a/testsuite/tests/partial-sigs/should_fail/T14584.hs b/testsuite/tests/partial-sigs/should_fail/T14584.hs index 1615b26205..077c80c490 100644 --- a/testsuite/tests/partial-sigs/should_fail/T14584.hs +++ b/testsuite/tests/partial-sigs/should_fail/T14584.hs @@ -25,6 +25,7 @@ module T14584 where import Data.Monoid import Data.Kind +import Data.Type.Equality data family Sing (a::k) diff --git a/testsuite/tests/partial-sigs/should_fail/T14584.stderr b/testsuite/tests/partial-sigs/should_fail/T14584.stderr index 7a47f25967..2cc457e635 100644 --- a/testsuite/tests/partial-sigs/should_fail/T14584.stderr +++ b/testsuite/tests/partial-sigs/should_fail/T14584.stderr @@ -1,25 +1,25 @@ -T14584.hs:56:50: warning: [-Wdeferred-type-errors (in -Wdefault)] +T14584.hs:57:50: warning: [-Wdeferred-type-errors (in -Wdefault)] • Could not deduce (m1 ~ *) from the context: (Action act, Monoid a, Good m1) - bound by the instance declaration at T14584.hs:54:10-89 + bound by the instance declaration at T14584.hs:55:10-89 ‘m1’ is a rigid type variable bound by the instance declaration - at T14584.hs:54:10-89 + at T14584.hs:55:10-89 • In the type ‘a’ In the second argument of ‘fromSing’, namely ‘(sing @m @a :: Sing _)’ In the fourth argument of ‘act’, namely ‘(fromSing @m (sing @m @a :: Sing _))’ -T14584.hs:56:60: warning: [-Wpartial-type-signatures (in -Wdefault)] +T14584.hs:57:60: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘a0 :: m’ Where: ‘a0’ is an ambiguous type variable ‘m’ is a rigid type variable bound by the instance declaration - at T14584.hs:54:10-89 + at T14584.hs:55:10-89 • In the first argument of ‘Sing’, namely ‘_’ In the type ‘Sing _’ In an expression type signature: Sing _ • Relevant bindings include - monHom :: a -> a (bound at T14584.hs:56:3) + monHom :: a -> a (bound at T14584.hs:57:3) diff --git a/testsuite/tests/perf/compiler/T3064.hs b/testsuite/tests/perf/compiler/T3064.hs index af3dc2cde7..b0eba0bad2 100644 --- a/testsuite/tests/perf/compiler/T3064.hs +++ b/testsuite/tests/perf/compiler/T3064.hs @@ -2,6 +2,7 @@ {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} {-# LANGUAGE Rank2Types, TypeSynonymInstances, FlexibleInstances #-} {-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TypeOperators #-} module T3064 where import Control.Applicative diff --git a/testsuite/tests/polykinds/T11523.hs b/testsuite/tests/polykinds/T11523.hs index 97551b2208..679d1d13d5 100644 --- a/testsuite/tests/polykinds/T11523.hs +++ b/testsuite/tests/polykinds/T11523.hs @@ -19,7 +19,8 @@ module T11523 where -import GHC.Types (Constraint, Type) +import Data.Kind (Constraint, Type) +import Data.Type.Equality (type (~)) import qualified Prelude type Cat i = i -> i -> Type diff --git a/testsuite/tests/polykinds/T12055.hs b/testsuite/tests/polykinds/T12055.hs index de3ad455ea..72c208d77d 100644 --- a/testsuite/tests/polykinds/T12055.hs +++ b/testsuite/tests/polykinds/T12055.hs @@ -17,8 +17,8 @@ module T12055 where -import GHC.Base ( Constraint, Type ) -import GHC.Exts ( type (~~) ) +import Data.Kind (Constraint, Type) +import Data.Type.Equality (type (~), type (~~)) type Cat k = k -> k -> Type diff --git a/testsuite/tests/quantified-constraints/T15359.hs b/testsuite/tests/quantified-constraints/T15359.hs index 2a58d89c05..ca84c0e8be 100644 --- a/testsuite/tests/quantified-constraints/T15359.hs +++ b/testsuite/tests/quantified-constraints/T15359.hs @@ -1,6 +1,6 @@ {-# LANGUAGE Haskell2010 #-} {-# LANGUAGE MultiParamTypeClasses, GADTs, RankNTypes, - ConstraintKinds, QuantifiedConstraints #-} + ConstraintKinds, QuantifiedConstraints, TypeOperators #-} module T15359 where diff --git a/testsuite/tests/quantified-constraints/T15359a.hs b/testsuite/tests/quantified-constraints/T15359a.hs index a5b16acf75..277793b81c 100644 --- a/testsuite/tests/quantified-constraints/T15359a.hs +++ b/testsuite/tests/quantified-constraints/T15359a.hs @@ -1,6 +1,6 @@ {-# LANGUAGE Haskell2010 #-} {-# LANGUAGE MultiParamTypeClasses, GADTs, RankNTypes, - ConstraintKinds, QuantifiedConstraints, + ConstraintKinds, QuantifiedConstraints, TypeOperators, UndecidableInstances #-} module T15359a where diff --git a/testsuite/tests/rebindable/T19167.hs b/testsuite/tests/rebindable/T19167.hs index 6f7ebff33d..4e98e815ea 100644 --- a/testsuite/tests/rebindable/T19167.hs +++ b/testsuite/tests/rebindable/T19167.hs @@ -6,6 +6,7 @@ module Bug where import qualified Prelude as P import qualified GHC.Exts as P import Data.List.NonEmpty ( NonEmpty ) +import Data.Type.Equality ( type (~) ) fromInteger :: P.Integer -> forall a. P.Num a => a fromInteger n = P.fromInteger n diff --git a/testsuite/tests/rename/should_fail/T15214.hs b/testsuite/tests/rename/should_compile/T15214.hs index 55f15593be..55f15593be 100644 --- a/testsuite/tests/rename/should_fail/T15214.hs +++ b/testsuite/tests/rename/should_compile/T15214.hs diff --git a/testsuite/tests/rename/should_compile/T18862.hs b/testsuite/tests/rename/should_compile/T18862.hs new file mode 100644 index 0000000000..7356a27ad8 --- /dev/null +++ b/testsuite/tests/rename/should_compile/T18862.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE PolyKinds, DataKinds, TypeOperators, TypeFamilies #-} + +module T18862 where + +import Prelude (Bool) +import Data.Kind (Constraint) +import qualified Data.Type.Equality as E + +type family (a :: k) ~ (b :: k) :: result_kind + +type instance a ~ b = (a E.~ b :: Constraint) +type instance a ~ b = (a E.== b :: Bool) diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T index 536c5b9013..3a6fdceac3 100644 --- a/testsuite/tests/rename/should_compile/all.T +++ b/testsuite/tests/rename/should_compile/all.T @@ -161,6 +161,7 @@ test('T14881', [], multimod_compile, ['T14881', '-W']) test('T14487', [], multimod_compile, ['T14487', '-v0']) test('T14747', [], multimod_compile, ['T14747', '-v0']) test('T15149', [], multimod_compile, ['T15149', '-v0']) +test('T15214', normal, compile, ['']) test('T13064', normal, compile, ['']) test('T15994', [], makefile_test, ['T15994']) test('T15798a', normal, compile, ['']) @@ -184,3 +185,4 @@ test('T20609a', normal, compile, ['']) test('T20609b', normal, compile, ['']) test('T20609c', normal, compile, ['']) test('T20609d', normal, compile, ['']) +test('T18862', normal, compile, ['']) diff --git a/testsuite/tests/rename/should_fail/T15214.stderr b/testsuite/tests/rename/should_fail/T15214.stderr deleted file mode 100644 index 399438adb5..0000000000 --- a/testsuite/tests/rename/should_fail/T15214.stderr +++ /dev/null @@ -1,2 +0,0 @@ - -T15214.hs:4:1: error: Illegal binding of built-in syntax: ~ diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T index 4ce00de399..5e62e28847 100644 --- a/testsuite/tests/rename/should_fail/all.T +++ b/testsuite/tests/rename/should_fail/all.T @@ -137,7 +137,6 @@ test('T14307', normal, compile_fail, ['']) test('T14591', normal, compile_fail, ['']) test('T14907a', normal, compile_fail, ['']) test('T14907b', normal, compile_fail, ['']) -test('T15214', normal, compile_fail, ['']) test('T15539', normal, compile_fail, ['']) test('T15487', normal, multimod_compile_fail, ['T15487','-v0']) test('T15659', normal, compile_fail, ['']) diff --git a/testsuite/tests/roles/should_compile/Roles3.hs b/testsuite/tests/roles/should_compile/Roles3.hs index b71d9cf2ec..b79129162e 100644 --- a/testsuite/tests/roles/should_compile/Roles3.hs +++ b/testsuite/tests/roles/should_compile/Roles3.hs @@ -1,5 +1,6 @@ {-# LANGUAGE Haskell2010 #-} {-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE AllowAmbiguousTypes #-} -- meth3, meth4 are ambiguous module Roles3 where @@ -20,4 +21,4 @@ class C4 a b where meth4 :: a -> F4 b -> F4 b type Syn1 a = F4 a -type Syn2 a = [a]
\ No newline at end of file +type Syn2 a = [a] diff --git a/testsuite/tests/tcplugins/TcPlugin_Rewrite.hs b/testsuite/tests/tcplugins/TcPlugin_Rewrite.hs index 6df19b7b62..5cacd28618 100644 --- a/testsuite/tests/tcplugins/TcPlugin_Rewrite.hs +++ b/testsuite/tests/tcplugins/TcPlugin_Rewrite.hs @@ -2,13 +2,16 @@ {-# OPTIONS_GHC -fplugin RewritePlugin #-} {-# LANGUAGE Haskell2010 #-} -{-# LANGUAGE DataKinds, ScopedTypeVariables, TypeFamilies #-} +{-# LANGUAGE DataKinds, ScopedTypeVariables, TypeFamilies, TypeOperators #-} module TcPlugin_Rewrite where import Data.Kind ( Type ) +import Data.Type.Equality + ( type (~) ) + import Definitions ( Add, Nat(..) ) diff --git a/testsuite/tests/typecheck/should_compile/LocalGivenEqs.hs b/testsuite/tests/typecheck/should_compile/LocalGivenEqs.hs index fd37ede0db..43063d20aa 100644 --- a/testsuite/tests/typecheck/should_compile/LocalGivenEqs.hs +++ b/testsuite/tests/typecheck/should_compile/LocalGivenEqs.hs @@ -1,5 +1,5 @@ {-# LANGUAGE Haskell2010 #-} -{-# LANGUAGE RankNTypes, TypeFamilies, FlexibleInstances #-} +{-# LANGUAGE RankNTypes, TypeFamilies, TypeOperators, FlexibleInstances #-} {-# OPTIONS_GHC -Wno-missing-methods -Wno-unused-matches #-} module LocalGivenEqs where diff --git a/testsuite/tests/typecheck/should_compile/T11524.hs b/testsuite/tests/typecheck/should_compile/T11524.hs index 0856afe50b..a8c40c88c6 100644 --- a/testsuite/tests/typecheck/should_compile/T11524.hs +++ b/testsuite/tests/typecheck/should_compile/T11524.hs @@ -3,6 +3,7 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE TypeOperators #-} module T11524 where diff --git a/testsuite/tests/typecheck/should_compile/T12919.hs b/testsuite/tests/typecheck/should_compile/T12919.hs index 29eb9dc469..825b7f65c1 100644 --- a/testsuite/tests/typecheck/should_compile/T12919.hs +++ b/testsuite/tests/typecheck/should_compile/T12919.hs @@ -1,5 +1,5 @@ {-# LANGUAGE Haskell2010 #-} -{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, GADTs, ConstraintKinds #-} +{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, GADTs, ConstraintKinds, TypeOperators #-} module T12919 where diff --git a/testsuite/tests/typecheck/should_compile/T13651a.hs b/testsuite/tests/typecheck/should_compile/T13651a.hs index f08407b738..80cda684e1 100644 --- a/testsuite/tests/typecheck/should_compile/T13651a.hs +++ b/testsuite/tests/typecheck/should_compile/T13651a.hs @@ -1,5 +1,5 @@ {-# LANGUAGE Haskell2010 #-} -{-# LANGUAGE TypeFamilies, TypeFamilyDependencies #-} +{-# LANGUAGE TypeFamilies, TypeFamilyDependencies, TypeOperators #-} module T13651 where type family F r s = f | f -> r s diff --git a/testsuite/tests/typecheck/should_compile/T17202.hs b/testsuite/tests/typecheck/should_compile/T17202.hs index cda5783ec9..ee639b9cc0 100644 --- a/testsuite/tests/typecheck/should_compile/T17202.hs +++ b/testsuite/tests/typecheck/should_compile/T17202.hs @@ -2,6 +2,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE ConstraintKinds #-} module T17202 where diff --git a/testsuite/tests/typecheck/should_compile/T17562b.hs b/testsuite/tests/typecheck/should_compile/T17562b.hs index b73e6b1bc7..44eb03ce97 100644 --- a/testsuite/tests/typecheck/should_compile/T17562b.hs +++ b/testsuite/tests/typecheck/should_compile/T17562b.hs @@ -1,5 +1,5 @@ {-# LANGUAGE Haskell2010 #-} -{-# LANGUAGE QuantifiedConstraints, MultiParamTypeClasses, TypeFamilies #-} +{-# LANGUAGE QuantifiedConstraints, MultiParamTypeClasses, TypeFamilies, TypeOperators #-} -- NB: No PolyKinds module T17562b where diff --git a/testsuite/tests/typecheck/should_compile/T17567StupidThetaB.hs b/testsuite/tests/typecheck/should_compile/T17567StupidThetaB.hs index d555511004..1d397f9861 100644 --- a/testsuite/tests/typecheck/should_compile/T17567StupidThetaB.hs +++ b/testsuite/tests/typecheck/should_compile/T17567StupidThetaB.hs @@ -1,5 +1,5 @@ {-# LANGUAGE Haskell2010 #-} -{-# LANGUAGE QuantifiedConstraints, DatatypeContexts, TypeFamilies #-} +{-# LANGUAGE QuantifiedConstraints, DatatypeContexts, TypeFamilies, TypeOperators #-} -- NB: -XNoPolyKinds, to get defaulting. module T17567StupidThetaB where diff --git a/testsuite/tests/typecheck/should_compile/T21010A.hs b/testsuite/tests/typecheck/should_compile/T21010A.hs index 234e1c72d7..5e8ef6fe96 100644 --- a/testsuite/tests/typecheck/should_compile/T21010A.hs +++ b/testsuite/tests/typecheck/should_compile/T21010A.hs @@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} module T21010A ( WrapMono, Constrained(..), withMonoCoercible ) where import T21010B ( WrapMono(..), withMonoCoercible ) diff --git a/testsuite/tests/typecheck/should_compile/tc250.hs b/testsuite/tests/typecheck/should_compile/tc250.hs index 445d702b69..1076fc5f49 100644 --- a/testsuite/tests/typecheck/should_compile/tc250.hs +++ b/testsuite/tests/typecheck/should_compile/tc250.hs @@ -1,5 +1,6 @@ {-# LANGUAGE Haskell2010 #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} module ShouldCompile where import Data.Kind (Type) diff --git a/testsuite/tests/typecheck/should_compile/tc251.hs b/testsuite/tests/typecheck/should_compile/tc251.hs index e9315263af..1c69c1d9ac 100644 --- a/testsuite/tests/typecheck/should_compile/tc251.hs +++ b/testsuite/tests/typecheck/should_compile/tc251.hs @@ -1,5 +1,6 @@ {-# LANGUAGE Haskell2010 #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} module ShouldCompile where import Tc251_Help diff --git a/testsuite/tests/typecheck/should_compile/tc252.hs b/testsuite/tests/typecheck/should_compile/tc252.hs index 1ad9c7c514..6ff23e75e4 100644 --- a/testsuite/tests/typecheck/should_compile/tc252.hs +++ b/testsuite/tests/typecheck/should_compile/tc252.hs @@ -1,5 +1,6 @@ {-# LANGUAGE Haskell2010 #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} module ShouldCompile where import Data.Kind (Type) diff --git a/testsuite/tests/typecheck/should_compile/tc253.hs b/testsuite/tests/typecheck/should_compile/tc253.hs index 7553b756a8..5c032daa01 100644 --- a/testsuite/tests/typecheck/should_compile/tc253.hs +++ b/testsuite/tests/typecheck/should_compile/tc253.hs @@ -1,5 +1,6 @@ {-# LANGUAGE Haskell2010 #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -- this is needed because |FamHelper a x| /< |Fam a x| module ShouldCompile where diff --git a/testsuite/tests/warnings/should_compile/T18862a.hs b/testsuite/tests/warnings/should_compile/T18862a.hs new file mode 100644 index 0000000000..532cd83e83 --- /dev/null +++ b/testsuite/tests/warnings/should_compile/T18862a.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE NoTypeOperators #-} + +module T18862a where + +f :: (a ~ b) => a -> b +f = id diff --git a/testsuite/tests/warnings/should_compile/T18862a.stderr b/testsuite/tests/warnings/should_compile/T18862a.stderr new file mode 100644 index 0000000000..e2a6fe3f3c --- /dev/null +++ b/testsuite/tests/warnings/should_compile/T18862a.stderr @@ -0,0 +1,5 @@ + +T18862a.hs:5:9: warning: [-Wtype-equality-requires-operators (in -Wdefault)] + The use of ‘~’ without TypeOperators + will become an error in a future GHC release. + Suggested fix: Perhaps you intended to use TypeOperators diff --git a/testsuite/tests/warnings/should_compile/T18862b.hs b/testsuite/tests/warnings/should_compile/T18862b.hs new file mode 100644 index 0000000000..7259547b7c --- /dev/null +++ b/testsuite/tests/warnings/should_compile/T18862b.hs @@ -0,0 +1,8 @@ +{-# OPTIONS -Wcompat -Wno-error=type-equality-out-of-scope #-} + +module T18862b where + +import Prelude (id) + +f :: (a ~ b) => a -> b +f = id diff --git a/testsuite/tests/warnings/should_compile/T18862b.stderr b/testsuite/tests/warnings/should_compile/T18862b.stderr new file mode 100644 index 0000000000..ac959be7d8 --- /dev/null +++ b/testsuite/tests/warnings/should_compile/T18862b.stderr @@ -0,0 +1,8 @@ + +T18862b.hs:7:9: warning: [-Wtype-equality-out-of-scope (in -Wcompat)] + • The ‘~’ operator is out of scope. + Assuming it to stand for an equality constraint. + • NB: ‘~’ used to be built-in syntax but now is a regular type operator + exported from Data.Type.Equality and Prelude. + If you are using a custom Prelude, consider re-exporting it. + • This will become an error in a future GHC release. diff --git a/testsuite/tests/warnings/should_compile/all.T b/testsuite/tests/warnings/should_compile/all.T index 2934db7ad4..3c514245fe 100644 --- a/testsuite/tests/warnings/should_compile/all.T +++ b/testsuite/tests/warnings/should_compile/all.T @@ -47,3 +47,5 @@ test('T19564d', normal, compile, ['']) test('T19296', normal, compile, ['-fdiagnostics-show-caret -Wredundant-constraints -dsuppress-uniques']) test('DodgyExports01', normal, compile, ['-Wdodgy-exports']) test('DerivingTypeable', normal, compile, ['-Wderiving-typeable']) +test('T18862a', normal, compile, ['']) +test('T18862b', normal, compile, ['']) |