Torsten Schmits pushed to branch wip/torsten.schmits/mercury-fixed at Glasgow Haskell Compiler / GHC

Commits:

25 changed files:

Changes:

  • compiler/GHC/Driver/Backpack.hs
    ... ... @@ -804,6 +804,7 @@ summariseRequirement pn mod_name = do
    804 804 
             ms_hie_date = hie_timestamp,
    805 805 
             ms_srcimps = [],
    806 806 
             ms_textual_imps = ((,) NoPkgQual . noLoc) <$> extra_sig_imports,
    807 
    +        ms_opts = [],
    807 808 
             ms_parsed_mod = Just (HsParsedModule {
    808 809 
                     hpm_module = L loc (HsModule {
    809 810 
                             hsmodExt = XModulePs {
    ... ... @@ -909,6 +910,7 @@ hsModuleToModSummary home_keys pn hsc_src modname
    909 910 
                                -- extra imports
    910 911 
                                ++ ((,) NoPkgQual . noLoc <$> extra_sig_imports)
    911 912 
                                ++ ((,) NoPkgQual . noLoc <$> implicit_sigs),
    913 
    +            ms_opts = [],
    912 914 
                 -- This is our hack to get the parse tree to the right spot
    913 915 
                 ms_parsed_mod = Just (HsParsedModule {
    914 916 
                         hpm_module = hsmod,

  • compiler/GHC/Driver/Downsweep.hs
    ... ... @@ -27,7 +27,7 @@ import GHC.Tc.Utils.Backpack
    27 27 
     import GHC.Platform.Ways
    28 28
    29 29 
     import GHC.Driver.Config.Finder (initFinderOpts)
    30 
    -import GHC.Driver.Config.Parser (initParserOpts)
    30 
    +import GHC.Driver.Config.Parser (initParserOpts, supportedLanguagePragmas)
    31 31 
     import GHC.Driver.Phases
    32 32 
     import GHC.Driver.Pipeline
    33 33 
     import GHC.Driver.Session
    ... ... @@ -819,6 +819,7 @@ summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf
    819 819 
                 , nms_location = location
    820 820 
                 , nms_mod = mod
    821 821 
                 , nms_preimps = preimps
    822 
    +            , nms_opts = pi_mod_opts
    822 823 
                 }
    823 824
    824 825 
     checkSummaryHash
    ... ... @@ -981,6 +982,7 @@ summariseModule hsc_env' home_unit old_summary_map is_boot (L _ wanted_mod) mb_p
    981 982 
                 , nms_location = location
    982 983 
                 , nms_mod = mod
    983 984 
                 , nms_preimps = preimps
    985 
    +            , nms_opts = pi_mod_opts
    984 986 
                 }
    985 987
    986 988 
     -- | Convenience named arguments for 'makeNewModSummary' only used to make
    ... ... @@ -993,6 +995,7 @@ data MakeNewModSummary
    993 995 
           , nms_location :: ModLocation
    994 996 
           , nms_mod :: Module
    995 997 
           , nms_preimps :: PreprocessedImports
    998 
    +      , nms_opts :: ![String]
    996 999 
           }
    997 1000
    998 1001 
     makeNewModSummary :: HscEnv -> MakeNewModSummary -> IO ModSummary
    ... ... @@ -1020,6 +1023,7 @@ makeNewModSummary hsc_env MakeNewModSummary{..} = do
    1020 1023 
                 ((,) NoPkgQual . noLoc <$> extra_sig_imports) ++
    1021 1024 
                 ((,) NoPkgQual . noLoc <$> implicit_sigs) ++
    1022 1025 
                 pi_theimps
    1026 
    +        , ms_opts = nms_opts
    1023 1027 
             , ms_hs_hash = nms_src_hash
    1024 1028 
             , ms_iface_date = hi_timestamp
    1025 1029 
             , ms_hie_date = hie_timestamp
    ... ... @@ -1036,6 +1040,7 @@ data PreprocessedImports
    1036 1040 
           , pi_hspp_buf :: StringBuffer
    1037 1041 
           , pi_mod_name_loc :: SrcSpan
    1038 1042 
           , pi_mod_name :: ModuleName
    1043 
    +      , pi_mod_opts :: ![String]
    1039 1044 
           }
    1040 1045
    1041 1046 
     -- Preprocess the source file and get its imports
    ... ... @@ -1051,14 +1056,15 @@ getPreprocessedImports hsc_env src_fn mb_phase maybe_buf = do
    1051 1056 
       (pi_local_dflags, pi_hspp_fn)
    1052 1057 
           <- ExceptT $ preprocess hsc_env src_fn (fst <$> maybe_buf) mb_phase
    1053 1058 
       pi_hspp_buf <- liftIO $ hGetStringBuffer pi_hspp_fn
    1054 
    -  (pi_srcimps', pi_theimps', L pi_mod_name_loc pi_mod_name)
    1059 
    +  ((pi_srcimps', pi_theimps', L pi_mod_name_loc pi_mod_name), pi_mod_opts)
    1055 1060 
           <- ExceptT $ do
    1056 1061 
               let imp_prelude = xopt LangExt.ImplicitPrelude pi_local_dflags
    1057 1062 
                   popts = initParserOpts pi_local_dflags
    1058 1063 
               mimps <- getImports popts imp_prelude pi_hspp_buf pi_hspp_fn src_fn
    1059 
    -          return (first (mkMessages . fmap mkDriverPsHeaderMessage . getMessages) mimps)
    1064 
    +          let mopts = map unLoc $ snd $ getOptions popts (supportedLanguagePragmas pi_local_dflags) pi_hspp_buf src_fn
    1065 
    +          pure $ ((, mopts) <$>) $ first (mkMessages . fmap mkDriverPsHeaderMessage . getMessages) mimps
    1060 1066 
       let rn_pkg_qual = renameRawPkgQual (hsc_unit_env hsc_env)
    1061 1067 
       let rn_imps = fmap (\(pk, lmn@(L _ mn)) -> (rn_pkg_qual mn pk, lmn))
    1062 1068 
       let pi_srcimps = rn_imps pi_srcimps'
    1063 1069 
       let pi_theimps = rn_imps pi_theimps'
    1064 
    -  return PreprocessedImports {..}
    \ No newline at end of file
    1070 
    +  return PreprocessedImports {..}

  • compiler/GHC/Driver/DynFlags.hs
    ... ... @@ -338,6 +338,7 @@ data DynFlags = DynFlags {
    338 338 
       depIncludeCppDeps     :: Bool,
    339 339 
       depExcludeMods        :: [ModuleName],
    340 340 
       depSuffixes           :: [String],
    341 
    +  depJSON               :: !(Maybe FilePath),
    341 342
    342 343 
       --  Package flags
    343 344 
       packageDBFlags        :: [PackageDBFlag],
    ... ... @@ -667,6 +668,7 @@ defaultDynFlags mySettings =
    667 668 
             depIncludeCppDeps = False,
    668 669 
             depExcludeMods    = [],
    669 670 
             depSuffixes       = [],
    671 
    +        depJSON           = Nothing,
    670 672 
             -- end of ghc -M values
    671 673 
             ghcVersionFile = Nothing,
    672 674 
             haddockOptions = Nothing,

  • compiler/GHC/Driver/MakeFile.hs
    1 
    -
    1 
    +{-# LANGUAGE LambdaCase #-}
    2 
    +{-# LANGUAGE NamedFieldPuns #-}
    2 3
    3 4 
     -----------------------------------------------------------------------------
    4 5 
     --
    ... ... @@ -17,15 +18,21 @@ where
    17 18 
     import GHC.Prelude
    18 19
    19 20 
     import qualified GHC
    21 
    +import GHC.Data.Maybe
    20 22 
     import GHC.Driver.Make
    21 23 
     import GHC.Driver.Monad
    22 24 
     import GHC.Driver.DynFlags
    25 
    +import GHC.Driver.MakeFile.JSON
    23 26 
     import GHC.Utils.Misc
    24 27 
     import GHC.Driver.Env
    25 28 
     import GHC.Driver.Errors.Types
    29 
    +import GHC.Driver.Pipeline (runPipeline, TPhase (T_Unlit, T_FileArgs), use, mkPipeEnv)
    30 
    +import GHC.Driver.Phases (StopPhase (StopPreprocess), startPhase, Phase (Unlit))
    31 
    +import GHC.Driver.Pipeline.Monad (PipelineOutput (NoOutputFile))
    32 
    +import GHC.Driver.Session (pgm_F)
    26 33 
     import qualified GHC.SysTools as SysTools
    27 34 
     import GHC.Data.Graph.Directed ( SCC(..) )
    28 
    -import GHC.Data.OsPath (unsafeDecodeUtf)
    35 
    +import GHC.Data.OsPath (unsafeDecodeUtf, unsafeEncodeUtf)
    29 36 
     import GHC.Utils.Outputable
    30 37 
     import GHC.Utils.Panic
    31 38 
     import GHC.Types.SourceError
    ... ... @@ -35,11 +42,13 @@ import Data.List (partition)
    35 42 
     import GHC.Utils.TmpFs
    36 43
    37 44 
     import GHC.Iface.Load (cannotFindModule)
    45 
    +import GHC.Iface.Errors.Types
    38 46
    39 47 
     import GHC.Unit.Module
    40 48 
     import GHC.Unit.Module.ModSummary
    41 49 
     import GHC.Unit.Module.Graph
    42 50 
     import GHC.Unit.Finder
    51 
    +import GHC.Unit.State (lookupUnitId)
    43 52
    44 53 
     import GHC.Utils.Exception
    45 54 
     import GHC.Utils.Error
    ... ... @@ -49,11 +58,10 @@ import System.Directory
    49 58 
     import System.FilePath
    50 59 
     import System.IO
    51 60 
     import System.IO.Error  ( isEOFError )
    52 
    -import Control.Monad    ( when, forM_ )
    53 
    -import Data.Maybe       ( isJust )
    61 
    +import Control.Monad    ( when )
    62 
    +import Data.Foldable (traverse_)
    54 63 
     import Data.IORef
    55 64 
     import qualified Data.Set as Set
    56 
    -import GHC.Iface.Errors.Types
    57 65 
     import Data.Either
    58 66
    59 67 
     -----------------------------------------------------------------
    ... ... @@ -110,7 +118,7 @@ doMkDependModuleGraph dflags module_graph = do
    110 118 
         -- and complaining about cycles
    111 119 
         hsc_env <- getSession
    112 120 
         root <- liftIO getCurrentDirectory
    113 
    -    mapM_ (liftIO . processDeps dflags hsc_env excl_mods root (mkd_tmp_hdl files)) sorted
    121 
    +    mapM_ (liftIO . processDeps dflags hsc_env excl_mods root (mkd_tmp_hdl files) (mkd_dep_json files)) sorted
    114 122
    115 123 
         -- If -ddump-mod-cycles, show cycles in the module graph
    116 124 
         liftIO $ dumpModCycles logger module_graph
    ... ... @@ -118,13 +126,6 @@ doMkDependModuleGraph dflags module_graph = do
    118 126 
         -- Tidy up
    119 127 
         liftIO $ endMkDependHS logger files
    120 128
    121 
    -    -- Unconditional exiting is a bad idea.  If an error occurs we'll get an
    122 
    -    --exception; if that is not caught it's fine, but at least we have a
    123 
    -    --chance to find out exactly what went wrong.  Uncomment the following
    124 
    -    --line if you disagree.
    125 
    -
    126 
    -    --`GHC.ghcCatch` \_ -> io $ exitWith (ExitFailure 1)
    127 
    -
    128 129 
     -----------------------------------------------------------------
    129 130 
     --
    130 131 
     --              beginMkDependHs
    ... ... @@ -137,6 +138,8 @@ doMkDependModuleGraph dflags module_graph = do
    137 138 
     data MkDepFiles
    138 139 
       = MkDep { mkd_make_file :: FilePath,          -- Name of the makefile
    139 140 
                 mkd_make_hdl  :: Maybe Handle,      -- Handle for the open makefile
    141 
    +             -- | Output interface for the -dep-json file
    142 
    +            mkd_dep_json  :: !(Maybe (JsonOutput DepJSON)),
    140 143 
                 mkd_tmp_file  :: FilePath,          -- Name of the temporary file
    141 144 
                 mkd_tmp_hdl   :: Handle }           -- Handle of the open temporary file
    142 145
    ... ... @@ -179,14 +182,15 @@ beginMkDependHS logger tmpfs dflags = do
    179 182
    180 183 
                return (Just makefile_hdl)
    181 184
    185 
    +  dep_json_ref <- mkJsonOutput initDepJSON (depJSON dflags)
    182 186
    183 187 
             -- write the magic marker into the tmp file
    184 188 
       hPutStrLn tmp_hdl depStartMarker
    185 189
    186 190 
       return (MkDep { mkd_make_file = makefile, mkd_make_hdl = mb_make_hdl,
    191 
    +                  mkd_dep_json = dep_json_ref,
    187 192 
                       mkd_tmp_file  = tmp_file, mkd_tmp_hdl  = tmp_hdl})
    188 193
    189 
    -
    190 194 
     -----------------------------------------------------------------
    191 195 
     --
    192 196 
     --              processDeps
    ... ... @@ -198,6 +202,7 @@ processDeps :: DynFlags
    198 202 
                 -> [ModuleName]
    199 203 
                 -> FilePath
    200 204 
                 -> Handle           -- Write dependencies to here
    205 
    +            -> Maybe (JsonOutput DepJSON)
    201 206 
                 -> SCC ModuleGraphNode
    202 207 
                 -> IO ()
    203 208 
     -- Write suitable dependencies to handle
    ... ... @@ -215,79 +220,83 @@ processDeps :: DynFlags
    215 220 
     --
    216 221 
     -- For {-# SOURCE #-} imports the "hi" will be "hi-boot".
    217 222
    218 
    -processDeps _ _ _ _ _ (CyclicSCC nodes)
    223 
    +processDeps _ _ _ _ _ _ (CyclicSCC nodes)
    219 224 
       =     -- There shouldn't be any cycles; report them
    220 225 
         throwOneError $ cyclicModuleErr nodes
    221 226
    222 
    -processDeps _ _ _ _ _ (AcyclicSCC (InstantiationNode _uid node))
    227 
    +processDeps _ _ _ _ _ _ (AcyclicSCC (InstantiationNode _uid node))
    223 228 
       =     -- There shouldn't be any backpack instantiations; report them as well
    224 229 
         throwOneError $
    225 230 
           mkPlainErrorMsgEnvelope noSrcSpan $
    226 231 
           GhcDriverMessage $ DriverInstantiationNodeInDependencyGeneration node
    227 232
    228 
    -processDeps _dflags _ _ _ _ (AcyclicSCC (LinkNode {})) = return ()
    229 
    -processDeps _dflags _ _ _ _ (AcyclicSCC (UnitNode {})) = return ()
    230 
    -processDeps _ _ _ _ _ (AcyclicSCC (ModuleNode _ (ModuleNodeFixed {})))
    233 
    +processDeps _dflags _ _ _ _ _ (AcyclicSCC (LinkNode {})) = return ()
    234 
    +processDeps _dflags _ _ _ _ _ (AcyclicSCC (UnitNode {})) = return ()
    235 
    +processDeps _ _ _ _ _ _ (AcyclicSCC (ModuleNode _ (ModuleNodeFixed {})))
    231 236 
       -- No dependencies needed for fixed modules (already compiled)
    232 237 
       = return ()
    233 
    -processDeps dflags hsc_env excl_mods root hdl (AcyclicSCC (ModuleNode _ (ModuleNodeCompile node)))
    234 
    -  = do  { let extra_suffixes = depSuffixes dflags
    235 
    -              include_pkg_deps = depIncludePkgDeps dflags
    236 
    -              src_file  = msHsFilePath node
    237 
    -              obj_file  = msObjFilePath node
    238 
    -              obj_files = insertSuffixes obj_file extra_suffixes
    239 
    -
    240 
    -              do_imp loc is_boot pkg_qual imp_mod
    241 
    -                = do { mb_hi <- findDependency hsc_env loc pkg_qual imp_mod
    242 
    -                                               is_boot include_pkg_deps
    243 
    -                     ; case mb_hi of {
    244 
    -                           Nothing      -> return () ;
    245 
    -                           Just hi_file -> do
    246 
    -                     { let hi_files = insertSuffixes hi_file extra_suffixes
    247 
    -                           write_dep (obj,hi) = writeDependency root hdl [obj] hi
    248 
    -
    249 
    -                        -- Add one dependency for each suffix;
    250 
    -                        -- e.g.         A.o   : B.hi
    251 
    -                        --              A.x_o : B.x_hi
    252 
    -                     ; mapM_ write_dep (obj_files `zip` hi_files) }}}
    253 
    -
    254 
    -
    255 
    -                -- Emit std dependency of the object(s) on the source file
    256 
    -                -- Something like       A.o : A.hs
    257 
    -        ; writeDependency root hdl obj_files src_file
    258 
    -
    259 
    -          -- add dependency between objects and their corresponding .hi-boot
    260 
    -          -- files if the module has a corresponding .hs-boot file (#14482)
    261 
    -        ; when (isBootSummary node == IsBoot) $ do
    262 
    -            let hi_boot = msHiFilePath node
    263 
    -            let obj     = unsafeDecodeUtf $ removeBootSuffix (msObjFileOsPath node)
    264 
    -            forM_ extra_suffixes $ \suff -> do
    265 
    -               let way_obj     = insertSuffixes obj     [suff]
    266 
    -               let way_hi_boot = insertSuffixes hi_boot [suff]
    267 
    -               mapM_ (writeDependency root hdl way_obj) way_hi_boot
    268 
    -
    269 
    -                -- Emit a dependency for each CPP import
    270 
    -        ; when (depIncludeCppDeps dflags) $ do
    271 
    -            -- CPP deps are discovered in the module parsing phase by parsing
    272 
    -            -- comment lines left by the preprocessor.
    273 
    -            -- Note that GHC.parseModule may throw an exception if the module
    274 
    -            -- fails to parse, which may not be desirable (see #16616).
    275 
    -          { session <- Session <$> newIORef hsc_env
    276 
    -          ; parsedMod <- reflectGhc (GHC.parseModule node) session
    277 
    -          ; mapM_ (writeDependency root hdl obj_files)
    278 
    -                  (GHC.pm_extra_src_files parsedMod)
    279 
    -          }
    280 
    -
    281 
    -                -- Emit a dependency for each import
    282 
    -
    283 
    -        ; let do_imps is_boot idecls = sequence_
    284 
    -                    [ do_imp loc is_boot mb_pkg mod
    285 
    -                    | (mb_pkg, L loc mod) <- idecls,
    286 
    -                      mod `notElem` excl_mods ]
    287 
    -
    288 
    -        ; do_imps IsBoot (ms_srcimps node)
    289 
    -        ; do_imps NotBoot (ms_imps node)
    290 
    -        }
    238 
    +
    239 
    +processDeps dflags hsc_env excl_mods root hdl m_dep_json (AcyclicSCC (ModuleNode _ (ModuleNodeCompile node))) = do
    240 
    +  pp <- preprocessor
    241 
    +  deps <- fmap concat $ sequence $
    242 
    +    [cpp_deps | depIncludeCppDeps dflags] ++ [
    243 
    +      import_deps IsBoot (ms_srcimps node),
    244 
    +      import_deps NotBoot (ms_imps node)
    245 
    +    ]
    246 
    +  updateJson m_dep_json (updateDepJSON include_pkg_deps pp dep_node deps)
    247 
    +  writeDependencies include_pkg_deps root hdl extra_suffixes dep_node deps
    248 
    +  where
    249 
    +    extra_suffixes = depSuffixes dflags
    250 
    +    include_pkg_deps = depIncludePkgDeps dflags
    251 
    +    src_file = msHsFilePath node
    252 
    +    dep_node =
    253 
    +      DepNode {
    254 
    +        dn_mod = ms_mod node,
    255 
    +        dn_src = src_file,
    256 
    +        dn_obj = msObjFilePath node,
    257 
    +        dn_hi = msHiFilePath node,
    258 
    +        dn_boot = isBootSummary node,
    259 
    +        dn_options = Set.fromList (ms_opts node)
    260 
    +      }
    261 
    +
    262 
    +    preprocessor
    263 
    +      | Just src <- ml_hs_file (ms_location node)
    264 
    +      = runPipeline (hsc_hooks hsc_env) $ do
    265 
    +        let (_, suffix) = splitExtension src
    266 
    +            lit | Unlit _ <- startPhase suffix = True
    267 
    +                | otherwise = False
    268 
    +            pipe_env = mkPipeEnv StopPreprocess src Nothing NoOutputFile
    269 
    +        unlit_fn <- if lit then use (T_Unlit pipe_env hsc_env src) else pure src
    270 
    +        (dflags1, _, _) <- use (T_FileArgs hsc_env unlit_fn)
    271 
    +        let pp = pgm_F dflags1
    272 
    +        pure (if null pp then global_preprocessor else Just pp)
    273 
    +      | otherwise
    274 
    +      = pure global_preprocessor
    275 
    +
    276 
    +    global_preprocessor
    277 
    +      | let pp = pgm_F dflags
    278 
    +      , not (null pp)
    279 
    +      = Just pp
    280 
    +      | otherwise
    281 
    +      = Nothing
    282 
    +
    283 
    +    -- Emit a dependency for each CPP import
    284 
    +    -- CPP deps are discovered in the module parsing phase by parsing
    285 
    +    -- comment lines left by the preprocessor.
    286 
    +    -- Note that GHC.parseModule may throw an exception if the module
    287 
    +    -- fails to parse, which may not be desirable (see #16616).
    288 
    +    cpp_deps = do
    289 
    +      session <- Session <$> newIORef hsc_env
    290 
    +      parsedMod <- reflectGhc (GHC.parseModule node) session
    291 
    +      pure (DepCpp <$> GHC.pm_extra_src_files parsedMod)
    292 
    +
    293 
    +    -- Emit a dependency for each import
    294 
    +    import_deps is_boot idecls =
    295 
    +      sequence [
    296 
    +        findDependency hsc_env loc mb_pkg mod is_boot
    297 
    +        | (mb_pkg, L loc mod) <- idecls
    298 
    +        , mod `notElem` excl_mods
    299 
    +        ]
    291 300
    292 301
    293 302 
     findDependency  :: HscEnv
    ... ... @@ -295,27 +304,78 @@ findDependency :: HscEnv
    295 304 
                     -> PkgQual              -- package qualifier, if any
    296 305 
                     -> ModuleName           -- Imported module
    297 306 
                     -> IsBootInterface      -- Source import
    298 
    -                -> Bool                 -- Record dependency on package modules
    299 
    -                -> IO (Maybe FilePath)  -- Interface file
    300 
    -findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps = do
    307 
    +                -> IO Dep
    308 
    +findDependency hsc_env srcloc pkg imp dep_boot = do
    301 309 
       -- Find the module; this will be fast because
    302 310 
       -- we've done it once during downsweep
    303 
    -  r <- findImportedModuleWithIsBoot hsc_env imp is_boot pkg
    304 
    -  case r of
    305 
    -    Found loc _
    306 
    -        -- Home package: just depend on the .hi or hi-boot file
    307 
    -        | isJust (ml_hs_file loc) || include_pkg_deps
    308 
    -        -> return (Just (ml_hi_file loc))
    309 
    -
    310 
    -        -- Not in this package: we don't need a dependency
    311 
    -        | otherwise
    312 
    -        -> return Nothing
    311 
    +  findImportedModule hsc_env imp pkg >>= \case
    312 
    +    Found loc dep_mod ->
    313 
    +      pure DepHi {
    314 
    +        dep_mod,
    315 
    +        dep_path = ml_hi_file loc,
    316 
    +        dep_unit = lookupUnitId (hsc_units hsc_env) (moduleUnitId dep_mod),
    317 
    +        dep_local,
    318 
    +        dep_boot
    319 
    +      }
    320 
    +      where
    321 
    +        dep_local = isJust (ml_hs_file loc)
    313 322
    314 323 
         fail ->
    315 
    -        throwOneError $
    316 
    -          mkPlainErrorMsgEnvelope srcloc $
    317 
    -          GhcDriverMessage $ DriverInterfaceError $
    318 
    -             (Can'tFindInterface (cannotFindModule hsc_env imp fail) (LookingForModule imp is_boot))
    324 
    +      throwOneError $
    325 
    +      mkPlainErrorMsgEnvelope srcloc $
    326 
    +      GhcDriverMessage $
    327 
    +      DriverInterfaceError $
    328 
    +      Can'tFindInterface (cannotFindModule hsc_env imp fail) $
    329 
    +      LookingForModule imp dep_boot
    330 
    +
    331 
    +writeDependencies ::
    332 
    +  Bool ->
    333 
    +  FilePath ->
    334 
    +  Handle ->
    335 
    +  [FilePath] ->
    336 
    +  DepNode ->
    337 
    +  [Dep] ->
    338 
    +  IO ()
    339 
    +writeDependencies include_pkgs root hdl suffixes node deps =
    340 
    +  traverse_ write tasks
    341 
    +  where
    342 
    +    tasks = source_dep : boot_dep ++ concatMap import_dep deps
    343 
    +
    344 
    +    -- Emit std dependency of the object(s) on the source file
    345 
    +    -- Something like       A.o : A.hs
    346 
    +    source_dep = (obj_files, dn_src)
    347 
    +
    348 
    +    -- add dependency between objects and their corresponding .hi-boot
    349 
    +    -- files if the module has a corresponding .hs-boot file (#14482)
    350 
    +    boot_dep
    351 
    +      | IsBoot <- dn_boot
    352 
    +      = [([obj], hi) | (obj, hi) <- zip (suffixed (viaOsPath removeBootSuffix dn_obj)) (suffixed dn_hi)]
    353 
    +      | otherwise
    354 
    +      = []
    355 
    +
    356 
    +    -- Add one dependency for each suffix;
    357 
    +    -- e.g.         A.o   : B.hi
    358 
    +    --              A.x_o : B.x_hi
    359 
    +    import_dep = \case
    360 
    +      DepHi {dep_path, dep_boot, dep_unit}
    361 
    +        | isNothing dep_unit || include_pkgs
    362 
    +        , let path = if dep_boot == IsBoot then viaOsPath addBootSuffix dep_path else dep_path
    363 
    +        -> [([obj], hi) | (obj, hi) <- zip obj_files (suffixed path)]
    364 
    +
    365 
    +        | otherwise
    366 
    +        -> []
    367 
    +
    368 
    +      DepCpp {dep_path} -> [(obj_files, dep_path)]
    369 
    +
    370 
    +    write (from, to) = writeDependency root hdl from to
    371 
    +
    372 
    +    obj_files = suffixed dn_obj
    373 
    +
    374 
    +    suffixed f = insertSuffixes f suffixes
    375 
    +
    376 
    +    DepNode {dn_src, dn_obj, dn_hi, dn_boot} = node
    377 
    +
    378 
    +    viaOsPath f a = unsafeDecodeUtf (f (unsafeEncodeUtf a))
    319 379
    320 380 
     -----------------------------
    321 381 
     writeDependency :: FilePath -> Handle -> [FilePath] -> FilePath -> IO ()
    ... ... @@ -357,8 +417,9 @@ insertSuffixes file_name extras
    357 417 
     endMkDependHS :: Logger -> MkDepFiles -> IO ()
    358 418
    359 419 
     endMkDependHS logger
    360 
    -   (MkDep { mkd_make_file = makefile, mkd_make_hdl =  makefile_hdl,
    361 
    -            mkd_tmp_file  = tmp_file, mkd_tmp_hdl  =  tmp_hdl })
    420 
    +   (MkDep { mkd_make_file = makefile, mkd_make_hdl = makefile_hdl,
    421 
    +            mkd_dep_json,
    422 
    +            mkd_tmp_file = tmp_file, mkd_tmp_hdl = tmp_hdl })
    362 423 
       = do
    363 424 
       -- write the magic marker into the tmp file
    364 425 
       hPutStrLn tmp_hdl depEndMarker
    ... ... @@ -381,6 +442,10 @@ endMkDependHS logger
    381 442 
       showPass logger "Installing new makefile"
    382 443 
       SysTools.copyFile tmp_file makefile
    383 444
    445 
    +  -- Write the dependency and option data to a json file if the corresponding
    446 
    +  -- flags were specified.
    447 
    +  writeJsonOutput mkd_dep_json
    448 
    +
    384 449
    385 450 
     -----------------------------------------------------------------
    386 451 
     --              Module cycles

  • compiler/GHC/Driver/MakeFile/JSON.hs
    1 
    +{-# LANGUAGE DeriveGeneric #-}
    2 
    +{-# LANGUAGE DerivingVia #-}
    3 
    +{-# LANGUAGE GeneralizedNewtypeDeriving #-}
    4 
    +{-# LANGUAGE LambdaCase #-}
    5 
    +{-# LANGUAGE NamedFieldPuns #-}
    6 
    +{-# LANGUAGE NoFieldSelectors #-}
    7 
    +{-# LANGUAGE RecordWildCards #-}
    8 
    +module GHC.Driver.MakeFile.JSON
    9 
    +  ( writeJSONFile,
    10 
    +    JsonOutput (..),
    11 
    +    mkJsonOutput,
    12 
    +    updateJson,
    13 
    +    writeJsonOutput,
    14 
    +    DepJSON,
    15 
    +    DepNode (..),
    16 
    +    Dep (..),
    17 
    +    initDepJSON,
    18 
    +    updateDepJSON,
    19 
    +  )
    20 
    +where
    21 
    +
    22 
    +import Data.Foldable (traverse_)
    23 
    +import Data.IORef
    24 
    +import qualified Data.Map.Strict as Map
    25 
    +import qualified Data.Semigroup as Semigroup
    26 
    +import qualified Data.Set as Set
    27 
    +import GHC.Data.FastString (unpackFS)
    28 
    +import GHC.Generics (Generic, Generically (Generically))
    29 
    +import GHC.Prelude
    30 
    +import GHC.Unit
    31 
    +import GHC.Utils.Json
    32 
    +import GHC.Utils.Misc
    33 
    +import GHC.Utils.Outputable
    34 
    +import System.FilePath (normalise)
    35 
    +
    36 
    +--------------------------------------------------------------------------------
    37 
    +-- Output helpers
    38 
    +--------------------------------------------------------------------------------
    39 
    +
    40 
    +writeJSONFile :: ToJson a => a -> FilePath -> IO ()
    41 
    +writeJSONFile doc p = do
    42 
    +  withAtomicRename p
    43 
    +    $ \tmp -> writeFile tmp $ showSDocUnsafe $ renderJSON $ json doc
    44 
    +
    45 
    +--------------------------------------------------------------------------------
    46 
    +-- Output interface for json dumps
    47 
    +--------------------------------------------------------------------------------
    48 
    +
    49 
    +-- | Resources for a json dump option, used in "GHC.Driver.MakeFile".
    50 
    +-- The flag @-dep-json@ add an additional output target for dependency
    51 
    +-- diagnostics.
    52 
    +data JsonOutput a =
    53 
    +  JsonOutput {
    54 
    +    -- | This ref is updated in @processDeps@ incrementally, using a
    55 
    +    -- flag-specific type.
    56 
    +    json_ref :: IORef a,
    57 
    +
    58 
    +    -- | The output file path specified as argument to the flag.
    59 
    +    json_path :: FilePath
    60 
    +  }
    61 
    +
    62 
    +-- | Allocate an 'IORef' with the given function if the 'FilePath' is 'Just',
    63 
    +-- indicating that the userspecified @-*-json@.
    64 
    +mkJsonOutput ::
    65 
    +  IO (IORef a) ->
    66 
    +  Maybe FilePath ->
    67 
    +  IO (Maybe (JsonOutput a))
    68 
    +mkJsonOutput mk_ref =
    69 
    +  traverse $ \ json_path -> do
    70 
    +    json_ref <- mk_ref
    71 
    +    pure JsonOutput {json_ref, json_path}
    72 
    +
    73 
    +-- | Update the dump data in 'json_ref' if the output target is present.
    74 
    +updateJson :: Maybe (JsonOutput a) -> (a -> a) -> IO ()
    75 
    +updateJson out f = traverse_ (\ JsonOutput {json_ref} -> modifyIORef' json_ref f) out
    76 
    +
    77 
    +-- | Write a json object to the flag-dependent file if the output target is
    78 
    +-- present.
    79 
    +writeJsonOutput ::
    80 
    +  ToJson a =>
    81 
    +  Maybe (JsonOutput a) ->
    82 
    +  IO ()
    83 
    +writeJsonOutput =
    84 
    +  traverse_ $ \ JsonOutput {json_ref, json_path} -> do
    85 
    +    payload <- readIORef json_ref
    86 
    +    writeJSONFile payload json_path
    87 
    +
    88 
    +--------------------------------------------------------------------------------
    89 
    +-- Types abstracting over json and Makefile
    90 
    +--------------------------------------------------------------------------------
    91 
    +
    92 
    +data DepNode =
    93 
    +  DepNode {
    94 
    +    dn_mod :: Module,
    95 
    +    dn_src :: FilePath,
    96 
    +    dn_obj :: FilePath,
    97 
    +    dn_hi :: FilePath,
    98 
    +    dn_boot :: IsBootInterface,
    99 
    +    dn_options :: Set.Set String
    100 
    +  }
    101 
    +
    102 
    +data Dep =
    103 
    +  DepHi {
    104 
    +    dep_mod :: Module,
    105 
    +    dep_path :: FilePath,
    106 
    +    dep_unit :: Maybe UnitInfo,
    107 
    +    dep_local :: Bool,
    108 
    +    dep_boot :: IsBootInterface
    109 
    +  }
    110 
    +  |
    111 
    +  DepCpp {
    112 
    +    dep_path :: FilePath
    113 
    +  }
    114 
    +
    115 
    +--------------------------------------------------------------------------------
    116 
    +-- Payload for -dep-json
    117 
    +--------------------------------------------------------------------------------
    118 
    +
    119 
    +newtype PackageDeps =
    120 
    +  PackageDeps (Map.Map (String, UnitId, PackageId) (Set.Set ModuleName))
    121 
    +  deriving newtype (Monoid)
    122 
    +
    123 
    +instance Semigroup PackageDeps where
    124 
    +  PackageDeps l <> PackageDeps r = PackageDeps (Map.unionWith (Semigroup.<>) l r)
    125 
    +
    126 
    +data Deps =
    127 
    +  Deps {
    128 
    +    sources :: Set.Set FilePath,
    129 
    +    modules :: (Set.Set ModuleName, Set.Set ModuleName),
    130 
    +    packages :: PackageDeps,
    131 
    +    cpp :: Set.Set FilePath,
    132 
    +    options :: Set.Set String,
    133 
    +    preprocessor :: Maybe FilePath
    134 
    +  }
    135 
    +  deriving stock (Generic)
    136 
    +  deriving (Semigroup, Monoid) via (Generically Deps)
    137 
    +
    138 
    +newtype DepJSON = DepJSON (Map.Map ModuleName Deps)
    139 
    +
    140 
    +instance ToJson DepJSON where
    141 
    +  json (DepJSON m) =
    142 
    +    JSObject [
    143 
    +      (moduleNameString target, JSObject [
    144 
    +        ("sources", array sources normalise),
    145 
    +        ("modules", array (fst modules) moduleNameString),
    146 
    +        ("modules-boot", array (snd modules) moduleNameString),
    147 
    +        ("packages",
    148 
    +          JSArray [
    149 
    +            package name unit_id package_id mods |
    150 
    +            ((name, unit_id, package_id), mods) <- Map.toList packages
    151 
    +          ]
    152 
    +        ),
    153 
    +        ("cpp", array cpp id),
    154 
    +        ("options", array options id),
    155 
    +        ("preprocessor", maybe JSNull JSString preprocessor)
    156 
    +      ])
    157 
    +      | (target, Deps {packages = PackageDeps packages, ..}) <- Map.toList m
    158 
    +    ]
    159 
    +    where
    160 
    +      package name unit_id (PackageId package_id) mods =
    161 
    +        JSObject [
    162 
    +          ("id", JSString (unitIdString unit_id)),
    163 
    +          ("name", JSString name),
    164 
    +          ("package-id", JSString (unpackFS package_id)),
    165 
    +          ("modules", array mods moduleNameString)
    166 
    +        ]
    167 
    +
    168 
    +      array values render = JSArray (fmap (JSString . render) (Set.toList values))
    169 
    +
    170 
    +initDepJSON :: IO (IORef DepJSON)
    171 
    +initDepJSON = newIORef $ DepJSON Map.empty
    172 
    +
    173 
    +insertDepJSON :: [ModuleName] -> Deps -> DepJSON -> DepJSON
    174 
    +insertDepJSON targets dep (DepJSON m0) =
    175 
    +  DepJSON
    176 
    +    $ foldl'
    177 
    +      ( \acc target ->
    178 
    +          Map.insertWith
    179 
    +            (Semigroup.<>)
    180 
    +            target
    181 
    +            dep
    182 
    +            acc
    183 
    +      )
    184 
    +      m0
    185 
    +      targets
    186 
    +
    187 
    +updateDepJSON :: Bool -> Maybe FilePath -> DepNode -> [Dep] -> DepJSON -> DepJSON
    188 
    +updateDepJSON include_pkgs preprocessor DepNode {..} deps =
    189 
    +  insertDepJSON [moduleName dn_mod] payload
    190 
    +  where
    191 
    +    payload = node_data Semigroup.<> foldMap dep deps
    192 
    +
    193 
    +    node_data =
    194 
    +      mempty {
    195 
    +        sources = Set.singleton dn_src,
    196 
    +        preprocessor,
    197 
    +        options = dn_options
    198 
    +      }
    199 
    +
    200 
    +    dep = \case
    201 
    +      DepHi {dep_mod, dep_local, dep_unit, dep_boot}
    202 
    +        | dep_local
    203 
    +        , let set = Set.singleton (moduleName dep_mod)
    204 
    +              value | IsBoot <- dep_boot = (Set.empty, set)
    205 
    +                    | otherwise = (set, Set.empty)
    206 
    +        -> mempty {modules = value}
    207 
    +
    208 
    +        | include_pkgs
    209 
    +        , Just unit <- dep_unit
    210 
    +        , let PackageName nameFS = unitPackageName unit
    211 
    +              name = unpackFS nameFS
    212 
    +              withLibName (PackageName c) = name ++ ":" ++ unpackFS c
    213 
    +              lname = maybe name withLibName (unitComponentName unit)
    214 
    +              key = (lname, unitId unit, unitPackageId unit)
    215 
    +        -> mempty {packages = PackageDeps (Map.singleton key (Set.singleton (moduleName dep_mod)))}
    216 
    +
    217 
    +        | otherwise
    218 
    +        -> mempty
    219 
    +
    220 
    +      DepCpp {dep_path} ->
    221 
    +        mempty {cpp = Set.singleton dep_path}

  • compiler/GHC/Driver/Pipeline/Execute.hs
    ... ... @@ -753,6 +753,7 @@ runHscPhase pipe_env hsc_env0 input_fn src_flavour = do
    753 753 
                                     ms_iface_date   = hi_date,
    754 754 
                                     ms_hie_date     = hie_date,
    755 755 
                                     ms_textual_imps = imps,
    756 
    +                                ms_opts         = [],
    756 757 
                                     ms_srcimps      = src_imps }
    757 758
    758 759

  • compiler/GHC/Driver/Session.hs
    ... ... @@ -753,6 +753,9 @@ addDepExcludeMod m d
    753 753 
     addDepSuffix :: FilePath -> DynFlags -> DynFlags
    754 754 
     addDepSuffix s d = d { depSuffixes = s : depSuffixes d }
    755 755
    756 
    +setDepJSON :: FilePath -> DynFlags -> DynFlags
    757 
    +setDepJSON f d = d { depJSON = Just f }
    758 
    +
    756 759 
     addCmdlineFramework f d = d { cmdlineFrameworks = f : cmdlineFrameworks d}
    757 760
    758 761 
     addGhcVersionFile :: FilePath -> DynFlags -> DynFlags
    ... ... @@ -1218,6 +1221,7 @@ dynamic_flags_deps = [
    1218 1221 
       , make_ord_flag defGhcFlag "include-pkg-deps"
    1219 1222 
             (noArg (setDepIncludePkgDeps True))
    1220 1223 
       , make_ord_flag defGhcFlag "exclude-module"          (hasArg addDepExcludeMod)
    1224 
    +  , make_ord_flag defGhcFlag "dep-json"                (hasArg setDepJSON)
    1221 1225
    1222 1226 
             -------- Linking ----------------------------------------------------
    1223 1227 
       , make_ord_flag defGhcFlag "no-link"

  • compiler/GHC/Unit/Info.hs
    ... ... @@ -117,6 +117,9 @@ instance Outputable PackageId where
    117 117 
     instance Outputable PackageName where
    118 118 
       ppr (PackageName str) = ftext str
    119 119
    120 
    +instance Ord PackageId where
    121 
    +    PackageId p1 `compare` PackageId p2 = p1 `lexicalCompareFS` p2
    122 
    +
    120 123 
     unitPackageIdString :: GenUnitInfo u -> String
    121 124 
     unitPackageIdString pkg = unpackFS str
    122 125 
       where

  • compiler/GHC/Unit/Module/ModSummary.hs
    ... ... @@ -83,6 +83,8 @@ data ModSummary
    83 83 
               -- ^ Source imports of the module
    84 84 
             ms_textual_imps :: [(PkgQual, Located ModuleName)],
    85 85 
               -- ^ Non-source imports of the module from the module *text*
    86 
    +        ms_opts         :: ![String],
    87 
    +          -- ^ OPTIONS and LANGUAGE pragmas of the source file
    86 88 
             ms_parsed_mod   :: Maybe HsParsedModule,
    87 89 
               -- ^ The parsed, nonrenamed source, if we have it.  This is also
    88 90 
               -- used to support "inline module syntax" in Backpack files.

  • compiler/GHC/Unit/State.hs
    ... ... @@ -71,6 +71,7 @@ module GHC.Unit.State (
    71 71 
             unwireUnit)
    72 72 
     where
    73 73
    74 
    +import Data.Foldable (find)
    74 75 
     import GHC.Prelude
    75 76
    76 77 
     import GHC.Driver.DynFlags
    ... ... @@ -903,8 +904,18 @@ applyPackageFlag prec_map pkg_map closure unusable no_hide_others pkgs vm flag =
    903 904 
         ExposePackage _ arg (ModRenaming b rns) ->
    904 905 
            case findPackages prec_map pkg_map closure arg pkgs unusable of
    905 906 
              Left ps     -> Failed (PackageFlagErr flag ps)
    906 
    -         Right (p:_) -> Succeeded vm'
    907 
    +         Right ps@(p0:_) -> Succeeded vm'
    907 908 
               where
    909 
    +           p | PackageArg _ <- arg = fromMaybe p0 mainPackage
    910 
    +             | otherwise = p0
    911 
    +
    912 
    +           mainPackage = find (\ u -> isNothing (unitComponentName u)) matchFirst
    913 
    +
    914 
    +           matchFirst = filter (\ u -> unitPackageName u == firstName && unitPackageVersion u == firstVersion) ps
    915 
    +
    916 
    +           firstName = unitPackageName p0
    917 
    +           firstVersion = unitPackageVersion p0
    918 
    +
    908 919 
                n = fsPackageName p
    909 920
    910 921 
                -- If a user says @-unit-id p[A=<A>]@, this imposes
    ... ... @@ -1030,6 +1041,13 @@ matchingStr :: String -> UnitInfo -> Bool
    1030 1041 
     matchingStr str p
    1031 1042 
             =  str == unitPackageIdString p
    1032 1043 
             || str == unitPackageNameString p
    1044 
    +        || matchSublibrary
    1045 
    +  where
    1046 
    +    matchSublibrary
    1047 
    +      | Just (PackageName c) <- unitComponentName p
    1048 
    +      = str == (unitPackageNameString p ++ ":" ++ unpackFS c)
    1049 
    +      | otherwise
    1050 
    +      = False
    1033 1051
    1034 1052 
     matchingId :: UnitId -> UnitInfo -> Bool
    1035 1053 
     matchingId uid p = uid == unitId p

  • compiler/ghc.cabal.in
    ... ... @@ -528,6 +528,7 @@ Library
    528 528 
             GHC.Driver.Make
    529 529 
             GHC.Driver.MakeAction
    530 530 
             GHC.Driver.MakeFile
    531 
    +        GHC.Driver.MakeFile.JSON
    531 532 
             GHC.Driver.Monad
    532 533 
             GHC.Driver.Phases
    533 534 
             GHC.Driver.Pipeline

  • configure.ac
    ... ... @@ -13,7 +13,7 @@ dnl
    13 13 
     # see what flags are available. (Better yet, read the documentation!)
    14 14 
     #
    15 15
    16 
    -AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.13], [glasgow-haskell-bugs@haskell.org], [ghc-AC_PACKAGE_VERSION])
    16 
    +AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.12.1], [glasgow-haskell-bugs@haskell.org], [ghc-AC_PACKAGE_VERSION])
    17 17 
         # Version on master must be X.Y (not X.Y.Z) for ProjectVersionMunged variable
    18 18 
         # to be useful (cf #19058). However, the version must have three components
    19 19 
         # (X.Y.Z) on stable branches (e.g. ghc-9.2) to ensure that pre-releases are
    ... ... @@ -22,7 +22,7 @@ AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.13], [glasgow-hask
    22 22 
     AC_CONFIG_MACRO_DIRS([m4])
    23 23
    24 24 
     # Set this to YES for a released version, otherwise NO
    25 
    -: ${RELEASE=NO}
    25 
    +: ${RELEASE=YES}
    26 26
    27 27 
     # The primary version (e.g. 7.5, 7.4.1) is set in the AC_INIT line
    28 28 
     # above.  If this is not a released version, then we will append the

  • docs/users_guide/separate_compilation.rst
    ... ... @@ -1520,6 +1520,22 @@ generation are:
    1520 1520 
         is only a temporary file that GHC will always generate, it is not output as
    1521 1521 
         a dependency.
    1522 1522
    1523 
    +.. ghc-flag:: -dep-json ⟨file⟩
    1524 
    +    :shortdesc: Also emit ⟨file⟩ as a JSON file containing dependencies
    1525 
    +    :type: dynamic
    1526 
    +    :category: redirect-output
    1527 
    +
    1528 
    +    In addition to the makefile, also emit ⟨file⟩ as a JSON file
    1529 
    +    containing the same dependencies info, so it can be parsed by
    1530 
    +    external build systems. The JSON file contains a single object,
    1531 
    +    mapping each target to a list of dependencies.
    1532 
    +    In addition to the makefile, each module's payload will contain the
    1533 
    +    values of ``OPTIONS`` and ``LANGUAGE`` pragmas of the source
    1534 
    +    file, so it can be parsed by external build systems. Each ``LANGUAGE``
    1535 
    +    pragma is represented as an option as well, e.g.
    1536 
    +    ``{-# LANGUAGE TemplateHaskell #-}`` is represented as
    1537 
    +    ``"-XTemplateHaskell"``.
    1538 
    +
    1523 1539 
     .. _orphan-modules:
    1524 1540
    1525 1541 
     Orphan modules and instance declarations

  • docs/users_guide/using.rst
    ... ... @@ -366,7 +366,7 @@ The available mode flags are:
    366 366
    367 367 
     .. ghc-flag:: -M
    368 368 
         :shortdesc: generate dependency information suitable for use in a
    369 
    -        ``Makefile``; see :ref:`makefile-dependencies` for details.
    369 
    +        ``Makefile`` or as JSON; see :ref:`makefile-dependencies` for details.
    370 370 
         :type: mode
    371 371 
         :category: modes
    372 372

  • testsuite/tests/driver/T24384/A.hs
    1 
    +{-# language Strict #-}
    2 
    +{-# options_ghc -fexpose-all-unfoldings #-}
    3 
    +module A where
    4 
    +
    5 
    +import {-# source #-} C

  • testsuite/tests/driver/T24384/B.hs
    1 
    +{-# options_ghc -F -pgmF ./preproc.sh #-}
    2 
    +module B where

  • testsuite/tests/driver/T24384/C.hs
    1 
    +module C where
    2 
    +
    3 
    +import A
    4 
    +import Data.Set
    5 
    +
    6 
    +data C = C

  • testsuite/tests/driver/T24384/C.hs-boot
    1 
    +module C where
    2 
    +
    3 
    +import E
    4 
    +
    5 
    +data C

  • testsuite/tests/driver/T24384/D.hs
    1 
    +module D where
    2 
    +
    3 
    +import B
    4 
    +import C

  • testsuite/tests/driver/T24384/E.hs
    1 
    +module E where
    2 
    +
    3 
    +import Language.Haskell.TH.Syntax
    4 
    +import Dep
    5 
    +import DepPub
    6 
    +
    7 
    +e :: Q Exp
    8 
    +e = lift (5 :: Integer)
    9 
    +
    10 
    +edep :: ()
    11 
    +edep = dep
    12 
    +
    13 
    +edepPub :: ()
    14 
    +edepPub = depPub

  • testsuite/tests/driver/T24384/Makefile
    1 
    +TOP=../../..
    2 
    +include $(TOP)/mk/boilerplate.mk
    3 
    +include $(TOP)/mk/test.mk
    4 
    +
    5 
    +T24384:
    6 
    +	./setup-dep.sh "$(TEST_HC)" "$(TEST_HC_OPTS)" "$(CABAL_MINIMAL_BUILD)" "$(GHC_PKG)"
    7 
    +	mkdir -p lib
    8 
    +	mv B.hs lib/
    9 
    +	'$(TEST_HC)' A.hs lib/B.hs C.hs D.hs E.hs -M -dep-json dep.json -include-pkg-deps -include-cpp-deps -package-db ./db -hide-all-packages -package base -package containers -package template-haskell -package dep -package dep:pub
    10 
    +	cat dep.json

  • testsuite/tests/driver/T24384/T24384.stdout
    1 
    +{"A":{"sources":["A.hs"],"modules":[],"modules-boot":["C"],"packages":[{"id":"base","name":"base","package-id":"base-4.20.0.0","modules":["Prelude"]}],"cpp":[],"options":["-XStrict","-fexpose-all-unfoldings"],"preprocessor":null},"B":{"sources":["lib/B.hs"],"modules":["A"],"modules-boot":[],"packages":[{"id":"base","name":"base","package-id":"base-4.20.0.0","modules":["Prelude"]}],"cpp":[],"options":[],"preprocessor":"./preproc.sh"},"C":{"sources":["C.hs","C.hs-boot"],"modules":["A","E"],"modules-boot":[],"packages":[{"id":"base","name":"base","package-id":"base-4.20.0.0","modules":["Prelude"]},{"id":"containers-0.7-inplace","name":"containers","package-id":"containers-0.7","modules":["Data.Set"]}],"cpp":[],"options":[],"preprocessor":null},"D":{"sources":["D.hs"],"modules":["B","C"],"modules-boot":[],"packages":[{"id":"base","name":"base","package-id":"base-4.20.0.0","modules":["Prelude"]}],"cpp":[],"options":[],"preprocessor":null},"E":{"sources":["E.hs"],"modules":[],"modules-boot":[],"packages":[{"id":"base","name":"base","package-id":"base-4.20.0.0","modules":["Prelude"]},{"id":"dep-1-Acdff5K3xp09fO6uiTrnge","name":"dep","package-id":"dep-1","modules":["Dep"]},{"id":"dep-1-8mhA0yJkyEn42CuhdNx93G-pub","name":"dep:pub","package-id":"dep-1","modules":["DepPub"]},{"id":"template-haskell","name":"template-haskell","package-id":"template-haskell-2.22.0.0","modules":["Language.Haskell.TH.Syntax"]}],"cpp":[],"options":[],"preprocessor":null}}
    \ No newline at end of file

  • testsuite/tests/driver/T24384/all.T
    1 
    +test('T24384', [extra_files(['A.hs', 'B.hs', 'C.hs', 'C.hs-boot', 'D.hs', 'E.hs', 'preproc.sh', 'setup-dep.sh'])], makefile_test, [])

  • testsuite/tests/driver/T24384/preproc.sh
    1 
    +#!/usr/bin/env bash
    2 
    +
    3 
    +sed '/preproc/d' $2 > $3
    4 
    +echo 'import A' >> $3

  • testsuite/tests/driver/T24384/setup-dep.sh
    1 
    +#!/usr/bin/env bash
    2 
    +
    3 
    +set -eu
    4 
    +
    5 
    +ghc="$1"
    6 
    +ghc_opts="$2"
    7 
    +config_options="$3"
    8 
    +ghc_pkg="$4"
    9 
    +base=$(cd $(dirname $0); pwd)
    10 
    +
    11 
    +mkdir -p dep/{int,pub}
    12 
    +$ghc_pkg init ./db
    13 
    +
    14 
    +cd dep/
    15 
    +
    16 
    +cat > dep.cabal <<EOF
    17 
    +cabal-version: 3.4
    18 
    +name: dep
    19 
    +version: 1
    20 
    +build-type: Simple
    21 
    +library
    22 
    +  default-language: Haskell2010
    23 
    +  exposed-modules: Dep
    24 
    +  build-depends: base, dep:int
    25 
    +library int
    26 
    +  default-language: Haskell2010
    27 
    +  hs-source-dirs: int
    28 
    +  exposed-modules: DepInt
    29 
    +  build-depends: base
    30 
    +library pub
    31 
    +  default-language: Haskell2010
    32 
    +  hs-source-dirs: pub
    33 
    +  visibility: public
    34 
    +  exposed-modules: DepPub
    35 
    +  build-depends: base
    36 
    +EOF
    37 
    +
    38 
    +cat > Dep.hs <<EOF
    39 
    +module Dep where
    40 
    +import DepInt
    41 
    +dep :: ()
    42 
    +dep = depInt
    43 
    +EOF
    44 
    +
    45 
    +cat > int/DepInt.hs <<EOF
    46 
    +module DepInt where
    47 
    +depInt :: ()
    48 
    +depInt = ()
    49 
    +EOF
    50 
    +
    51 
    +cat > pub/DepPub.hs <<EOF
    52 
    +module DepPub where
    53 
    +depPub :: ()
    54 
    +depPub = ()
    55 
    +EOF
    56 
    +
    57 
    +cat > Setup.hs <<EOF
    58 
    +import Distribution.Simple
    59 
    +main = defaultMain
    60 
    +EOF
    61 
    +
    62 
    +eval $ghc $ghc_opts -v0 --make Setup
    63 
    +eval ./Setup configure $config_options --with-ghc="'$ghc'" --with-hc-pkg="'$ghc_pkg'" --ghc-options="'$ghc_opts'" --package-db="'$base/db'" -v0
    64 
    +./Setup build -v0
    65 
    +./Setup register --inplace -v0

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help