Skip to content

Commit d501148

Browse files
mgsloanmgsloan
committed
Use main build code for tests/benchmarks #1166 
1 parent 526b3dc commit d501148

File tree

3 files changed

+56
-146
lines changed

3 files changed

+56
-146
lines changed

‎src/Control/Concurrent/Execute.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -24,6 +24,7 @@ import Stack.Types
2424

2525
data ActionType
2626
= ATBuild
27+
| ATBuildFinal
2728
| ATFinal
2829
deriving (Show, Eq, Ord)
2930
data ActionId = ActionId !PackageIdentifier !ActionType

‎src/Stack/Build/Cache.hs‎

Lines changed: 0 additions & 64 deletions
Original file line numberDiff line numberDiff line change
@@ -21,12 +21,6 @@ module Stack.Build.Cache
2121
, setTestSuccess
2222
, unsetTestSuccess
2323
, checkTestSuccess
24-
, setTestBuilt
25-
, unsetTestBuilt
26-
, checkTestBuilt
27-
, setBenchBuilt
28-
, unsetBenchBuilt
29-
, checkBenchBuilt
3024
, writePrecompiledCache
3125
, readPrecompiledCache
3226
) where
@@ -229,64 +223,6 @@ checkTestSuccess dir =
229223
(fromMaybe False)
230224
(tryGetCache testSuccessFile dir)
231225

232-
-- | Mark a test suite as having built
233-
setTestBuilt :: (MonadIO m, MonadLogger m, MonadThrow m, MonadReader env m, HasConfig env, HasEnvConfig env)
234-
=> Path Abs Dir
235-
-> m ()
236-
setTestBuilt dir =
237-
writeCache
238-
dir
239-
testBuiltFile
240-
True
241-
242-
-- | Mark a test suite as not having built
243-
unsetTestBuilt :: (MonadIO m, MonadLogger m, MonadThrow m, MonadReader env m, HasConfig env, HasEnvConfig env)
244-
=> Path Abs Dir
245-
-> m ()
246-
unsetTestBuilt dir =
247-
writeCache
248-
dir
249-
testBuiltFile
250-
False
251-
252-
-- | Check if the test suite already built
253-
checkTestBuilt :: (MonadIO m, MonadLogger m, MonadThrow m, MonadReader env m, HasConfig env, HasEnvConfig env)
254-
=> Path Abs Dir
255-
-> m Bool
256-
checkTestBuilt dir =
257-
liftM
258-
(fromMaybe False)
259-
(tryGetCache testBuiltFile dir)
260-
261-
-- | Mark a bench suite as having built
262-
setBenchBuilt :: (MonadIO m, MonadLogger m, MonadThrow m, MonadReader env m, HasConfig env, HasEnvConfig env)
263-
=> Path Abs Dir
264-
-> m ()
265-
setBenchBuilt dir =
266-
writeCache
267-
dir
268-
benchBuiltFile
269-
True
270-
271-
-- | Mark a bench suite as not having built
272-
unsetBenchBuilt :: (MonadIO m, MonadLogger m, MonadThrow m, MonadReader env m, HasConfig env, HasEnvConfig env)
273-
=> Path Abs Dir
274-
-> m ()
275-
unsetBenchBuilt dir =
276-
writeCache
277-
dir
278-
benchBuiltFile
279-
False
280-
281-
-- | Check if the bench suite already built
282-
checkBenchBuilt :: (MonadIO m, MonadLogger m, MonadThrow m, MonadReader env m, HasConfig env, HasEnvConfig env)
283-
=> Path Abs Dir
284-
-> m Bool
285-
checkBenchBuilt dir =
286-
liftM
287-
(fromMaybe False)
288-
(tryGetCache benchBuiltFile dir)
289-
290226
--------------------------------------
291227
-- Precompiled Cache
292228
--

‎src/Stack/Build/Execute.hs‎

Lines changed: 55 additions & 82 deletions
Original file line numberDiff line numberDiff line change
@@ -37,10 +37,10 @@ import qualified Data.ByteString.Char8 as S8
3737
import Data.Conduit
3838
import qualified Data.Conduit.Binary as CB
3939
import qualified Data.Conduit.List as CL
40-
import Data.Foldable (forM_)
40+
import Data.Foldable (forM_, any)
4141
import Data.Function
4242
import Data.IORef.RunOnce (runOnce)
43-
import Data.List
43+
import Data.List hiding (any)
4444
import Data.Map.Strict (Map)
4545
import qualified Data.Map.Strict as Map
4646
import Data.Maybe
@@ -52,6 +52,7 @@ import qualified Data.Streaming.Process as Process
5252
import Data.Traversable (forM)
5353
import Data.Text (Text)
5454
import qualified Data.Text as T
55+
import Data.Text.Encoding (decodeUtf8)
5556
import Data.Time.Clock (getCurrentTime)
5657
import Data.Word8 (_colon)
5758
import Distribution.System (OS (Windows),
@@ -61,7 +62,7 @@ import Language.Haskell.TH as TH (location)
6162
import Network.HTTP.Client.Conduit (HasHttpManager)
6263
import Path
6364
import Path.IO
64-
import Prelude hiding (FilePath, writeFile)
65+
import Prelude hiding (FilePath, writeFile, any)
6566
import Stack.Build.Cache
6667
import Stack.Build.Haddock
6768
import Stack.Build.Installed
@@ -532,17 +533,22 @@ toActions installedMap runInBase ee (mbuild, mfinal) =
532533
{ actionId = ActionId taskProvides ATBuild
533534
, actionDeps =
534535
(Set.map (\ident -> ActionId ident ATBuild) (tcoMissing taskConfigOpts))
535-
, actionDo = \ac -> runInBase $ singleBuild runInBase ac ee task installedMap
536+
, actionDo = \ac -> runInBase $ singleBuild runInBase ac ee task installedMap False
536537
}
537538
]
538539
afinal =
539540
case mfinal of
540541
Nothing -> []
541542
Just task@Task {..} ->
542543
[ Action
543-
{ actionId = ActionId taskProvides ATFinal
544-
, actionDeps = addBuild taskProvides $
544+
{ actionId = ActionId taskProvides ATBuildFinal
545+
, actionDeps = addBuild taskProvides
545546
(Set.map (\ident -> ActionId ident ATBuild) (tcoMissing taskConfigOpts))
547+
, actionDo = \ac -> runInBase $ singleBuild runInBase ac ee task installedMap True
548+
}
549+
, Action
550+
{ actionId = ActionId taskProvides ATFinal
551+
, actionDeps = Set.singleton (ActionId taskProvides ATBuildFinal)
546552
, actionDo = \ac -> runInBase $ do
547553
let comps = taskComponents task
548554
tests = testComponents comps
@@ -554,12 +560,10 @@ toActions installedMap runInBase ee (mbuild, mfinal) =
554560
singleBench runInBase beopts ac ee task installedMap
555561
}
556562
]
557-
where
558-
addBuild ident =
559-
case mbuild of
560-
Nothing -> id
561-
Just _ -> Set.insert $ ActionId ident ATBuild
562-
563+
addBuild ident =
564+
case mbuild of
565+
Nothing -> id
566+
Just _ -> Set.insert $ ActionId ident ATBuild
563567
bopts = eeBuildOpts ee
564568
topts = boptsTestOpts bopts
565569
beopts = boptsBenchmarkOpts bopts
@@ -886,9 +890,10 @@ singleBuild :: M env m
886890
-> ExecuteEnv
887891
-> Task
888892
-> InstalledMap
893+
-> Bool
889894
-> m ()
890-
singleBuild runInBase ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap = do
891-
(allDepsMap, cache) <- getConfigCache ee task installedMap False False
895+
singleBuild runInBase ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap isFinalBuild = do
896+
(allDepsMap, cache) <- getConfigCache ee task installedMap enableTests enableBenchmarks
892897
mprecompiled <- getPrecompiled cache
893898
minstalled <-
894899
case mprecompiled of
@@ -903,10 +908,20 @@ singleBuild runInBase ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} in
903908
pname = packageIdentifierName taskProvides
904909
shouldHaddockPackage' = shouldHaddockPackage eeBuildOpts eeWanted pname
905910
doHaddock package = shouldHaddockPackage' &&
911+
not isFinalBuild &&
906912
-- Works around haddock failing on bytestring-builder since it has no modules
907913
-- when bytestring is new enough.
908914
packageHasExposedModules package
909915

916+
enableTests = isFinalBuild && any isCTest (taskComponents task)
917+
enableBenchmarks = isFinalBuild && any isCBench (taskComponents task)
918+
annSuffix =
919+
case (enableTests, enableBenchmarks) of
920+
(False, False) -> ""
921+
(True, False) -> " (test)"
922+
(False, True) -> " (bench)"
923+
(True, True) -> " (test + bench)"
924+
910925
getPrecompiled cache =
911926
case taskLocation task of
912927
Snap | not shouldHaddockPackage' -> do
@@ -988,7 +1003,7 @@ singleBuild runInBase ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} in
9881003

9891004
realConfigAndBuild cache allDepsMap = withSingleContext runInBase ac ee task (Just allDepsMap) Nothing
9901005
$ \package cabalfp pkgDir cabal announce console _mlogFile -> do
991-
_neededConfig <- ensureConfig cache pkgDir ee (announce "configure") cabal cabalfp
1006+
_neededConfig <- ensureConfig cache pkgDir ee (announce ("configure" <> annSuffix)) cabal cabalfp
9921007

9931008
if boptsOnlyConfigure eeBuildOpts
9941009
then return Nothing
@@ -999,18 +1014,20 @@ singleBuild runInBase ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} in
9991014

10001015
markExeNotInstalled (taskLocation task) taskProvides
10011016
case taskType of
1002-
TTLocal lp -> writeBuildCache pkgDir $ lpNewBuildCache lp
1017+
TTLocal lp -> do
1018+
when enableTests $ unsetTestSuccess pkgDir
1019+
writeBuildCache pkgDir $ lpNewBuildCache lp
10031020
TTUpstream _ _ -> return ()
10041021

1005-
() <- announce "build"
1022+
() <- announce ("build" <> annSuffix)
10061023
config <- asks getConfig
10071024
extraOpts <- extraBuildOptions eeBuildOpts
10081025
preBuildTime <- modTime <$> liftIO getCurrentTime
1009-
cabal (console && configHideTHLoading config) $
1010-
(case taskType of
1011-
TTLocal lp -> concat
1012-
[ ["build"]
1013-
, ["lib:" ++ packageNameString (packageName package)
1026+
cabal (console && configHideTHLoading config) $ ("build" :) $ (++ extraOpts) $
1027+
case (taskType, isFinalBuild) of
1028+
-- Normal build
1029+
(TTLocal lp, False) -> concat
1030+
[ ["lib:" ++ packageNameString (packageName package)
10141031
-- TODO: get this information from target parsing instead,
10151032
-- which will allow users to turn off library building if
10161033
-- desired
@@ -1023,7 +1040,12 @@ singleBuild runInBase ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} in
10231040
-- extra-deps).
10241041
else packageExes package
10251042
]
1026-
TTUpstream _ _ -> ["build"]) ++ extraOpts
1043+
-- Tests / benchmarks build
1044+
(TTLocal lp, True) ->
1045+
map (T.unpack . decodeUtf8 . renderComponent) $
1046+
Set.toList $
1047+
Set.filter (\c -> isCTest c || isCBench c) (lpComponents lp)
1048+
(TTUpstream{}, _) -> []
10271049
checkForUnlistedFiles taskType preBuildTime pkgDir
10281050

10291051
when (doHaddock package) $ do
@@ -1044,7 +1066,7 @@ singleBuild runInBase ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} in
10441066
cabal False (concat [["haddock", "--html", "--hoogle", "--html-location=../$pkg-$version/"]
10451067
,sourceFlag])
10461068

1047-
withMVar eeInstallLock $ \() -> do
1069+
unless isFinalBuild $ withMVar eeInstallLock $ \() -> do
10481070
announce "copy/register"
10491071
cabal False ["copy"]
10501072
when (packageHasLibrary package) $ cabal False ["register"]
@@ -1134,37 +1156,12 @@ singleTest :: M env m
11341156
-> InstalledMap
11351157
-> m ()
11361158
singleTest runInBase topts testsToRun ac ee task installedMap = do
1137-
(allDepsMap, cache) <- getConfigCache ee task installedMap True False
1138-
withSingleContext runInBase ac ee task (Just allDepsMap) (Just "test") $ \package cabalfp pkgDir cabal announce console mlogFile -> do
1139-
neededConfig <- ensureConfig cache pkgDir ee (announce "configure (test)") cabal cabalfp
1159+
-- FIXME: Since this doesn't use cabal, we should be able to avoid using a
1160+
-- fullblown 'withSingleContext'.
1161+
(allDepsMap, _cache) <- getConfigCache ee task installedMap True False
1162+
withSingleContext runInBase ac ee task (Just allDepsMap) (Just "test") $ \package _cabalfp pkgDir _cabal announce _console mlogFile -> do
11401163
config <- asks getConfig
1141-
1142-
testBuilt <- checkTestBuilt pkgDir
1143-
1144-
let needBuild = neededConfig ||
1145-
(case taskType task of
1146-
TTLocal lp ->
1147-
case lpDirtyFiles lp of
1148-
Just _ -> True
1149-
Nothing -> False
1150-
_ -> assert False True) ||
1151-
not testBuilt
1152-
needHpc = toCoverage topts
1153-
components = map (T.unpack . T.append "test:") testsToRun
1154-
1155-
when needBuild $ do
1156-
announce "build (test)"
1157-
unsetTestBuilt pkgDir
1158-
unsetTestSuccess pkgDir
1159-
case taskType task of
1160-
TTLocal lp -> writeBuildCache pkgDir $ lpNewBuildCache lp
1161-
TTUpstream _ _ -> assert False $ return ()
1162-
extraOpts <- extraBuildOptions (eeBuildOpts ee)
1163-
preBuildTime <- modTime <$> liftIO getCurrentTime
1164-
cabal (console && configHideTHLoading config) $
1165-
"build" : (components ++ extraOpts)
1166-
checkForUnlistedFiles (taskType task) preBuildTime pkgDir
1167-
setTestBuilt pkgDir
1164+
let needHpc = toCoverage topts
11681165

11691166
toRun <-
11701167
if toDisableRun topts
@@ -1267,8 +1264,6 @@ singleTest runInBase topts testsToRun ac ee task installedMap = do
12671264
(fmap fst mlogFile)
12681265
bs
12691266

1270-
setTestSuccess pkgDir
1271-
12721267
singleBench :: M env m
12731268
=> (m () -> IO ())
12741269
-> BenchmarkOpts
@@ -1278,32 +1273,10 @@ singleBench :: M env m
12781273
-> InstalledMap
12791274
-> m ()
12801275
singleBench runInBase beopts ac ee task installedMap = do
1281-
(allDepsMap, cache) <- getConfigCache ee task installedMap False True
1282-
withSingleContext runInBase ac ee task (Just allDepsMap) (Just "bench") $ \_package cabalfp pkgDir cabal announce console _mlogFile -> do
1283-
neededConfig <- ensureConfig cache pkgDir ee (announce "configure (benchmarks)") cabal cabalfp
1284-
1285-
benchBuilt <- checkBenchBuilt pkgDir
1286-
1287-
let needBuild = neededConfig ||
1288-
(case taskType task of
1289-
TTLocal lp ->
1290-
case lpDirtyFiles lp of
1291-
Just _ -> True
1292-
Nothing -> False
1293-
_ -> assert False True) ||
1294-
not benchBuilt
1295-
when needBuild $ do
1296-
announce "build (benchmarks)"
1297-
unsetBenchBuilt pkgDir
1298-
case taskType task of
1299-
TTLocal lp -> writeBuildCache pkgDir $ lpNewBuildCache lp
1300-
TTUpstream _ _ -> assert False $ return ()
1301-
config <- asks getConfig
1302-
extraOpts <- extraBuildOptions (eeBuildOpts ee)
1303-
preBuildTime <- modTime <$> liftIO getCurrentTime
1304-
cabal (console && configHideTHLoading config) ("build" : extraOpts)
1305-
checkForUnlistedFiles (taskType task) preBuildTime pkgDir
1306-
setBenchBuilt pkgDir
1276+
-- FIXME: Since this doesn't use cabal, we should be able to avoid using a
1277+
-- fullblown 'withSingleContext'.
1278+
(allDepsMap, _cache) <- getConfigCache ee task installedMap False True
1279+
withSingleContext runInBase ac ee task (Just allDepsMap) (Just "bench") $ \_package _cabalfp _pkgDir cabal announce _console _mlogFile -> do
13071280
let args = maybe []
13081281
((:[]) . ("--benchmark-options=" <>))
13091282
(beoAdditionalArgs beopts)

0 commit comments

Comments
 (0)