@@ -1,4 +1,5 @@
11{-# LANGUAGE CPP #-}
2+{-# LANGUAGE DeriveDataTypeable #-}
23module Stackage.Test
34 ( runTestSuites
45 ) where
@@ -16,6 +17,8 @@ import System.FilePath ((<.>), (</>))
1617import System.IO (IOMode (WriteMode, AppendMode),
1718 withBinaryFile)
1819import System.Process (runProcess, waitForProcess)
20+import Control.Exception (handle, Exception, throwIO)
21+import Data.Typeable (Typeable)
1922
2023runTestSuites :: InstallInfo -> IO ()
2124runTestSuites ii = do
@@ -41,6 +44,10 @@ fixEnv :: FilePath -> (String, String) -> (String, String)
4144fixEnv bin (p@"PATH", x) = (p, bin ++ pathSep : x)
4245fixEnv _ x = x
4346
47+data TestException = TestException
48+ deriving (Show, Typeable)
49+instance Exception TestException
50+
4451runTestSuite :: FilePath -> Bool -> (PackageName, (Version, Maintainer)) -> IO Bool
4552runTestSuite testdir prevPassed (packageName, (version, Maintainer maintainer)) = do
4653 -- 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))
4855 bin <- canonicalizePath "cabal-dev/bin"
4956 let menv = Just $ map (fixEnv bin) env'
5057
51− passed <- do
52− ph1 <- getHandle WriteMode $ \handle -> runProcess "cabal" ["unpack", package] (Just testdir) menv Nothing (Just handle) (Just handle)
53− ec1 <- waitForProcess ph1
54− if (ec1 /= ExitSuccess)
55− then return False
56− else do
57− ph2 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["-s", "../../cabal-dev", "configure", "--enable-tests"] (Just dir) menv Nothing (Just handle) (Just handle)
58− ec2 <- waitForProcess ph2
59− if (ec2 /= ExitSuccess)
60− then return False
61− else do
62− ph3 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["build"] (Just dir) menv Nothing (Just handle) (Just handle)
63− ec3 <- waitForProcess ph3
64− if (ec3 /= ExitSuccess)
65− then return False
66− else do
67− ph4 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["test"] (Just dir) menv Nothing (Just handle) (Just handle)
68− ec4 <- waitForProcess ph4
69− if (ec4 /= ExitSuccess)
70− then return False
71− else do
72− ph5 <- getHandle AppendMode $ \handle -> runProcess "cabal-dev" ["haddock"] (Just dir) menv Nothing (Just handle) (Just handle)
73− ec5 <- waitForProcess ph5
74− return $ ec5 == ExitSuccess
58+ let run cmd args wdir handle = do
59+ ph <- runProcess cmd args (Just wdir) menv Nothing (Just handle) (Just handle)
60+ ec <- waitForProcess ph
61+ unless (ec == ExitSuccess) $ throwIO TestException
62+
63+ passed <- handle (\TestException -> return False) $ do
64+ getHandle WriteMode $ run "cabal" ["unpack", package] testdir
65+ getHandle AppendMode $ run "cabal-dev" ["-s", "../../cabal-dev", "configure", "--enable-tests"] dir
66+ getHandle AppendMode $ run "cabal-dev" ["build"] dir
67+ getHandle AppendMode $ run "cabal-dev" ["test"] dir
68+ getHandle AppendMode $ run "cabal-dev" ["haddock"] dir
69+ return True
7570 let expectedFailure = packageName `Set.member` expectedFailures
7671 if passed
7772 then do