git.iko.soy/stackage
on d7ccf74 help sign in
stackage/Stackage/Test.hs
87 lines 4.0 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)
20runTestSuites :: InstallInfo -> IO ()
21runTestSuites ii = do
22 let testdir = "runtests"
23 rm_r testdir
24 createDirectory testdir
25 allPass <- foldM (runTestSuite testdir) True $ filter hasTestSuites $ Map.toList $ iiPackages ii
26 unless allPass $ error $ "There were failures, please see the logs in " ++ testdir
27 where
28 PackageDB pdb = iiPackageDB ii
30 hasTestSuites (name, _) = maybe defaultHasTestSuites piHasTests $ Map.lookup name pdb
32-- | Separate for the PATH environment variable
33pathSep :: Char
34#ifdef mingw32_HOST_OS
35pathSep = ';'
36#else
37pathSep = ':'
38#endif
40fixEnv :: FilePath -> (String, String) -> (String, String)
41fixEnv bin (p@"PATH", x) = (p, bin ++ pathSep : x)
42fixEnv _ x = x
44runTestSuite :: FilePath -> Bool -> (PackageName, (Version, Maintainer)) -> IO Bool
45runTestSuite testdir prevPassed (packageName, (version, Maintainer maintainer)) = do
46 -- Set up a new environment that includes the cabal-dev/bin folder in PATH.
47 env' <- getEnvironment
48 bin <- canonicalizePath "cabal-dev/bin"
49 let menv = Just $ map (fixEnv bin) env'
51 passed <- do
52 ph1 <- getHandle WriteMode $ \handle -> runProcess "cabal" ["unpack", package] (Just testdir) menv Nothing (Just handle) (Just handle)
53 ec1 <- waitForProcess ph1
54 if (ec1 /= ExitSuccess)
55 then return False
56 else do
57 ph2 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["-s", "../../cabal-dev", "configure", "--enable-tests"] (Just dir) menv Nothing (Just handle) (Just handle)
58 ec2 <- waitForProcess ph2
59 if (ec2 /= ExitSuccess)
60 then return False
61 else do
62 ph3 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["build"] (Just dir) menv Nothing (Just handle) (Just handle)
63 ec3 <- waitForProcess ph3
64 if (ec3 /= ExitSuccess)
65 then return False
66 else do
67 ph4 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["test"] (Just dir) menv Nothing (Just handle) (Just handle)
68 ec4 <- waitForProcess ph4
69 if (ec4 /= ExitSuccess)
70 then return False
71 else do
72 ph5 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["haddock"] (Just dir) menv Nothing (Just handle) (Just handle)
73 ec5 <- waitForProcess ph5
74 return $ ec5 == ExitSuccess
75 let expectedFailure = packageName `Set.member` expectedFailures
76 if passed
77 then do
78 removeFile logfile
79 when expectedFailure $ putStrLn $ package ++ " passed, but I didn't think it would."
80 else unless expectedFailure $ putStrLn $ "Test suite failed: " ++ package ++ "(" ++ maintainer ++ ")"
81 rm_r dir
82 return $! prevPassed && (passed || expectedFailure)
83 where
84 logfile = testdir </> package <.> "log"
85 dir = testdir </> package
86 getHandle mode = withBinaryFile logfile mode
87 package = packageVersionString (packageName, version)