haskell/stackage
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage.git synced 2026-02-18 09:15:50 +01:00
Code Issues Actions 2 Packages Projects Releases Wiki Activity

Better error reporting

Browse Source
This commit is contained in:
Michael Snoyman 2014-10-23 11:05:19 +03:00
parent 12b057bddb
commit 0b3363777c
1 changed files with 8 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
Stackage/Test.hs
View File

@ -112,12 +112,11 @@ getCabalVersion = do
notCRLF '\r' = False notCRLF '\r' = False
notCRLF _ = True notCRLF _ = True
parFoldM :: (Ord key, Show key) parFoldM :: Int -- ^ number of threads
=> Int -- ^ number of threads -> ((PackageName, payload) -> IO c)
-> ((key, payload) -> IO c)
-> (a -> c -> a) -> (a -> c -> a)
-> a -> a
-> [(key, Set key, payload)] -> [(PackageName, Set PackageName, payload)]
-> IO a -> IO a
parFoldM threadCount0 f g a0 bs0 = do parFoldM threadCount0 f g a0 bs0 = do
ma <- C.newMVar a0 ma <- C.newMVar a0
@ -126,7 +125,11 @@ parFoldM threadCount0 f g a0 bs0 = do
completed <- newIORef Set.empty completed <- newIORef Set.empty
tids <- replicateM threadCount0 $ C.forkIO $ worker completed ma mbs signal tids <- replicateM threadCount0 $ C.forkIO $ worker completed ma mbs signal
wait threadCount0 signal tids wait threadCount0 signal tids
[] <- C.takeMVar mbs -- ensure all tests were run
unrun <- C.takeMVar mbs
when (not $ null unrun) $
error $ "The following tests were not run: " ++ unwords
[x | (PackageName x, _, _) <- unrun]
C.takeMVar ma C.takeMVar ma
where where
worker completedRef ma mbs signal = worker completedRef ma mbs signal =