git.iko.soy/stackage
on cc26f37 help sign in
stackage/Stackage/Test.hs
85 lines 3.8 kB history raw
1{-# LANGUAGE CPP #-}
2module Stackage.Test
3 ( runTestSuites
4 ) where
6import Control.Monad (foldM, unless, when)
7import qualified Data.Map as Map
8import qualified Data.Set as Set
9import Stackage.Config
10import Stackage.Types
11import Stackage.Util
12import System.Directory (createDirectory, removeFile, canonicalizePath)
13import System.Environment (getEnvironment)
14import System.Exit (ExitCode (ExitSuccess))
15import System.FilePath ((<.>), (</>))
16import System.IO (IOMode (WriteMode, AppendMode),
17 withBinaryFile)
18import System.Process (runProcess, waitForProcess)
19import Distribution.Text
20import Data.Maybe
22runTestSuites :: InstallInfo -> IO ()
23runTestSuites ii = do
24 let testdir = "runtests"
25 rm_r testdir
26 createDirectory testdir
27 allPass <- foldM (runTestSuite testdir) True $ Map.toList $ iiPackages ii
28 unless allPass $ error $ "There were failures, please see the logs in " ++ testdir
30-- | Separate for the PATH environment variable
31pathSep :: Char
32#ifdef mingw32_HOST_OS
33pathSep = ';'
34#else
35pathSep = ':'
36#endif
38fixEnv :: FilePath -> (String, String) -> (String, String)
39fixEnv bin (p@"PATH", x) = (p, bin ++ pathSep : x)
40fixEnv _ x = x
42runTestSuite :: FilePath -> Bool -> (PackageName, Version) -> IO Bool
43runTestSuite testdir prevPassed pair@(packageName, _) = do
44 -- Set up a new environment that includes the cabal-dev/bin folder in PATH.
45 env' <- getEnvironment
46 bin <- canonicalizePath "cabal-dev/bin"
47 let menv = Just $ map (fixEnv bin) env'
49 passed <- do
50 ph1 <- getHandle WriteMode $ \handle -> runProcess "cabal" ["unpack", package] (Just testdir) menv Nothing (Just handle) (Just handle)
51 ec1 <- waitForProcess ph1
52 if (ec1 /= ExitSuccess)
53 then return False
54 else do
55 ph2 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["-s", "../../cabal-dev", "configure", "--enable-tests"] (Just dir) menv Nothing (Just handle) (Just handle)
56 ec2 <- waitForProcess ph2
57 if (ec2 /= ExitSuccess)
58 then return False
59 else do
60 ph3 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["build"] (Just dir) menv Nothing (Just handle) (Just handle)
61 ec3 <- waitForProcess ph3
62 if (ec3 /= ExitSuccess)
63 then return False
64 else do
65 ph4 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["test"] (Just dir) menv Nothing (Just handle) (Just handle)
66 ec4 <- waitForProcess ph4
67 if (ec4 /= ExitSuccess)
68 then return False
69 else do
70 ph5 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["haddock"] (Just dir) menv Nothing (Just handle) (Just handle)
71 ec5 <- waitForProcess ph5
72 return $ ec5 == ExitSuccess
73 let expectedFailure = packageName `Set.member` expectedFailures
74 if passed
75 then do
76 removeFile logfile
77 when expectedFailure $ putStrLn $ package ++ " passed, but I didn't think it would."
78 else unless expectedFailure $ putStrLn $ "Test suite failed: " ++ package
79 rm_r dir
80 return $! prevPassed && (passed || expectedFailure)
81 where
82 logfile = testdir </> package <.> "log"
83 dir = testdir </> package
84 getHandle mode = withBinaryFile logfile mode
85 package = packageVersionString pair