{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Distribution.Simple.Test.ExeV10
( runTest
) where
import Distribution.Compat.Prelude
import Prelude ()
import Distribution.Compat.Environment
import qualified Distribution.PackageDescription as PD
import Distribution.Simple.BuildPaths
import Distribution.Simple.Compiler
import Distribution.Simple.Errors
import Distribution.Simple.Flag
import Distribution.Simple.Hpc
import Distribution.Simple.InstallDirs
import qualified Distribution.Simple.LocalBuildInfo as LBI
( ComponentLocalBuildInfo (..)
, buildDir
, depLibraryPaths
)
import Distribution.Simple.Program.Db
import Distribution.Simple.Program.Find
import Distribution.Simple.Program.Run
import Distribution.Simple.Setup.Common
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
( LocalBuildInfo (..)
, localUnitId
, testCoverage
)
import Distribution.Types.UnqualComponentName
import Distribution.Verbosity
import Distribution.Utils.Path
import qualified Data.ByteString.Lazy as LBS
import Distribution.Simple.LocalBuildInfo (interpretSymbolicPathLBI, packageRoot)
import System.Directory
( createDirectoryIfMissing
, doesDirectoryExist
, doesFileExist
, removeDirectoryRecursive
)
import System.IO (stderr, stdout)
import System.Process (createPipe)
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
tixDir_ :: FilePath
tixDir_ = SymbolicPathX 'AllowAbsolute Pkg ('Dir Tix) -> FilePath
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> FilePath
i (SymbolicPathX 'AllowAbsolute Pkg ('Dir Tix) -> FilePath)
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Tix) -> FilePath
forall a b. (a -> b) -> a -> b
$ SymbolicPath Pkg ('Dir Dist)
-> Way -> SymbolicPathX 'AllowAbsolute Pkg ('Dir Tix)
tixDir SymbolicPath Pkg ('Dir Dist)
distPref Way
way
[(FilePath, FilePath)]
existingEnv <- IO [(FilePath, FilePath)]
getEnvironment
let cmd :: FilePath
cmd =
SymbolicPathX 'AllowAbsolute Pkg ('Dir Build) -> FilePath
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> FilePath
i (LocalBuildInfo -> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
LBI.buildDir LocalBuildInfo
lbi)
FilePath -> FilePath -> FilePath
forall p q r. PathLike p q r => p -> q -> r
</> FilePath
testName'
FilePath -> FilePath -> FilePath
forall p q r. PathLike p q r => p -> q -> r
</> FilePath
testName' FilePath -> FilePath -> FilePath
forall p. FileLike p => p -> FilePath -> p
<.> Platform -> FilePath
exeExtension (LocalBuildInfo -> Platform
LBI.hostPlatform LocalBuildInfo
lbi)
Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
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 -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO ()) -> CabalException -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath -> CabalException
Couldn'tFindTestProgram FilePath
cmd
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
Bool
exists' <- FilePath -> IO Bool
doesDirectoryExist FilePath
tixDir_
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists' (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removeDirectoryRecursive FilePath
tixDir_
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
tixDir_
Verbosity -> FilePath -> IO ()
notice Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
summarizeSuiteStart (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
testName'
let progDb :: ProgramDb
progDb = LocalBuildInfo -> ProgramDb
LBI.withPrograms LocalBuildInfo
lbi
pathVar :: ProgramSearchPath
pathVar = ProgramDb -> ProgramSearchPath
progSearchPath ProgramDb
progDb
envOverrides :: [(FilePath, Maybe FilePath)]
envOverrides = ProgramDb -> [(FilePath, Maybe FilePath)]
progOverrideEnv ProgramDb
progDb
FilePath
newPath <- ProgramSearchPath -> IO FilePath
programSearchPathAsPATHVar ProgramSearchPath
pathVar
[(FilePath, FilePath)]
overrideEnv <- [(FilePath, FilePath)]
-> Maybe [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [(FilePath, FilePath)] -> [(FilePath, FilePath)])
-> IO (Maybe [(FilePath, FilePath)]) -> IO [(FilePath, FilePath)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(FilePath, Maybe FilePath)] -> IO (Maybe [(FilePath, FilePath)])
getEffectiveEnvironment ([(FilePath
"PATH", FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
newPath)] [(FilePath, Maybe FilePath)]
-> [(FilePath, Maybe FilePath)] -> [(FilePath, Maybe FilePath)]
forall a. [a] -> [a] -> [a]
++ [(FilePath, Maybe FilePath)]
envOverrides)
let opts :: [FilePath]
opts =
(PathTemplate -> FilePath) -> [PathTemplate] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map
(PackageDescription
-> LocalBuildInfo -> TestSuite -> PathTemplate -> FilePath
testOption PackageDescription
pkg_descr LocalBuildInfo
lbi TestSuite
suite)
(TestFlags -> [PathTemplate]
testOptions TestFlags
flags)
tixFile :: FilePath
tixFile = CommonSetupFlags -> FilePath
packageRoot (TestFlags -> CommonSetupFlags
testCommonFlags TestFlags
flags) FilePath -> FilePath -> FilePath
forall p q r. PathLike p q r => p -> q -> r
</> SymbolicPathX 'AllowAbsolute Pkg 'File -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath (SymbolicPath Pkg ('Dir Dist)
-> Way -> FilePath -> SymbolicPathX 'AllowAbsolute Pkg 'File
tixFilePath SymbolicPath Pkg ('Dir Dist)
distPref Way
way (FilePath
testName'))
shellEnv :: [(FilePath, FilePath)]
shellEnv = [(FilePath
"HPCTIXFILE", FilePath
tixFile) | Bool
isCoverageEnabled] [(FilePath, FilePath)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [a] -> [a] -> [a]
++ [(FilePath, FilePath)]
overrideEnv [(FilePath, FilePath)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [a] -> [a] -> [a]
++ [(FilePath, FilePath)]
existingEnv
[(FilePath, FilePath)]
shellEnv' <-
if LocalBuildInfo -> Bool
LBI.withDynExe LocalBuildInfo
lbi
then do
let (Platform Arch
_ OS
os) = LocalBuildInfo -> Platform
LBI.hostPlatform LocalBuildInfo
lbi
[FilePath]
paths <- Bool
-> Bool
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> IO [FilePath]
LBI.depLibraryPaths Bool
True Bool
False LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
[(FilePath, FilePath)] -> IO [(FilePath, FilePath)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (OS
-> [FilePath] -> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
addLibraryPath OS
os [FilePath]
paths [(FilePath, FilePath)]
shellEnv)
else [(FilePath, FilePath)] -> IO [(FilePath, FilePath)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [(FilePath, FilePath)]
shellEnv
(Handle
wOut, Handle
wErr, IO ByteString
getLogText) <- case TestShowDetails
details of
TestShowDetails
Direct -> (Handle, Handle, IO ByteString)
-> IO (Handle, Handle, IO ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
stdout, Handle
stderr, ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
LBS.empty)
TestShowDetails
_ -> do
(Handle
rOut, Handle
wOut) <- IO (Handle, Handle)
createPipe
(Handle, Handle, IO ByteString)
-> IO (Handle, Handle, IO ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Handle, Handle, IO ByteString)
-> IO (Handle, Handle, IO ByteString))
-> (Handle, Handle, IO ByteString)
-> IO (Handle, Handle, IO ByteString)
forall a b. (a -> b) -> a -> b
$ (,,) Handle
wOut Handle
wOut (IO ByteString -> (Handle, Handle, IO ByteString))
-> IO ByteString -> (Handle, Handle, IO ByteString)
forall a b. (a -> b) -> a -> b
$ do
ByteString
logText <- Handle -> IO ByteString
LBS.hGetContents Handle
rOut
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TestShowDetails
details TestShowDetails -> TestShowDetails -> Bool
forall a. Eq a => a -> a -> Bool
== TestShowDetails
Streaming) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
LBS.putStr ByteString
logText
ByteString -> IO ByteString
forall a. a -> IO a
evaluate (ByteString -> ByteString
forall a. NFData a => a -> a
force ByteString
logText)
(ExitCode
exit, ByteString
logText) <- case TestFlags -> Flag FilePath
testWrapper TestFlags
flags of
Flag FilePath
path ->
Verbosity
-> FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> IO ByteString
-> Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> IO (ExitCode, ByteString)
forall a.
Verbosity
-> FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> IO a
-> Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> IO (ExitCode, a)
rawSystemIOWithEnvAndAction
Verbosity
verbosity
FilePath
path
(FilePath
cmd FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
opts)
Maybe FilePath
forall a. Maybe a
Nothing
([(FilePath, FilePath)] -> Maybe [(FilePath, FilePath)]
forall a. a -> Maybe a
Just [(FilePath, FilePath)]
shellEnv')
IO ByteString
getLogText
Maybe Handle
forall a. Maybe a
Nothing
(Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
wOut)
(Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
wErr)
Flag FilePath
NoFlag ->
Verbosity
-> FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> IO ByteString
-> Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> IO (ExitCode, ByteString)
forall a.
Verbosity
-> FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> IO a
-> Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> IO (ExitCode, a)
rawSystemIOWithEnvAndAction
Verbosity
verbosity
FilePath
cmd
[FilePath]
opts
Maybe FilePath
forall a. Maybe a
Nothing
([(FilePath, FilePath)] -> Maybe [(FilePath, FilePath)]
forall a. a -> Maybe a
Just [(FilePath, FilePath)]
shellEnv')
IO ByteString
getLogText
Maybe Handle
forall a. Maybe a
Nothing
(Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
wOut)
(Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
wErr)
let suiteLog :: TestSuiteLog
suiteLog = ExitCode -> TestSuiteLog
buildLog ExitCode
exit
FilePath -> FilePath -> IO ()
appendFile (TestSuiteLog -> FilePath
logFile TestSuiteLog
suiteLog) (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
summarizeSuiteStart FilePath
testName'
FilePath -> ByteString -> IO ()
LBS.appendFile (TestSuiteLog -> FilePath
logFile TestSuiteLog
suiteLog) ByteString
logText
FilePath -> FilePath -> IO ()
appendFile (TestSuiteLog -> FilePath
logFile TestSuiteLog
suiteLog) (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ TestSuiteLog -> FilePath
summarizeSuiteFinish TestSuiteLog
suiteLog
let 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. Eq a => a -> a -> Bool
== TestShowDetails
Always
Bool -> Bool -> Bool
|| TestShowDetails
details TestShowDetails -> TestShowDetails -> Bool
forall a. Eq a => a -> a -> Bool
== TestShowDetails
Failures 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
&& 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'
Verbosity -> FilePath -> IO ()
notice Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ TestSuiteLog -> FilePath
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
$ do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Library] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Library] -> Bool) -> [Library] -> Bool
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Library]
PD.allLibraries PackageDescription
pkg_descr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
TestCoverageSupport
Verbosity
-> HPCMarkupInfo
-> LocalBuildInfo
-> SymbolicPath Pkg ('Dir Dist)
-> PackageDescription
-> [TestSuite]
-> IO ()
markupPackage Verbosity
verbosity HPCMarkupInfo
hpcMarkupInfo LocalBuildInfo
lbi SymbolicPath Pkg ('Dir Dist)
distPref PackageDescription
pkg_descr [TestSuite
suite]
TestSuiteLog -> IO TestSuiteLog
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TestSuiteLog
suiteLog
where
i :: SymbolicPathX allowAbsolute Pkg to -> FilePath
i = LocalBuildInfo -> SymbolicPathX allowAbsolute Pkg to -> FilePath
forall (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
LocalBuildInfo -> SymbolicPathX allowAbsolute Pkg to -> FilePath
interpretSymbolicPathLBI LocalBuildInfo
lbi
commonFlags :: CommonSetupFlags
commonFlags = TestFlags -> CommonSetupFlags
testCommonFlags TestFlags
flags
testName' :: FilePath
testName' = UnqualComponentName -> FilePath
unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
forall a b. (a -> b) -> a -> b
$ TestSuite -> UnqualComponentName
PD.testName TestSuite
suite
distPref :: SymbolicPath Pkg ('Dir Dist)
distPref = Flag (SymbolicPath Pkg ('Dir Dist)) -> SymbolicPath Pkg ('Dir Dist)
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag (SymbolicPath Pkg ('Dir Dist))
-> SymbolicPath Pkg ('Dir Dist))
-> Flag (SymbolicPath Pkg ('Dir Dist))
-> SymbolicPath Pkg ('Dir Dist)
forall a b. (a -> b) -> a -> b
$ CommonSetupFlags -> Flag (SymbolicPath Pkg ('Dir Dist))
setupDistPref CommonSetupFlags
commonFlags
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
$ CommonSetupFlags -> Flag Verbosity
setupVerbosity CommonSetupFlags
commonFlags
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
testLogDir :: SymbolicPathX 'AllowAbsolute Pkg c3
testLogDir = SymbolicPath Pkg ('Dir Dist)
distPref SymbolicPath Pkg ('Dir Dist)
-> RelativePath Dist c3 -> SymbolicPathX 'AllowAbsolute Pkg c3
forall p q r. PathLike p q r => p -> q -> r
</> FilePath -> RelativePath Dist c3
forall from (to :: FileOrDir).
HasCallStack =>
FilePath -> RelativePath from to
makeRelativePathEx FilePath
"test"
buildLog :: ExitCode -> TestSuiteLog
buildLog ExitCode
exit =
let r :: Result
r = case ExitCode
exit of
ExitCode
ExitSuccess -> Result
Pass
ExitFailure Int
c -> FilePath -> Result
Fail (FilePath -> Result) -> FilePath -> Result
forall a b. (a -> b) -> a -> b
$ FilePath
"exit code: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
c
l :: TestLogs
l =
TestLog
{ testName :: FilePath
testName = FilePath
testName'
, testOptionsReturned :: [(FilePath, FilePath)]
testOptionsReturned = []
, testResult :: Result
testResult = Result
r
}
in TestSuiteLog
{ testSuiteName :: UnqualComponentName
testSuiteName = TestSuite -> UnqualComponentName
PD.testName TestSuite
suite
, testLogs :: TestLogs
testLogs = TestLogs
l
, logFile :: FilePath
logFile =
SymbolicPathX 'AllowAbsolute Pkg Any -> FilePath
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> FilePath
i SymbolicPathX 'AllowAbsolute Pkg Any
forall {c3 :: FileOrDir}. SymbolicPathX 'AllowAbsolute Pkg c3
testLogDir
FilePath -> FilePath -> FilePath
forall p q r. PathLike p q r => p -> q -> r
</> PathTemplate
-> PackageDescription
-> LocalBuildInfo
-> FilePath
-> TestLogs
-> FilePath
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
FilePath
testName'
TestLogs
l
}
testOption
:: PD.PackageDescription
-> LBI.LocalBuildInfo
-> PD.TestSuite
-> PathTemplate
-> String
testOption :: PackageDescription
-> LocalBuildInfo -> TestSuite -> PathTemplate -> FilePath
testOption PackageDescription
pkg_descr LocalBuildInfo
lbi TestSuite
suite PathTemplate
template =
PathTemplate -> FilePath
fromPathTemplate (PathTemplate -> FilePath) -> PathTemplate -> FilePath
forall a b. (a -> b) -> a -> b
$ PathTemplateEnv -> PathTemplate -> PathTemplate
substPathTemplate PathTemplateEnv
env PathTemplate
template
where
env :: PathTemplateEnv
env =
PackageIdentifier
-> UnitId -> CompilerInfo -> Platform -> PathTemplateEnv
initialPathTemplateEnv
(PackageDescription -> PackageIdentifier
PD.package PackageDescription
pkg_descr)
(LocalBuildInfo -> UnitId
LBI.localUnitId LocalBuildInfo
lbi)
(Compiler -> CompilerInfo
compilerInfo (Compiler -> CompilerInfo) -> Compiler -> CompilerInfo
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> Compiler
LBI.compiler LocalBuildInfo
lbi)
(LocalBuildInfo -> Platform
LBI.hostPlatform LocalBuildInfo
lbi)
PathTemplateEnv -> PathTemplateEnv -> PathTemplateEnv
forall a. [a] -> [a] -> [a]
++ [(PathTemplateVariable
TestSuiteNameVar, FilePath -> PathTemplate
toPathTemplate (FilePath -> PathTemplate) -> FilePath -> PathTemplate
forall a b. (a -> b) -> a -> b
$ UnqualComponentName -> FilePath
unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
forall a b. (a -> b) -> a -> b
$ TestSuite -> UnqualComponentName
PD.testName TestSuite
suite)]