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

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

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

    import Distribution.Compat.CreatePipe
    import Distribution.Compat.Environment
    import Distribution.Compat.Internal.TempFile
    import Distribution.ModuleName
    import qualified Distribution.PackageDescription as PD
    import Distribution.Simple.Build.PathsModule
    import Distribution.Simple.BuildPaths
    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.Test.Log
    import Distribution.Simple.Utils
    import Distribution.System
    import Distribution.TestSuite
    import Distribution.Pretty
    import Distribution.Verbosity

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

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

        String
    pwd <- IO String
    getCurrentDirectory
        [(String, String)]
    existingEnv <- IO [(String, String)]
    getEnvironment

        let cmd :: String
    cmd = LocalBuildInfo -> String
    LBI.buildDir LocalBuildInfo
    lbi String -> String -> String
    </> TestSuite -> String
    stubName TestSuite
    suite
                      String -> String -> String
    </> TestSuite -> String
    stubName TestSuite
    suite String -> String -> String
    <.> Platform -> String
    exeExtension (LocalBuildInfo -> Platform
    LBI.hostPlatform LocalBuildInfo
    lbi)
        -- Check that the test executable exists.
        Bool
    exists <- String -> IO Bool
    doesFileExist String
    cmd
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    exists (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
          Verbosity -> String -> IO ()
    forall a. Verbosity -> String -> IO a
    die' Verbosity
    verbosity (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Error: Could not find test program \"" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    cmd
                        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\". Did you build the package first?"

        -- Remove old .tix files if appropriate.
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Flag Bool -> Bool
    forall a. WithCallStack (Flag a -> a)
    fromFlag (Flag Bool -> Bool) -> Flag Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ TestFlags -> Flag Bool
    testKeepTix TestFlags
    flags) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
            let tDir :: String
    tDir = String -> Way -> String -> String
    tixDir String
    distPref Way
    way String
    testName'
            Bool
    exists' <- String -> IO Bool
    doesDirectoryExist String
    tDir
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    exists' (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO ()
    removeDirectoryRecursive String
    tDir

        -- Create directory for HPC files.
        Bool -> String -> IO ()
    createDirectoryIfMissing Bool
    True (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> Way -> String -> String
    tixDir String
    distPref Way
    way String
    testName'

        -- Write summary notices indicating start of test suite
        Verbosity -> String -> IO ()
    notice Verbosity
    verbosity (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> String
    summarizeSuiteStart String
    testName'

        TestSuiteLog
    suiteLog <- IO String
    -> (String -> IO ())
    -> (String -> IO TestSuiteLog)
    -> IO TestSuiteLog
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    CE.bracket IO String
    openCabalTemp String -> IO ()
    deleteIfExists ((String -> IO TestSuiteLog) -> IO TestSuiteLog)
    -> (String -> IO TestSuiteLog) -> IO TestSuiteLog
    forall a b. (a -> b) -> a -> b
    $ \String
    tempLog -> do

            -- TODO: this setup is broken,
            -- if the test output is too big, we will deadlock.
            (Handle
    rOut, Handle
    wOut) <- IO (Handle, Handle)
    createPipe

            -- Run test executable
            (Just Handle
    wIn, Maybe Handle
    _, Maybe Handle
    _, ProcessHandle
    process) <- do
                    let opts :: [String]
    opts = (PathTemplate -> String) -> [PathTemplate] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (PackageDescription
    -> LocalBuildInfo -> TestSuite -> PathTemplate -> String
    testOption PackageDescription
    pkg_descr LocalBuildInfo
    lbi TestSuite
    suite) ([PathTemplate] -> [String]) -> [PathTemplate] -> [String]
    forall a b. (a -> b) -> a -> b
    $ TestFlags -> [PathTemplate]
    testOptions TestFlags
    flags
                        dataDirPath :: String
    dataDirPath = String
    pwd String -> String -> String
    </> PackageDescription -> String
    PD.dataDir PackageDescription
    pkg_descr
                        tixFile :: String
    tixFile = String
    pwd String -> String -> String
    </> String -> Way -> String -> String
    tixFilePath String
    distPref Way
    way String
    testName'
                        pkgPathEnv :: [(String, String)]
    pkgPathEnv = (PackageDescription -> String -> String
    pkgPathEnvVar PackageDescription
    pkg_descr String
    "datadir", String
    dataDirPath)
                                   (String, String) -> [(String, String)] -> [(String, String)]
    forall a. a -> [a] -> [a]
    : [(String, String)]
    existingEnv
                        shellEnv :: [(String, String)]
    shellEnv = [(String
    "HPCTIXFILE", String
    tixFile) | Bool
    isCoverageEnabled]
                                 [(String, String)] -> [(String, String)] -> [(String, String)]
    forall a. [a] -> [a] -> [a]
    ++ [(String, String)]
    pkgPathEnv
                    -- Add (DY)LD_LIBRARY_PATH if needed
                    [(String, String)]
    shellEnv' <-
                      if LocalBuildInfo -> Bool
    LBI.withDynExe LocalBuildInfo
    lbi
                      then do
                        let (Platform Arch
    _ OS
    os) = LocalBuildInfo -> Platform
    LBI.hostPlatform LocalBuildInfo
    lbi
                        [String]
    paths <- Bool
    -> Bool -> LocalBuildInfo -> ComponentLocalBuildInfo -> IO [String]
    LBI.depLibraryPaths Bool
    True Bool
    False LocalBuildInfo
    lbi ComponentLocalBuildInfo
    clbi
                        String
    cpath <- String -> IO String
    canonicalizePath (String -> IO String) -> String -> IO String
    forall a b. (a -> b) -> a -> b
    $ LocalBuildInfo -> ComponentLocalBuildInfo -> String
    LBI.componentBuildDir LocalBuildInfo
    lbi ComponentLocalBuildInfo
    clbi
                        [(String, String)] -> IO [(String, String)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OS -> [String] -> [(String, String)] -> [(String, String)]
    addLibraryPath OS
    os (String
    cpath String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    paths) [(String, String)]
    shellEnv)
                      else [(String, String)] -> IO [(String, String)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(String, String)]
    shellEnv
                    case TestFlags -> Flag String
    testWrapper TestFlags
    flags of
                      Flag String
    path -> Verbosity
    -> String
    -> [String]
    -> Maybe String
    -> Maybe [(String, String)]
    -> StdStream
    -> StdStream
    -> StdStream
    -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    createProcessWithEnv Verbosity
    verbosity String
    path (String
    cmdString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    opts) Maybe String
    forall a. Maybe a
    Nothing ([(String, String)] -> Maybe [(String, String)]
    forall a. a -> Maybe a
    Just [(String, String)]
    shellEnv')
                                   -- these handles are closed automatically
                                   StdStream
    CreatePipe (Handle -> StdStream
    UseHandle Handle
    wOut) (Handle -> StdStream
    UseHandle Handle
    wOut)

                      Flag String
    NoFlag -> Verbosity
    -> String
    -> [String]
    -> Maybe String
    -> Maybe [(String, String)]
    -> StdStream
    -> StdStream
    -> StdStream
    -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    createProcessWithEnv Verbosity
    verbosity String
    cmd [String]
    opts Maybe String
    forall a. Maybe a
    Nothing ([(String, String)] -> Maybe [(String, String)]
    forall a. a -> Maybe a
    Just [(String, String)]
    shellEnv')
                                -- these handles are closed automatically
                                StdStream
    CreatePipe (Handle -> StdStream
    UseHandle Handle
    wOut) (Handle -> StdStream
    UseHandle Handle
    wOut)

            Handle -> String -> IO ()
    hPutStr Handle
    wIn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String, UnqualComponentName) -> String
    forall a. Show a => a -> String
    show (String
    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
            ByteString
    logText <- Handle -> IO ByteString
    LBS.hGetContents Handle
    rOut
            -- Force the IO manager to drain the test output pipe
            ByteString
    _ <- ByteString -> IO ByteString
    forall a. a -> IO a
    evaluate (ByteString -> ByteString
    forall a. NFData a => a -> a
    force ByteString
    logText)

            ExitCode
    exitcode <- ProcessHandle -> IO ExitCode
    waitForProcess ProcessHandle
    process
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (ExitCode
    exitcode ExitCode -> ExitCode -> Bool
    forall a. Eq a => a -> a -> Bool
    == ExitCode
    ExitSuccess) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                Verbosity -> String -> IO ()
    debug Verbosity
    verbosity (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    cmd String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " returned " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ExitCode -> String
    forall a. Show a => a -> String
    show ExitCode
    exitcode

            -- Generate final log file name
            let finalLogName :: TestSuiteLog -> String
    finalLogName TestSuiteLog
    l = String
    testLogDir
                                 String -> String -> String
    </> PathTemplate
    -> PackageDescription
    -> LocalBuildInfo
    -> String
    -> TestLogs
    -> String
    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 -> String
    unUnqualComponentName (UnqualComponentName -> String) -> UnqualComponentName -> String
    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
            TestSuiteLog
    suiteLog <- (String -> TestSuiteLog) -> IO String -> IO TestSuiteLog
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\String
    s -> (\TestSuiteLog
    l -> TestSuiteLog
    l { logFile :: String
    logFile = TestSuiteLog -> String
    finalLogName TestSuiteLog
    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 (String -> TestSuiteLog
    forall a. HasCallStack => String -> a
    error (String -> TestSuiteLog) -> String -> TestSuiteLog
    forall a b. (a -> b) -> a -> b
    $ String
    "panic! read @TestSuiteLog " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    s) (Maybe TestSuiteLog -> TestSuiteLog)
    -> Maybe TestSuiteLog -> TestSuiteLog
    forall a b. (a -> b) -> a -> b
    $ String -> Maybe TestSuiteLog
    forall a. Read a => String -> Maybe a
    readMaybe String
    s) -- TODO: eradicateNoParse
                        (IO String -> IO TestSuiteLog) -> IO String -> IO TestSuiteLog
    forall a b. (a -> b) -> a -> b
    $ String -> IO String
    readFile String
    tempLog

            -- Write summary notice to log file indicating start of test suite
            String -> String -> IO ()
    appendFile (TestSuiteLog -> String
    logFile TestSuiteLog
    suiteLog) (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> String
    summarizeSuiteStart String
    testName'

            String -> ByteString -> IO ()
    LBS.appendFile (TestSuiteLog -> String
    logFile TestSuiteLog
    suiteLog) ByteString
    logText

            -- Write end-of-suite summary notice to log file
            String -> String -> IO ()
    appendFile (TestSuiteLog -> String
    logFile TestSuiteLog
    suiteLog) (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ TestSuiteLog -> String
    summarizeSuiteFinish TestSuiteLog
    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 :: TestShowDetails
    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 :: IO () -> IO ()
    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
            IO () -> IO ()
    whenPrinting (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                ByteString -> IO ()
    LBS.putStr ByteString
    logText
                Char -> IO ()
    putChar Char
    '\n'

            TestSuiteLog -> IO TestSuiteLog
    forall (m :: * -> *) a. Monad m => a -> m a
    return TestSuiteLog
    suiteLog

        -- Write summary notice to terminal indicating end of test suite
        Verbosity -> String -> IO ()
    notice Verbosity
    verbosity (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ TestSuiteLog -> String
    summarizeSuiteFinish TestSuiteLog
    suiteLog

        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    isCoverageEnabled (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            case PackageDescription -> Maybe Library
    PD.library PackageDescription
    pkg_descr of
                Maybe Library
    Nothing ->
                    Verbosity -> String -> IO ()
    forall a. Verbosity -> String -> IO a
    die' Verbosity
    verbosity (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Error: test coverage is only supported for packages with a library component"

                Just Library
    library ->
                    Verbosity
    -> LocalBuildInfo
    -> String
    -> String
    -> TestSuite
    -> Library
    -> IO ()
    markupTest Verbosity
    verbosity LocalBuildInfo
    lbi String
    distPref (PackageIdentifier -> String
    forall a. Pretty a => a -> String
    prettyShow (PackageIdentifier -> String) -> PackageIdentifier -> String
    forall a b. (a -> b) -> a -> b
    $ PackageDescription -> PackageIdentifier
    PD.package PackageDescription
    pkg_descr) TestSuite
    suite Library
    library

        TestSuiteLog -> IO TestSuiteLog
    forall (m :: * -> *) a. Monad m => a -> m a
    return TestSuiteLog
    suiteLog
      where
        testName' :: String
    testName' = UnqualComponentName -> String
    unUnqualComponentName (UnqualComponentName -> String) -> UnqualComponentName -> String
    forall a b. (a -> b) -> a -> b
    $ TestSuite -> UnqualComponentName
    PD.testName TestSuite
    suite

        deleteIfExists :: String -> IO ()
    deleteIfExists String
    file = do
            Bool
    exists <- String -> IO Bool
    doesFileExist String
    file
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    exists (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO ()
    removeFile String
    file

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

        distPref :: String
    distPref = Flag String -> String
    forall a. WithCallStack (Flag a -> a)
    fromFlag (Flag String -> String) -> Flag String -> String
    forall a b. (a -> b) -> a -> b
    $ TestFlags -> Flag String
    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 -> String
    testOption PackageDescription
    pkg_descr LocalBuildInfo
    lbi TestSuite
    suite PathTemplate
    template =
        PathTemplate -> String
    fromPathTemplate (PathTemplate -> String) -> PathTemplate -> String
    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, String -> PathTemplate
    toPathTemplate (String -> PathTemplate) -> String -> PathTemplate
    forall a b. (a -> b) -> a -> b
    $ UnqualComponentName -> String
    unUnqualComponentName (UnqualComponentName -> String) -> UnqualComponentName -> String
    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 -> String
    stubName TestSuite
    t = UnqualComponentName -> String
    unUnqualComponentName (TestSuite -> UnqualComponentName
    PD.testName TestSuite
    t) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "Stub"

    -- | The filename of the source file for the stub executable associated with a
    -- library 'TestSuite'.
    stubFilePath :: PD.TestSuite -> FilePath
    stubFilePath :: TestSuite -> String
    stubFilePath TestSuite
    t = TestSuite -> String
    stubName TestSuite
    t String -> String -> String
    <.> String
    "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 -> String -> IO ()
    writeSimpleTestStub TestSuite
    t String
    dir = do
        Bool -> String -> IO ()
    createDirectoryIfMissing Bool
    True String
    dir
        let filename :: String
    filename = String
    dir String -> String -> String
    </> TestSuite -> String
    stubFilePath TestSuite
    t
            m :: ModuleName
    m = case TestSuite -> TestSuiteInterface
    PD.testInterface TestSuite
    t of
                PD.TestSuiteLibV09 Version
    _  ModuleName
    m' -> ModuleName
    m'
                TestSuiteInterface
    _                        -> String -> ModuleName
    forall a. HasCallStack => String -> a
    error String
    "writeSimpleTestStub: invalid TestSuite passed"
        String -> String -> IO ()
    writeFile String
    filename (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ModuleName -> String
    simpleTestStub ModuleName
    m

    -- | Source code for library test suite stub executable
    simpleTestStub :: ModuleName -> String
    simpleTestStub :: ModuleName -> String
    simpleTestStub ModuleName
    m = [String] -> String
    unlines
        [ String
    "module Main ( main ) where"
        , String
    "import Distribution.Simple.Test.LibV09 ( stubMain )"
        , String
    "import " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Doc -> String
    forall a. Show a => a -> String
    show (ModuleName -> Doc
    forall a. Pretty a => a -> Doc
    pretty ModuleName
    m) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " ( tests )"
        , String
    "main :: IO ()"
        , String
    "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
        (String
    f, UnqualComponentName
    n) <- (String -> (String, UnqualComponentName))
    -> IO String -> IO (String, UnqualComponentName)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\String
    s -> (String, UnqualComponentName)
    -> Maybe (String, UnqualComponentName)
    -> (String, UnqualComponentName)
    forall a. a -> Maybe a -> a
    fromMaybe (String -> (String, UnqualComponentName)
    forall a. HasCallStack => String -> a
    error (String -> (String, UnqualComponentName))
    -> String -> (String, UnqualComponentName)
    forall a b. (a -> b) -> a -> b
    $ String
    "panic! read " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    s) (Maybe (String, UnqualComponentName)
     -> (String, UnqualComponentName))
    -> Maybe (String, UnqualComponentName)
    -> (String, UnqualComponentName)
    forall a b. (a -> b) -> a -> b
    $ String -> Maybe (String, UnqualComponentName)
    forall a. Read a => String -> Maybe a
    readMaybe String
    s) IO String
    getContents -- TODO: eradicateNoParse
        String
    dir <- IO String
    getCurrentDirectory
        TestLogs
    results <- (IO [Test]
    tests IO [Test] -> ([Test] -> IO TestLogs) -> IO TestLogs
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [Test] -> IO TestLogs
    stubRunTests) IO TestLogs -> (SomeException -> IO TestLogs) -> IO TestLogs
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `CE.catch` SomeException -> IO TestLogs
    errHandler
        String -> IO ()
    setCurrentDirectory String
    dir
        String -> UnqualComponentName -> TestLogs -> IO ()
    stubWriteLog String
    f UnqualComponentName
    n TestLogs
    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. Exception e => e -> IO a
    CE.throwIO SomeException
    e
            Maybe AsyncException
    _ -> TestLogs -> IO TestLogs
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TestLogs -> IO TestLogs) -> TestLogs -> IO TestLogs
    forall a b. (a -> b) -> a -> b
    $ TestLog { testName :: String
    testName = String
    "Cabal test suite exception",
                                    testOptionsReturned :: [(String, String)]
    testOptionsReturned = [],
                                    testResult :: Result
    testResult = String -> Result
    Error (String -> Result) -> String -> Result
    forall a b. (a -> b) -> a -> b
    $ SomeException -> String
    forall a. Show a => a -> String
    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
        [TestLogs]
    logs <- (Test -> IO TestLogs) -> [Test] -> IO [TestLogs]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Test -> IO TestLogs
    stubRunTests' [Test]
    tests
        TestLogs -> IO TestLogs
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TestLogs -> IO TestLogs) -> TestLogs -> IO TestLogs
    forall a b. (a -> b) -> a -> b
    $ String -> [TestLogs] -> TestLogs
    GroupLogs String
    "Default" [TestLogs]
    logs
      where
        stubRunTests' :: Test -> IO TestLogs
    stubRunTests' (Test TestInstance
    t) = do
            TestLogs
    l <- TestInstance -> IO Progress
    run TestInstance
    t IO Progress -> (Progress -> IO TestLogs) -> IO TestLogs
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Progress -> IO TestLogs
    finish
            Verbosity -> TestShowDetails -> TestLogs -> IO ()
    summarizeTest Verbosity
    normal TestShowDetails
    Always TestLogs
    l
            TestLogs -> IO TestLogs
    forall (m :: * -> *) a. Monad m => a -> m a
    return TestLogs
    l
          where
            finish :: Progress -> IO TestLogs
    finish (Finished Result
    result) =
                TestLogs -> IO TestLogs
    forall (m :: * -> *) a. Monad m => a -> m a
    return TestLog
                    { testName :: String
    testName = TestInstance -> String
    name TestInstance
    t
                    , testOptionsReturned :: [(String, String)]
    testOptionsReturned = TestInstance -> [(String, String)]
    defaultOptions TestInstance
    t
                    , testResult :: Result
    testResult = Result
    result
                    }
            finish (Progress String
    _ IO Progress
    next) = IO Progress
    next IO Progress -> (Progress -> IO TestLogs) -> IO TestLogs
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Progress -> IO TestLogs
    finish
        stubRunTests' g :: Test
    g@(Group {}) = do
            [TestLogs]
    logs <- (Test -> IO TestLogs) -> [Test] -> IO [TestLogs]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Test -> IO TestLogs
    stubRunTests' ([Test] -> IO [TestLogs]) -> [Test] -> IO [TestLogs]
    forall a b. (a -> b) -> a -> b
    $ Test -> [Test]
    groupTests Test
    g
            TestLogs -> IO TestLogs
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TestLogs -> IO TestLogs) -> TestLogs -> IO TestLogs
    forall a b. (a -> b) -> a -> b
    $ String -> [TestLogs] -> TestLogs
    GroupLogs (Test -> String
    groupName Test
    g) [TestLogs]
    logs
        stubRunTests' (ExtraOptions [OptionDescr]
    _ Test
    t) = Test -> IO TestLogs
    stubRunTests' Test
    t
        maybeDefaultOption :: OptionDescr -> Maybe (String, String)
    maybeDefaultOption OptionDescr
    opt =
            Maybe (String, String)
    -> (String -> Maybe (String, String))
    -> Maybe String
    -> Maybe (String, String)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Maybe (String, String)
    forall a. Maybe a
    Nothing (\String
    d -> (String, String) -> Maybe (String, String)
    forall a. a -> Maybe a
    Just (OptionDescr -> String
    optionName OptionDescr
    opt, String
    d)) (Maybe String -> Maybe (String, String))
    -> Maybe String -> Maybe (String, String)
    forall a b. (a -> b) -> a -> b
    $ OptionDescr -> Maybe String
    optionDefault OptionDescr
    opt
        defaultOptions :: TestInstance -> [(String, String)]
    defaultOptions TestInstance
    testInst = (OptionDescr -> Maybe (String, String))
    -> [OptionDescr] -> [(String, String)]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe OptionDescr -> Maybe (String, String)
    maybeDefaultOption ([OptionDescr] -> [(String, String)])
    -> [OptionDescr] -> [(String, String)]
    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 :: String -> UnqualComponentName -> TestLogs -> IO ()
    stubWriteLog String
    f UnqualComponentName
    n TestLogs
    logs = do
        let testLog :: TestSuiteLog
    testLog = TestSuiteLog { testSuiteName :: UnqualComponentName
    testSuiteName = UnqualComponentName
    n, testLogs :: TestLogs
    testLogs = TestLogs
    logs, logFile :: String
    logFile = String
    f }
        String -> String -> IO ()
    writeFile (TestSuiteLog -> String
    logFile TestSuiteLog
    testLog) (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ TestSuiteLog -> String
    forall a. Show a => a -> String
    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