Commit c2032b67 authored by barmston's avatar barmston
Browse files

Tests for the freeze command

Introduced a new test-suite, package-tests, which is intended for black-box
testing of the cabal binary.

The `PackageTests` module determines which cabal binary is to be tested and
runs the tests passing each of them the path to that binary. The binary is the
first cabal binary found on the path. To test a different binary, adjust the
PATH environment variable.

The `PackageTests.PackageTester` module contains common routines to execute
the cabal binary and check its results.

Finally, the `PackageTests.Freeze.Check` command contains some tests for the
freeze command.
parent a9dc1996
......@@ -22,8 +22,12 @@ Copyright: 2005 Lemmih <lemmih@gmail.com>
2007-2012 Duncan Coutts <duncan@community.haskell.org>
Category: Distribution
Build-type: Simple
Extra-Source-Files: README.md bash-completion/cabal bootstrap.sh changelog
Cabal-Version: >= 1.8
Extra-Source-Files:
README.md bash-completion/cabal bootstrap.sh changelog
-- Generated with '../Cabal/misc/gen-extra-source-files.sh | sort'
tests/PackageTests/Freeze/my.cabal
source-repository head
type: git
......@@ -154,6 +158,7 @@ executable cabal
c-sources: cbits/getnumcores.c
-- Small, fast running tests.
Test-Suite unit-tests
type: exitcode-stdio-1.0
main-is: UnitTests.hs
......@@ -200,3 +205,40 @@ Test-Suite unit-tests
cc-options: -DCABAL_NO_THREADED
else
ghc-options: -threaded
-- Large, system tests that build packages.
test-suite package-tests
type: exitcode-stdio-1.0
hs-source-dirs: tests
main-is: PackageTests.hs
other-modules:
PackageTests.Freeze.Check
PackageTests.PackageTester
build-depends:
Cabal,
HUnit,
QuickCheck >= 2.1.0.1 && < 2.8,
base,
bytestring,
directory,
extensible-exceptions,
filepath,
process,
regex-posix,
test-framework,
test-framework-hunit,
test-framework-quickcheck2 >= 0.2.12
if os(windows)
build-depends: Win32 >= 2 && < 3
cpp-options: -DWIN32
else
build-depends: unix >= 2.0 && < 2.8
if arch(arm)
cc-options: -DCABAL_NO_THREADED
else
ghc-options: -threaded
ghc-options: -Wall
default-language: Haskell98
-- | Groups black-box tests of cabal-install and configures them to test
-- the correct binary.
--
-- This file should do nothing but import tests from other modules and run
-- them with the path to the correct cabal-install binary.
module Main
where
-- Modules from Cabal.
import Distribution.Simple.Program.Db (defaultProgramDb, requireProgram)
import Distribution.Simple.Program.Types
( Program(..), simpleProgram, programPath)
import Distribution.Simple.Utils ( findProgramVersion )
import Distribution.Verbosity (normal)
-- Third party modules.
import qualified Control.Exception.Extensible as E
import System.Directory (getCurrentDirectory, setCurrentDirectory)
import Test.Framework (Test, defaultMain, testGroup)
-- Modules containing the tests.
import qualified PackageTests.Freeze.Check
-- List of tests to run. Each test will be called with the path to the
-- cabal binary to use.
tests :: [FilePath -> Test]
tests =
[ testGroup "Freeze" . PackageTests.Freeze.Check.tests
]
cabalProgram :: Program
cabalProgram = (simpleProgram "cabal") {
programFindVersion = findProgramVersion "--numeric-version" id
}
main :: IO ()
main = do
(cabal, _) <- requireProgram normal cabalProgram defaultProgramDb
let cabalPath = programPath cabal
putStrLn $ "Using cabal: " ++ cabalPath
cwd <- getCurrentDirectory
let runTests = do
setCurrentDirectory "tests"
defaultMain (map ($ cabalPath) tests)
-- Change back to the old working directory so that the tests can be
-- repeatedly run in `cabal repl` via `:main`.
runTests `E.finally` setCurrentDirectory cwd
{-# LANGUAGE ScopedTypeVariables #-}
module PackageTests.Freeze.Check
( tests
) where
import PackageTests.PackageTester
import Test.Framework as TF (Test)
import Test.Framework.Providers.HUnit (testCase)
import Test.HUnit (assertBool)
import qualified Control.Exception.Extensible as E
import Data.List (intercalate, isInfixOf)
import System.Directory (doesFileExist, removeFile)
import System.FilePath ((</>))
import System.IO.Error (isDoesNotExistError)
dir :: FilePath
dir = "PackageTests" </> "Freeze"
tests :: FilePath -> [TF.Test]
tests cabalPath =
[ testCase "runs without error" $ do
removeCabalConfig
result <- cabal_freeze dir [] cabalPath
assertFreezeSucceeded result
, testCase "freezes direct dependencies" $ do
removeCabalConfig
result <- cabal_freeze dir [] cabalPath
assertFreezeSucceeded result
c <- readCabalConfig
assertBool ("should have frozen base\n" ++ c) $
" base ==" `isInfixOf` (intercalate " " $ lines $ c)
, testCase "freezes transitory dependencies" $ do
removeCabalConfig
result <- cabal_freeze dir [] cabalPath
assertFreezeSucceeded result
c <- readCabalConfig
assertBool ("should have frozen ghc-prim\n" ++ c) $
" ghc-prim ==" `isInfixOf` (intercalate " " $ lines $ c)
, testCase "does not freeze packages which are not dependend upon" $ do
-- XXX Test this against a package installed in the sandbox but
-- not depended upon.
removeCabalConfig
result <- cabal_freeze dir [] cabalPath
assertFreezeSucceeded result
c <- readCabalConfig
assertBool ("should not have frozen exceptions\n" ++ c) $ not $
" exceptions ==" `isInfixOf` (intercalate " " $ lines $ c)
, testCase "--dry-run does not modify the cabal.config file" $ do
removeCabalConfig
result <- cabal_freeze dir ["--dry-run"] cabalPath
assertFreezeSucceeded result
c <- doesFileExist $ dir </> "cabal.config"
assertBool "cabal.config file should not have been created" (not c)
, testCase "--enable-tests freezes test dependencies" $ do
removeCabalConfig
result <- cabal_freeze dir ["--enable-tests"] cabalPath
assertFreezeSucceeded result
c <- readCabalConfig
assertBool ("should have frozen test-framework\n" ++ c) $
" test-framework ==" `isInfixOf` (intercalate " " $ lines $ c)
, testCase "--disable-tests does not freeze test dependencies" $ do
removeCabalConfig
result <- cabal_freeze dir ["--disable-tests"] cabalPath
assertFreezeSucceeded result
c <- readCabalConfig
assertBool ("should not have frozen test-framework\n" ++ c) $ not $
" test-framework ==" `isInfixOf` (intercalate " " $ lines $ c)
, testCase "--enable-benchmarks freezes benchmark dependencies" $ do
removeCabalConfig
result <- cabal_freeze dir ["--disable-benchmarks"] cabalPath
assertFreezeSucceeded result
c <- readCabalConfig
assertBool ("should not have frozen criterion\n" ++ c) $ not $
" criterion ==" `isInfixOf` (intercalate " " $ lines $ c)
, testCase "--disable-benchmarks does not freeze benchmark dependencies" $ do
removeCabalConfig
result <- cabal_freeze dir ["--disable-benchmarks"] cabalPath
assertFreezeSucceeded result
c <- readCabalConfig
assertBool ("should not have frozen criterion\n" ++ c) $ not $
" criterion ==" `isInfixOf` (intercalate " " $ lines $ c)
]
removeCabalConfig :: IO ()
removeCabalConfig = do
removeFile (dir </> "cabal.config")
`E.catch` \ (e :: IOError) ->
if isDoesNotExistError e
then return ()
else E.throw e
readCabalConfig :: IO String
readCabalConfig = do
readFile $ dir </> "cabal.config"
name: my
version: 0.1
license: BSD3
cabal-version: >= 1.20.0
build-type: Simple
library
exposed-modules: Foo
build-depends: base
test-suite test-Foo
type: exitcode-stdio-1.0
hs-source-dirs: tests
main-is: test-Foo.hs
build-depends: base, my, test-framework
benchmark bench-Foo
type: exitcode-stdio-1.0
hs-source-dirs: benchmarks
main-is: benchmark-Foo.hs
build-depends: base, my, criterion
{-# LANGUAGE ScopedTypeVariables #-}
-- TODO This module was originally based on the PackageTests.PackageTester
-- module in Cabal, however it has a few differences. I suspect that as
-- this module ages the two modules will diverge further. As such, I have
-- not attempted to merge them into a single module nor to extract a common
-- module from them. Refactor this module and/or Cabal's
-- PackageTests.PackageTester to remove commonality.
-- 2014-05-15 Ben Armston
-- | Routines for black-box testing cabal-install.
--
-- Instead of driving the tests by making library calls into
-- Distribution.Simple.* or Distribution.Client.* this module only every
-- executes the `cabal-install` binary.
--
-- You can set the following VERBOSE environment variable to control
-- the verbosity of the output generated by this module.
module PackageTests.PackageTester
( Result(..)
-- * Running cabal commands
, cabal_freeze
-- * Test helpers
, assertFreezeSucceeded
) where
import qualified Control.Exception.Extensible as E
import Control.Monad (unless)
import Data.Maybe (fromMaybe)
import System.Directory (canonicalizePath, doesFileExist)
import System.Environment (getEnv)
import System.Exit (ExitCode(ExitSuccess))
import System.FilePath ((<.>))
import System.IO (hClose, hGetChar, hIsEOF)
import System.IO.Error (isDoesNotExistError)
import System.Process (runProcess, waitForProcess)
import Test.HUnit (Assertion, assertFailure)
import Distribution.Simple.BuildPaths (exeExtension)
import Distribution.Compat.CreatePipe (createPipe)
import Distribution.ReadE (readEOrFail)
import Distribution.Verbosity (Verbosity, deafening, flagToVerbosity, normal,
verbose)
data Success = Failure
-- | ConfigureSuccess
-- | BuildSuccess
-- | InstallSuccess
-- | TestSuccess
-- | BenchSuccess
| FreezeSuccess
deriving (Eq, Show)
data Result = Result
{ successful :: Bool
, success :: Success
, outputText :: String
} deriving Show
nullResult :: Result
nullResult = Result True Failure ""
------------------------------------------------------------------------
-- * Running cabal commands
recordRun :: (String, ExitCode, String) -> Success -> Result -> Result
recordRun (cmd, exitCode, exeOutput) thisSucc res =
res { successful = successful res && exitCode == ExitSuccess
, success = if exitCode == ExitSuccess then thisSucc
else success res
, outputText =
(if null $ outputText res then "" else outputText res ++ "\n") ++
cmd ++ "\n" ++ exeOutput
}
-- | Run the freeze command and return its result.
cabal_freeze :: FilePath -> [String] -> FilePath -> IO Result
cabal_freeze dir args cabalPath = do
res <- cabal dir (["freeze"] ++ args) cabalPath
return $ recordRun res FreezeSuccess nullResult
-- | Returns the command that was issued, the return code, and the output text.
cabal :: FilePath -> [String] -> FilePath -> IO (String, ExitCode, String)
cabal dir cabalArgs cabalPath = do
run (Just dir) cabalPath cabalArgs
-- | Returns the command that was issued, the return code, and the output text
run :: Maybe FilePath -> String -> [String] -> IO (String, ExitCode, String)
run cwd path args = do
verbosity <- getVerbosity
-- path is relative to the current directory; canonicalizePath makes it
-- absolute, so that runProcess will find it even when changing directory.
path' <- do pathExists <- doesFileExist path
canonicalizePath (if pathExists then path else path <.> exeExtension)
printRawCommandAndArgs verbosity path' args
(readh, writeh) <- createPipe
pid <- runProcess path' args cwd Nothing Nothing (Just writeh) (Just writeh)
-- fork off a thread to start consuming the output
out <- suckH [] readh
hClose readh
-- wait for the program to terminate
exitcode <- waitForProcess pid
let fullCmd = unwords (path' : args)
return ("\"" ++ fullCmd ++ "\" in " ++ fromMaybe "" cwd, exitcode, out)
where
suckH output h = do
eof <- hIsEOF h
if eof
then return (reverse output)
else do
c <- hGetChar h
suckH (c:output) h
-- Copied from Distribution/Simple/Utils.hs
printRawCommandAndArgs :: Verbosity -> FilePath -> [String] -> IO ()
printRawCommandAndArgs verbosity path args
| verbosity >= deafening = print (path, args)
| verbosity >= verbose = putStrLn $ unwords (path : args)
| otherwise = return ()
------------------------------------------------------------------------
-- * Test helpers
assertFreezeSucceeded :: Result -> Assertion
assertFreezeSucceeded result = unless (successful result) $
assertFailure $
"expected: \'cabal freeze\' should succeed\n" ++
" output: " ++ outputText result
------------------------------------------------------------------------
-- Verbosity
lookupEnv :: String -> IO (Maybe String)
lookupEnv name =
(fmap Just $ getEnv name)
`E.catch` \ (e :: IOError) ->
if isDoesNotExistError e
then return Nothing
else E.throw e
-- TODO: Convert to a "-v" flag instead.
getVerbosity :: IO Verbosity
getVerbosity = do
maybe normal (readEOrFail flagToVerbosity) `fmap` lookupEnv "VERBOSE"
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