Test the ConstraintKind extension and related changes
authorMax Bolingbroke <batterseapower@hotmail.com>
Sun, 21 Aug 2011 15:53:40 +0000 (16:53 +0100)
committerMax Bolingbroke <batterseapower@hotmail.com>
Tue, 6 Sep 2011 16:28:53 +0000 (17:28 +0100)
49 files changed:
testsuite/tests/indexed-types/should_compile/T3017.stderr
testsuite/tests/indexed-types/should_fail/SimpleFail14.stderr
testsuite/tests/module/mod40.stderr
testsuite/tests/rename/should_fail/all.T
testsuite/tests/rename/should_fail/rnfail055.stderr
testsuite/tests/rename/should_fail/rnfail057.hs [new file with mode: 0644]
testsuite/tests/rename/should_fail/rnfail057.stderr [new file with mode: 0644]
testsuite/tests/typecheck/should_compile/all.T
testsuite/tests/typecheck/should_compile/tc231.stderr
testsuite/tests/typecheck/should_compile/tc250.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_compile/tc251.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/T2994.stderr
testsuite/tests/typecheck/should_fail/T3540.stderr
testsuite/tests/typecheck/should_fail/all.T
testsuite/tests/typecheck/should_fail/tcfail027.stderr
testsuite/tests/typecheck/should_fail/tcfail036.stderr
testsuite/tests/typecheck/should_fail/tcfail041.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/tcfail041.stderr [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/tcfail048.stderr
testsuite/tests/typecheck/should_fail/tcfail057.stderr
testsuite/tests/typecheck/should_fail/tcfail058.stderr
testsuite/tests/typecheck/should_fail/tcfail063.stderr
testsuite/tests/typecheck/should_fail/tcfail078.stderr
testsuite/tests/typecheck/should_fail/tcfail091.hs [deleted file]
testsuite/tests/typecheck/should_fail/tcfail134.stderr
testsuite/tests/typecheck/should_fail/tcfail146.stderr
testsuite/tests/typecheck/should_fail/tcfail147.stderr
testsuite/tests/typecheck/should_fail/tcfail151.stderr
testsuite/tests/typecheck/should_fail/tcfail209.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/tcfail209.stderr [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/tcfail210.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/tcfail210.stderr [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/tcfail211.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/tcfail211.stderr [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/tcfail212.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/tcfail212.stderr [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/tcfail213.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/tcfail213.stderr [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/tcfail214.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/tcfail214.stderr [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/tcfail215.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/tcfail215.stderr [new file with mode: 0644]
testsuite/tests/typecheck/should_run/all.T
testsuite/tests/typecheck/should_run/tcrun043.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_run/tcrun043.stdout [new file with mode: 0644]
testsuite/tests/typecheck/should_run/tcrun044.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_run/tcrun044.stdout [new file with mode: 0644]
testsuite/tests/typecheck/should_run/tcrun045.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_run/tcrun045.stdout [new file with mode: 0644]

index cd03a10..591b0bc 100644 (file)
@@ -4,6 +4,10 @@ TYPE SIGNATURES
              (Num t1, Num t, Coll c, Elem c ~ (t, t1)) =>
              c -> c
 TYPE CONSTRUCTORS
+  class Coll c
+      RecFlag NonRecursive
+      type family Elem c :: *
+      empty :: c insert :: Elem c -> c -> c
   data ListColl a
       RecFlag NonRecursive
       = L :: forall a. [a] -> ListColl a Stricts: _
index e11f950..42bc53d 100644 (file)
@@ -1,6 +1,7 @@
 
 SimpleFail14.hs:5:15:
-    Predicate used as a type: a ~ a
+    Predicate `a ~ a' used as a type
+    Expected kind `?', but `a ~ a' has kind `Constraint'
     In the type `a ~ a'
     In the definition of data constructor `T'
     In the data type declaration for `T'
index 35c2151..a1eb1ed 100644 (file)
@@ -1,5 +1,5 @@
-\r
-mod40.hs:3:1:\r
-    Cycle in class declarations (via superclasses):\r
-      mod40.hs:3:1-31: class C2 a => C1 a\r
-      mod40.hs:4:1-31: class C1 a => C2 a\r
+
+mod40.hs:3:1:
+    Cycle in class declarations (via superclasses):
+      mod40.hs:3:1-31: class C2 a => C1 a
+      mod40.hs:4:1-31: class C1 a => C2 a
index 571b375..1d383a4 100644 (file)
@@ -66,6 +66,7 @@ test('rnfail055',
      multimod_compile_fail,
      ['RnFail055','-v0'])
 test('rnfail056', normal, compile_fail, [''])
+test('rnfail057', normal, compile_fail, [''])
 
 test('rn_dup', normal, compile_fail, [''])
 test('T2310', normal, compile_fail, [''])
index 7c30e78..301dbea 100644 (file)
@@ -95,7 +95,7 @@ RnFail055.hs-boot:27:22:
 RnFail055.hs-boot:28:7:
     Class `C2' has conflicting definitions in the module and its hs-boot file
     Main module: class C2 a b
-                     RecFlag NonRecursive
+                     RecFlag Recursive
                      m2 :: a -> b m2' :: a -> b
     Boot file:   class C2 a b
                      RecFlag NonRecursive
@@ -103,5 +103,5 @@ RnFail055.hs-boot:28:7:
 
 RnFail055.hs-boot:29:24:
     Class `C3' has conflicting definitions in the module and its hs-boot file
-    Main module: class (Eq a, Ord a) => C3 a RecFlag NonRecursive
+    Main module: class (Eq a, Ord a) => C3 a RecFlag Recursive
     Boot file:   class (Ord a, Eq a) => C3 a RecFlag NonRecursive
diff --git a/testsuite/tests/rename/should_fail/rnfail057.hs b/testsuite/tests/rename/should_fail/rnfail057.hs
new file mode 100644 (file)
index 0000000..df06881
--- /dev/null
@@ -0,0 +1,3 @@
+module BindKindName where
+
+type Foo (a :: DontExistKind) = a
diff --git a/testsuite/tests/rename/should_fail/rnfail057.stderr b/testsuite/tests/rename/should_fail/rnfail057.stderr
new file mode 100644 (file)
index 0000000..556fab6
--- /dev/null
@@ -0,0 +1,4 @@
+
+rnfail057.hs:3:16:
+    Unexpected named kind:
+        DontExistKind
index 862ac9f..38b6ef3 100644 (file)
@@ -340,6 +340,8 @@ test('T4969', normal, compile, [''])
 test('T5120', normal, compile, [''])
 test('mc18', normal, compile, [''])
 test('tc249', normal, compile, [''])
+test('tc250', normal, compile, [''])
+test('tc251', normal, compile, [''])
 
 test('GivenOverlapping', normal, compile, [''])
 test('SilentParametersOverlapping', normal, compile, [''])
index 0d4ea6d..bf92dac 100644 (file)
@@ -13,10 +13,11 @@ TYPE CONSTRUCTORS
       RecFlag NonRecursive
       = Z :: forall a. a -> Z a Stricts: _
       FamilyInstance: none
+  class Zork s a b | a -> b
+      RecFlag NonRecursive
+      huh :: forall chain. Q s a chain -> ST s ()
 COERCION AXIOMS
-  axiom ShouldCompile.NTCo:T:Zork [s, a, b]
-    :: ShouldCompile.T:Zork s a b
-         ~
-       (forall chain. Q s a chain -> ST s ())
+  axiom ShouldCompile.NTCo:Zork [s, a, b]
+    :: Zork s a b ~ (forall chain. Q s a chain -> ST s ())
 Dependent modules: []
 Dependent packages: [base, ghc-prim, integer-gmp]
diff --git a/testsuite/tests/typecheck/should_compile/tc250.hs b/testsuite/tests/typecheck/should_compile/tc250.hs
new file mode 100644 (file)
index 0000000..cf95685
--- /dev/null
@@ -0,0 +1,10 @@
+{-# LANGUAGE TypeFamilies, ConstraintKind, UndecidableInstances #-}
+module Ctx where
+
+type family Indirect :: * -> Constraint
+type instance Indirect = Show
+
+class Indirect a => Cls a where
+
+foo :: Cls a => a -> String
+foo = show
diff --git a/testsuite/tests/typecheck/should_compile/tc251.hs b/testsuite/tests/typecheck/should_compile/tc251.hs
new file mode 100644 (file)
index 0000000..c878feb
--- /dev/null
@@ -0,0 +1,11 @@
+{-# LANGUAGE TypeFamilies, ConstraintKind, UndecidableInstances #-}
+module Ctx where
+
+type family Indirect :: * -> Constraint
+type instance Indirect = Show
+
+class Cls a where
+    f :: a -> String
+
+instance Indirect a => Cls [a] where
+    f = show
index 7eab543..da472a3 100644 (file)
@@ -1,13 +1,14 @@
 
 T2994.hs:11:10:
     `MonadReader Int' is not applied to enough type arguments
-    Expected kind `*', but `MonadReader Int' has kind `* -> *'
+    Expected kind `Constraint',
+    but `MonadReader Int' has kind `* -> Constraint'
     In the instance declaration for `MonadReader Int'
 
-T2994.hs:13:23:
-    `Reader' r' is not applied to enough type arguments
-    The first argument of `MonadReader' should have kind `*',
-    but `Reader' r' has kind `* -> *'
+T2994.hs:13:10:
+    `MonadReader (Reader' r)' is not applied to enough type arguments
+    Expected kind `Constraint',
+    but `MonadReader (Reader' r)' has kind `* -> Constraint'
     In the instance declaration for `MonadReader (Reader' r)'
 
 T2994.hs:15:10:
index 8708dff..d29dc2e 100644 (file)
@@ -1,25 +1,25 @@
 
 T3540.hs:4:12:
-    Predicate used as a type: a ~ Int
-    In the type signature for `thing':
-      thing :: a ~ Int
+    Predicate `a ~ Int' used as a type
+    Expected kind `*', but `a ~ Int' has kind `Constraint'
+    In the type signature for `thing': thing :: a ~ Int
 
 T3540.hs:7:20:
-    Predicate used as a type: a ~ Int
-    In the type signature for `thing1':
-      thing1 :: Int -> (a ~ Int)
+    Predicate `a ~ Int' used as a type
+    Expected kind `?', but `a ~ Int' has kind `Constraint'
+    In the type signature for `thing1': thing1 :: Int -> (a ~ Int)
 
 T3540.hs:10:13:
-    Predicate used as a type: a ~ Int
-    In the type signature for `thing2':
-      thing2 :: (a ~ Int) -> Int
+    Predicate `a ~ Int' used as a type
+    Expected kind `??', but `a ~ Int' has kind `Constraint'
+    In the type signature for `thing2': thing2 :: (a ~ Int) -> Int
 
 T3540.hs:13:12:
-    Predicate used as a type: ?dude :: Int
-    In the type signature for `thing3':
-      thing3 :: (?dude :: Int) -> Int
+    Predicate `?dude :: Int' used as a type
+    Expected kind `??', but `?dude :: Int' has kind `Constraint'
+    In the type signature for `thing3': thing3 :: (?dude :: Int) -> Int
 
 T3540.hs:16:11:
-    Class `Eq' used as a type
-    In the type signature for `thing4':
-      thing4 :: (Eq a) -> Int
+    Predicate `Eq a' used as a type
+    Expected kind `??', but `Eq a' has kind `Constraint'
+    In the type signature for `thing4': thing4 :: (Eq a) -> Int
index 283be2f..ac583b2 100644 (file)
@@ -34,6 +34,7 @@ test('tcfail036', normal, compile_fail, [''])
 test('tcfail037', normal, compile_fail, [''])
 test('tcfail038', normal, compile_fail, [''])
 test('tcfail040', normal, compile_fail, [''])
+test('tcfail041', normal, compile_fail, [''])
 test('tcfail042', normal, compile_fail, [''])
 test('tcfail043', normal, compile_fail, [''])
 test('tcfail044', normal, compile_fail, [''])
@@ -76,7 +77,6 @@ test('tcfail087', only_compiler_types(['ghc']), compile_fail, [''])
 test('tcfail088', normal, compile_fail, [''])
 test('tcfail089', normal, compile_fail, [''])
 test('tcfail090', only_compiler_types(['ghc']), compile_fail, [''])
-test('tcfail091', normal, compile_fail, [''])
 test('tcfail092', normal, compile_fail, [''])
 test('tcfail093', normal, compile, [''])
 test('tcfail094', normal, compile_fail, [''])
@@ -237,6 +237,13 @@ test('mc25', normal, compile_fail, [''])
 test('tcfail207', normal, compile_fail, [''])
 test('T5084', normal, compile_fail, [''])
 test('tcfail208', normal, compile_fail, [''])
+test('tcfail209', normal, compile_fail, [''])
+test('tcfail210', normal, compile_fail, [''])
+test('tcfail211', normal, compile_fail, [''])
+test('tcfail212', normal, compile_fail, [''])
+test('tcfail213', normal, compile_fail, [''])
+test('tcfail214', normal, compile_fail, [''])
+test('tcfail215', normal, compile_fail, [''])
 
 test('FailDueToGivenOverlapping', normal, compile_fail, [''])
 test('LongWayOverlapping', normal, compile_fail, [''])
index d51c253..d90c298 100644 (file)
@@ -1,5 +1,5 @@
-\r
-tcfail027.hs:4:1:\r
-    Cycle in class declarations (via superclasses):\r
-      tcfail027.hs:(4,1)-(5,14): class B a => A a\r
-      tcfail027.hs:(7,1)-(8,19): class A a => B a\r
+
+tcfail027.hs:4:1:
+    Cycle in class declarations (via superclasses):
+      tcfail027.hs:(4,1)-(5,14): class B a => A a
+      tcfail027.hs:(7,1)-(8,19): class A a => B a
index 8107ec9..3f42189 100644 (file)
@@ -5,5 +5,7 @@ tcfail036.hs:6:10:
       instance Num NUM -- Defined at tcfail036.hs:8:10
 
 tcfail036.hs:9:13:
-    Class `Num' used as a type
+    `Num' is not applied to enough type arguments
+    The first argument of `Eq' should have kind `*',
+    but `Num' has kind `* -> Constraint'
     In the instance declaration for `Eq Num'
diff --git a/testsuite/tests/typecheck/should_fail/tcfail041.hs b/testsuite/tests/typecheck/should_fail/tcfail041.hs
new file mode 100644 (file)
index 0000000..a796c02
--- /dev/null
@@ -0,0 +1,10 @@
+{-# LANGUAGE ImplicitParams #-}
+
+module ShouldFail where
+
+class (?imp :: Int) => D t where
+    methodD :: t -> t
+
+-- Don't repeat implicit parameter constraint on the instance
+instance D Int where
+    methodD x = x + ?imp
diff --git a/testsuite/tests/typecheck/should_fail/tcfail041.stderr b/testsuite/tests/typecheck/should_fail/tcfail041.stderr
new file mode 100644 (file)
index 0000000..bfa9de5
--- /dev/null
@@ -0,0 +1,12 @@
+
+tcfail041.hs:9:10:
+    Unbound implicit parameter (?imp::Int)
+      arising from the superclasses of an instance declaration
+    In the instance declaration for `D Int'
+
+tcfail041.hs:10:21:
+    Unbound implicit parameter (?imp::Int)
+      arising from a use of implicit parameter `?imp'
+    In the second argument of `(+)', namely `?imp'
+    In the expression: x + ?imp
+    In an equation for `methodD': methodD x = x + ?imp
index 569b85f..aa1330d 100644 (file)
@@ -1,2 +1,2 @@
 
-tcfail048.hs:3:7: Not in scope: type constructor or class `B'
+tcfail048.hs:3:8: Not in scope: type constructor or class `B'
index d67b969..4c815b6 100644 (file)
@@ -1,5 +1,5 @@
 
 tcfail057.hs:5:7:
-    Class `RealFrac' used as a type
-    In the type signature for `f':
-      f :: (RealFrac a) -> a -> a
+    Predicate `RealFrac a' used as a type
+    Expected kind `??', but `RealFrac a' has kind `Constraint'
+    In the type signature for `f': f :: (RealFrac a) -> a -> a
index 4c017c8..46ce26c 100644 (file)
@@ -1,4 +1,5 @@
-\r
-tcfail058.hs:6:6:\r
-    Type constructor `Array' used as a class\r
-    In the type signature for `f': f :: Array a => a -> b\r
+
+tcfail058.hs:6:7:
+    `Array a' is not applied to enough type arguments
+    Expected kind `Constraint', but `Array a' has kind `* -> *'
+    In the type signature for `f': f :: Array a => a -> b
index 1a1ee50..8111ae8 100644 (file)
@@ -1,5 +1,5 @@
 
 tcfail063.hs:6:9:
     `Num' is not applied to enough type arguments
-    Expected kind `?', but `Num' has kind `* -> *'
+    Expected kind `Constraint', but `Num' has kind `* -> Constraint'
     In the type signature for `moby': moby :: Num => Int -> a -> Int
index 60636c9..714e280 100644 (file)
@@ -1,4 +1,4 @@
-\r
-tcfail078.hs:5:6:\r
-    Type constructor `Integer' used as a class\r
-    In the type signature for `f': f :: Integer i => i\r
+
+tcfail078.hs:5:6:
+    `Integer' is applied to too many type arguments
+    In the type signature for `f': f :: Integer i => i
diff --git a/testsuite/tests/typecheck/should_fail/tcfail091.hs b/testsuite/tests/typecheck/should_fail/tcfail091.hs
deleted file mode 100644 (file)
index e64d1f5..0000000
+++ /dev/null
@@ -1,9 +0,0 @@
-{-# LANGUAGE ImplicitParams #-}
-
--- !!! Illegal superclass constraint
--- These examples actually crashed GHC 4.08.2
-
-module ShouldFail where
-
-class (?imp :: Int) => C t where
-
index ea302f0..ef8b8b1 100644 (file)
@@ -1,6 +1,6 @@
 
 tcfail134.hs:5:33:
     `XML' is not applied to enough type arguments
-    Expected kind `?', but `XML' has kind `* -> *'
+    Expected kind `?', but `XML' has kind `* -> Constraint'
     In the type `a -> XML'
     In the class declaration for `XML'
index 25031ae..9e1c99a 100644 (file)
@@ -1,5 +1,7 @@
 
-tcfail146.hs:7:16:
-    Class `SClass' used as a type
+tcfail146.hs:7:22:
+    Predicate `SClass a' used as a type
+    Expected kind `?', but `SClass a' has kind `Constraint'
+    In the type `SClass a'
     In the definition of data constructor `SCon'
     In the data type declaration for `SData'
index 81e77fe..360fb09 100644 (file)
@@ -1,7 +1,7 @@
 
 tcfail147.hs:7:19:
     `XClass' is not applied to enough type arguments
-    Expected kind `?', but `XClass' has kind `k0 -> *'
+    Expected kind `?', but `XClass' has kind `k0 -> Constraint'
     In the type `XClass'
     In the definition of data constructor `XCon'
     In the data type declaration for `XData'
index bf54960..857316d 100644 (file)
@@ -4,5 +4,5 @@ tcfail151.hs:1:14:
 
 tcfail151.hs:8:6:
     `Name a' is not applied to enough type arguments
-    Expected kind `?', but `Name a' has kind `* -> *'
+    Expected kind `Constraint', but `Name a' has kind `* -> Constraint'
     In the data type declaration for `Exp'
diff --git a/testsuite/tests/typecheck/should_fail/tcfail209.hs b/testsuite/tests/typecheck/should_fail/tcfail209.hs
new file mode 100644 (file)
index 0000000..4b83a44
--- /dev/null
@@ -0,0 +1,9 @@
+module FancyContextsWithoutExtension1 where
+
+type Showish = Show
+
+f :: (Showish a) => a -> a
+f = undefined
+
+g :: ((Show a, Num a), Eq a) => a -> a
+g = undefined
diff --git a/testsuite/tests/typecheck/should_fail/tcfail209.stderr b/testsuite/tests/typecheck/should_fail/tcfail209.stderr
new file mode 100644 (file)
index 0000000..964a10e
--- /dev/null
@@ -0,0 +1,11 @@
+
+tcfail209.hs:5:1:
+    Illegal irreducible constraint Showish a
+    (Use -XConstraintKind to permit this)
+    In the type signature for `f': f :: Showish a => a -> a
+
+tcfail209.hs:8:8:
+    Predicate `Show a' used as a type
+    Expected kind `*', but `Show a' has kind `Constraint'
+    In the type signature for `g':
+      g :: ((Show a, Num a), Eq a) => a -> a
diff --git a/testsuite/tests/typecheck/should_fail/tcfail210.hs b/testsuite/tests/typecheck/should_fail/tcfail210.hs
new file mode 100644 (file)
index 0000000..2d06ab9
--- /dev/null
@@ -0,0 +1,9 @@
+{-# LANGUAGE TypeFamilies #-}
+module FancyContextsWithoutExtension2 where
+
+type family Indexed a :: * -> Constraint
+type instance Indexed Int = Show
+type instance Indexed Bool = Num
+
+f :: (Indexed Int a) => a -> a
+f = undefined
\ No newline at end of file
diff --git a/testsuite/tests/typecheck/should_fail/tcfail210.stderr b/testsuite/tests/typecheck/should_fail/tcfail210.stderr
new file mode 100644 (file)
index 0000000..46f0404
--- /dev/null
@@ -0,0 +1,5 @@
+
+tcfail210.hs:4:31:
+    Unexpected named kind:
+        Constraint
+    Perhaps you meant to use -XConstraintKind?
diff --git a/testsuite/tests/typecheck/should_fail/tcfail211.hs b/testsuite/tests/typecheck/should_fail/tcfail211.hs
new file mode 100644 (file)
index 0000000..18fe8c6
--- /dev/null
@@ -0,0 +1,16 @@
+{-# LANGUAGE ImplicitParams, FlexibleContexts #-}
+
+module ShouldFail where
+
+class (?imp :: Int) => D t where
+    methodD :: t -> t
+
+instance (?imp :: Int) => D Int where
+    methodD x = x + ?imp
+
+test :: D Int => Int -- Requires FlexibleContexts
+test = methodD ?imp
+
+-- Should get reasonable error about unbound ?imp
+use :: IO ()
+use = print test
diff --git a/testsuite/tests/typecheck/should_fail/tcfail211.stderr b/testsuite/tests/typecheck/should_fail/tcfail211.stderr
new file mode 100644 (file)
index 0000000..81e04d6
--- /dev/null
@@ -0,0 +1,7 @@
+
+tcfail211.hs:16:13:
+    Unbound implicit parameter (?imp::Int)
+      arising from a use of `test'
+    In the first argument of `print', namely `test'
+    In the expression: print test
+    In an equation for `use': use = print test
diff --git a/testsuite/tests/typecheck/should_fail/tcfail212.hs b/testsuite/tests/typecheck/should_fail/tcfail212.hs
new file mode 100644 (file)
index 0000000..9ebc242
--- /dev/null
@@ -0,0 +1,14 @@
+{-# LANGUAGE ConstraintKind, MagicHash #-}
+module ShouldFail where
+
+import GHC.Exts
+
+-- If we turn on ConstraintKind the typing rule for
+-- tuple types is generalised. This test checks that
+-- we get a reasonable error for unreasonable tuples.
+
+f :: (Maybe, Either Int)
+f = (Just 1, Left 1)
+
+g :: (Int#, Int#)
+g = (1#, 2#)
\ No newline at end of file
diff --git a/testsuite/tests/typecheck/should_fail/tcfail212.stderr b/testsuite/tests/typecheck/should_fail/tcfail212.stderr
new file mode 100644 (file)
index 0000000..1e24032
--- /dev/null
@@ -0,0 +1,8 @@
+
+tcfail212.hs:10:1:
+    Unexpected tuple component kind: * -> *
+    In the type signature for `f': f :: (Maybe, Either Int)
+
+tcfail212.hs:13:1:
+    Unexpected tuple component kind: #
+    In the type signature for `g': g :: (Int#, Int#)
diff --git a/testsuite/tests/typecheck/should_fail/tcfail213.hs b/testsuite/tests/typecheck/should_fail/tcfail213.hs
new file mode 100644 (file)
index 0000000..133418a
--- /dev/null
@@ -0,0 +1,6 @@
+{-# LANGUAGE TypeFamilies, ConstraintKind #-}
+module ShouldFail where
+
+type family F a :: Constraint
+
+class (F a) => C a where
diff --git a/testsuite/tests/typecheck/should_fail/tcfail213.stderr b/testsuite/tests/typecheck/should_fail/tcfail213.stderr
new file mode 100644 (file)
index 0000000..e67034f
--- /dev/null
@@ -0,0 +1,7 @@
+
+tcfail213.hs:6:1:
+    Illegal irreducible constraint F a
+    in superclass/instance head context (Use -XUndecidableInstances to permit this)
+    In the context: (F a)
+    While checking the super-classes of class `C'
+    In the class declaration for `C'
diff --git a/testsuite/tests/typecheck/should_fail/tcfail214.hs b/testsuite/tests/typecheck/should_fail/tcfail214.hs
new file mode 100644 (file)
index 0000000..718810a
--- /dev/null
@@ -0,0 +1,7 @@
+{-# LANGUAGE TypeFamilies, ConstraintKind #-}
+module ShouldFail where
+
+type family F a :: Constraint
+
+class C a where
+instance (F a) => C [a] where
diff --git a/testsuite/tests/typecheck/should_fail/tcfail214.stderr b/testsuite/tests/typecheck/should_fail/tcfail214.stderr
new file mode 100644 (file)
index 0000000..2832df9
--- /dev/null
@@ -0,0 +1,7 @@
+
+tcfail214.hs:7:10:
+    Illegal irreducible constraint F a
+    in superclass/instance head context (Use -XUndecidableInstances to permit this)
+    In the context: (F a)
+    While checking the context of an instance declaration
+    In the instance declaration for `C [a]'
diff --git a/testsuite/tests/typecheck/should_fail/tcfail215.hs b/testsuite/tests/typecheck/should_fail/tcfail215.hs
new file mode 100644 (file)
index 0000000..be06f78
--- /dev/null
@@ -0,0 +1,9 @@
+{-# LANGUAGE ImplicitParams, MagicHash #-}
+
+module ShouldFail where
+
+import GHC.Exts
+
+-- As of GHC 7.4, we don't allow unlifted types in ImplicitParms
+foo :: (?x :: Int#) => Int
+foo = I# ?x
diff --git a/testsuite/tests/typecheck/should_fail/tcfail215.stderr b/testsuite/tests/typecheck/should_fail/tcfail215.stderr
new file mode 100644 (file)
index 0000000..c38e24e
--- /dev/null
@@ -0,0 +1,6 @@
+
+tcfail215.hs:8:15:
+    Expecting a lifted type, but `Int#' is unlifted
+    The type argument of the implicit parameter had kind `*',
+    but `Int#' has kind `#'
+    In the type signature for `foo': foo :: ?x :: Int# => Int
index a66586f..aeeacb6 100644 (file)
@@ -65,6 +65,9 @@ test('tcrun039', only_compiler_types(['ghc']), compile_and_run, [''])
 test('tcrun040', normal, compile_and_run, [''])
 test('tcrun041', omit_ways(['ghci']), compile_and_run, [''])
 test('tcrun042', normal, compile_and_run, [''])
+test('tcrun043', normal, compile_and_run, [''])
+test('tcrun044', normal, compile_and_run, [''])
+test('tcrun045', normal, compile_and_run, [''])
 
 test('church', normal, compile_and_run, [''])
 test('testeq2', normal, compile_and_run, [''])
diff --git a/testsuite/tests/typecheck/should_run/tcrun043.hs b/testsuite/tests/typecheck/should_run/tcrun043.hs
new file mode 100644 (file)
index 0000000..9e2e6d7
--- /dev/null
@@ -0,0 +1,42 @@
+{-# LANGUAGE GADTs, TypeFamilies, ConstraintKind #-}
+
+type Showish = Show
+
+f :: (Showish a) => a -> String
+f x = show x ++ show x
+
+
+data T = T
+data F = F
+
+data GADT a where
+    Tish :: GADT T
+    Fish :: GADT F
+
+type family Indexed a b :: Constraint
+type instance Indexed T b = Show b
+type instance Indexed F b = Num b
+
+g :: (Indexed a b) => GADT a -> b -> Either String b
+g Tish x = Left (show x)
+g Fish x = Right (x + 1)
+
+
+type TwoConstraints a = (Show a, Num a)
+
+h :: TwoConstraints a => a -> String
+h x = show (x + 1)
+
+
+main :: IO ()
+main = do
+    print $ f 9
+    print $ f True
+
+    print $ g Tish 10
+    print $ g Tish False
+    print $ g Fish 11
+    print $ g Fish 12.0
+
+    print $ h 13
+    print $ h 14.0
diff --git a/testsuite/tests/typecheck/should_run/tcrun043.stdout b/testsuite/tests/typecheck/should_run/tcrun043.stdout
new file mode 100644 (file)
index 0000000..d6a7977
--- /dev/null
@@ -0,0 +1,8 @@
+"99"
+"TrueTrue"
+Left "10"
+Left "False"
+Right 12
+Right 13.0
+"14"
+"15.0"
diff --git a/testsuite/tests/typecheck/should_run/tcrun044.hs b/testsuite/tests/typecheck/should_run/tcrun044.hs
new file mode 100644 (file)
index 0000000..0a2413c
--- /dev/null
@@ -0,0 +1,32 @@
+{-# LANGUAGE TypeFamilies, ConstraintKind #-}
+
+import qualified Data.Set as S
+
+-- You can't write this as an associated type synonym
+-- because it is indexed in more arguments than those
+-- bound by the class
+--
+-- A better solution would be index it only in "m"
+-- but then how do we write the instance for []?
+type family RMonadCtxt m a :: Constraint
+
+class RMonad m where
+    returnR :: (RMonadCtxt m a) => a -> m a
+    bindR :: (RMonadCtxt m a, RMonadCtxt m b) => m a -> (a -> m b) -> m b
+
+type instance RMonadCtxt [] a = ()
+
+instance RMonad [] where
+    returnR x = [x]
+    bindR = flip concatMap
+
+type instance RMonadCtxt S.Set a = Ord a
+
+instance RMonad S.Set where
+    returnR x = S.singleton x
+    bindR mx fxmy = S.fromList [y | x <- S.toList mx, y <- S.toList (fxmy x)]
+
+
+main = do
+    print $ (returnR 1 ++        returnR 2) `bindR` (\x -> returnR (x + 1) ++        returnR (x + 2))
+    print $ (returnR 1 `S.union` returnR 2) `bindR` (\x -> returnR (x + 1) `S.union` returnR (x + 2))
diff --git a/testsuite/tests/typecheck/should_run/tcrun044.stdout b/testsuite/tests/typecheck/should_run/tcrun044.stdout
new file mode 100644 (file)
index 0000000..78dbe3d
--- /dev/null
@@ -0,0 +1,2 @@
+[2,3,3,4]
+fromList [2,3,4]
diff --git a/testsuite/tests/typecheck/should_run/tcrun045.hs b/testsuite/tests/typecheck/should_run/tcrun045.hs
new file mode 100644 (file)
index 0000000..4a60262
--- /dev/null
@@ -0,0 +1,47 @@
+{-# LANGUAGE ImplicitParams, FlexibleContexts #-}
+
+-- !!! Implicit parameter superclass constraint
+-- These examples actually crashed GHC 4.08.2
+
+module Main where
+
+class C t where
+    methodC :: t -> t
+
+instance (?imp :: Int) => C Int where
+    methodC x = ?imp + x
+
+-- Check implicit parameter constraints in instance heads
+test1 :: Int
+test1 = methodC 10
+  where ?imp = 2
+
+test2 :: (?imp :: Int) => Int
+test2 = methodC 20
+  where ?imp = 2
+
+
+class (?imp :: Int) => D t where
+    methodD :: t -> t
+
+instance (?imp :: Int) => D Int where
+    methodD x = x + ?imp
+
+-- Check implicit parameter constraints in *superclass*, not just in instances
+test3 :: Int
+test3 = methodD 10
+  where ?imp = 2
+
+test4 :: (?imp :: Int) => Int
+test4 = methodD 20
+  where ?imp = 2
+
+test5 :: D Int => Int -- Requires FlexibleContexts
+test5 = methodD ?imp
+
+main = do
+    print test1
+    print $ let ?imp = 3 in test2
+    print test3
+    print $ let ?imp = 3 in test4
+    print $ let ?imp = 3 in test5
diff --git a/testsuite/tests/typecheck/should_run/tcrun045.stdout b/testsuite/tests/typecheck/should_run/tcrun045.stdout
new file mode 100644 (file)
index 0000000..4f76ac1
--- /dev/null
@@ -0,0 +1,5 @@
+12
+22
+12
+22
+6