Test associated type defaults

28 files changed, 209 insertions, 3 deletions

diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail4.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail4.stderr
index 2183ddfe97..220c93a097 100644
--- a/testsuite/tests/indexed-types/should_fail/SimpleFail4.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SimpleFail4.stderr
@@ -1,4 +1,6 @@
 
-SimpleFail4.hs:8:11:
-    Unexpected type `Int' where type variable expected
-    In the declaration of `S2 Int'
+SimpleFail4.hs:8:3:
+    Type indexes must match class instance head
+    Found `Int' but expected `a'
+    In the type synonym instance declaration for `S2'
+    In the class declaration for `C2'
diff --git a/testsuite/tests/typecheck/should_compile/Tc251_Help.hs b/testsuite/tests/typecheck/should_compile/Tc251_Help.hs
new file mode 100644
index 0000000000..6f3243c065
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/Tc251_Help.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE TypeFamilies #-}
+module Tc251_Help where
+
+class Cls a where
+    type Fam a :: *
+    type Fam a = Maybe a
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index 862ac9f2bf..46e7c83cea 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -340,6 +340,12 @@ test('T4969', normal, compile, [''])
 test('T5120', normal, compile, [''])
 test('mc18', normal, compile, [''])
 test('tc249', normal, compile, [''])
+test('tc250', normal, compile, [''])
+test('tc251', extra_clean(['Tc251_Help.hi', 'Tc251_Help.o']),
+              multisrc_compile, ['tc251', ['Tc251_Help.hs'], '-v0'])
+test('tc252', normal, compile, [''])
+test('tc253', normal, compile, [''])
+test('tc254', normal, compile, [''])
 
 test('GivenOverlapping', normal, compile, [''])
 test('SilentParametersOverlapping', normal, compile, [''])
diff --git a/testsuite/tests/typecheck/should_compile/tc250.hs b/testsuite/tests/typecheck/should_compile/tc250.hs
new file mode 100644
index 0000000000..7464a078aa
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/tc250.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE TypeFamilies #-}
+module ShouldCompile where
+
+class Cls a where
+    type Fam a :: *
+    type Fam a = Maybe a
+
+instance Cls Int where
+    -- Gets type family from default
+
+inc :: (Fam a ~ Maybe Int) => a -> Fam a -> Fam a
+inc _proxy (Just x) = Just (x + 1)
+inc _proxy Nothing  = Just 0
+
+foo :: Maybe Int -> Maybe Int
+foo = inc (undefined :: Int)
diff --git a/testsuite/tests/typecheck/should_compile/tc251.hs b/testsuite/tests/typecheck/should_compile/tc251.hs
new file mode 100644
index 0000000000..b8b4984143
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/tc251.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE TypeFamilies #-}

+module ShouldCompile where

+

+import Tc251_Help

+

+instance Cls Int where

+

+inc :: (Fam a ~ Maybe Int) => a -> Fam a -> Fam a

+inc _proxy (Just x) = Just (x + 1)

+inc _proxy Nothing  = Just 0

+

+foo :: Maybe Int -> Maybe Int

+foo = inc (undefined :: Int)

diff --git a/testsuite/tests/typecheck/should_compile/tc252.hs b/testsuite/tests/typecheck/should_compile/tc252.hs
new file mode 100644
index 0000000000..f5b129f6bf
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/tc252.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE TypeFamilies #-}
+module ShouldCompile where
+
+class Cls a where
+    type Fam a :: *
+    type Fam a = Maybe a
+
+instance Cls Int where
+    -- Overriding default
+    type Fam Int = Bool
+
+nott :: (Fam a ~ Bool) => a -> Fam a -> Fam a
+nott _proxy False = True
+nott _proxy True  = False
+
+foo :: Bool -> Bool
+foo = nott (undefined :: Int)
diff --git a/testsuite/tests/typecheck/should_compile/tc253.hs b/testsuite/tests/typecheck/should_compile/tc253.hs
new file mode 100644
index 0000000000..4771b82435
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/tc253.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE TypeFamilies #-}
+module ShouldCompile where
+
+class Cls a where
+    type Fam a b :: *
+    -- Multiple defaults!
+    type Fam a Bool = Maybe a
+    type Fam a Int = (String, a)
+
+instance Cls Int where
+    -- Gets type family from default
+
+inc :: (Fam a Bool ~ Maybe Int, Fam a Int ~ (String, Int)) => a -> Fam a Bool -> Fam a Int -> Fam a Bool
+inc _proxy (Just x) (_, y) = Just (x + y + 1)
+inc _proxy Nothing  (_, y) = Just y
+
+foo :: Maybe Int -> (String, Int) -> Maybe Int
+foo = inc (undefined :: Int)
diff --git a/testsuite/tests/typecheck/should_compile/tc254.hs b/testsuite/tests/typecheck/should_compile/tc254.hs
new file mode 100644
index 0000000000..5d089dce71
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/tc254.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -fwarn-missing-methods #-}
+module AssocTyDef01 where
+
+class Cls a where
+    type Typ a
+
+instance Cls Int where
+    -- No default: should get warning
\ No newline at end of file
diff --git a/testsuite/tests/typecheck/should_compile/tc254.stderr b/testsuite/tests/typecheck/should_compile/tc254.stderr
new file mode 100644
index 0000000000..e84ab61709
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/tc254.stderr
@@ -0,0 +1,4 @@
+
+tc254.hs:8:1:
+    Warning: No explicit AT declaration for `Typ'
+    In the instance declaration for `Cls Int'
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef01.hs b/testsuite/tests/typecheck/should_fail/AssocTyDef01.hs
new file mode 100644
index 0000000000..f3b0d3b43f
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/AssocTyDef01.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE TypeFamilies #-}
+module AssocTyDef01 where
+
+class OtherCls a where
+    type OtherTyp a
+
+class Cls a where
+    type Typ a
+    type OtherType a = Int
+      -- Default for another class AT: want error
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef01.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef01.stderr
new file mode 100644
index 0000000000..5d3a596d97
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/AssocTyDef01.stderr
@@ -0,0 +1,3 @@
+
+AssocTyDef01.hs:9:10:
+    `OtherType' is not a (visible) associated type of class `Cls'
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef02.hs b/testsuite/tests/typecheck/should_fail/AssocTyDef02.hs
new file mode 100644
index 0000000000..8f22d4ce1c
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/AssocTyDef02.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE TypeFamilies #-}
+module AssocTyDef02 where
+
+class Cls a where
+    type Typ a
+    type Typ b = Int
+      -- Default is not parametric in type class params
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef02.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef02.stderr
new file mode 100644
index 0000000000..9facede780
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/AssocTyDef02.stderr
@@ -0,0 +1,6 @@
+
+AssocTyDef02.hs:6:5:
+    Type indexes must match class instance head
+    Found `b' but expected `a'
+    In the type synonym instance declaration for `Typ'
+    In the class declaration for `Cls'
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef03.hs b/testsuite/tests/typecheck/should_fail/AssocTyDef03.hs
new file mode 100644
index 0000000000..790f2740ee
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/AssocTyDef03.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE TypeFamilies #-}
+module AssocTyDef03 where
+
+class Cls a where
+    data Typ a
+    type Typ a = Int
+      -- Default for data family :-(
\ No newline at end of file
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef03.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef03.stderr
new file mode 100644
index 0000000000..2572980161
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/AssocTyDef03.stderr
@@ -0,0 +1,5 @@
+
+AssocTyDef03.hs:6:5:
+    Wrong category of family instance; declaration was for a data type
+    In the type synonym instance declaration for `Typ'
+    In the class declaration for `Cls'
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef04.hs b/testsuite/tests/typecheck/should_fail/AssocTyDef04.hs
new file mode 100644
index 0000000000..2ff833725e
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/AssocTyDef04.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE TypeFamilies #-}
+module AssocTyDef04 where
+
+class Cls a where
+    type Typ a
+    type Typ a = Maybe
+      -- Wrong kind for default
\ No newline at end of file
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef04.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef04.stderr
new file mode 100644
index 0000000000..5eb90241a5
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/AssocTyDef04.stderr
@@ -0,0 +1,7 @@
+
+AssocTyDef04.hs:6:18:
+    `Maybe' is not applied to enough type arguments
+    Expected kind `*', but `Maybe' has kind `* -> *'
+    In the type `Maybe'
+    In the type synonym instance declaration for `Typ'
+    In the class declaration for `Cls'
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef05.hs b/testsuite/tests/typecheck/should_fail/AssocTyDef05.hs
new file mode 100644
index 0000000000..097d14f40a
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/AssocTyDef05.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE TypeFamilies #-}
+module AssocTyDef05 where
+
+class Cls a where
+    type Typ a
+    type Typ = Maybe
+      -- Too few params for default
\ No newline at end of file
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef05.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef05.stderr
new file mode 100644
index 0000000000..0518c84b69
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/AssocTyDef05.stderr
@@ -0,0 +1,5 @@
+
+AssocTyDef05.hs:6:5:
+    Number of parameters must match family declaration; expected 1
+    In the type synonym instance declaration for `Typ'
+    In the class declaration for `Cls'
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef06.hs b/testsuite/tests/typecheck/should_fail/AssocTyDef06.hs
new file mode 100644
index 0000000000..fb595a3e27
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/AssocTyDef06.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE TypeFamilies #-}
+module AssocTyDef06 where
+
+class Cls a where
+    type Typ a
+    type Typ a Int = Int
+      -- Too many params for default
\ No newline at end of file
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef06.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef06.stderr
new file mode 100644
index 0000000000..7c79207a49
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/AssocTyDef06.stderr
@@ -0,0 +1,5 @@
+
+AssocTyDef06.hs:6:5:
+    Family instance has too many parameters: `Typ'
+    In the type synonym instance declaration for `Typ'
+    In the class declaration for `Cls'
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef07.hs b/testsuite/tests/typecheck/should_fail/AssocTyDef07.hs
new file mode 100644
index 0000000000..65c7f5f3f5
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/AssocTyDef07.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE TypeFamilies #-}
+module AssocTyDef07 where
+
+class Cls a where
+    type Typ a = Int
+     -- Default without family
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef07.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef07.stderr
new file mode 100644
index 0000000000..4a4562d0e0
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/AssocTyDef07.stderr
@@ -0,0 +1,3 @@
+
+AssocTyDef07.hs:5:10:
+    `Typ' is not a (visible) associated type of class `Cls'
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef08.hs b/testsuite/tests/typecheck/should_fail/AssocTyDef08.hs
new file mode 100644
index 0000000000..6a7d808bb7
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/AssocTyDef08.hs
@@ -0,0 +1,5 @@
+module AssocTyDef07 where
+
+class Cls a where
+    type Typ a = Int
+     -- Default without family OR extension flag
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef08.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef08.stderr
new file mode 100644
index 0000000000..c45132f994
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/AssocTyDef08.stderr
@@ -0,0 +1,3 @@
+
+AssocTyDef08.hs:4:10:
+    `Typ' is not a (visible) associated type of class `Cls'
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef09.hs b/testsuite/tests/typecheck/should_fail/AssocTyDef09.hs
new file mode 100644
index 0000000000..085cbb5bb3
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/AssocTyDef09.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE TypeFamilies #-}
+module AssocTyDef01 where
+
+type family OtherTyp a
+
+class Cls a where
+    type Typ a
+    type OtherType a = Int
+      -- Default for top level AT: want error
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef09.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef09.stderr
new file mode 100644
index 0000000000..053450c48e
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/AssocTyDef09.stderr
@@ -0,0 +1,3 @@
+
+AssocTyDef09.hs:8:10:
+    `OtherType' is not a (visible) associated type of class `Cls'
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index 0788788e89..cc88208512 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -245,3 +245,13 @@ test('T5246',normal,compile_fail,[''])
 test('T5300',normal,compile_fail,[''])
 test('T5095',normal,compile_fail,[''])
 test('T1897a',normal,compile_fail,[''])
+
+test('AssocTyDef01', normal, compile_fail, [''])
+test('AssocTyDef02', normal, compile_fail, [''])
+test('AssocTyDef03', normal, compile_fail, [''])
+test('AssocTyDef04', normal, compile_fail, [''])
+test('AssocTyDef05', normal, compile_fail, [''])
+test('AssocTyDef06', normal, compile_fail, [''])
+test('AssocTyDef07', normal, compile_fail, [''])
+test('AssocTyDef08', normal, compile_fail, [''])
+test('AssocTyDef09', normal, compile_fail, [''])