[commit: ghc] master: Fix #14320 by looking through HsParTy in more places (f1d2db6)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/f1d2db68d87f2c47a8dd4d86910e415599777f9f/ghc

>---------------------------------------------------------------

commit f1d2db68d87f2c47a8dd4d86910e415599777f9f
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date:   Sat Oct 7 16:59:03 2017 -0400

    Fix #14320 by looking through HsParTy in more places
    
    Summary:
    GHC was needlessly rejecting GADT constructors' type
    signatures that were surrounded in parentheses due to the fact that
    `splitLHsForAllTy` and `splitLHsQualTy` (which are used to check as
    part of checking if GADT constructor return types are correct)
    weren't looking through parentheses (i.e., `HsParTy`). This is
    easily fixed, though.
    
    Test Plan: make test TEST=T14320
    
    Reviewers: austin, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: rwbarton, thomie
    
    GHC Trac Issues: #14320
    
    Differential Revision: https://phabricator.haskell.org/D4072


>---------------------------------------------------------------

f1d2db68d87f2c47a8dd4d86910e415599777f9f
 compiler/hsSyn/HsTypes.hs      |  6 ++++--
 testsuite/tests/gadt/T14320.hs | 15 +++++++++++++++
 testsuite/tests/gadt/all.T     |  1 +
 3 files changed, 20 insertions(+), 2 deletions(-)

diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs
index b9cd946..e9dea63 100644
--- a/compiler/hsSyn/HsTypes.hs
+++ b/compiler/hsSyn/HsTypes.hs
@@ -1053,11 +1053,13 @@ splitLHsSigmaTy ty
 
 splitLHsForAllTy :: LHsType pass -> ([LHsTyVarBndr pass], LHsType pass)
 splitLHsForAllTy (L _ (HsForAllTy { hst_bndrs = tvs, hst_body = body })) = (tvs, body)
-splitLHsForAllTy body                                                    = ([], body)
+splitLHsForAllTy (L _ (HsParTy t)) = splitLHsForAllTy t
+splitLHsForAllTy body              = ([], body)
 
 splitLHsQualTy :: LHsType pass -> (LHsContext pass, LHsType pass)
 splitLHsQualTy (L _ (HsQualTy { hst_ctxt = ctxt, hst_body = body })) = (ctxt,     body)
-splitLHsQualTy body                                                  = (noLoc [], body)
+splitLHsQualTy (L _ (HsParTy t)) = splitLHsQualTy t
+splitLHsQualTy body              = (noLoc [], body)
 
 splitLHsInstDeclTy :: LHsSigType GhcRn
                    -> ([Name], LHsContext GhcRn, LHsType GhcRn)
diff --git a/testsuite/tests/gadt/T14320.hs b/testsuite/tests/gadt/T14320.hs
new file mode 100644
index 0000000..4acd4c8
--- /dev/null
+++ b/testsuite/tests/gadt/T14320.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE RankNTypes, GADTs, KindSignatures #-}
+module T14320
+where
+
+data Exp :: * where
+  Lit  :: (Int -> Exp)
+
+newtype TypedExp :: * -> * where
+  TEGood ::  forall a . (Exp -> (TypedExp a))
+
+-- The only difference here is that the type is wrapped in parentheses,
+-- but GHC 8.0.1 rejects this program
+--
+newtype TypedExpToo :: * -> * where
+  TEBad  :: (forall a . (Exp -> (TypedExpToo a)))
diff --git a/testsuite/tests/gadt/all.T b/testsuite/tests/gadt/all.T
index 3c825f0..c81ab80 100644
--- a/testsuite/tests/gadt/all.T
+++ b/testsuite/tests/gadt/all.T
@@ -114,3 +114,4 @@ test('T9096', normal, compile, [''])
 test('T9380', normal, compile_and_run, [''])
 test('T12087', normal, compile_fail, [''])
 test('T12468', normal, compile_fail, [''])
+test('T14320', normal, compile, [''])