New fix for #11647. Avoid side effects like #17171

If a main module doesn't contain a header, we omit the check whether the main module is exported.
With this patch GHC, GHCi and runghc use the same code.

8 files changed, 35 insertions, 6 deletions

diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index 6c61487152..c7f1cf62d5 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -271,8 +271,10 @@ tcRnModuleTcRnM hsc_env mod_sum
                       ; tcg_env <- tcRnExports explicit_mod_hdr export_ies
                                      tcg_env
                       ; traceRn "rn4b: after exports" empty
-                      ; -- Check main is exported(must be after tcRnExports)
-                        checkMainExported tcg_env
+                      ; -- When a module header is specified,
+                        -- check that the main module exports a main function.
+                        -- (must be after tcRnExports)
+                        when explicit_mod_hdr $ checkMainExported tcg_env
                       ; -- Compare hi-boot iface (if any) with the real thing
                         -- Must be done after processing the exports
                         tcg_env <- checkHiBootIface tcg_env boot_info
@@ -1801,11 +1803,10 @@ checkMainExported tcg_env
       Just main_name ->
          do { dflags <- getDynFlags
             ; let main_mod = mainModIs dflags
-            ; when (ghcLink dflags /= LinkInMemory) $      -- #11647
-                checkTc (main_name `elem`
+            ; checkTc (main_name `elem`
                            concatMap availNames (tcg_exports tcg_env)) $
-                   text "The" <+> ppMainFn (nameRdrName main_name) <+>
-                   text "is not exported by module" <+> quotes (ppr main_mod) }
+                text "The" <+> ppMainFn (nameRdrName main_name) <+>
+                text "is not exported by module" <+> quotes (ppr main_mod) }
 
 ppMainFn :: RdrName -> SDoc
 ppMainFn main_fn
diff --git a/testsuite/tests/runghc/Makefile b/testsuite/tests/runghc/Makefile
index 25c2600f45..5823471ad4 100644
--- a/testsuite/tests/runghc/Makefile
+++ b/testsuite/tests/runghc/Makefile
@@ -23,5 +23,10 @@ T11247:
 	-'$(RUNGHC)' foo.
 	-'$(RUNGHC)' foo.bar
 
+T17171a:
+	'$(RUNGHC)' --ghc-arg=-Wall T17171a.hs
+T17171b:
+	'$(RUNGHC)' --ghc-arg=-Wall T17171b.hs
+
 T-signals-child:
 	-'$(RUNGHC)' T-signals-child.hs --runghc '$(RUNGHC)'
diff --git a/testsuite/tests/runghc/T17171a.hs b/testsuite/tests/runghc/T17171a.hs
new file mode 100644
index 0000000000..b64b424a01
--- /dev/null
+++ b/testsuite/tests/runghc/T17171a.hs
@@ -0,0 +1,4 @@
+module Main () where
+
+main :: IO ()
+main = putStrLn "Main"
diff --git a/testsuite/tests/runghc/T17171a.stderr b/testsuite/tests/runghc/T17171a.stderr
new file mode 100644
index 0000000000..5079cf4075
--- /dev/null
+++ b/testsuite/tests/runghc/T17171a.stderr
@@ -0,0 +1,5 @@
+Main.hs:1:1: error:
+    The IO action ‘main’ is not exported by module ‘Main’
+  |
+1 | module Main () where
+  | ^
diff --git a/testsuite/tests/runghc/T17171b.hs b/testsuite/tests/runghc/T17171b.hs
new file mode 100644
index 0000000000..329fe77460
--- /dev/null
+++ b/testsuite/tests/runghc/T17171b.hs
@@ -0,0 +1,4 @@
+module T17171b () where
+
+main :: IO ()
+main = putStrLn "NoMain"
diff --git a/testsuite/tests/runghc/T17171b.stderr b/testsuite/tests/runghc/T17171b.stderr
new file mode 100644
index 0000000000..088a4eca00
--- /dev/null
+++ b/testsuite/tests/runghc/T17171b.stderr
@@ -0,0 +1,6 @@
+
+T17171b.hs:4:1: warning: [-Wunused-top-binds]
+    Defined but not used: ‘main’
+  |
+4 | main = putStrLn "NoMain"
+  | ^^^^
diff --git a/testsuite/tests/runghc/T17171b.stdout b/testsuite/tests/runghc/T17171b.stdout
new file mode 100644
index 0000000000..e62d6c3957
--- /dev/null
+++ b/testsuite/tests/runghc/T17171b.stdout
@@ -0,0 +1 @@
+NoMain
diff --git a/testsuite/tests/runghc/all.T b/testsuite/tests/runghc/all.T
index 1b1b9eac23..1e159ee685 100644
--- a/testsuite/tests/runghc/all.T
+++ b/testsuite/tests/runghc/all.T
@@ -6,6 +6,9 @@ test('T11247', [req_interp, expect_broken(11247)], makefile_test, [])
 
 test('T6132', [when(opsys('darwin'), expect_broken(6132))], compile, [''])
 
+test('T17171a', [req_interp, expect_fail], makefile_test, [])
+test('T17171b', req_interp, makefile_test, [])
+
 test('T-signals-child',
      [ when(opsys('mingw32'), skip), req_interp
      , only_ways(['threaded1', 'threaded2'])