git.iko.soy/stackage
on master help sign in
Add cabal-dev/bin to PATH
cc26f37Michael Snoyman
Stackage/Test.hs+35−14
compare with master
unifiedsplit
@@ -1,19 +1,23 @@
1+{-# LANGUAGE CPP #-}
1module Stackage.Test
2module Stackage.Test
2 ( runTestSuites
3 ( runTestSuites
3 ) where
4 ) where
4
5
5−import Control.Monad (foldM, unless, when)
6+import Control.Monad (foldM, unless, when)
6−import qualified Data.Map as Map
7+import qualified Data.Map as Map
7−import qualified Data.Set as Set
8+import qualified Data.Set as Set
8import Stackage.Config
9import Stackage.Config
9import Stackage.Types
10import Stackage.Types
10import Stackage.Util
11import Stackage.Util
11−import System.Directory (createDirectory, removeFile)
12+import System.Directory (createDirectory, removeFile, canonicalizePath)
13+import System.Environment (getEnvironment)
12−import System.Exit (ExitCode (ExitSuccess))
14+import System.Exit (ExitCode (ExitSuccess))
13−import System.FilePath ((<.>), (</>))
15+import System.FilePath ((<.>), (</>))
14−import System.IO (IOMode (WriteMode, AppendMode),
16+import System.IO (IOMode (WriteMode, AppendMode),
15− withBinaryFile)
17+ withBinaryFile)
16−import System.Process (runProcess, waitForProcess)
18+import System.Process (runProcess, waitForProcess)
19+import Distribution.Text
20+import Data.Maybe
17
21
18runTestSuites :: InstallInfo -> IO ()
22runTestSuites :: InstallInfo -> IO ()
19runTestSuites ii = do
23runTestSuites ii = do
@@ -23,30 +27,47 @@ runTestSuites ii = do
23 allPass <- foldM (runTestSuite testdir) True $ Map.toList $ iiPackages ii
27 allPass <- foldM (runTestSuite testdir) True $ Map.toList $ iiPackages ii
24 unless allPass $ error $ "There were failures, please see the logs in " ++ testdir
28 unless allPass $ error $ "There were failures, please see the logs in " ++ testdir
25
29
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+
26runTestSuite :: FilePath -> Bool -> (PackageName, Version) -> IO Bool
42runTestSuite :: FilePath -> Bool -> (PackageName, Version) -> IO Bool
27runTestSuite testdir prevPassed pair@(packageName, _) = do
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'
48+
28 passed <- do
49 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)
30 ec1 <- waitForProcess ph1
51 ec1 <- waitForProcess ph1
31 if (ec1 /= ExitSuccess)
52 if (ec1 /= ExitSuccess)
32 then return False
53 then return False
33 else do
54 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)
35 ec2 <- waitForProcess ph2
56 ec2 <- waitForProcess ph2
36 if (ec2 /= ExitSuccess)
57 if (ec2 /= ExitSuccess)
37 then return False
58 then return False
38 else do
59 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)
40 ec3 <- waitForProcess ph3
61 ec3 <- waitForProcess ph3
41 if (ec3 /= ExitSuccess)
62 if (ec3 /= ExitSuccess)
42 then return False
63 then return False
43 else do
64 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)
45 ec4 <- waitForProcess ph4
66 ec4 <- waitForProcess ph4
46 if (ec4 /= ExitSuccess)
67 if (ec4 /= ExitSuccess)
47 then return False
68 then return False
48 else do
69 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)
50 ec5 <- waitForProcess ph5
71 ec5 <- waitForProcess ph5
51 return $ ec5 == ExitSuccess
72 return $ ec5 == ExitSuccess
52 let expectedFailure = packageName `Set.member` expectedFailures
73 let expectedFailure = packageName `Set.member` expectedFailures