Hannes Siebenhandl pushed to branch wip/fendor/dep-json at Glasgow Haskell Compiler / GHC Commits: b2eed73f by fendor at 2026-09-25T14:48:04+02:00 Add makefile -M test - - - - - d87108e8 by fendor at 2026-09-25T15:58:43+02:00 Refactor Makefile to use phases appropriately Prepare refactoring to allow json and Makefile implementation - - - - - 01b023a0 by fendor at 2026-09-25T15:58:46+02:00 Abstract dependency processing from Makefile generation Allows multiple consumers - - - - - b5351fd6 by fendor at 2026-09-25T15:58:47+02:00 Add json output format - - - - - 663da77b by fendor at 2026-09-29T17:17:07+02:00 Add support for explicit level imports Don't merge boot module entries with the actual sources, they can have different imports, different preprocessors, etc... Expand the test to include a boot module with a preprocessor and options different to the source module. - - - - - 0963547e by fendor at 2026-10-01T16:25:24+02:00 New json output schema that works with multiple home units Update testsuite - - - - - 30 changed files: - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/MakeFile.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Pipeline/Phases.hs - compiler/GHC/Driver/Session.hs - docs/users_guide/separate_compilation.rst - testsuite/driver/testlib.py - + testsuite/tests/driver/T24384/A.hs - + testsuite/tests/driver/T24384/C.hs - + testsuite/tests/driver/T24384/C.hs-boot - + testsuite/tests/driver/T24384/D.hs - + testsuite/tests/driver/T24384/E.hs - + testsuite/tests/driver/T24384/Makefile - + testsuite/tests/driver/T24384/T24384a.stdout - + testsuite/tests/driver/T24384/T24384b.stdout - + testsuite/tests/driver/T24384/T24384b.stdout-mingw - + testsuite/tests/driver/T24384/T24384c.stdout - + testsuite/tests/driver/T24384/all.T - + testsuite/tests/driver/T24384/dep-internal/DepInternal.hs - + testsuite/tests/driver/T24384/dep-internal/dep-internal.pkg - + testsuite/tests/driver/T24384/dep-public/DepPublic.hs - + testsuite/tests/driver/T24384/dep-public/dep-public.pkg - + testsuite/tests/driver/T24384/dep/Dep.hs - + testsuite/tests/driver/T24384/dep/dep.pkg - + testsuite/tests/driver/T24384/foo.h - + testsuite/tests/driver/T24384/format_json.sh - + testsuite/tests/driver/T24384/lib/B.hs - + testsuite/tests/driver/T24384/lib/B.hs-boot - + testsuite/tests/driver/T24384/preproc.sh Changes: ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -351,6 +351,7 @@ data DynFlags = DynFlags { -- For ghc -M depMakefile :: FilePath, + depJson :: Maybe FilePath, depIncludePkgDeps :: Bool, depIncludeCppDeps :: Bool, depExcludeMods :: [ModuleName], @@ -694,6 +695,7 @@ defaultDynFlags mySettings = -- ghc -M values depMakefile = "Makefile", + depJson = Nothing, depIncludePkgDeps = False, depIncludeCppDeps = False, depExcludeMods = [], ===================================== compiler/GHC/Driver/MakeFile.hs ===================================== @@ -7,6 +7,8 @@ -- (c) The University of Glasgow 2005 -- ----------------------------------------------------------------------------- +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE RecordWildCards #-} module GHC.Driver.MakeFile ( doMkDependHS @@ -16,47 +18,68 @@ where import GHC.Prelude -import qualified GHC -import GHC.Driver.Make -import GHC.Driver.Monad +import GHC qualified + +import GHC.Data.Bag (listToBag) +import GHC.Data.FastString (lexicalCompareFS, unpackFS) +import GHC.Data.Graph.Directed (SCC (..)) +import GHC.Data.OsPath + import GHC.Driver.DynFlags -import GHC.Utils.Misc import GHC.Driver.Env import GHC.Driver.Errors.Types -import GHC.Types.UnresolvedImport -import qualified GHC.SysTools as SysTools -import GHC.Data.Graph.Directed ( SCC(..) ) -import GHC.Data.OsPath (unsafeDecodeUtf) -import GHC.Utils.Outputable -import GHC.Utils.Panic -import GHC.Types.SourceError -import GHC.Types.SrcLoc -import GHC.Types.PkgQual -import Data.List (partition) -import GHC.Utils.TmpFs +import GHC.Driver.Make +import GHC.Driver.Monad +import GHC.Driver.Phases +import GHC.Driver.Pipeline +import GHC.Driver.Pipeline.Monad +import GHC.Driver.Session +import GHC.Iface.Errors.Types import GHC.Iface.Load (cannotFindModule) +import GHC.SysTools qualified as SysTools +import GHC.Types.PkgQual +import GHC.Types.SourceError +import GHC.Types.SrcLoc +import GHC.Types.Unique.Set (UniqSet) +import GHC.Types.Unique.Set qualified as UniqSet +import GHC.Types.UnresolvedImport + +import GHC.Unit.Finder +import GHC.Unit.Info import GHC.Unit.Module -import GHC.Unit.Module.ModSummary import GHC.Unit.Module.Graph -import GHC.Unit.Finder +import GHC.Unit.Module.ModSummary +import GHC.Unit.State (lookupUnitId) -import GHC.Utils.Exception import GHC.Utils.Error +import GHC.Utils.Exception +import GHC.Utils.Json import GHC.Utils.Logger +import GHC.Utils.Misc +import GHC.Utils.Outputable +import GHC.Utils.Panic +import GHC.Utils.TmpFs +import Control.Monad (when) +import Data.Either +import Data.Foldable (traverse_) +import Data.IORef +import Data.List (partition) +import Data.Map.Strict qualified as Map +import Data.Maybe (isJust, isNothing) +import Data.Semigroup qualified as Semigroup +import Data.Set qualified as Set +import GHC.Generics (Generic, Generically (..)) import System.Directory -import System.FilePath +import qualified System.Directory as Directory +import System.OsPath as OsPath import System.IO -import System.IO.Error ( isEOFError ) -import Control.Monad ( when, forM_ ) -import Data.Maybe ( isJust ) -import Data.IORef -import qualified Data.Set as Set -import GHC.Iface.Errors.Types -import Data.Either -import GHC.Data.Bag (listToBag) +import System.IO.Error (isEOFError) +import qualified System.OsString as OsString +import qualified Data.Monoid as Monoid +import qualified System.FilePath as FilePath ----------------------------------------------------------------- -- @@ -98,27 +121,47 @@ doMkDependHS srcs = do doMkDependModuleGraph :: GhcMonad m => DynFlags -> ModuleGraph -> m () doMkDependModuleGraph dflags module_graph = do + hsc_env <- getSession logger <- getLogger - tmpfs <- hsc_tmpfs <$> getSession - let excl_mods = depExcludeMods dflags + let + tmpfs = hsc_tmpfs hsc_env + excl_mods = depExcludeMods dflags - files <- liftIO $ beginMkDependHS logger tmpfs dflags - let sorted = GHC.topSortModuleGraph False module_graph Nothing + root_ <- liftIO getCurrentDirectory + root <- encodeUtf root_ + let + backends = concat + [ [ initFileDepWriter logger root tmpfs dflags + ] + , [ initJsonDepWriter json_output dflags + | Just json_output <- [depJson dflags] + ] + ] + + + let sorted = GHC.topSortModuleGraph False module_graph Nothing -- Print out the dependencies if wanted liftIO $ debugTraceMsg logger 2 (text "Module dependencies" $$ ppr sorted) - -- Process them one by one, dumping results into makefile - -- and complaining about cycles - hsc_env <- getSession - root <- liftIO getCurrentDirectory - mapM_ (liftIO . processDeps dflags hsc_env excl_mods root (mkd_tmp_hdl files)) sorted + liftIO $ do + + -- Setup the writers + writers <- sequenceA backends + sinks <- traverse dw_beginWriter writers + + -- Do the actual work + do + -- Process them one by one, dumping results and complaining about cycles + mapM_ (processDeps dflags hsc_env (UniqSet.mkUniqSet excl_mods) sinks) sorted - -- If -ddump-mod-cycles, show cycles in the module graph - liftIO $ dumpModCycles logger module_graph + -- If -ddump-mod-cycles, show cycles in the module graph + liftIO $ dumpModCycles logger module_graph + + -- Tidy up + do + traverse_ dw_endWriter writers - -- Tidy up - liftIO $ endMkDependHS logger files -- Unconditional exiting is a bad idea. If an error occurs we'll get an --exception; if that is not caught it's fine, but at least we have a @@ -127,6 +170,200 @@ doMkDependModuleGraph dflags module_graph = do --`GHC.ghcCatch` \_ -> io $ exitWith (ExitFailure 1) +-------------------------------------------------------------------------------- +-- Types abstracting over the output +-------------------------------------------------------------------------------- + +data DepNode = + DepNode + { dn_mod :: ModuleWithIsBoot + , dn_src :: OsPath + , dn_obj :: OsPath + , dn_hi :: OsPath + , dn_preprocessing :: PreprocessingNode + } + +data PreprocessingNode = PreprocessingNode + { pn_preprocessor :: Maybe String + , pn_options :: [String] + } + +data Dep + = DepHi + { dep_mod :: Module + , dep_path :: OsPath + , dep_unit :: Maybe UnitInfo + , dep_local :: Bool + , dep_level :: ImportLevel + , dep_boot :: IsBootInterface + } + | DepCpp + { dep_path :: OsPath + } + +data DependencyWriter = DependencyWriter + { dw_beginWriter :: IO DepSink + , dw_endWriter :: IO () + } + +data DepSink = DepSink + { ds_writeDependency :: DepNode -> [Dep] -> IO () + } + +----------------------------------------------------------------- +-- +-- processDeps +-- +----------------------------------------------------------------- + +processDeps :: DynFlags + -> HscEnv + -> UniqSet ModuleName -- ^ Excludes + -> [DepSink] + -> SCC ModuleGraphNode + -> IO () +-- Write suitable dependencies to handle +-- Always: +-- this.o : this.hs +-- +-- If the dependency is on something other than a .hi file: +-- this.o this.p_o ... : dep +-- otherwise +-- this.o ... : dep.hi +-- this.p_o ... : dep.p_hi +-- ... +-- (where .o is $osuf, and the other suffixes come from +-- the cmdline -s options). +-- +-- For {-# SOURCE #-} imports the "hi" will be "hi-boot". + +processDeps _ hsc_env _ _ (CyclicSCC nodes) + = -- There shouldn't be any cycles; report them + throwOneError (initSourceErrorContext (hsc_dflags hsc_env)) $ cyclicModuleErr nodes + +processDeps _ hsc_env _ _ (AcyclicSCC (InstantiationNode _uid node)) + = -- There shouldn't be any backpack instantiations; report them as well + throwOneError (initSourceErrorContext (hsc_dflags hsc_env)) $ + mkPlainErrorMsgEnvelope noSrcSpan $ + GhcDriverMessage $ DriverInstantiationNodeInDependencyGeneration node + +processDeps _dflags _ _ _ (AcyclicSCC (LinkNode {})) = return () +processDeps _dflags _ _ _ (AcyclicSCC (UnitNode {})) = return () +processDeps _ _ _ _ (AcyclicSCC (ModuleNode _ (ModuleNodeFixed {}))) + -- No dependencies needed for fixed modules (already compiled) + = return () + +processDeps dflags hsc_env excl_mods sinks (AcyclicSCC (ModuleNode _ (ModuleNodeCompile node))) = do + pp <- preprocessor + let + dep_node = mkDepNode pp + find_deps imps = do + cpp_deps <- find_cpp_deps + import_deps <- find_import_deps imps + pure $ map Right cpp_deps ++ import_deps + (missing_dep_errs, deps) <- partitionEithers <$> find_deps (ms_imps node) + + if null missing_dep_errs + then do + traverse_ (\ sink -> ds_writeDependency sink dep_node deps) sinks + else do + let sec = initSourceErrorContext (hsc_dflags hsc_env) + throwErrors sec (mkMessages (listToBag missing_dep_errs)) + where + src_file = msHsFileOsPath node + mkDepNode preproc = + DepNode + { dn_mod = GWIB (ms_mod node) (isBootSummary node) + , dn_src = src_file + , dn_obj = msObjFileOsPath node + , dn_hi = msHiFileOsPath node + , dn_preprocessing = preproc + } + + preprocessor :: IO PreprocessingNode + preprocessor + | Just src <- ml_hs_file (ms_location node) + = runPipeline (hsc_hooks hsc_env) $ do + let + (_, suffix) = FilePath.splitExtension src + lit | Unlit _ <- startPhase suffix = True + | otherwise = False + pipe_env = mkPipeEnv StopPreprocess src Nothing NoOutputFile + unlit_fn <- if lit then use (T_Unlit pipe_env hsc_env src) else pure src + (dflags1, opts, _, _) <- use (T_FileArgs (hsc_logger hsc_env) (ms_hspp_opts node) unlit_fn) + let pp = pgm_F dflags1 + pure PreprocessingNode + { pn_preprocessor = if null pp then global_preprocessor else Just pp + , pn_options = opts + } + | otherwise + = pure PreprocessingNode + { pn_preprocessor = global_preprocessor + , pn_options = [] + } + + global_preprocessor :: Maybe String + global_preprocessor + | let pp = pgm_F dflags + , not (null pp) + = Just pp + | otherwise + = Nothing + + -- Emit a dependency for each CPP import + -- CPP deps are discovered in the module parsing phase by parsing + -- comment lines left by the preprocessor. + -- Note that GHC.parseModule may throw an exception if the module + -- fails to parse, which may not be desirable (see #16616). + find_cpp_deps :: IO [Dep] + find_cpp_deps = + if depIncludeCppDeps dflags + then do + session <- Session <$> newIORef hsc_env + parsedMod <- reflectGhc (GHC.parseModule node) session + pure (DepCpp . unsafeEncodeUtf <$> GHC.pm_extra_src_files parsedMod) + else + pure [] + + -- Emit a dependency for each import + find_import_deps :: [UnresolvedImport PkgQual] -> IO [Either (MsgEnvelope GhcMessage) Dep] + find_import_deps idecls = + sequence + [ findDependency hsc_env decl + | decl <- idecls + , let L _loc mod = ui_mod_name decl + , not $ mod `UniqSet.elementOfUniqSet` excl_mods + ] + +findDependency :: HscEnv + -> UnresolvedImport PkgQual -- The import to find + -> IO (Either (MsgEnvelope GhcMessage) Dep) -- Interface file +findDependency hsc_env imp = do + -- Find the module; this will be fast because + -- we've done it once during downsweep. + r <- resolveImport hsc_env imp + case r of + Found loc dep_mod -> + pure $ Right + DepHi + { dep_mod = dep_mod + , dep_path = ml_hi_file_ospath loc + , dep_unit = lookupUnitId (hsc_units hsc_env) (moduleUnitId dep_mod) + , dep_local = isJust (ml_hs_file loc) + , dep_boot = is_boot + , dep_level = ui_level imp + } + + fail -> + return $ + Left $ + mkPlainErrorMsgEnvelope srcloc $ + GhcDriverMessage $ DriverInterfaceError $ + (Can'tFindInterface (cannotFindModule hsc_env mod_name fail) (LookingForModule mod_name is_boot)) + where + L srcloc mod_name = ui_mod_name imp + is_boot = ui_boot imp + ----------------------------------------------------------------- -- -- beginMkDependHs @@ -136,6 +373,18 @@ doMkDependModuleGraph dflags module_graph = do -- ----------------------------------------------------------------- +initFileDepWriter :: Logger -> OsPath -> TmpFs -> DynFlags -> IO DependencyWriter +initFileDepWriter logger root tmpfs dflags = do + files <- beginMkDependHS logger tmpfs dflags + pure DependencyWriter + { dw_beginWriter = do + pure $ DepSink $ \ node deps -> do + writeDependencies (depIncludePkgDeps dflags) root (mkd_tmp_hdl files) suffixes node deps + , dw_endWriter = endMkDependHS logger files + } + where + suffixes = map unsafeEncodeUtf (depSuffixes dflags) + data MkDepFiles = MkDep { mkd_make_file :: FilePath, -- Name of the makefile mkd_make_hdl :: Maybe Handle, -- Handle for the open makefile @@ -151,7 +400,7 @@ beginMkDependHS logger tmpfs dflags = do -- open the makefile let makefile = depMakefile dflags - exists <- doesFileExist makefile + exists <- Directory.doesFileExist makefile mb_make_hdl <- if not exists then return Nothing @@ -188,141 +437,53 @@ beginMkDependHS logger tmpfs dflags = do return (MkDep { mkd_make_file = makefile, mkd_make_hdl = mb_make_hdl, mkd_tmp_file = tmp_file, mkd_tmp_hdl = tmp_hdl}) +writeDependencies :: + Bool -> + OsPath -> + Handle -> + [OsString] -> + -- ^ Suffixes + DepNode -> + [Dep] -> + IO () +writeDependencies include_pkgs root hdl suffixes node deps = + traverse_ write tasks + where + tasks = source_dep : boot_dep ++ concatMap import_dep deps + + -- Emit std dependency of the object(s) on the source file + -- Something like A.o : A.hs + source_dep = (obj_files, dn_src) + + -- add dependency between objects and their corresponding .hi-boot + -- files if the module has a corresponding .hs-boot file (#14482) + boot_dep = case gwib_isBoot dn_mod of + IsBoot -> [([obj], hi) | (obj, hi) <- zip (suffixed (removeBootSuffix dn_obj)) (suffixed dn_hi)] + NotBoot -> [] + + -- Add one dependency for each suffix; + -- e.g. A.o : B.hi + -- A.x_o : B.x_hi + import_dep = \case + DepHi {dep_path, dep_unit} + | isNothing dep_unit || include_pkgs + -> [([obj], hi) | (obj, hi) <- zip obj_files (suffixed dep_path)] ------------------------------------------------------------------ --- --- processDeps --- ------------------------------------------------------------------ - -processDeps :: DynFlags - -> HscEnv - -> [ModuleName] - -> FilePath - -> Handle -- Write dependencies to here - -> SCC ModuleGraphNode - -> IO () --- Write suitable dependencies to handle --- Always: --- this.o : this.hs --- --- If the dependency is on something other than a .hi file: --- this.o this.p_o ... : dep --- otherwise --- this.o ... : dep.hi --- this.p_o ... : dep.p_hi --- ... --- (where .o is $osuf, and the other suffixes come from --- the cmdline -s options). --- --- For {-# SOURCE #-} imports the "hi" will be "hi-boot". - -processDeps _ hsc_env _ _ _ (CyclicSCC nodes) - = -- There shouldn't be any cycles; report them - throwOneError (initSourceErrorContext (hsc_dflags hsc_env)) $ cyclicModuleErr nodes - -processDeps _ hsc_env _ _ _ (AcyclicSCC (InstantiationNode _uid node)) - = -- There shouldn't be any backpack instantiations; report them as well - throwOneError (initSourceErrorContext (hsc_dflags hsc_env)) $ - mkPlainErrorMsgEnvelope noSrcSpan $ - GhcDriverMessage $ DriverInstantiationNodeInDependencyGeneration node - -processDeps _dflags _ _ _ _ (AcyclicSCC (LinkNode {})) = return () -processDeps _dflags _ _ _ _ (AcyclicSCC (UnitNode {})) = return () -processDeps _ _ _ _ _ (AcyclicSCC (ModuleNode _ (ModuleNodeFixed {}))) - -- No dependencies needed for fixed modules (already compiled) - = return () -processDeps dflags hsc_env excl_mods root hdl (AcyclicSCC (ModuleNode _ (ModuleNodeCompile node))) - = do { let extra_suffixes = depSuffixes dflags - include_pkg_deps = depIncludePkgDeps dflags - src_file = msHsFilePath node - obj_file = msObjFilePath node - obj_files = insertSuffixes obj_file extra_suffixes - - - - -- Emit std dependency of the object(s) on the source file - -- Something like A.o : A.hs - ; writeDependency root hdl obj_files src_file - - -- add dependency between objects and their corresponding .hi-boot - -- files if the module has a corresponding .hs-boot file (#14482) - ; when (isBootSummary node == IsBoot) $ do - let hi_boot = msHiFilePath node - let obj = unsafeDecodeUtf $ removeBootSuffix (msObjFileOsPath node) - forM_ extra_suffixes $ \suff -> do - let way_obj = insertSuffixes obj [suff] - let way_hi_boot = insertSuffixes hi_boot [suff] - mapM_ (writeDependency root hdl way_obj) way_hi_boot - - -- Emit a dependency for each CPP import - ; when (depIncludeCppDeps dflags) $ do - -- CPP deps are discovered in the module parsing phase by parsing - -- comment lines left by the preprocessor. - -- Note that GHC.parseModule may throw an exception if the module - -- fails to parse, which may not be desirable (see #16616). - { session <- Session <$> newIORef hsc_env - ; parsedMod <- reflectGhc (GHC.parseModule node) session - ; mapM_ (writeDependency root hdl obj_files) - (GHC.pm_extra_src_files parsedMod) - } - - -- Emit a dependency for each import - - ; let find_deps imps = sequence - [ findDependency hsc_env imp include_pkg_deps - | imp <- imps - , unLoc (ui_mod_name imp) `notElem` excl_mods - ] - - do_imp hi_file = do - let hi_files = insertSuffixes hi_file extra_suffixes - write_dep (obj,hi) = writeDependency root hdl [obj] hi + | otherwise + -> [] - -- Add one dependency for each suffix; - -- e.g. A.o : B.hi - -- A.x_o : B.x_hi - mapM_ write_dep (obj_files `zip` hi_files) + DepCpp {dep_path} -> [(obj_files, dep_path)] - ; (missing_dep_errs, deps) <- partitionEithers <$> find_deps (ms_imps node) + write (from, to) = writeDependency root hdl from to - ; if null missing_dep_errs - then mapM_ (mapM_ do_imp) deps - else do - let sec = initSourceErrorContext (hsc_dflags hsc_env) - throwErrors sec (mkMessages (listToBag missing_dep_errs)) - } + obj_files = suffixed dn_obj -findDependency :: HscEnv - -> UnresolvedImport PkgQual -- The import to find - -> Bool -- Record dependency on package modules - -> IO (Either (MsgEnvelope GhcMessage) (Maybe FilePath)) -- Interface file -findDependency hsc_env imp include_pkg_deps = do - -- Find the module; this will be fast because - -- we've done it once during downsweep. - r <- resolveImport hsc_env imp - case r of - Found loc _ - -- Home package: just depend on the .hi or hi-boot file - | isJust (ml_hs_file loc) || include_pkg_deps - -> return (Right (Just (ml_hi_file loc))) + suffixed f = insertSuffixes f suffixes - -- Not in this package: we don't need a dependency - | otherwise - -> return (Right Nothing) - - fail -> - return $ - Left $ - mkPlainErrorMsgEnvelope srcloc $ - GhcDriverMessage $ DriverInterfaceError $ - (Can'tFindInterface (cannotFindModule hsc_env mod_name fail) (LookingForModule mod_name is_boot)) - where - L srcloc mod_name = ui_mod_name imp - is_boot = ui_boot imp + DepNode {dn_src, dn_obj, dn_hi, dn_mod} = node ----------------------------- -writeDependency :: FilePath -> Handle -> [FilePath] -> FilePath -> IO () +writeDependency :: OsPath -> Handle -> [OsPath] -> OsPath -> IO () -- (writeDependency r h [t1,t2] dep) writes to handle h the dependency -- t1 t2 : dep writeDependency root hdl targets dep @@ -330,33 +491,30 @@ writeDependency root hdl targets dep -- c:/foo/... -- on Windows as make gets confused by the : -- Making relative deps avoids some instances of this. - dep' = makeRelative root dep - forOutput = escapeSpaces . reslash Forwards . normalise + dep' = OsPath.makeRelative root dep + forOutput = escapeSpaces . reslash Forwards . unsafeDecodeUtf . OsPath.normalise output = unwords (map forOutput targets) ++ " : " ++ forOutput dep' hPutStrLn hdl output ----------------------------- insertSuffixes - :: FilePath -- Original filename; e.g. "foo.o" - -> [String] -- Suffix prefixes e.g. ["x_", "y_"] - -> [FilePath] -- Zapped filenames e.g. ["foo.x_o", "foo.y_o"] + :: OsPath -- Original filename; e.g. "foo.o" + -> [OsString] -- Suffix prefixes e.g. ["x_", "y_"] + -> [OsPath] -- Zapped filenames e.g. ["foo.x_o", "foo.y_o"] -- Note that the extra bit gets inserted *before* the old suffix -- We assume the old suffix contains no dots, so we know where to -- split it insertSuffixes file_name extras - = [ basename <.> (extra ++ suffix) | extra <- extras ] + = [ basename <.> (extra Monoid.<> suffix) | extra <- extras ] where - (basename, suffix) = case splitExtension file_name of + (basename, suffix) = case OsPath.splitExtension file_name of -- Drop the "." from the extension - (b, s) -> (b, drop 1 s) + (b, s) -> (b, OsString.drop 1 s) ----------------------------------------------------------------- --- --- endMkDependHs --- Complete the makefile, close the tmp file etc --- ------------------------------------------------------------------ +-- endMkDependHs +-- Complete the makefile, close the tmp file etc endMkDependHS :: Logger -> MkDepFiles -> IO () @@ -385,6 +543,277 @@ endMkDependHS logger showPass logger "Installing new makefile" SysTools.copyFile tmp_file makefile +----------------------------------------------------------------- +-- +-- JSON MkDepends output +-- +----------------------------------------------------------------- + +initJsonDepWriter :: FilePath -> DynFlags -> IO DependencyWriter +initJsonDepWriter output dflags = do + json_var <- mkJsonOutput output initDepJson + pure DependencyWriter + { dw_beginWriter = + pure $ DepSink $ \ node deps -> + updateJson json_var (updateDepJson (depIncludePkgDeps dflags) node deps) + , dw_endWriter = + writeJsonOutput json_var + } + +-------------------------------------------------------------------------------- +-- Output interface for json dumps + +-- | Resources for a json dump option, used in "GHC.Driver.MakeFile". +-- The flag @-dep-json@ add an additional output target for dependency +-- diagnostics. +data JsonOutput a = + JsonOutput { + -- | This ref is updated in @processDeps@ incrementally, using a + -- flag-specific type. + json_ref :: IORef a, + + -- | The output file path specified as argument to the flag. + json_path :: FilePath + } + +-- | TODO: @fendor +mkJsonOutput :: + FilePath -> + IO (IORef a) -> + IO (JsonOutput a) +mkJsonOutput json_path mk_ref = do + json_ref <- mk_ref + pure JsonOutput {json_ref, json_path} + +-- | Update the dump data in 'json_ref' if the output target is present. +updateJson :: JsonOutput a -> (a -> a) -> IO () +updateJson JsonOutput {json_ref} f = modifyIORef' json_ref f + +-- | Write a json object to the flag-dependent file if the output target is +-- present. +writeJsonOutput :: + ToJson a => + JsonOutput a -> + IO () +writeJsonOutput JsonOutput {json_ref, json_path} = do + payload <- readIORef json_ref + writeJsonFile payload json_path + +-------------------------------------------------------------------------------- +-- Output helpers + +writeJsonFile :: ToJson a => a -> FilePath -> IO () +writeJsonFile doc p = do + withAtomicRename p + $ \tmp -> writeFile tmp $ showSDocUnsafe $ renderJSON $ json doc + +-------------------------------------------------------------------------------- +-- Payload for -dep-json + +newtype DPackageId = DPackageId PackageId + deriving newtype (Eq) + +instance Ord DPackageId where + DPackageId (PackageId d1) `compare` DPackageId (PackageId d2) = d1 `lexicalCompareFS` d2 + +data ModuleNodeDeps = ModuleNodeDeps + { source :: OsPath + , imports :: ImportDeps + , cpp :: Set.Set OsPath + , options :: [String] + , preprocessor :: Maybe FilePath + } + deriving stock (Generic) + deriving (Semigroup, Monoid) via (Generically ModuleNodeDeps) + +addImport :: ImportDep -> ModuleNodeDeps -> ModuleNodeDeps +addImport import_dep mod_node_deps = + mod_node_deps + { imports = ImportDeps $ Map.insertWith Set.union uid (Set.singleton import_dep) (getImports $ imports mod_node_deps) + } + where + uid = toUnitId $ moduleUnit $ imp_mod import_dep + +addCpp :: OsPath -> ModuleNodeDeps -> ModuleNodeDeps +addCpp p mod_node_deps = + mod_node_deps + { cpp = Set.insert p (cpp mod_node_deps) + } + +newtype ImportDeps = ImportDeps { getImports :: Map.Map UnitId (Set.Set ImportDep) } + deriving stock (Generic) + deriving (Semigroup, Monoid) via (Generically ImportDeps) + +data ImportDep = ImportDep + { imp_mod :: Module + , imp_level :: ImportLevel + , imp_isBoot :: IsBootInterface + } deriving (Eq, Ord) + +mkImportDep :: Module -> ImportLevel -> IsBootInterface -> ImportDep +mkImportDep modl level isBoot = ImportDep + { imp_mod = modl + , imp_level = level + , imp_isBoot = isBoot + } + +data HomeUnitDeps = HomeUnitDeps + { homeModules :: Map.Map ModuleWithIsBoot ModuleNodeDeps + } + deriving stock (Generic) + deriving (Semigroup, Monoid) via (Generically HomeUnitDeps) + +data ExtUnitDep = ExtUnitDep + { extUnitId :: UnitId + -- ^ The 'UnitId' of a unit. This is assumed to be globally unique. + , extUnitName :: String + , extUnitPackageId :: DPackageId + } deriving (Eq, Ord) + +data DepJson = DepJson + { homeUnitDeps :: Map.Map UnitId HomeUnitDeps + , externalDeps :: Set.Set ExtUnitDep + } + +instance ToJson DepJson where + json (DepJson homeUnits extDeps) = + JSObject $ + [ homeUnit huid hud + | (huid, hud) <- Map.toList homeUnits + ] ++ + [ mkExtDepObj dep + | dep <- Set.toList extDeps + ] + where + homeUnit uid hud = + ( unitIdString uid + , JSObject + [ + ( "modules" + , JSObject + [ (homeUnitModuleKey modl, homeUnitModule deps) + | (modl, deps) <- Map.toList $ homeModules hud + ] + ) + ] + ) + + homeUnitModuleKey :: ModuleWithIsBoot -> String + homeUnitModuleKey t = moduleKey (gwib_mod t) (gwib_isBoot t) + + moduleKey :: Module -> IsBootInterface -> String + moduleKey t b = moduleNameString (moduleName t) ++ case b of + IsBoot -> "[boot]" + NotBoot -> "" + + homeUnitModule :: ModuleNodeDeps -> JsonDoc + homeUnitModule ModuleNodeDeps {source, imports, cpp, options, preprocessor} = + JSObject + [ ("source", JSString . showOsPath $ normalise source) + , ("imports", importsObj imports) + , ("includes", strArray cpp showOsPath) + , ("options", JSArray $ map JSString options) + , ("preprocessor", maybe JSNull JSString preprocessor) + ] + + importsObj :: ImportDeps -> JsonDoc + importsObj importDeps = JSArray $ map importObj (Map.toList $ getImports importDeps) + + importObj :: (UnitId, Set.Set ImportDep) -> JsonDoc + importObj (uid, importSet) = + JSObject + [ (unitIdString uid, array importSet importDepObj ) + ] + + importDepObj :: ImportDep -> JsonDoc + importDepObj ImportDep {imp_mod, imp_level, imp_isBoot} + | NormalLevel <- imp_level = JSString (moduleKey imp_mod imp_isBoot) + | otherwise = JSObject + [ ("module", JSString (moduleKey imp_mod imp_isBoot)) + , ("level" , importLevel imp_level) + ] + + importLevel :: ImportLevel -> JsonDoc + importLevel lvl = + JSString $ case lvl of + NormalLevel -> "normal" + SpliceLevel -> "splice" + QuoteLevel -> "quote" + + mkExtDepObj :: ExtUnitDep -> (String, JsonDoc) + mkExtDepObj ExtUnitDep{..} = + ( unitIdString extUnitId + , JSObject + [ ("package-name", JSString extUnitName) + , ("package-id", JSString $ showPackageId extUnitPackageId) + ] + ) + + array values render = JSArray (fmap render (Set.toList values)) + strArray values render = JSArray (fmap (JSString . render) (Set.toList values)) + + showOsPath = unsafeDecodeUtf + showPackageId (DPackageId (PackageId pid)) = unpackFS pid + +initDepJson :: IO (IORef DepJson) +initDepJson = newIORef $ DepJson Map.empty Set.empty + +insertDepJson :: ModuleWithIsBoot -> ModuleNodeDeps -> Set.Set ExtUnitDep -> DepJson -> DepJson +insertDepJson target modNode extUnits (DepJson m0 e0) = + DepJson + { homeUnitDeps = + Map.insertWith + (Semigroup.<>) + modUnitId + (HomeUnitDeps $ Map.singleton target modNode) + m0 + , externalDeps = + Set.union e0 extUnits + } + where + modUnitId = toUnitId $ moduleUnit $ gwib_mod target + +updateDepJson :: Bool -> DepNode -> [Dep] -> DepJson -> DepJson +updateDepJson include_pkgs DepNode {..} deps = + insertDepJson dn_mod payload externalDeps + where + (externalDeps, payload) = foldl' go (Set.empty, initial_node_data) deps + + initial_node_data = + ModuleNodeDeps + { source = dn_src + , preprocessor = pn_preprocessor dn_preprocessing + , options = pn_options dn_preprocessing + , cpp = Set.empty + , imports = ImportDeps Map.empty + } + + go (extDeps, node_data) = \ case + DepHi {dep_mod, dep_local, dep_unit, dep_boot, dep_level} + | dep_local + -> (extDeps, addImport (mkImportDep dep_mod dep_level dep_boot) node_data) + + | include_pkgs + , Just unit <- dep_unit + , let PackageName nameFS = unitPackageName unit + name = unpackFS nameFS + withLibName (PackageName c) = name ++ ":" ++ unpackFS c + lname = maybe name withLibName (unitComponentName unit) + newExtDep = ExtUnitDep + { extUnitId = unitId unit + , extUnitName = lname + , extUnitPackageId = DPackageId $ unitPackageId unit + } + -> + ( Set.insert newExtDep extDeps + , addImport (mkImportDep dep_mod dep_level dep_boot) node_data + ) + + | otherwise + -> (extDeps, node_data) + + DepCpp {dep_path} -> + (extDeps, addCpp dep_path node_data) ----------------------------------------------------------------- -- Module cycles ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -820,13 +820,13 @@ preprocessPipeline pipe_env hsc_env input_fn = do use (T_Unlit pipe_env hsc_env input_fn) - (dflags1, p_warns1, warns1) <- use (T_FileArgs hsc_env unlit_fn) + (dflags1, _, p_warns1, warns1) <- use (fileArgsPhase hsc_env unlit_fn) let hsc_env1 = hscSetFlags dflags1 hsc_env (cpp_fn, hsc_env2) <- runAfterFlag hsc_env1 (Cpp HsSrcFile) (xopt LangExt.Cpp) (unlit_fn, hsc_env1) $ do cpp_fn <- use (T_Cpp pipe_env hsc_env1 unlit_fn) - (dflags2, _, _) <- use (T_FileArgs hsc_env1 cpp_fn) + (dflags2, _, _, _) <- use (fileArgsPhase hsc_env1 cpp_fn) let hsc_env2 = hscSetFlags dflags2 hsc_env1 return (cpp_fn, hsc_env2) @@ -841,7 +841,8 @@ preprocessPipeline pipe_env hsc_env input_fn = do then return (dflags1, p_warns1, warns1) else do -- Reparse with original hsc_env so that we don't get duplicated options - use (T_FileArgs hsc_env pp_fn) + (dflagsPP, _, p_warns3, warns3) <- use (fileArgsPhase hsc_env pp_fn) + pure (dflagsPP, p_warns3, warns3) let print_config = initPrintConfig dflags3 liftIO (printOrThrowDiagnostics (hsc_logger hsc_env) print_config (initDiagOpts dflags3) (GhcPsMessage <$> p_warns3)) @@ -865,6 +866,9 @@ preprocessPipeline pipe_env hsc_env input_fn = do runAfter phase def $ phaseIfFlag hsc_env flag def action + fileArgsPhase env fn = + T_FileArgs (hsc_logger env) (hsc_dflags env) fn + -- | The complete compilation pipeline, from start to finish fullPipeline :: P m => PipeEnv -> HscEnv -> FilePath -> HscSource -> m (ModIface, RecompLinkables) fullPipeline pipe_env hsc_env pp_fn src_flavour = do ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -104,7 +104,7 @@ runPhase :: TPhase out -> IO out runPhase (T_Unlit pipe_env hsc_env inp_path) = do out_path <- phaseOutputFilenameNew (Cpp HsSrcFile) pipe_env hsc_env Nothing runUnlitPhase hsc_env inp_path out_path -runPhase (T_FileArgs hsc_env inp_path) = getFileArgs hsc_env inp_path +runPhase (T_FileArgs logger dflags inp_path) = getFileArgsNoHsc logger dflags inp_path runPhase (T_Cpp pipe_env hsc_env inp_path) = do out_path <- phaseOutputFilenameNew (HsPp HsSrcFile) pipe_env hsc_env Nothing runCppPhase hsc_env inp_path out_path @@ -620,17 +620,21 @@ runUnlitPhase hsc_env input_fn output_fn = do return output_fn -getFileArgs :: HscEnv -> FilePath -> IO ((DynFlags, Messages PsMessage, Messages DriverMessage)) +getFileArgs :: HscEnv -> FilePath -> IO ((DynFlags, [String], Messages PsMessage, Messages DriverMessage)) getFileArgs hsc_env input_fn = do let dflags0 = hsc_dflags hsc_env logger = hsc_logger hsc_env - parser_opts = initParserOpts dflags0 + getFileArgsNoHsc logger dflags0 input_fn + +getFileArgsNoHsc :: Logger -> DynFlags -> FilePath -> IO ((DynFlags, [String], Messages PsMessage, Messages DriverMessage)) +getFileArgsNoHsc logger dflags0 input_fn = do + let parser_opts = initParserOpts dflags0 sec = initSourceErrorContext dflags0 (warns0, src_opts) <- getOptionsFromFile parser_opts sec (supportedLanguagePragmas dflags0) input_fn (dflags1, unhandled_flags, warns) <- parseDynamicFilePragma logger dflags0 src_opts checkProcessArgsResult dflags0 unhandled_flags - return (dflags1, warns0, warns) + return (dflags1, map unLoc src_opts, warns0, warns) runCppPhase :: HscEnv -> FilePath -> FilePath -> IO FilePath runCppPhase hsc_env input_fn output_fn = do ===================================== compiler/GHC/Driver/Pipeline/Phases.hs ===================================== @@ -13,6 +13,7 @@ import GHC.Driver.Errors.Types import GHC.Fingerprint.Type import GHC.Unit.Module.Location ( ModLocation ) import GHC.Unit.Module.ModIface +import GHC.Utils.Logger import GHC.Driver.Phases import Language.Haskell.Syntax.Module.Name ( ModuleName ) @@ -25,7 +26,7 @@ import GHC.Unit.Home.ModInfo -- phase if the inputs have been modified. data TPhase res where T_Unlit :: PipeEnv -> HscEnv -> FilePath -> TPhase FilePath - T_FileArgs :: HscEnv -> FilePath -> TPhase (DynFlags, Messages PsMessage, Messages DriverMessage) + T_FileArgs :: Logger -> DynFlags -> FilePath -> TPhase ((DynFlags, [String], Messages PsMessage, Messages DriverMessage)) T_Cpp :: PipeEnv -> HscEnv -> FilePath -> TPhase FilePath T_HsPp :: PipeEnv -> HscEnv -> FilePath -> FilePath -> TPhase FilePath T_HscRecomp :: PipeEnv -> HscEnv -> FilePath -> HscSource -> TPhase (HscEnv, ModSummary, HscRecompStatus) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -791,6 +791,12 @@ addOptCmmP f = alterToolSettings $ \s -> s setDepMakefile :: FilePath -> DynFlags -> DynFlags setDepMakefile f d = d { depMakefile = f } +setDepJson :: FilePath -> DynFlags -> DynFlags +setDepJson f d = d { depJson = Just f } + +unsetDepJson :: DynFlags -> DynFlags +unsetDepJson d = d { depJson = Nothing } + setDepIncludeCppDeps :: Bool -> DynFlags -> DynFlags setDepIncludeCppDeps b d = d { depIncludeCppDeps = b } @@ -1261,6 +1267,8 @@ dynamic_flags_deps = [ -------- ghc -M ----------------------------------------------------- , make_ord_flag defGhcFlag "dep-suffix" (hasArg addDepSuffix) , make_ord_flag defGhcFlag "dep-makefile" (hasArg setDepMakefile) + , make_ord_flag defGhcFlag "dep-json" (hasArg setDepJson) + , make_ord_flag defGhcFlag "no-dep-json" (noArg unsetDepJson) , make_ord_flag defGhcFlag "include-cpp-deps" (noArg (setDepIncludeCppDeps True)) , make_ord_flag defGhcFlag "include-pkg-deps" ===================================== docs/users_guide/separate_compilation.rst ===================================== @@ -1503,6 +1503,23 @@ generation are: ``.depend`` and then ``include`` the file ``.depend`` into ``Makefile``. +.. ghc-flag:: -dep-json ⟨file⟩ + :shortdesc: Also emit ⟨file⟩ as a JSON file containing dependencies + :type: dynamic + :reverse: -no-dep-json + :category: redirect-output + + In addition to the makefile, also emit ⟨file⟩ as a JSON file + containing the same dependencies info, so it can be parsed by + external build systems. The JSON file contains a single object, + mapping each target to a list of dependencies. + In addition to the makefile, each module's payload will contain the + values of ``OPTIONS`` and ``LANGUAGE`` pragmas of the source + file, so it can be parsed by external build systems. Each ``LANGUAGE`` + pragma is represented as an option as well, e.g. + ``{-# LANGUAGE TemplateHaskell #-}`` is represented as + ``"-XTemplateHaskell"``. + .. ghc-flag:: -dep-suffix ⟨suffix⟩ :shortdesc: Make dependencies that declare that files with suffix ``.⟨suf⟩⟨osuf⟩`` depend on interface files with suffix ``.⟨suf⟩hi`` ===================================== testsuite/driver/testlib.py ===================================== @@ -20,6 +20,7 @@ from pathlib import Path, PurePath import collections import collections.abc import subprocess +import json from testglobals import config, ghc_env, default_testopts, brokens, t, \ TestRun, TestResult, TestOptions, PerfMetric @@ -3265,6 +3266,34 @@ def normalise_asm( s: str ) -> str: out.append(ins[0]) return '\n'.join(out) +def normalise_dep_json(s: str) -> str: + """ + Normalise the json output of `ghc -M -dep-json output.json` + """ + + def normalise_includes(j): + # Only normalise proper json objects. + # Strings might be parsed as json strings, but we that's not what we are looking for + if not isinstance(j, dict): + return j + for unit in j.values(): + for module in unit.get("modules", {}).values(): + rewritten = [ + "<absolute-path>/" + p.rsplit("/", 1)[-1] if p.startswith("/") else p + for p in module["includes"] + ] + # we sort to make sure this never + module["includes"] = sorted(rewritten) + return j + + output = "" + try: + normalised_dep_json = normalise_includes(json.loads(s)) + output = json.dumps(normalised_dep_json, indent=2, sort_keys=True, ensure_ascii=False) + except json.JSONDecodeError: + output = line + return output + def safe_print(s: str) -> None: s2 = s.encode(sys.stdout.encoding, errors='replace').decode(sys.stdout.encoding) print(s2) ===================================== testsuite/tests/driver/T24384/A.hs ===================================== @@ -0,0 +1,7 @@ +{-# language Strict #-} +{-# language CPP #-} +{-# options_ghc -fexpose-all-unfoldings #-} +module A where + +#include "foo.h" +import {-# source #-} C ===================================== testsuite/tests/driver/T24384/C.hs ===================================== @@ -0,0 +1,6 @@ +module C where + +import A +import Data.Set + +data C = C ===================================== testsuite/tests/driver/T24384/C.hs-boot ===================================== @@ -0,0 +1,5 @@ +module C where + +import E + +data C ===================================== testsuite/tests/driver/T24384/D.hs ===================================== @@ -0,0 +1,4 @@ +module D where + +import B +import C ===================================== testsuite/tests/driver/T24384/E.hs ===================================== @@ -0,0 +1,14 @@ +module E where + +import Language.Haskell.TH.Syntax +import Dep +import DepPublic + +e :: Q Exp +e = lift (5 :: Integer) + +edep :: () +edep = dep + +edepPub :: () +edepPub = depPub ===================================== testsuite/tests/driver/T24384/Makefile ===================================== @@ -0,0 +1,56 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + + +PKGCONF_LOCAL=./db.package.conf +GHC_PKG_LOCAL='$(GHC_PKG)' --no-user-package-db -f $(PKGCONF_LOCAL) + +T24384_prep: + rm -r $(PKGCONF_LOCAL) || true + $(GHC_PKG_LOCAL) init $(PKGCONF_LOCAL) 2>&1 >/dev/null + + cd dep-internal && \ + '$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \ + -v0 -fno-code -fwrite-interface -hidir outdir -this-unit-id dep-internal-1-XXX \ + -package base \ + -i. DepInternal + $(GHC_PKG_LOCAL) register --force dep-internal/dep-internal.pkg 2>&1 >/dev/null + + cd dep-public && \ + '$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \ + -v0 -fno-code -fwrite-interface -hidir outdir -this-unit-id dep-public-1-XXX \ + -package base \ + -i. DepPublic + $(GHC_PKG_LOCAL) register --force dep-public/dep-public.pkg 2>&1 >/dev/null + + cd dep && \ + '$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \ + -v0 -fno-code -fwrite-interface -hidir outdir -this-unit-id dep-1-XXX \ + -package-db ../$(PKGCONF_LOCAL) -package-id dep-internal-1-XXX \ + -i. Dep + $(GHC_PKG_LOCAL) register --force dep/dep.pkg 2>&1 >/dev/null + +T24384a: T24384_prep + '$(TEST_HC)' -M -dep-makefile T24384a.Makefile -include-pkg-deps -include-cpp-deps \ + -hide-all-packages -package base -package containers -package template-haskell \ + -package-db ./$(PKGCONF_LOCAL) -package-id dep-1-XXX -package-id dep-public-1-XXX \ + A.hs lib/B.hs C.hs D.hs E.hs + + cat T24384a.Makefile + +T24384b: T24384_prep + '$(TEST_HC)' -M -dep-json dep.json -include-pkg-deps -include-cpp-deps \ + -hide-all-packages -package base -package containers -package template-haskell \ + -package-db ./$(PKGCONF_LOCAL) -package-id dep-1-XXX -package-id dep-public-1-XXX \ + A.hs lib/B.hs C.hs D.hs E.hs + + cat dep.json + +T24384c: T24384_prep + '$(TEST_HC)' -M -dep-json dep.json \ + -hide-all-packages -package base -package containers -package template-haskell \ + -package-db ./$(PKGCONF_LOCAL) -package-id dep-1-XXX -package-id dep-public-1-XXX \ + A.hs lib/B.hs C.hs D.hs E.hs + + cat dep.json ===================================== testsuite/tests/driver/T24384/T24384a.stdout ===================================== @@ -0,0 +1,39 @@ +# DO NOT DELETE: Beginning of Haskell dependencies +E.o : E.hs +E.o : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/base-4.23.0.0-inplace/Prelude.hi +E.o : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/base-4.23.0.0-inplace/GHC/Essentials.hi +E.o : dep-public/outdir/DepPublic.hi +E.o : dep/outdir/Dep.hi +E.o : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/template-haskell-2.25.0.0-inplace/Language/Haskell/TH/Syntax.hi +C.o-boot : C.hs-boot +C.o : C.hi-boot +C.o-boot : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/base-4.23.0.0-inplace/Prelude.hi +C.o-boot : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/base-4.23.0.0-inplace/GHC/Essentials.hi +C.o-boot : E.hi +A.o : A.hs +A.o : foo.h +A.o : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/rts-1.0.3/include/ghcversion.h +A.o : /usr/include/stdc-predef.h +A.o : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/base-4.23.0.0-inplace/Prelude.hi +A.o : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/base-4.23.0.0-inplace/GHC/Essentials.hi +A.o : C.hi-boot +C.o : C.hs +C.o : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/base-4.23.0.0-inplace/Prelude.hi +C.o : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/base-4.23.0.0-inplace/GHC/Essentials.hi +C.o : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/containers-0.8-inplace/Data/Set.hi +C.o : A.hi +lib/B.o-boot : lib/B.hs-boot +lib/B.o : lib/B.hi-boot +lib/B.o-boot : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/base-4.23.0.0-inplace/Prelude.hi +lib/B.o-boot : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/base-4.23.0.0-inplace/GHC/Essentials.hi +lib/B.o-boot : A.hi +lib/B.o : lib/B.hs +lib/B.o : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/base-4.23.0.0-inplace/Prelude.hi +lib/B.o : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/base-4.23.0.0-inplace/GHC/Essentials.hi +lib/B.o : A.hi +D.o : D.hs +D.o : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/base-4.23.0.0-inplace/Prelude.hi +D.o : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../lib/x86_64-linux-ghc-10.1.20260917-inplace/base-4.23.0.0-inplace/GHC/Essentials.hi +D.o : C.hi +D.o : lib/B.hi +# DO NOT DELETE: End of Haskell dependencies ===================================== testsuite/tests/driver/T24384/T24384b.stdout ===================================== @@ -0,0 +1,191 @@ +{ + "base-<VERSION>-<HASH>": { + "package-id": "base-<VERSION>-<HASH>", + "package-name": "base" + }, + "containers-<VERSION>-<HASH>": { + "package-id": "containers-<VERSION>-<HASH>", + "package-name": "containers" + }, + "dep-1-XXX": { + "package-id": "dep-1", + "package-name": "dep" + }, + "dep-public-1-XXX": { + "package-id": "dep-public-1", + "package-name": "dep-public" + }, + "main": { + "modules": { + "A": { + "imports": [ + { + "base-<VERSION>-<HASH>": [ + "GHC.Essentials", + "Prelude" + ] + }, + { + "main": [ + "C[boot]" + ] + } + ], + "includes": [ + "<absolute-path>/ghcversion.h", + "<absolute-path>/stdc-predef.h", + "foo.h" + ], + "options": [ + "-XStrict", + "-XCPP", + "-fexpose-all-unfoldings" + ], + "preprocessor": null, + "source": "A.hs" + }, + "B": { + "imports": [ + { + "base-<VERSION>-<HASH>": [ + "GHC.Essentials", + "Prelude" + ] + }, + { + "main": [ + "A" + ] + } + ], + "includes": [], + "options": [ + "-F", + "-pgmF", + "./preproc.sh" + ], + "preprocessor": "./preproc.sh", + "source": "lib/B.hs" + }, + "B[boot]": { + "imports": [ + { + "base-<VERSION>-<HASH>": [ + "GHC.Essentials", + "Prelude" + ] + }, + { + "main": [ + "A" + ] + } + ], + "includes": [], + "options": [ + "-F", + "-pgmF", + "./preproc.sh" + ], + "preprocessor": "./preproc.sh", + "source": "lib/B.hs-boot" + }, + "C": { + "imports": [ + { + "base-<VERSION>-<HASH>": [ + "GHC.Essentials", + "Prelude" + ] + }, + { + "containers-<VERSION>-<HASH>": [ + "Data.Set" + ] + }, + { + "main": [ + "A" + ] + } + ], + "includes": [], + "options": [], + "preprocessor": null, + "source": "C.hs" + }, + "C[boot]": { + "imports": [ + { + "base-<VERSION>-<HASH>": [ + "GHC.Essentials", + "Prelude" + ] + }, + { + "main": [ + "E" + ] + } + ], + "includes": [], + "options": [], + "preprocessor": null, + "source": "C.hs-boot" + }, + "D": { + "imports": [ + { + "base-<VERSION>-<HASH>": [ + "GHC.Essentials", + "Prelude" + ] + }, + { + "main": [ + "B", + "C" + ] + } + ], + "includes": [], + "options": [], + "preprocessor": null, + "source": "D.hs" + }, + "E": { + "imports": [ + { + "base-<VERSION>-<HASH>": [ + "GHC.Essentials", + "Prelude" + ] + }, + { + "dep-1-XXX": [ + "Dep" + ] + }, + { + "dep-public-1-XXX": [ + "DepPublic" + ] + }, + { + "template-haskell-<VERSION>-<HASH>": [ + "Language.Haskell.TH.Syntax" + ] + } + ], + "includes": [], + "options": [], + "preprocessor": null, + "source": "E.hs" + } + } + }, + "template-haskell-<VERSION>-<HASH>": { + "package-id": "template-haskell-<VERSION>-<HASH>", + "package-name": "template-haskell" + } +} ===================================== testsuite/tests/driver/T24384/T24384b.stdout-mingw ===================================== @@ -0,0 +1,191 @@ +{ + "base-<VERSION>-<HASH>": { + "package-id": "base-<VERSION>-<HASH>", + "package-name": "base" + }, + "containers-<VERSION>-<HASH>": { + "package-id": "containers-<VERSION>-<HASH>", + "package-name": "containers" + }, + "dep-1-XXX": { + "package-id": "dep-1", + "package-name": "dep" + }, + "dep-public-1-XXX": { + "package-id": "dep-public-1", + "package-name": "dep-public" + }, + "main": { + "modules": { + "A": { + "imports": [ + { + "base-<VERSION>-<HASH>": [ + "GHC.Essentials", + "Prelude" + ] + }, + { + "main": [ + "C[boot]" + ] + } + ], + "includes": [ + "<absolute-path>/ghcversion.h", + "<absolute-path>/stdc-predef.h", + "foo.h" + ], + "options": [ + "-XStrict", + "-XCPP", + "-fexpose-all-unfoldings" + ], + "preprocessor": null, + "source": "A.hs" + }, + "B": { + "imports": [ + { + "base-<VERSION>-<HASH>": [ + "GHC.Essentials", + "Prelude" + ] + }, + { + "main": [ + "A" + ] + } + ], + "includes": [], + "options": [ + "-F", + "-pgmF", + "./preproc.sh" + ], + "preprocessor": "./preproc.sh", + "source": "lib/B.hs" + }, + "B[boot]": { + "imports": [ + { + "base-<VERSION>-<HASH>": [ + "GHC.Essentials", + "Prelude" + ] + }, + { + "main": [ + "A" + ] + } + ], + "includes": [], + "options": [ + "-F", + "-pgmF", + "./preproc.sh" + ], + "preprocessor": "./preproc.sh", + "source": "lib/B.hs-boot" + }, + "C": { + "imports": [ + { + "base-<VERSION>-<HASH>": [ + "GHC.Essentials", + "Prelude" + ] + }, + { + "containers-<VERSION>-<HASH>": [ + "Data.Set" + ] + }, + { + "main": [ + "A" + ] + } + ], + "includes": [], + "options": [], + "preprocessor": null, + "source": "C.hs" + }, + "C[boot]": { + "imports": [ + { + "base-<VERSION>-<HASH>": [ + "GHC.Essentials", + "Prelude" + ] + }, + { + "main": [ + "E" + ] + } + ], + "includes": [], + "options": [], + "preprocessor": null, + "source": "C.hs-boot" + }, + "D": { + "imports": [ + { + "base-<VERSION>-<HASH>": [ + "GHC.Essentials", + "Prelude" + ] + }, + { + "main": [ + "B", + "C" + ] + } + ], + "includes": [], + "options": [], + "preprocessor": null, + "source": "D.hs" + }, + "E": { + "imports": [ + { + "base-<VERSION>-<HASH>": [ + "GHC.Essentials", + "Prelude" + ] + }, + { + "dep-1-XXX": [ + "Dep" + ] + }, + { + "dep-public-1-XXX": [ + "DepPublic" + ] + }, + { + "template-haskell-<VERSION>-<HASH>": [ + "Language.Haskell.TH.Syntax" + ] + } + ], + "includes": [], + "options": [], + "preprocessor": null, + "source": "E.hs" + } + } + }, + "template-haskell-<VERSION>-<HASH>": { + "package-id": "template-haskell-<VERSION>-<HASH>", + "package-name": "template-haskell" + } +} ===================================== testsuite/tests/driver/T24384/T24384c.stdout ===================================== @@ -0,0 +1,104 @@ +{ + "main": { + "modules": { + "A": { + "imports": [ + { + "main": [ + "C[boot]" + ] + } + ], + "includes": [], + "options": [ + "-XStrict", + "-XCPP", + "-fexpose-all-unfoldings" + ], + "preprocessor": null, + "source": "A.hs" + }, + "B": { + "imports": [ + { + "main": [ + "A" + ] + } + ], + "includes": [], + "options": [ + "-F", + "-pgmF", + "./preproc.sh" + ], + "preprocessor": "./preproc.sh", + "source": "lib/B.hs" + }, + "B[boot]": { + "imports": [ + { + "main": [ + "A" + ] + } + ], + "includes": [], + "options": [ + "-F", + "-pgmF", + "./preproc.sh" + ], + "preprocessor": "./preproc.sh", + "source": "lib/B.hs-boot" + }, + "C": { + "imports": [ + { + "main": [ + "A" + ] + } + ], + "includes": [], + "options": [], + "preprocessor": null, + "source": "C.hs" + }, + "C[boot]": { + "imports": [ + { + "main": [ + "E" + ] + } + ], + "includes": [], + "options": [], + "preprocessor": null, + "source": "C.hs-boot" + }, + "D": { + "imports": [ + { + "main": [ + "B", + "C" + ] + } + ], + "includes": [], + "options": [], + "preprocessor": null, + "source": "D.hs" + }, + "E": { + "imports": [], + "includes": [], + "options": [], + "preprocessor": null, + "source": "E.hs" + } + } + } +} ===================================== testsuite/tests/driver/T24384/all.T ===================================== @@ -0,0 +1,15 @@ +test_extras = extra_files( + ['A.hs', 'lib/', 'C.hs', 'C.hs-boot', 'D.hs', 'E.hs', + 'foo.h', + 'dep', 'dep-internal', 'dep-public', + 'preproc.sh' + ]) + +normalisers = [ normalise_version('base', 'containers', 'template-haskell') + , normalise_slashes + , normalise_fun(normalise_dep_json) + ] + +test('T24384a', [ test_extras, pre_cmd('$MAKE -s --no-print-directory T24384_prep'), *normalisers ], makefile_test, []) +test('T24384b', [ test_extras, pre_cmd('$MAKE -s --no-print-directory T24384_prep'), *normalisers ], makefile_test, []) +test('T24384c', [ test_extras, pre_cmd('$MAKE -s --no-print-directory T24384_prep'), *normalisers ], makefile_test, []) ===================================== testsuite/tests/driver/T24384/dep-internal/DepInternal.hs ===================================== @@ -0,0 +1,3 @@ +module DepInternal where +depInt :: () +depInt = () ===================================== testsuite/tests/driver/T24384/dep-internal/dep-internal.pkg ===================================== @@ -0,0 +1,11 @@ +name: dep-internal +version: 1 +id: dep-internal-1-XXX +key: dep-internal-1-XXX +visibility: public +abi: inplace +exposed-modules: DepInternal +depends: +import-dirs: ${pkgroot}/dep-internal/outdir +library-dirs: ${pkgroot}/dep-internal/outdir +include-dirs: ===================================== testsuite/tests/driver/T24384/dep-public/DepPublic.hs ===================================== @@ -0,0 +1,3 @@ +module DepPublic where +depPub :: () +depPub = () ===================================== testsuite/tests/driver/T24384/dep-public/dep-public.pkg ===================================== @@ -0,0 +1,11 @@ +name: dep-public +version: 1 +id: dep-public-1-XXX +key: dep-public-1-XXX +visibility: public +abi: inplace +exposed-modules: DepPublic +depends: +import-dirs: ${pkgroot}/dep-public/outdir +library-dirs: ${pkgroot}/dep-public/outdir +include-dirs: ===================================== testsuite/tests/driver/T24384/dep/Dep.hs ===================================== @@ -0,0 +1,4 @@ +module Dep where +import DepInternal +dep :: () +dep = depInt ===================================== testsuite/tests/driver/T24384/dep/dep.pkg ===================================== @@ -0,0 +1,11 @@ +name: dep +version: 1 +id: dep-1-XXX +key: dep-1-XXX +visibility: public +abi: inplace +exposed-modules: Dep +depends: dep-internal-1-XXX +import-dirs: ${pkgroot}/dep/outdir +library-dirs: ${pkgroot}/dep/outdir +include-dirs: ===================================== testsuite/tests/driver/T24384/foo.h ===================================== ===================================== testsuite/tests/driver/T24384/format_json.sh ===================================== @@ -0,0 +1,35 @@ +#!/usr/bin/env bash +set -euo pipefail + +# Packages whose ids are rewritten to <pkg>-<VERSION>-<HASH> +pkgs='base|containers|template-haskell' + +usage() { + cat <<EOF +Usage: $(basename "$0") FILE + +Format one of the test -dep-json output file with jq and normalise it: + - absolute paths in "includes" become <absolute-path>/<filename>, + and the "includes" lists are sorted + - ids of the packages ${packages[*]} + (e.g. base-4.23.0.0-inplace) become <pkg>-<VERSION>-<HASH> + +Writes the output to FILE +EOF +} + +case "${1:-}" in -h|--help) usage; exit 0 ;; esac +[ $# -eq 1 ] || { usage >&2; exit 1; } + +# Escape regex metacharacters (and the / delimiter) for sed +esc() { sed 's/[][\.*^$+?(){}|/]/\\&/g'; } + +json=$(jq --sort-keys ' + (.. | objects | select(has("includes")) | .includes) |= + (map(if startswith("/") then "<absolute-path>/" + (split("/") | last) else . end) | sort) +' "$1") + +tmp=$(mktemp "$1.XXXXXX") +trap 'rm -f "$tmp"' EXIT +sed -E "s/($pkgs)-[0-9.]+(-[0-9a-zA-Z+]+)?(-[0-9a-zA-Z]+)?/\\1-<VERSION>-<HASH>/g" <<<"$json" > "$tmp" +mv "$tmp" "$1" ===================================== testsuite/tests/driver/T24384/lib/B.hs ===================================== @@ -0,0 +1,2 @@ +{-# options_ghc -F -pgmF ./preproc.sh #-} +module B where ===================================== testsuite/tests/driver/T24384/lib/B.hs-boot ===================================== @@ -0,0 +1,2 @@ +{-# options_ghc -F -pgmF ./preproc.sh #-} +module B where ===================================== testsuite/tests/driver/T24384/preproc.sh ===================================== @@ -0,0 +1,4 @@ +#!/usr/bin/env bash + +sed '/preproc/d' $2 > $3 +echo 'import A' >> $3 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/020bc06ba6ec9a573ad33376bccb3e5... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/020bc06ba6ec9a573ad33376bccb3e5... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help