aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlan Zimmerman <alan.zimm@gmail.com>2018-10-27 20:59:57 +0200
committerDaniel Gröber <dxld@darkboxed.org>2019-01-22 03:03:25 +0100
commita941d3083b0f92e69af848abce9d82dcd6d98186 (patch)
tree1b6116740fbc4125d7f75ff917bd2a53f60e4d52
parent95f5dffb70a06d84a6c05b4df2e17b29bd93942a (diff)
Run tests against both old and new build configurations
-rw-r--r--tests/GhcSession.hs99
1 files changed, 83 insertions, 16 deletions
diff --git a/tests/GhcSession.hs b/tests/GhcSession.hs
index a4ccac8..91845d4 100644
--- a/tests/GhcSession.hs
+++ b/tests/GhcSession.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TupleSections, ScopedTypeVariables, RecordWildCards #-}
+{-# LANGUAGE TupleSections, ScopedTypeVariables, RecordWildCards, RankNTypes, DataKinds #-}
module Main where
import GHC
@@ -54,7 +54,37 @@ cabalInstallBuiltinCabalVersion =
parseVer . trim <$> readProcess "cabal"
["act-as-setup", "--", "--numeric-version"] ""
-setup :: FilePath -> (FilePath -> IO [Bool]) -> (FilePath, Version, Version) -> IO [Bool]
+data CabalCommands pt =
+ CabalCommands
+ { cabalDistDir :: FilePath -> DistDir pt
+ , cabalProjDir :: FilePath -> ProjLoc pt
+ , cabalAddProject :: FilePath -> IO ()
+ , cabalConfigureCommand :: String
+ , cabalBuildCommand :: String
+ , cabalSdistCommand :: String
+ }
+
+oldBuild :: CabalCommands 'V1
+oldBuild = CabalCommands
+ { cabalDistDir = \d -> DistDirV1 (d </> "dist")
+ , cabalProjDir = \cf -> ProjLocCabalFile cf
+ , cabalAddProject = \_ -> return ()
+ , cabalConfigureCommand = "configure"
+ , cabalBuildCommand = "build"
+ , cabalSdistCommand = "sdist"
+ }
+
+newBuild :: CabalCommands 'V2
+newBuild = CabalCommands
+ { cabalDistDir = \d -> DistDirV2 (d </> "dist-newstyle")
+ , cabalProjDir = \cf -> ProjLocV2Dir (takeDirectory cf)
+ , cabalAddProject = addCabalProject
+ , cabalConfigureCommand = "new-configure"
+ , cabalBuildCommand = "new-build"
+ , cabalSdistCommand = "sdist"
+ }
+
+setup :: FilePath -> (forall pt . CabalCommands pt -> FilePath -> IO [Bool]) -> (FilePath, Version, Version) -> IO [Bool]
setup topdir act (cabal_file, min_cabal_ver, min_ghc_ver) = do
let projdir = takeDirectory cabal_file
ci_ver <- cabalInstallVersion
@@ -77,15 +107,26 @@ setup topdir act (cabal_file, min_cabal_ver, min_ghc_ver) = do
putStrLn $ "Skipping test '" ++ projdir ++ "' because " ++ reason ++ "."
return []
Nothing -> do
- putStrLn $ "Running test '" ++ projdir ++ "'-------------------------"
- withSystemTempDirectory "cabal-helper.ghc-session.test" $ \dir -> do
- setCurrentDirectory $ topdir </> projdir
- run "cabal" [ "sdist", "-v0", "--output-dir", dir ]
-
- setCurrentDirectory dir
- run "cabal" [ "configure" ]
-
- act $ dir </> takeFileName cabal_file
+ putStrLn $ "Running test '" ++ projdir ++ "' with " ++ showVersion ci_ver ++ "."
+ putStrLn "Old build -------------------------------------"
+ rold <- runTest oldBuild topdir projdir cabal_file act
+ putStrLn "New build -------------------------------------"
+ rnew <- runTest newBuild topdir projdir cabal_file act
+ return (rold ++ rnew)
+
+runTest :: CabalCommands pt -> FilePath -> String -> FilePath
+ -> (CabalCommands pt -> FilePath -> IO [Bool]) -> IO [Bool]
+runTest c topdir projdir cabal_file act = do
+ putStrLn $ "Running test '" ++ projdir ++ "'-------------------------"
+ withSystemTempDirectory' "cabal-helper.ghc-session.test" $ \dir -> do
+ setCurrentDirectory $ topdir </> projdir
+ run "cabal" [ cabalSdistCommand c, "-v0", "--output-dir", dir ]
+
+ setCurrentDirectory dir
+ cabalAddProject c $ dir
+ run "cabal" [ cabalConfigureCommand c ]
+
+ act c $ dir </> takeFileName cabal_file
run :: String -> [String] -> IO ()
run x xs = do
@@ -93,18 +134,18 @@ run x xs = do
ExitSuccess <- rawSystem x xs
return ()
-test :: FilePath -> IO [Bool]
-test cabal_file = do
+test :: CabalCommands pt -> FilePath -> IO [Bool]
+test c cabal_file = do
let projdir = takeDirectory cabal_file
qe <- mkQueryEnv
- (ProjLocCabalFile cabal_file)
- (DistDirV1 $ projdir </> "dist")
+ (cabalProjDir c $ cabal_file)
+ (cabalDistDir c $ projdir)
cs <- concat <$> runQuery (allUnits (Map.elems . uiComponents)) qe
forM cs $ \ChComponentInfo{..} -> do
putStrLn $ "\n" ++ show ciComponentName ++ ":::: " ++ show ciNeedsBuildOutput
when (ciNeedsBuildOutput == ProduceBuildOutput) $ do
- run "cabal" [ "build" ]
+ run "cabal" [ cabalBuildCommand c ]
let opts' = "-Werror" : ciGhcOptions
@@ -117,6 +158,9 @@ test cabal_file = do
| "-" `isPrefixOf` x = "\n "++x
| otherwise = x
+addCabalProject :: FilePath -> IO ()
+addCabalProject dir = do
+ writeFile (dir </> "cabal.project") "packages: .\n"
compileModule :: NeedsBuildOutput -> ChEntrypoint -> [String] -> IO Bool
compileModule nb ep opts = do
@@ -185,3 +229,26 @@ compileModule nb ep opts = do
unChModuleName :: ChModuleName -> String
unChModuleName (ChModuleName mn) = mn
+
+-- ---------------------------------------------------------------------
+-- | Create and use a temporary directory in the system standard temporary directory.
+--
+-- Behaves exactly the same as 'withTempDirectory', except that the parent temporary directory
+-- will be that returned by 'getCanonicalTemporaryDirectory'.
+withSystemTempDirectory' :: String -- ^ Directory name template
+ -> (FilePath -> IO a) -- ^ Callback that can use the directory
+ -> IO a
+withSystemTempDirectory' template action
+ = liftIO getCanonicalTemporaryDirectory >>= \tmpDir' -> withTempDirectory' tmpDir' template action
+
+-- | Create and use a temporary directory inside the given directory.
+--
+-- The directory is deleted after use.
+withTempDirectory' :: FilePath -- ^ Parent directory to create the directory in
+ -> String -- ^ Directory name template
+ -> (FilePath -> IO a) -- ^ Callback that can use the directory
+ -> IO a
+withTempDirectory' targetDir template =
+ gbracket
+ (liftIO (createTempDirectory targetDir template))
+ (\x -> return x) -- Leave the dir for inspection later