    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE RankNTypes #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Distribution.Simple.Test
    -- Copyright   :  Thomas Tuegel 2010
    -- License     :  BSD3
    --
    -- Maintainer  :  cabal-devel@haskell.org
    -- Portability :  portable
    --
    -- This is the entry point into testing a built package. It performs the
    -- \"@.\/setup test@\" action. It runs test suites designated in the package
    -- description and reports on the results.

    module Distribution.Simple.Test
        ( test
        ) where

    import Prelude ()
    import Distribution.Compat.Prelude

    import Distribution.Types.UnqualComponentName
    import qualified Distribution.PackageDescription as PD
    import Distribution.Simple.Compiler
    import Distribution.Simple.Hpc
    import Distribution.Simple.InstallDirs
    import qualified Distribution.Simple.LocalBuildInfo as LBI
    import qualified Distribution.Types.LocalBuildInfo as LBI
    import Distribution.Simple.Setup
    import Distribution.Simple.UserHooks
    import qualified Distribution.Simple.Test.ExeV10 as ExeV10
    import qualified Distribution.Simple.Test.LibV09 as LibV09
    import Distribution.Simple.Test.Log
    import Distribution.Simple.Utils
    import Distribution.TestSuite
    import Distribution.Pretty

    import System.Directory
        ( createDirectoryIfMissing, doesFileExist, getDirectoryContents
        , removeFile )
    import System.FilePath ( (</>) )

    -- |Perform the \"@.\/setup test@\" action.
    test :: Args                    -- ^positional command-line arguments
         -> PD.PackageDescription   -- ^information from the .cabal file
         -> LBI.LocalBuildInfo      -- ^information from the configure step
         -> TestFlags               -- ^flags sent to test
         -> IO ()
    test :: Args -> PackageDescription -> LocalBuildInfo -> TestFlags -> IO ()
    test Args
    args PackageDescription
    pkg_descr LocalBuildInfo
    lbi TestFlags
    flags = do
        let verbosity :: Verbosity
    verbosity = Flag Verbosity -> Verbosity
    forall a. WithCallStack (Flag a -> a)
    fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
    forall a b. (a -> b) -> a -> b
    $ TestFlags -> Flag Verbosity
    testVerbosity TestFlags
    flags
            machineTemplate :: PathTemplate
    machineTemplate = Flag PathTemplate -> PathTemplate
    forall a. WithCallStack (Flag a -> a)
    fromFlag (Flag PathTemplate -> PathTemplate)
    -> Flag PathTemplate -> PathTemplate
    forall a b. (a -> b) -> a -> b
    $ TestFlags -> Flag PathTemplate
    testMachineLog TestFlags
    flags
            distPref :: FilePath
    distPref = Flag FilePath -> FilePath
    forall a. WithCallStack (Flag a -> a)
    fromFlag (Flag FilePath -> FilePath) -> Flag FilePath -> FilePath
    forall a b. (a -> b) -> a -> b
    $ TestFlags -> Flag FilePath
    testDistPref TestFlags
    flags
            testLogDir :: FilePath
    testLogDir = FilePath
    distPref FilePath -> FilePath -> FilePath
    </> FilePath
    "test"
            testNames :: Args
    testNames = Args
    args
            pkgTests :: [TestSuite]
    pkgTests = PackageDescription -> [TestSuite]
    PD.testSuites PackageDescription
    pkg_descr
            enabledTests :: [(TestSuite, ComponentLocalBuildInfo)]
    enabledTests = PackageDescription
    -> LocalBuildInfo -> [(TestSuite, ComponentLocalBuildInfo)]
    LBI.enabledTestLBIs PackageDescription
    pkg_descr LocalBuildInfo
    lbi

            doTest :: ((PD.TestSuite, LBI.ComponentLocalBuildInfo),
                        Maybe TestSuiteLog) -> IO TestSuiteLog
            doTest :: ((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)
    -> IO TestSuiteLog
    doTest ((TestSuite
    suite, ComponentLocalBuildInfo
    clbi), Maybe TestSuiteLog
    _) =
                case TestSuite -> TestSuiteInterface
    PD.testInterface TestSuite
    suite of
                  PD.TestSuiteExeV10 Version
    _ FilePath
    _ ->
                      PackageDescription
    -> LocalBuildInfo
    -> ComponentLocalBuildInfo
    -> TestFlags
    -> TestSuite
    -> IO TestSuiteLog
    ExeV10.runTest PackageDescription
    pkg_descr LocalBuildInfo
    lbi ComponentLocalBuildInfo
    clbi TestFlags
    flags TestSuite
    suite

                  PD.TestSuiteLibV09 Version
    _ ModuleName
    _ ->
                      PackageDescription
    -> LocalBuildInfo
    -> ComponentLocalBuildInfo
    -> TestFlags
    -> TestSuite
    -> IO TestSuiteLog
    LibV09.runTest PackageDescription
    pkg_descr LocalBuildInfo
    lbi ComponentLocalBuildInfo
    clbi TestFlags
    flags TestSuite
    suite

                  TestSuiteInterface
    _ -> TestSuiteLog -> IO TestSuiteLog
    forall (m :: * -> *) a. Monad m => a -> m a
    return TestSuiteLog
                      { testSuiteName :: UnqualComponentName
    testSuiteName = TestSuite -> UnqualComponentName
    PD.testName TestSuite
    suite
                      , testLogs :: TestLogs
    testLogs = TestLog
                          { testName :: FilePath
    testName = UnqualComponentName -> FilePath
    unUnqualComponentName (UnqualComponentName -> FilePath)
    -> UnqualComponentName -> FilePath
    forall a b. (a -> b) -> a -> b
    $ TestSuite -> UnqualComponentName
    PD.testName TestSuite
    suite
                          , testOptionsReturned :: Options
    testOptionsReturned = []
                          , testResult :: Result
    testResult =
                              FilePath -> Result
    Error (FilePath -> Result) -> FilePath -> Result
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "No support for running test suite type: "
                                      FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Doc -> FilePath
    forall a. Show a => a -> FilePath
    show (TestType -> Doc
    forall a. Pretty a => a -> Doc
    pretty (TestType -> Doc) -> TestType -> Doc
    forall a b. (a -> b) -> a -> b
    $ TestSuite -> TestType
    PD.testType TestSuite
    suite)
                          }
                      , logFile :: FilePath
    logFile = FilePath
    ""
                      }

        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (PackageDescription -> Bool
    PD.hasTests PackageDescription
    pkg_descr) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
            Verbosity -> FilePath -> IO ()
    notice Verbosity
    verbosity FilePath
    "Package has no test suites."
            IO ()
    forall a. IO a
    exitSuccess

        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (PackageDescription -> Bool
    PD.hasTests PackageDescription
    pkg_descr Bool -> Bool -> Bool
    && [(TestSuite, ComponentLocalBuildInfo)] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(TestSuite, ComponentLocalBuildInfo)]
    enabledTests) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            Verbosity -> FilePath -> IO ()
    forall a. Verbosity -> FilePath -> IO a
    die' Verbosity
    verbosity (FilePath -> IO ()) -> FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                  FilePath
    "No test suites enabled. Did you remember to configure with "
               FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    "\'--enable-tests\'?"

        [((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)]
    testsToRun <- case Args
    testNames of
                [] -> [((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)]
    -> IO [((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)]
     -> IO [((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)])
    -> [((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)]
    -> IO [((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)]
    forall a b. (a -> b) -> a -> b
    $ [(TestSuite, ComponentLocalBuildInfo)]
    -> [Maybe TestSuiteLog]
    -> [((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [(TestSuite, ComponentLocalBuildInfo)]
    enabledTests ([Maybe TestSuiteLog]
     -> [((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)])
    -> [Maybe TestSuiteLog]
    -> [((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)]
    forall a b. (a -> b) -> a -> b
    $ Maybe TestSuiteLog -> [Maybe TestSuiteLog]
    forall a. a -> [a]
    repeat Maybe TestSuiteLog
    forall a. Maybe a
    Nothing
                Args
    names -> Args
    -> (FilePath
        -> IO ((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog))
    -> IO [((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    t a -> (a -> f b) -> f (t b)
    for Args
    names ((FilePath
      -> IO ((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog))
     -> IO [((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)])
    -> (FilePath
        -> IO ((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog))
    -> IO [((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)]
    forall a b. (a -> b) -> a -> b
    $ \FilePath
    tName ->
                    let testMap :: [(UnqualComponentName, (TestSuite, ComponentLocalBuildInfo))]
    testMap = [UnqualComponentName]
    -> [(TestSuite, ComponentLocalBuildInfo)]
    -> [(UnqualComponentName, (TestSuite, ComponentLocalBuildInfo))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [UnqualComponentName]
    enabledNames [(TestSuite, ComponentLocalBuildInfo)]
    enabledTests
                        enabledNames :: [UnqualComponentName]
    enabledNames = ((TestSuite, ComponentLocalBuildInfo) -> UnqualComponentName)
    -> [(TestSuite, ComponentLocalBuildInfo)] -> [UnqualComponentName]
    forall a b. (a -> b) -> [a] -> [b]
    map (TestSuite -> UnqualComponentName
    PD.testName (TestSuite -> UnqualComponentName)
    -> ((TestSuite, ComponentLocalBuildInfo) -> TestSuite)
    -> (TestSuite, ComponentLocalBuildInfo)
    -> UnqualComponentName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (TestSuite, ComponentLocalBuildInfo) -> TestSuite
    forall a b. (a, b) -> a
    fst) [(TestSuite, ComponentLocalBuildInfo)]
    enabledTests
                        allNames :: [UnqualComponentName]
    allNames = (TestSuite -> UnqualComponentName)
    -> [TestSuite] -> [UnqualComponentName]
    forall a b. (a -> b) -> [a] -> [b]
    map TestSuite -> UnqualComponentName
    PD.testName [TestSuite]
    pkgTests
                        tCompName :: UnqualComponentName
    tCompName = FilePath -> UnqualComponentName
    mkUnqualComponentName FilePath
    tName
                    in case UnqualComponentName
    -> [(UnqualComponentName, (TestSuite, ComponentLocalBuildInfo))]
    -> Maybe (TestSuite, ComponentLocalBuildInfo)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup UnqualComponentName
    tCompName [(UnqualComponentName, (TestSuite, ComponentLocalBuildInfo))]
    testMap of
                        Just (TestSuite, ComponentLocalBuildInfo)
    t -> ((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)
    -> IO ((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((TestSuite, ComponentLocalBuildInfo)
    t, Maybe TestSuiteLog
    forall a. Maybe a
    Nothing)
                        Maybe (TestSuite, ComponentLocalBuildInfo)
    _ | UnqualComponentName
    tCompName UnqualComponentName -> [UnqualComponentName] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [UnqualComponentName]
    allNames ->
                              Verbosity
    -> FilePath
    -> IO ((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)
    forall a. Verbosity -> FilePath -> IO a
    die' Verbosity
    verbosity (FilePath
     -> IO ((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog))
    -> FilePath
    -> IO ((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "Package configured with test suite "
                                    FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    tName FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    " disabled."
                          | Bool
    otherwise -> Verbosity
    -> FilePath
    -> IO ((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)
    forall a. Verbosity -> FilePath -> IO a
    die' Verbosity
    verbosity (FilePath
     -> IO ((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog))
    -> FilePath
    -> IO ((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "no such test: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    tName

        Bool -> FilePath -> IO ()
    createDirectoryIfMissing Bool
    True FilePath
    testLogDir

        -- Delete ordinary files from test log directory.
        FilePath -> IO Args
    getDirectoryContents FilePath
    testLogDir
            IO Args -> (Args -> IO Args) -> IO Args
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (FilePath -> IO Bool) -> Args -> IO Args
    forall (m :: * -> *) a.
    Applicative m =>
    (a -> m Bool) -> [a] -> m [a]
    filterM FilePath -> IO Bool
    doesFileExist (Args -> IO Args) -> (Args -> Args) -> Args -> IO Args
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FilePath -> FilePath) -> Args -> Args
    forall a b. (a -> b) -> [a] -> [b]
    map (FilePath
    testLogDir FilePath -> FilePath -> FilePath
    </>)
            IO Args -> (Args -> IO ()) -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (FilePath -> IO ()) -> Args -> IO ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    (a -> f b) -> t a -> f ()
    traverse_ FilePath -> IO ()
    removeFile

        let totalSuites :: Int
    totalSuites = [((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)]
    testsToRun
        Verbosity -> FilePath -> IO ()
    notice Verbosity
    verbosity (FilePath -> IO ()) -> FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "Running " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    totalSuites FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    " test suites..."
        [TestSuiteLog]
    suites <- (((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)
     -> IO TestSuiteLog)
    -> [((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)]
    -> IO [TestSuiteLog]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse ((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)
    -> IO TestSuiteLog
    doTest [((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)]
    testsToRun
        let packageLog :: PackageLog
    packageLog = (PackageDescription -> LocalBuildInfo -> PackageLog
    localPackageLog PackageDescription
    pkg_descr LocalBuildInfo
    lbi) { testSuites :: [TestSuiteLog]
    testSuites = [TestSuiteLog]
    suites }
            packageLogFile :: FilePath
    packageLogFile = FilePath -> FilePath -> FilePath
    (</>) FilePath
    testLogDir
                (FilePath -> FilePath) -> FilePath -> FilePath
    forall a b. (a -> b) -> a -> b
    $ PathTemplate -> PackageDescription -> LocalBuildInfo -> FilePath
    packageLogPath PathTemplate
    machineTemplate PackageDescription
    pkg_descr LocalBuildInfo
    lbi
        Bool
    allOk <- Verbosity -> PackageLog -> IO Bool
    summarizePackage Verbosity
    verbosity PackageLog
    packageLog
        FilePath -> FilePath -> IO ()
    writeFile FilePath
    packageLogFile (FilePath -> IO ()) -> FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ PackageLog -> FilePath
    forall a. Show a => a -> FilePath
    show PackageLog
    packageLog

        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (LocalBuildInfo -> Bool
    LBI.testCoverage LocalBuildInfo
    lbi) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            Verbosity
    -> LocalBuildInfo
    -> FilePath
    -> PackageDescription
    -> [TestSuite]
    -> IO ()
    markupPackage Verbosity
    verbosity LocalBuildInfo
    lbi FilePath
    distPref PackageDescription
    pkg_descr ([TestSuite] -> IO ()) -> [TestSuite] -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                (((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)
     -> TestSuite)
    -> [((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)]
    -> [TestSuite]
    forall a b. (a -> b) -> [a] -> [b]
    map ((TestSuite, ComponentLocalBuildInfo) -> TestSuite
    forall a b. (a, b) -> a
    fst ((TestSuite, ComponentLocalBuildInfo) -> TestSuite)
    -> (((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)
        -> (TestSuite, ComponentLocalBuildInfo))
    -> ((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)
    -> TestSuite
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)
    -> (TestSuite, ComponentLocalBuildInfo)
    forall a b. (a, b) -> a
    fst) [((TestSuite, ComponentLocalBuildInfo), Maybe TestSuiteLog)]
    testsToRun

        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    allOk IO ()
    forall a. IO a
    exitFailure

    packageLogPath :: PathTemplate
                   -> PD.PackageDescription
                   -> LBI.LocalBuildInfo
                   -> FilePath
    packageLogPath :: PathTemplate -> PackageDescription -> LocalBuildInfo -> FilePath
    packageLogPath PathTemplate
    template PackageDescription
    pkg_descr LocalBuildInfo
    lbi =
        PathTemplate -> FilePath
    fromPathTemplate (PathTemplate -> FilePath) -> PathTemplate -> FilePath
    forall a b. (a -> b) -> a -> b
    $ PathTemplateEnv -> PathTemplate -> PathTemplate
    substPathTemplate PathTemplateEnv
    env PathTemplate
    template
        where
            env :: PathTemplateEnv
    env = PackageIdentifier
    -> UnitId -> CompilerInfo -> Platform -> PathTemplateEnv
    initialPathTemplateEnv
                    (PackageDescription -> PackageIdentifier
    PD.package PackageDescription
    pkg_descr) (LocalBuildInfo -> UnitId
    LBI.localUnitId LocalBuildInfo
    lbi)
                    (Compiler -> CompilerInfo
    compilerInfo (Compiler -> CompilerInfo) -> Compiler -> CompilerInfo
    forall a b. (a -> b) -> a -> b
    $ LocalBuildInfo -> Compiler
    LBI.compiler LocalBuildInfo
    lbi) (LocalBuildInfo -> Platform
    LBI.hostPlatform LocalBuildInfo
    lbi)