From 060b05b2b47e92168c79db77bfda4b0f2dce3fdb Mon Sep 17 00:00:00 2001
From: Mikhail Glushenkov <the.dead.shall.rise@gmail.com>
Date: Mon, 31 Dec 2012 06:24:43 +0100
Subject: [PATCH] Add unit tests for the UserConstraint parser.
---
cabal-install/cabal-install.cabal | 13 ++++
cabal-install/tests/UnitTests.hs | 15 +++++
.../UnitTests/Distribution/Client/Targets.hs | 59 +++++++++++++++++++
3 files changed, 87 insertions(+)
create mode 100644 cabal-install/tests/UnitTests.hs
create mode 100644 cabal-install/tests/UnitTests/Distribution/Client/Targets.hs
diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal
index 731ec5f732..7b341d7019 100644
--- a/cabal-install/cabal-install.cabal
+++ b/cabal-install/cabal-install.cabal
@@ -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
diff --git a/cabal-install/tests/UnitTests.hs b/cabal-install/tests/UnitTests.hs
new file mode 100644
index 0000000000..6d5d47a02a
--- /dev/null
+++ b/cabal-install/tests/UnitTests.hs
@@ -0,0 +1,15 @@
+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
diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Targets.hs b/cabal-install/tests/UnitTests/Distribution/Client/Targets.hs
new file mode 100644
index 0000000000..e641c50a42
--- /dev/null
+++ b/cabal-install/tests/UnitTests/Distribution/Client/Targets.hs
@@ -0,0 +1,59 @@
+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
--
GitLab