[commit: ghc] wip/type-app: Bugfixing (890058c)

Fri Aug 7 12:05:11 UTC 2015

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

On branch  : wip/type-app
Link       : http://ghc.haskell.org/trac/ghc/changeset/890058c1d215d2d9de327542bd1c28ab83e92655/ghc

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

commit 890058c1d215d2d9de327542bd1c28ab83e92655
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Thu Jul 9 14:35:15 2015 -0400

    Bugfixing


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

890058c1d215d2d9de327542bd1c28ab83e92655
 compiler/typecheck/TcBinds.hs                          |  2 +-
 testsuite/tests/typecheck/should_fail/all.T            |  2 +-
 testsuite/tests/typecheck/should_fail/tcfail165.hs     |  3 ++-
 testsuite/tests/typecheck/should_fail/tcfail165.stderr | 12 ------------
 4 files changed, 4 insertions(+), 15 deletions(-)

diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs
index fda3bbb..1b2f72f 100644
--- a/compiler/typecheck/TcBinds.hs
+++ b/compiler/typecheck/TcBinds.hs
@@ -1279,7 +1279,7 @@ tcMonoBinds is_rec sig_fn no_gen
         -- e.g.         f = \(x::forall a. a->a) -> <body>
         --      We want to infer a higher-rank type for f
     setSrcSpan b_loc    $
-    do  { rhs_ty  <- newFlexiTyVarTy openTypeKind
+    do  { rhs_ty  <- newReturnTyVarTy openTypeKind
         ; mono_id <- newNoSigLetBndr no_gen name rhs_ty
         ; (co_fn, matches') <- tcExtendIdBndrs [TcIdBndr mono_id NotTopLevel] $
                                  -- We extend the error context even for a non-recursive
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index 2addf6a..3a3137e 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -147,7 +147,7 @@ test('tcfail160', normal, compile_fail, [''])
 test('tcfail161', normal, compile_fail, [''])
 test('tcfail162', normal, compile_fail, [''])
 test('tcfail164', normal, compile_fail, [''])
-test('tcfail165', normal, compile_fail, [''])
+test('tcfail165', normal, compile, [''])
 test('tcfail166', normal, compile_fail, [''])
 test('tcfail167', normal, compile_fail, [''])
 test('tcfail168', normal, compile_fail, [''])
diff --git a/testsuite/tests/typecheck/should_fail/tcfail165.hs b/testsuite/tests/typecheck/should_fail/tcfail165.hs
index c23a7f3..8b4cabd 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail165.hs
+++ b/testsuite/tests/typecheck/should_fail/tcfail165.hs
@@ -11,6 +11,7 @@ import Control.Concurrent
 --
 -- In GHC 7.0 it fails again! (and rightly so)
 
+-- With the Visible Type Application patch, this succeeds again.
+
 foo = do var <- newEmptyMVar :: IO (MVar (forall a. Show a => a -> String))
          putMVar var (show :: forall b. Show b => b -> String)
-
diff --git a/testsuite/tests/typecheck/should_fail/tcfail165.stderr b/testsuite/tests/typecheck/should_fail/tcfail165.stderr
deleted file mode 100644
index 2b8b434..0000000
--- a/testsuite/tests/typecheck/should_fail/tcfail165.stderr
+++ /dev/null
@@ -1,12 +0,0 @@
-
-tcfail165.hs:15:23:
-    Couldn't match expected type ‘forall a. Show a => a -> String’
-                with actual type ‘b0 -> String’
-    In the second argument of ‘putMVar’, namely
-      ‘(show :: forall b. Show b => b -> String)’
-    In a stmt of a 'do' block:
-      putMVar var (show :: forall b. Show b => b -> String)
-    In the expression:
-      do { var <- newEmptyMVar ::
-                    IO (MVar (forall a. Show a => a -> String));
-           putMVar var (show :: forall b. Show b => b -> String) }

