Commit 703221f4 authored by Roland Senn's avatar Roland Senn Committed by Marge Bot

Use export list of Main module in function TcRnDriver.hs:check_main (Fix #16453)

- Provide the export list of the `Main` module as parameter to the
  `compiler/typecheck/TcRnDriver.hs:check_main` function.
- Instead of `lookupOccRn_maybe` call the function `lookupInfoOccRn`.
  It returns the list `mains_all` of all the main functions in scope.
- Select from this list `mains_all` all `main` functions that are in
  the export list of the `Main` module.
- If this new list contains exactly one single `main` function, then
  typechecking continues.
- Otherwise issue an appropriate error message.
parent 2643ba46
Pipeline #17105 passed with stages
in 507 minutes and 46 seconds
......@@ -17,6 +17,7 @@ module TcExpr ( tcPolyExpr, tcMonoExpr, tcMonoExprNC,
tcSyntaxOp, tcSyntaxOpGen, SyntaxOpType(..), synKnownType,
tcCheckId,
addExprErrCtxt,
addAmbiguousNameErr,
getFixedTyVars ) where
#include "HsVersions.h"
......@@ -2193,10 +2194,16 @@ disambiguateSelector lr@(L _ rdr) parent_type
-- occurrence" error, then give up.
ambiguousSelector :: Located RdrName -> TcM a
ambiguousSelector (L _ rdr)
= do { addAmbiguousNameErr rdr
; failM }
-- | This name really is ambiguous, so add a suitable "ambiguous
-- occurrence" error, then continue
addAmbiguousNameErr :: RdrName -> TcM ()
addAmbiguousNameErr rdr
= do { env <- getGlobalRdrEnv
; let gres = lookupGRE_RdrName rdr env
; setErrCtxt [] $ addNameClashErrRn rdr gres
; failM }
; setErrCtxt [] $ addNameClashErrRn rdr gres}
-- Disambiguate the fields in a record update.
-- See Note [Disambiguating record fields]
......
......@@ -129,7 +129,7 @@ import GHC.Core.Class
import BasicTypes hiding( SuccessFlag(..) )
import GHC.Core.Coercion.Axiom
import Annotations
import Data.List ( sortBy, sort )
import Data.List ( find, sortBy, sort )
import Data.Ord
import FastString
import Maybes
......@@ -268,17 +268,13 @@ tcRnModuleTcRnM hsc_env mod_sum
; tcg_env <- if isHsBootOrSig hsc_src
then tcRnHsBootDecls hsc_src local_decls
else {-# SCC "tcRnSrcDecls" #-}
tcRnSrcDecls explicit_mod_hdr local_decls
tcRnSrcDecls explicit_mod_hdr local_decls export_ies
; setGblEnv tcg_env
$ do { -- Process the export list
traceRn "rn4a: before exports" empty
; tcg_env <- tcRnExports explicit_mod_hdr export_ies
tcg_env
; traceRn "rn4b: after exports" empty
; -- 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
......@@ -400,8 +396,9 @@ tcRnImports hsc_env import_decls
tcRnSrcDecls :: Bool -- False => no 'module M(..) where' header at all
-> [LHsDecl GhcPs] -- Declarations
-> Maybe (Located [LIE GhcPs])
-> TcM TcGblEnv
tcRnSrcDecls explicit_mod_hdr decls
tcRnSrcDecls explicit_mod_hdr decls export_ies
= do { -- Do all the declarations
; (tcg_env, tcl_env, lie) <- tc_rn_src_decls decls
......@@ -410,7 +407,7 @@ tcRnSrcDecls explicit_mod_hdr decls
-- NB: always set envs *before* captureTopConstraints
; (tcg_env, lie_main) <- setEnvs (tcg_env, tcl_env) $
captureTopConstraints $
checkMain explicit_mod_hdr
checkMain explicit_mod_hdr export_ies
; setEnvs (tcg_env, tcl_env) $ do {
......@@ -1719,29 +1716,69 @@ tcTyClsInstDecls tycl_decls deriv_decls binds
-}
checkMain :: Bool -- False => no 'module M(..) where' header at all
-> Maybe (Located [LIE GhcPs]) -- Export specs of Main module
-> TcM TcGblEnv
-- If we are in module Main, check that 'main' is defined.
checkMain explicit_mod_hdr
-- If we are in module Main, check that 'main' is defined and exported.
checkMain explicit_mod_hdr export_ies
= do { dflags <- getDynFlags
; tcg_env <- getGblEnv
; check_main dflags tcg_env explicit_mod_hdr }
; check_main dflags tcg_env explicit_mod_hdr export_ies }
check_main :: DynFlags -> TcGblEnv -> Bool -> TcM TcGblEnv
check_main dflags tcg_env explicit_mod_hdr
check_main :: DynFlags -> TcGblEnv -> Bool -> Maybe (Located [LIE GhcPs])
-> TcM TcGblEnv
check_main dflags tcg_env explicit_mod_hdr export_ies
| mod /= main_mod
= traceTc "checkMain not" (ppr main_mod <+> ppr mod) >>
return tcg_env
| otherwise
= do { mb_main <- lookupGlobalOccRn_maybe main_fn
-- Check that 'main' is in scope
-- It might be imported from another module!
; case mb_main of {
Nothing -> do { traceTc "checkMain fail" (ppr main_mod <+> ppr main_fn)
; complain_no_main
; return tcg_env } ;
Just main_name -> do
-- Compare the list of main functions in scope with those
-- specified in the export list.
= do mains_all <- lookupInfoOccRn main_fn
-- get all 'main' functions in scope
-- They may also be imported from other modules!
case exportedMains of -- check the main(s) specified in the export list
[ ] -> do
-- The module has no main functions in the export spec, so we must give
-- some kind of error message. The tricky part is giving an error message
-- that accurately characterizes what the problem is.
-- See Note [Main module without a main function in the export spec]
traceTc "checkMain no main module exported" ppr_mod_mainfn
complain_no_main
-- In order to reduce the number of potential error messages, we check
-- to see if there are any main functions defined (but not exported)...
case getSomeMain mains_all of
Nothing -> return tcg_env
-- ...if there are no such main functions, there is nothing we can do...
Just some_main -> use_as_main some_main
-- ...if there is such a main function, then communicate this to the
-- typechecker. This can prevent a spurious "Ambiguous type variable"
-- error message in certain cases, as described in
-- Note [Main module without a main function in the export spec].
_ -> do -- The module has one or more main functions in the export spec
let mains = filterInsMains exportedMains mains_all
case mains of
[] -> do --
traceTc "checkMain fail" ppr_mod_mainfn
complain_no_main
return tcg_env
[main_name] -> use_as_main main_name
_ -> do -- multiple main functions are exported
addAmbiguousNameErr main_fn -- issue error msg
return tcg_env
where
mod = tcg_mod tcg_env
main_mod = mainModIs dflags
main_mod_nm = moduleName main_mod
main_fn = getMainFun dflags
occ_main_fn = occName main_fn
interactive = ghcLink dflags == LinkInMemory
exportedMains = selExportMains export_ies
ppr_mod_mainfn = ppr main_mod <+> ppr main_fn
-- There is a single exported 'main' function.
use_as_main :: Name -> TcM TcGblEnv
use_as_main main_name = do
{ traceTc "checkMain found" (ppr main_mod <+> ppr main_fn)
; let loc = srcLocSpan (getSrcLoc main_name)
; ioTyCon <- tcLookupTyCon ioTyConName
......@@ -1779,13 +1816,7 @@ check_main dflags tcg_env explicit_mod_hdr
`plusDU` usesOnly (unitFV main_name)
-- Record the use of 'main', so that we don't
-- complain about it being defined but not used
})
}}}
where
mod = tcg_mod tcg_env
main_mod = mainModIs dflags
main_fn = getMainFun dflags
interactive = ghcLink dflags == LinkInMemory
})}
complain_no_main = unless (interactive && not explicit_mod_hdr)
(addErrTc noMainMsg) -- #12906
......@@ -1795,9 +1826,56 @@ check_main dflags tcg_env explicit_mod_hdr
mainCtxt = text "When checking the type of the" <+> pp_main_fn
noMainMsg = text "The" <+> pp_main_fn
<+> text "is not defined in module" <+> quotes (ppr main_mod)
<+> text "is not" <+> text defOrExp <+> text "module"
<+> quotes (ppr main_mod)
defOrExp = if null exportedMains then "exported by" else "defined in"
pp_main_fn = ppMainFn main_fn
-- Select the main functions from the export list.
-- Only the module name is needed, the function name is fixed.
selExportMains :: Maybe (Located [LIE GhcPs]) -> [ModuleName] -- #16453
selExportMains Nothing = [main_mod_nm]
-- no main specified, but there is a header.
selExportMains (Just exps) = fmap fst $
filter (\(_,n) -> n == occ_main_fn ) texp
where
ies = fmap unLoc $ unLoc exps
texp = mapMaybe transExportIE ies
-- Filter all main functions in scope that match the export specs
filterInsMains :: [ModuleName] -> [Name] -> [Name] -- #16453
filterInsMains export_mains inscope_mains =
[mod | mod <- inscope_mains,
(moduleName . nameModule) mod `elem` export_mains]
-- Transform an export_ie to a (ModuleName, OccName) pair.
-- 'IEVar' constructors contain exported values (functions), eg '(Main.main)'
-- 'IEModuleContents' constructors contain fully exported modules, eg '(Main)'
-- All other 'IE...' constructors are not used and transformed to Nothing.
transExportIE :: IE GhcPs -> Maybe (ModuleName, OccName) -- #16453
transExportIE (IEVar _ var) = isQual_maybe $
upqual $ ieWrappedName $ unLoc var
where
-- A module name is always needed, so qualify 'UnQual' rdr names.
upqual (Unqual occ) = Qual main_mod_nm occ
upqual rdr = rdr
transExportIE (IEModuleContents _ mod) = Just (unLoc mod, occ_main_fn)
transExportIE _ = Nothing
-- Get a main function that is in scope.
-- See Note [Main module without a main function in the export spec]
getSomeMain :: [Name] -> Maybe Name -- #16453
getSomeMain all_mains = case all_mains of
[] -> Nothing -- No main function in scope
[m] -> Just m -- Just one main function in scope
_ -> case mbMainOfMain of
Nothing -> listToMaybe all_mains -- Take the first main function in scope or Nothing
_ -> mbMainOfMain -- Take the Main module's main function or Nothing
where
mbMainOfMain = find (\n -> (moduleName . nameModule) n == main_mod_nm )
all_mains -- the main function of the Main module
-- | Get the unqualified name of the function to use as the \"main\" for the main module.
-- Either returns the default name or the one configured on the command line with -main-is
getMainFun :: DynFlags -> RdrName
......@@ -1805,19 +1883,6 @@ 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
Nothing -> return () -- not the main module
Just main_name ->
do { dflags <- getDynFlags
; let main_mod = mainModIs dflags
; 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) }
ppMainFn :: RdrName -> SDoc
ppMainFn main_fn
| rdrNameOcc main_fn == mainOcc
......@@ -1842,6 +1907,53 @@ module. Tiresomely, we must filter it out again in GHC.Iface.Make, less we
get two defns for 'main' in the interface file!
Note [Main module without a main function in the export spec]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Giving accurate error messages for a Main module that does not export a main
function is surprisingly tricky. To see why, consider a module in a file
`Foo.hs` that has no `main` function in the explicit export specs of the module
header:
module Main () where
foo = return ()
This does not export a main function and therefore should be rejected, per
chapter 5 of the Haskell Report 2010:
A Haskell program is a collection of modules, one of which, by convention,
must be called Main and must export the value main. The value of the
program is the value of the identifier main in module Main, which must be
a computation of type IO τ for some type τ.
In fact, when you compile the program above using `ghc Foo.hs`, you will
actually get *two* errors:
- The IO action ‘main’ is not defined in module ‘Main’
- Ambiguous type variable ‘m0’ arising from a use of ‘return’
prevents the constraint ‘(Monad m0)’ from being solved.
The first error is self-explanatory, while the second error message occurs
due to the monomorphism restriction.
Now consider what would happen if the program above were compiled with
`ghc -main-is foo Foo`. The has the effect of `foo` being designated as the
main function. The program will still be rejected since it does not export
`foo` (and therefore does not export its main function), but there is one
important difference: `foo` will be checked against the type `IO τ`. As a
result, we would *not* expect the monomorphism restriction error message
to occur, since the typechecker should have no trouble figuring out the type
of `foo`. In other words, we should only throw the former error message,
not the latter.
The implementation uses the function `getSomeMain` to find a potential main
function that is defined but not exported. If one is found, it is passed to
`use_as_main` to inform the typechecker that the main function should be of
type `IO τ`. See also the `T414` and `T17171a` test cases for similar examples
of programs whose error messages are influenced by the situation described in
this Note.
*********************************************************
* *
GHCi stuff
......@@ -2574,7 +2686,7 @@ tcRnDeclsi :: HscEnv
-> IO (Messages, Maybe TcGblEnv)
tcRnDeclsi hsc_env local_decls
= runTcInteractive hsc_env $
tcRnSrcDecls False local_decls
tcRnSrcDecls False local_decls Nothing
externaliseAndTidyId :: Module -> Id -> TcM Id
externaliseAndTidyId this_mod id
......
T16453E1.hs:1:1: error:
The IO action ‘main’ is not defined in module ‘Main’
module Main (T16453T.main, T16453S.main) where
import T16453T
import T16453S
T16453E2.hs:1:1:
Ambiguous occurrence ‘main’
It could refer to
either ‘T16453T.main’,
imported from ‘T16453T’ at T16453E2.hs:2:1-14
(and originally defined at T16453T.hs:2:1-4)
or ‘T16453S.main’,
imported from ‘T16453S’ at T16453E2.hs:3:1-14
(and originally defined at T16453S.hs:2:1-4)
module T16453S where
main = putStrLn "T16453S"
module T16453T where
main = putStrLn "T16453T"
......@@ -516,6 +516,10 @@ test('T16255', normal, compile_fail, [''])
test('T16204c', normal, compile_fail, [''])
test('T16394', normal, compile_fail, [''])
test('T16414', normal, compile_fail, [''])
test('T16453E1', extra_files(['T16453T.hs', 'T16453S.hs']), multimod_compile_fail,
['T16453E1.hs', '-v0'])
test('T16453E2', extra_files(['T16453T.hs', 'T16453S.hs']),
multimod_compile_fail, ['T16453E2.hs', '-v0'])
test('T16456', normal, compile_fail, ['-fprint-explicit-foralls'])
test('T16627', normal, compile_fail, [''])
test('T502', normal, compile_fail, [''])
......
module Main where
import T16453T
main = putStrLn "T16453M0"
module Main (T16453T.main) where
import T16453T
main = putStrLn "T16453M1"
module Main (Main.main) where
import T16453T
main = putStrLn "T16453M2"
module Main (module Main) where
import T16453T
main = putStrLn "T16453M3"
module Main (module T16453T) where
import T16453T
main = putStrLn "T16453M4"
module T16453T where
main = putStrLn "T16453T"
......@@ -135,6 +135,11 @@ test('T14218', normal, compile_and_run, [''])
test('T14236', normal, compile_and_run, [''])
test('T14925', normal, compile_and_run, [''])
test('T14341', normal, compile_and_run, [''])
test('T16453M0', extra_files(['T16453T.hs']), compile_and_run, [''])
test('T16453M1', extra_files(['T16453T.hs']), compile_and_run, [''])
test('T16453M2', extra_files(['T16453T.hs']), compile_and_run, [''])
test('T16453M3', extra_files(['T16453T.hs']), compile_and_run, [''])
test('T16453M4', extra_files(['T16453T.hs']), compile_and_run, [''])
test('UnliftedNewtypesRun', normal, compile_and_run, [''])
test('UnliftedNewtypesFamilyRun', normal, compile_and_run, [''])
test('UnliftedNewtypesDependentFamilyRun', normal, compile_and_run, [''])
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment