[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