From 8fc49b9b87dcf5fe349dfbde2d2d67e64b8af5e0 Mon Sep 17 00:00:00 2001 From: Luigy Leon Date: Sat, 28 Nov 2015 12:53:28 -0500 Subject: [PATCH] Support detailed-0.9 tests #1429 --- ChangeLog.md | 2 ++ src/Stack/Build/Execute.hs | 29 ++++++++++++++++++++++++----- src/Stack/Build/Source.hs | 4 ++-- src/Stack/Ghci.hs | 2 +- src/Stack/Package.hs | 6 +++--- src/Stack/Types/Build.hs | 6 +++++- src/Stack/Types/Package.hs | 3 ++- 7 files changed, 39 insertions(+), 13 deletions(-) diff --git a/ChangeLog.md b/ChangeLog.md index c68420664b..0bbd57ef2d 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -17,6 +17,8 @@ Other enhancements: * Support git-style executable fall-through (`stack something` executes `stack-something` if present) [#1433](https://github.com/commercialhaskell/stack/issues/1433) +* Support `detailed-0.9` tests + [#1429](https://github.com/commercialhaskell/stack/issues/1429) Bug fixes: diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index 3278c4e913..d384b99850 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -56,6 +56,7 @@ import Data.Text.Encoding (decodeUtf8) import Data.Time.Clock (getCurrentTime) import Data.Traversable (forM) import Data.Word8 (_colon) +import qualified Distribution.PackageDescription as C import Distribution.System (OS (Windows), Platform (Platform)) import Language.Haskell.TH as TH (location) @@ -1171,15 +1172,23 @@ singleTest runInBase topts testsToRun ac ee task installedMap = do buildDir <- distDirFromDir pkgDir hpcDir <- hpcDirFromDir pkgDir when needHpc (createTree hpcDir) + let exeExtension = case configPlatform $ getConfig bconfig of Platform _ Windows -> ".exe" _ -> "" - errs <- liftM Map.unions $ forM testsToRun $ \testName -> do - nameDir <- parseRelDir $ T.unpack testName - nameExe <- parseRelFile $ T.unpack testName ++ exeExtension - nameTix <- liftM (pkgDir ) $ parseRelFile $ T.unpack testName ++ ".tix" + errs <- liftM Map.unions $ forM (Map.toList (packageTests package)) $ \(testName, suiteInterface) -> do + let stestName = T.unpack testName + (testName', isTestTypeLib) <- + case suiteInterface of + C.TestSuiteLibV09{} -> return (stestName ++ "Stub", True) + C.TestSuiteExeV10{} -> return (stestName, False) + interface -> throwM (TestSuiteTypeUnsupported interface) + + nameDir <- parseRelDir $ testName' + nameExe <- parseRelFile $ testName' ++ exeExtension + nameTix <- liftM (pkgDir ) $ parseRelFile $ testName' ++ ".tix" let exeName = buildDir $(mkRelDir "build") nameDir nameExe exists <- fileExists exeName menv <- liftIO $ configEnvOverride config EnvSettings @@ -1218,6 +1227,10 @@ singleTest runInBase topts testsToRun ac ee task installedMap = do -- Use createProcess_ to avoid the log file being closed afterwards (Just inH, Nothing, Nothing, ph) <- liftIO $ createProcess_ "singleBuild.runTests" cp + when isTestTypeLib $ do + logPath <- buildLogPath package (Just stestName) + createTree (parent logPath) + liftIO $ hPutStr inH $ show (logPath, testName) liftIO $ hClose inH ec <- liftIO $ waitForProcess ph -- Move the .tix file out of the package @@ -1237,7 +1250,13 @@ singleTest runInBase topts testsToRun ac ee task installedMap = do ] return $ Map.singleton testName Nothing - when needHpc $ generateHpcReport pkgDir package testsToRun + when needHpc $ do + let testsToRun' = map f testsToRun + f tName = + case Map.lookup tName (packageTests package) of + Just C.TestSuiteLibV09{} -> tName <> "Stub" + _ -> tName + generateHpcReport pkgDir package testsToRun' bs <- liftIO $ case mlogFile of diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs index 8dc761b251..db4ed76530 100644 --- a/src/Stack/Build/Source.hs +++ b/src/Stack/Build/Source.hs @@ -298,7 +298,7 @@ loadLocalPackage bopts targets (name, (lpv, gpkg)) = do Just STLocalAll -> ( packageExes pkg , if boptsTests bopts - then packageTests pkg + then Map.keysSet (packageTests pkg) else Set.empty , if boptsBenchmarks bopts then packageBenchmarks pkg @@ -367,7 +367,7 @@ loadLocalPackage bopts targets (name, (lpv, gpkg)) = do -- present, then they must not be buildable. , lpUnbuildable = toComponents (exes `Set.difference` packageExes pkg) - (tests `Set.difference` packageTests pkg) + (tests `Set.difference` Map.keysSet (packageTests pkg)) (benches `Set.difference` packageBenchmarks pkg) } diff --git a/src/Stack/Ghci.hs b/src/Stack/Ghci.hs index 8edab22247..c9c2247b3c 100644 --- a/src/Stack/Ghci.hs +++ b/src/Stack/Ghci.hs @@ -322,7 +322,7 @@ wantedPackageComponents _ (STLocalComps cs) _ = cs wantedPackageComponents bopts STLocalAll pkg = S.fromList $ (if packageHasLibrary pkg then [CLib] else []) ++ map CExe (S.toList (packageExes pkg)) <> - (if boptsTests bopts then map CTest (S.toList (packageTests pkg)) else []) <> + (if boptsTests bopts then map CTest (M.keys (packageTests pkg)) else []) <> (if boptsBenchmarks bopts then map CBench (S.toList (packageBenchmarks pkg)) else []) wantedPackageComponents _ _ _ = S.empty diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index d4ee603443..69bc436ca8 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -196,9 +196,9 @@ resolvePackage packageConfig gpkg = , packageFlags = packageConfigFlags packageConfig , packageAllDeps = S.fromList (M.keys deps) , packageHasLibrary = maybe False (buildable . libBuildInfo) (library pkg) - , packageTests = S.fromList - [T.pack (testName t) | t <- testSuites pkg - , buildable (testBuildInfo t)] + , packageTests = M.fromList + [(T.pack (testName t), testInterface t) | t <- testSuites pkg + , buildable (testBuildInfo t)] , packageBenchmarks = S.fromList [T.pack (benchmarkName b) | b <- benchmarks pkg , buildable (benchmarkBuildInfo b)] diff --git a/src/Stack/Types/Build.hs b/src/Stack/Types/Build.hs index 0c048a51da..718116bd4d 100644 --- a/src/Stack/Types/Build.hs +++ b/src/Stack/Types/Build.hs @@ -64,6 +64,7 @@ import Data.Text.Encoding.Error (lenientDecode) import Data.Time.Calendar import Data.Time.Clock import Distribution.System (Arch) +import Distribution.PackageDescription (TestSuiteInterface) import Distribution.Text (display) import GHC.Generics import Path (Path, Abs, File, Dir, mkRelDir, toFilePath, parseRelDir, ()) @@ -99,6 +100,7 @@ data StackBuildException (Map PackageName Version) -- not in snapshot, here's the most recent version in the index (Path Abs File) -- stack.yaml | TestSuiteFailure PackageIdentifier (Map Text (Maybe ExitCode)) (Maybe (Path Abs File)) S.ByteString + | TestSuiteTypeUnsupported TestSuiteInterface | ConstructPlanExceptions [ConstructPlanException] (Path Abs File) -- stack.yaml @@ -209,6 +211,8 @@ instance Show StackBuildException where where indent = dropWhileEnd isSpace . unlines . fmap (\line -> " " ++ line) . lines doubleIndent = indent . indent + show (TestSuiteTypeUnsupported interface) = + ("Unsupported test suite type: " <> show interface) show (ConstructPlanExceptions exceptions stackYaml) = "While constructing the BuildPlan the following exceptions were encountered:" ++ appendExceptions exceptions' ++ @@ -725,7 +729,7 @@ configureOptsNoDir econfig bco deps wanted isLocal package = concat allGhcOptions = concat [ Map.findWithDefault [] Nothing (configGhcOptions config) , Map.findWithDefault [] (Just $ packageName package) (configGhcOptions config) - , concat [["-fhpc", "-fforce-recomp"] | isLocal && toCoverage (boptsTestOpts bopts)] + , concat [["-fhpc"] | isLocal && toCoverage (boptsTestOpts bopts)] , if includeExtraOptions then boptsGhcOptions bopts else [] diff --git a/src/Stack/Types/Package.hs b/src/Stack/Types/Package.hs index 17646b7a65..a42927421f 100644 --- a/src/Stack/Types/Package.hs +++ b/src/Stack/Types/Package.hs @@ -30,6 +30,7 @@ import Data.Text.Encoding (encodeUtf8, decodeUtf8) import Distribution.InstalledPackageInfo (PError) import Distribution.ModuleName (ModuleName) import Distribution.Package hiding (Package,PackageName,packageName,packageVersion,PackageIdentifier) +import Distribution.PackageDescription (TestSuiteInterface) import Distribution.System (Platform (..)) import Distribution.Text (display) import GHC.Generics @@ -87,7 +88,7 @@ data Package = ,packageAllDeps :: !(Set PackageName) -- ^ Original dependencies (not sieved). ,packageFlags :: !(Map FlagName Bool) -- ^ Flags used on package. ,packageHasLibrary :: !Bool -- ^ does the package have a buildable library stanza? - ,packageTests :: !(Set Text) -- ^ names of test suites + ,packageTests :: !(Map Text TestSuiteInterface) -- ^ names and interfaces of test suites ,packageBenchmarks :: !(Set Text) -- ^ names of benchmarks ,packageExes :: !(Set Text) -- ^ names of executables ,packageOpts :: !GetPackageOpts -- ^ Args to pass to GHC.