haskell/stackage
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage.git synced 2026-01-26 22:21:57 +01:00
Code Issues Actions 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 module Stackage.Test
( runTestSuites ( runTestSuites
) where ) where
import Control.Monad (foldM, unless, when) import Control.Monad (foldM, unless, when)
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Set as Set import qualified Data.Set as Set
import Stackage.Config import Stackage.Config
import Stackage.Types import Stackage.Types
import Stackage.Util import Stackage.Util
import System.Directory (createDirectory, removeFile) import System.Directory (createDirectory, removeFile, canonicalizePath)
import System.Exit (ExitCode (ExitSuccess)) import System.Environment (getEnvironment)
import System.FilePath ((<.>), (</>)) import System.Exit (ExitCode (ExitSuccess))
import System.IO (IOMode (WriteMode, AppendMode), import System.FilePath ((<.>), (</>))
withBinaryFile) import System.IO (IOMode (WriteMode, AppendMode),
import System.Process (runProcess, waitForProcess) withBinaryFile)
import System.Process (runProcess, waitForProcess)
import Distribution.Text
import Data.Maybe
runTestSuites :: InstallInfo -> IO () runTestSuites :: InstallInfo -> IO ()
runTestSuites ii = do runTestSuites ii = do
@ -23,30 +27,47 @@ runTestSuites ii = do
allPass <- foldM (runTestSuite testdir) True $ Map.toList $ iiPackages ii allPass <- foldM (runTestSuite testdir) True $ Map.toList $ iiPackages ii
unless allPass $ error $ "There were failures, please see the logs in " ++ testdir 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 :: FilePath -> Bool -> (PackageName, Version) -> IO Bool
runTestSuite testdir prevPassed pair@(packageName, _) = do 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 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 ec1 <- waitForProcess ph1
if (ec1 /= ExitSuccess) if (ec1 /= ExitSuccess)
then return False then return False
else do 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 ec2 <- waitForProcess ph2
if (ec2 /= ExitSuccess) if (ec2 /= ExitSuccess)
then return False then return False
else do 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 ec3 <- waitForProcess ph3
if (ec3 /= ExitSuccess) if (ec3 /= ExitSuccess)
then return False then return False
else do 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 ec4 <- waitForProcess ph4
if (ec4 /= ExitSuccess) if (ec4 /= ExitSuccess)
then return False then return False
else do 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 ec5 <- waitForProcess ph5
return $ ec5 == ExitSuccess return $ ec5 == ExitSuccess
let expectedFailure = packageName `Set.member` expectedFailures let expectedFailure = packageName `Set.member` expectedFailures