diff options
author | Thomas Miedema <thomasmiedema@gmail.com> | 2015-02-23 03:38:26 -0600 |
---|---|---|
committer | Austin Seipp <austin@well-typed.com> | 2015-02-23 03:38:27 -0600 |
commit | 0fa20726b0587530712677e50a56c2b03ba43095 (patch) | |
tree | b82eaaf4828a17dfc72845ac11a918feed801bc3 | |
parent | b2be772a97f6e7fe9f1d1c28108949f81a13158b (diff) | |
download | haskell-0fa20726b0587530712677e50a56c2b03ba43095.tar.gz |
Error out on `Main` without `main` in GHCi (#7765)
Summary:
GHC does 2 validation checks for module `Main`:
* does `main` exist
* is `main` exported (#414)
The second check is done in ghc as well as in ghci (and runghc and ghc -e).
The first check however is currently not done in ghci, to prevent "'main' is
not in scope" errors when loading simple scripts. See commit d28ba8c8009 for
more information.
This commit tightens the special case for ghci. When the file does not contain
a main function, but does contain an explicit module header (i.e. "module Main
where"), then /do/ raise an error in ghci (and runghc and ghc -e) as well
Test Plan:
module/T7765: a module Main with an explicit module header but without a
main function should be an error for all Ways.
Additionaly: delete test module/mod174. It was added in commit 5a54c38, but it
is a duplicate of module/T414.
Reviewers: austin
Reviewed By: austin
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D649
GHC Trac Issues: #7765
-rw-r--r-- | compiler/typecheck/TcRnDriver.hs | 37 | ||||
-rw-r--r-- | compiler/typecheck/TcRnMonad.hs | 5 | ||||
-rw-r--r-- | compiler/typecheck/TcRnTypes.hs | 4 | ||||
-rw-r--r-- | compiler/utils/IOEnv.hs | 9 | ||||
-rw-r--r-- | docs/users_guide/7.12.1-notes.xml | 3 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_fail/T5686.hs | 14 | ||||
-rw-r--r-- | testsuite/tests/ghci/prog012/FooBar.hs (renamed from testsuite/tests/ghci/prog012/Main.hs) | 2 | ||||
-rw-r--r-- | testsuite/tests/ghci/prog012/prog012.script | 2 | ||||
-rw-r--r-- | testsuite/tests/ghci/scripts/ghci022.hs | 2 | ||||
-rw-r--r-- | testsuite/tests/ghci/scripts/ghci027.script | 4 | ||||
-rw-r--r-- | testsuite/tests/ghci/scripts/ghci027_1.hs | 2 | ||||
-rw-r--r-- | testsuite/tests/ghci/scripts/ghci027_2.hs | 2 | ||||
-rw-r--r-- | testsuite/tests/module/T7765.hs | 1 | ||||
-rw-r--r-- | testsuite/tests/module/T7765.stderr | 2 | ||||
-rw-r--r-- | testsuite/tests/module/all.T | 4 | ||||
-rw-r--r-- | testsuite/tests/module/mod174.hs | 9 | ||||
-rw-r--r-- | testsuite/tests/module/mod174.stderr | 3 | ||||
-rw-r--r-- | testsuite/tests/parser/should_fail/readFail013.hs | 2 |
18 files changed, 43 insertions, 64 deletions
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index c3b16ca367..85d5a2ade1 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -3,6 +3,8 @@ (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 \section[TcMovectle]{Typechecking a whole module} + +https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/TypeChecker -} {-# LANGUAGE CPP, NondecreasingIndentation #-} @@ -268,7 +270,7 @@ tcRnModuleTcRnM :: HscEnv -> HsParsedModule -> (Module, SrcSpan) -> TcRn TcGblEnv --- Factored out separately so that a Core plugin can +-- Factored out separately from tcRnModule so that a Core plugin can -- call the type checker directly tcRnModuleTcRnM hsc_env hsc_src (HsParsedModule { @@ -283,7 +285,7 @@ tcRnModuleTcRnM hsc_env hsc_src do { let { dflags = hsc_dflags hsc_env } ; tcg_env <- tcRnSignature dflags hsc_src ; - setGblEnv tcg_env $ do { + setGblEnv tcg_env { tcg_mod_name=maybe_mod } $ do { -- Deal with imports; first add implicit prelude implicit_prelude <- xoptM Opt_ImplicitPrelude; @@ -1070,23 +1072,11 @@ instMisMatch is_boot inst {- ************************************************************************ * * - Type-checking the top level of a module + Type-checking the top level of a module (continued) * * ************************************************************************ - -tcRnGroup takes a bunch of top-level source-code declarations, and - * renames them - * gets supporting declarations from interface files - * typechecks them - * zonks them - * and augments the TcGblEnv with the results - -In Template Haskell it may be called repeatedly for each group of -declarations. It expects there to be an incoming TcGblEnv in the -monad; it augments it and returns the new TcGblEnv. -} ------------------------------------------------- rnTopSrcDecls :: [Name] -> HsGroup RdrName -> TcM (TcGblEnv, HsGroup Name) -- Fails if there are any errors rnTopSrcDecls extra_deps group @@ -1108,14 +1098,6 @@ rnTopSrcDecls extra_deps group return (tcg_env', rn_decls) } -{- -************************************************************************ -* * - tcTopSrcDecls -* * -************************************************************************ --} - tcTopSrcDecls :: ModDetails -> HsGroup Name -> TcM (TcGblEnv, TcLclEnv) tcTopSrcDecls boot_details (HsGroup { hs_tyclds = tycl_decls, @@ -1339,10 +1321,12 @@ check_main dflags tcg_env mod = tcg_mod tcg_env main_mod = mainModIs dflags main_fn = getMainFun dflags + interactive = ghcLink dflags == LinkInMemory + implicit_mod = isNothing (tcg_mod_name tcg_env) - complain_no_main | ghcLink dflags == LinkInMemory = return () - | otherwise = failWithTc noMainMsg - -- In interactive mode, don't worry about the absence of 'main' + complain_no_main = checkTc (interactive && implicit_mod) noMainMsg + -- In interactive mode, without an explicit module header, don't + -- worry about the absence of 'main'. -- In other modes, fail altogether, so that we don't go on -- and complain a second time when processing the export list. @@ -1358,6 +1342,7 @@ getMainFun dflags = case mainFunIs dflags of Just fn -> mkRdrUnqual (mkVarOccFS (mkFastString fn)) Nothing -> main_RDR_Unqual +-- If we are in module Main, check that 'main' is exported. checkMainExported :: TcGblEnv -> TcM () checkMainExported tcg_env = case tcg_main tcg_env of diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs index 84ae0b97de..f3c16cb555 100644 --- a/compiler/typecheck/TcRnMonad.hs +++ b/compiler/typecheck/TcRnMonad.hs @@ -120,6 +120,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this tcg_mod = mod, tcg_src = hsc_src, tcg_sig_of = getSigOf dflags (moduleName mod), + tcg_mod_name = Nothing, tcg_impl_rdr_env = Nothing, tcg_rdr_env = emptyGlobalRdrEnv, tcg_fix_env = emptyNameEnv, @@ -463,7 +464,7 @@ instance MonadUnique (IOEnv (Env gbl lcl)) where {- ************************************************************************ * * - Debugging + Accessing input/output * * ************************************************************************ -} @@ -762,7 +763,7 @@ reportWarning err ; writeTcRef errs_var (warns `snocBag` warn, errs) } try_m :: TcRn r -> TcRn (Either IOEnvFailure r) --- Does try_m, with a debug-trace on failure +-- Does tryM, with a debug-trace on failure try_m thing = do { mb_r <- tryM thing ; case mb_r of diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index b460faee12..23d0635868 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -27,7 +27,7 @@ module TcRnTypes( TcGblEnv(..), TcLclEnv(..), IfGblEnv(..), IfLclEnv(..), - -- Ranamer types + -- Renamer types ErrCtxt, RecFieldEnv(..), ImportAvails(..), emptyImportAvails, plusImportAvails, WhereFrom(..), mkModDeps, @@ -334,6 +334,8 @@ data TcGblEnv -- ^ What kind of module (regular Haskell, hs-boot, ext-core) tcg_sig_of :: Maybe Module, -- ^ Are we being compiled as a signature of an implementation? + tcg_mod_name :: Maybe (Located ModuleName), + -- ^ @Nothing@: \"module X where\" is omitted tcg_impl_rdr_env :: Maybe GlobalRdrEnv, -- ^ Environment used only during -sig-of for resolving top level -- bindings. See Note [Signature parameters in TcGblEnv and DynFlags] diff --git a/compiler/utils/IOEnv.hs b/compiler/utils/IOEnv.hs index fd98bad213..1ddf170cf0 100644 --- a/compiler/utils/IOEnv.hs +++ b/compiler/utils/IOEnv.hs @@ -102,7 +102,7 @@ instance ContainsModule env => HasModule (IOEnv env) where return $ extractModule env ---------------------------------------------------------------------- --- Fundmantal combinators specific to the monad +-- Fundamental combinators specific to the monad ---------------------------------------------------------------------- @@ -113,9 +113,9 @@ runIOEnv env (IOEnv m) = m env --------------------------- {-# NOINLINE fixM #-} - -- Aargh! Not inlining fixTc alleviates a space leak problem. - -- Normally fixTc is used with a lazy tuple match: if the optimiser is - -- shown the definition of fixTc, it occasionally transforms the code + -- Aargh! Not inlining fixM alleviates a space leak problem. + -- Normally fixM is used with a lazy tuple match: if the optimiser is + -- shown the definition of fixM, it occasionally transforms the code -- in such a way that the code generator doesn't spot the selector -- thunks. Sigh. @@ -213,4 +213,3 @@ setEnv new_env (IOEnv m) = IOEnv (\ _ -> m new_env) updEnv :: (env -> env') -> IOEnv env' a -> IOEnv env a {-# INLINE updEnv #-} updEnv upd (IOEnv m) = IOEnv (\ env -> m (upd env)) - diff --git a/docs/users_guide/7.12.1-notes.xml b/docs/users_guide/7.12.1-notes.xml index 7f9346edf2..5bdf96d9e1 100644 --- a/docs/users_guide/7.12.1-notes.xml +++ b/docs/users_guide/7.12.1-notes.xml @@ -82,7 +82,8 @@ <itemizedlist> <listitem> <para> - TODO FIXME + <literal>Main</literal> with an explicit module header but + without <literal>main</literal> is now an error (#7765). </para> </listitem> </itemizedlist> diff --git a/testsuite/tests/deriving/should_fail/T5686.hs b/testsuite/tests/deriving/should_fail/T5686.hs index 425a13c839..a61df0627b 100644 --- a/testsuite/tests/deriving/should_fail/T5686.hs +++ b/testsuite/tests/deriving/should_fail/T5686.hs @@ -1,7 +1,7 @@ -{-# LANGUAGE TypeFamilies, DeriveFunctor #-}
-module Main where
-
-data U a = U (G a) deriving Functor
-
-class A a where
- type G a
+{-# LANGUAGE TypeFamilies, DeriveFunctor #-} +module T5686 where + +data U a = U (G a) deriving Functor + +class A a where + type G a diff --git a/testsuite/tests/ghci/prog012/Main.hs b/testsuite/tests/ghci/prog012/FooBar.hs index d49d063551..eeb29bbdbb 100644 --- a/testsuite/tests/ghci/prog012/Main.hs +++ b/testsuite/tests/ghci/prog012/FooBar.hs @@ -1,4 +1,4 @@ -module Main where +module FooBar where import Foo import Bar diff --git a/testsuite/tests/ghci/prog012/prog012.script b/testsuite/tests/ghci/prog012/prog012.script index 49af938b75..5e178389ac 100644 --- a/testsuite/tests/ghci/prog012/prog012.script +++ b/testsuite/tests/ghci/prog012/prog012.script @@ -10,7 +10,7 @@ :shell cp Bar1.hs Bar.hs -:load Main.hs +:load FooBar.hs :shell sleep 1 :shell cp Bar2.hs Bar.hs diff --git a/testsuite/tests/ghci/scripts/ghci022.hs b/testsuite/tests/ghci/scripts/ghci022.hs index d49fdba319..f87946a758 100644 --- a/testsuite/tests/ghci/scripts/ghci022.hs +++ b/testsuite/tests/ghci/scripts/ghci022.hs @@ -1,2 +1,2 @@ -module Main where +module GHCi022 where 'a' ' diff --git a/testsuite/tests/ghci/scripts/ghci027.script b/testsuite/tests/ghci/scripts/ghci027.script index aaf0ac5544..7a24f527bb 100644 --- a/testsuite/tests/ghci/scripts/ghci027.script +++ b/testsuite/tests/ghci/scripts/ghci027.script @@ -1,8 +1,8 @@ -- Test for #1617 :!cp ghci027_1.hs ghci027.hs :load ghci027 -:browse *Main +:browse *T1617 :!sleep 1 :!cp ghci027_2.hs ghci027.hs :reload -:browse *Main +:browse *T1617 diff --git a/testsuite/tests/ghci/scripts/ghci027_1.hs b/testsuite/tests/ghci/scripts/ghci027_1.hs index a1a7bfac37..23d52f0fee 100644 --- a/testsuite/tests/ghci/scripts/ghci027_1.hs +++ b/testsuite/tests/ghci/scripts/ghci027_1.hs @@ -1,5 +1,5 @@ -- Test for #1617 -module Main where +module T1617 where import Prelude () import Control.Monad (mplus) import qualified Control.Monad (mplus) diff --git a/testsuite/tests/ghci/scripts/ghci027_2.hs b/testsuite/tests/ghci/scripts/ghci027_2.hs index df99d7d1c0..c4db784dc2 100644 --- a/testsuite/tests/ghci/scripts/ghci027_2.hs +++ b/testsuite/tests/ghci/scripts/ghci027_2.hs @@ -1,5 +1,5 @@ -- Test for #1617 -module Main where +module T1617 where import Prelude () --import Control.Monad (mplus) import qualified Control.Monad (mplus) diff --git a/testsuite/tests/module/T7765.hs b/testsuite/tests/module/T7765.hs new file mode 100644 index 0000000000..6ca9a1fce6 --- /dev/null +++ b/testsuite/tests/module/T7765.hs @@ -0,0 +1 @@ +module Main where diff --git a/testsuite/tests/module/T7765.stderr b/testsuite/tests/module/T7765.stderr new file mode 100644 index 0000000000..bc8377d20d --- /dev/null +++ b/testsuite/tests/module/T7765.stderr @@ -0,0 +1,2 @@ + +T7765.hs:1:1: The IO action ‘main’ is not defined in module ‘Main’ diff --git a/testsuite/tests/module/all.T b/testsuite/tests/module/all.T index 58632bea73..c86a5f8806 100644 --- a/testsuite/tests/module/all.T +++ b/testsuite/tests/module/all.T @@ -319,8 +319,7 @@ test('mod172', extra_clean(['Mod172_B.hi', 'Mod172_B.o', 'Mod172_C.hi', 'Mod172_ test('mod173', extra_clean(['Mod173_Aux.hi', 'Mod173_Aux.o']), multimod_compile, ['mod173', '-v0']) -test('mod174', normal, compile_fail, ['']) - +# mod174 has been deleted # mod175 is a sub-directory test('mod176', normal, compile, ['-fwarn-unused-imports']) @@ -343,5 +342,6 @@ test('T414', normal, compile_fail, ['']) test('T414a', normal, compile, ['']) test('T414b', normal, compile, ['']) test('T3776', normal, compile, ['']) +test('T7765', normal, compile_fail, ['']) test('T9061', normal, compile, ['']) test('T9997', normal, compile, ['']) diff --git a/testsuite/tests/module/mod174.hs b/testsuite/tests/module/mod174.hs deleted file mode 100644 index 8e8149db7a..0000000000 --- a/testsuite/tests/module/mod174.hs +++ /dev/null @@ -1,9 +0,0 @@ - --- Test for trac #414 --- If main is not exported from Main then we should emit an error --- instead of running it anyway - -module Main () where - -main = putStrLn "Hello, World" - diff --git a/testsuite/tests/module/mod174.stderr b/testsuite/tests/module/mod174.stderr deleted file mode 100644 index a035f92b90..0000000000 --- a/testsuite/tests/module/mod174.stderr +++ /dev/null @@ -1,3 +0,0 @@ - -mod174.hs:1:1: - The IO action ‘main’ is not exported by module ‘Main’ diff --git a/testsuite/tests/parser/should_fail/readFail013.hs b/testsuite/tests/parser/should_fail/readFail013.hs index 97e926d49c..4850f3a1a5 100644 --- a/testsuite/tests/parser/should_fail/readFail013.hs +++ b/testsuite/tests/parser/should_fail/readFail013.hs @@ -1,4 +1,4 @@ -module Main where +module ReadFail013 where -- !!! unterminated `` a = ``s`` |