diff options
Diffstat (limited to 'testsuite')
25 files changed, 97 insertions, 52 deletions
diff --git a/testsuite/tests/indexed-types/should_compile/T2715.hs b/testsuite/tests/indexed-types/should_compile/T2715.hs index 0fae15eaf8..c283467b82 100644 --- a/testsuite/tests/indexed-types/should_compile/T2715.hs +++ b/testsuite/tests/indexed-types/should_compile/T2715.hs @@ -3,6 +3,8 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE AllowAmbiguousTypes #-} + -- The type of 'empty' is indeed ambiguous module T2715 where @@ -14,9 +16,8 @@ type instance Domain Interval = Interval type family Value (d :: * -> *) :: * - class IDomain d where - empty :: (Ord (Value d), Enum (Value d)) => (Domain d) (Value d) + empty :: (Ord (Value d), Enum (Value d)) => Domain d (Value d) class (IDomain d1) -- (IDomain d1, IDomain d2, Value d1 ~ Value d2) => IIDomain (d1 :: * -> *) (d2 :: * -> * ) where @@ -25,7 +26,7 @@ class (IDomain d1) -- (IDomain d1, IDomain d2, Value d1 ~ Value d2) instance Ord (Value Interval) => IDomain Interval where - empty = Intv (toEnum 1, toEnum 0) + empty = Intv (toEnum 1, toEnum 0) instance Ord (Value Interval) => IIDomain Interval Interval where diff --git a/testsuite/tests/indexed-types/should_compile/T4160.hs b/testsuite/tests/indexed-types/should_compile/T4160.hs index f13aafa103..ee95e8c874 100644 --- a/testsuite/tests/indexed-types/should_compile/T4160.hs +++ b/testsuite/tests/indexed-types/should_compile/T4160.hs @@ -1,4 +1,7 @@ {-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeFamilies #-} +{-# LANGUAGE AllowAmbiguousTypes #-} + -- The type of sizeT is indeed ambiguous + module Foo where data P f g r = f r :*: g r diff --git a/testsuite/tests/indexed-types/should_compile/T4200.hs b/testsuite/tests/indexed-types/should_compile/T4200.hs index feb91e8d8b..a9a1a5bd63 100644 --- a/testsuite/tests/indexed-types/should_compile/T4200.hs +++ b/testsuite/tests/indexed-types/should_compile/T4200.hs @@ -5,9 +5,9 @@ module T4200 where class C a where type In a :: * - op :: In a -> Int + op :: In a -> a -> Int -- Should be ok; no -XUndecidableInstances required instance (In c ~ Int) => C [c] where type In [c] = In c - op x = 3 + op _ _ = 3 diff --git a/testsuite/tests/indexed-types/should_compile/T9582.hs b/testsuite/tests/indexed-types/should_compile/T9582.hs index f86d723319..d906205834 100644 --- a/testsuite/tests/indexed-types/should_compile/T9582.hs +++ b/testsuite/tests/indexed-types/should_compile/T9582.hs @@ -3,12 +3,12 @@ module T9582 where class C a where type T a - m :: T a + m :: a -> T a instance C Int where type T Int = String - m :: String - m = "bla" + m :: Int -> String + m _ = "bla" -- Method signature does not match class; it should be m :: T Int -- In the instance declaration for ‘C Int’ diff --git a/testsuite/tests/indexed-types/should_fail/T1900.stderr b/testsuite/tests/indexed-types/should_fail/T1900.stderr index 0d02a52f11..f986888cfd 100644 --- a/testsuite/tests/indexed-types/should_fail/T1900.stderr +++ b/testsuite/tests/indexed-types/should_fail/T1900.stderr @@ -1,12 +1,13 @@ - -T1900.hs:13:10: - Couldn't match type ‘Depend s0’ with ‘Depend s’ - NB: ‘Depend’ is a type function, and may not be injective - The type variable ‘s0’ is ambiguous - Expected type: Depend s -> Bool - Actual type: Depend s0 -> Bool - In the ambiguity check for the type signature for ‘check’: - check :: forall s. Bug s => Depend s -> Bool - To defer the ambiguity check to use sites, enable AllowAmbiguousTypes - In the type signature for ‘check’: - check :: (Bug s) => Depend s -> Bool +
+T1900.hs:7:3:
+ Couldn't match type ‘Depend s0’ with ‘Depend s’
+ NB: ‘Depend’ is a type function, and may not be injective
+ The type variable ‘s0’ is ambiguous
+ Expected type: Depend s -> Depend s
+ Actual type: Depend s0 -> Depend s0
+ In the ambiguity check for the type signature for ‘trans’:
+ trans :: forall s. Bug s => Depend s -> Depend s
+ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
+ When checking the class method:
+ trans :: forall s. Bug s => Depend s -> Depend s
+ In the class declaration for ‘Bug’
diff --git a/testsuite/tests/indexed-types/should_fail/T2544.hs b/testsuite/tests/indexed-types/should_fail/T2544.hs index 3653a42317..0e98910055 100644 --- a/testsuite/tests/indexed-types/should_fail/T2544.hs +++ b/testsuite/tests/indexed-types/should_fail/T2544.hs @@ -1,4 +1,6 @@ {-# LANGUAGE TypeOperators, TypeFamilies #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+ -- The type of 'empty' is indeed ambiguous
module T2544 where
diff --git a/testsuite/tests/indexed-types/should_fail/T2544.stderr b/testsuite/tests/indexed-types/should_fail/T2544.stderr index 6c5230800c..7a1f564c56 100644 --- a/testsuite/tests/indexed-types/should_fail/T2544.stderr +++ b/testsuite/tests/indexed-types/should_fail/T2544.stderr @@ -1,11 +1,11 @@ -T2544.hs:15:12:
+T2544.hs:17:12:
Couldn't match type ‘IxMap l’ with ‘IxMap i0’
NB: ‘IxMap’ is a type function, and may not be injective
The type variable ‘i0’ is ambiguous
Expected type: IxMap (l :|: r) [Int]
Actual type: BiApp (IxMap i0) (IxMap i1) [Int]
Relevant bindings include
- empty :: IxMap (l :|: r) [Int] (bound at T2544.hs:15:4)
+ empty :: IxMap (l :|: r) [Int] (bound at T2544.hs:17:4)
In the expression: BiApp empty empty
In an equation for ‘empty’: empty = BiApp empty empty
diff --git a/testsuite/tests/module/all.T b/testsuite/tests/module/all.T index c86a5f8806..1507ffb0d5 100644 --- a/testsuite/tests/module/all.T +++ b/testsuite/tests/module/all.T @@ -57,7 +57,7 @@ test('mod35', normal, compile, ['']) test('mod36', normal, compile_fail, ['']) test('mod37', normal, compile, ['']) test('mod38', normal, compile_fail, ['']) -test('mod39', normal, compile, ['']) +test('mod39', normal, compile_fail, ['']) test('mod40', normal, compile_fail, ['']) test('mod41', normal, compile_fail, ['']) test('mod42', normal, compile_fail, ['']) diff --git a/testsuite/tests/module/mod39.stderr b/testsuite/tests/module/mod39.stderr new file mode 100644 index 0000000000..3c049f2532 --- /dev/null +++ b/testsuite/tests/module/mod39.stderr @@ -0,0 +1,7 @@ +
+mod39.hs:3:17:
+ Constraint ‘Eq a’ in the type of ‘f’
+ constrains only the class type variables
+ Use ConstrainedClassMethods to allow it
+ When checking the class method: f :: forall a. (C a, Eq a) => a
+ In the class declaration for ‘C’
diff --git a/testsuite/tests/polykinds/T8566.hs b/testsuite/tests/polykinds/T8566.hs index ee5892ce25..248febb586 100644 --- a/testsuite/tests/polykinds/T8566.hs +++ b/testsuite/tests/polykinds/T8566.hs @@ -6,6 +6,7 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE AllowAmbiguousTypes #-} -- 'c' is ambiguous module T8566 where diff --git a/testsuite/tests/polykinds/T8566.stderr b/testsuite/tests/polykinds/T8566.stderr index 096f058791..168e890404 100644 --- a/testsuite/tests/polykinds/T8566.stderr +++ b/testsuite/tests/polykinds/T8566.stderr @@ -1,19 +1,19 @@ - -T8566.hs:31:9: - Could not deduce (C ('AA (t (I a ps)) as) ps fs0) - arising from a use of ‘c’ - from the context: C ('AA (t (I a ps)) as) ps fs - bound by the instance declaration at T8566.hs:29:10-67 - or from: 'AA t (a : as) ~ 'AA t1 as1 - bound by a pattern with constructor: - A :: forall (r :: [*]) (k :: BOX) (t :: k) (as :: [U *]). - I ('AA t as) r, - in an equation for ‘c’ - at T8566.hs:31:5 - The type variable ‘fs0’ is ambiguous - Relevant bindings include - c :: I ('AA t (a : as)) ps -> I ('AA t (a : as)) ps - (bound at T8566.hs:31:3) - In the expression: c undefined - In an equation for ‘c’: c A = c undefined - In the instance declaration for ‘C ('AA t (a : as)) ps fs’ +
+T8566.hs:32:9:
+ Could not deduce (C ('AA (t (I a ps)) as) ps fs0)
+ arising from a use of ‘c’
+ from the context: C ('AA (t (I a ps)) as) ps fs
+ bound by the instance declaration at T8566.hs:30:10-67
+ or from: 'AA t (a : as) ~ 'AA t1 as1
+ bound by a pattern with constructor:
+ A :: forall (r :: [*]) (k :: BOX) (t :: k) (as :: [U *]).
+ I ('AA t as) r,
+ in an equation for ‘c’
+ at T8566.hs:32:5
+ The type variable ‘fs0’ is ambiguous
+ Relevant bindings include
+ c :: I ('AA t (a : as)) ps -> I ('AA t (a : as)) ps
+ (bound at T8566.hs:32:3)
+ In the expression: c undefined
+ In an equation for ‘c’: c A = c undefined
+ In the instance declaration for ‘C ('AA t (a : as)) ps fs’
diff --git a/testsuite/tests/polykinds/T9200.hs b/testsuite/tests/polykinds/T9200.hs index ca050661a2..740536a516 100644 --- a/testsuite/tests/polykinds/T9200.hs +++ b/testsuite/tests/polykinds/T9200.hs @@ -2,12 +2,13 @@ TypeFamilies #-} module T9200 where +import Data.Proxy ------ -- test CUSK on classes class C (f :: k) (a :: k2) where - c_meth :: D a => () + c_meth :: D a => Proxy f -> Proxy a -> () class C () a => D a diff --git a/testsuite/tests/roles/should_compile/Roles3.hs b/testsuite/tests/roles/should_compile/Roles3.hs index 4c26f0d986..3df74ec8e2 100644 --- a/testsuite/tests/roles/should_compile/Roles3.hs +++ b/testsuite/tests/roles/should_compile/Roles3.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-} +{-# LANGUAGE AllowAmbiguousTypes #-} -- meth3, meth4 are ambiguous module Roles3 where diff --git a/testsuite/tests/th/TH_tf2.hs b/testsuite/tests/th/TH_tf2.hs index 94be291324..399731a7f6 100644 --- a/testsuite/tests/th/TH_tf2.hs +++ b/testsuite/tests/th/TH_tf2.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE AllowAmbiguousTypes #-} -- 'bar' is ambiguous module TH_tf2 where diff --git a/testsuite/tests/typecheck/should_compile/tc165.hs b/testsuite/tests/typecheck/should_compile/tc165.hs index ea2fa08ec1..0533c80ca8 100644 --- a/testsuite/tests/typecheck/should_compile/tc165.hs +++ b/testsuite/tests/typecheck/should_compile/tc165.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ConstrainedClassMethods #-} {-# OPTIONS_GHC -dcore-lint #-} -- Fails GHC 5.04.2 with -dcore-lint diff --git a/testsuite/tests/typecheck/should_compile/tc199.hs b/testsuite/tests/typecheck/should_compile/tc199.hs index d530cfd6d0..dfa2c1f230 100644 --- a/testsuite/tests/typecheck/should_compile/tc199.hs +++ b/testsuite/tests/typecheck/should_compile/tc199.hs @@ -1,7 +1,8 @@ -{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE MultiParamTypeClasses, AllowAmbiguousTypes #-} -- This code defines a default method with a highly dubious type, -- because 'v' is not mentioned, and there are no fundeps +-- Hence needing AllowAmbiguousTypes -- -- However, arguably the instance declaration should be accepted, -- beause it's equivalent to diff --git a/testsuite/tests/typecheck/should_compile/tc200.hs b/testsuite/tests/typecheck/should_compile/tc200.hs index bb6a00e1ae..ef799c61d1 100644 --- a/testsuite/tests/typecheck/should_compile/tc200.hs +++ b/testsuite/tests/typecheck/should_compile/tc200.hs @@ -1,4 +1,5 @@ {-# OPTIONS_GHC -w #-} +{-# LANGUAGE ConstrainedClassMethods #-} -- Needed for 'baz' -- A nasty case that crashed GHC 6.4 with a Lint error; -- see Note [Multiple instantiation] in TcExpr diff --git a/testsuite/tests/typecheck/should_compile/tc235.hs b/testsuite/tests/typecheck/should_compile/tc235.hs index 55a1a5855d..4973ec1b33 100644 --- a/testsuite/tests/typecheck/should_compile/tc235.hs +++ b/testsuite/tests/typecheck/should_compile/tc235.hs @@ -1,6 +1,8 @@ {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} {-# LANGUAGE FlexibleInstances, UndecidableInstances, MultiParamTypeClasses, FunctionalDependencies #-} +{-# LANGUAGE AllowAmbiguousTypes #-} + -- 'x' and 'v' are ambiguous -- Trac #1564 diff --git a/testsuite/tests/typecheck/should_compile/tc259.hs b/testsuite/tests/typecheck/should_compile/tc259.hs index 776bd8416b..6ece4a29ca 100644 --- a/testsuite/tests/typecheck/should_compile/tc259.hs +++ b/testsuite/tests/typecheck/should_compile/tc259.hs @@ -1,5 +1,8 @@ -- Test we don't get a cycle for "phantom" superclasses {-# LANGUAGE ConstraintKinds, MultiParamTypeClasses, FlexibleContexts #-} +{-# LANGUAGE AllowAmbiguousTypes #-} + -- 'meth' is ambiguous + module TcOK where class A cls c where diff --git a/testsuite/tests/typecheck/should_compile/tc260.hs b/testsuite/tests/typecheck/should_compile/tc260.hs index 29baeee903..3a4d9b0d8d 100644 --- a/testsuite/tests/typecheck/should_compile/tc260.hs +++ b/testsuite/tests/typecheck/should_compile/tc260.hs @@ -1,6 +1,9 @@ -- Test we don't get a cycle for "phantom" superclasses, -- even if the phantomness is behind a type synonym {-# LANGUAGE ConstraintKinds, MultiParamTypeClasses, FlexibleContexts #-} +{-# LANGUAGE AllowAmbiguousTypes #-} + -- 'meth' is ambiguous + module TcOK where class A ctxt c where diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 60c709760e..20eede0f96 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -133,7 +133,7 @@ test('tcfail146', normal, compile_fail, ['']) test('tcfail147', normal, compile_fail, ['']) test('tcfail148', normal, compile_fail, ['']) test('tcfail149', normal, compile_and_run, ['']) -test('tcfail150', normal, compile, ['']) +test('tcfail150', normal, compile_fail, ['']) test('tcfail151', normal, compile_fail, ['']) test('tcfail152', normal, compile_fail, ['']) test('tcfail153', normal, compile_fail, ['']) diff --git a/testsuite/tests/typecheck/should_fail/tcfail116.stderr b/testsuite/tests/typecheck/should_fail/tcfail116.stderr index 0136173201..abefc61eb8 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail116.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail116.stderr @@ -1,6 +1,12 @@ - -tcfail116.hs:5:1: - The class method ‘bug’ - mentions none of the type or kind variables of the class ‘Foo a’ - When checking the class method: bug :: () - In the class declaration for ‘Foo’ +
+tcfail116.hs:6:5:
+ Could not deduce (Foo a0)
+ from the context: Foo a
+ bound by the type signature for: bug :: Foo a => ()
+ at tcfail116.hs:6:5-13
+ The type variable ‘a0’ is ambiguous
+ In the ambiguity check for the type signature for ‘bug’:
+ bug :: forall a. Foo a => ()
+ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
+ When checking the class method: bug :: forall a. Foo a => ()
+ In the class declaration for ‘Foo’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail149.hs b/testsuite/tests/typecheck/should_fail/tcfail149.hs index 2479ed75c8..090db8de22 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail149.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail149.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE ConstrainedClassMethods #-} + module Main where class C a where diff --git a/testsuite/tests/typecheck/should_fail/tcfail150.stderr b/testsuite/tests/typecheck/should_fail/tcfail150.stderr index e69de29bb2..c91d404c13 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail150.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail150.stderr @@ -0,0 +1,8 @@ +
+tcfail150.hs:6:3:
+ Constraint ‘Eq a’ in the type of ‘op’
+ constrains only the class type variables
+ Use ConstrainedClassMethods to allow it
+ When checking the class method:
+ op :: forall a. (Foo a, Eq a) => a -> a
+ In the class declaration for ‘Foo’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail151.hs b/testsuite/tests/typecheck/should_fail/tcfail151.hs index 00578a1eb2..51cf65d5cd 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail151.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail151.hs @@ -2,7 +2,7 @@ module ShouldFail where class (Show a, Eq a, Monad m) => Name m a where - hashName :: a -> Int + hashName :: a -> m Int newName :: m a data Name a => Exp a = MkExp a |