on master help sign in
Only use streaming show-details for cabal 1.20
c5e2a58Michael Snoyman
Stackage/Test.hs+28−8
@@ -9,6 +9,7 @@ import Control.Exception (Exception, SomeException, handle, throwIO)
9import Control.Monad (replicateM, unless, when)
9import Control.Monad (replicateM, unless, when)
10import qualified Data.Map as Map
10import qualified Data.Map as Map
11import qualified Data.Set as Set
11import qualified Data.Set as Set
12+import Data.Version (parseVersion, Version (Version))
12import Data.Typeable (Typeable)
13import Data.Typeable (Typeable)
13import Stackage.Types
14import Stackage.Types
14import Stackage.Util
15import Stackage.Util
@@ -18,7 +19,8 @@ import System.Exit (ExitCode (ExitSuccess))
18import System.FilePath ((<.>), (</>))
19import System.FilePath ((<.>), (</>))
19import System.IO (IOMode (WriteMode, AppendMode),
20import System.IO (IOMode (WriteMode, AppendMode),
20 withBinaryFile)
21 withBinaryFile)
21−import System.Process (runProcess, waitForProcess)
22+import System.Process (readProcess, runProcess, waitForProcess)
23+import Text.ParserCombinators.ReadP (readP_to_S)
22
24
23runTestSuites :: BuildSettings -> BuildPlan -> IO ()
25runTestSuites :: BuildSettings -> BuildPlan -> IO ()
24runTestSuites settings' bp = do
26runTestSuites settings' bp = do
@@ -28,11 +30,23 @@ runTestSuites settings' bp = do
28 let testdir = "runtests"
30 let testdir = "runtests"
29 rm_r testdir
31 rm_r testdir
30 createDirectory testdir
32 createDirectory testdir
33+ cabalVersion <- getCabalVersion
31− allPass <- parFoldM (testWorkerThreads settings) (runTestSuite settings testdir) (&&) True $ Map.toList selected
34+ allPass <- parFoldM (testWorkerThreads settings) (runTestSuite cabalVersion settings testdir) (&&) True $ Map.toList selected
32 unless allPass $ error $ "There were failures, please see the logs in " ++ testdir
35 unless allPass $ error $ "There were failures, please see the logs in " ++ testdir
33 where
36 where
34 notSkipped p _ = p `Set.notMember` bpSkippedTests bp
37 notSkipped p _ = p `Set.notMember` bpSkippedTests bp
35
38
39+getCabalVersion :: IO CabalVersion
40+getCabalVersion = do
41+ output <- readProcess "cabal" ["--numeric-version"] ""
42+ case filter (null . snd) $ readP_to_S parseVersion $ filter notCRLF output of
43+ (Version (x:y:_) _, _):_ -> return $ CabalVersion x y
44+ _ -> error $ "Invalid cabal version: " ++ show output
45+ where
46+ notCRLF '\n' = False
47+ notCRLF '\r' = False
48+ notCRLF _ = True
49+
36parFoldM :: Int -- ^ number of threads
50parFoldM :: Int -- ^ number of threads
37 -> (b -> IO c)
51 -> (b -> IO c)
38 -> (a -> c -> a)
52 -> (a -> c -> a)
@@ -77,11 +91,15 @@ data TestException = TestException
77 deriving (Show, Typeable)
91 deriving (Show, Typeable)
78instance Exception TestException
92instance Exception TestException
79
93
94+data CabalVersion = CabalVersion Int Int
95+ deriving (Eq, Ord, Show)
96+
97+runTestSuite :: CabalVersion
80−runTestSuite :: BuildSettings
98+ -> BuildSettings
81 -> FilePath
99 -> FilePath
82 -> (PackageName, SelectedPackageInfo)
100 -> (PackageName, SelectedPackageInfo)
83 -> IO Bool
101 -> IO Bool
84−runTestSuite settings testdir (packageName, SelectedPackageInfo {..}) = do
102+runTestSuite cabalVersion settings testdir (packageName, SelectedPackageInfo {..}) = do
85 -- Set up a new environment that includes the sandboxed bin folder in PATH.
103 -- Set up a new environment that includes the sandboxed bin folder in PATH.
86 env' <- getModifiedEnv settings
104 env' <- getModifiedEnv settings
87 let menv addGPP
105 let menv addGPP
@@ -116,10 +134,12 @@ runTestSuite settings testdir (packageName, SelectedPackageInfo {..}) = do
116 getHandle AppendMode $ run "cabal" (addCabalArgs settings BSTest ["configure", "--enable-tests"]) dir
134 getHandle AppendMode $ run "cabal" (addCabalArgs settings BSTest ["configure", "--enable-tests"]) dir
117 when spiHasTests $ do
135 when spiHasTests $ do
118 getHandle AppendMode $ run "cabal" ["build"] dir
136 getHandle AppendMode $ run "cabal" ["build"] dir
119− getHandle AppendMode $ runGhcPackagePath "cabal"
137+ getHandle AppendMode $ runGhcPackagePath "cabal" (concat
120− [ "test"
138+ [ ["test"]
139+ , if cabalVersion >= CabalVersion 1 20
121− , "--show-details=streaming" -- FIXME temporary workaround for https://github.com/haskell/cabal/issues/1810
140+ then ["--show-details=streaming"] -- FIXME temporary workaround for https://github.com/haskell/cabal/issues/1810
141+ else []
122− ] dir
142+ ]) dir
123 when (buildDocs settings) $
143 when (buildDocs settings) $
124 getHandle AppendMode $ run "cabal" ["haddock"] dir
144 getHandle AppendMode $ run "cabal" ["haddock"] dir
125 return True
145 return True