diff --git a/src/GHC.hs b/src/GHC.hs index 9b453e58d7c57d35bd77393fc34565972d0fbfe6..f84d3d68841c2756d2f89271bdc3864505c8696a 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -105,15 +105,18 @@ stage2Packages = return [haddock] -- | Packages that are built only for the testsuite. testsuitePackages :: Action [Package] -testsuitePackages = return [ checkApiAnnotations - , checkPpr - , ghci - , ghcPkg - , hp2ps - , iserv - , parallel - , runGhc - , timeout ] +testsuitePackages = do + win <- windowsHost + return $ + [ checkApiAnnotations + , checkPpr + , ghci + , ghcPkg + , hp2ps + , iserv + , parallel + , runGhc ] ++ + [ timeout | win ] -- | Given a 'Context', compute the name of the program that is built in it -- assuming that the corresponding package's type is 'Program'. For example, GHC diff --git a/src/Rules/Test.hs b/src/Rules/Test.hs index d8d644e7f805e46bee65c11f73dff6aa2e86061a..6a04c1e751c1e160c7c6fcc66c9cb2db63a4ca38 100644 --- a/src/Rules/Test.hs +++ b/src/Rules/Test.hs @@ -21,13 +21,15 @@ testRules = do root -/- ghcConfigProgPath ~> do ghc <- builderPath $ Ghc CompileHs Stage0 cmd ghc [ghcConfigHsPath, "-o" , root -/- ghcConfigProgPath] - - -- | TODO : Use input test compiler and not just stage2 compiler. + + -- | TODO : Use input test compiler and not just stage2 compiler. root -/- ghcConfigPath ~> do ghcPath <- needfile Stage1 ghc need [ root -/- ghcConfigProgPath] cmd [FileStdout $ root -/- ghcConfigPath] (root -/- ghcConfigProgPath) - [ ghcPath ] + [ ghcPath ] + + root -/- timeoutProgPath ~> timeoutProgBuilder "validate" ~> do needTestBuilders @@ -38,7 +40,7 @@ testRules = do -- TODO : Should we remove the previosly generated config file? -- Prepare Ghc configuration file for input compiler. - need [ root -/- ghcConfigPath ] + need [ root -/- ghcConfigPath, root -/- timeoutProgPath ] -- TODO This approach doesn't work. -- Set environment variables for test's Makefile. @@ -93,13 +95,12 @@ timeoutProgBuilder = do copyFile prog (root -/- timeoutProgPath) else do python <- builderPath Python - copyFile "testsuite/timeout/timeout.py" (root -/- "test/bin/timeout.py") + copyFile "testsuite/timeout/timeout.py" (root -/- timeoutProgPath <.> "py") let script = unlines [ "#!/usr/bin/env sh" , "exec " ++ python ++ " $0.py \"$@\"" ] - liftIO $ do - writeFile (root -/- timeoutProgPath) script + writeFile' (root -/- timeoutProgPath) script makeExecutable (root -/- timeoutProgPath) needTestBuilders :: Action () @@ -108,7 +109,6 @@ needTestBuilders = do needBuilder $ GhcPkg Update Stage1 needBuilder Hpc needBuilder (Hsc2Hs Stage1) - timeoutProgBuilder needTestsuitePackages -- | Extra flags to send to the Haskell compiler to run tests. @@ -160,4 +160,3 @@ needfile stage pkg -- we are going to use, I suppose? | isLibrary pkg = pkgConfFile (Context stage pkg profilingDynamic) | otherwise = programPath =<< programContext stage pkg - diff --git a/src/Settings/Builders/RunTest.hs b/src/Settings/Builders/RunTest.hs index 9f308482e490319e6f915e18c5911ddfba608d58..6c0c52f9f179429974fa6e8637da7e82a762f62f 100644 --- a/src/Settings/Builders/RunTest.hs +++ b/src/Settings/Builders/RunTest.hs @@ -103,7 +103,7 @@ getTestArgs = do args <- expr $ userSetting defaultTestArgs bindir <- expr $ setBinaryDirectory (testCompiler args) compiler <- expr $ setCompiler (testCompiler args) - globalVerbosity <- shakeVerbosity <$> expr getShakeOptions + globalVerbosity <- shakeVerbosity <$> expr getShakeOptions let configFileArg= ["--config-file=" ++ (testConfigFile args)] testOnlyArg = case testOnly args of Just cases -> map ("--only=" ++) (words cases) @@ -125,30 +125,30 @@ getTestArgs = do verbosityArg = case testVerbosity args of Nothing -> Just $ "--verbose=" ++ show (fromEnum globalVerbosity) Just verbosity -> Just $ "--verbose=" ++ verbosity - wayArgs = map ("--way=" ++) (testWays args) + wayArgs = map ("--way=" ++) (testWays args) compilerArg = ["--config", "compiler=" ++ show (compiler)] ghcPkgArg = ["--config", "ghc_pkg=" ++ show (bindir -/- "ghc-pkg")] haddockArg = ["--config", "haddock=" ++ show (bindir -/- "haddock")] hp2psArg = ["--config", "hp2ps=" ++ show (bindir -/- "hp2ps")] - hpcArg = ["--config", "hpc=" ++ show (bindir -/- "hpc")] - pure $ configFileArg ++ testOnlyArg ++ speedArg + hpcArg = ["--config", "hpc=" ++ show (bindir -/- "hpc")] + pure $ configFileArg ++ testOnlyArg ++ speedArg ++ catMaybes [ onlyPerfArg, skipPerfArg, summaryArg - , junitArg, verbosityArg ] + , junitArg, verbosityArg ] ++ configArgs ++ wayArgs ++ compilerArg ++ ghcPkgArg ++ haddockArg ++ hp2psArg ++ hpcArg -- | Directory to look for Binaries --- | We assume that required programs are present in the same binary directory +-- | We assume that required programs are present in the same binary directory -- | in which ghc is stored and that they have their conventional name. -- | QUESTION : packages can be named different from their conventional names. -- | For example, ghc-pkg can be named as ghc-pkg-version. In such cases, it will --- | be impossible to search the binary. Only possible way will be to take user --- | inputs for these directory also. boilerplate soes not account for this +-- | be impossible to search the binary. Only possible way will be to take user +-- | inputs for these directory also. boilerplate soes not account for this -- | problem, but simply returns an error. How should we handle such cases? setBinaryDirectory :: String -> Action FilePath setBinaryDirectory "stage0" = setting InstallBinDir -setBinaryDirectory "stage1" = liftM2 (-/-) topDirectory (stageBinPath Stage0) -setBinaryDirectory "stage2" = liftM2 (-/-) topDirectory (stageBinPath Stage1) +setBinaryDirectory "stage1" = liftM2 (-/-) topDirectory (stageBinPath Stage0) +setBinaryDirectory "stage2" = liftM2 (-/-) topDirectory (stageBinPath Stage1) setBinaryDirectory compiler = pure $ parentPath compiler -- | Set Test Compiler @@ -156,7 +156,7 @@ setCompiler :: String -> Action FilePath setCompiler "stage0" = setting SystemGhc setCompiler "stage1" = liftM2 (-/-) topDirectory (fullpath Stage0 ghc) setCompiler "stage2" = liftM2 (-/-) topDirectory (fullpath Stage1 ghc) -setCompiler compiler = pure compiler +setCompiler compiler = pure compiler -- | Set speed for test setTestSpeed :: TestSpeed -> String @@ -164,7 +164,7 @@ setTestSpeed Fast = "2" setTestSpeed Average = "1" setTestSpeed Slow = "0" --- | Returns parent path of test compiler +-- | Returns parent path of test compiler -- | TODO : Is there a simpler way to find parent directory? parentPath :: String -> String parentPath path = let upPath = init $ splitOn "/" path @@ -173,4 +173,3 @@ parentPath path = let upPath = init $ splitOn "/" path -- | TODO: move to hadrian utilities. fullpath :: Stage -> Package -> Action FilePath fullpath stage pkg = programPath =<< programContext stage pkg -