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

    module Distribution.Simple.Test.LibV09
      ( runTest
      -- Test stub
      , simpleTestStub
      , stubFilePath
      , stubMain
      , stubName
      , stubWriteLog
      , writeSimpleTestStub
      ) where

    import Distribution.Compat.Prelude
    import Distribution.Types.UnqualComponentName
    import Prelude ()

    import Distribution.Compat.Environment
    import Distribution.Compat.Internal.TempFile
    import Distribution.ModuleName
    import qualified Distribution.PackageDescription as PD
    import Distribution.Pretty
    import Distribution.Simple.Build.PathsModule
    import Distribution.Simple.BuildPaths
    import Distribution.Simple.Compiler
    import Distribution.Simple.Flag (Flag (Flag, NoFlag), fromFlag)
    import Distribution.Simple.Hpc
    import Distribution.Simple.InstallDirs
    import qualified Distribution.Simple.LocalBuildInfo as LBI
    import Distribution.Simple.Setup.Test
    import Distribution.Simple.Test.Log
    import Distribution.Simple.Utils
    import Distribution.System
    import Distribution.TestSuite
    import qualified Distribution.Types.LocalBuildInfo as LBI
    import Distribution.Verbosity

    import qualified Control.Exception as CE
    import qualified Data.ByteString.Lazy as LBS
    import Distribution.Compat.Process (proc)
    import Distribution.Simple.Errors
    import System.Directory
      ( canonicalizePath
      , createDirectoryIfMissing
      , doesDirectoryExist
      , doesFileExist
      , getCurrentDirectory
      , removeDirectoryRecursive
      , removeFile
      , setCurrentDirectory
      )
    import System.FilePath ((<.>), (</>))
    import System.IO (hClose, hPutStr)
    import qualified System.Process as Process

    runTest
      :: PD.PackageDescription
      -> LBI.LocalBuildInfo
      -> LBI.ComponentLocalBuildInfo
      -> HPCMarkupInfo
      -> TestFlags
      -> PD.TestSuite
      -> IO TestSuiteLog
    runTest :: PackageDescription
    -> LocalBuildInfo
    -> ComponentLocalBuildInfo
    -> HPCMarkupInfo
    -> TestFlags
    -> TestSuite
    -> IO TestSuiteLog
    runTest PackageDescription
    pkg_descr LocalBuildInfo
    lbi ComponentLocalBuildInfo
    clbi HPCMarkupInfo
    hpcMarkupInfo TestFlags
    flags TestSuite
    suite = do
      let isCoverageEnabled :: Bool
    isCoverageEnabled = LocalBuildInfo -> Bool
    LBI.testCoverage LocalBuildInfo
    lbi
          way :: Way
    way = LocalBuildInfo -> Way
    guessWay LocalBuildInfo
    lbi

      pwd <- IO [Char]
    getCurrentDirectory
      existingEnv <- getEnvironment

      let cmd =
            LocalBuildInfo -> [Char]
    LBI.buildDir LocalBuildInfo
    lbi
              [Char] -> [Char] -> [Char]
    </> TestSuite -> [Char]
    stubName TestSuite
    suite
              [Char] -> [Char] -> [Char]
    </> TestSuite -> [Char]
    stubName TestSuite
    suite [Char] -> [Char] -> [Char]
    <.> Platform -> [Char]
    exeExtension (LocalBuildInfo -> Platform
    LBI.hostPlatform LocalBuildInfo
    lbi)
      -- Check that the test executable exists.
      exists <- doesFileExist cmd
      unless exists $
        dieWithException verbosity $
          Couldn'tFindTestProgLibV09 cmd

      -- Remove old .tix files if appropriate.
      unless (fromFlag $ testKeepTix flags) $ do
        let tDir = [Char] -> Way -> [Char]
    tixDir [Char]
    distPref Way
    way
        exists' <- doesDirectoryExist tDir
        when exists' $ removeDirectoryRecursive tDir

      -- Create directory for HPC files.
      createDirectoryIfMissing True $ tixDir distPref way

      -- Write summary notices indicating start of test suite
      notice verbosity $ summarizeSuiteStart testName'

      suiteLog <- CE.bracket openCabalTemp deleteIfExists $ \[Char]
    tempLog -> do
        -- Run test executable
        let opts :: [[Char]]
    opts = (PathTemplate -> [Char]) -> [PathTemplate] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map (PackageDescription
    -> LocalBuildInfo -> TestSuite -> PathTemplate -> [Char]
    testOption PackageDescription
    pkg_descr LocalBuildInfo
    lbi TestSuite
    suite) ([PathTemplate] -> [[Char]]) -> [PathTemplate] -> [[Char]]
    forall a b. (a -> b) -> a -> b
    $ TestFlags -> [PathTemplate]
    testOptions TestFlags
    flags
            dataDirPath :: [Char]
    dataDirPath = [Char]
    pwd [Char] -> [Char] -> [Char]
    </> PackageDescription -> [Char]
    PD.dataDir PackageDescription
    pkg_descr
            tixFile :: [Char]
    tixFile = [Char]
    pwd [Char] -> [Char] -> [Char]
    </> [Char] -> Way -> [Char] -> [Char]
    tixFilePath [Char]
    distPref Way
    way [Char]
    testName'
            pkgPathEnv :: [([Char], [Char])]
    pkgPathEnv =
              (PackageDescription -> [Char] -> [Char]
    pkgPathEnvVar PackageDescription
    pkg_descr [Char]
    "datadir", [Char]
    dataDirPath)
                ([Char], [Char]) -> [([Char], [Char])] -> [([Char], [Char])]
    forall a. a -> [a] -> [a]
    : [([Char], [Char])]
    existingEnv
            shellEnv :: [([Char], [Char])]
    shellEnv =
              [([Char]
    "HPCTIXFILE", [Char]
    tixFile) | Bool
    isCoverageEnabled]
                [([Char], [Char])] -> [([Char], [Char])] -> [([Char], [Char])]
    forall a. [a] -> [a] -> [a]
    ++ [([Char], [Char])]
    pkgPathEnv
        -- Add (DY)LD_LIBRARY_PATH if needed
        shellEnv' <-
          if LocalBuildInfo -> Bool
    LBI.withDynExe LocalBuildInfo
    lbi
            then do
              let (Platform Arch
    _ OS
    os) = LocalBuildInfo -> Platform
    LBI.hostPlatform LocalBuildInfo
    lbi
              paths <- Bool
    -> Bool -> LocalBuildInfo -> ComponentLocalBuildInfo -> IO [[Char]]
    LBI.depLibraryPaths Bool
    True Bool
    False LocalBuildInfo
    lbi ComponentLocalBuildInfo
    clbi
              cpath <- canonicalizePath $ LBI.componentBuildDir lbi clbi
              return (addLibraryPath os (cpath : paths) shellEnv)
            else [([Char], [Char])] -> IO [([Char], [Char])]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [([Char], [Char])]
    shellEnv
        let (cmd', opts') = case testWrapper flags of
              Flag [Char]
    path -> ([Char]
    path, [Char]
    cmd [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [[Char]]
    opts)
              Flag [Char]
    NoFlag -> ([Char]
    cmd, [[Char]]
    opts)

        -- TODO: this setup is broken,
        -- if the test output is too big, we will deadlock.
        (rOut, wOut) <- Process.createPipe
        (exitcode, logText) <- rawSystemProcAction
          verbosity
          (proc cmd' opts')
            { Process.env = Just shellEnv'
            , Process.std_in = Process.CreatePipe
            , Process.std_out = Process.UseHandle wOut
            , Process.std_err = Process.UseHandle wOut
            }
          $ \Maybe Handle
    mIn Maybe Handle
    _ Maybe Handle
    _ -> do
            let wIn :: Handle
    wIn = Maybe Handle -> Handle
    fromCreatePipe Maybe Handle
    mIn
            Handle -> [Char] -> IO ()
    hPutStr Handle
    wIn ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ([Char], UnqualComponentName) -> [Char]
    forall a. Show a => a -> [Char]
    show ([Char]
    tempLog, TestSuite -> UnqualComponentName
    PD.testName TestSuite
    suite)
            Handle -> IO ()
    hClose Handle
    wIn

            -- Append contents of temporary log file to the final human-
            -- readable log file
            logText <- Handle -> IO ByteString
    LBS.hGetContents Handle
    rOut
            -- Force the IO manager to drain the test output pipe
            _ <- evaluate (force logText)
            return logText
        unless (exitcode == ExitSuccess) $
          debug verbosity $
            cmd ++ " returned " ++ show exitcode

        -- Generate final log file name
        let finalLogName TestSuiteLog
    l =
              [Char]
    testLogDir
                [Char] -> [Char] -> [Char]
    </> PathTemplate
    -> PackageDescription
    -> LocalBuildInfo
    -> [Char]
    -> TestLogs
    -> [Char]
    testSuiteLogPath
                  (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
    testHumanLog TestFlags
    flags)
                  PackageDescription
    pkg_descr
                  LocalBuildInfo
    lbi
                  (UnqualComponentName -> [Char]
    unUnqualComponentName (UnqualComponentName -> [Char]) -> UnqualComponentName -> [Char]
    forall a b. (a -> b) -> a -> b
    $ TestSuiteLog -> UnqualComponentName
    testSuiteName TestSuiteLog
    l)
                  (TestSuiteLog -> TestLogs
    testLogs TestSuiteLog
    l)
        -- Generate TestSuiteLog from executable exit code and a machine-
        -- readable test log
        suiteLog <-
          fmap
            ( \[Char]
    s ->
                (\TestSuiteLog
    l -> TestSuiteLog
    l{logFile = finalLogName l})
                  (TestSuiteLog -> TestSuiteLog)
    -> (Maybe TestSuiteLog -> TestSuiteLog)
    -> Maybe TestSuiteLog
    -> TestSuiteLog
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TestSuiteLog -> Maybe TestSuiteLog -> TestSuiteLog
    forall a. a -> Maybe a -> a
    fromMaybe ([Char] -> TestSuiteLog
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> TestSuiteLog) -> [Char] -> TestSuiteLog
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "panic! read @TestSuiteLog " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    s)
                  (Maybe TestSuiteLog -> TestSuiteLog)
    -> Maybe TestSuiteLog -> TestSuiteLog
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Maybe TestSuiteLog
    forall a. Read a => [Char] -> Maybe a
    readMaybe [Char]
    s -- TODO: eradicateNoParse
            )
            $ readFile tempLog

        -- Write summary notice to log file indicating start of test suite
        appendFile (logFile suiteLog) $ summarizeSuiteStart testName'

        LBS.appendFile (logFile suiteLog) logText

        -- Write end-of-suite summary notice to log file
        appendFile (logFile suiteLog) $ summarizeSuiteFinish suiteLog

        -- Show the contents of the human-readable log file on the terminal
        -- if there is a failure and/or detailed output is requested
        let details = Flag TestShowDetails -> TestShowDetails
    forall a. WithCallStack (Flag a -> a)
    fromFlag (Flag TestShowDetails -> TestShowDetails)
    -> Flag TestShowDetails -> TestShowDetails
    forall a b. (a -> b) -> a -> b
    $ TestFlags -> Flag TestShowDetails
    testShowDetails TestFlags
    flags
            whenPrinting =
              Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> IO () -> IO ()) -> Bool -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                (TestShowDetails
    details TestShowDetails -> TestShowDetails -> Bool
    forall a. Ord a => a -> a -> Bool
    > TestShowDetails
    Never)
                  Bool -> Bool -> Bool
    && (Bool -> Bool
    not (TestLogs -> Bool
    suitePassed (TestLogs -> Bool) -> TestLogs -> Bool
    forall a b. (a -> b) -> a -> b
    $ TestSuiteLog -> TestLogs
    testLogs TestSuiteLog
    suiteLog) Bool -> Bool -> Bool
    || TestShowDetails
    details TestShowDetails -> TestShowDetails -> Bool
    forall a. Eq a => a -> a -> Bool
    == TestShowDetails
    Always)
                  Bool -> Bool -> Bool
    && Verbosity
    verbosity Verbosity -> Verbosity -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Verbosity
    normal
        whenPrinting $ do
          LBS.putStr logText
          putChar '\n'

        return suiteLog

      -- Write summary notice to terminal indicating end of test suite
      notice verbosity $ summarizeSuiteFinish suiteLog

      when isCoverageEnabled $ do
        -- Until #9493 is fixed, we expect cabal-install to pass one dist dir per
        -- library and there being at least one library in the package with the
        -- testsuite.  When it is fixed, we can remove this predicate and allow a
        -- testsuite without a library to cover libraries in other packages of the
        -- same project
        when (null $ PD.allLibraries pkg_descr) $
          dieWithException verbosity TestCoverageSupport

        markupPackage verbosity hpcMarkupInfo lbi distPref pkg_descr [suite]

      return suiteLog
      where
        testName' :: [Char]
    testName' = UnqualComponentName -> [Char]
    unUnqualComponentName (UnqualComponentName -> [Char]) -> UnqualComponentName -> [Char]
    forall a b. (a -> b) -> a -> b
    $ TestSuite -> UnqualComponentName
    PD.testName TestSuite
    suite

        deleteIfExists :: [Char] -> IO ()
    deleteIfExists [Char]
    file = do
          exists <- [Char] -> IO Bool
    doesFileExist [Char]
    file
          when exists $ removeFile file

        testLogDir :: [Char]
    testLogDir = [Char]
    distPref [Char] -> [Char] -> [Char]
    </> [Char]
    "test"
        openCabalTemp :: IO [Char]
    openCabalTemp = do
          (f, h) <- [Char] -> [Char] -> IO ([Char], Handle)
    openTempFile [Char]
    testLogDir ([Char] -> IO ([Char], Handle)) -> [Char] -> IO ([Char], Handle)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "cabal-test-" [Char] -> [Char] -> [Char]
    <.> [Char]
    "log"
          hClose h >> return f

        distPref :: [Char]
    distPref = Flag [Char] -> [Char]
    forall a. WithCallStack (Flag a -> a)
    fromFlag (Flag [Char] -> [Char]) -> Flag [Char] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ TestFlags -> Flag [Char]
    testDistPref TestFlags
    flags
        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

    -- TODO: This is abusing the notion of a 'PathTemplate'.  The result isn't
    -- necessarily a path.
    testOption
      :: PD.PackageDescription
      -> LBI.LocalBuildInfo
      -> PD.TestSuite
      -> PathTemplate
      -> String
    testOption :: PackageDescription
    -> LocalBuildInfo -> TestSuite -> PathTemplate -> [Char]
    testOption PackageDescription
    pkg_descr LocalBuildInfo
    lbi TestSuite
    suite PathTemplate
    template =
      PathTemplate -> [Char]
    fromPathTemplate (PathTemplate -> [Char]) -> PathTemplate -> [Char]
    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)
            PathTemplateEnv -> PathTemplateEnv -> PathTemplateEnv
    forall a. [a] -> [a] -> [a]
    ++ [(PathTemplateVariable
    TestSuiteNameVar, [Char] -> PathTemplate
    toPathTemplate ([Char] -> PathTemplate) -> [Char] -> PathTemplate
    forall a b. (a -> b) -> a -> b
    $ UnqualComponentName -> [Char]
    unUnqualComponentName (UnqualComponentName -> [Char]) -> UnqualComponentName -> [Char]
    forall a b. (a -> b) -> a -> b
    $ TestSuite -> UnqualComponentName
    PD.testName TestSuite
    suite)]

    -- Test stub ----------

    -- | The name of the stub executable associated with a library 'TestSuite'.
    stubName :: PD.TestSuite -> FilePath
    stubName :: TestSuite -> [Char]
    stubName TestSuite
    t = UnqualComponentName -> [Char]
    unUnqualComponentName (TestSuite -> UnqualComponentName
    PD.testName TestSuite
    t) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Stub"

    -- | The filename of the source file for the stub executable associated with a
    -- library 'TestSuite'.
    stubFilePath :: PD.TestSuite -> FilePath
    stubFilePath :: TestSuite -> [Char]
    stubFilePath TestSuite
    t = TestSuite -> [Char]
    stubName TestSuite
    t [Char] -> [Char] -> [Char]
    <.> [Char]
    "hs"

    -- | Write the source file for a library 'TestSuite' stub executable.
    writeSimpleTestStub
      :: PD.TestSuite
      -- ^ library 'TestSuite' for which a stub
      -- is being created
      -> FilePath
      -- ^ path to directory where stub source
      -- should be located
      -> IO ()
    writeSimpleTestStub :: TestSuite -> [Char] -> IO ()
    writeSimpleTestStub TestSuite
    t [Char]
    dir = do
      Bool -> [Char] -> IO ()
    createDirectoryIfMissing Bool
    True [Char]
    dir
      let filename :: [Char]
    filename = [Char]
    dir [Char] -> [Char] -> [Char]
    </> TestSuite -> [Char]
    stubFilePath TestSuite
    t
          m :: ModuleName
    m = case TestSuite -> TestSuiteInterface
    PD.testInterface TestSuite
    t of
            PD.TestSuiteLibV09 Version
    _ ModuleName
    m' -> ModuleName
    m'
            TestSuiteInterface
    _ -> [Char] -> ModuleName
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "writeSimpleTestStub: invalid TestSuite passed"
      [Char] -> [Char] -> IO ()
    writeFile [Char]
    filename ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ModuleName -> [Char]
    simpleTestStub ModuleName
    m

    -- | Source code for library test suite stub executable
    simpleTestStub :: ModuleName -> String
    simpleTestStub :: ModuleName -> [Char]
    simpleTestStub ModuleName
    m =
      [[Char]] -> [Char]
    unlines
        [ [Char]
    "module Main ( main ) where"
        , [Char]
    "import Distribution.Simple.Test.LibV09 ( stubMain )"
        , [Char]
    "import " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Doc -> [Char]
    forall a. Show a => a -> [Char]
    show (ModuleName -> Doc
    forall a. Pretty a => a -> Doc
    pretty ModuleName
    m) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " ( tests )"
        , [Char]
    "main :: IO ()"
        , [Char]
    "main = stubMain tests"
        ]

    -- | Main function for test stubs. Once, it was written directly into the stub,
    -- but minimizing the amount of code actually in the stub maximizes the number
    -- of detectable errors when Cabal is compiled.
    stubMain :: IO [Test] -> IO ()
    stubMain :: IO [Test] -> IO ()
    stubMain IO [Test]
    tests = do
      (f, n) <- ([Char] -> ([Char], UnqualComponentName))
    -> IO [Char] -> IO ([Char], UnqualComponentName)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\[Char]
    s -> ([Char], UnqualComponentName)
    -> Maybe ([Char], UnqualComponentName)
    -> ([Char], UnqualComponentName)
    forall a. a -> Maybe a -> a
    fromMaybe ([Char] -> ([Char], UnqualComponentName)
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> ([Char], UnqualComponentName))
    -> [Char] -> ([Char], UnqualComponentName)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "panic! read " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    s) (Maybe ([Char], UnqualComponentName)
     -> ([Char], UnqualComponentName))
    -> Maybe ([Char], UnqualComponentName)
    -> ([Char], UnqualComponentName)
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Maybe ([Char], UnqualComponentName)
    forall a. Read a => [Char] -> Maybe a
    readMaybe [Char]
    s) IO [Char]
    getContents -- TODO: eradicateNoParse
      dir <- getCurrentDirectory
      results <- (tests >>= stubRunTests) `CE.catch` errHandler
      setCurrentDirectory dir
      stubWriteLog f n results
      where
        errHandler :: CE.SomeException -> IO TestLogs
        errHandler :: SomeException -> IO TestLogs
    errHandler SomeException
    e = case SomeException -> Maybe AsyncException
    forall e. Exception e => SomeException -> Maybe e
    CE.fromException SomeException
    e of
          Just AsyncException
    CE.UserInterrupt -> SomeException -> IO TestLogs
    forall e a. (HasCallStack, Exception e) => e -> IO a
    CE.throwIO SomeException
    e
          Maybe AsyncException
    _ ->
            TestLogs -> IO TestLogs
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TestLogs -> IO TestLogs) -> TestLogs -> IO TestLogs
    forall a b. (a -> b) -> a -> b
    $
              TestLog
                { testName :: [Char]
    testName = [Char]
    "Cabal test suite exception"
                , testOptionsReturned :: [([Char], [Char])]
    testOptionsReturned = []
                , testResult :: Result
    testResult = [Char] -> Result
    Error ([Char] -> Result) -> [Char] -> Result
    forall a b. (a -> b) -> a -> b
    $ SomeException -> [Char]
    forall a. Show a => a -> [Char]
    show SomeException
    e
                }

    -- | The test runner used in library "TestSuite" stub executables.  Runs a list
    -- of 'Test's.  An executable calling this function is meant to be invoked as
    -- the child of a Cabal process during @.\/setup test@.  A 'TestSuiteLog',
    -- provided by Cabal, is read from the standard input; it supplies the name of
    -- the test suite and the location of the machine-readable test suite log file.
    -- Human-readable log information is written to the standard output for capture
    -- by the calling Cabal process.
    stubRunTests :: [Test] -> IO TestLogs
    stubRunTests :: [Test] -> IO TestLogs
    stubRunTests [Test]
    tests = do
      logs <- (Test -> IO TestLogs) -> [Test] -> IO [TestLogs]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse Test -> IO TestLogs
    stubRunTests' [Test]
    tests
      return $ GroupLogs "Default" logs
      where
        stubRunTests' :: Test -> IO TestLogs
    stubRunTests' (Test TestInstance
    t) = do
          l <- TestInstance -> IO Progress
    run TestInstance
    t IO Progress -> (Progress -> IO TestLogs) -> IO TestLogs
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Progress -> IO TestLogs
    finish
          summarizeTest normal Always l
          return l
          where
            finish :: Progress -> IO TestLogs
    finish (Finished Result
    result) =
              TestLogs -> IO TestLogs
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
                TestLog
                  { testName :: [Char]
    testName = TestInstance -> [Char]
    name TestInstance
    t
                  , testOptionsReturned :: [([Char], [Char])]
    testOptionsReturned = TestInstance -> [([Char], [Char])]
    defaultOptions TestInstance
    t
                  , testResult :: Result
    testResult = Result
    result
                  }
            finish (Progress [Char]
    _ IO Progress
    next) = IO Progress
    next IO Progress -> (Progress -> IO TestLogs) -> IO TestLogs
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Progress -> IO TestLogs
    finish
        stubRunTests' g :: Test
    g@(Group{}) = do
          logs <- (Test -> IO TestLogs) -> [Test] -> IO [TestLogs]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse Test -> IO TestLogs
    stubRunTests' ([Test] -> IO [TestLogs]) -> [Test] -> IO [TestLogs]
    forall a b. (a -> b) -> a -> b
    $ Test -> [Test]
    groupTests Test
    g
          return $ GroupLogs (groupName g) logs
        stubRunTests' (ExtraOptions [OptionDescr]
    _ Test
    t) = Test -> IO TestLogs
    stubRunTests' Test
    t
        maybeDefaultOption :: OptionDescr -> Maybe ([Char], [Char])
    maybeDefaultOption OptionDescr
    opt =
          Maybe ([Char], [Char])
    -> ([Char] -> Maybe ([Char], [Char]))
    -> Maybe [Char]
    -> Maybe ([Char], [Char])
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Maybe ([Char], [Char])
    forall a. Maybe a
    Nothing (\[Char]
    d -> ([Char], [Char]) -> Maybe ([Char], [Char])
    forall a. a -> Maybe a
    Just (OptionDescr -> [Char]
    optionName OptionDescr
    opt, [Char]
    d)) (Maybe [Char] -> Maybe ([Char], [Char]))
    -> Maybe [Char] -> Maybe ([Char], [Char])
    forall a b. (a -> b) -> a -> b
    $ OptionDescr -> Maybe [Char]
    optionDefault OptionDescr
    opt
        defaultOptions :: TestInstance -> [([Char], [Char])]
    defaultOptions TestInstance
    testInst = (OptionDescr -> Maybe ([Char], [Char]))
    -> [OptionDescr] -> [([Char], [Char])]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe OptionDescr -> Maybe ([Char], [Char])
    maybeDefaultOption ([OptionDescr] -> [([Char], [Char])])
    -> [OptionDescr] -> [([Char], [Char])]
    forall a b. (a -> b) -> a -> b
    $ TestInstance -> [OptionDescr]
    options TestInstance
    testInst

    -- | From a test stub, write the 'TestSuiteLog' to temporary file for the calling
    -- Cabal process to read.
    stubWriteLog :: FilePath -> UnqualComponentName -> TestLogs -> IO ()
    stubWriteLog :: [Char] -> UnqualComponentName -> TestLogs -> IO ()
    stubWriteLog [Char]
    f UnqualComponentName
    n TestLogs
    logs = do
      let testLog :: TestSuiteLog
    testLog = TestSuiteLog{testSuiteName :: UnqualComponentName
    testSuiteName = UnqualComponentName
    n, testLogs :: TestLogs
    testLogs = TestLogs
    logs, logFile :: [Char]
    logFile = [Char]
    f}
      [Char] -> [Char] -> IO ()
    writeFile (TestSuiteLog -> [Char]
    logFile TestSuiteLog
    testLog) ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ TestSuiteLog -> [Char]
    forall a. Show a => a -> [Char]
    show TestSuiteLog
    testLog
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (TestLogs -> Bool
    suiteError TestLogs
    logs) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ExitCode -> IO ()
    forall a. ExitCode -> IO a
    exitWith (ExitCode -> IO ()) -> ExitCode -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> ExitCode
    ExitFailure Int
    2
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (TestLogs -> Bool
    suiteFailed TestLogs
    logs) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ExitCode -> IO ()
    forall a. ExitCode -> IO a
    exitWith (ExitCode -> IO ()) -> ExitCode -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> ExitCode
    ExitFailure Int
    1
      IO ()
    forall a. IO a
    exitSuccess