[commit: ghc] wip/nfs-locking: Support several variants of -jN flag, add tests (73b9b7b)
git at git.haskell.org
git at git.haskell.org
Fri Oct 27 00:23:36 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/nfs-locking
Link : http://ghc.haskell.org/trac/ghc/changeset/73b9b7b47f9c33506be8238d355eba2363470ce9/ghc
>---------------------------------------------------------------
commit 73b9b7b47f9c33506be8238d355eba2363470ce9
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date: Wed Oct 5 15:31:26 2016 +0100
Support several variants of -jN flag, add tests
See #289.
>---------------------------------------------------------------
73b9b7b47f9c33506be8238d355eba2363470ce9
src/Builder.hs | 7 +++++--
src/Rules/Selftest.hs | 22 ++++++++++++++++------
2 files changed, 21 insertions(+), 8 deletions(-)
diff --git a/src/Builder.hs b/src/Builder.hs
index 704947d..55d561e 100644
--- a/src/Builder.hs
+++ b/src/Builder.hs
@@ -155,8 +155,11 @@ specified = fmap (not . null) . builderPath
-- parallelism. Given a 'Builder' and an argument, this function should return
-- 'True' only if the argument needs to be tracked.
trackedArgument :: Builder -> String -> Bool
-trackedArgument (Make _) ('-' : 'j' : xs) = not $ all isDigit xs
-trackedArgument _ _ = True
+trackedArgument (Make _) = not . threadArg
+trackedArgument _ = const True
+
+threadArg :: String -> Bool
+threadArg s = dropWhileEnd isDigit s `elem` ["-j", "MAKEFLAGS=-j", "THREADS="]
-- | Make sure a Builder exists on the given path and rebuild it if out of date.
needBuilder :: Builder -> Action ()
diff --git a/src/Rules/Selftest.hs b/src/Rules/Selftest.hs
index f53a5db..3b20f14 100644
--- a/src/Rules/Selftest.hs
+++ b/src/Rules/Selftest.hs
@@ -6,6 +6,7 @@ import Development.Shake
import Test.QuickCheck
import Base
+import Builder
import Oracles.ModuleFiles
import Settings.Builders.Ar
import UserSettings
@@ -23,14 +24,23 @@ test = liftIO . quickCheck
selftestRules :: Rules ()
selftestRules =
"selftest" ~> do
- testWays
+ testBuilder
+ testWay
testChunksOfSize
testMatchVersionedFilePath
- testModuleNames
+ testModuleName
testLookupAll
-testWays :: Action ()
-testWays = do
+testBuilder :: Action ()
+testBuilder = do
+ putBuild $ "==== trackedArgument"
+ test $ forAll (elements ["-j", "MAKEFLAGS=-j", "THREADS="])
+ $ \prefix -> \(NonNegative n) ->
+ trackedArgument (Make undefined) prefix == False &&
+ trackedArgument (Make undefined) ("-j" ++ show (n :: Int)) == False
+
+testWay :: Action ()
+testWay = do
putBuild $ "==== Read Way, Show Way"
test $ \(x :: Way) -> read (show x) == x
@@ -59,8 +69,8 @@ testMatchVersionedFilePath = do
where
versions = listOf . elements $ '-' : '.' : ['0'..'9']
-testModuleNames :: Action ()
-testModuleNames = do
+testModuleName :: Action ()
+testModuleName = do
putBuild $ "==== Encode/decode module name"
test $ encodeModule "Data/Functor" "Identity.hs" == "Data.Functor.Identity"
test $ encodeModule "" "Prelude" == "Prelude"
More information about the ghc-commits
mailing list