Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Support for detailed-0.9 test type #1447

Merged
merged 1 commit into from
Dec 3, 2015
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions ChangeLog.md
Original file line number Diff line number Diff line change
Expand Up @@ -24,6 +24,8 @@ Other enhancements:
[#584](https://github.com/commercialhaskell/stack/issues/584)
* `--work-dir` option for overriding `.stack-work`
[#1178](https://github.com/commercialhaskell/stack/issues/1178)
* Support `detailed-0.9` tests
[#1429](https://github.com/commercialhaskell/stack/issues/1429)

Bug fixes:

Expand Down
29 changes: 24 additions & 5 deletions src/Stack/Build/Execute.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down
4 changes: 2 additions & 2 deletions src/Stack/Build/Source.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)
}

Expand Down
2 changes: 1 addition & 1 deletion src/Stack/Ghci.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
6 changes: 3 additions & 3 deletions src/Stack/Package.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)]
Expand Down
6 changes: 5 additions & 1 deletion src/Stack/Types/Build.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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, (</>))
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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' ++
Expand Down Expand Up @@ -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 []
Expand Down
3 changes: 2 additions & 1 deletion src/Stack/Types/Package.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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.
Expand Down