haskell/stackage
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage.git synced 2026-01-11 23:08:30 +01: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

49
Stackage/Test.hs
View File

@ -1,19 +1,23 @@
{-# LANGUAGE CPP #-}
module Stackage.Test
( runTestSuites
) where
import Control.Monad (foldM, unless, when)
import qualified Data.Map as Map
import qualified Data.Set as Set
import Control.Monad (foldM, unless, when)
import qualified Data.Map as Map
import qualified Data.Set as Set
import Stackage.Config
import Stackage.Types
import Stackage.Util
import System.Directory (createDirectory, removeFile)
import System.Exit (ExitCode (ExitSuccess))
import System.FilePath ((<.>), (</>))
import System.IO (IOMode (WriteMode, AppendMode),
withBinaryFile)
import System.Process (runProcess, waitForProcess)
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