Torsten Schmits pushed to branch wip/torsten.schmits/mercury-mhu-transitive-th-deps at Glasgow Haskell Compiler / GHC

Commits:

14 changed files:

Changes:

  • compiler/GHC/Linker/Deps.hs
    ... ... @@ -11,6 +11,7 @@
    11 11 
     module GHC.Linker.Deps
    12 12 
       ( LinkDepsOpts (..)
    13 13 
       , LinkDeps (..)
    14 
    +  , LibraryUnits (..)
    14 15 
       , getLinkDeps
    15 16 
       )
    16 17 
     where
    ... ... @@ -84,10 +85,16 @@ data LinkDepsOpts = LinkDepsOpts
    84 85 
     data LinkDeps = LinkDeps
    85 86 
       { ldNeededLinkables :: [Linkable]
    86 87 
       , ldAllLinkables    :: [Linkable]
    87 
    -  , ldNeededUnits     :: [UnitId]
    88 
    +  , ldNeededUnits     :: [LibraryUnits]
    88 89 
       , ldAllUnits        :: UniqDSet UnitId
    89 90 
       }
    90 91
    92 
    +data LibraryUnits
    93 
    +  = LibraryUnits
    94 
    +  { home_unit :: !UnitId
    95 
    +  , library_unit :: !UnitId
    96 
    +  }
    97 
    +
    91 98 
     -- | Find all the packages and linkables that a set of modules depends on
    92 99 
     --
    93 100 
     -- Return the module and package dependencies for the needed modules.
    ... ... @@ -142,6 +149,7 @@ instance Outputable LinkExternalDetails where
    142 149 
     data LinkExternal =
    143 150 
       LinkExternal {
    144 151 
         le_details :: LinkExternalDetails,
    152 
    +    le_unit_for_dbs :: !UnitId,
    145 153 
         le_module :: !Module
    146 154 
       }
    147 155
    ... ... @@ -215,7 +223,7 @@ get_link_deps opts pls maybe_normal_osuf span mods = do
    215 223 
         -- entire set for oneshot mode.
    216 224 
         separate_home_deps =
    217 225 
           if ldOneShotMode opts
    218 
    -      then pure ([], LinkExternal LinkAllDeps <$!> noninteractive)
    226 
    +      then pure ([], LinkExternal LinkAllDeps (ue_currentUnit unit_env) <$!> noninteractive)
    219 227 
           else make_deps
    220 228
    221 229 
         make_deps = do
    ... ... @@ -239,7 +247,7 @@ get_link_deps opts pls maybe_normal_osuf span mods = do
    239 247 
                 Nothing ->
    240 248 
                   let (ModNodeKeyWithUid (GWIB mod_name _) uid) = nk
    241 249 
                       mod = Module (RealUnit (Definite uid)) mod_name
    242 
    -              in make_deps_loop (LinkExternal LinkAllDeps mod : external, found_mods) nexts
    250 
    +              in make_deps_loop (LinkExternal LinkAllDeps (ue_currentUnit unit_env) mod : external, found_mods) nexts
    243 251 
                 Just trans_deps ->
    244 252 
                   let deps = Set.insert (NodeKey_Module nk) (Set.fromList trans_deps)
    245 253 
                       -- See #936 and the ghci.prog007 test for why we have to continue traversing through
    ... ... @@ -256,7 +264,8 @@ get_link_deps opts pls maybe_normal_osuf span mods = do
    256 264 
           case lookupHug (ue_home_unit_graph unit_env) uid (gwib_mod gwib) of
    257 265 
             Just hmi -> do
    258 266 
               let iface = hm_iface hmi
    259 
    -          pure (LinkExternal (LinkOnlyPackages iface) (mi_module iface), hmi)
    267 
    +              mod = mi_module iface
    268 
    +          pure (LinkExternal (LinkOnlyPackages iface) (moduleUnitId mod) mod, hmi)
    260 269 
             Nothing -> throwProgramError opts $
    261 270 
               text "getLinkDeps: Home module not loaded" <+> ppr (gwib_mod gwib) <+> ppr uid
    262 271
    ... ... @@ -319,12 +328,13 @@ get_link_deps opts pls maybe_normal_osuf span mods = do
    319 328 
     data LinkDep =
    320 329 
       LinkModules !(UniqDFM ModuleName LinkModule)
    321 330 
       |
    322 
    -  LinkLibrary !UnitId
    331 
    +  LinkLibrary !LibraryUnits
    323 332
    324 333 
     instance Outputable LinkDep where
    325 334 
       ppr = \case
    326 335 
         LinkModules mods -> text "modules:" <+> ppr (eltsUDFM mods)
    327 
    -    LinkLibrary uid -> text "library:" <+> ppr uid
    336 
    +    LinkLibrary (LibraryUnits {home_unit, library_unit}) ->
    337 
    +      text "library:" <+> ppr library_unit <+> parens (ppr home_unit)
    328 338
    329 339 
     data OneshotError =
    330 340 
       NoInterface !MissingInterfaceError
    ... ... @@ -397,7 +407,7 @@ external_deps_loop opts (job@LinkExternal {le_module = mod, ..} : mods) acc = do
    397 407 
         already_seen
    398 408 
           | Just (LinkModules mods) <- mod_dep
    399 409 
           = elemUDFM mod_name mods
    400 
    -      | Just (LinkLibrary _) <- mod_dep
    410 
    +      | Just (LinkLibrary {}) <- mod_dep
    401 411 
           = True
    402 412 
           | otherwise
    403 413 
           = False
    ... ... @@ -429,7 +439,7 @@ external_deps_loop opts (job@LinkExternal {le_module = mod, ..} : mods) acc = do
    429 439 
           = add_library
    430 440
    431 441 
         add_library =
    432 
    -      pure (addToUDFM acc mod_unit_id (LinkLibrary mod_unit_id), [], Just "library")
    442 
    +      pure (addToUDFM acc mod_unit_id (LinkLibrary (LibraryUnits {home_unit = le_unit_for_dbs, library_unit = mod_unit_id})), [], Just "library")
    433 443
    434 444 
         add_module iface lmod action =
    435 445 
           with_deps with_mod iface True action
    ... ... @@ -437,7 +447,7 @@ external_deps_loop opts (job@LinkExternal {le_module = mod, ..} : mods) acc = do
    437 447 
             with_mod = alterUDFM (add_package_module lmod) acc mod_unit_id
    438 448
    439 449 
         add_package_module lmod = \case
    440 
    -      Just (LinkLibrary u) -> Just (LinkLibrary u)
    450 
    +      Just (LinkLibrary lib) -> Just (LinkLibrary lib)
    441 451 
           Just (LinkModules old) -> Just (LinkModules (addToUDFM old mod_name lmod))
    442 452 
           Nothing -> Just (LinkModules (unitUDFM mod_name lmod))
    443 453
    ... ... @@ -449,7 +459,7 @@ external_deps_loop opts (job@LinkExternal {le_module = mod, ..} : mods) acc = do
    449 459
    450 460 
         local_deps iface =
    451 461 
           [
    452 
    -        LinkExternal LinkAllDeps (mkModule mod_unit m)
    462 
    +        LinkExternal LinkAllDeps le_unit_for_dbs (mkModule mod_unit m)
    453 463 
             | (_, GWIB m _) <- Set.toList (dep_direct_mods (mi_deps iface))
    454 464 
           ]
    455 465
    ... ... @@ -458,9 +468,9 @@ external_deps_loop opts (job@LinkExternal {le_module = mod, ..} : mods) acc = do
    458 468 
         -- Otherwise, link all package deps as libraries.
    459 469 
         package_deps iface
    460 470 
           | package_bc
    461 
    -      = ([], [LinkExternal LinkAllDeps usg_mod | UsagePackageModule {usg_mod} <- mi_usages iface])
    471 
    +      = ([], [LinkExternal LinkAllDeps le_unit_for_dbs usg_mod | UsagePackageModule {usg_mod} <- mi_usages iface])
    462 472 
           | otherwise
    463 
    -      = ([(u, LinkLibrary u) | u <- Set.toList (dep_direct_pkgs (mi_deps iface))], [])
    473 
    +      = ([(u, LinkLibrary (LibraryUnits {home_unit = le_unit_for_dbs, library_unit = u})) | u <- Set.toList (dep_direct_pkgs (mi_deps iface))], [])
    464 474
    465 475 
         load_reason =
    466 476 
           text "need to link module" <+> ppr mod <+>
    ... ... @@ -500,7 +510,7 @@ classify_deps ::
    500 510 
       LoaderState ->
    501 511 
       [HomeModInfo] ->
    502 512 
       [LinkDep] ->
    503 
    -  ([Linkable], [LinkModule], UniqDSet UnitId, [UnitId])
    513 
    +  ([Linkable], [LinkModule], UniqDSet UnitId, [LibraryUnits])
    504 514 
     classify_deps pls hmis deps =
    505 515 
       (loaded_modules' ++ loaded_modules'', needed_modules' ++ needed_modules'', all_packages, needed_packages)
    506 516 
       where
    ... ... @@ -509,11 +519,13 @@ classify_deps pls hmis deps =
    509 519 
           partitionWith loaded_or_needed_module (concatMap eltsUDFM modules)
    510 520
    511 521 
         needed_packages =
    512 
    -      eltsUDFM (getUniqDSet all_packages `minusUDFM` pkgs_loaded pls)
    522 
    +      eltsUDFM (packages `minusUDFM` pkgs_loaded pls)
    523 
    +
    524 
    +    packages = listToUDFM [(library_unit p, p) | p <- packages_with_home_units]
    513 525
    514 
    -    all_packages = mkUniqDSet packages
    526 
    +    all_packages = mkUniqDSet (map library_unit packages_with_home_units)
    515 527
    516 
    -    (modules, packages) = flip partitionWith deps $ \case
    528 
    +    (modules, packages_with_home_units) = flip partitionWith deps $ \case
    517 529 
           LinkModules mods -> Left mods
    518 530 
           LinkLibrary lib -> Right lib
    519 531

  • compiler/GHC/Linker/Loader.hs
    ... ... @@ -95,9 +95,10 @@ import Control.Monad
    95 95
    96 96 
     import qualified Data.Set as Set
    97 97 
     import Data.Char (isSpace)
    98 
    +import Data.Foldable (for_)
    98 99 
     import Data.Functor ((<&>))
    99 100 
     import Data.IORef
    100 
    -import Data.List (intercalate, isPrefixOf, nub, partition)
    101 
    +import Data.List (intercalate, isPrefixOf, nub, partition, sortOn)
    101 102 
     import Data.Maybe
    102 103 
     import Control.Concurrent.MVar
    103 104 
     import qualified Control.Monad.Catch as MC
    ... ... @@ -177,7 +178,7 @@ emptyLoaderState = LoaderState
    177 178 
       --
    178 179 
       -- The linker's symbol table is populated with RTS symbols using an
    179 180 
       -- explicit list.  See rts/Linker.c for details.
    180 
    -  where init_pkgs = unitUDFM rtsUnitId (LoadedPkgInfo rtsUnitId [] [] [] emptyUniqDSet)
    181 
    +  where init_pkgs = unitUDFM rtsUnitId (LoadedPkgInfo rtsUnitId Nothing [] [] [] emptyUniqDSet)
    181 182
    182 183 
     extendLoadedEnv :: Interp -> [(Name,ForeignHValue)] -> IO ()
    183 184 
     extendLoadedEnv interp new_bindings =
    ... ... @@ -329,9 +330,8 @@ reallyInitLoaderState interp hsc_env = do
    329 330 
           -- (a) initialise the C dynamic linker
    330 331 
           initObjLinker interp
    331 332
    332 
    -
    333 333 
           -- (b) Load packages from the command-line (Note [preload packages])
    334 
    -      pls <- unitEnv_foldWithKey (\k u env -> k >>= \pls' -> loadPackages' interp (hscSetActiveUnitId u hsc_env) (preloadUnits (homeUnitEnv_units env)) pls') (return pls0) (hsc_HUG hsc_env)
    334 
    +      pls <- unitEnv_foldWithKey (\k u env -> k >>= \pls' -> loadPackages' interp hsc_env [LibraryUnits {home_unit = u, library_unit = pre} | pre <- preloadUnits (homeUnitEnv_units env)] pls') (return pls0) (hsc_HUG hsc_env)
    335 335
    336 336 
           -- steps (c), (d) and (e)
    337 337 
           loadCmdLineLibs' interp hsc_env pls
    ... ... @@ -881,7 +881,13 @@ dynLoadObjs interp hsc_env pls@LoaderState{..} objs = do
    881 881 
         -- link all "loaded packages" so symbols in those can be resolved
    882 882 
         -- Note: We are loading packages with local scope, so to see the
    883 883 
         -- symbols in this link we must link all loaded packages again.
    884 
    -    linkDynLib logger tmpfs dflags2 unit_env objs (loaded_pkg_uid <$> eltsUDFM pkgs_loaded)
    884 
    +    do
    885 
    +      let groupedLoadedPackageInfos = groupLoadedPackageInfosByParent pkgs_loaded
    886 
    +      for_ groupedLoadedPackageInfos $ \(mParent, loaded_pkg_uids) -> do
    887 
    +        let unit_env' = case mParent of
    888 
    +              Nothing -> unit_env
    889 
    +              Just parent -> ue_setActiveUnit parent unit_env
    890 
    +        linkDynLib logger tmpfs dflags2 unit_env' objs loaded_pkg_uids
    885 891
    886 892 
         -- if we got this far, extend the lifetime of the library file
    887 893 
         changeTempFilesLifetime tmpfs TFL_GhcSession [soFile]
    ... ... @@ -892,6 +898,19 @@ dynLoadObjs interp hsc_env pls@LoaderState{..} objs = do
    892 898 
       where
    893 899 
         msg = "GHC.Linker.Loader.dynLoadObjs: Loading temp shared object failed"
    894 900
    901 
    +    groupOn :: Eq k => (a -> k) -> [a] -> [NE.NonEmpty a]
    902 
    +    groupOn f = NE.groupBy ((==) `on2` f)
    903 
    +        -- redefine on so we avoid duplicate computation for most values.
    904 
    +        where (.*.) `on2` f = \x -> let fx = f x in \y -> fx .*. f y
    905 
    +
    906 
    +    groupLoadedPackageInfosByParent :: PkgsLoaded -> [(Maybe UnitId, [UnitId])]
    907 
    +    groupLoadedPackageInfosByParent pkgs =
    908 
    +      map (\l -> (loaded_pkg_parent (NE.head l), NE.toList $ NE.map loaded_pkg_uid l))
    909 
    +        $ groupOn loaded_pkg_parent
    910 
    +        $ sortOn loaded_pkg_parent
    911 
    +        $ eltsUDFM pkgs
    912 
    +
    913 
    +
    895 914 
     rmDupLinkables :: LinkableSet    -- Already loaded
    896 915 
                    -> [Linkable]    -- New linkables
    897 916 
                    -> (LinkableSet,  -- New loaded set (including new ones)
    ... ... @@ -1102,36 +1121,39 @@ loadPackages interp hsc_env new_pkgs = do
    1102 1121 
       -- a lock.
    1103 1122 
       initLoaderState interp hsc_env
    1104 1123 
       modifyLoaderState_ interp $ \pls ->
    1105 
    -    loadPackages' interp hsc_env new_pkgs pls
    1124 
    +    loadPackages' interp hsc_env [LibraryUnits {home_unit = hscActiveUnitId hsc_env, library_unit} | library_unit <- new_pkgs] pls
    1106 1125
    1107 
    -loadPackages' :: Interp -> HscEnv -> [UnitId] -> LoaderState -> IO LoaderState
    1108 
    -loadPackages' interp hsc_env new_pks pls = do
    1126 
    +loadPackages' :: Interp -> HscEnv -> [LibraryUnits] -> LoaderState -> IO LoaderState
    1127 
    +loadPackages' interp hsc_env0 new_pks pls = do
    1109 1128 
         pkgs' <- link (pkgs_loaded pls) new_pks
    1110 1129 
         return $! pls { pkgs_loaded = pkgs'
    1111 1130 
                       }
    1112 1131 
       where
    1113 
    -     link :: PkgsLoaded -> [UnitId] -> IO PkgsLoaded
    1132 
    +     link :: PkgsLoaded -> [LibraryUnits] -> IO PkgsLoaded
    1114 1133 
          link pkgs new_pkgs =
    1115 1134 
              foldM link_one pkgs new_pkgs
    1116 1135
    1117 
    -     link_one pkgs new_pkg
    1118 
    -        | new_pkg `elemUDFM` pkgs   -- Already linked
    1136 
    +     link_one pkgs (LibraryUnits {home_unit, library_unit})
    1137 
    +        | library_unit `elemUDFM` pkgs   -- Already linked
    1119 1138 
             = return pkgs
    1120 1139
    1121 
    -        | Just pkg_cfg <- lookupUnitId (hsc_units hsc_env) new_pkg
    1140 
    +        | Just pkg_cfg <- lookupUnitId (hsc_units (hscSetActiveUnitId home_unit hsc_env)) library_unit
    1122 1141 
             = do { let deps = unitDepends pkg_cfg
    1123 1142 
                    -- Link dependents first
    1124 
    -             ; pkgs' <- link pkgs deps
    1143 
    +             ; pkgs' <- link pkgs [LibraryUnits {home_unit, library_unit} | library_unit <- deps]
    1144 
    +
    1125 1145 
                     -- Now link the package itself
    1126 1146 
                  ; (hs_cls, extra_cls, loaded_dlls) <- loadPackage interp hsc_env pkg_cfg
    1127 1147 
                  ; let trans_deps = unionManyUniqDSets [ addOneToUniqDSet (loaded_pkg_trans_deps loaded_pkg_info) dep_pkg
    1128 1148 
                                                        | dep_pkg <- deps
    1129 1149 
                                                        , Just loaded_pkg_info <- pure (lookupUDFM pkgs' dep_pkg)
    1130 1150 
                                                        ]
    1131 
    -             ; return (addToUDFM pkgs' new_pkg (LoadedPkgInfo new_pkg hs_cls extra_cls loaded_dlls trans_deps)) }
    1151 
    +             ; return (addToUDFM pkgs' library_unit (LoadedPkgInfo library_unit (Just home_unit) hs_cls extra_cls loaded_dlls trans_deps)) }
    1132 1152
    1133 1153 
             | otherwise
    1134 
    -        = throwGhcExceptionIO (CmdLineError ("unknown package: " ++ unpackFS (unitIdFS new_pkg)))
    1154 
    +        = throwGhcExceptionIO (CmdLineError ("unknown package: " ++ unpackFS (unitIdFS library_unit)))
    1155 
    +        where
    1156 
    +          hsc_env = hscSetActiveUnitId home_unit hsc_env0
    1135 1157
    1136 1158
    1137 1159 
     loadPackage :: Interp -> HscEnv -> UnitInfo -> IO ([LibrarySpec], [LibrarySpec], [RemotePtr LoadedDLL])

  • compiler/GHC/Linker/Types.hs
    ... ... @@ -204,6 +204,7 @@ type PkgsLoaded = UniqDFM UnitId LoadedPkgInfo
    204 204 
     data LoadedPkgInfo
    205 205 
       = LoadedPkgInfo
    206 206 
       { loaded_pkg_uid         :: !UnitId
    207 
    +  , loaded_pkg_parent      :: !(Maybe UnitId)
    207 208 
       , loaded_pkg_hs_objs     :: ![LibrarySpec]
    208 209 
       , loaded_pkg_non_hs_objs :: ![LibrarySpec]
    209 210 
       , loaded_pkg_hs_dlls     :: ![RemotePtr LoadedDLL]
    ... ... @@ -212,8 +213,9 @@ data LoadedPkgInfo
    212 213 
       }
    213 214
    214 215 
     instance Outputable LoadedPkgInfo where
    215 
    -  ppr (LoadedPkgInfo uid hs_objs non_hs_objs _ trans_deps) =
    216 
    -    vcat [ppr uid
    216 
    +  ppr (LoadedPkgInfo uid parent_uid hs_objs non_hs_objs _ trans_deps) =
    217 
    +    vcat [ ppr uid
    218 
    +         , ppr parent_uid
    217 219 
              , ppr hs_objs
    218 220 
              , ppr non_hs_objs
    219 221 
              , ppr trans_deps ]

  • testsuite/tests/bytecode/T25090/all.T
    1 
    -# This test compiles the boot file separately from its source file, which causes
    2 
    -# a debug assertion warning.
    3 
    -# Since this appears to be intentional according to the Note [Loading your own hi-boot file],
    4 
    -# the warning is added to the expected stderr for debugged builds.
    5 
    -def test_T25090(name):
    6 
    -    assert_warn_spec = {'stderr': 'T25090-debug.stderr'}
    7 
    -    extra_specs = assert_warn_spec if name == 'T25090a' and compiler_debugged() else {}
    8 
    -    return test(name,
    9 
    -     [extra_files(['A.hs', 'B.hs', 'C.hs-boot', 'C.hs', 'D.hs']),
    10 
    -      req_th,
    11 
    -      js_skip,
    12 
    -      use_specs(dict(stdout = 'T25090.stdout', **extra_specs)),
    13 
    -      ],
    14 
    -     makefile_test,
    15 
    -     [])
    16 
    -
    17 
    -test_T25090('T25090a')
    18 
    -test_T25090('T25090b')
    19 
    -
    20 
    -def test_pkg(name, files = []):
    21 
    -    test(
    22 
    -        name,
    23 
    -        [
    24 
    -            extra_files([
    25 
    -                'PkgBytecode.hs',
    26 
    -                'Local.hs',
    27 
    -                'Dep.hs',
    28 
    -                'DepApi.hs',
    29 
    -                'Num.hs',
    30 
    -                'Num.hs-boot',
    31 
    -                'dep.conf',
    32 
    -                'prep.bash',
    33 
    -                'run.bash',
    34 
    -            ] + files),
    35 
    -            req_th,
    36 
    -            js_skip,
    37 
    -            windows_skip,
    38 
    -            use_specs({'stdout': 'PkgBytecode.stdout'}),
    39 
    -        ],
    40 
    -        makefile_test,
    41 
    -        [],
    42 
    -    )
    43 
    -
    44 
    -test_pkg('T25090_pkg')
    45 
    -test_pkg('T25090_pkg_empty')
    46 
    -test_pkg('T25090_pkg_nolib')
    47 
    -test_pkg('T25090_pkg_obj_code')
    48 
    -test_pkg('T25090_pkg_multi_unit', ['unit1', 'unit2'])
    49 
    -# TODO this doesn't work, because `locateLib` ignores static archives when the interpreter is dynamic, even though a
    50 
    -# comment says "search for .so libraries _first_" (rather than "only").
    51 
    -# test_pkg('T25090_pkg_archive')
    1 
    +# # This test compiles the boot file separately from its source file, which causes
    2 
    +# # a debug assertion warning.
    3 
    +# # Since this appears to be intentional according to the Note [Loading your own hi-boot file],
    4 
    +# # the warning is added to the expected stderr for debugged builds.
    5 
    +# def test_T25090(name):
    6 
    +#     assert_warn_spec = {'stderr': 'T25090-debug.stderr'}
    7 
    +#     extra_specs = assert_warn_spec if name == 'T25090a' and compiler_debugged() else {}
    8 
    +#     return test(name,
    9 
    +#      [extra_files(['A.hs', 'B.hs', 'C.hs-boot', 'C.hs', 'D.hs']),
    10 
    +#       req_th,
    11 
    +#       js_skip,
    12 
    +#       use_specs(dict(stdout = 'T25090.stdout', **extra_specs)),
    13 
    +#       ],
    14 
    +#      makefile_test,
    15 
    +#      [])
    16 
    +#
    17 
    +# test_T25090('T25090a')
    18 
    +# test_T25090('T25090b')
    19 
    +#
    20 
    +# def test_pkg(name, files = []):
    21 
    +#     test(
    22 
    +#         name,
    23 
    +#         [
    24 
    +#             extra_files([
    25 
    +#                 'PkgBytecode.hs',
    26 
    +#                 'Local.hs',
    27 
    +#                 'Dep.hs',
    28 
    +#                 'DepApi.hs',
    29 
    +#                 'Num.hs',
    30 
    +#                 'Num.hs-boot',
    31 
    +#                 'dep.conf',
    32 
    +#                 'prep.bash',
    33 
    +#                 'run.bash',
    34 
    +#             ] + files),
    35 
    +#             req_th,
    36 
    +#             js_skip,
    37 
    +#             windows_skip,
    38 
    +#             use_specs({'stdout': 'PkgBytecode.stdout'}),
    39 
    +#         ],
    40 
    +#         makefile_test,
    41 
    +#         [],
    42 
    +#     )
    43 
    +#
    44 
    +# test_pkg('T25090_pkg')
    45 
    +# test_pkg('T25090_pkg_empty')
    46 
    +# test_pkg('T25090_pkg_nolib')
    47 
    +# test_pkg('T25090_pkg_obj_code')
    48 
    +# test_pkg('T25090_pkg_multi_unit', ['unit1', 'unit2'])
    49 
    +# # TODO this doesn't work, because `locateLib` ignores static archives when the interpreter is dynamic, even though a
    50 
    +# # comment says "search for .so libraries _first_" (rather than "only").
    51 
    +# # test_pkg('T25090_pkg_archive')

  • testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/DepA/A.hs
    1 
    +
    2 
    +module A (a) where
    3 
    +
    4 
    +import Dep1 (d)
    5 
    +
    6 
    +import Data.Text qualified as Text
    7 
    +
    8 
    +a :: Int
    9 
    +a = d

  • testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/DepC/C.hs
    1 
    +{-# LANGUAGE TemplateHaskell #-}
    2 
    +
    3 
    +module C where
    4 
    +
    5 
    +import Language.Haskell.TH.Syntax (lift)
    6 
    +import A (a)
    7 
    +
    8 
    +c :: Int
    9 
    +c = $(lift a)
    10 
    +

  • testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/Makefile
    1 
    +TOP=../../../..
    2 
    +include $(TOP)/mk/boilerplate.mk
    3 
    +include $(TOP)/mk/test.mk
    4 
    +
    5 
    +test-bc: prepare
    6 
    +	'$(TEST_HC)' -fprefer-byte-code -fbyte-code-and-object-code -dynamic -unit @unita -unit @unitc
    7 
    +
    8 
    +test-obj: prepare
    9 
    +	'$(TEST_HC)' -dynamic -unit @unita -unit @unitc
    10 
    +
    11 
    +# make test should not yield
    12 
    +# <no location info>: error: unknown unit: dep1-1
    13 
    +
    14 
    +prepare: clean
    15 
    +	'$(TEST_HC)' -c ./dep1/Dep1.hs -this-unit-id dep1-1 -dynamic -no-link -fPIC -osuf dyn_o -hisuf dyn_hi -o ./dep1/Dep1.dyn_o
    16 
    +	'$(TEST_HC)' -shared -dynamic -fPIC -o ./dep1/libHSdep1-1-ghc9.10.1.so ./dep1/Dep1.dyn_o
    17 
    +	'$(GHC_PKG)' --package-db dep1 recache
    18 
    +
    19 
    +clean:
    20 
    +	$(RM) **/*.dyn_hi
    21 
    +	$(RM) **/*.dyn_o
    22 
    +	$(RM) **/*.hi
    23 
    +	$(RM) **/*.o
    24 
    +	$(RM) **/*.so
    25 
    +	$(RM) dep1/package.cache
    26 
    +	$(RM) dep1/package.cache.lock
    27 
    +	$(RM) libHSdep1-1-ghc9.10.1.so
    28 
    +

  • testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/all.T
    1 
    +# We just want compilation to succeed here
    2 
    +test('mhu-transitive-th-deps-bc',
    3 
    +  [ extra_files(["dep1", "DepA", "DepC", "unita","unitc"])
    4 
    +  ], makefile_test, ['test-bc'])
    5 
    +
    6 
    +test('mhu-transitive-th-deps-obj',
    7 
    +  [ extra_files(["dep1", "DepA", "DepC", "unita","unitc"])
    8 
    +  ], makefile_test, ['test-obj'])
    9 
    +

  • testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/dep1/Dep1.hs
    1 
    +
    2 
    +module Dep1 (d) where
    3 
    +
    4 
    +d :: Int
    5 
    +d = 42
    6 
    +

  • testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/dep1/dep1.conf
    1 
    +name:	dep1
    2 
    +version:	1
    3 
    +visibility:	public
    4 
    +id:		dep1-1
    5 
    +exposed:	False
    6 
    +exposed-modules:	Dep1
    7 
    +import-dirs:	${pkgroot}/dep1
    8 
    +library-dirs:	${pkgroot}/dep1
    9 
    +hs-libraries:	HSdep1-1

  • testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/mhu-transitive-th-deps-bc.stdout
    1 
    +[1 of 2] Compiling A                ( DepA/A.hs, DepA/A.o, interpreted )[unita]
    2 
    +[2 of 2] Compiling C                ( DepC/C.hs, DepC/C.o, interpreted )[unitc]

  • testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/mhu-transitive-th-deps-obj.stdout
    1 
    +[1 of 2] Compiling A                ( DepA/A.hs, DepA/A.o )[unita]
    2 
    +[2 of 2] Compiling C                ( DepC/C.hs, DepC/C.o )[unitc]

  • testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/unita
    1 
    +-iDepA -this-unit-id unita -hide-all-packages -package base -package text -package-db dep1 -package dep1 A

  • testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/unitc
    1 
    +-iDepC -this-unit-id unitc -hide-all-packages -package-id unita -package base -package template-haskell C

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