diff options
| -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, ['']) |