diff options
| author | HE, Tao <sighingnow@gmail.com> | 2018-05-27 11:48:20 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2018-05-30 10:02:10 -0400 |
| commit | 49e423e9940a9122a4a417cfc7580b9984fb49eb (patch) | |
| tree | 8906639676278962a50695921b21758627126d0e | |
| parent | c65159dcf401d36e8920f43fec300264533642b9 (diff) | |
| download | haskell-49e423e9940a9122a4a417cfc7580b9984fb49eb.tar.gz | |
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
| -rw-r--r-- | compiler/typecheck/TcRnDriver.hs | 8 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_run/T13838.hs | 6 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_run/T13838.stderr | 6 | ||||
| -rwxr-xr-x | 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 63fe36d2c8..d20d43affb 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 0000000000..265fdb0986 --- /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 0000000000..b2129f7d13 --- /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 3cf70b6b32..b7f37b7507 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, ['']) |