haskell/stackage
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage.git synced 2026-01-25 05:31:57 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Cleaner test running

Browse Source
This commit is contained in:
Michael Snoyman 2012-11-29 13:35:17 +02:00
parent d7ccf7406d
commit fd62aee254
1 changed files with 19 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
Stackage/Test.hs
View File

@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Stackage.Test module Stackage.Test
( runTestSuites ( runTestSuites
) where ) where
@ -16,6 +17,8 @@ import System.FilePath ((<.>), (</>))
import System.IO (IOMode (WriteMode, AppendMode), import System.IO (IOMode (WriteMode, AppendMode),
withBinaryFile) withBinaryFile)
import System.Process (runProcess, waitForProcess) import System.Process (runProcess, waitForProcess)
import Control.Exception (handle, Exception, throwIO)
import Data.Typeable (Typeable)
runTestSuites :: InstallInfo -> IO () runTestSuites :: InstallInfo -> IO ()
runTestSuites ii = do runTestSuites ii = do
@ -41,6 +44,10 @@ fixEnv :: FilePath -> (String, String) -> (String, String)
fixEnv bin (p@"PATH", x) = (p, bin ++ pathSep : x) fixEnv bin (p@"PATH", x) = (p, bin ++ pathSep : x)
fixEnv _ x = x fixEnv _ x = x
data TestException = TestException
deriving (Show, Typeable)
instance Exception TestException
runTestSuite :: FilePath -> Bool -> (PackageName, (Version, Maintainer)) -> IO Bool runTestSuite :: FilePath -> Bool -> (PackageName, (Version, Maintainer)) -> IO Bool
runTestSuite testdir prevPassed (packageName, (version, Maintainer maintainer)) = do runTestSuite testdir prevPassed (packageName, (version, Maintainer maintainer)) = do
-- Set up a new environment that includes the cabal-dev/bin folder in PATH. -- Set up a new environment that includes the cabal-dev/bin folder in PATH.
@ -48,30 +55,18 @@ runTestSuite testdir prevPassed (packageName, (version, Maintainer maintainer))
bin <- canonicalizePath "cabal-dev/bin" bin <- canonicalizePath "cabal-dev/bin"
let menv = Just $ map (fixEnv bin) env' let menv = Just $ map (fixEnv bin) env'
passed <- do let run cmd args wdir handle = do
ph1 <- getHandle WriteMode $ \handle -> runProcess "cabal" ["unpack", package] (Just testdir) menv Nothing (Just handle) (Just handle) ph <- runProcess cmd args (Just wdir) menv Nothing (Just handle) (Just handle)
ec1 <- waitForProcess ph1 ec <- waitForProcess ph
if (ec1 /= ExitSuccess) unless (ec == ExitSuccess) $ throwIO TestException
then return False
else do passed <- handle (\TestException -> return False) $ do
ph2 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["-s", "../../cabal-dev", "configure", "--enable-tests"] (Just dir) menv Nothing (Just handle) (Just handle) getHandle WriteMode $ run "cabal" ["unpack", package] testdir
ec2 <- waitForProcess ph2 getHandle AppendMode $ run "cabal-dev" ["-s", "../../cabal-dev", "configure", "--enable-tests"] dir
if (ec2 /= ExitSuccess) getHandle AppendMode $ run "cabal-dev" ["build"] dir
then return False getHandle AppendMode $ run "cabal-dev" ["test"] dir
else do getHandle AppendMode $ run "cabal-dev" ["haddock"] dir
ph3 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["build"] (Just dir) menv Nothing (Just handle) (Just handle) return True
ec3 <- waitForProcess ph3
if (ec3 /= ExitSuccess)
then return False
else do
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) menv Nothing (Just handle) (Just handle)
ec5 <- waitForProcess ph5
return $ ec5 == ExitSuccess
let expectedFailure = packageName `Set.member` expectedFailures let expectedFailure = packageName `Set.member` expectedFailures
if passed if passed
then do then do