Hannes Siebenhandl pushed to branch wip/fendor/dep-json at Glasgow Haskell Compiler / GHC Commits: ec0db48d by fendor at 2026-10-01T18:01:31+02:00 New json output schema that works with multiple home units Update testsuite - - - - - f694e986 by fendor at 2026-10-01T18:01:50+02:00 Add support for multiple home units - - - - - 10 changed files: - compiler/GHC/Driver/MakeFile.hs - ghc/Main.hs - testsuite/driver/testlib.py - 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/format_json.sh Changes: ===================================== compiler/GHC/Driver/MakeFile.hs ===================================== @@ -11,7 +11,8 @@ {-# LANGUAGE RecordWildCards #-} module GHC.Driver.MakeFile - ( doMkDependHS + ( doMkDepend + , doMkDependHS , doMkDependModuleGraph ) where @@ -80,6 +81,8 @@ import System.IO.Error (isEOFError) import qualified System.OsString as OsString import qualified Data.Monoid as Monoid import qualified System.FilePath as FilePath +import GHC.Unit.Home.Graph (HomeUnitEnv(homeUnitEnv_dflags)) +import GHC (setProgramHUG) ----------------------------------------------------------------- -- @@ -117,7 +120,39 @@ doMkDependHS srcs = do module_graph <- GHC.depanal excl_mods True {- Allow dup roots -} doMkDependModuleGraph dflags module_graph +doMkDepend :: GhcMonad m => m () +doMkDepend = do + hug_ <- hsc_HUG <$> getSession + + let hug = + fmap (\ hue -> + let + -- We kludge things a bit for dependency generation. Rather than + -- generating dependencies for each way separately, we generate + -- them once and then duplicate them for each way's osuf/hisuf. + -- We therefore do the initial dependency generation with an empty + -- way and .o/.hi extensions, regardless of any flags that might + -- be specified. + dflags1 = (homeUnitEnv_dflags hue) + { targetWays_ = Set.empty + , hiSuf_ = "hi" + , objectSuf_ = "o" + } + in + hue {homeUnitEnv_dflags = dflags1} + ) hug_ + + _ <- setProgramHUG hug + + dflagsGlobal <- GHC.getSessionDynFlags + -- If no suffix is provided, use the default -- the empty one + let dflags = if null (depSuffixes dflagsGlobal) + then dflagsGlobal { depSuffixes = [""] } + else dflagsGlobal + let excl_mods = depExcludeMods dflags + module_graph <- GHC.depanal excl_mods True {- Allow dup roots -} + doMkDependModuleGraph dflags module_graph doMkDependModuleGraph :: GhcMonad m => DynFlags -> ModuleGraph -> m () doMkDependModuleGraph dflags module_graph = do @@ -610,127 +645,188 @@ writeJsonFile doc p = do -------------------------------------------------------------------------------- -- Payload for -dep-json -newtype PackageDeps - = PackageDeps (Map.Map (String, UnitId, DPackageId) DepsImports) - deriving newtype (Monoid) - newtype DPackageId = DPackageId PackageId deriving newtype (Eq) instance Ord DPackageId where DPackageId (PackageId d1) `compare` DPackageId (PackageId d2) = d1 `lexicalCompareFS` d2 -instance Semigroup PackageDeps where - PackageDeps l <> PackageDeps r = PackageDeps (Map.unionWith (Semigroup.<>) l r) - -data Deps = Deps - { sources :: Set.Set OsPath - , moduleImports :: DepsImports - , sourceImports :: DepsImports - , packages :: PackageDeps +data ModuleNodeDeps = ModuleNodeDeps + { source :: OsPath + , imports :: ImportDeps , cpp :: Set.Set OsPath , options :: [String] , preprocessor :: Maybe FilePath } deriving stock (Generic) - deriving (Semigroup, Monoid) via (Generically Deps) + deriving (Semigroup, Monoid) via (Generically ModuleNodeDeps) -data DepsImports - = DepsImports - { normalImport :: Set.Set Module - , spliceImport :: Set.Set Module - , quoteImport :: Set.Set Module - } +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 DepsImports) + 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 + } -newtype DepJson = DepJson (Map.Map ModuleWithIsBoot Deps) +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 m) = - JSObject - [ (homeUnitModuleKey target, homeUnitModule deps) - | (target, deps) <- Map.toList m + 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 = moduleNameString (moduleName (gwib_mod t)) ++ case gwib_isBoot t of + 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 :: Deps -> JsonDoc - homeUnitModule Deps {packages = PackageDeps packages, ..} = + homeUnitModule :: ModuleNodeDeps -> JsonDoc + homeUnitModule ModuleNodeDeps {source, imports, cpp, options, preprocessor} = JSObject - [ ("sources", array sources (showOsPath . normalise)) - , ("modules", JSObject $ importsObj moduleImports) - , ("modules-boot", JSObject $ importsObj sourceImports) - , ("packages", JSArray - [ package name unit_id package_id mods - | ((name, unit_id, dpkd_id), mods) <- Map.toList packages - , let DPackageId package_id = dpkd_id - ] - ) - , ("cpp", array cpp showOsPath) + [ ("source", JSString . showOsPath $ normalise source) + , ("imports", importsObj imports) + , ("includes", strArray cpp showOsPath) , ("options", JSArray $ map JSString options) , ("preprocessor", maybe JSNull JSString preprocessor) ] - package :: String -> UnitId -> PackageId -> DepsImports -> JsonDoc - package name unit_id (PackageId package_id) mods = + importsObj :: ImportDeps -> JsonDoc + importsObj importDeps = JSArray $ map importObj (Map.toList $ getImports importDeps) + + importObj :: (UnitId, Set.Set ImportDep) -> JsonDoc + importObj (uid, importSet) = JSObject - [ ("id", JSString (unitIdString unit_id)) - , ("name", JSString name) - , ("package-id", JSString (unpackFS package_id)) - , ("modules", JSObject $ importsObj mods) + [ (unitIdString uid, array importSet importDepObj ) ] - array values render = JSArray (fmap (JSString . render) (Set.toList values)) + 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) + ] - showOsPath = unsafeDecodeUtf + 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)) - importsObj :: DepsImports -> [(String, JsonDoc)] - importsObj DepsImports{..} = - [ ("normal", array normalImport (moduleNameString . moduleName)) - , ("quote" , array quoteImport (moduleNameString . moduleName)) - , ("splice", array spliceImport (moduleNameString . moduleName)) - ] + showOsPath = unsafeDecodeUtf + showPackageId (DPackageId (PackageId pid)) = unpackFS pid initDepJson :: IO (IORef DepJson) -initDepJson = newIORef $ DepJson Map.empty +initDepJson = newIORef $ DepJson Map.empty Set.empty -insertDepJson :: [ModuleWithIsBoot] -> Deps -> DepJson -> DepJson -insertDepJson targets dep (DepJson m0) = +insertDepJson :: ModuleWithIsBoot -> ModuleNodeDeps -> Set.Set ExtUnitDep -> DepJson -> DepJson +insertDepJson target modNode extUnits (DepJson m0 e0) = DepJson - $ foldl' - ( \acc target -> - Map.insertWithKey - (\ k _l _r -> pprPanic "insertDepJson" (text "Conflicting entries for: " <+> ppr k)) - target - dep - acc - ) - m0 - targets + { 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 + insertDepJson dn_mod payload externalDeps where - payload = node_data Semigroup.<> foldMap mkDep deps + (externalDeps, payload) = foldl' go (Set.empty, initial_node_data) deps - node_data = - mempty - { sources = Set.singleton dn_src + initial_node_data = + ModuleNodeDeps + { source = dn_src , preprocessor = pn_preprocessor dn_preprocessing , options = pn_options dn_preprocessing + , cpp = Set.empty + , imports = ImportDeps Map.empty } - mkDep = \case + go (extDeps, node_data) = \ case DepHi {dep_mod, dep_local, dep_unit, dep_boot, dep_level} | dep_local - -> case dep_boot of - IsBoot -> mempty {sourceImports = depsImportForImport dep_mod dep_level} - NotBoot -> mempty {moduleImports = depsImportForImport dep_mod dep_level } + -> (extDeps, addImport (mkImportDep dep_mod dep_level dep_boot) node_data) | include_pkgs , Just unit <- dep_unit @@ -738,19 +834,21 @@ updateDepJson include_pkgs DepNode {..} deps = name = unpackFS nameFS withLibName (PackageName c) = name ++ ":" ++ unpackFS c lname = maybe name withLibName (unitComponentName unit) - key = (lname, unitId unit, DPackageId $ unitPackageId unit) - -> mempty {packages = PackageDeps (Map.singleton key (depsImportForImport dep_mod dep_level))} + 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 - -> mempty + -> (extDeps, node_data) DepCpp {dep_path} -> - mempty {cpp = Set.singleton dep_path} - - depsImportForImport mod_name = \ case - NormalLevel -> mempty { normalImport = Set.singleton mod_name } - SpliceLevel -> mempty { spliceImport = Set.singleton mod_name } - QuoteLevel -> mempty { quoteImport = Set.singleton mod_name } + (extDeps, addCpp dep_path node_data) ----------------------------------------------------------------- -- Module cycles ===================================== ghc/Main.hs ===================================== @@ -27,7 +27,7 @@ import GHC.Driver.Phases import GHC.Driver.Session import GHC.Driver.Ppr import GHC.Driver.Pipeline ( oneShot ) -import GHC.Driver.MakeFile ( doMkDependHS ) +import qualified GHC.Driver.MakeFile as MakeFile import GHC.Driver.Backpack ( doBackpack ) import GHC.Driver.Plugins import GHC.Driver.Config.Logger (initLogFlags) @@ -271,7 +271,7 @@ main' postLoadMode units dflags0 args flagWarnings = do f ShowByteCode f -> liftIO $ showByteCode logger hsc_env f DoMake -> doMake units srcs - DoMkDependHS -> doMkDependHS (map fst srcs) + DoMkDependHS -> doMkDepend units srcs StopBefore p -> liftIO (oneShot hsc_env p srcs) DoInteractive -> ghciUI units srcs Nothing DoEval exprs -> ghciUI units srcs $ Just $ reverse exprs @@ -332,6 +332,24 @@ doMake units targets = do ok_flag <- GHC.load LoadAllTargets when (failed ok_flag) (liftIO $ exitWith (ExitFailure 1)) +-- ---------------------------------------------------------------------------- +-- Run -M mode + +doMkDepend :: [String] -> [(String, Maybe Phase)] -> Ghc () +doMkDepend units targets = do + hs_srcs <- case NE.nonEmpty units of + Just ne_units -> do + initMulti ne_units (checkOptions DoMake) + Nothing -> do + s <- initMake targets -- TODO: @fendor: This feels wrong + return $ map (uncurry (,Nothing,)) s + case hs_srcs of + [] -> return () + _ -> do + targets' <- mapM (\(src, uid, phase) -> GHC.guessTarget src uid phase) hs_srcs + GHC.setTargets targets' + MakeFile.doMkDepend + -- --------------------------------------------------------------------------- -- Various banners and verbosity output. ===================================== 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 = s + 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/Makefile ===================================== @@ -45,4 +45,12 @@ T24384b: T24384_prep -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 | jq --sort-keys + 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 ===================================== @@ -22,6 +22,11 @@ C.o : /home/hugin/Documents/haskell/ghc-homes/ghc-dep-json/_build/stage1/lib/../ 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 ===================================== testsuite/tests/driver/T24384/T24384b.stdout ===================================== @@ -1,310 +1,191 @@ { - "A": { - "cpp": [ - "/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", - "/usr/include/stdc-predef.h", - "foo.h" - ], - "modules": { - "normal": [], - "quote": [], - "splice": [] - }, - "modules-boot": { - "normal": [ - "C" - ], - "quote": [], - "splice": [] - }, - "options": [ - "-XStrict", - "-XCPP", - "-fexpose-all-unfoldings" - ], - "packages": [ - { - "id": "base-4.23.0.0-inplace", - "modules": { - "normal": [ - "GHC.Essentials", - "Prelude" - ], - "quote": [], - "splice": [] - }, - "name": "base", - "package-id": "base-4.23.0.0" - } - ], - "preprocessor": null, - "sources": [ - "A.hs" - ] + "base-<VERSION>-<HASH>": { + "package-id": "base-<VERSION>-<HASH>", + "package-name": "base" }, - "B": { - "cpp": [], - "modules": { - "normal": [ - "A" - ], - "quote": [], - "splice": [] - }, - "modules-boot": { - "normal": [], - "quote": [], - "splice": [] - }, - "options": [ - "-F", - "-pgmF", - "./preproc.sh" - ], - "packages": [ - { - "id": "base-4.23.0.0-inplace", - "modules": { - "normal": [ - "GHC.Essentials", - "Prelude" - ], - "quote": [], - "splice": [] - }, - "name": "base", - "package-id": "base-4.23.0.0" - } - ], - "preprocessor": "./preproc.sh", - "sources": [ - "lib/B.hs" - ] + "containers-<VERSION>-<HASH>": { + "package-id": "containers-<VERSION>-<HASH>", + "package-name": "containers" }, - "B[boot]": { - "cpp": [], - "modules": { - "normal": [ - "A" - ], - "quote": [], - "splice": [] - }, - "modules-boot": { - "normal": [], - "quote": [], - "splice": [] - }, - "options": [ - "-F", - "-pgmF", - "./preproc.sh" - ], - "packages": [ - { - "id": "base-4.23.0.0-inplace", - "modules": { - "normal": [ - "GHC.Essentials", - "Prelude" - ], - "quote": [], - "splice": [] - }, - "name": "base", - "package-id": "base-4.23.0.0" - } - ], - "preprocessor": "./preproc.sh", - "sources": [ - "lib/B.hs-boot" - ] + "dep-1-XXX": { + "package-id": "dep-1", + "package-name": "dep" }, - "C": { - "cpp": [], - "modules": { - "normal": [ - "A" - ], - "quote": [], - "splice": [] - }, - "modules-boot": { - "normal": [], - "quote": [], - "splice": [] - }, - "options": [], - "packages": [ - { - "id": "base-4.23.0.0-inplace", - "modules": { - "normal": [ - "GHC.Essentials", - "Prelude" - ], - "quote": [], - "splice": [] - }, - "name": "base", - "package-id": "base-4.23.0.0" - }, - { - "id": "containers-0.8-inplace", - "modules": { - "normal": [ - "Data.Set" - ], - "quote": [], - "splice": [] - }, - "name": "containers", - "package-id": "containers-0.8" - } - ], - "preprocessor": null, - "sources": [ - "C.hs" - ] + "dep-public-1-XXX": { + "package-id": "dep-public-1", + "package-name": "dep-public" }, - "C[boot]": { - "cpp": [], + "main": { "modules": { - "normal": [ - "E" - ], - "quote": [], - "splice": [] - }, - "modules-boot": { - "normal": [], - "quote": [], - "splice": [] - }, - "options": [], - "packages": [ - { - "id": "base-4.23.0.0-inplace", - "modules": { - "normal": [ - "GHC.Essentials", - "Prelude" - ], - "quote": [], - "splice": [] - }, - "name": "base", - "package-id": "base-4.23.0.0" - } - ], - "preprocessor": null, - "sources": [ - "C.hs-boot" - ] - }, - "D": { - "cpp": [], - "modules": { - "normal": [ - "B", - "C" - ], - "quote": [], - "splice": [] - }, - "modules-boot": { - "normal": [], - "quote": [], - "splice": [] - }, - "options": [], - "packages": [ - { - "id": "base-4.23.0.0-inplace", - "modules": { - "normal": [ - "GHC.Essentials", - "Prelude" - ], - "quote": [], - "splice": [] - }, - "name": "base", - "package-id": "base-4.23.0.0" - } - ], - "preprocessor": null, - "sources": [ - "D.hs" - ] - }, - "E": { - "cpp": [], - "modules": { - "normal": [], - "quote": [], - "splice": [] - }, - "modules-boot": { - "normal": [], - "quote": [], - "splice": [] - }, - "options": [], - "packages": [ - { - "id": "base-4.23.0.0-inplace", - "modules": { - "normal": [ - "GHC.Essentials", - "Prelude" - ], - "quote": [], - "splice": [] - }, - "name": "base", - "package-id": "base-4.23.0.0" + "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" }, - { - "id": "dep-1-XXX", - "modules": { - "normal": [ - "Dep" - ], - "quote": [], - "splice": [] - }, - "name": "dep", - "package-id": "dep-1" + "B": { + "imports": [ + { + "base-<VERSION>-<HASH>": [ + "GHC.Essentials", + "Prelude" + ] + }, + { + "main": [ + "A" + ] + } + ], + "includes": [], + "options": [ + "-F", + "-pgmF", + "./preproc.sh" + ], + "preprocessor": "./preproc.sh", + "source": "lib/B.hs" }, - { - "id": "dep-public-1-XXX", - "modules": { - "normal": [ - "DepPublic" - ], - "quote": [], - "splice": [] - }, - "name": "dep-public", - "package-id": "dep-public-1" + "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" }, - { - "id": "template-haskell-2.25.0.0-inplace", - "modules": { - "normal": [ - "Language.Haskell.TH.Syntax" - ], - "quote": [], - "splice": [] - }, - "name": "template-haskell", - "package-id": "template-haskell-2.25.0.0" + "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" } - ], - "preprocessor": null, - "sources": [ - "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 ===================================== @@ -5,7 +5,11 @@ test_extras = extra_files( 'preproc.sh' ]) -normalisers = normalise_version('base', 'containers', 'template-haskell') +normalisers = [ normalise_version('base', 'containers', 'template-haskell') + , normalise_slashes + , normalise_fun(normalise_dep_json) + ] -test('T24384a', [ test_extras, normalisers, pre_cmd('$MAKE -s --no-print-directory T24384_prep') ], makefile_test, []) -test('T24384b', [ test_extras, normalisers, pre_cmd('$MAKE -s --no-print-directory T24384_prep') ], makefile_test, []) +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/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" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0963547e17d9fb681bddf11848ad45d... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0963547e17d9fb681bddf11848ad45d... 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