From: Ian Lynagh Date: Sun, 26 Aug 2007 00:12:32 +0000 (+0000) Subject: Check that exported modules were actually imported; fixes #1384 X-Git-Tag: Before_type_family_merge~3 X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=e12bd07bcadb0efb1da0b49801a4a43689ee508a Check that exported modules were actually imported; fixes #1384 --- diff --git a/compiler/deSugar/Desugar.lhs b/compiler/deSugar/Desugar.lhs index 9a4c261..45eeff4 100644 --- a/compiler/deSugar/Desugar.lhs +++ b/compiler/deSugar/Desugar.lhs @@ -166,7 +166,7 @@ deSugar hsc_env mg_exports = exports, mg_deps = deps, mg_usages = usages, - mg_dir_imps = [m | (m,_,_) <- moduleEnvElts dir_imp_mods], + mg_dir_imps = [m | (m, _) <- moduleEnvElts dir_imp_mods], mg_rdr_env = rdr_env, mg_fix_env = fix_env, mg_deprecs = deprecs, diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index 489c2f7..0d200d8 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -705,7 +705,7 @@ bump_unless False v = bumpVersion v \begin{code} mkUsageInfo :: HscEnv - -> ModuleEnv (Module, Bool, SrcSpan) + -> ModuleEnv (Module, [(ModuleName, Bool, SrcSpan)]) -> [(ModuleName, IsBootInterface)] -> NameSet -> IO [Usage] mkUsageInfo hsc_env dir_imp_mods dep_mods used_names @@ -717,6 +717,12 @@ mkUsageInfo hsc_env dir_imp_mods dep_mods used_names -- don't get evaluated for a while and we can end up hanging on to -- the entire collection of Ifaces. +mk_usage_info :: PackageIfaceTable + -> HscEnv + -> ModuleEnv (Module, [(ModuleName, Bool, SrcSpan)]) + -> [(ModuleName, IsBootInterface)] + -> NameSet + -> [Usage] mk_usage_info pit hsc_env dir_imp_mods dep_mods used_names = mapCatMaybes mkUsage dep_mods -- ToDo: do we need to sort into canonical order? @@ -739,8 +745,8 @@ mk_usage_info pit hsc_env dir_imp_mods dep_mods used_names add_item occs _ = occ:occs depend_on_exports mod = case lookupModuleEnv dir_imp_mods mod of - Just (_,no_imp,_) -> not no_imp - Nothing -> True + Just (_, xs) -> any (\(_, no_imp, _) -> not no_imp) xs + Nothing -> True -- We want to create a Usage for a home module if -- a) we used something from; has something in used_names diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index 8b09f52..76da335 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -229,7 +229,7 @@ rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot other -> False imports = ImportAvails { - imp_mods = unitModuleEnv imp_mod (imp_mod, import_all, loc), + imp_mods = unitModuleEnv imp_mod (imp_mod, [(qual_mod_name, import_all, loc)]), imp_orphs = orphans, imp_finsts = finsts, imp_dep_mods = mkModDeps dependent_mods, @@ -759,6 +759,10 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod kids_env :: NameEnv [Name] -- Maps a parent to its in-scope children kids_env = mkChildEnv (globalRdrEnvElts rdr_env) + imported_modules = [ qual_name + | (_, xs) <- moduleEnvElts $ imp_mods imports, + (qual_name, _, _) <- xs ] + exports_from_item :: ExportAccum -> LIE RdrName -> RnM ExportAccum exports_from_item acc@(ie_names, occs, exports) (L loc ie@(IEModuleContents mod)) @@ -770,10 +774,14 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod | otherwise = do { implicit_prelude <- doptM Opt_ImplicitPrelude - ; let gres = filter (isModuleExported implicit_prelude mod) - (globalRdrEnvElts rdr_env) + ; let { exportValid = (mod `elem` imported_modules) + || (moduleName this_mod == mod) + ; gres = filter (isModuleExported implicit_prelude mod) + (globalRdrEnvElts rdr_env) + } - ; warnIf (null gres) (nullModuleExport mod) + ; checkErr exportValid (moduleNotImported mod) + ; warnIf (exportValid && null gres) (nullModuleExport mod) ; occs' <- check_occs ie occs (map gre_name gres) -- This check_occs not only finds conflicts @@ -1110,7 +1118,7 @@ reportUnusedNames export_decls gbl_env -- qualified imports into account. But it's an improvement. add_expall mod acc = addToFM_C plusAvailEnv acc mod emptyAvailEnv - add_inst_mod (mod,_,_) acc + add_inst_mod (mod, _) acc | mod_name `elemFM` acc = acc -- We import something already | otherwise = addToFM acc mod_name emptyAvailEnv where @@ -1120,7 +1128,7 @@ reportUnusedNames export_decls gbl_env imports = tcg_imports gbl_env - direct_import_mods :: [(Module, Bool, SrcSpan)] + direct_import_mods :: [(Module, [(ModuleName, Bool, SrcSpan)])] -- See the type of the imp_mods for this triple direct_import_mods = moduleEnvElts (imp_mods imports) @@ -1129,10 +1137,11 @@ reportUnusedNames export_decls gbl_env -- [Note: not 'minimal_imports', because that includes directly-imported -- modules even if we use nothing from them; see notes above] -- - -- BUG WARNING: does not deal correctly with multiple imports of the same module - -- becuase direct_import_mods has only one entry per module + -- BUG WARNING: this code is generally buggy unused_imp_mods :: [(ModuleName, SrcSpan)] - unused_imp_mods = [(mod_name,loc) | (mod,no_imp,loc) <- direct_import_mods, + unused_imp_mods = [(mod_name,loc) + | (mod, xs) <- direct_import_mods, + (_, no_imp, loc) <- xs, let mod_name = moduleName mod, not (mod_name `elemFM` minimal_imports1), mod /= pRELUDE, @@ -1354,6 +1363,11 @@ dupModuleExport mod quotes (ptext SLIT("Module") <+> ppr mod), ptext SLIT("in export list")] +moduleNotImported :: ModuleName -> SDoc +moduleNotImported mod + = ptext SLIT("The export item `module") <+> ppr mod <> + ptext SLIT("' is not imported") + nullModuleExport mod = ptext SLIT("The export item `module") <+> ppr mod <> ptext SLIT("' exports nothing") diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs index 4a3cb5e..bb67d9b 100644 --- a/compiler/typecheck/TcRnDriver.lhs +++ b/compiler/typecheck/TcRnDriver.lhs @@ -245,7 +245,7 @@ tcRnImports hsc_env this_mod import_decls -- Check type-familily consistency ; traceRn (text "rn1: checking family instance consistency") - ; let { dir_imp_mods = map (\ (mod, _, _) -> mod) + ; let { dir_imp_mods = map (\ (mod, _) -> mod) . moduleEnvElts . imp_mods $ imports } diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs index 4785a49..d11ee27 100644 --- a/compiler/typecheck/TcRnTypes.lhs +++ b/compiler/typecheck/TcRnTypes.lhs @@ -491,8 +491,11 @@ It is used * when processing the export list \begin{code} data ImportAvails = ImportAvails { - imp_mods :: ModuleEnv (Module, Bool, SrcSpan), + imp_mods :: ModuleEnv (Module, [(ModuleName, Bool, SrcSpan)]), -- Domain is all directly-imported modules + -- The ModuleName is what the module was imported as, e.g. in + -- import Foo as Bar + -- it is Bar. -- Bool means: -- True => import was "import Foo ()" -- False => import was some other form @@ -555,12 +558,13 @@ plusImportAvails (ImportAvails { imp_mods = mods2, imp_dep_mods = dmods2, imp_dep_pkgs = dpkgs2, imp_orphs = orphs2, imp_finsts = finsts2 }) - = ImportAvails { imp_mods = mods1 `plusModuleEnv` mods2, + = ImportAvails { imp_mods = plusModuleEnv_C plus_mod mods1 mods2, imp_dep_mods = plusUFM_C plus_mod_dep dmods1 dmods2, imp_dep_pkgs = dpkgs1 `unionLists` dpkgs2, imp_orphs = orphs1 `unionLists` orphs2, imp_finsts = finsts1 `unionLists` finsts2 } where + plus_mod (m1, xs1) (_, xs2) = (m1, xs1 ++ xs2) plus_mod_dep (m1, boot1) (m2, boot2) = WARN( not (m1 == m2), (ppr m1 <+> ppr m2) $$ (ppr boot1 <+> ppr boot2) ) -- Check mod-names match