@@ -1,19 +1,23 @@
1+{-# LANGUAGE CPP #-}
12module Stackage.Test
23 ( runTestSuites
34 ) where
45
5−import Control.Monad (foldM, unless, when)
6−import qualified Data.Map as Map
7−import qualified Data.Set as Set
6+import Control.Monad (foldM, unless, when)
7+import qualified Data.Map as Map
8+import qualified Data.Set as Set
89import Stackage.Config
910import Stackage.Types
1011import Stackage.Util
11−import System.Directory (createDirectory, removeFile)
12−import System.Exit (ExitCode (ExitSuccess))
13−import System.FilePath ((<.>), (</>))
14−import System.IO (IOMode (WriteMode, AppendMode),
15− withBinaryFile)
16−import System.Process (runProcess, waitForProcess)
12+import System.Directory (createDirectory, removeFile, canonicalizePath)
13+import System.Environment (getEnvironment)
14+import System.Exit (ExitCode (ExitSuccess))
15+import System.FilePath ((<.>), (</>))
16+import System.IO (IOMode (WriteMode, AppendMode),
17+ withBinaryFile)
18+import System.Process (runProcess, waitForProcess)
19+import Distribution.Text
20+import Data.Maybe
1721
1822runTestSuites :: InstallInfo -> IO ()
1923runTestSuites ii = do
@@ -23,30 +27,47 @@ runTestSuites ii = do
2327 allPass <- foldM (runTestSuite testdir) True $ Map.toList $ iiPackages ii
2428 unless allPass $ error $ "There were failures, please see the logs in " ++ testdir
2529
30+-- | Separate for the PATH environment variable
31+pathSep :: Char
32+#ifdef mingw32_HOST_OS
33+pathSep = ';'
34+#else
35+pathSep = ':'
36+#endif
37+
38+fixEnv :: FilePath -> (String, String) -> (String, String)
39+fixEnv bin (p@"PATH", x) = (p, bin ++ pathSep : x)
40+fixEnv _ x = x
41+
2642runTestSuite :: FilePath -> Bool -> (PackageName, Version) -> IO Bool
2743runTestSuite 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'
48+
2849 passed <- do
29− ph1 <- getHandle WriteMode $ \handle -> runProcess "cabal" ["unpack", package] (Just testdir) Nothing Nothing (Just handle) (Just handle)
50+ ph1 <- getHandle WriteMode $ \handle -> runProcess "cabal" ["unpack", package] (Just testdir) menv Nothing (Just handle) (Just handle)
3051 ec1 <- waitForProcess ph1
3152 if (ec1 /= ExitSuccess)
3253 then return False
3354 else do
34− ph2 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["-s", "../../cabal-dev", "configure", "--enable-tests"] (Just dir) Nothing Nothing (Just handle) (Just handle)
55+ ph2 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["-s", "../../cabal-dev", "configure", "--enable-tests"] (Just dir) menv Nothing (Just handle) (Just handle)
3556 ec2 <- waitForProcess ph2
3657 if (ec2 /= ExitSuccess)
3758 then return False
3859 else do
39− ph3 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["build"] (Just dir) Nothing Nothing (Just handle) (Just handle)
60+ ph3 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["build"] (Just dir) menv Nothing (Just handle) (Just handle)
4061 ec3 <- waitForProcess ph3
4162 if (ec3 /= ExitSuccess)
4263 then return False
4364 else do
44− ph4 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["test"] (Just dir) Nothing Nothing (Just handle) (Just handle)
65+ ph4 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["test"] (Just dir) menv Nothing (Just handle) (Just handle)
4566 ec4 <- waitForProcess ph4
4667 if (ec4 /= ExitSuccess)
4768 then return False
4869 else do
49− ph5 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["haddock"] (Just dir) Nothing Nothing (Just handle) (Just handle)
70+ ph5 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["haddock"] (Just dir) menv Nothing (Just handle) (Just handle)
5071 ec5 <- waitForProcess ph5
5172 return $ ec5 == ExitSuccess
5273 let expectedFailure = packageName `Set.member` expectedFailures