    {-# 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.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 Distribution.Compat.Process (proc)
    import qualified System.Process as Process

    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

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

        let cmd :: [Char]
    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.
        Bool
    exists <- [Char] -> IO Bool
    doesFileExist [Char]
    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 -> [Char] -> IO ()
    forall a. Verbosity -> [Char] -> IO a
    die' Verbosity
    verbosity ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Could not find test program \"" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    cmd
                        [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "\". 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 :: [Char]
    tDir = [Char] -> Way -> [Char] -> [Char]
    tixDir [Char]
    distPref Way
    way [Char]
    testName'
            Bool
    exists' <- [Char] -> IO Bool
    doesDirectoryExist [Char]
    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
    $ [Char] -> IO ()
    removeDirectoryRecursive [Char]
    tDir

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

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

        TestSuiteLog
    suiteLog <- IO [Char]
    -> ([Char] -> IO ())
    -> ([Char] -> IO TestSuiteLog)
    -> IO TestSuiteLog
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    CE.bracket IO [Char]
    openCabalTemp [Char] -> IO ()
    deleteIfExists (([Char] -> IO TestSuiteLog) -> IO TestSuiteLog)
    -> ([Char] -> IO TestSuiteLog) -> IO TestSuiteLog
    forall a b. (a -> b) -> a -> b
    $ \[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
            [([Char], [Char])]
    shellEnv' <-
              if LocalBuildInfo -> Bool
    LBI.withDynExe LocalBuildInfo
    lbi
              then do
                let (Platform Arch
    _ OS
    os) = LocalBuildInfo -> Platform
    LBI.hostPlatform LocalBuildInfo
    lbi
                [[Char]]
    paths <- Bool
    -> Bool -> LocalBuildInfo -> ComponentLocalBuildInfo -> IO [[Char]]
    LBI.depLibraryPaths Bool
    True Bool
    False LocalBuildInfo
    lbi ComponentLocalBuildInfo
    clbi
                [Char]
    cpath <- [Char] -> IO [Char]
    canonicalizePath ([Char] -> IO [Char]) -> [Char] -> IO [Char]
    forall a b. (a -> b) -> a -> b
    $ LocalBuildInfo -> ComponentLocalBuildInfo -> [Char]
    LBI.componentBuildDir LocalBuildInfo
    lbi ComponentLocalBuildInfo
    clbi
                [([Char], [Char])] -> IO [([Char], [Char])]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OS -> [[Char]] -> [([Char], [Char])] -> [([Char], [Char])]
    addLibraryPath OS
    os ([Char]
    cpath [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [[Char]]
    paths) [([Char], [Char])]
    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 ([Char]
    cmd', [[Char]]
    opts') = case TestFlags -> Flag [Char]
    testWrapper TestFlags
    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.
            (Handle
    rOut, Handle
    wOut) <- IO (Handle, Handle)
    Process.createPipe
            (ExitCode
    exitcode, ByteString
    logText) <- Verbosity
    -> CreateProcess
    -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> IO ByteString)
    -> IO (ExitCode, ByteString)
    forall a.
    Verbosity
    -> CreateProcess
    -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> IO a)
    -> IO (ExitCode, a)
    rawSystemProcAction Verbosity
    verbosity
                ([Char] -> [[Char]] -> CreateProcess
    proc [Char]
    cmd' [[Char]]
    opts') { Process.env           = Just shellEnv'
                                  , Process.std_in        = Process.CreatePipe
                                  , Process.std_out       = Process.UseHandle wOut
                                  , Process.std_err       = Process.UseHandle wOut
                                  } ((Maybe Handle -> Maybe Handle -> Maybe Handle -> IO ByteString)
     -> IO (ExitCode, ByteString))
    -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> IO ByteString)
    -> IO (ExitCode, ByteString)
    forall a b. (a -> b) -> a -> b
    $ \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
              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)
              ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    logText
            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
    $
              Verbosity -> [Char] -> IO ()
    debug Verbosity
    verbosity ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    cmd [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " returned " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ ExitCode -> [Char]
    forall a. Show a => a -> [Char]
    show ExitCode
    exitcode

            -- Generate final log file name
            let finalLogName :: TestSuiteLog -> [Char]
    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
            TestSuiteLog
    suiteLog <- ([Char] -> TestSuiteLog) -> IO [Char] -> IO TestSuiteLog
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    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
                        (IO [Char] -> IO TestSuiteLog) -> IO [Char] -> IO TestSuiteLog
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO [Char]
    readFile [Char]
    tempLog

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

            [Char] -> ByteString -> IO ()
    LBS.appendFile (TestSuiteLog -> [Char]
    logFile TestSuiteLog
    suiteLog) ByteString
    logText

            -- Write end-of-suite summary notice to log file
            [Char] -> [Char] -> IO ()
    appendFile (TestSuiteLog -> [Char]
    logFile TestSuiteLog
    suiteLog) ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ TestSuiteLog -> [Char]
    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 a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return TestSuiteLog
    suiteLog

        -- Write summary notice to terminal indicating end of test suite
        Verbosity -> [Char] -> IO ()
    notice Verbosity
    verbosity ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ TestSuiteLog -> [Char]
    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 -> [Char] -> IO ()
    forall a. Verbosity -> [Char] -> IO a
    die' Verbosity
    verbosity [Char]
    "Test coverage is only supported for packages with a library component."
            Just Library
    library ->
              Verbosity
    -> LocalBuildInfo
    -> [Char]
    -> [Char]
    -> TestSuite
    -> Library
    -> IO ()
    markupTest Verbosity
    verbosity LocalBuildInfo
    lbi [Char]
    distPref (PackageIdentifier -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow (PackageIdentifier -> [Char]) -> PackageIdentifier -> [Char]
    forall a b. (a -> b) -> a -> b
    $ PackageDescription -> PackageIdentifier
    PD.package PackageDescription
    pkg_descr) TestSuite
    suite Library
    library

        TestSuiteLog -> IO TestSuiteLog
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return TestSuiteLog
    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
            Bool
    exists <- [Char] -> IO Bool
    doesFileExist [Char]
    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
    $ [Char] -> IO ()
    removeFile [Char]
    file

        testLogDir :: [Char]
    testLogDir = [Char]
    distPref [Char] -> [Char] -> [Char]
    </> [Char]
    "test"
        openCabalTemp :: IO [Char]
    openCabalTemp = do
            ([Char]
    f, Handle
    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"
            Handle -> IO ()
    hClose Handle
    h IO () -> IO [Char] -> IO [Char]
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> [Char] -> IO [Char]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Char]
    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
        ([Char]
    f, UnqualComponentName
    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
        [Char]
    dir <- IO [Char]
    getCurrentDirectory
        TestLogs
    results <- (IO [Test]
    tests IO [Test] -> ([Test] -> 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
    >>= [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
        [Char] -> IO ()
    setCurrentDirectory [Char]
    dir
        [Char] -> UnqualComponentName -> TestLogs -> IO ()
    stubWriteLog [Char]
    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 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
        [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)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse Test -> IO TestLogs
    stubRunTests' [Test]
    tests
        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
    $ [Char] -> [TestLogs] -> TestLogs
    GroupLogs [Char]
    "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 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
            Verbosity -> TestShowDetails -> TestLogs -> IO ()
    summarizeTest Verbosity
    normal TestShowDetails
    Always TestLogs
    l
            TestLogs -> IO TestLogs
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return TestLogs
    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
            [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)
    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
            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
    $ [Char] -> [TestLogs] -> TestLogs
    GroupLogs (Test -> [Char]
    groupName Test
    g) [TestLogs]
    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