[project @ 2005-02-14 16:38:30 by simonmar]
authorsimonmar <unknown>
Mon, 14 Feb 2005 16:38:30 +0000 (16:38 +0000)
committersimonmar <unknown>
Mon, 14 Feb 2005 16:38:30 +0000 (16:38 +0000)
cmSetContext: check whether the modules specified actually exist and
emit the usual Finder error message if any don't.

This regressed duing the ModuleName->Module changeover, where I was a
bit heavyhanded in removing moduleNameToModule: it also checked for
the existence of each module and emitted a sensible exception.

ghc/compiler/compMan/CompManager.lhs

index 87e59fa..c48784e 100644 (file)
@@ -60,7 +60,8 @@ import DriverPipeline ( CompResult(..), preprocess, compile, link )
 import HscMain         ( newHscEnv )
 import DriverState     ( v_Output_file, v_NoHsMain, v_MainModIs )
 import DriverPhases    ( HscSource(..), isHsBoot, hscSourceString, isHaskellSrcFilename )
-import Finder          ( findModule, findLinkable, addHomeModuleToFinder, flushFinderCache, 
+import Finder          ( findModule, findLinkable, addHomeModuleToFinder,
+                         flushFinderCache, findPackageModule,
                          mkHomeModLocation, FindResult(..), cantFindError )
 import HscTypes                ( ModSummary(..), HomeModInfo(..), ModIface(..), msHsFilePath,
                          HscEnv(..), GhciMode(..), 
@@ -241,7 +242,9 @@ cmSetContext cmstate toplevs exports = do
       hsc_env = cm_hsc cmstate
       hpt     = hsc_HPT hsc_env
 
-  export_env  <- mkExportEnv hsc_env (map mkModule exports)
+  let export_mods = map mkModule exports
+  mapM_ (checkModuleExists (hsc_dflags hsc_env) hpt) export_mods
+  export_env  <- mkExportEnv hsc_env export_mods
   toplev_envs <- mapM (mkTopLevEnv hpt) toplevs
 
   let all_env = foldr plusGlobalRdrEnv export_env toplev_envs
@@ -249,6 +252,17 @@ cmSetContext cmstate toplevs exports = do
                                   ic_exports      = exports,
                                   ic_rn_gbl_env   = all_env } }
 
+checkModuleExists :: DynFlags -> HomePackageTable -> Module -> IO ()
+checkModuleExists dflags hpt mod = 
+  case lookupModuleEnv hpt mod of
+    Just mod_info -> return ()
+    _not_a_home_module -> do
+         res <- findPackageModule dflags mod True
+         case res of
+           Found _ _ -> return  ()
+           err -> let msg = cantFindError dflags mod err in
+                  throwDyn (CmdLineError (showSDoc msg))
+
 mkTopLevEnv :: HomePackageTable -> String -> IO GlobalRdrEnv
 mkTopLevEnv hpt mod
  = case lookupModuleEnv hpt (mkModule mod) of