From 807354f7dc6644fec15dfa1e534c69c14d219628 Mon Sep 17 00:00:00 2001 From: Daniel Gröber Date: Sun, 14 Oct 2018 03:33:38 +0200 Subject: Start refactoring to support cabal v2-build --- tests/CompileTest.hs | 1 + tests/GhcSession.hs | 24 ++++++++++++++---------- 2 files changed, 15 insertions(+), 10 deletions(-) (limited to 'tests') diff --git a/tests/CompileTest.hs b/tests/CompileTest.hs index 02f4c3b..5e03d8c 100644 --- a/tests/CompileTest.hs +++ b/tests/CompileTest.hs @@ -46,6 +46,7 @@ main :: IO () main = do let ?progs = defaultPrograms let ?opts = defaultCompileOptions { oVerbose = True } + let ?verbose = True args <- getArgs case args of diff --git a/tests/GhcSession.hs b/tests/GhcSession.hs index 6e71075..63085db 100644 --- a/tests/GhcSession.hs +++ b/tests/GhcSession.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TupleSections, ScopedTypeVariables #-} +{-# LANGUAGE TupleSections, ScopedTypeVariables, RecordWildCards #-} module Main where import GHC @@ -10,6 +10,7 @@ import Control.Monad import Control.Monad.IO.Class import Data.List import Data.Version +import qualified Data.Map as Map import System.Environment (getArgs) import System.Exit import System.FilePath (()) @@ -91,23 +92,26 @@ run x xs = do ExitSuccess <- rawSystem x xs return () +allComponents :: Query pt [ChComponentInfo] +allComponents = + concat . map (Map.elems . uiComponents) <$> (mapM unitQuery =<< projectUnits) + test :: FilePath -> IO [Bool] test dir = do - let qe = mkQueryEnv dir (dir "dist") - cs <- runQuery qe $ components $ (,,,) <$> entrypoints <.> ghcOptions <.> needsBuildOutput - forM cs $ \(ep, opts, nb, cn) -> do - - putStrLn $ "\n" ++ show cn ++ ":::: " ++ show nb + qe <- mkQueryEnv (ProjDirV1 dir) (DistDirV1 $ dir "dist") + cs <- runQuery allComponents qe + forM cs $ \ChComponentInfo{..} -> do + putStrLn $ "\n" ++ show ciComponentName ++ ":::: " ++ show ciNeedsBuildOutput - when (nb == ProduceBuildOutput) $ do + when (ciNeedsBuildOutput == ProduceBuildOutput) $ do run "cabal" [ "build" ] - let opts' = "-Werror" : opts + let opts' = "-Werror" : ciGhcOptions let sopts = intercalate " " $ map formatArg $ "\nghc" : opts' - putStrLn $ "\n" ++ show cn ++ ": " ++ sopts + putStrLn $ "\n" ++ show ciComponentName ++ ": " ++ sopts hFlush stdout - compileModule nb ep opts' + compileModule ciNeedsBuildOutput ciEntrypoints opts' where formatArg x | "-" `isPrefixOf` x = "\n "++x -- cgit v1.2.3