Fix #13839: GHCi warnings do not respect the default module header
authorRoland Senn <rsx@bluewin.ch>
Sat, 2 Mar 2019 15:53:06 +0000 (16:53 +0100)
committerMarge Bot <ben+marge-bot@smart-cactus.org>
Fri, 8 Mar 2019 19:11:19 +0000 (14:11 -0500)
compiler/typecheck/TcRnExports.hs
testsuite/tests/rename/should_compile/T13839.script [new file with mode: 0644]
testsuite/tests/rename/should_compile/T13839.stdout [new file with mode: 0644]
testsuite/tests/rename/should_compile/T13839a.hs [new file with mode: 0644]
testsuite/tests/rename/should_compile/T13839a.stderr [new file with mode: 0644]
testsuite/tests/rename/should_compile/T13839b.hs [new file with mode: 0644]
testsuite/tests/rename/should_compile/all.T
testsuite/tests/rename/should_fail/T13839b.hs [new file with mode: 0644]
testsuite/tests/rename/should_fail/T13839b.stderr [new file with mode: 0644]
testsuite/tests/rename/should_fail/all.T

index b3baf6c..ea52b12 100644 (file)
@@ -170,22 +170,24 @@ tcRnExports explicit_mod exports
        -- list, to avoid bleating about re-exporting a deprecated
        -- thing (especially via 'module Foo' export item)
    do   {
-        -- In interactive mode, we behave as if he had
-        -- written "module Main where ..."
         ; dflags <- getDynFlags
         ; let is_main_mod = mainModIs dflags == this_mod
         ; let default_main = case mainFunIs dflags of
                  Just main_fun
                      | is_main_mod -> mkUnqual varName (fsLit main_fun)
                  _                 -> main_RDR_Unqual
+        ; has_main <- lookupGlobalOccRn_maybe default_main >>= return . isJust
+        -- If the module has no explicit header, and it has a main function,
+        -- then we add a header like "module Main(main) where ..." (#13839)
+        -- See Note [Modules without a module header]
         ; let real_exports
                  | explicit_mod = exports
-                 | ghcLink dflags == LinkInMemory = Nothing
-                 | otherwise
+                 | has_main
                           = Just (noLoc [noLoc (IEVar noExt
                                      (noLoc (IEName $ noLoc default_main)))])
                         -- ToDo: the 'noLoc' here is unhelpful if 'main'
                         --       turns out to be out of scope
+                 | otherwise = Nothing
 
         ; let do_it = exports_from_avail real_exports rdr_env imports this_mod
         ; (rn_exports, final_avails)
@@ -436,6 +438,34 @@ isDoc _ = False
 -- Renaming and typechecking of exports happens after everything else has
 -- been typechecked.
 
+{-
+Note [Modules without a module header]
+--------------------------------------------------
+
+The Haskell 2010 report says in section 5.1:
+
+>> An abbreviated form of module, consisting only of the module body, is
+>> permitted. If this is used, the header is assumed to be
+>> ‘module Main(main) where’.
+
+For modules without a module header, this is implemented the
+following way:
+
+If the module has a main function:
+   Then create a module header and export the main function.
+   This has the effect to mark the main function and all top level
+   functions called directly or indirectly via main as 'used',
+   and later on, unused top-level functions can be reported correctly.
+   There is no distinction between GHC and GHCi.
+If the module has NO main function:
+   Then export all top-level functions. This marks all top level
+   functions as 'used'.
+   In GHCi this has the effect, that we don't get any 'non-used' warnings.
+   In GHC, however, the 'has-main-module' check in the module
+   compiler/typecheck/TcRnDriver (functions checkMain / check-main) fires,
+   and we get the error:
+      The IO action ‘main’ is not defined in module ‘Main’
+-}
 
 
 -- Renaming exports lists is a minefield. Five different things can appear in
diff --git a/testsuite/tests/rename/should_compile/T13839.script b/testsuite/tests/rename/should_compile/T13839.script
new file mode 100644 (file)
index 0000000..212d7f7
--- /dev/null
@@ -0,0 +1,4 @@
+:l T13839a.hs
+:t nonUsed
+:l T13839b.hs
+:t nonUsed
diff --git a/testsuite/tests/rename/should_compile/T13839.stdout b/testsuite/tests/rename/should_compile/T13839.stdout
new file mode 100644 (file)
index 0000000..a700b14
--- /dev/null
@@ -0,0 +1,5 @@
+
+T13839a.hs:10:1: warning: [-Wunused-top-binds (in -Wextra, -Wunused-binds)]
+    Defined but not used: ‘nonUsed’
+nonUsed :: ()
+nonUsed :: ()
diff --git a/testsuite/tests/rename/should_compile/T13839a.hs b/testsuite/tests/rename/should_compile/T13839a.hs
new file mode 100644 (file)
index 0000000..74235be
--- /dev/null
@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -Wall #-}
+
+main :: IO ()
+main = putStrLn used
+
+used :: String
+used = "T13839"
+
+nonUsed :: ()
+nonUsed = ()
diff --git a/testsuite/tests/rename/should_compile/T13839a.stderr b/testsuite/tests/rename/should_compile/T13839a.stderr
new file mode 100644 (file)
index 0000000..84b9873
--- /dev/null
@@ -0,0 +1,3 @@
+
+T13839a.hs:10:1: warning: [-Wunused-top-binds (in -Wextra, -Wunused-binds)]
+    Defined but not used: ‘nonUsed’
diff --git a/testsuite/tests/rename/should_compile/T13839b.hs b/testsuite/tests/rename/should_compile/T13839b.hs
new file mode 100644 (file)
index 0000000..da7b0f4
--- /dev/null
@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -Wall #-}
+
+nomain :: IO ()
+nomain = putStrLn used
+
+used :: String
+used = "T13839"
+
+nonUsed :: ()
+nonUsed = ()
index 4d427de..51684f1 100644 (file)
@@ -155,6 +155,8 @@ test('T12597', normal, compile, [''])
 test('T12548', normal, compile, [''])
 test('T13132', normal, compile, [''])
 test('T13646', normal, compile, [''])
+test('T13839', combined_output, ghci_script, ['T13839.script'])
+test('T13839a', normal, compile, [''])
 test('LookupSub', [], multimod_compile, ['LookupSub', '-v0'])
 test('T14881', [], multimod_compile, ['T14881', '-W'])
 test('T14487', [], multimod_compile, ['T14487', '-v0'])
diff --git a/testsuite/tests/rename/should_fail/T13839b.hs b/testsuite/tests/rename/should_fail/T13839b.hs
new file mode 100644 (file)
index 0000000..da7b0f4
--- /dev/null
@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -Wall #-}
+
+nomain :: IO ()
+nomain = putStrLn used
+
+used :: String
+used = "T13839"
+
+nonUsed :: ()
+nonUsed = ()
diff --git a/testsuite/tests/rename/should_fail/T13839b.stderr b/testsuite/tests/rename/should_fail/T13839b.stderr
new file mode 100644 (file)
index 0000000..93846bd
--- /dev/null
@@ -0,0 +1,3 @@
+
+T13839b.hs:1:1: error:
+    The IO action ‘main’ is not defined in module ‘Main’
index 4f1b1fa..4b5e9e9 100644 (file)
@@ -126,6 +126,7 @@ test('T11592', normal, compile_fail, [''])
 test('T12879', normal, compile_fail, [''])
 test('T13644', normal, multimod_compile_fail, ['T13644','-v0'])
 test('T13568', normal, multimod_compile_fail, ['T13568','-v0'])
+test('T13839b', normal, compile_fail, [''])
 test('T13947', normal, compile_fail, [''])
 test('T13847', normal, multimod_compile_fail, ['T13847','-v0'])
 test('T14225', normal, ghci_script, ['T14225.script'])