hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Need to validate test paths too

Browse Source
This commit is contained in:
Alan Zimmerman 2013-09-21 17:26:55 +02:00
parent 54bb83e972
commit bdc2b96ae1
1 changed files with 11 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
Language/Haskell/GhcMod/CabalApi.hs
View File

@ -169,15 +169,15 @@ getGHC = do
-- tests and benchmarks. -- tests and benchmarks.
cabalAllTargets :: PackageDescription -> IO ([String],[String],[String],[String]) cabalAllTargets :: PackageDescription -> IO ([String],[String],[String],[String])
cabalAllTargets pd = do cabalAllTargets pd = do
exeTargets <- mapM getExecutableTarget $ executables pd exeTargets <- mapM getExecutableTarget $ executables pd
return (libTargets,concat exeTargets,testTargets,benchTargets) testTargets <- mapM getTestTarget $ testSuites pd
return (libTargets,concat exeTargets,concat testTargets,benchTargets)
where where
lib = case library pd of lib = case library pd of
Nothing -> [] Nothing -> []
Just l -> libModules l Just l -> libModules l
libTargets = map toModuleString $ lib libTargets = map toModuleString $ lib
testTargets = concatMap getTestTargets $ map testInterface $ testSuites pd
benchTargets = map toModuleString $ concatMap benchmarkModules $ benchmarks pd benchTargets = map toModuleString $ concatMap benchmarkModules $ benchmarks pd
toModuleString :: ModuleName -> String toModuleString :: ModuleName -> String
@ -186,10 +186,14 @@ cabalAllTargets pd = do
fromFilePath :: FilePath -> String fromFilePath :: FilePath -> String
fromFilePath fp = map (\c -> if c=='/' then '.' else c) fp fromFilePath fp = map (\c -> if c=='/' then '.' else c) fp
getTestTargets :: TestSuiteInterface -> [String] getTestTarget :: TestSuite -> IO [String]
getTestTargets (TestSuiteExeV10 _ filePath) = [fromFilePath filePath] getTestTarget ts =
getTestTargets (TestSuiteLibV09 _ moduleName) = [toModuleString moduleName] case testInterface ts of
getTestTargets (TestSuiteUnsupported _) = [] (TestSuiteExeV10 _ filePath) -> do
let maybeTests = [p </> e | p <- hsSourceDirs $ testBuildInfo ts, e <- [filePath]]
liftIO $ filterM doesFileExist maybeTests
(TestSuiteLibV09 _ moduleName) -> return [toModuleString moduleName]
(TestSuiteUnsupported _) -> return []
getExecutableTarget :: Executable -> IO [String] getExecutableTarget :: Executable -> IO [String]
getExecutableTarget exe = do getExecutableTarget exe = do