Fix #13571 by adding an extension flag check

Test case: indexed-types/should_fail/T13571

9 files changed, 38 insertions, 3 deletions

diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index 91536e5d23..237f59f5b9 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -1951,6 +1951,7 @@ tcFamDecl1 parent (FamilyDecl { fdInfo = fam_info
   { traceTc "open type family:" (ppr tc_name)
   ; checkFamFlag tc_name
   ; inj' <- tcInjectivity binders inj
+  ; checkResultSigFlag tc_name sig  -- check after injectivity for better errors
   ; let tycon = mkFamilyTyCon tc_name binders res_kind
                                (resultVariableName sig) OpenSynFamilyTyCon
                                parent inj'
@@ -1968,6 +1969,7 @@ tcFamDecl1 parent (FamilyDecl { fdInfo = fam_info
                   ; return (inj', binders, res_kind) }
 
        ; checkFamFlag tc_name -- make sure we have -XTypeFamilies
+       ; checkResultSigFlag tc_name sig
 
          -- If Nothing, this is an abstract family in a hs-boot file;
          -- but eqns might be empty in the Just case as well
@@ -3707,6 +3709,14 @@ checkFamFlag tc_name
     err_msg = hang (text "Illegal family declaration for" <+> quotes (ppr tc_name))
                  2 (text "Enable TypeFamilies to allow indexed type families")
 
+checkResultSigFlag :: Name -> FamilyResultSig GhcRn -> TcM ()
+checkResultSigFlag tc_name (TyVarSig _ tvb)
+  = do { ty_fam_deps <- xoptM LangExt.TypeFamilyDependencies
+       ; checkTc ty_fam_deps $
+         hang (text "Illegal result type variable" <+> ppr tvb <+> text "for" <+> quotes (ppr tc_name))
+            2 (text "Enable TypeFamilyDependencies to allow result variable names") }
+checkResultSigFlag _ _ = return ()  -- other cases OK
+
 {- Note [Class method constraints]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Haskell 2010 is supposed to reject
diff --git a/testsuite/tests/dependent/should_compile/T14749.hs b/testsuite/tests/dependent/should_compile/T14749.hs
index c4480fad0f..bf3d5c488a 100644
--- a/testsuite/tests/dependent/should_compile/T14749.hs
+++ b/testsuite/tests/dependent/should_compile/T14749.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE GADTs, TypeOperators, DataKinds, TypeFamilies, PolyKinds #-}
+{-# LANGUAGE GADTs, TypeOperators, DataKinds, TypeFamilies, PolyKinds, TypeFamilyDependencies #-}
 
 module T14749 where
 
diff --git a/testsuite/tests/indexed-types/should_fail/T13571.hs b/testsuite/tests/indexed-types/should_fail/T13571.hs
new file mode 100644
index 0000000000..87036c801f
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T13571.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module T13571 where
+
+type family F a = r where
+    F a = a
diff --git a/testsuite/tests/indexed-types/should_fail/T13571.stderr b/testsuite/tests/indexed-types/should_fail/T13571.stderr
new file mode 100644
index 0000000000..482d6024a0
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T13571.stderr
@@ -0,0 +1,5 @@
+
+T13571.hs:5:1: error:
+    • Illegal result type variable r for ‘F’
+        Enable TypeFamilyDependencies to allow result variable names
+    • In the type family declaration for ‘F’
diff --git a/testsuite/tests/indexed-types/should_fail/T13571a.hs b/testsuite/tests/indexed-types/should_fail/T13571a.hs
new file mode 100644
index 0000000000..f4330c6366
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T13571a.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module T13571a where
+
+import Data.Kind
+
+type family G a = (r :: Type)
diff --git a/testsuite/tests/indexed-types/should_fail/T13571a.stderr b/testsuite/tests/indexed-types/should_fail/T13571a.stderr
new file mode 100644
index 0000000000..f92e5a909a
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T13571a.stderr
@@ -0,0 +1,5 @@
+
+T13571a.hs:7:1: error:
+    • Illegal result type variable (r :: Type) for ‘G’
+        Enable TypeFamilyDependencies to allow result variable names
+    • In the type family declaration for ‘G’
diff --git a/testsuite/tests/indexed-types/should_fail/all.T b/testsuite/tests/indexed-types/should_fail/all.T
index ca1781b8fd..a419610f9e 100644
--- a/testsuite/tests/indexed-types/should_fail/all.T
+++ b/testsuite/tests/indexed-types/should_fail/all.T
@@ -160,3 +160,5 @@ test('T16356_Fail1', normal, compile_fail, [''])
 test('T16356_Fail2', normal, compile_fail, [''])
 test('T16356_Fail3', normal, compile_fail, [''])
 test('T17008a', normal, compile_fail, ['-fprint-explicit-kinds'])
+test('T13571', normal, compile_fail, [''])
+test('T13571a', normal, compile_fail, [''])
diff --git a/testsuite/tests/patsyn/should_compile/T13441.hs b/testsuite/tests/patsyn/should_compile/T13441.hs
index 738017500d..8a7170dd45 100644
--- a/testsuite/tests/patsyn/should_compile/T13441.hs
+++ b/testsuite/tests/patsyn/should_compile/T13441.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE ScopedTypeVariables, PatternSynonyms, DataKinds, PolyKinds,
-             GADTs, TypeOperators, TypeFamilies #-}
+             GADTs, TypeOperators, TypeFamilies, TypeFamilyDependencies #-}
 
 module T13441 where
 
diff --git a/testsuite/tests/th/ClosedFam2TH.hs b/testsuite/tests/th/ClosedFam2TH.hs
index 2237aba651..abe2ddca3b 100644
--- a/testsuite/tests/th/ClosedFam2TH.hs
+++ b/testsuite/tests/th/ClosedFam2TH.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TemplateHaskell, TypeFamilies, PolyKinds, TypeApplications #-}
+{-# LANGUAGE TemplateHaskell, TypeFamilies, PolyKinds, TypeApplications, TypeFamilyDependencies #-}
 
 module ClosedFam2 where