Sven Tennie pushed to branch wip/supersven/libDir-setting at Glasgow Haskell Compiler / GHC

Commits:

12 changed files:

Changes:

  • changelog.d/libdir-setting
    1 
    +section: packaging
    2 
    +synopsis: Added a new optional configuration setting for `LibDir` to support inplace
    3 
    +  stage2 cross-compilers where binaries and libraries are in different stage
    4 
    +  directories.
    5 
    +issues: #19174
    6 
    +mrs: !15716
    7 
    +
    8 
    +description: {
    9 
    +  Previously, `libDir` was always derived from `topDir`, which does not work
    10 
    +  for inplace stage2 cross-compilers where executables live in `_build/stage1/`
    11 
    +  but libraries live in `_build/stage2/`. A new optional `LibDir` setting in the
    12 
    +  `settings` file allows overriding this. When absent (e.g. in bindists),
    13 
    +  `libDir` defaults to `topDir`, preserving relocatability.
    14 
    +
    15 
    +  The global package database path is now resolved relative to `libDir`
    16 
    +  (which may differ from `topDir` when `LibDir` is set). This affects inplace
    17 
    +  cross-compiler builds but is transparent to normal and bindist builds.
    18 
    +}

  • compiler/GHC/Driver/Config/Interpreter.hs
    ... ... @@ -17,8 +17,8 @@ import System.Directory
    17 17
    18 18 
     initInterpOpts :: DynFlags -> IO InterpOpts
    19 19 
     initInterpOpts dflags = do
    20 
    -  wasm_dyld <- makeAbsolute $ topDir dflags </> "dyld.mjs"
    21 
    -  js_interp <- makeAbsolute $ topDir dflags </> "ghc-interp.js"
    20 
    +  wasm_dyld <- makeAbsolute $ libDir dflags </> "dyld.mjs"
    21 
    +  js_interp <- makeAbsolute $ libDir dflags </> "ghc-interp.js"
    22 22 
       pure $ InterpOpts
    23 23 
         { interpExternal = gopt Opt_ExternalInterpreter dflags
    24 24 
         , interpProg = pgm_i dflags

  • compiler/GHC/Driver/DynFlags.hs
    ... ... @@ -61,7 +61,7 @@ module GHC.Driver.DynFlags (
    61 61
    62 62 
             -- ** System tool settings and locations
    63 63 
             programName, projectVersion,
    64 
    -        ghcUsagePath, ghciUsagePath, topDir, toolDir,
    64 
    +        ghcUsagePath, ghciUsagePath, topDir, libDir, toolDir,
    65 65 
             versionedAppDir, versionedFilePath,
    66 66 
             extraGccViaCFlags, globalPackageDatabasePath,
    67 67
    ... ... @@ -1516,6 +1516,8 @@ ghciUsagePath :: DynFlags -> FilePath
    1516 1516 
     ghciUsagePath dflags = fileSettings_ghciUsagePath $ fileSettings dflags
    1517 1517 
     topDir                :: DynFlags -> FilePath
    1518 1518 
     topDir dflags = fileSettings_topDir $ fileSettings dflags
    1519 
    +libDir                :: DynFlags -> FilePath
    1520 
    +libDir dflags = fileSettings_libDir $ fileSettings dflags
    1519 1521 
     toolDir               :: DynFlags -> Maybe FilePath
    1520 1522 
     toolDir dflags = fileSettings_toolDir $ fileSettings dflags
    1521 1523 
     extraGccViaCFlags     :: DynFlags -> [String]

  • compiler/GHC/Driver/Session.hs
    ... ... @@ -3551,9 +3551,9 @@ compilerInfo dflags
    3551 3551 
           ("Project name",                 cProjectName)
    3552 3552 
           -- Next come the settings, so anything else can be overridden
    3553 3553 
           -- in the settings file (as "lookup" uses the first match for the
    3554 
    -      -- key)
    3554 
    +      -- key). We filter out LibDir from rawSettings to avoid duplication.
    3555 3555 
          : map (fmap expandDirectories)
    3556 
    -           (rawSettings dflags)
    3556 
    +           (filter ((/= "LibDir") . fst) (rawSettings dflags))
    3557 3557 
          ++
    3558 3558 
           [("C compiler command", queryCmd $ ccProgram . tgtCCompiler),
    3559 3559 
            ("C compiler flags", queryFlags $ ccProgram . tgtCCompiler),
    ... ... @@ -3656,7 +3656,7 @@ compilerInfo dflags
    3656 3656 
            -- Whether or not GHC was compiled using -prof
    3657 3657 
            ("GHC Profiled",                showBool hostIsProfiled),
    3658 3658 
            ("Debug on",                    showBool debugIsOn),
    3659 
    -       ("LibDir",                      topDir dflags),
    3659 
    +       ("LibDir",                      libDir dflags),
    3660 3660 
            -- This is always an absolute path, unlike "Relative Global Package DB" which is
    3661 3661 
            -- in the settings file.
    3662 3662 
            ("Global Package DB",           globalPackageDatabasePath dflags)

  • compiler/GHC/Settings.hs
    ... ... @@ -179,11 +179,24 @@ data ToolSettings = ToolSettings
    179 179 
     -- | Paths to various files and directories used by GHC, including those that
    180 180 
     -- provide more settings.
    181 181 
     data FileSettings = FileSettings
    182 
    -  { fileSettings_ghcUsagePath          :: FilePath       -- ditto
    183 
    -  , fileSettings_ghciUsagePath         :: FilePath       -- ditto
    184 
    -  , fileSettings_toolDir               :: Maybe FilePath -- ditto
    185 
    -  , fileSettings_topDir                :: FilePath       -- ditto
    182 
    +  { fileSettings_ghcUsagePath          :: FilePath
    183 
    +    -- ^ Path to @ghc-usage.txt@, displayed by @ghc --help@
    184 
    +  , fileSettings_ghciUsagePath         :: FilePath
    185 
    +    -- ^ Path to @ghci-usage.txt@, displayed by @ghci --help@
    186 
    +  , fileSettings_toolDir               :: Maybe FilePath
    187 
    +    -- ^ Directory containing the mingw toolchain (Windows only);
    188 
    +    -- see Note [tooldir: How GHC finds mingw on Windows] in `GHC.SysTools.BaseDir`
    189 
    +  , fileSettings_topDir                :: FilePath
    190 
    +    -- ^ GHC's top directory: the root from which GHC locates its support files
    191 
    +    -- (e.g. settings).
    192 
    +    -- See Note [topdir: How GHC finds its files] in `GHC.SysTools.BaseDir`
    186 193 
       , fileSettings_globalPackageDatabase :: FilePath
    194 
    +    -- ^ Path to the global package database, relative to `libDir`
    195 
    +  , fileSettings_libDir                :: FilePath
    196 
    +    -- ^ Directory containing GHC's library packages and the global package
    197 
    +    -- database. Defaults to 'fileSettings_topDir' but can differ in inplace
    198 
    +    -- builds used for cross-compilation testing (the "stage2 cross-compiler"
    199 
    +    -- scenario).
    187 200 
       }
    188 201
    189 202

  • compiler/GHC/Settings/IO.hs
    ... ... @@ -28,6 +28,7 @@ import GHC.Toolchain.Program
    28 28 
     import GHC.Toolchain
    29 29 
     import GHC.Data.Maybe
    30 30 
     import Data.Bifunctor (Bifunctor(second))
    31 
    +import Data.Either (fromRight)
    31 32
    32 33 
     data SettingsError
    33 34 
       = SettingsError_MissingData String
    ... ... @@ -117,12 +118,6 @@ initSettings top_dir = do
    117 118 
                               then ["-fwrapv", "-fno-builtin"]
    118 119 
                               else []
    119 120
    120 
    -  -- The package database is either a relative path to the location of the settings file
    121 
    -  -- OR an absolute path.
    122 
    -  -- In case the path is absolute then top_dir </> abs_path == abs_path
    123 
    -  --         the path is relative then top_dir </> rel_path == top_dir </> rel_path
    124 
    -  globalpkgdb_path <- installed <$> getSetting "Relative Global Package DB"
    125 
    -
    126 121 
       let ghc_usage_msg_path  = installed "ghc-usage.txt"
    127 122 
           ghci_usage_msg_path = installed "ghci-usage.txt"
    128 123
    ... ... @@ -148,6 +143,19 @@ initSettings top_dir = do
    148 143
    149 144 
       baseUnitId <- getSetting_raw "base unit-id"
    150 145
    146 
    +  -- LibDir is optional. If not set, derive it from topDir. This allows
    147 
    +  -- bindists to work without explicitly setting LibDir, but gives us the
    148 
    +  -- option to override it for inplace test compilers (the "stage2
    149 
    +  -- cross-compiler" scenario). If LibDir is a relative path, it is
    150 
    +  -- interpreted relative to topDir.
    151 
    +  let lib_dir = installed $ fromRight "." $
    152 
    +                  getRawFilePathSetting top_dir settingsFile mySettings "LibDir"
    153 
    +
    154 
    +  -- The package database is either a relative path to lib_dir OR an absolute path.
    155 
    +  -- In case the path is absolute then lib_dir </> abs_path == abs_path
    156 
    +  --         the path is relative then lib_dir </> rel_path == lib_dir </> rel_path
    157 
    +  globalpkgdb_path <- (lib_dir </>) <$> getSetting "Relative Global Package DB"
    158 
    +
    151 159 
       return $ Settings
    152 160 
         { sGhcNameVersion = GhcNameVersion
    153 161 
           { ghcNameVersion_programName = "ghc"
    ... ... @@ -159,6 +167,7 @@ initSettings top_dir = do
    159 167 
           , fileSettings_ghciUsagePath  = ghci_usage_msg_path
    160 168 
           , fileSettings_toolDir        = mtool_dir
    161 169 
           , fileSettings_topDir         = top_dir
    170 
    +      , fileSettings_libDir         = lib_dir
    162 171 
           , fileSettings_globalPackageDatabase = globalpkgdb_path
    163 172 
           }
    164 173

  • hadrian/src/Rules/BinaryDist.hs
    ... ... @@ -14,6 +14,7 @@ import qualified System.Directory.Extra as IO
    14 14 
     import Data.Either
    15 15 
     import qualified Data.Set as Set
    16 16 
     import Oracles.Flavour
    17 
    +import Rules.Generate (generateSettings)
    17 18
    18 19 
     {-
    19 20 
     Note [Binary distributions]
    ... ... @@ -218,6 +219,17 @@ bindistRules = do
    218 219 
                       IO.createFileLink version_prog versioned_runhaskell_path
    219 220
    220 221 
             copyDirectory (ghcBuildDir -/- "lib") bindistFilesDir
    222 
    +
    223 
    +      -- Regenerate settings file without LibDir. For bindists, LibDir should
    224 
    +      -- be derived from topdir at runtime such that the GHC binary is
    225 
    +      -- relocatable. The package DB is always at "package.conf.d" relative to
    226 
    +      -- the lib dir, matching the known bindist layout.
    227 
    +        let bindistSettings = bindistFilesDir -/- "lib" -/- "settings"
    228 
    +            bindistContext = vanillaContext Stage1 compiler
    229 
    +        bindistSettingsContent <- interpretInContext bindistContext $
    230 
    +            generateSettings bindistSettings False "package.conf.d"
    231 
    +        writeFile' bindistSettings bindistSettingsContent
    232 
    +
    221 233 
             copyDirectory (rtsIncludeDir)         bindistFilesDir
    222 234 
             when windowsHost $ createGhcii (bindistFilesDir -/- "bin")
    223 235

  • hadrian/src/Rules/Generate.hs
    1 1 
     module Rules.Generate (
    2 2 
         isGeneratedCmmFile, compilerDependencies, generatePackageCode,
    3 3 
         generateRules, copyRules, generatedDependencies,
    4 
    -    templateRules
    4 
    +    templateRules, generateSettings
    5 5 
         ) where
    6 6
    7 7 
     import Development.Shake.FilePath
    ... ... @@ -256,8 +256,21 @@ generateRules = do
    256 256
    257 257 
         forM_ allStages $ \stage -> do
    258 258 
             let prefix = root -/- stageString stage -/- "lib"
    259 
    -            go gen file = generate file (semiEmptyTarget (succStage stage)) gen
    260 
    -        (prefix -/- "settings") %> \out -> go (generateSettings out) out
    259 
    +            -- Stage0 compiler builds Stage1, Stage1 -> Stage2, etc.
    260 
    +            buildStage = succStage stage
    261 
    +            go gen file = generate file (semiEmptyTarget buildStage) gen
    262 
    +        (prefix -/- "settings") %> \out -> do
    263 
    +            let get_pkg_db stg = packageDbPath (PackageDbLoc stg Final)
    264 
    +            pkgDb <- case buildStage of
    265 
    +                Stage0 {} -> error "Unable to generate settings for stage0. This should never be reached."
    266 
    +                Stage1 -> get_pkg_db Stage1
    267 
    +                Stage2 -> get_pkg_db Stage1
    268 
    +                Stage3 -> get_pkg_db Stage2
    269 
    +            -- addTrailingPathSeparator needed: makeRelativeNoSysLink uses
    270 
    +            -- splitPath where "lib" and "lib/" are distinct components.
    271 
    +            let lib_topDir = addTrailingPathSeparator prefix
    272 
    +                relPkgDb = makeRelativeNoSysLink lib_topDir pkgDb
    273 
    +            go (generateSettings out True relPkgDb) out
    261 274 
             (prefix -/- "targets" -/- "default.target") %> \out -> go (show <$> expr getTargetTarget) out
    262 275
    263 276 
       where
    ... ... @@ -460,19 +473,17 @@ ghcWrapper stage = do
    460 473 
         return $ unwords $ map show $ [ ghcPath ]
    461 474 
                                    ++ [ "$@" ]
    462 475
    463 
    -generateSettings :: FilePath -> Expr String
    464 
    -generateSettings settingsFile = do
    476 
    +-- | Generate settings file, optionally including @LibDir@.
    477 
    +--
    478 
    +-- @rel_pkg_db@: package DB path relative to the lib dir (e.g.
    479 
    +-- "package.conf.d"). Callers supply the correct relative path. For bindists
    480 
    +-- the layout is known statically; for in-tree builds callers compute it. For
    481 
    +-- bindists, we omit @LibDir@ so it defaults to @topDir@ at runtime.
    482 
    +generateSettings :: FilePath -> Bool -> FilePath -> Expr String
    483 
    +generateSettings settingsFile includeLibDir rel_pkg_db = do
    465 484 
         ctx <- getContext
    466 485 
         stage <- getStage
    467 486
    468 
    -    package_db_path <- expr $ do
    469 
    -      let get_pkg_db stg = packageDbPath (PackageDbLoc stg Final)
    470 
    -      case stage of
    471 
    -        Stage0 {} -> error "Unable to generate settings for stage0"
    472 
    -        Stage1 -> get_pkg_db Stage1
    473 
    -        Stage2 -> get_pkg_db Stage1
    474 
    -        Stage3 -> get_pkg_db Stage2
    475 
    -
    476 487 
         -- The unit-id of the base package which is always linked against (#25382)
    477 488 
         base_unit_id <- expr $ do
    478 489 
           case stage of
    ... ... @@ -481,15 +492,24 @@ generateSettings settingsFile = do
    481 492 
             Stage2 -> pkgUnitId Stage1 base
    482 493 
             Stage3 -> pkgUnitId Stage2 base
    483 494
    484 
    -    let rel_pkg_db = makeRelativeNoSysLink (dropFileName settingsFile) package_db_path
    495 
    +    let -- E.g. the Stage2 compiler lives in _build/stage1
    496 
    +        -- So, we need to decrement the stage to get the correct directory
    497 
    +        stage_dir_stage = predStage stage
    498 
    +
    499 
    +    -- addTrailingPathSeparator is needed because makeRelativeNoSysLink uses
    500 
    +    -- splitPath internally, where "lib" and "lib/" are distinct components.
    501 
    +    lib_topDir :: FilePath <- expr $ addTrailingPathSeparator <$> stageLibPath stage_dir_stage
    502 
    +    let rel_lib_topDir = makeRelativeNoSysLink (dropFileName settingsFile) lib_topDir
    485 503
    486 504 
         settings <- traverse sequence $
    487 
    -        [ ("unlit command", ("$topdir/../bin/" <>) <$> expr (programName (ctx { Context.package = unlit })))
    488 
    -        , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter (predStage stage))
    489 
    -        , ("RTS ways", escapeArgs . map show . Set.toList <$> getRtsWays)
    490 
    -        , ("Relative Global Package DB", pure rel_pkg_db)
    491 
    -        , ("base unit-id", pure base_unit_id)
    492 
    -        ]
    505 
    +          [ ("unlit command", ("$topdir/../bin/" <>) <$> expr (programName (ctx { Context.package = unlit })))
    506 
    +          , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter (predStage stage))
    507 
    +          , ("RTS ways", escapeArgs . map show . Set.toList <$> getRtsWays)
    508 
    +          , ("Relative Global Package DB", pure rel_pkg_db)
    509 
    +          , ("base unit-id", pure base_unit_id)
    510 
    +          ]
    511 
    +          ++ ([("LibDir", pure rel_lib_topDir) | includeLibDir])
    512 
    +
    493 513 
         let showTuple (k, v) = "(" ++ show k ++ ", " ++ show v ++ ")"
    494 514 
         pure $ case settings of
    495 515 
             [] -> "[]"

  • libraries/ghc-boot/GHC/Settings/Utils.hs
    ... ... @@ -3,6 +3,7 @@ module GHC.Settings.Utils where
    3 3 
     import Prelude -- See Note [Why do we import Prelude here?]
    4 4
    5 5 
     import Data.Char (isSpace)
    6 
    +import Data.Either (fromRight)
    6 7 
     import Data.Map (Map)
    7 8 
     import qualified Data.Map as Map
    8 9
    ... ... @@ -45,7 +46,10 @@ getTargetArchOS target = tgtArchOs target
    45 46 
     getGlobalPackageDb :: FilePath -> RawSettings -> Either String FilePath
    46 47 
     getGlobalPackageDb settingsFile settings = do
    47 48 
       rel_db <- getRawSetting settingsFile settings "Relative Global Package DB"
    48 
    -  return (dropFileName settingsFile </> rel_db)
    49 
    +  let top_dir = dropFileName settingsFile
    50 
    +      lib_dir  = (top_dir </>) $ fromRight "." $
    51 
    +                   getRawFilePathSetting top_dir settingsFile settings "LibDir"
    52 
    +  return (lib_dir </> rel_db)
    49 53
    50 54 
     --------------------------------------------------------------------------------
    51 55 
     -- lib/settings

  • testsuite/tests/ghc-api/settings/LibDir.hs
    1 
    +module Main where
    2 
    +
    3 
    +import Control.Monad (when)
    4 
    +import Control.Monad.IO.Class (liftIO)
    5 
    +import Data.List (intercalate)
    6 
    +import GHC
    7 
    +import GHC.Driver.DynFlags
    8 
    +import GHC.Driver.Env (hsc_dflags)
    9 
    +import GHC.Settings
    10 
    +import System.Directory
    11 
    +import System.Environment
    12 
    +import System.Exit (ExitCode (ExitFailure), exitWith)
    13 
    +import System.FilePath
    14 
    +import System.IO (hPutStrLn, stderr)
    15 
    +import System.Process (readProcess)
    16 
    +import Unsafe.Coerce (unsafeCoerce)
    17 
    +
    18 
    +-- Verify that a LibDir setting in the settings file is respected:
    19 
    +--   1. fileSettings_libDir and fileSettings_globalPackageDatabase reflect the
    20 
    +--      configured LibDir path (not topDir)
    21 
    +--   2. GHC can still compile with a LibDir that differs from topDir
    22 
    +--   3. --print-libdir and --print-global-package-db output the correct paths
    23 
    +--
    24 
    +-- We create a symlink to the real lib dir so that the package DB remains
    25 
    +-- findable, but use a separate topDir so that topDir ≠ libDir, proving
    26 
    +-- the LibDir setting is actually used.
    27 
    +--
    28 
    +-- Tested for both relative and absolute LibDir values.
    29 
    +main :: IO ()
    30 
    +main = do
    31 
    +  libdir : ghcBin : _ <- getArgs
    32 
    +
    33 
    +  (rawSettingOpts, rawTargetOpts, realLibDir) <- runGhc (Just libdir) $ do
    34 
    +    dflags <- hsc_dflags <$> getSession
    35 
    +    pure (rawSettings dflags, rawTarget dflags, fileSettings_libDir (fileSettings dflags))
    36 
    +
    37 
    +  tmpDir <- getTemporaryDirectory
    38 
    +  let topDir = tmpDir </> "T19174_top"
    39 
    +      symlinkLib = tmpDir </> "T19174_lib"
    40 
    +  -- Remove stale dirs from prior runs; createDirectoryLink fails if path exists.
    41 
    +  removePathForcibly topDir
    42 
    +  removePathForcibly symlinkLib
    43 
    +  createDirectoryIfMissing True (topDir </> "targets")
    44 
    +  createDirectoryLink realLibDir symlinkLib
    45 
    +
    46 
    +  let testWithLibDir libDirValue = do
    47 
    +        writeTopDirFiles topDir rawSettingOpts rawTargetOpts libDirValue
    48 
    +        runGhc (Just topDir) $ do
    49 
    +          assertSettings topDir symlinkLib
    50 
    +          compileAndRunTestExpr
    51 
    +        assertGhcFlags ghcBin topDir symlinkLib
    52 
    +
    53 
    +  testWithLibDir (".." </> takeFileName symlinkLib)
    54 
    +  testWithLibDir symlinkLib
    55 
    +
    56 
    +  putStrLn "OK"
    57 
    +
    58 
    +writeTopDirFiles ::
    59 
    +  (Show a) =>
    60 
    +  FilePath ->
    61 
    +  [(String, String)] ->
    62 
    +  a ->
    63 
    +  String ->
    64 
    +  IO ()
    65 
    +writeTopDirFiles topDir rawSettingOpts rawTargetOpts libDirValue = do
    66 
    +  let settings = filter ((/= "LibDir") . fst) rawSettingOpts ++ [("LibDir", libDirValue)]
    67 
    +  writeFile (topDir </> "settings") $
    68 
    +    "[" ++ intercalate "\n," (map show settings) ++ "]"
    69 
    +  writeFile (topDir </> "targets" </> "default.target") $
    70 
    +    show rawTargetOpts
    71 
    +
    72 
    +assertSettings :: FilePath -> FilePath -> Ghc ()
    73 
    +assertSettings topDir expectedLib = do
    74 
    +  dflags <- hsc_dflags <$> getSession
    75 
    +  let fs = fileSettings dflags
    76 
    +      actualLib = fileSettings_libDir fs
    77 
    +      actualPkgDb = fileSettings_globalPackageDatabase fs
    78 
    +  normActualLib <- liftIO $ canonicalizePath actualLib
    79 
    +  normExpected <- liftIO $ canonicalizePath expectedLib
    80 
    +  normTopDir <- liftIO $ canonicalizePath topDir
    81 
    +  normActualPkgDb <- liftIO $ canonicalizePath actualPkgDb
    82 
    +  normExpectedPkgDb <- liftIO $ canonicalizePath (expectedLib </> "package.conf.d")
    83 
    +  liftIO $ do
    84 
    +    when (normActualLib /= normExpected) $
    85 
    +      die
    86 
    +        [ "FAIL: libDir should be " ++ normExpected,
    87 
    +          "             got       " ++ normActualLib
    88 
    +        ]
    89 
    +    when (normActualLib == normTopDir) $
    90 
    +      die ["FAIL: libDir equals topDir — LibDir setting was ignored"]
    91 
    +    when (normActualPkgDb /= normExpectedPkgDb) $
    92 
    +      die
    93 
    +        [ "FAIL: globalPackageDB should be " ++ normExpectedPkgDb,
    94 
    +          "                      got       " ++ normActualPkgDb
    95 
    +        ]
    96 
    +
    97 
    +assertGhcFlags :: FilePath -> FilePath -> FilePath -> IO ()
    98 
    +assertGhcFlags ghcBin topDir expectedLib = do
    99 
    +  normExpectedLib <- canonicalizePath expectedLib
    100 
    +  normExpectedPkgDb <- canonicalizePath (expectedLib </> "package.conf.d")
    101 
    +
    102 
    +  printedLibDir <- trim <$> readProcess ghcBin ["-B" ++ topDir, "--print-libdir"] ""
    103 
    +  normPrintedLib <- canonicalizePath printedLibDir
    104 
    +  when (normPrintedLib /= normExpectedLib) $
    105 
    +    die
    106 
    +      [ "FAIL: --print-libdir should be " ++ normExpectedLib,
    107 
    +        "                     got       " ++ normPrintedLib
    108 
    +      ]
    109 
    +
    110 
    +  printedPkgDb <- trim <$> readProcess ghcBin ["-B" ++ topDir, "--print-global-package-db"] ""
    111 
    +  normPrintedPkgDb <- canonicalizePath printedPkgDb
    112 
    +  when (normPrintedPkgDb /= normExpectedPkgDb) $
    113 
    +    die
    114 
    +      [ "FAIL: --print-global-package-db should be " ++ normExpectedPkgDb,
    115 
    +        "                                 got       " ++ normPrintedPkgDb
    116 
    +      ]
    117 
    +
    118 
    +compileAndRunTestExpr :: Ghc ()
    119 
    +compileAndRunTestExpr = do
    120 
    +  dflags <- getSessionDynFlags
    121 
    +  _ <- setSessionDynFlags dflags
    122 
    +  setContext [IIDecl (simpleImportDecl (mkModuleName "Prelude"))]
    123 
    +  result <- compileExpr "length [1,2,3 :: Int]"
    124 
    +  liftIO $ print (unsafeCoerce result :: Int)
    125 
    +
    126 
    +trim :: String -> String
    127 
    +trim = reverse . dropWhile (== '\n') . reverse
    128 
    +
    129 
    +die :: [String] -> IO ()
    130 
    +die msgs = mapM_ (hPutStrLn stderr) msgs >> exitWith (ExitFailure 1)

  • testsuite/tests/ghc-api/settings/LibDir.stdout
    1 
    +3
    2 
    +3
    3 
    +OK

  • testsuite/tests/ghc-api/settings/all.T
    1 
    +test('LibDir',
    2 
    +    [ extra_run_opts('"' + config.libdir + '" "' + config.compiler + '"')
    3 
    +    , req_interp
    4 
    +    # createDirectoryLink uses CreateSymbolicLink on Windows (requires developer
    5 
    +    # mode or admin); also GHC searches for mingw relative to topDir, which our
    6 
    +    # artificial topDir doesn't provide.
    7 
    +    , when(opsys('mingw32'), skip)
    8 
    +    # TODO: wasm CI image lacks permission to create symlinks in temp dir (`/tmp`).
    9 
    +    , when(arch('wasm32'), skip)
    10 
    +    ]
    11 
    +    , compile_and_run
    12 
    +    , ['-package ghc -package directory -package filepath'])

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