haskell/stackage
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage.git synced 2026-04-23 08:27:44 +02:00
Code Issues Actions 1 Packages Projects Releases Wiki Activity

Add cabal-dev/bin to PATH

Browse Source
This commit is contained in:
Michael Snoyman 2012-11-26 10:23:20 +02:00
parent 48c9d56a73
commit cc26f37141
1 changed files with 35 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
Stackage/Test.hs
View File

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
module Stackage.Test
( runTestSuites
) where
@ -8,12 +9,15 @@ import qualified Data.Set as Set
import Stackage.Config
import Stackage.Types
import Stackage.Util
import System.Directory (createDirectory, removeFile)
import System.Directory (createDirectory, removeFile, canonicalizePath)
import System.Environment (getEnvironment)
import System.Exit (ExitCode (ExitSuccess))
import System.FilePath ((<.>), (</>))
import System.IO (IOMode (WriteMode, AppendMode),
withBinaryFile)
import System.Process (runProcess, waitForProcess)
import Distribution.Text
import Data.Maybe
runTestSuites :: InstallInfo -> IO ()
runTestSuites ii = do
@ -23,30 +27,47 @@ runTestSuites ii = do
allPass <- foldM (runTestSuite testdir) True $ Map.toList $ iiPackages ii
unless allPass $ error $ "There were failures, please see the logs in " ++ testdir
-- | Separate for the PATH environment variable
pathSep :: Char
#ifdef mingw32_HOST_OS
pathSep = ';'
#else
pathSep = ':'
#endif
fixEnv :: FilePath -> (String, String) -> (String, String)
fixEnv bin (p@"PATH", x) = (p, bin ++ pathSep : x)
fixEnv _ x = x
runTestSuite :: FilePath -> Bool -> (PackageName, Version) -> IO Bool
runTestSuite testdir prevPassed pair@(packageName, _) = do
-- Set up a new environment that includes the cabal-dev/bin folder in PATH.
env' <- getEnvironment
bin <- canonicalizePath "cabal-dev/bin"
let menv = Just $ map (fixEnv bin) env'
passed <- do
ph1 <- getHandle WriteMode $ \handle -> runProcess "cabal" ["unpack", package] (Just testdir) Nothing Nothing (Just handle) (Just handle)
ph1 <- getHandle WriteMode $ \handle -> runProcess "cabal" ["unpack", package] (Just testdir) menv Nothing (Just handle) (Just handle)
ec1 <- waitForProcess ph1
if (ec1 /= ExitSuccess)
then return False
else do
ph2 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["-s", "../../cabal-dev", "configure", "--enable-tests"] (Just dir) Nothing Nothing (Just handle) (Just handle)
ph2 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["-s", "../../cabal-dev", "configure", "--enable-tests"] (Just dir) menv Nothing (Just handle) (Just handle)
ec2 <- waitForProcess ph2
if (ec2 /= ExitSuccess)
then return False
else do
ph3 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["build"] (Just dir) Nothing Nothing (Just handle) (Just handle)
ph3 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["build"] (Just dir) menv Nothing (Just handle) (Just handle)
ec3 <- waitForProcess ph3
if (ec3 /= ExitSuccess)
then return False
else do
ph4 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["test"] (Just dir) Nothing Nothing (Just handle) (Just handle)
ph4 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["test"] (Just dir) menv Nothing (Just handle) (Just handle)
ec4 <- waitForProcess ph4
if (ec4 /= ExitSuccess)
then return False
else do
ph5 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["haddock"] (Just dir) Nothing Nothing (Just handle) (Just handle)
ph5 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["haddock"] (Just dir) menv Nothing (Just handle) (Just handle)
ec5 <- waitForProcess ph5
return $ ec5 == ExitSuccess
let expectedFailure = packageName `Set.member` expectedFailures