[commit: ghc] master: Add missing solveEqualities (4c746cb)

[git at git.haskell.org]

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

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

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

commit 4c746cb2886b06ca53a2edb62188827c3dbccce0
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Mon Apr 25 16:17:34 2016 +0100

    Add missing solveEqualities
    
    I'd missed a call to solveEqualities in the partial-type-sig case
    of TcBinds.tcUserTypeSig.
    
    Also the checkValidType test done there best done after inference,
    in checkInferredPolyId (and is already done there).
    
    Fixes Trac #11976


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

4c746cb2886b06ca53a2edb62188827c3dbccce0
 compiler/typecheck/TcBinds.hs                          | 15 +++++----------
 testsuite/tests/partial-sigs/should_fail/T11976.hs     |  7 +++++++
 testsuite/tests/partial-sigs/should_fail/T11976.stderr |  7 +++++++
 testsuite/tests/partial-sigs/should_fail/all.T         |  1 +
 4 files changed, 20 insertions(+), 10 deletions(-)

diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs
index 1a58719..ac19061 100644
--- a/compiler/typecheck/TcBinds.hs
+++ b/compiler/typecheck/TcBinds.hs
@@ -1797,8 +1797,9 @@ tcUserTypeSig hs_sig_ty mb_name
            <- pushTcLevelM_  $
                   -- When instantiating the signature, do so "one level in"
                   -- so that they can be unified under the forall
-              tcImplicitTKBndrs vars $
-              tcWildCardBinders wcs  $ \ wcs ->
+              solveEqualities           $
+              tcImplicitTKBndrs vars    $
+              tcWildCardBinders wcs     $ \ wcs ->
               tcExplicitTKBndrs hs_tvs  $ \ tvs2 ->
          do { -- Instantiate the type-class context; but if there
               -- is an extra-constraints wildcard, just discard it here
@@ -1815,20 +1816,14 @@ tcUserTypeSig hs_sig_ty mb_name
             ; theta <- zonkTcTypes theta
             ; tau   <- zonkTcType tau
 
-              -- Check for validity (eg rankN etc)
-              -- The ambiguity check will happen (from checkValidType),
-              -- but unnecessarily; it will always succeed because there
-              -- is no quantification
-            ; checkValidType ctxt_F (mkPhiTy theta tau)
-                -- NB: Do this in the context of the pushTcLevel so that
-                -- the TcLevel invariant is respected
-
             ; let bound_tvs
                     = unionVarSets [ allBoundVariabless theta
                                    , allBoundVariables tau
                                    , mkVarSet (map snd wcs) ]
             ; return ((wcs, tvs2, theta, tau), bound_tvs) }
 
+       -- NB: checkValidType on the final inferred type will
+       --     be done later by checkInferredPolyId
        ; loc <- getSrcSpanM
        ; return $
          TISI { sig_bndr  = PartialSig { sig_name = name, sig_hs_ty = hs_ty
diff --git a/testsuite/tests/partial-sigs/should_fail/T11976.hs b/testsuite/tests/partial-sigs/should_fail/T11976.hs
new file mode 100644
index 0000000..ce6e904
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_fail/T11976.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE PartialTypeSignatures, RankNTypes #-}
+
+module T11976 where
+
+type Lens s a = forall f. Functor f => (a -> f a) -> (s -> f s)
+
+foo = undefined :: Lens _ _ _
diff --git a/testsuite/tests/partial-sigs/should_fail/T11976.stderr b/testsuite/tests/partial-sigs/should_fail/T11976.stderr
new file mode 100644
index 0000000..06320d9
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_fail/T11976.stderr
@@ -0,0 +1,7 @@
+
+T11976.hs:7:20: error:
+    • Expecting one fewer arguments to ‘Lens t0 t1’
+      Expected kind ‘k0 -> *’, but ‘Lens t0 t1’ has kind ‘*’
+    • In the type ‘Lens _ _ _’
+      In the expression: undefined :: Lens _ _ _
+      In an equation for ‘foo’: foo = undefined :: Lens _ _ _
diff --git a/testsuite/tests/partial-sigs/should_fail/all.T b/testsuite/tests/partial-sigs/should_fail/all.T
index c62dd9c..a676a02 100644
--- a/testsuite/tests/partial-sigs/should_fail/all.T
+++ b/testsuite/tests/partial-sigs/should_fail/all.T
@@ -60,3 +60,4 @@ test('T10615', normal, compile_fail, [''])
 test('T10045', normal, compile_fail, [''])
 test('T10999', normal, compile_fail, [''])
 test('T11122', normal, compile, [''])
+test('T11976', normal, compile_fail, [''])