@@ -52,6 +52,7 @@ data BuildArgs = BuildArgs
52 , extraArgs' :: [String] -> [String]
52 , extraArgs' :: [String] -> [String]
53 , noDocs :: Bool
53 , noDocs :: Bool
54 , buildCores :: Maybe Int
54 , buildCores :: Maybe Int
55+ , testThreads :: Maybe Int
57parseBuildArgs :: GhcMajorVersion -> [String] -> IO BuildArgs
58parseBuildArgs :: GhcMajorVersion -> [String] -> IO BuildArgs
@@ -62,6 +63,7 @@ parseBuildArgs version =
62 , extraArgs' = id
63 , extraArgs' = id
63 , noDocs = False
64 , noDocs = False
64 , buildCores = Nothing
65 , buildCores = Nothing
66+ , testThreads = Nothing
67 loop x [] = return x
69 loop x [] = return x
@@ -70,6 +72,7 @@ parseBuildArgs version =
70 loop x ("--arg":y:rest) = loop x { extraArgs' = extraArgs' x . (y:) } rest
72 loop x ("--arg":y:rest) = loop x { extraArgs' = extraArgs' x . (y:) } rest
71 loop x ("--no-docs":rest) = loop x { noDocs = True } rest
73 loop x ("--no-docs":rest) = loop x { noDocs = True } rest
72 loop x ("-j":y:rest) = loop x { buildCores = Just $ read y } rest
74 loop x ("-j":y:rest) = loop x { buildCores = Just $ read y } rest
75+ loop x ("--test-threads":y:rest) = loop x { testThreads = Just $ read y } rest
73 loop _ (y:_) = error $ "Did not understand argument: " ++ y
76 loop _ (y:_) = error $ "Did not understand argument: " ++ y
75defaultBuildPlan :: FilePath
78defaultBuildPlan :: FilePath
@@ -81,7 +84,11 @@ withBuildSettings args f = do
81 BuildArgs {..} <- parseBuildArgs version args
84 BuildArgs {..} <- parseBuildArgs version args
82 bp <- readBuildPlan buildPlanSrc
85 bp <- readBuildPlan buildPlanSrc
83 let bs = defaultBuildSettings buildCores version
86 let bs = defaultBuildSettings buildCores version
84− let settings = bs
87+ modTestThreads settings' =
90+ Just t -> settings' { testWorkerThreads = t }
91+ settings = modTestThreads bs
85 { sandboxRoot = sandbox
92 { sandboxRoot = sandbox
86 , extraArgs = extraArgs' . extraArgs bs
93 , extraArgs = extraArgs' . extraArgs bs
87 , buildDocs = not noDocs
94 , buildDocs = not noDocs