[Git][ghc/ghc][wip/fendor/dep-json] 3 commits: Add json output format
Hannes Siebenhandl pushed to branch wip/fendor/dep-json at Glasgow Haskell Compiler / GHC Commits: e0d006a4 by fendor at 2026-09-22T16:21:48+02:00 Add json output format - - - - - c9b90413 by fendor at 2026-09-22T16:21:48+02:00 fixup! Refactor Makefile to use phases appropriately - - - - - 2808bf67 by fendor at 2026-09-22T16:21:48+02:00 Add -dep-json test with multiple deps - - - - - 19 changed files: - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/MakeFile.hs - compiler/GHC/Driver/Session.hs - + 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/T24384.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/lib/B.hs - + 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,9 +18,10 @@ where import GHC.Prelude - import qualified GHC +import GHC.Data.Bag (listToBag) +import GHC.Data.FastString import GHC.Data.Graph.Directed (SCC (..)) import GHC.Data.OsPath (unsafeDecodeUtf, unsafeEncodeUtf) @@ -35,12 +38,12 @@ import GHC.Driver.Session import GHC.Iface.Errors.Types import GHC.Iface.Load (cannotFindModule) -import qualified GHC.SysTools as SysTools +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 qualified GHC.Types.Unique.Set as UniqSet +import GHC.Types.Unique.Set qualified as UniqSet import GHC.Types.UnresolvedImport import GHC.Unit.Finder @@ -52,23 +55,27 @@ import GHC.Unit.State (lookupUnitId) 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 System.Directory -import System.FilePath -import System.IO -import System.IO.Error (isEOFError) 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 System.IO +import System.IO.Error (isEOFError) ----------------------------------------------------------------- -- @@ -117,7 +124,15 @@ doMkDependModuleGraph dflags module_graph = do excl_mods = depExcludeMods dflags root <- liftIO getCurrentDirectory - let dep_writer = initFileDepWriter logger root tmpfs dflags + let + dep_writers = + concat + [ [ SomeDependencyWriter $ initFileDepWriter logger root tmpfs dflags + ] + , [ SomeDependencyWriter $ initJsonDepWriter json_output dflags + | Just json_output <- [depJson dflags] + ] + ] let sorted = GHC.topSortModuleGraph False module_graph Nothing @@ -125,12 +140,25 @@ doMkDependModuleGraph dflags module_graph = do liftIO $ debugTraceMsg logger 2 (text "Module dependencies" $$ ppr sorted) liftIO $ bracket - (dw_beginWriter dep_writer) + (do + traverse + (\ (SomeDependencyWriter dep_writer) -> do + backend <- dw_beginWriter dep_writer + pure (SomeDependencyWriter2 (dep_writer, backend)) + ) + dep_writers + ) -- Tidy up - (dw_endWriter dep_writer) - ( \ files -> do + (\ writers -> do + traverse + ( \(SomeDependencyWriter2 (writer, backend)) -> + dw_endWriter writer backend + ) + writers + ) + ( \ backends -> do -- Process them one by one, dumping results and complaining about cycles - mapM_ (processDeps dflags hsc_env (UniqSet.mkUniqSet excl_mods) [(dep_writer, files)]) sorted + mapM_ (processDeps dflags hsc_env (UniqSet.mkUniqSet excl_mods) backends) sorted -- If -ddump-mod-cycles, show cycles in the module graph liftIO $ dumpModCycles logger module_graph @@ -147,28 +175,41 @@ doMkDependModuleGraph dflags module_graph = do -- Types abstracting over the output -------------------------------------------------------------------------------- -data DepNode - = DepNode { - dn_mod :: Module, - dn_src :: FilePath, - dn_obj :: FilePath, - dn_hi :: FilePath, - dn_boot :: IsBootInterface, - dn_options :: [String] +data DepNode = + DepNode + { dn_mod :: Module + , dn_src :: FilePath + , dn_obj :: FilePath + , dn_hi :: FilePath + , dn_boot :: IsBootInterface + , dn_preprocessor :: PreprocessorInfo + } + +data PreprocessorInfo = + PreprocessorInfo + { pi_options :: [String] -- ^ module level @OPTIONS_GHC@ pragma contents + , pi_processor :: Maybe FilePath } data Dep - = DepHi { - dep_mod :: Module, - dep_path :: FilePath, - dep_unit :: Maybe UnitInfo, - dep_local :: Bool, - dep_boot :: IsBootInterface + = DepHi + { dep_mod_name :: ModuleName + , dep_path :: FilePath + , dep_unit :: Maybe UnitInfo + , dep_local :: Bool + , dep_boot :: IsBootInterface + } + | DepCpp + { dep_path :: FilePath } - | DepCpp { - dep_path :: FilePath - } + + +data SomeDependencyWriter = + forall backend . SomeDependencyWriter (DependencyWriter backend) + +data SomeDependencyWriter2 = + forall backend . SomeDependencyWriter2 ((DependencyWriter backend, backend)) data DependencyWriter backend = DependencyWriter { dw_beginWriter :: IO backend @@ -185,7 +226,7 @@ data DependencyWriter backend = DependencyWriter processDeps :: DynFlags -> HscEnv -> UniqSet ModuleName -- ^ Excludes - -> [(DependencyWriter backend, backend)] + -> [SomeDependencyWriter2] -> SCC ModuleGraphNode -> IO () -- Write suitable dependencies to handle @@ -221,27 +262,40 @@ processDeps _ _ _ _ (AcyclicSCC (ModuleNode _ (ModuleNodeFixed {}))) processDeps dflags hsc_env excl_mods backends (AcyclicSCC (ModuleNode _ (ModuleNodeCompile node))) = do pp <- preprocessor - let dep_node = mkDepNode (maybe [] snd pp) - deps <- fmap concat $ sequence $ - [cpp_deps | depIncludeCppDeps dflags] ++ [ - import_deps IsBoot (ms_srcimps node), - import_deps NotBoot (ms_imps node) - ] + let dep_node = mkDepNode pp + + let + find_deps = do + cpp_deps <- find_cpp_deps + imp_deps <- find_import_deps (ms_imps node) + pure $ map Right cpp_deps ++ imp_deps + + (missing_dep_errs, deps) <- partitionEithers <$> find_deps + + if null missing_dep_errs + then do + traverse_ + (\ (SomeDependencyWriter2 (writer, backend)) -> + dw_writeDependency writer backend dep_node deps + ) + backends + else do + let sec = initSourceErrorContext (hsc_dflags hsc_env) + throwErrors sec (mkMessages (listToBag missing_dep_errs)) - traverse_ (\ (writer, backend) -> dw_writeDependency writer backend dep_node deps) backends where src_file = msHsFilePath node - mkDepNode opts = + mkDepNode preproc = DepNode { dn_mod = ms_mod node, dn_src = src_file, dn_obj = msObjFilePath node, dn_hi = msHiFilePath node, dn_boot = isBootSummary node, - dn_options = opts + dn_preprocessor = preproc } - preprocessor :: IO (Maybe (String, [String])) + preprocessor :: IO PreprocessorInfo preprocessor | Just src <- ml_hs_file (ms_location node) = runPipeline (hsc_hooks hsc_env) $ do @@ -252,15 +306,23 @@ processDeps dflags hsc_env excl_mods backends (AcyclicSCC (ModuleNode _ (ModuleN 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) (hsc_dflags hsc_env) unlit_fn) let pp = pgm_F dflags1 - pure (if null pp then global_preprocessor else Just (pp, opts)) + pure + PreprocessorInfo + { pi_processor = if null pp then global_preprocessor else Just pp + , pi_options = opts + } | otherwise - = pure global_preprocessor + = pure + PreprocessorInfo + { pi_processor = global_preprocessor + , pi_options = [] + } - global_preprocessor :: Maybe (String, [String]) + global_preprocessor :: Maybe String global_preprocessor | let pp = pgm_F dflags , not (null pp) - = Just (pp, []) + = Just pp | otherwise = Nothing @@ -269,53 +331,49 @@ processDeps dflags hsc_env excl_mods backends (AcyclicSCC (ModuleNode _ (ModuleN -- 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). - cpp_deps :: IO [Dep] - cpp_deps = do + find_cpp_deps :: IO [Dep] + find_cpp_deps = do session <- Session <$> newIORef hsc_env parsedMod <- reflectGhc (GHC.parseModule node) session pure (DepCpp <$> GHC.pm_extra_src_files parsedMod) -- Emit a dependency for each import - import_deps :: IsBootInterface -> [UnresolvedImport PkgQual] -> IO [Dep] - import_deps is_boot idecls = - sequence [ - findDependency hsc_env loc mb_pkg mod is_boot + find_import_deps :: [UnresolvedImport PkgQual] -> IO [Either (MsgEnvelope GhcMessage) Dep] + find_import_deps idecls = + sequence + [ findDependency hsc_env decl | decl <- idecls - , let mb_pkg = ui_pkg_qual decl - , let L loc mod = ui_mod_name decl - , mod `UniqSet.elementOfUniqSet` excl_mods + , let L _loc mod = ui_mod_name decl + , not (mod `UniqSet.elementOfUniqSet` excl_mods) ] findDependency :: HscEnv - -> SrcSpan - -> PkgQual -- package qualifier, if any - -> ModuleName -- Imported module - -> IsBootInterface -- Source import - -> IO Dep -findDependency hsc_env srcloc pkg imp dep_boot = do + -> 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 - findImportedModule hsc_env LookupUser imp pkg >>= \case + resolveImport hsc_env imp >>= \case Found loc dep_mod -> - pure DepHi { - dep_mod, - dep_path = ml_hi_file loc, - dep_unit = lookupUnitId (hsc_units hsc_env) (moduleUnitId dep_mod), - dep_local, - dep_boot - } - where - dep_local = isJust (ml_hs_file loc) + pure $ Right + DepHi + { dep_mod_name = mod_name + , dep_path = ml_hi_file loc + , dep_unit = lookupUnitId (hsc_units hsc_env) (moduleUnitId dep_mod) + , dep_local = isJust (ml_hs_file loc) + , dep_boot = is_boot + } fail -> - throwOneError - (initSourceErrorContext (hsc_dflags hsc_env)) $ - mkPlainErrorMsgEnvelope srcloc $ - GhcDriverMessage $ - DriverInterfaceError $ - Can'tFindInterface (cannotFindModule hsc_env imp fail) $ - LookingForModule imp dep_boot + 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 ----------------------------------------------------------------- @@ -467,11 +525,8 @@ insertSuffixes file_name extras ----------------------------------------------------------------- --- --- endMkDependHs --- Complete the makefile, close the tmp file etc --- ------------------------------------------------------------------ +-- endMkDependHs +-- Complete the makefile, close the tmp file etc endMkDependHS :: Logger -> MkDepFiles -> IO () @@ -500,6 +555,183 @@ endMkDependHS logger showPass logger "Installing new makefile" SysTools.copyFile tmp_file makefile +----------------------------------------------------------------- +-- +-- JSON MkDepends output +-- +----------------------------------------------------------------- + +initJsonDepWriter :: FilePath -> DynFlags -> DependencyWriter (JsonOutput DepJson) +initJsonDepWriter output dflags = DependencyWriter + { dw_beginWriter = do + mkJsonOutput output initDepJson + , dw_writeDependency = \ backend node deps -> do + updateJson backend (updateDepJson (depIncludePkgDeps dflags) node deps) + , dw_endWriter = + writeJsonOutput + } + +-------------------------------------------------------------------------------- +-- 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 PackageDeps = + PackageDeps (Map.Map (String, UnitId, DPackageId) (Set.Set ModuleName)) + 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 FilePath, + modules :: (Set.Set ModuleName, Set.Set ModuleName), + packages :: PackageDeps, + cpp :: Set.Set FilePath, + options :: [String], + preprocessor :: Maybe FilePath + } + deriving stock (Generic) + deriving (Semigroup, Monoid) via (Generically Deps) + +newtype DepJson = DepJson (Map.Map ModuleName Deps) + +instance ToJson DepJson where + json (DepJson m) = + JSObject [ + (moduleNameString target, JSObject [ + ("sources", array sources normalise), + ("modules", array (fst modules) moduleNameString), + ("modules-boot", array (snd modules) moduleNameString), + ("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 id), + ("options", JSArray $ map JSString options), + ("preprocessor", maybe JSNull JSString preprocessor) + ]) + | (target, Deps {packages = PackageDeps packages, ..}) <- Map.toList m + ] + where + package name unit_id (PackageId package_id) mods = + JSObject [ + ("id", JSString (unitIdString unit_id)), + ("name", JSString name), + ("package-id", JSString (unpackFS package_id)), + ("modules", array mods moduleNameString) + ] + + array values render = JSArray (fmap (JSString . render) (Set.toList values)) + +initDepJson :: IO (IORef DepJson) +initDepJson = newIORef $ DepJson Map.empty + +insertDepJson :: [ModuleName] -> Deps -> DepJson -> DepJson +insertDepJson targets dep (DepJson m0) = + DepJson + $ foldl' + ( \acc target -> + Map.insertWith + (Semigroup.<>) + target + dep + acc + ) + m0 + targets + +updateDepJson :: Bool -> DepNode -> [Dep] -> DepJson -> DepJson +updateDepJson include_pkgs DepNode {..} deps = + insertDepJson [moduleName dn_mod] payload + where + payload = node_data Semigroup.<> foldMap dep deps + + node_data = + mempty { + sources = Set.singleton dn_src, + preprocessor = pi_processor dn_preprocessor, + options = pi_options dn_preprocessor + } + + dep = \case + DepHi {dep_mod_name, dep_local, dep_unit, dep_boot} + | dep_local + , let set = Set.singleton dep_mod_name + value | IsBoot <- dep_boot = (Set.empty, set) + | otherwise = (set, Set.empty) + -> mempty {modules = value} + + | 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) + key = (lname, unitId unit, DPackageId $ unitPackageId unit) + -> mempty {packages = PackageDeps (Map.singleton key (Set.singleton dep_mod_name))} + + | otherwise + -> mempty + + DepCpp {dep_path} -> + mempty {cpp = Set.singleton dep_path} + ----------------------------------------------------------------- -- Module cycles ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -760,6 +760,9 @@ 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 } + setDepIncludeCppDeps :: Bool -> DynFlags -> DynFlags setDepIncludeCppDeps b d = d { depIncludeCppDeps = b } @@ -1245,6 +1248,7 @@ 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 "include-cpp-deps" (noArg (setDepIncludeCppDeps True)) , make_ord_flag defGhcFlag "include-pkg-deps" ===================================== testsuite/tests/driver/T24384/A.hs ===================================== @@ -0,0 +1,5 @@ +{-# language Strict #-} +{-# options_ghc -fexpose-all-unfoldings #-} +module A where + +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,38 @@ +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: + $(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 + + '$(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 | jq --sort-keys ===================================== testsuite/tests/driver/T24384/T24384.stdout ===================================== @@ -0,0 +1,157 @@ +{ + "A": { + "cpp": [], + "modules": [], + "modules-boot": [ + "C" + ], + "options": [ + "-XStrict", + "-fexpose-all-unfoldings" + ], + "packages": [ + { + "id": "base-4.23.0.0-inplace", + "modules": [ + "GHC.Essentials", + "Prelude" + ], + "name": "base", + "package-id": "base-4.23.0.0" + } + ], + "preprocessor": null, + "sources": [ + "A.hs" + ] + }, + "B": { + "cpp": [], + "modules": [ + "A" + ], + "modules-boot": [], + "options": [ + "-F", + "-pgmF", + "./preproc.sh" + ], + "packages": [ + { + "id": "base-4.23.0.0-inplace", + "modules": [ + "GHC.Essentials", + "Prelude" + ], + "name": "base", + "package-id": "base-4.23.0.0" + } + ], + "preprocessor": "./preproc.sh", + "sources": [ + "lib/B.hs" + ] + }, + "C": { + "cpp": [], + "modules": [ + "A", + "E" + ], + "modules-boot": [], + "options": [], + "packages": [ + { + "id": "base-4.23.0.0-inplace", + "modules": [ + "GHC.Essentials", + "Prelude" + ], + "name": "base", + "package-id": "base-4.23.0.0" + }, + { + "id": "containers-0.8-inplace", + "modules": [ + "Data.Set" + ], + "name": "containers", + "package-id": "containers-0.8" + } + ], + "preprocessor": null, + "sources": [ + "C.hs", + "C.hs-boot" + ] + }, + "D": { + "cpp": [], + "modules": [ + "B", + "C" + ], + "modules-boot": [], + "options": [], + "packages": [ + { + "id": "base-4.23.0.0-inplace", + "modules": [ + "GHC.Essentials", + "Prelude" + ], + "name": "base", + "package-id": "base-4.23.0.0" + } + ], + "preprocessor": null, + "sources": [ + "D.hs" + ] + }, + "E": { + "cpp": [], + "modules": [], + "modules-boot": [], + "options": [], + "packages": [ + { + "id": "base-4.23.0.0-inplace", + "modules": [ + "GHC.Essentials", + "Prelude" + ], + "name": "base", + "package-id": "base-4.23.0.0" + }, + { + "id": "dep-1-XXX", + "modules": [ + "Dep" + ], + "name": "dep", + "package-id": "dep-1" + }, + { + "id": "dep-public-1-XXX", + "modules": [ + "DepPublic" + ], + "name": "dep-public", + "package-id": "dep-public-1" + }, + { + "id": "template-haskell-2.25.0.0-inplace", + "modules": [ + "Language.Haskell.TH.Syntax" + ], + "name": "template-haskell", + "package-id": "template-haskell-2.25.0.0" + } + ], + "preprocessor": null, + "sources": [ + "E.hs" + ] + } +} ===================================== testsuite/tests/driver/T24384/all.T ===================================== @@ -0,0 +1,7 @@ +test('T24384', + [ extra_files(['A.hs', 'lib/', 'C.hs', 'C.hs-boot', 'D.hs', 'E.hs', + 'dep', 'dep-internal', 'dep-public', + 'preproc.sh' + ]) + ], + 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/lib/B.hs ===================================== @@ -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/ff9c357394147d81fd6ec9c4d70cf4b... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ff9c357394147d81fd6ec9c4d70cf4b... 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
participants (1)
-
Hannes Siebenhandl (@fendor)