diff options
Diffstat (limited to 'testsuite')
13 files changed, 66 insertions, 57 deletions
diff --git a/testsuite/tests/dependent/ghci/T14238.stdout b/testsuite/tests/dependent/ghci/T14238.stdout index 729f821af7..fddbc0de54 100644 --- a/testsuite/tests/dependent/ghci/T14238.stdout +++ b/testsuite/tests/dependent/ghci/T14238.stdout @@ -1 +1 @@ -Foo :: forall k -> k -> Type +Foo :: forall k -> k -> * diff --git a/testsuite/tests/partial-sigs/should_compile/T15039b.stderr b/testsuite/tests/partial-sigs/should_compile/T15039b.stderr index 020c253516..5726c7fa65 100644 --- a/testsuite/tests/partial-sigs/should_compile/T15039b.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T15039b.stderr @@ -1,62 +1,57 @@ T15039b.hs:19:14: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ - standing for ‘Dict ((a :: Type) ~ (b :: Type))’ + • Found type wildcard ‘_’ standing for ‘Dict ((a :: *) ~ (b :: *))’ Where: ‘a’, ‘b’ are rigid type variables bound by the type signature for: - ex1 :: forall a b. Dict ((a :: Type) ~ (b :: Type)) -> () + ex1 :: forall a b. Dict ((a :: *) ~ (b :: *)) -> () at T15039b.hs:18:1-45 • In a pattern type signature: _ In the pattern: Dict :: _ In an equation for ‘ex1’: ex1 (Dict :: _) = () • Relevant bindings include - ex1 :: Dict ((a :: Type) ~ (b :: Type)) -> () - (bound at T15039b.hs:19:1) + ex1 :: Dict ((a :: *) ~ (b :: *)) -> () (bound at T15039b.hs:19:1) T15039b.hs:22:14: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ - standing for ‘Dict ((a :: Type) ~ (b :: Type))’ + • Found type wildcard ‘_’ standing for ‘Dict ((a :: *) ~ (b :: *))’ Where: ‘a’, ‘b’ are rigid type variables bound by the type signature for: - ex2 :: forall a b. Dict ((a :: Type) ~ (b :: Type)) -> () + ex2 :: forall a b. Dict ((a :: *) ~ (b :: *)) -> () at T15039b.hs:21:1-46 • In a pattern type signature: _ In the pattern: Dict :: _ In an equation for ‘ex2’: ex2 (Dict :: _) = () • Relevant bindings include - ex2 :: Dict ((a :: Type) ~ (b :: Type)) -> () - (bound at T15039b.hs:22:1) + ex2 :: Dict ((a :: *) ~ (b :: *)) -> () (bound at T15039b.hs:22:1) T15039b.hs:25:14: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ - standing for ‘Dict ((a :: Type) ~~ (b :: k))’ + standing for ‘Dict ((a :: *) ~~ (b :: k))’ Where: ‘a’, ‘b’, ‘k’ are rigid type variables bound by the type signature for: - ex3 :: forall k a (b :: k). Dict ((a :: Type) ~~ (b :: k)) -> () + ex3 :: forall k a (b :: k). Dict ((a :: *) ~~ (b :: k)) -> () at T15039b.hs:24:1-43 • In a pattern type signature: _ In the pattern: Dict :: _ In an equation for ‘ex3’: ex3 (Dict :: _) = () • Relevant bindings include - ex3 :: Dict ((a :: Type) ~~ (b :: k)) -> () - (bound at T15039b.hs:25:1) + ex3 :: Dict ((a :: *) ~~ (b :: k)) -> () (bound at T15039b.hs:25:1) T15039b.hs:33:14: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ standing for ‘Dict (Coercible Type a b)’ + • Found type wildcard ‘_’ standing for ‘Dict (Coercible * a b)’ Where: ‘a’, ‘b’ are rigid type variables bound by the type signature for: - ex6 :: forall a b. Dict (Coercible Type a b) -> () + ex6 :: forall a b. Dict (Coercible * a b) -> () at T15039b.hs:32:1-53 • In a pattern type signature: _ In the pattern: Dict :: _ In an equation for ‘ex6’: ex6 (Dict :: _) = () • Relevant bindings include - ex6 :: Dict (Coercible Type a b) -> () (bound at T15039b.hs:33:1) + ex6 :: Dict (Coercible * a b) -> () (bound at T15039b.hs:33:1) T15039b.hs:35:8: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ standing for ‘Coercible Type a b’ + • Found type wildcard ‘_’ standing for ‘Coercible * a b’ Where: ‘a’, ‘b’ are rigid type variables bound by - the inferred type of ex7 :: Coercible Type a b => Coercion Type a b + the inferred type of ex7 :: Coercible * a b => Coercion * a b at T15039b.hs:36:1-14 • In the type signature: ex7 :: _ => Coercion (a :: Type) (b :: Type) diff --git a/testsuite/tests/partial-sigs/should_compile/T15039d.stderr b/testsuite/tests/partial-sigs/should_compile/T15039d.stderr index 6c6e1a0c24..7a0f4acf26 100644 --- a/testsuite/tests/partial-sigs/should_compile/T15039d.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T15039d.stderr @@ -1,64 +1,59 @@ T15039d.hs:19:14: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ - standing for ‘Dict ((a :: Type) ~ (b :: Type))’ + • Found type wildcard ‘_’ standing for ‘Dict ((a :: *) ~ (b :: *))’ Where: ‘a’, ‘b’ are rigid type variables bound by the type signature for: - ex1 :: forall a b. Dict ((a :: Type) ~ (b :: Type)) -> () + ex1 :: forall a b. Dict ((a :: *) ~ (b :: *)) -> () at T15039d.hs:18:1-45 • In a pattern type signature: _ In the pattern: Dict :: _ In an equation for ‘ex1’: ex1 (Dict :: _) = () • Relevant bindings include - ex1 :: Dict ((a :: Type) ~ (b :: Type)) -> () - (bound at T15039d.hs:19:1) + ex1 :: Dict ((a :: *) ~ (b :: *)) -> () (bound at T15039d.hs:19:1) T15039d.hs:22:14: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ - standing for ‘Dict ((a :: Type) ~~ (b :: Type))’ + standing for ‘Dict ((a :: *) ~~ (b :: *))’ Where: ‘a’, ‘b’ are rigid type variables bound by the type signature for: - ex2 :: forall a b. Dict ((a :: Type) ~~ (b :: Type)) -> () + ex2 :: forall a b. Dict ((a :: *) ~~ (b :: *)) -> () at T15039d.hs:21:1-46 • In a pattern type signature: _ In the pattern: Dict :: _ In an equation for ‘ex2’: ex2 (Dict :: _) = () • Relevant bindings include - ex2 :: Dict ((a :: Type) ~~ (b :: Type)) -> () - (bound at T15039d.hs:22:1) + ex2 :: Dict ((a :: *) ~~ (b :: *)) -> () (bound at T15039d.hs:22:1) T15039d.hs:25:14: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ - standing for ‘Dict ((a :: Type) ~~ (b :: k))’ + standing for ‘Dict ((a :: *) ~~ (b :: k))’ Where: ‘a’, ‘b’, ‘k’ are rigid type variables bound by the type signature for: - ex3 :: forall k a (b :: k). Dict ((a :: Type) ~~ (b :: k)) -> () + ex3 :: forall k a (b :: k). Dict ((a :: *) ~~ (b :: k)) -> () at T15039d.hs:24:1-43 • In a pattern type signature: _ In the pattern: Dict :: _ In an equation for ‘ex3’: ex3 (Dict :: _) = () • Relevant bindings include - ex3 :: Dict ((a :: Type) ~~ (b :: k)) -> () - (bound at T15039d.hs:25:1) + ex3 :: Dict ((a :: *) ~~ (b :: k)) -> () (bound at T15039d.hs:25:1) T15039d.hs:33:14: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ standing for ‘Dict (Coercible Type a b)’ + • Found type wildcard ‘_’ standing for ‘Dict (Coercible * a b)’ Where: ‘a’, ‘b’ are rigid type variables bound by the type signature for: - ex6 :: forall a b. Dict (Coercible Type a b) -> () + ex6 :: forall a b. Dict (Coercible * a b) -> () at T15039d.hs:32:1-53 • In a pattern type signature: _ In the pattern: Dict :: _ In an equation for ‘ex6’: ex6 (Dict :: _) = () • Relevant bindings include - ex6 :: Dict (Coercible Type a b) -> () (bound at T15039d.hs:33:1) + ex6 :: Dict (Coercible * a b) -> () (bound at T15039d.hs:33:1) T15039d.hs:35:8: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ - standing for ‘(a :: Type) ~R# (b :: Type)’ + • Found type wildcard ‘_’ standing for ‘(a :: *) ~R# (b :: *)’ Where: ‘a’, ‘b’ are rigid type variables bound by the inferred type of - ex7 :: ((a :: Type) ~R# (b :: Type)) => Coercion Type a b + ex7 :: ((a :: *) ~R# (b :: *)) => Coercion * a b at T15039d.hs:36:1-14 • In the type signature: ex7 :: _ => Coercion (a :: Type) (b :: Type) diff --git a/testsuite/tests/partial-sigs/should_fail/T14584.stderr b/testsuite/tests/partial-sigs/should_fail/T14584.stderr index f4f1887f4d..f22178774e 100644 --- a/testsuite/tests/partial-sigs/should_fail/T14584.stderr +++ b/testsuite/tests/partial-sigs/should_fail/T14584.stderr @@ -1,13 +1,13 @@ T14584.hs:56:41: warning: [-Wdeferred-type-errors (in -Wdefault)] - • Could not deduce: m1 ~ Type + • Could not deduce: m1 ~ * from the context: (Action act, Monoid a, Good m1) bound by the instance declaration at T14584.hs:54:10-89 ‘m1’ is a rigid type variable bound by the instance declaration at T14584.hs:54:10-89 When matching types - a :: Type + a :: * a0 :: m Expected type: Sing a0 Actual type: Sing a diff --git a/testsuite/tests/polykinds/T10134.hs b/testsuite/tests/polykinds/T10134.hs index 0b64625f28..746758ce2f 100644 --- a/testsuite/tests/polykinds/T10134.hs +++ b/testsuite/tests/polykinds/T10134.hs @@ -3,7 +3,7 @@ module T10134 where -import GHC.TypeLits +import GHC.TypeLits as L import T10134a import Prelude @@ -11,9 +11,9 @@ type Positive n = ((n-1)+1)~n data Dummy n d = Dummy { vec :: Vec n (Vec d Bool) } -nextDummy :: Positive (2*(n+d)) => Dummy n d -> Dummy n d +nextDummy :: Positive (2 L.* (n+d)) => Dummy n d -> Dummy n d nextDummy d = Dummy { vec = vec dFst } where (dFst,dSnd) = nextDummy' d -nextDummy' :: Positive (2*(n+d)) => Dummy n d -> ( Dummy n d, Bool ) +nextDummy' :: Positive (2 L.* (n+d)) => Dummy n d -> ( Dummy n d, Bool ) nextDummy' _ = undefined diff --git a/testsuite/tests/th/TH_unresolvedInfix.hs b/testsuite/tests/th/TH_unresolvedInfix.hs index 49f283bcd8..aa684f7f23 100644 --- a/testsuite/tests/th/TH_unresolvedInfix.hs +++ b/testsuite/tests/th/TH_unresolvedInfix.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE NoStarIsType #-} {-# LANGUAGE QuasiQuotes #-} module Main where diff --git a/testsuite/tests/th/TH_unresolvedInfix_Lib.hs b/testsuite/tests/th/TH_unresolvedInfix_Lib.hs index e6ad9f027b..a88b93fc8a 100644 --- a/testsuite/tests/th/TH_unresolvedInfix_Lib.hs +++ b/testsuite/tests/th/TH_unresolvedInfix_Lib.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE NoStarIsType #-} module TH_unresolvedInfix_Lib where diff --git a/testsuite/tests/typecheck/should_compile/TcTypeNatSimple.hs b/testsuite/tests/typecheck/should_compile/TcTypeNatSimple.hs index 911a43e507..d0077edbdb 100644 --- a/testsuite/tests/typecheck/should_compile/TcTypeNatSimple.hs +++ b/testsuite/tests/typecheck/should_compile/TcTypeNatSimple.hs @@ -1,6 +1,6 @@ {-# LANGUAGE DataKinds, TypeOperators, TypeFamilies #-} module TcTypeNatSimple where -import GHC.TypeLits +import GHC.TypeLits as L import Data.Proxy -------------------------------------------------------------------------------- @@ -8,7 +8,7 @@ import Data.Proxy e1 :: Proxy (2 + 3) -> Proxy 5 e1 = id -e2 :: Proxy (2 * 3) -> Proxy 6 +e2 :: Proxy (2 L.* 3) -> Proxy 6 e2 = id e3 :: Proxy (2 ^ 3) -> Proxy 8 @@ -20,16 +20,16 @@ e4 = id e5 :: Proxy (x + 0) -> Proxy x e5 = id -e6 :: Proxy (x * 0) -> Proxy 0 +e6 :: Proxy (x L.* 0) -> Proxy 0 e6 = id -e7 :: Proxy (0 * x) -> Proxy 0 +e7 :: Proxy (0 L.* x) -> Proxy 0 e7 = id -e8 :: Proxy (x * 1) -> Proxy x +e8 :: Proxy (x L.* 1) -> Proxy x e8 = id -e9 :: Proxy (1 * x) -> Proxy x +e9 :: Proxy (1 L.* x) -> Proxy x e9 = id e10 :: Proxy (x ^ 1) -> Proxy x @@ -83,10 +83,10 @@ e23 = id ti2 :: Proxy (y + x) -> Proxy x -> () ti2 _ _ = () -ti3 :: Proxy (2 * y) -> () +ti3 :: Proxy (2 L.* y) -> () ti3 _ = () -ti4 :: Proxy (y * 2) -> () +ti4 :: Proxy (y L.* 2) -> () ti4 _ = () ti5 :: Proxy (2 ^ y) -> () diff --git a/testsuite/tests/typecheck/should_compile/type_in_type_hole_fits.hs b/testsuite/tests/typecheck/should_compile/type_in_type_hole_fits.hs index 92d20daa56..566f8aa102 100644 --- a/testsuite/tests/typecheck/should_compile/type_in_type_hole_fits.hs +++ b/testsuite/tests/typecheck/should_compile/type_in_type_hole_fits.hs @@ -2,7 +2,7 @@ UndecidableInstances, ConstraintKinds #-} module TypeInTypeSubstitutions where -import GHC.TypeLits +import GHC.TypeLits as L import Data.Type.Bool import Data.Type.Equality import Data.List (sort) @@ -21,7 +21,7 @@ type One = NLogN 0 0 type O (a :: AsympPoly) = a type family (^.) (n :: AsympPoly) (m :: Nat) :: AsympPoly where - (NLogN a b) ^. n = (NLogN (a * n) (b * n)) + (NLogN a b) ^. n = (NLogN (a L.* n) (b L.* n)) type family (*.) (n :: AsympPoly) (m :: AsympPoly) :: AsympPoly where (NLogN a b) *. (NLogN c d) = NLogN (a+c) (b+d) diff --git a/testsuite/tests/typecheck/should_run/TcTypeNatSimpleRun.hs b/testsuite/tests/typecheck/should_run/TcTypeNatSimpleRun.hs index fb1463cc86..c12d53cde6 100644 --- a/testsuite/tests/typecheck/should_run/TcTypeNatSimpleRun.hs +++ b/testsuite/tests/typecheck/should_run/TcTypeNatSimpleRun.hs @@ -1,6 +1,6 @@ {-# LANGUAGE DataKinds, TypeOperators, TypeFamilies #-} module Main(main) where -import GHC.TypeLits +import GHC.TypeLits as L import Data.Proxy -------------------------------------------------------------------------------- @@ -12,10 +12,10 @@ tsub _ _ = Proxy tsub2 :: Proxy (x + y) -> (Proxy x, Proxy y) tsub2 _ = (Proxy, Proxy) -tdiv :: Proxy (x * y) -> Proxy y -> Proxy x +tdiv :: Proxy (x L.* y) -> Proxy y -> Proxy x tdiv _ _ = Proxy -tdiv2 :: Proxy (x * y) -> (Proxy x, Proxy y) +tdiv2 :: Proxy (x L.* y) -> (Proxy x, Proxy y) tdiv2 _ = (Proxy, Proxy) troot :: Proxy (x ^ y) -> Proxy y -> Proxy x diff --git a/testsuite/tests/warnings/should_compile/StarBinder.hs b/testsuite/tests/warnings/should_compile/StarBinder.hs new file mode 100644 index 0000000000..09f51684ac --- /dev/null +++ b/testsuite/tests/warnings/should_compile/StarBinder.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeOperators, TypeFamilies #-} + +module X (type (X.*)) where + +type family (*) a b where { (*) a b = Either b a } diff --git a/testsuite/tests/warnings/should_compile/StarBinder.stderr b/testsuite/tests/warnings/should_compile/StarBinder.stderr new file mode 100644 index 0000000000..2dbcf0e800 --- /dev/null +++ b/testsuite/tests/warnings/should_compile/StarBinder.stderr @@ -0,0 +1,10 @@ + +StarBinder.hs:5:14: warning: [-Wstar-binder (in -Wdefault)] + Found binding occurrence of ‘*’ yet StarIsType is enabled. + NB. To use (or export) this operator in modules with StarIsType, + including the definition module, you must qualify it. + +StarBinder.hs:5:30: warning: [-Wstar-binder (in -Wdefault)] + Found binding occurrence of ‘*’ yet StarIsType is enabled. + NB. To use (or export) this operator in modules with StarIsType, + including the definition module, you must qualify it. diff --git a/testsuite/tests/warnings/should_compile/all.T b/testsuite/tests/warnings/should_compile/all.T index 6740990853..fd2ba85035 100644 --- a/testsuite/tests/warnings/should_compile/all.T +++ b/testsuite/tests/warnings/should_compile/all.T @@ -20,3 +20,5 @@ test('Werror01', normal, compile, ['']) test('Werror02', normal, compile, ['']) test('MissingMod', normal, multimod_compile, ['MissingMod', '-Wmissing-home-modules']) + +test('StarBinder', normal, compile, [''])
\ No newline at end of file |