[commit: ghc] master: Put the `ev_binds` of main function inside `runMainIO` (49e423e)

[git at git.haskell.org]

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

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

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

commit 49e423e9940a9122a4a417cfc7580b9984fb49eb
Author: HE, Tao <sighingnow at gmail.com>
Date:   Sun May 27 11:48:20 2018 -0400

    Put the `ev_binds` of main function inside `runMainIO`
    
    This ensures that the deferred type error can be emitted correctly.
    
    For `main` function in `Main` module, we have
    
        :Main.main = GHC.TopHandler.runMainIO main
    
    When the type of `main` is not `IO t` and the
    `-fdefer-type-errors` is enabled, the `ev_binds`
    of `main` function will contain deferred type
    errors.
    
    Previously, the `ev_binds` are bound to `runMainIO main`,
    rather than `main`, the type error exception at runtime
    cannot be handled properly. See Trac #13838.
    
    This patch fix that.
    
    Test Plan: make test TEST="T13838"
    
    Reviewers: bgamari
    
    Reviewed By: bgamari
    
    Subscribers: rwbarton, thomie, carter
    
    GHC Trac Issues: #13838
    
    Differential Revision: https://phabricator.haskell.org/D4708


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

49e423e9940a9122a4a417cfc7580b9984fb49eb
 compiler/typecheck/TcRnDriver.hs                   | 8 ++++++--
 testsuite/tests/typecheck/should_run/T13838.hs     | 6 ++++++
 testsuite/tests/typecheck/should_run/T13838.stderr | 6 ++++++
 testsuite/tests/typecheck/should_run/all.T         | 1 +
 4 files changed, 19 insertions(+), 2 deletions(-)

diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index 63fe36d..d20d43a 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -1692,8 +1692,12 @@ check_main dflags tcg_env explicit_mod_hdr
               ; root_main_id = Id.mkExportedVanillaId root_main_name
                                                       (mkTyConApp ioTyCon [res_ty])
               ; co  = mkWpTyApps [res_ty]
-              ; rhs = mkHsDictLet ev_binds $
-                      nlHsApp (mkLHsWrap co (nlHsVar run_main_id)) main_expr
+              -- The ev_binds of the `main` function may contain deferred
+              -- type error when type of `main` is not `IO a`. The `ev_binds`
+              -- must be put inside `runMainIO` to ensure the deferred type
+              -- error can be emitted correctly. See Trac #13838.
+              ; rhs = nlHsApp (mkLHsWrap co (nlHsVar run_main_id)) $
+                        mkHsDictLet ev_binds main_expr
               ; main_bind = mkVarBind root_main_id rhs }
 
         ; return (tcg_env { tcg_main  = Just main_name,
diff --git a/testsuite/tests/typecheck/should_run/T13838.hs b/testsuite/tests/typecheck/should_run/T13838.hs
new file mode 100644
index 0000000..265fdb0
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/T13838.hs
@@ -0,0 +1,6 @@
+{-# OPTIONS_GHC -fdefer-type-errors #-}
+
+module Main where
+
+main :: () -> ()
+main = undefined
diff --git a/testsuite/tests/typecheck/should_run/T13838.stderr b/testsuite/tests/typecheck/should_run/T13838.stderr
new file mode 100644
index 0000000..b2129f7
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/T13838.stderr
@@ -0,0 +1,6 @@
+T13838.exe: T13838.hs:6:1: error:
+    • Couldn't match expected type ‘IO t0’ with actual type ‘() -> ()’
+    • Probable cause: ‘main’ is applied to too few arguments
+      In the expression: main
+      When checking the type of the IO action ‘main’
+(deferred type error)
diff --git a/testsuite/tests/typecheck/should_run/all.T b/testsuite/tests/typecheck/should_run/all.T
index 3cf70b6..b7f37b7 100755
--- a/testsuite/tests/typecheck/should_run/all.T
+++ b/testsuite/tests/typecheck/should_run/all.T
@@ -130,6 +130,7 @@ test('TypeableEq', normal, compile_and_run, [''])
 test('T13435', normal, compile_and_run, [''])
 test('T11715', exit_code(1), compile_and_run, [''])
 test('T13594a', normal, ghci_script, ['T13594a.script'])
+test('T13838', [exit_code(1)], compile_and_run, ['-fdefer-type-errors'])
 test('T14218', normal, compile_and_run, [''])
 test('T14236', normal, compile_and_run, [''])
 test('T14925', normal, compile_and_run, [''])