aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorDaniel Gröber <dxld@darkboxed.org>2019-07-30 16:16:37 +0200
committerDaniel Gröber (dxld) <dxld@darkboxed.org>2019-09-17 17:48:26 +0200
commit432d80f962535c2d2db27f6d652509090a88936b (patch)
treed8055e2c3e8a54aadecf106753834f8027ce8dbf /tests
parent86a4864838342202348d999987c0a16301b46c8b (diff)
ghc-session: Allow overriding programs on commandline
Diffstat (limited to 'tests')
-rw-r--r--tests/GhcSession.hs161
1 files changed, 104 insertions, 57 deletions
diff --git a/tests/GhcSession.hs b/tests/GhcSession.hs
index 98a7d69..db06c87 100644
--- a/tests/GhcSession.hs
+++ b/tests/GhcSession.hs
@@ -21,6 +21,7 @@ import Data.Maybe
import Data.Version
import Data.Bifunctor
import qualified Data.Map as Map
+import System.Console.GetOpt as GetOpt
import System.Environment (getArgs)
import System.Exit
import System.FilePath ((</>), (<.>), makeRelative, takeDirectory)
@@ -34,7 +35,12 @@ import Text.Show.Pretty (pPrint)
import Distribution.Helper
import CabalHelper.Shared.Common
+import CabalHelper.Compiletime.Types (Env)
import CabalHelper.Compiletime.Process (readProcess, callProcessStderr)
+import CabalHelper.Compiletime.Program.GHC
+ (GhcVersion(..), ghcVersion)
+import CabalHelper.Compiletime.Program.CabalInstall
+ (CabalInstallVersion(..), cabalInstallVersion)
data TestConfig = TC
{ location :: TestLocation
@@ -48,21 +54,53 @@ data TestLocation
| TF FilePath FilePath FilePath
deriving (Show)
+type ModProgs = (Programs -> Programs, CompPrograms -> CompPrograms)
+
+options :: [OptDescr ModProgs]
+options =
+ [ GetOpt.Option [] ["with-cabal"]
+ (ReqArg (\arg -> (\p -> p { cabalProgram = arg }, id)) "PROG")
+ "name or path of 'cabal' executable"
+ , GetOpt.Option [] ["with-stack"]
+ (ReqArg (\arg -> (\p -> p { stackProgram = arg }, id)) "PROG")
+ "name or path of 'stack' executable"
+ , GetOpt.Option [] ["with-ghc"]
+ (ReqArg (\arg -> (id, \cp -> cp { ghcProgram = arg })) "PROG")
+ "name or path of 'ghc' executable"
+ , GetOpt.Option [] ["with-ghc-pkg"]
+ (ReqArg (\arg -> (id, \cp -> cp { ghcPkgProgram = arg })) "PROG")
+ "name or path of 'ghc-pkg' executable"
+ ]
+
+testOpts :: [String] -> IO (ModProgs, [String])
+testOpts args =
+ case getOpt Permute options args of
+ (o,n,[] ) -> return (foldl (\(b, d) (a, c) -> (a . b, c . d)) (id, id) o, n)
+ (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
+ where header = "Usage: ghc-session [OPTION..] [TEST_SPEC..]"
+
main :: IO ()
main = do
- args <- getArgs
+ (modProgs, args) <- testOpts =<< getArgs
-- topdir <- getCurrentDirectory
- g_ver <- ghcVersion
- ci_ver <- cabalInstallVersion
- s_ver <- stackVersion
+ let withEnv :: (Env => a) -> a
+ withEnv action =
+ let ?verbose = const False
+ ?progs = (fst modProgs) defaultPrograms
+ ?cprogs = (snd modProgs) defaultCompPrograms
+ in action
+
+ GhcVersion g_ver <- withEnv ghcVersion
+ CabalInstallVersion ci_ver <- withEnv cabalInstallVersion
+ s_ver <- withEnv stackVersion
`E.catch` \(_ :: IOError) -> return (makeVersion [0])
-- Cabal lib version
f_c_ver :: ProjType -> Either SkipReason Version <- do
- ci_c_ver <- Right <$> cabalInstallBuiltinCabalVersion
+ ci_c_ver <- Right <$> withEnv cabalInstallBuiltinCabalVersion
s_c_ver :: Either SkipReason Version
- <- sequence $ stackBuiltinCabalVersion s_ver g_ver
+ <- sequence $ withEnv stackBuiltinCabalVersion s_ver g_ver
return $ \pt -> case pt of
V1 -> ci_c_ver
V2 -> ci_c_ver
@@ -129,7 +167,7 @@ main = do
Left reason -> return $ skip reason >> return []
Right eximpl -> do
let ps1 = ps0 { psdImpl = eximpl }
- case checkAndRunTestConfig VerEnv{..} ps1 tc of
+ case checkAndRunTestConfig modProgs VerEnv{..} ps1 tc of
Left reason -> return $ skip reason >> return []
Right (Message msg, act) -> return $ putStrLn msg >> act
@@ -175,11 +213,13 @@ testLocPath (TF topdir projdir cabal_file) =
-- | Check version bounds of tests against available versions, if successful run
-- the test.
checkAndRunTestConfig
- :: VerEnv
+ :: ModProgs
+ -> VerEnv
-> ProjSetup1
-> TestConfig
-> Either SkipReason (Message, IO [TestResult])
checkAndRunTestConfig
+ modProgs
VerEnv { ci_ver, f_c_ver, g_ver, s_ver }
ps1@(psdImpl -> Ex psdImpl2)
(TC test_loc min_cabal_ver min_ghc_ver _proj_types)
@@ -207,19 +247,21 @@ checkAndRunTestConfig
, psdHeading ps1
, "'" ++ topdir ++ "'"
])
- (runTest ps1{ psdImpl = psdImpl2 } topdir projdir_rel cabal_file)
+ (runTest modProgs ps1{ psdImpl = psdImpl2 } topdir projdir_rel cabal_file)
where
pt_disp V1 = "cabal-install"
pt_disp V2 = "cabal-install"
pt_disp Stack = "Stack"
-runTest :: ProjSetup2 pt -> FilePath -> FilePath -> FilePath -> IO [TestResult]
-runTest ps2@(psdImpl -> ProjSetupImpl{..}) topdir projdir cabal_file = do
+runTest
+ :: ModProgs -> ProjSetup2 pt
+ -> FilePath -> FilePath -> FilePath
+ -> IO [TestResult]
+runTest modProgs ps2@(psdImpl -> ProjSetupImpl{..}) topdir projdir cabal_file
+ = do
withSystemTempDirectory' "cabal-helper.ghc-session.test" $ \tmpdir -> do
- psiSdist topdir tmpdir
- psiConfigure (tmpdir </> projdir)
- trs <- test ps2 (tmpdir </> projdir) (tmpdir </> cabal_file)
+ trs <- test modProgs ps2 topdir tmpdir (tmpdir </> projdir) (tmpdir </> cabal_file)
return $ map ($ (topdir </> projdir)) $ map ($ (psdHeading ps2)) trs
runWithCwd :: FilePath -> String -> [String] -> IO ()
@@ -232,17 +274,28 @@ run x xs = do
let ?verbose = (==1)
callProcessStderr Nothing x xs
-test :: ProjSetup2 pt -> FilePath -> FilePath
- -> IO [(String -> FilePath -> TestResult)]
-test (psdImpl -> ProjSetupImpl{..}) projdir cabal_file = do
- qe <- psiQEmod <$> mkQueryEnv
+test
+ :: ModProgs -> ProjSetup2 pt
+ -> FilePath -> FilePath -> FilePath -> FilePath
+ -> IO [(String -> FilePath -> TestResult)]
+test modProgs (psdImpl -> ProjSetupImpl{..}) topdir tmpdir projdir cabal_file
+ = do
+ qe' <- psiQEmod <$> mkQueryEnv
(psiProjLoc (CabalFile cabal_file) projdir)
(psiDistDir projdir)
+ let qe = qe' { qePrograms = (fst modProgs) (qePrograms qe')
+ , qeCompPrograms = (snd modProgs) (qeCompPrograms qe')
+ }
+ progs = qePrograms qe
+
+ psiSdist progs topdir tmpdir
+ psiConfigure progs projdir
+
cs <- concat <$> runQuery (allUnits (Map.elems . uiComponents)) qe
when (any ((==ProduceBuildOutput) . ciNeedsBuildOutput) cs) $
- psiBuild projdir
+ psiBuild progs projdir
let pkgdir = takeDirectory cabal_file
homedir <- getHomeDirectory
@@ -358,9 +411,9 @@ data ProjSetupImpl pt =
{ psiProjType :: !(SProjType pt)
, psiDistDir :: !(FilePath -> DistDir pt)
, psiProjLoc :: !(CabalFile -> FilePath -> ProjLoc pt)
- , psiConfigure :: !(FilePath -> IO ())
- , psiBuild :: !(FilePath -> IO ())
- , psiSdist :: !(FilePath -> FilePath -> IO ())
+ , psiConfigure :: !(Programs -> FilePath -> IO ())
+ , psiBuild :: !(Programs -> FilePath -> IO ())
+ , psiSdist :: !(Programs -> FilePath -> FilePath -> IO ())
, psiQEmod :: !(QueryEnv pt -> QueryEnv pt)
}
@@ -369,12 +422,12 @@ oldBuildProjSetup = ProjSetupDescr "cabal-v1" $ Right $ Ex $ ProjSetupImpl
{ psiProjType = SV1
, psiDistDir = \dir -> DistDirV1 (dir </> "dist")
, psiProjLoc = \(CabalFile cf) _projdir -> ProjLocV1CabalFile cf
- , psiConfigure = \dir ->
- runWithCwd dir "cabal" [ "configure" ]
- , psiBuild = \dir ->
- runWithCwd dir "cabal" [ "build" ]
- , psiSdist = \srcdir destdir ->
- copyMuliPackageProject srcdir destdir (\_ _ -> return ())
+ , psiConfigure = \progs dir ->
+ runWithCwd dir (cabalProgram progs) [ "configure" ]
+ , psiBuild = \progs dir ->
+ runWithCwd dir (cabalProgram progs) [ "build" ]
+ , psiSdist = \progs srcdir destdir ->
+ copyMuliPackageProject progs srcdir destdir (\_ _ -> return ())
, psiQEmod = id
}
@@ -386,12 +439,12 @@ newBuildProjSetup = ProjSetupDescr "cabal-v2" $ Right $ Ex $ ProjSetupImpl
-- TODO: check if cabal.project is there and only use
-- V2File then, also remove addCabalProject below so we
-- cover both cases.
- , psiConfigure = \dir ->
- runWithCwd dir "cabal" [ "new-configure" ]
- , psiBuild = \dir ->
- runWithCwd dir "cabal" [ "new-build" ]
- , psiSdist = \srcdir destdir -> do
- copyMuliPackageProject srcdir destdir $ \pkgsrc pkgdest -> do
+ , psiConfigure = \progs dir ->
+ runWithCwd dir (cabalProgram progs) [ "new-configure" ]
+ , psiBuild = \progs dir ->
+ runWithCwd dir (cabalProgram progs) [ "new-build" ]
+ , psiSdist = \progs srcdir destdir -> do
+ copyMuliPackageProject progs srcdir destdir $ \pkgsrc pkgdest -> do
exists <- doesFileExist (pkgsrc </> "cabal.project")
if exists then
copyFile (pkgsrc </> "cabal.project") (pkgdest </> "cabal.project")
@@ -410,12 +463,12 @@ stackProjSetup ghcVer =
, psiDistDir = \_dir -> DistDirStack Nothing
, psiProjLoc = \_cabal_file projdir ->
ProjLocStackYaml $ projdir </> "stack.yaml"
- , psiConfigure = \dir ->
- runWithCwd dir "stack" $ argsBefore ++ [ "build", "--dry-run" ]
- , psiBuild = \dir ->
- runWithCwd dir "stack" $ argsBefore ++ [ "build" ]
- , psiSdist = \srcdir destdir -> do
- copyMuliPackageProject srcdir destdir copyStackYamls
+ , psiConfigure = \progs dir ->
+ runWithCwd dir (stackProgram progs) $ argsBefore ++ [ "build", "--dry-run" ]
+ , psiBuild = \progs dir ->
+ runWithCwd dir (stackProgram progs) $ argsBefore ++ [ "build" ]
+ , psiSdist = \progs srcdir destdir -> do
+ copyMuliPackageProject progs srcdir destdir copyStackYamls
, psiQEmod = \qe ->
qe { qePrograms = (qePrograms qe)
{ stackArgsBefore = argsBefore
@@ -446,33 +499,27 @@ copyStackYamls srcdir destdir = do
-- to another directory while only including source files referenced in the
-- cabal file.
copyMuliPackageProject
- :: FilePath -> FilePath -> (FilePath -> FilePath -> IO ()) -> IO ()
-copyMuliPackageProject srcdir destdir copyPkgExtra = do
+ :: Programs -> FilePath -> FilePath -> (FilePath -> FilePath -> IO ()) -> IO ()
+copyMuliPackageProject progs srcdir destdir copyPkgExtra = do
let packages_file = srcdir </> "packages.list"
pkgdirs <- lines <$> readFile packages_file
forM_ pkgdirs $ \pkgdir -> do
- runWithCwd (srcdir </> pkgdir) "cabal"
+ runWithCwd (srcdir </> pkgdir) (cabalProgram progs)
[ "act-as-setup", "--", "sdist"
, "--output-directory="++destdir </> pkgdir ]
copyPkgExtra (srcdir </> pkgdir) (destdir </> pkgdir)
-cabalInstallVersion :: IO Version
-cabalInstallVersion =
- parseVer . trim <$> readProcess "cabal" ["--numeric-version"] ""
-
-ghcVersion :: IO Version
-ghcVersion =
- parseVer . trim <$> readProcess "ghc" ["--numeric-version"] ""
-
-stackVersion :: IO Version
+stackVersion :: (?progs :: Programs) => IO Version
stackVersion =
- parseVer . trim <$> readProcess "stack" [ "--numeric-version" ] ""
+ parseVer . trim <$> readProcess (stackProgram ?progs) [ "--numeric-version" ] ""
-stackBuiltinCabalVersion :: Version -> Version -> Either SkipReason (IO Version)
+stackBuiltinCabalVersion
+ :: (?progs :: Programs)
+ => Version -> Version -> Either SkipReason (IO Version)
stackBuiltinCabalVersion s_ver g_ver = do
_ <- stackCheckCompat s_ver g_ver
res <- lookupStackResolver g_ver
- return $ parseVer . trim <$> readProcess "stack"
+ return $ parseVer . trim <$> readProcess (stackProgram ?progs)
[ "--resolver="++res, "--system-ghc", "exec", "--"
, "ghc-pkg", "--simple-output", "field", "Cabal", "version"
] ""
@@ -490,9 +537,9 @@ stackCheckCompat s_ver g_ver =
| otherwise ->
Right ()
-cabalInstallBuiltinCabalVersion :: IO Version
+cabalInstallBuiltinCabalVersion :: (?progs :: Programs) => IO Version
cabalInstallBuiltinCabalVersion =
- parseVer . trim <$> readProcess "cabal"
+ parseVer . trim <$> readProcess (cabalProgram ?progs)
["act-as-setup", "--", "--numeric-version"] ""
normalizeOutputWithVars :: [(String, String)] -> String -> String