diff options
40 files changed, 139 insertions, 581 deletions
diff --git a/compiler/deSugar/DsMonad.hs b/compiler/deSugar/DsMonad.hs index ad6a6b1d7b..61beca2f5c 100644 --- a/compiler/deSugar/DsMonad.hs +++ b/compiler/deSugar/DsMonad.hs @@ -184,7 +184,7 @@ initDs hsc_env mod rdr_env type_env fam_inst_env thing_inside else do { ; result <- liftIO $ findImportedModule hsc_env modname Nothing ; case result of - FoundModule h -> loadModule err (fr_mod h) + Found _ mod -> loadModule err mod _ -> pprPgmError "Unable to use Data Parallel Haskell (DPH):" err } } diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs index 3e8423c432..8c2a07c07f 100644 --- a/compiler/ghci/Linker.hs +++ b/compiler/ghci/Linker.hs @@ -562,29 +562,23 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods -- 3. For each dependent module, find its linkable -- This will either be in the HPT or (in the case of one-shot - -- compilation) we may need to use maybe_getFileLinkable. - -- If the module is actually a signature, there won't be a - -- linkable (thus catMaybes) + -- compilation) we may need to use maybe_getFileLinkable ; let { osuf = objectSuf dflags } - ; lnks_needed <- fmap Maybes.catMaybes - $ mapM (get_linkable osuf) mods_needed + ; lnks_needed <- mapM (get_linkable osuf) mods_needed ; return (lnks_needed, pkgs_needed) } where dflags = hsc_dflags hsc_env this_pkg = thisPackage dflags - -- | Given a list of modules @mods@, recursively discover all external - -- package and local module (according to @this_pkg@) dependencies. - -- - -- The 'ModIface' contains the transitive closure of the module dependencies - -- within the current package, *except* for boot modules: if we encounter - -- a boot module, we have to find its real interface and discover the - -- dependencies of that. Hence we need to traverse the dependency - -- tree recursively. See bug #936, testcase ghci/prog007. - follow_deps :: [Module] -- modules to follow - -> UniqSet ModuleName -- accum. module dependencies - -> UniqSet PackageKey -- accum. package dependencies + -- The ModIface contains the transitive closure of the module dependencies + -- within the current package, *except* for boot modules: if we encounter + -- a boot module, we have to find its real interface and discover the + -- dependencies of that. Hence we need to traverse the dependency + -- tree recursively. See bug #936, testcase ghci/prog007. + follow_deps :: [Module] -- modules to follow + -> UniqSet ModuleName -- accum. module dependencies + -> UniqSet PackageKey -- accum. package dependencies -> IO ([ModuleName], [PackageKey]) -- result follow_deps [] acc_mods acc_pkgs = return (uniqSetToList acc_mods, uniqSetToList acc_pkgs) @@ -607,7 +601,6 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods where is_boot (m,True) = Left m is_boot (m,False) = Right m - -- Boot module dependencies which must be processed recursively boot_deps' = filter (not . (`elementOfUniqSet` acc_mods)) boot_deps acc_mods' = addListToUniqSet acc_mods (moduleName mod : mod_deps) acc_pkgs' = addListToUniqSet acc_pkgs $ map fst pkg_deps @@ -638,37 +631,30 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods get_linkable osuf mod_name -- A home-package module | Just mod_info <- lookupUFM hpt mod_name - = adjust_linkable (hm_iface mod_info) - (Maybes.expectJust "getLinkDeps" (hm_linkable mod_info)) + = adjust_linkable (Maybes.expectJust "getLinkDeps" (hm_linkable mod_info)) | otherwise = do -- It's not in the HPT because we are in one shot mode, -- so use the Finder to get a ModLocation... - -- ezyang: I don't actually know how to trigger this codepath, - -- seeing as this is GHCi logic. Template Haskell, maybe? mb_stuff <- findHomeModule hsc_env mod_name case mb_stuff of - FoundExact loc mod -> found loc mod + Found loc mod -> found loc mod _ -> no_obj mod_name where found loc mod = do { -- ...and then find the linkable for it mb_lnk <- findObjectLinkableMaybe mod loc ; - iface <- initIfaceCheck hsc_env $ - loadUserInterface False (text "getLinkDeps2") mod ; case mb_lnk of { Nothing -> no_obj mod ; - Just lnk -> adjust_linkable iface lnk + Just lnk -> adjust_linkable lnk }} - adjust_linkable iface lnk - -- Signatures have no linkables! Don't return one. - | Just _ <- mi_sig_of iface = return Nothing + adjust_linkable lnk | Just new_osuf <- replace_osuf = do new_uls <- mapM (adjust_ul new_osuf) (linkableUnlinked lnk) - return (Just lnk{ linkableUnlinked=new_uls }) + return lnk{ linkableUnlinked=new_uls } | otherwise = - return (Just lnk) + return lnk adjust_ul new_osuf (DotO file) = do MASSERT(osuf `isSuffixOf` file) diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs index defaa91c14..c88ad143d4 100644 --- a/compiler/iface/LoadIface.hs +++ b/compiler/iface/LoadIface.hs @@ -297,17 +297,12 @@ loadSrcInterface_maybe doc mod want_boot maybe_pkg -- interface; it will call the Finder again, but the ModLocation will be -- cached from the first search. = do { hsc_env <- getTopEnv + -- ToDo: findImportedModule should return a list of interfaces ; res <- liftIO $ findImportedModule hsc_env mod maybe_pkg ; case res of - FoundModule (FoundHs { fr_mod = mod }) - -> fmap (fmap (:[])) - . initIfaceTcRn - $ loadInterface doc mod (ImportByUser want_boot) - FoundSigs mods _backing - -> initIfaceTcRn $ do - ms <- forM mods $ \(FoundHs { fr_mod = mod }) -> - loadInterface doc mod (ImportByUser want_boot) - return (sequence ms) + Found _ mod -> fmap (fmap (:[])) + . initIfaceTcRn + $ loadInterface doc mod (ImportByUser want_boot) err -> return (Failed (cannotFindInterface (hsc_dflags hsc_env) mod err)) } -- | Load interface directly for a fully qualified 'Module'. (This is a fairly @@ -772,7 +767,7 @@ findAndReadIface doc_str mod hi_boot_file hsc_env <- getTopEnv mb_found <- liftIO (findExactModule hsc_env mod) case mb_found of - FoundExact loc mod -> do + Found loc mod -> do -- Found file, so read it let file_path = addBootSuffix_maybe hi_boot_file @@ -789,8 +784,7 @@ findAndReadIface doc_str mod hi_boot_file traceIf (ptext (sLit "...not found")) dflags <- getDynFlags return (Failed (cannotFindInterface dflags - (moduleName mod) - (convFindExactResult err))) + (moduleName mod) err)) where read_file file_path = do traceIf (ptext (sLit "readIFace") <+> text file_path) read_result <- readIface mod file_path diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs index e897daa3b6..c1a9d2523f 100644 --- a/compiler/iface/MkIface.hs +++ b/compiler/iface/MkIface.hs @@ -1335,20 +1335,9 @@ checkDependencies hsc_env summary iface find_res <- liftIO $ findImportedModule hsc_env mod (fmap snd pkg) let reason = moduleNameString mod ++ " changed" case find_res of - FoundModule h -> check_mod reason (fr_mod h) - FoundSigs hs _backing -> check_mods reason (map fr_mod hs) - _otherwise -> return (RecompBecause reason) - - check_mods _ [] = return UpToDate - check_mods reason (m:ms) = do - r <- check_mod reason m - case r of - UpToDate -> check_mods reason ms - _otherwise -> return r - - check_mod reason mod + Found _ mod | pkg == this_pkg - = if moduleName mod `notElem` map fst prev_dep_mods + -> if moduleName mod `notElem` map fst prev_dep_mods then do traceHiDiffs $ text "imported module " <> quotes (ppr mod) <> text " not among previous dependencies" @@ -1356,7 +1345,7 @@ checkDependencies hsc_env summary iface else return UpToDate | otherwise - = if pkg `notElem` (map fst prev_dep_pkgs) + -> if pkg `notElem` (map fst prev_dep_pkgs) then do traceHiDiffs $ text "imported module " <> quotes (ppr mod) <> text " is from package " <> quotes (ppr pkg) <> @@ -1365,6 +1354,7 @@ checkDependencies hsc_env summary iface else return UpToDate where pkg = modulePackageKey mod + _otherwise -> return (RecompBecause reason) needInterface :: Module -> (ModIface -> IfG RecompileRequired) -> IfG RecompileRequired diff --git a/compiler/main/DriverMkDepend.hs b/compiler/main/DriverMkDepend.hs index c51feeb491..310007d000 100644 --- a/compiler/main/DriverMkDepend.hs +++ b/compiler/main/DriverMkDepend.hs @@ -248,7 +248,7 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps -- we've done it once during downsweep r <- findImportedModule hsc_env imp pkg ; case r of - FoundModule (FoundHs { fr_loc = loc }) + Found loc _ -- Home package: just depend on the .hi or hi-boot file | isJust (ml_hs_file loc) || include_pkg_deps -> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc))) @@ -257,9 +257,6 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps | otherwise -> return Nothing - -- TODO: FoundSignature. For now, we assume home package - -- "signature" dependencies look like FoundModule. - fail -> let dflags = hsc_dflags hsc_env in throwOneError $ mkPlainErrMsg dflags srcloc $ diff --git a/compiler/main/DynamicLoading.hs b/compiler/main/DynamicLoading.hs index 3b62717a9c..0d72bece36 100644 --- a/compiler/main/DynamicLoading.hs +++ b/compiler/main/DynamicLoading.hs @@ -203,15 +203,7 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do -- First find the package the module resides in by searching exposed packages and home modules found_module <- findImportedModule hsc_env mod_name Nothing case found_module of - FoundModule h -> check_mod (fr_mod h) - FoundSigs hs _backing -> check_mods (map fr_mod hs) -- (not tested) - err -> throwCmdLineErrorS dflags $ cannotFindModule dflags mod_name err - where - dflags = hsc_dflags hsc_env - meth = "lookupRdrNameInModule" - doc = ptext (sLit $ "contains a name used in an invocation of " ++ meth) - - check_mod mod = do + Found _ mod -> do -- Find the exports of the module (_, mb_iface) <- initTcInteractive hsc_env $ initIfaceTcRn $ @@ -229,13 +221,10 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do _ -> panic "lookupRdrNameInModule" Nothing -> throwCmdLineErrorS dflags $ hsep [ptext (sLit "Could not determine the exports of the module"), ppr mod_name] - - check_mods [] = return Nothing - check_mods (m:ms) = do - r <- check_mod m - case r of - Nothing -> check_mods ms - Just _ -> return r + err -> throwCmdLineErrorS dflags $ cannotFindModule dflags mod_name err + where + dflags = hsc_dflags hsc_env + doc = ptext (sLit "contains a name used in an invocation of lookupRdrNameInModule") wrongTyThingError :: Name -> TyThing -> SDoc wrongTyThingError name got_thing = hsep [ptext (sLit "The name"), ppr name, ptext (sLit "is not that of a value but rather a"), pprTyThingCategory got_thing] diff --git a/compiler/main/Finder.hs b/compiler/main/Finder.hs index d8aef57011..00ba0388dd 100644 --- a/compiler/main/Finder.hs +++ b/compiler/main/Finder.hs @@ -9,7 +9,6 @@ module Finder ( flushFinderCaches, FindResult(..), - convFindExactResult, -- move to HscTypes? findImportedModule, findExactModule, findHomeModule, @@ -46,7 +45,8 @@ import System.Directory import System.FilePath import Control.Monad import Data.Time -import Data.List ( foldl', partition ) +import Data.List ( foldl' ) + type FileExt = String -- Filename extension type BaseName = String -- Basename of file @@ -75,7 +75,7 @@ flushFinderCaches hsc_env = is_ext mod _ | modulePackageKey mod /= this_pkg = True | otherwise = False -addToFinderCache :: IORef FinderCache -> Module -> FindExactResult -> IO () +addToFinderCache :: IORef FinderCache -> Module -> FindResult -> IO () addToFinderCache ref key val = atomicModifyIORef' ref $ \c -> (extendModuleEnv c key val, ()) @@ -83,7 +83,7 @@ removeFromFinderCache :: IORef FinderCache -> Module -> IO () removeFromFinderCache ref key = atomicModifyIORef' ref $ \c -> (delModuleEnv c key, ()) -lookupFinderCache :: IORef FinderCache -> Module -> IO (Maybe FindExactResult) +lookupFinderCache :: IORef FinderCache -> Module -> IO (Maybe FindResult) lookupFinderCache ref key = do c <- readIORef ref return $! lookupModuleEnv c key @@ -104,7 +104,7 @@ findImportedModule hsc_env mod_name mb_pkg = Just pkg | pkg == fsLit "this" -> home_import -- "this" is special | otherwise -> pkg_import where - home_import = convFindExactResult `fmap` findHomeModule hsc_env mod_name + home_import = findHomeModule hsc_env mod_name pkg_import = findExposedPackageModule hsc_env mod_name mb_pkg @@ -118,7 +118,7 @@ findImportedModule hsc_env mod_name mb_pkg = -- reading the interface for a module mentioned by another interface, -- for example (a "system import"). -findExactModule :: HscEnv -> Module -> IO FindExactResult +findExactModule :: HscEnv -> Module -> IO FindResult findExactModule hsc_env mod = let dflags = hsc_dflags hsc_env in if modulePackageKey mod == thisPackage dflags @@ -152,45 +152,17 @@ orIfNotFound this or_this = do -- been done. Otherwise, do the lookup (with the IO action) and save -- the result in the finder cache and the module location cache (if it -- was successful.) -homeSearchCache :: HscEnv - -> ModuleName - -> IO FindExactResult - -> IO FindExactResult +homeSearchCache :: HscEnv -> ModuleName -> IO FindResult -> IO FindResult homeSearchCache hsc_env mod_name do_this = do let mod = mkModule (thisPackage (hsc_dflags hsc_env)) mod_name modLocationCache hsc_env mod do_this --- | Converts a 'FindExactResult' into a 'FindResult' in the obvious way. -convFindExactResult :: FindExactResult -> FindResult -convFindExactResult (FoundExact loc m) = FoundModule (FoundHs loc m) -convFindExactResult (NoPackageExact pk) = NoPackage pk -convFindExactResult NotFoundExact { fer_paths = paths, fer_pkg = pkg } = - NotFound { - fr_paths = paths, fr_pkg = pkg, - fr_pkgs_hidden = [], fr_mods_hidden = [], fr_suggestions = [] - } - -foundExact :: FindExactResult -> Bool -foundExact FoundExact{} = True -foundExact _ = False - findExposedPackageModule :: HscEnv -> ModuleName -> Maybe FastString -> IO FindResult findExposedPackageModule hsc_env mod_name mb_pkg = case lookupModuleWithSuggestions (hsc_dflags hsc_env) mod_name mb_pkg of - LookupFound (m, _) -> do - fmap convFindExactResult (findPackageModule hsc_env m) - LookupFoundSigs ms backing -> do - locs <- mapM (findPackageModule hsc_env . fst) ms - let (ok, missing) = partition foundExact locs - case missing of - -- At the moment, we return the errors one at a time. It might be - -- better if we collected them up and reported them all, but - -- FindResult doesn't have enough information to support this. - -- In any case, this REALLY shouldn't happen (it means there are - -- broken packages in the database.) - (m:_) -> return (convFindExactResult m) - _ -> return (FoundSigs [FoundHs l m | FoundExact l m <- ok] backing) + LookupFound m pkg_conf -> + findPackageModule_ hsc_env m pkg_conf LookupMultiple rs -> return (FoundMultiple rs) LookupHidden pkg_hiddens mod_hiddens -> @@ -204,7 +176,7 @@ findExposedPackageModule hsc_env mod_name mb_pkg , fr_mods_hidden = [] , fr_suggestions = suggest }) -modLocationCache :: HscEnv -> Module -> IO FindExactResult -> IO FindExactResult +modLocationCache :: HscEnv -> Module -> IO FindResult -> IO FindResult modLocationCache hsc_env mod do_this = do m <- lookupFinderCache (hsc_FC hsc_env) mod case m of @@ -217,7 +189,7 @@ modLocationCache hsc_env mod do_this = do addHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module addHomeModuleToFinder hsc_env mod_name loc = do let mod = mkModule (thisPackage (hsc_dflags hsc_env)) mod_name - addToFinderCache (hsc_FC hsc_env) mod (FoundExact loc mod) + addToFinderCache (hsc_FC hsc_env) mod (Found loc mod) return mod uncacheModule :: HscEnv -> ModuleName -> IO () @@ -244,7 +216,7 @@ uncacheModule hsc_env mod = do -- -- 4. Some special-case code in GHCi (ToDo: Figure out why that needs to -- call this.) -findHomeModule :: HscEnv -> ModuleName -> IO FindExactResult +findHomeModule :: HscEnv -> ModuleName -> IO FindResult findHomeModule hsc_env mod_name = homeSearchCache hsc_env mod_name $ let @@ -275,19 +247,19 @@ findHomeModule hsc_env mod_name = -- This is important only when compiling the base package (where GHC.Prim -- is a home module). if mod == gHC_PRIM - then return (FoundExact (error "GHC.Prim ModLocation") mod) + then return (Found (error "GHC.Prim ModLocation") mod) else searchPathExts home_path mod exts -- | Search for a module in external packages only. -findPackageModule :: HscEnv -> Module -> IO FindExactResult +findPackageModule :: HscEnv -> Module -> IO FindResult findPackageModule hsc_env mod = do let dflags = hsc_dflags hsc_env pkg_id = modulePackageKey mod -- case lookupPackage dflags pkg_id of - Nothing -> return (NoPackageExact pkg_id) + Nothing -> return (NoPackage pkg_id) Just pkg_conf -> findPackageModule_ hsc_env mod pkg_conf -- | Look up the interface file associated with module @mod@. This function @@ -297,14 +269,14 @@ findPackageModule hsc_env mod = do -- the 'PackageConfig' must be consistent with the package key in the 'Module'. -- The redundancy is to avoid an extra lookup in the package state -- for the appropriate config. -findPackageModule_ :: HscEnv -> Module -> PackageConfig -> IO FindExactResult +findPackageModule_ :: HscEnv -> Module -> PackageConfig -> IO FindResult findPackageModule_ hsc_env mod pkg_conf = ASSERT( modulePackageKey mod == packageConfigId pkg_conf ) modLocationCache hsc_env mod $ -- special case for GHC.Prim; we won't find it in the filesystem. if mod == gHC_PRIM - then return (FoundExact (error "GHC.Prim ModLocation") mod) + then return (Found (error "GHC.Prim ModLocation") mod) else let @@ -327,7 +299,7 @@ findPackageModule_ hsc_env mod pkg_conf = -- don't bother looking for it. let basename = moduleNameSlashes (moduleName mod) loc <- mk_hi_loc one basename - return (FoundExact loc mod) + return (Found loc mod) _otherwise -> searchPathExts import_dirs mod [(package_hisuf, mk_hi_loc)] @@ -342,7 +314,7 @@ searchPathExts FilePath -> BaseName -> IO ModLocation -- action ) ] - -> IO FindExactResult + -> IO FindResult searchPathExts paths mod exts = do result <- search to_search @@ -368,13 +340,15 @@ searchPathExts paths mod exts file = base <.> ext ] - search [] = return (NotFoundExact {fer_paths = map fst to_search - ,fer_pkg = Just (modulePackageKey mod)}) + search [] = return (NotFound { fr_paths = map fst to_search + , fr_pkg = Just (modulePackageKey mod) + , fr_mods_hidden = [], fr_pkgs_hidden = [] + , fr_suggestions = [] }) search ((file, mk_result) : rest) = do b <- doesFileExist file if b - then do { loc <- mk_result; return (FoundExact loc mod) } + then do { loc <- mk_result; return (Found loc mod) } else search rest mkHomeModLocationSearched :: DynFlags -> ModuleName -> FileExt @@ -597,8 +571,7 @@ cantFindErr cannot_find _ dflags mod_name find_result vcat (map mod_hidden mod_hiddens) $$ tried_these files - _ -> pprPanic "cantFindErr" - (ptext cannot_find <+> quotes (ppr mod_name)) + _ -> panic "cantFindErr" build_tag = buildTag dflags diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index d6aa2273dc..39af5fa984 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -1377,20 +1377,6 @@ showRichTokenStream ts = go startLoc ts "" -- | Takes a 'ModuleName' and possibly a 'PackageKey', and consults the -- filesystem and package database to find the corresponding 'Module', -- using the algorithm that is used for an @import@ declaration. --- --- However, there is a twist for local modules, see #2682. --- --- The full algorithm: --- IF it's a package qualified import for a REMOTE package (not @this_pkg@ or --- this), do a normal lookup. --- OTHERWISE see if it is ALREADY loaded, and use it if it is. --- OTHERWISE do a normal lookup, but reject the result if the found result --- is from the LOCAL package (@this_pkg@). --- --- For signatures, we return the BACKING implementation to keep the API --- consistent with what we had before. (ToDo: create a new GHC API which --- can deal with signatures.) --- findModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module findModule mod_name maybe_pkg = withSession $ \hsc_env -> do let @@ -1401,23 +1387,17 @@ findModule mod_name maybe_pkg = withSession $ \hsc_env -> do Just pkg | fsToPackageKey pkg /= this_pkg && pkg /= fsLit "this" -> liftIO $ do res <- findImportedModule hsc_env mod_name maybe_pkg case res of - FoundModule h -> return (fr_mod h) - FoundSigs _ backing -> return backing + Found _ m -> return m err -> throwOneError $ noModError dflags noSrcSpan mod_name err _otherwise -> do home <- lookupLoadedHomeModule mod_name case home of - -- TODO: This COULD be a signature Just m -> return m Nothing -> liftIO $ do res <- findImportedModule hsc_env mod_name maybe_pkg case res of - FoundModule (FoundHs { fr_mod = m, fr_loc = loc }) - | modulePackageKey m /= this_pkg -> return m - | otherwise -> modNotLoadedError dflags m loc - FoundSigs (FoundHs { fr_loc = loc, fr_mod = m }:_) backing - | modulePackageKey m /= this_pkg -> return backing - | otherwise -> modNotLoadedError dflags m loc + Found loc m | modulePackageKey m /= this_pkg -> return m + | otherwise -> modNotLoadedError dflags m loc err -> throwOneError $ noModError dflags noSrcSpan mod_name err modNotLoadedError :: DynFlags -> Module -> ModLocation -> IO a @@ -1438,13 +1418,11 @@ lookupModule mod_name (Just pkg) = findModule mod_name (Just pkg) lookupModule mod_name Nothing = withSession $ \hsc_env -> do home <- lookupLoadedHomeModule mod_name case home of - -- TODO: This COULD be a signature Just m -> return m Nothing -> liftIO $ do res <- findExposedPackageModule hsc_env mod_name Nothing case res of - FoundModule (FoundHs { fr_mod = m }) -> return m - FoundSigs _ backing -> return backing + Found _ m -> return m err -> throwOneError $ noModError (hsc_dflags hsc_env) noSrcSpan mod_name err lookupLoadedHomeModule :: GhcMonad m => ModuleName -> m (Maybe Module) diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index 89cab9ef3a..2d1d9ebf52 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -1815,10 +1815,7 @@ findSummaryBySourceFile summaries file [] -> Nothing (x:_) -> Just x --- | Summarise a module, and pick up source and timestamp. --- Returns @Nothing@ if the module is excluded via @excl_mods@ or is an --- external package module (which we don't compile), otherwise returns the --- new module summary (or an error saying why we couldn't summarise it). +-- Summarise a module, and pick up source and timestamp. summariseModule :: HscEnv -> NodeMap ModSummary -- Map of old summaries @@ -1880,10 +1877,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) uncacheModule hsc_env wanted_mod found <- findImportedModule hsc_env wanted_mod Nothing case found of - -- TODO: When we add -alias support, we can validly find - -- multiple signatures in the home package; need to make this - -- logic more flexible in that case. - FoundModule (FoundHs { fr_loc = location, fr_mod = mod }) + Found location mod | isJust (ml_hs_file location) -> -- Home package just_found location mod @@ -1892,15 +1886,6 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) ASSERT(modulePackageKey mod /= thisPackage dflags) return Nothing - FoundSigs hs _backing - | Just (FoundHs { fr_loc = location, fr_mod = mod }) - <- find (isJust . ml_hs_file . fr_loc) hs -> - just_found location mod - | otherwise -> - ASSERT(all (\h -> modulePackageKey (fr_mod h) - /= thisPackage dflags) hs) - return Nothing - err -> return $ Just $ Left $ noModError dflags loc wanted_mod err -- Not found diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs index f834e17e0c..67b069470b 100644 --- a/compiler/main/HscTypes.hs +++ b/compiler/main/HscTypes.hs @@ -10,7 +10,7 @@ module HscTypes ( -- * compilation state HscEnv(..), hscEPS, - FinderCache, FindResult(..), FoundHs(..), FindExactResult(..), + FinderCache, FindResult(..), Target(..), TargetId(..), pprTarget, pprTargetId, ModuleGraph, emptyMG, HscStatus(..), @@ -674,30 +674,15 @@ prepareAnnotations hsc_env mb_guts = do -- modules along the search path. On @:load@, we flush the entire -- contents of this cache. -- -type FinderCache = ModuleEnv FindExactResult - --- | The result of search for an exact 'Module'. -data FindExactResult - = FoundExact ModLocation Module - -- ^ The module/signature was found - | NoPackageExact PackageKey - | NotFoundExact - { fer_paths :: [FilePath] - , fer_pkg :: Maybe PackageKey - } - --- | A found module or signature; e.g. anything with an interface file -data FoundHs = FoundHs { fr_loc :: ModLocation - , fr_mod :: Module - -- , fr_origin :: ModuleOrigin - } +-- Although the @FinderCache@ range is 'FindResult' for convenience, +-- in fact it will only ever contain 'Found' or 'NotFound' entries. +-- +type FinderCache = ModuleEnv FindResult -- | The result of searching for an imported module. data FindResult - = FoundModule FoundHs + = Found ModLocation Module -- ^ The module was found - | FoundSigs [FoundHs] Module - -- ^ Signatures were found, with some backing implementation | NoPackage PackageKey -- ^ The requested package was not found | FoundMultiple [(Module, ModuleOrigin)] @@ -2070,15 +2055,6 @@ type IsBootInterface = Bool -- Invariant: the dependencies of a module @M@ never includes @M@. -- -- Invariant: none of the lists contain duplicates. --- --- NB: While this contains information about all modules and packages below --- this one in the the import *hierarchy*, this may not accurately reflect --- the full runtime dependencies of the module. This is because this module may --- have imported a boot module, in which case we'll only have recorded the --- dependencies from the hs-boot file, not the actual hs file. (This is --- unavoidable: usually, the actual hs file will have been compiled *after* --- we wrote this interface file.) See #936, and also @getLinkDeps@ in --- @compiler/ghci/Linker.hs@ for code which cares about this distinction. data Dependencies = Deps { dep_mods :: [(ModuleName, IsBootInterface)] -- ^ All home-package modules transitively below this one diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs index 16ee352243..0be5e3ffaf 100644 --- a/compiler/main/Packages.hs +++ b/compiler/main/Packages.hs @@ -132,10 +132,9 @@ import qualified Data.Set as Set -- in a different DLL, by setting the DLL flag. -- | Given a module name, there may be multiple ways it came into scope, --- possibly simultaneously. For a given particular implementation (e.g. --- original module, or even a signature module), this data type tracks all the --- possible ways it could have come into scope. Warning: don't use the record --- functions, they're partial! +-- possibly simultaneously. This data type tracks all the possible ways +-- it could have come into scope. Warning: don't use the record functions, +-- they're partial! data ModuleOrigin = -- | Module is hidden, and thus never will be available for import. -- (But maybe the user didn't realize), so we'll still keep track @@ -159,7 +158,7 @@ data ModuleOrigin = } instance Outputable ModuleOrigin where - ppr ModHidden = text "hidden module" -- NB: cannot be signature + ppr ModHidden = text "hidden module" ppr (ModOrigin e res rhs f) = sep (punctuate comma ( (case e of Nothing -> [] @@ -176,18 +175,17 @@ instance Outputable ModuleOrigin where (if f then [text "package flag"] else []) )) --- | Smart constructor for a module which is in @exposed-modules@ or --- @exposed-signatures@. Takes as an argument whether or not the defining --- package is exposed. -fromExposed :: Bool -> ModuleOrigin -fromExposed e = ModOrigin (Just e) [] [] False +-- | Smart constructor for a module which is in @exposed-modules@. Takes +-- as an argument whether or not the defining package is exposed. +fromExposedModules :: Bool -> ModuleOrigin +fromExposedModules e = ModOrigin (Just e) [] [] False --- | Smart constructor for a module which is in @reexported-modules@ --- or @reexported-signatures@. Takes as an argument whether or not the --- reexporting package is expsed, and also its 'PackageConfig'. -fromReexported :: Bool -> PackageConfig -> ModuleOrigin -fromReexported True pkg = ModOrigin Nothing [pkg] [] False -fromReexported False pkg = ModOrigin Nothing [] [pkg] False +-- | Smart constructor for a module which is in @reexported-modules@. Takes +-- as an argument whether or not the reexporting package is expsed, and +-- also its 'PackageConfig'. +fromReexportedModules :: Bool -> PackageConfig -> ModuleOrigin +fromReexportedModules True pkg = ModOrigin Nothing [pkg] [] False +fromReexportedModules False pkg = ModOrigin Nothing [] [pkg] False -- | Smart constructor for a module which was bound by a package flag. fromFlag :: ModuleOrigin @@ -229,40 +227,11 @@ type PackageConfigMap = PackageKeyMap PackageConfig type VisibilityMap = PackageKeyMap (Bool, [(ModuleName, ModuleName)], FastString) --- | Alias for 'Module' indicating we expect the interface in question to --- be for a signature. -type Signature = Module - --- | Alias for 'ModuleOrigin' indicating we expect it to describe a signature. -type SignatureOrigin = ModuleOrigin - --- | This is the main lookup structure we use to handle imports, which map --- from 'ModuleName' to 'ModuleDb', which describes all possible implementations --- which are available under a module name. -type ModuleNameDb = Map ModuleName ModuleDb - --- | This is an auxiliary structure per module name, and it's a map of --- backing implementations to more information about them. This is a map --- so it's easy to tell if we're bringing in an implementation for a name --- which is already in scope (and thus non-conflicting.) -type ModuleDb = Map Module ModuleDesc - --- | Per backing implementation, there may be multiple signatures available --- exporting subsets of its interface; we need to track all of them. -type SignatureDb = Map Signature SignatureOrigin - --- | Combined module description for a module: includes 'ModuleOrigin' --- describing the backing implementation, as well as 'SignatureDb' for any --- signatures of the module in question. -data ModuleDesc = MD ModuleOrigin SignatureDb - -instance Outputable ModuleDesc where - ppr (MD o m) = ppr o <+> parens (ppr m) - -instance Monoid ModuleDesc where - mempty = MD mempty Map.empty - mappend (MD o m) (MD o' m') = MD (o `mappend` o') - (Map.unionWith mappend m m') +-- | Map from 'ModuleName' to 'Module' to all the origins of the bindings +-- in scope. The 'PackageConf' is not cached, mostly for convenience reasons +-- (since this is the slow path, we'll just look it up again). +type ModuleToPkgConfAll = + Map ModuleName (Map Module ModuleOrigin) data PackageState = PackageState { -- | A mapping of 'PackageKey' to 'PackageConfig'. This list is adjusted @@ -280,7 +249,7 @@ data PackageState = PackageState { -- | This is a full map from 'ModuleName' to all modules which may possibly -- be providing it. These providers may be hidden (but we'll still want -- to report them in error messages), or it may be an ambiguous import. - moduleNameDb :: ModuleNameDb, + moduleToPkgConfAll :: ModuleToPkgConfAll, -- | This is a map from 'InstalledPackageId' to 'PackageKey', since GHC -- internally deals in package keys but the database may refer to installed @@ -292,7 +261,7 @@ emptyPackageState :: PackageState emptyPackageState = PackageState { pkgIdMap = emptyUFM, preloadPackages = [], - moduleNameDb = Map.empty, + moduleToPkgConfAll = Map.empty, installedPackageIdMap = Map.empty } @@ -1056,7 +1025,7 @@ mkPackageState dflags0 pkgs0 preload0 this_package = do let pstate = PackageState{ preloadPackages = dep_preload, pkgIdMap = pkg_db, - moduleNameDb = mkModuleNameDb dflags pkg_db ipid_map vis_map, + moduleToPkgConfAll = mkModuleToPkgConfAll dflags pkg_db ipid_map vis_map, installedPackageIdMap = ipid_map } return (pstate, new_dep_preload, this_package) @@ -1065,70 +1034,62 @@ mkPackageState dflags0 pkgs0 preload0 this_package = do -- ----------------------------------------------------------------------------- -- | Makes the mapping from module to package info -mkModuleNameDb +mkModuleToPkgConfAll :: DynFlags -> PackageConfigMap -> InstalledPackageIdMap -> VisibilityMap - -> ModuleNameDb -mkModuleNameDb dflags pkg_db ipid_map vis_map = + -> ModuleToPkgConfAll +mkModuleToPkgConfAll dflags pkg_db ipid_map vis_map = foldl' extend_modmap emptyMap (eltsUFM pkg_db) where emptyMap = Map.empty - sing pk m = Map.singleton (mkModule pk m) + sing pk m _ = Map.singleton (mkModule pk m) addListTo = foldl' merge merge m (k, v) = Map.insertWith (Map.unionWith mappend) k v m + setOrigins m os = fmap (const os) m extend_modmap modmap pkg = addListTo modmap theBindings where - theBindings :: [(ModuleName, ModuleDb)] + theBindings :: [(ModuleName, Map Module ModuleOrigin)] theBindings | Just (b,rns,_) <- lookupUFM vis_map (packageConfigId pkg) = newBindings b rns | otherwise = newBindings False [] newBindings :: Bool -> [(ModuleName, ModuleName)] - -> [(ModuleName, ModuleDb)] + -> [(ModuleName, Map Module ModuleOrigin)] newBindings e rns = es e ++ hiddens ++ map rnBinding rns rnBinding :: (ModuleName, ModuleName) - -> (ModuleName, ModuleDb) - rnBinding (orig, new) = (new, fmap applyFlag origEntry) + -> (ModuleName, Map Module ModuleOrigin) + rnBinding (orig, new) = (new, setOrigins origEntry fromFlag) where origEntry = case lookupUFM esmap orig of Just r -> r Nothing -> throwGhcException (CmdLineError (showSDoc dflags (text "package flag: could not find module name" <+> ppr orig <+> text "in package" <+> ppr pk))) - applyFlag (MD _ sigs) = MD fromFlag (fmap (const fromFlag) sigs) - - es :: Bool -> [(ModuleName, ModuleDb)] + es :: Bool -> [(ModuleName, Map Module ModuleOrigin)] es e = do - ExposedModule m exposedReexport exposedSignature <- exposed_mods - let (pk', m', origin') = + -- TODO: signature support + ExposedModule m exposedReexport _exposedSignature <- exposed_mods + let (pk', m', pkg', origin') = case exposedReexport of - Nothing -> (pk, m, fromExposed e) + Nothing -> (pk, m, pkg, fromExposedModules e) Just (OriginalModule ipid' m') -> - let (pk', pkg') = ipid_lookup ipid' - in (pk', m', fromReexported e pkg') - return $ case exposedSignature of - Nothing -> (m, sing pk' m' (MD origin' Map.empty)) - Just (OriginalModule ipid'' m'') -> - let (pk'', _) = ipid_lookup ipid'' - in (m, sing pk'' m'' (MD mempty (sing pk' m' origin'))) + let pk' = expectJust "mkModuleToPkgConf" (Map.lookup ipid' ipid_map) + pkg' = pkg_lookup pk' + in (pk', m', pkg', fromReexportedModules e pkg') + return (m, sing pk' m' pkg' origin') - - esmap :: UniqFM ModuleDb + esmap :: UniqFM (Map Module ModuleOrigin) esmap = listToUFM (es False) -- parameter here doesn't matter, orig will -- be overwritten - hiddens :: [(ModuleName, ModuleDb)] - hiddens = [(m, sing pk m (MD ModHidden Map.empty)) | m <- hidden_mods] + hiddens = [(m, sing pk m pkg ModHidden) | m <- hidden_mods] pk = packageConfigId pkg - pkg_lookup = expectJust "mkModuleNameDb" . lookupPackage' pkg_db - ipid_lookup ipid = - let pk = expectJust "mkModuleNameDb" (Map.lookup ipid ipid_map) - in (pk, pkg_lookup pk) + pkg_lookup = expectJust "mkModuleToPkgConf" . lookupPackage' pkg_db exposed_mods = exposedModules pkg hidden_mods = hiddenModules pkg @@ -1238,20 +1199,16 @@ lookupModuleInAllPackages :: DynFlags -> [(Module, PackageConfig)] lookupModuleInAllPackages dflags m = case lookupModuleWithSuggestions dflags m Nothing of - LookupFound (m,_) -> [(m,get_pkg m)] - LookupMultiple rs -> map (\(m,_) -> (m,get_pkg m)) rs + LookupFound a b -> [(a,b)] + LookupMultiple rs -> map f rs + where f (m,_) = (m, expectJust "lookupModule" (lookupPackage dflags + (modulePackageKey m))) _ -> [] - where get_pkg = expectJust "lookupModule" . lookupPackage dflags - . modulePackageKey -- | The result of performing a lookup data LookupResult = -- | Found the module uniquely, nothing else to do - LookupFound (Module, ModuleOrigin) - -- | We found (possibly multiple) signatures with a unique backing - -- implementation: they should be "merged" together. For good measure, - -- the backing implementation is recorded too. - | LookupFoundSigs [(Module, ModuleOrigin)] Module + LookupFound Module PackageConfig -- | Multiple modules with the same name in scope | LookupMultiple [(Module, ModuleOrigin)] -- | No modules found, but there were some hidden ones with @@ -1261,39 +1218,6 @@ data LookupResult = -- | Nothing found, here are some suggested different names | LookupNotFound [ModuleSuggestion] -- suggestions -instance Monoid LookupResult where - mempty = LookupNotFound [] - - LookupNotFound s1 `mappend` LookupNotFound s2 - = LookupNotFound (s1 ++ s2) - LookupNotFound{} `mappend` l = l - l `mappend` LookupNotFound{} = l - - LookupHidden x1 y1 `mappend` LookupHidden x2 y2 - = LookupHidden (x1 ++ x2) (y1 ++ y2) - LookupHidden{} `mappend` l = l - l `mappend` LookupHidden{} = l - - LookupFound m1 `mappend` LookupFound m2 - = ASSERT(fst m1 /= fst m2) LookupMultiple [m1, m2] - LookupFound m `mappend` LookupMultiple ms - = ASSERT(not (any ((==fst m).fst) ms)) LookupMultiple (m:ms) - LookupFound m `mappend` LookupFoundSigs ms check - | fst m == check = LookupFound m - | otherwise = LookupMultiple (m:ms) - l1 `mappend` l2@LookupFound{} - = l2 `mappend` l1 - - LookupMultiple ms1 `mappend` LookupFoundSigs ms2 _ - = LookupMultiple (ms1 ++ ms2) - LookupMultiple ms1 `mappend` LookupMultiple ms2 - = LookupMultiple (ms1 ++ ms2) - l1 `mappend` l2@LookupMultiple{} - = l2 `mappend` l1 - - LookupFoundSigs ms1 m1 `mappend` LookupFoundSigs ms2 m2 - = ASSERT(m1 /= m2) LookupMultiple (ms1 ++ ms2) - data ModuleSuggestion = SuggestVisible ModuleName Module ModuleOrigin | SuggestHidden ModuleName Module ModuleOrigin @@ -1302,28 +1226,23 @@ lookupModuleWithSuggestions :: DynFlags -> Maybe FastString -> LookupResult lookupModuleWithSuggestions dflags m mb_pn - = case Map.lookup m (moduleNameDb pkg_state) of + = case Map.lookup m (moduleToPkgConfAll pkg_state) of Nothing -> LookupNotFound suggestions - Just xs -> mconcat (LookupNotFound suggestions - :map classify (Map.toList xs)) + Just xs -> + case foldl' classify ([],[],[]) (Map.toList xs) of + ([], [], []) -> LookupNotFound suggestions + (_, _, [(m, _)]) -> LookupFound m (mod_pkg m) + (_, _, exposed@(_:_)) -> LookupMultiple exposed + (hidden_pkg, hidden_mod, []) -> LookupHidden hidden_pkg hidden_mod where - classify (m, MD origin0 sigs0) = + classify (hidden_pkg, hidden_mod, exposed) (m, origin0) = let origin = filterOrigin mb_pn (mod_pkg m) origin0 - r = (m, origin) + x = (m, origin) in case origin of - ModHidden -> LookupHidden [] [r] - _ | originVisible origin -> LookupFound r - | otherwise -> - let sigs = do (back_m, back_origin0) <- Map.toList sigs0 - let back_origin = filterOrigin mb_pn - (mod_pkg back_m) - back_origin0 - guard (originVisible back_origin) - return (back_m, back_origin) - in case sigs of - [] | originEmpty origin -> LookupNotFound [] - | otherwise -> LookupHidden [r] [] - _ -> LookupFoundSigs sigs m + ModHidden -> (hidden_pkg, x:hidden_mod, exposed) + _ | originEmpty origin -> (hidden_pkg, hidden_mod, exposed) + | originVisible origin -> (hidden_pkg, hidden_mod, x:exposed) + | otherwise -> (x:hidden_pkg, hidden_mod, exposed) pkg_lookup = expectJust "lookupModuleWithSuggestions" . lookupPackage dflags pkg_state = pkgState dflags @@ -1358,18 +1277,17 @@ lookupModuleWithSuggestions dflags m mb_pn all_mods :: [(String, ModuleSuggestion)] -- All modules all_mods = sortBy (comparing fst) $ [ (moduleNameString m, suggestion) - | (m, e) <- Map.toList (moduleNameDb (pkgState dflags)) + | (m, e) <- Map.toList (moduleToPkgConfAll (pkgState dflags)) , suggestion <- map (getSuggestion m) (Map.toList e) ] - -- For now, don't suggest implemented signatures - getSuggestion name (mod, MD origin _) = + getSuggestion name (mod, origin) = (if originVisible origin then SuggestVisible else SuggestHidden) name mod origin listVisibleModuleNames :: DynFlags -> [ModuleName] listVisibleModuleNames dflags = - map fst (filter visible (Map.toList (moduleNameDb (pkgState dflags)))) - where visible (_, ms) = any (\(MD o _) -> originVisible o) (Map.elems ms) + map fst (filter visible (Map.toList (moduleToPkgConfAll (pkgState dflags)))) + where visible (_, ms) = any originVisible (Map.elems ms) -- | Find all the 'PackageConfig' in both the preload packages from 'DynFlags' and corresponding to the list of -- 'PackageConfig's @@ -1508,7 +1426,7 @@ pprPackagesSimple = pprPackagesWith pprIPI -- | Show the mapping of modules to where they come from. pprModuleMap :: DynFlags -> SDoc pprModuleMap dflags = - vcat (map pprLine (Map.toList (moduleNameDb (pkgState dflags)))) + vcat (map pprLine (Map.toList (moduleToPkgConfAll (pkgState dflags)))) where pprLine (m,e) = ppr m $$ nest 50 (vcat (map (pprEntry m) (Map.toList e))) pprEntry m (m',o) diff --git a/docs/users_guide/separate_compilation.xml b/docs/users_guide/separate_compilation.xml index f6b2cba0ce..639c7de160 100644 --- a/docs/users_guide/separate_compilation.xml +++ b/docs/users_guide/separate_compilation.xml @@ -970,11 +970,6 @@ ghc -c A.hs written in a subset of Haskell essentially identical to that of <literal>hs-boot</literal> files.</para> - <para>Signatures can be installed like ordinary module files, - and when multiple signatures are brought into scope under the same - module name, they are merged together if their backing implementations - are the same.</para> - <para>There is one important gotcha with the current implementation: currently, instances from backing implementations will "leak" code that uses signatures, and explicit instance declarations in signatures are diff --git a/ghc/Main.hs b/ghc/Main.hs index 201ee5d8d2..fa266a24f8 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -834,12 +834,11 @@ abiHash strs = do let modname = mkModuleName str r <- findImportedModule hsc_env modname Nothing case r of - FoundModule h -> return [fr_mod h] - FoundSigs hs _ -> return (map fr_mod hs) + Found _ m -> return m _error -> throwGhcException $ CmdLineError $ showSDoc dflags $ cannotFindInterface dflags modname r - mods <- fmap concat (mapM find_it strs) + mods <- mapM find_it strs let get_iface modl = loadUserInterface False (text "abiHash") modl ifaces <- initIfaceCheck hsc_env $ mapM get_iface mods diff --git a/testsuite/.gitignore b/testsuite/.gitignore index ade0024bcb..1716b8f9c6 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -119,12 +119,6 @@ mk/ghcconfig*_inplace_bin_ghc-stage2.exe.mk /tests/cabal/sigcabal01/p_lazy /tests/cabal/sigcabal01/p_strict /tests/cabal/sigcabal01/containers -/tests/cabal/sigcabal02/Main -/tests/cabal/sigcabal02/p_ipid -/tests/cabal/sigcabal02/q_ipid -/tests/cabal/sigcabal02/containers -/tests/cabal/sigcabal02/tmp* -/tests/cabal/sigcabal02/inst* /tests/cabal/local01.package.conf/ /tests/cabal/local03.package.conf/ /tests/cabal/local04.package.conf/ diff --git a/testsuite/tests/cabal/sigcabal02/Main.hs b/testsuite/tests/cabal/sigcabal02/Main.hs deleted file mode 100644 index 52def3d41f..0000000000 --- a/testsuite/tests/cabal/sigcabal02/Main.hs +++ /dev/null @@ -1,7 +0,0 @@ -import Map -import P -import Q - -main = do - x <- foo - print (mymember 5 x) diff --git a/testsuite/tests/cabal/sigcabal02/Makefile b/testsuite/tests/cabal/sigcabal02/Makefile deleted file mode 100644 index 152aaeac0e..0000000000 --- a/testsuite/tests/cabal/sigcabal02/Makefile +++ /dev/null @@ -1,34 +0,0 @@ -TOP=../../.. -include $(TOP)/mk/boilerplate.mk -include $(TOP)/mk/test.mk - -SETUP=../Setup -v0 - -# This test is for two Cabal packages exposing the same signature - -sigcabal02: - $(MAKE) clean - '$(GHC_PKG)' field containers id | sed 's/^.*: *//' > containers - '$(GHC_PKG)' init tmp.d - '$(TEST_HC)' -v0 --make Setup - cd p && $(SETUP) clean - cd p && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --prefix='$(PWD)/inst-p' --instantiate-with="Map=Data.Map.Lazy@`cat ../containers`" --instantiate-with="Set=Data.Set@`cat ../containers`" --ghc-pkg-options="--enable-multi-instance" - cd p && $(SETUP) build - cd p && $(SETUP) copy - cd p && $(SETUP) register --print-ipid > ../p_ipid - cd q && $(SETUP) clean - cd q && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --prefix='$(PWD)/inst-p' --instantiate-with="Map=Data.Map.Lazy@`cat ../containers`" --ghc-pkg-options="--enable-multi-instance" - cd q && $(SETUP) build - cd q && $(SETUP) copy - cd q && $(SETUP) register --print-ipid > ../q_ipid - '$(TEST_HC)' $(TEST_HC_OPTS) -package-db=tmp.d -hide-all-packages -package base -package-id "`cat p_ipid`" -package-id "`cat q_ipid`" --make Main.hs - ./Main - ! '$(TEST_HC)' $(TEST_HC_OPTS) -package-db=tmp.d -hide-all-packages -package base -package-id "`cat p_ipid`" -package-id "`cat q_ipid`" --make ShouldFail.hs -ifneq "$(CLEANUP)" "" - $(MAKE) clean -endif - -clean : - '$(GHC_PKG)' unregister --force p >/dev/null 2>&1 || true - '$(GHC_PKG)' unregister --force q >/dev/null 2>&1 || true - $(RM) -r tmp.d inst-* *.o *.hi */*.o */*.hi */Setup$(exeext) */dist Setup$(exeext) diff --git a/testsuite/tests/cabal/sigcabal02/Setup.hs b/testsuite/tests/cabal/sigcabal02/Setup.hs deleted file mode 100644 index 9a994af677..0000000000 --- a/testsuite/tests/cabal/sigcabal02/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/testsuite/tests/cabal/sigcabal02/ShouldFail.hs b/testsuite/tests/cabal/sigcabal02/ShouldFail.hs deleted file mode 100644 index 98ec49e886..0000000000 --- a/testsuite/tests/cabal/sigcabal02/ShouldFail.hs +++ /dev/null @@ -1 +0,0 @@ -import Set diff --git a/testsuite/tests/cabal/sigcabal02/all.T b/testsuite/tests/cabal/sigcabal02/all.T deleted file mode 100644 index 11eb05975b..0000000000 --- a/testsuite/tests/cabal/sigcabal02/all.T +++ /dev/null @@ -1,9 +0,0 @@ -if default_testopts.cleanup != '': - cleanup = 'CLEANUP=1' -else: - cleanup = '' - -test('sigcabal02', - normal, - run_command, - ['$MAKE -s --no-print-directory sigcabal02 ' + cleanup]) diff --git a/testsuite/tests/cabal/sigcabal02/p/LICENSE b/testsuite/tests/cabal/sigcabal02/p/LICENSE deleted file mode 100644 index e69de29bb2..0000000000 --- a/testsuite/tests/cabal/sigcabal02/p/LICENSE +++ /dev/null diff --git a/testsuite/tests/cabal/sigcabal02/p/Map.hsig b/testsuite/tests/cabal/sigcabal02/p/Map.hsig deleted file mode 100644 index 359cf64ab9..0000000000 --- a/testsuite/tests/cabal/sigcabal02/p/Map.hsig +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE RoleAnnotations #-} -module Map where - -import Set - -type role Map nominal representational -data Map k a - -instance (Show k, Show a) => Show (Map k a) - -size :: Map k a -> Int -lookup :: Ord k => k -> Map k a -> Maybe a -empty :: Map k a -insert :: Ord k => k -> a -> Map k a -> Map k a -delete :: Ord k => k -> Map k a -> Map k a - -keysSet :: Map k a -> Set k -fromSet :: (k -> a) -> Set k -> Map k a diff --git a/testsuite/tests/cabal/sigcabal02/p/P.hs b/testsuite/tests/cabal/sigcabal02/p/P.hs deleted file mode 100644 index dec6b41c94..0000000000 --- a/testsuite/tests/cabal/sigcabal02/p/P.hs +++ /dev/null @@ -1,12 +0,0 @@ -module P where - -import qualified Map -import qualified Set - -foo = do - let x = Map.insert 0 "foo" - . Map.insert (6 :: Int) "foo" - $ Map.empty - print (Map.lookup 1 x) - print (Set.size (Map.keysSet x)) - return x diff --git a/testsuite/tests/cabal/sigcabal02/p/Set.hsig b/testsuite/tests/cabal/sigcabal02/p/Set.hsig deleted file mode 100644 index 1713133365..0000000000 --- a/testsuite/tests/cabal/sigcabal02/p/Set.hsig +++ /dev/null @@ -1,13 +0,0 @@ -{-# LANGUAGE RoleAnnotations #-} -module Set where - -type role Set nominal -data Set a - -instance Show a => Show (Set a) - -size :: Set a -> Int -member :: Ord a => a -> Set a -> Bool -empty :: Set a -insert :: Ord a => a -> Set a -> Set a -delete :: Ord a => a -> Set a -> Set a diff --git a/testsuite/tests/cabal/sigcabal02/p/p.cabal b/testsuite/tests/cabal/sigcabal02/p/p.cabal deleted file mode 100644 index bb3b2a4463..0000000000 --- a/testsuite/tests/cabal/sigcabal02/p/p.cabal +++ /dev/null @@ -1,14 +0,0 @@ -name: p -version: 1.0 -license-file: LICENSE -author: Edward Z. Yang -maintainer: ezyang@cs.stanford.edu -build-type: Simple -cabal-version: >=1.20 - -library - exposed-modules: P - exposed-signatures: Map - required-signatures: Set - build-depends: base - default-language: Haskell2010 diff --git a/testsuite/tests/cabal/sigcabal02/q/LICENSE b/testsuite/tests/cabal/sigcabal02/q/LICENSE deleted file mode 100644 index e69de29bb2..0000000000 --- a/testsuite/tests/cabal/sigcabal02/q/LICENSE +++ /dev/null diff --git a/testsuite/tests/cabal/sigcabal02/q/Map.hsig b/testsuite/tests/cabal/sigcabal02/q/Map.hsig deleted file mode 100644 index 40fd0bc74c..0000000000 --- a/testsuite/tests/cabal/sigcabal02/q/Map.hsig +++ /dev/null @@ -1,7 +0,0 @@ -{-# LANGUAGE RoleAnnotations #-} -module Map where - -type role Map nominal representational -data Map k a - -member :: Ord k => k -> Map k a -> Bool diff --git a/testsuite/tests/cabal/sigcabal02/q/Q.hs b/testsuite/tests/cabal/sigcabal02/q/Q.hs deleted file mode 100644 index ba55fb97b7..0000000000 --- a/testsuite/tests/cabal/sigcabal02/q/Q.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Q where - -import qualified Map -import Map(Map) - -mymember :: Int -> Map Int a -> Bool -mymember k m = Map.member k m || Map.member (k + 1) m diff --git a/testsuite/tests/cabal/sigcabal02/q/q.cabal b/testsuite/tests/cabal/sigcabal02/q/q.cabal deleted file mode 100644 index 2f99c4403c..0000000000 --- a/testsuite/tests/cabal/sigcabal02/q/q.cabal +++ /dev/null @@ -1,13 +0,0 @@ -name: q -version: 1.0 -license-file: LICENSE -author: Edward Z. Yang -maintainer: ezyang@cs.stanford.edu -build-type: Simple -cabal-version: >=1.20 - -library - exposed-modules: Q - exposed-signatures: Map - build-depends: base - default-language: Haskell2010 diff --git a/testsuite/tests/cabal/sigcabal02/sigcabal02.stderr b/testsuite/tests/cabal/sigcabal02/sigcabal02.stderr deleted file mode 100644 index 7c1f09239f..0000000000 --- a/testsuite/tests/cabal/sigcabal02/sigcabal02.stderr +++ /dev/null @@ -1,4 +0,0 @@ - -ShouldFail.hs:1:8: - Could not find module ‘Set’ - Use -v to see a list of the files searched for. diff --git a/testsuite/tests/cabal/sigcabal02/sigcabal02.stdout b/testsuite/tests/cabal/sigcabal02/sigcabal02.stdout deleted file mode 100644 index 48cb59e63a..0000000000 --- a/testsuite/tests/cabal/sigcabal02/sigcabal02.stdout +++ /dev/null @@ -1,5 +0,0 @@ -[1 of 1] Compiling Main ( Main.hs, Main.o ) -Linking Main ... -Nothing -2 -True diff --git a/testsuite/tests/driver/recomp014/Makefile b/testsuite/tests/driver/recomp014/Makefile deleted file mode 100644 index e788110097..0000000000 --- a/testsuite/tests/driver/recomp014/Makefile +++ /dev/null @@ -1,31 +0,0 @@ -TOP=../../.. -include $(TOP)/mk/boilerplate.mk -include $(TOP)/mk/test.mk - -# -fforce-recomp makes lots of driver tests trivially pass, so we -# filter it out from $(TEST_HC_OPTS). -TEST_HC_OPTS_NO_RECOMP = $(filter-out -fforce-recomp,$(TEST_HC_OPTS)) - -# Recompilation tests - -clean: - rm -f *.o *.hi - -recomp014: clean - echo 'module A where a = False' > A.hs - echo 'module A1 where a = False' > A1.hs - echo 'module B where a :: Bool' > B.hsig - echo 'first run' - '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c A.hs - '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c A1.hs - '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c B.hsig -sig-of "B is main:A" - echo 'import B; main = print a' > C.hs - '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c C.hs - '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c C.hs - echo 'second run' - '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c B.hsig -sig-of "B is main:A1" - '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c C.hs - '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) A1.o C.o -o recomp014 - ./recomp014 - -.PHONY: clean recomp014 diff --git a/testsuite/tests/driver/recomp014/all.T b/testsuite/tests/driver/recomp014/all.T deleted file mode 100644 index affccd2f7f..0000000000 --- a/testsuite/tests/driver/recomp014/all.T +++ /dev/null @@ -1,4 +0,0 @@ -test('recomp014', - [ clean_cmd('$MAKE -s clean') ], - run_command, - ['$MAKE -s --no-print-directory recomp014']) diff --git a/testsuite/tests/driver/recomp014/recomp014.stdout b/testsuite/tests/driver/recomp014/recomp014.stdout deleted file mode 100644 index 7d540716f0..0000000000 --- a/testsuite/tests/driver/recomp014/recomp014.stdout +++ /dev/null @@ -1,4 +0,0 @@ -first run -compilation IS NOT required -second run -False diff --git a/testsuite/tests/driver/sigof01/Makefile b/testsuite/tests/driver/sigof01/Makefile index 629d4b656a..84dfc33a9f 100644 --- a/testsuite/tests/driver/sigof01/Makefile +++ b/testsuite/tests/driver/sigof01/Makefile @@ -21,9 +21,3 @@ sigof01m: mkdir tmp_sigof01m '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -outputdir tmp_sigof01m --make Main.hs -sig-of "B is main:A" -o tmp_sigof01m/Main tmp_sigof01m/Main - -sigof01i: - '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) --interactive -v0 -ignore-dot-ghci Main.hs -sig-of "B is main:A" < sigof01i.script - -sigof01i2: - '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) --interactive -v0 -ignore-dot-ghci -sig-of "B is main:A" < sigof01i2.script diff --git a/testsuite/tests/driver/sigof01/all.T b/testsuite/tests/driver/sigof01/all.T index 50418b9af0..d0cdc3c02c 100644 --- a/testsuite/tests/driver/sigof01/all.T +++ b/testsuite/tests/driver/sigof01/all.T @@ -7,13 +7,3 @@ test('sigof01m', [ clean_cmd('rm -rf tmp_sigof01m') ], run_command, ['$MAKE -s --no-print-directory sigof01m']) - -test('sigof01i', - normal, - run_command, - ['$MAKE -s --no-print-directory sigof01i']) - -test('sigof01i2', - normal, - run_command, - ['$MAKE -s --no-print-directory sigof01i2']) diff --git a/testsuite/tests/driver/sigof01/sigof01i.script b/testsuite/tests/driver/sigof01/sigof01i.script deleted file mode 100644 index ba2906d066..0000000000 --- a/testsuite/tests/driver/sigof01/sigof01i.script +++ /dev/null @@ -1 +0,0 @@ -main diff --git a/testsuite/tests/driver/sigof01/sigof01i.stdout b/testsuite/tests/driver/sigof01/sigof01i.stdout deleted file mode 100644 index bb614cd2a0..0000000000 --- a/testsuite/tests/driver/sigof01/sigof01i.stdout +++ /dev/null @@ -1,3 +0,0 @@ -False -T -True diff --git a/testsuite/tests/driver/sigof01/sigof01i2.script b/testsuite/tests/driver/sigof01/sigof01i2.script deleted file mode 100644 index 3a91e377a3..0000000000 --- a/testsuite/tests/driver/sigof01/sigof01i2.script +++ /dev/null @@ -1,3 +0,0 @@ -:load B -:browse B -:issafe diff --git a/testsuite/tests/driver/sigof01/sigof01i2.stdout b/testsuite/tests/driver/sigof01/sigof01i2.stdout deleted file mode 100644 index ac15dcfa1e..0000000000 --- a/testsuite/tests/driver/sigof01/sigof01i2.stdout +++ /dev/null @@ -1,8 +0,0 @@ -class Foo a where - foo :: a -> a -data T = A.T -mkT :: T -x :: Bool -Trust type is (Module: Safe, Package: trusted) -Package Trust: Off -B is trusted! diff --git a/testsuite/tests/package/package09e.stderr b/testsuite/tests/package/package09e.stderr index 70c6f22d89..9cd00a2930 100644 --- a/testsuite/tests/package/package09e.stderr +++ b/testsuite/tests/package/package09e.stderr @@ -1,5 +1,5 @@ package09e.hs:2:1: Ambiguous interface for ‘M’: - it is bound as Data.Map by a package flag it is bound as Data.Set by a package flag + it is bound as Data.Map by a package flag |