Unverified Commit 766ae3b5 authored by Mikhail Glushenkov's avatar Mikhail Glushenkov Committed by Mikhail Glushenkov

Formatting, 80-col violations.

parent d1534624
...@@ -801,7 +801,8 @@ freezeCommand = CommandUI { ...@@ -801,7 +801,8 @@ freezeCommand = CommandUI {
commandUsage = usageFlags "freeze", commandUsage = usageFlags "freeze",
commandDefaultFlags = defaultFreezeFlags, commandDefaultFlags = defaultFreezeFlags,
commandOptions = \ showOrParseArgs -> [ commandOptions = \ showOrParseArgs -> [
optionVerbosity freezeVerbosity (\v flags -> flags { freezeVerbosity = v }) optionVerbosity freezeVerbosity
(\v flags -> flags { freezeVerbosity = v })
, option [] ["dry-run"] , option [] ["dry-run"]
"Do not freeze anything, only print what would be frozen" "Do not freeze anything, only print what would be frozen"
...@@ -809,18 +810,21 @@ freezeCommand = CommandUI { ...@@ -809,18 +810,21 @@ freezeCommand = CommandUI {
trueArg trueArg
, option [] ["tests"] , option [] ["tests"]
"freezing of the dependencies of any tests suites in the package description file." ("freezing of the dependencies of any tests suites "
++ "in the package description file.")
freezeTests (\v flags -> flags { freezeTests = v }) freezeTests (\v flags -> flags { freezeTests = v })
(boolOpt [] []) (boolOpt [] [])
, option [] ["benchmarks"] , option [] ["benchmarks"]
"freezing of the dependencies of any benchmarks suites in the package description file." ("freezing of the dependencies of any benchmarks suites "
++ "in the package description file.")
freezeBenchmarks (\v flags -> flags { freezeBenchmarks = v }) freezeBenchmarks (\v flags -> flags { freezeBenchmarks = v })
(boolOpt [] []) (boolOpt [] [])
] ++ ] ++
optionSolver freezeSolver (\v flags -> flags { freezeSolver = v }) : optionSolver
freezeSolver (\v flags -> flags { freezeSolver = v }):
optionSolverFlags showOrParseArgs optionSolverFlags showOrParseArgs
freezeMaxBackjumps (\v flags -> flags { freezeMaxBackjumps = v }) freezeMaxBackjumps (\v flags -> flags { freezeMaxBackjumps = v })
freezeReorderGoals (\v flags -> flags { freezeReorderGoals = v }) freezeReorderGoals (\v flags -> flags { freezeReorderGoals = v })
...@@ -842,7 +846,8 @@ genBoundsCommand = CommandUI { ...@@ -842,7 +846,8 @@ genBoundsCommand = CommandUI {
commandSynopsis = "Generate dependency bounds.", commandSynopsis = "Generate dependency bounds.",
commandDescription = Just $ \_ -> wrapText $ commandDescription = Just $ \_ -> wrapText $
"Generates bounds for all dependencies that do not currently have them. " "Generates bounds for all dependencies that do not currently have them. "
++ "Generated bounds are printed to stdout. You can then paste them into your .cabal file.\n" ++ "Generated bounds are printed to stdout. "
++ "You can then paste them into your .cabal file.\n"
++ "\n", ++ "\n",
commandNotes = Nothing, commandNotes = Nothing,
commandUsage = usageFlags "gen-bounds", commandUsage = usageFlags "gen-bounds",
......
...@@ -14,13 +14,15 @@ import Distribution.Compat.Internal.TempFile (createTempDirectory) ...@@ -14,13 +14,15 @@ import Distribution.Compat.Internal.TempFile (createTempDirectory)
import Distribution.Simple.Configure (findDistPrefOrDefault) import Distribution.Simple.Configure (findDistPrefOrDefault)
import Distribution.Simple.Program.Builtin (ghcPkgProgram, gccProgram, ghcProgram) import Distribution.Simple.Program.Builtin (ghcPkgProgram, gccProgram, ghcProgram)
import Distribution.Simple.Program.Db import Distribution.Simple.Program.Db
(defaultProgramDb, requireProgram, setProgramSearchPath, lookupProgramVersion) (defaultProgramDb, requireProgram, setProgramSearchPath
,lookupProgramVersion)
import Distribution.Simple.Program.Find import Distribution.Simple.Program.Find
(ProgramSearchPathEntry(ProgramSearchPathDir), defaultProgramSearchPath) (ProgramSearchPathEntry(ProgramSearchPathDir), defaultProgramSearchPath)
import Distribution.Simple.Program.Types import Distribution.Simple.Program.Types
( Program(..), simpleProgram, programPath) ( Program(..), simpleProgram, programPath)
import Distribution.Simple.Setup ( Flag(..) ) import Distribution.Simple.Setup ( Flag(..) )
import Distribution.Simple.Utils ( findProgramVersion, copyDirectoryRecursive, installOrdinaryFile ) import Distribution.Simple.Utils ( findProgramVersion, copyDirectoryRecursive
, installOrdinaryFile )
import Distribution.Verbosity (normal) import Distribution.Verbosity (normal)
import Distribution.Version (anyVersion) import Distribution.Version (anyVersion)
...@@ -105,7 +107,8 @@ run cwd path args = do ...@@ -105,7 +107,8 @@ run cwd path args = do
-- CABAL_BUILDDIR can interfere with test running, so -- CABAL_BUILDDIR can interfere with test running, so
-- be sure to clear it out. -- be sure to clear it out.
let env = filter ((/= "CABAL_BUILDDIR") . fst) env0 let env = filter ((/= "CABAL_BUILDDIR") . fst) env0
pid <- runProcess path' args (Just cwd) (Just env) Nothing (Just hWriteStdOut) (Just hWriteStdErr) pid <- runProcess path' args (Just cwd) (Just env)
Nothing (Just hWriteStdOut) (Just hWriteStdErr)
-- Return the pid and read ends of the pipes -- Return the pid and read ends of the pipes
return (pid, hReadStdOut, hReadStdErr) return (pid, hReadStdOut, hReadStdErr)
-- Read subprocess output using asynchronous threads; we need to -- Read subprocess output using asynchronous threads; we need to
...@@ -241,14 +244,16 @@ runTestCase tc = do ...@@ -241,14 +244,16 @@ runTestCase tc = do
bracket createWorkDirectory (removeWorkDirectory doRemove) $ \workDirectory -> do bracket createWorkDirectory (removeWorkDirectory doRemove) $ \workDirectory -> do
-- Run -- Run
let scriptDirectory = workDirectory let scriptDirectory = workDirectory
sh <- fmap (fromMaybe $ error "Cannot find 'sh' executable") $ findExecutable "sh" sh <- fmap (fromMaybe $ error "Cannot find 'sh' executable") $
findExecutable "sh"
testResult <- run scriptDirectory sh [ "-e", tcName tc] testResult <- run scriptDirectory sh [ "-e", tcName tc]
-- Assert that we got what we expected -- Assert that we got what we expected
case trExitCode testResult of case trExitCode testResult of
ExitSuccess -> ExitSuccess ->
return () -- We're good return () -- We're good
ExitFailure _ -> ExitFailure _ ->
assertFailure $ "Unexpected exit status.\n\n" ++ testResultToString testResult assertFailure $ "Unexpected exit status.\n\n"
++ testResultToString testResult
mustMatch testResult "stdout" (trStdOut testResult) (tcStdOutPath tc) mustMatch testResult "stdout" (trStdOut testResult) (tcStdOutPath tc)
mustMatch testResult "stderr" (trStdErr testResult) (tcStdErrPath tc) mustMatch testResult "stderr" (trStdErr testResult) (tcStdErrPath tc)
-- Only remove working directory if test succeeded -- Only remove working directory if test succeeded
...@@ -284,7 +289,8 @@ main = do ...@@ -284,7 +289,8 @@ main = do
distPref <- guessDistDir distPref <- guessDistDir
buildDir <- canonicalizePath (distPref </> "build/cabal") buildDir <- canonicalizePath (distPref </> "build/cabal")
let programSearchPath = ProgramSearchPathDir buildDir : defaultProgramSearchPath let programSearchPath = ProgramSearchPathDir buildDir : defaultProgramSearchPath
(cabal, _) <- requireProgram normal cabalProgram (setProgramSearchPath programSearchPath defaultProgramDb) (cabal, _) <- requireProgram normal cabalProgram
(setProgramSearchPath programSearchPath defaultProgramDb)
(ghcPkg, _) <- requireProgram normal ghcPkgProgram defaultProgramDb (ghcPkg, _) <- requireProgram normal ghcPkgProgram defaultProgramDb
baseDirectory <- canonicalizePath $ "tests" </> "IntegrationTests" baseDirectory <- canonicalizePath $ "tests" </> "IntegrationTests"
-- Set up environment variables for test scripts -- Set up environment variables for test scripts
...@@ -311,7 +317,8 @@ main = do ...@@ -311,7 +317,8 @@ main = do
categoryTests <- discoverCategoryTests baseDirectory category categoryTests <- discoverCategoryTests baseDirectory category
return (category, categoryTests) return (category, categoryTests)
-- Map into a test tree -- Map into a test tree
let testTree = map (\(category, categoryTests) -> testGroup category categoryTests) tests let testTree = map (\(category, categoryTests) ->
testGroup category categoryTests) tests
-- Run the tests -- Run the tests
defaultMain $ testGroup "Integration Tests" $ testTree defaultMain $ testGroup "Integration Tests" $ testTree
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment