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 (file)
--- 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_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,
                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 (file)
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -705,7 +705,7 @@ bump_unless False v = bumpVersion v
 
 \begin{code}
 mkUsageInfo :: HscEnv 
 
 \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
            -> [(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.
 
         -- 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?
 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
                     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
     
     -- 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 (file)
--- 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 { 
                        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,
                        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)
 
     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))
     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
 
        | 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
 
             ; 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
 
        -- 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
       | 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
 
    
     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)
 
        -- 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]
     --
     -- [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 :: [(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,
                       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")]
 
          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")
 
 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 (file)
--- 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")
 
                -- 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 }
                             . moduleEnvElts 
                             . imp_mods 
                             $ imports }

diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index 4785a49..d11ee27 100644 (file)
--- 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 {
 \begin{code}
 data ImportAvails 
    = ImportAvails {

-       imp_mods :: ModuleEnv (Module, Bool, SrcSpan),
+       imp_mods :: ModuleEnv (Module, [(ModuleName, Bool, SrcSpan)]),

                -- Domain is all directly-imported modules
                -- 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
                -- 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 = 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
                   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
     plus_mod_dep (m1, boot1) (m2, boot2) 
        = WARN( not (m1 == m2), (ppr m1 <+> ppr m2) $$ (ppr boot1 <+> ppr boot2) )
                -- Check mod-names match