Commit 060b05b2 authored by refold's avatar refold
Browse files

Add unit tests for the UserConstraint parser.

parent 03af50b6
......@@ -165,3 +165,16 @@ Executable cabal
else
build-depends: base >= 3,
directory >= 1 && < 1.3
Test-Suite unit-tests
type: exitcode-stdio-1.0
main-is: UnitTests.hs
hs-source-dirs: tests
build-depends:
base,
test-framework,
test-framework-hunit,
HUnit,
cabal-install,
Cabal
ghc-options: -Wall
module Main
where
import Test.Framework
import qualified UnitTests.Distribution.Client.Targets
tests :: [Test]
tests = [
testGroup "Distribution.Client.Targets"
UnitTests.Distribution.Client.Targets.tests
]
main :: IO ()
main = defaultMain tests
module UnitTests.Distribution.Client.Targets (
tests
) where
import Distribution.Client.Targets (UserConstraint (..), readUserConstraint)
import Distribution.Compat.ReadP (ReadP, readP_to_S)
import Distribution.Package (PackageName (..))
import Distribution.ParseUtils (parseCommaList)
import Distribution.Text (parse)
import Test.Framework as TF (Test)
import Test.Framework.Providers.HUnit (testCase)
import Test.HUnit (Assertion, assertEqual)
import Data.Char (isSpace)
tests :: [TF.Test]
tests = [ testCase "readUserConstraint" readUserConstraintTest
, testCase "parseUserConstraint" parseUserConstraintTest
, testCase "readUserConstraints" readUserConstraintsTest
]
readUserConstraintTest :: Assertion
readUserConstraintTest =
assertEqual ("Couldn't read constraint: '" ++ constr ++ "'") expected actual
where
pkgName = "template-haskell"
constr = pkgName ++ " installed"
expected = UserConstraintInstalled (PackageName pkgName)
actual = let (Right r) = readUserConstraint constr in r
parseUserConstraintTest :: Assertion
parseUserConstraintTest =
assertEqual ("Couldn't parse constraint: '" ++ constr ++ "'") expected actual
where
pkgName = "template-haskell"
constr = pkgName ++ " installed"
expected = [UserConstraintInstalled (PackageName pkgName)]
actual = [ x | (x, ys) <- readP_to_S parseUserConstraint constr
, all isSpace ys]
parseUserConstraint :: ReadP r UserConstraint
parseUserConstraint = parse
readUserConstraintsTest :: Assertion
readUserConstraintsTest =
assertEqual ("Couldn't read constraints: '" ++ constr ++ "'") expected actual
where
pkgName = "template-haskell"
constr = pkgName ++ " installed"
expected = [[UserConstraintInstalled (PackageName pkgName)]]
actual = [ x | (x, ys) <- readP_to_S parseUserConstraints constr
, all isSpace ys]
parseUserConstraints :: ReadP r [UserConstraint]
parseUserConstraints = parseCommaList parse
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