From f842aecd1645ab751841ad9def7a5722f50696b5 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Fri, 7 Sep 2012 06:57:17 +0900
Subject: [PATCH] Simplify a bit more the test harness
We can build the test groups directly in the `testSuite' helper,
instead of doing it (much later) in the test harness.
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Guido Trotter <ultrotter@google.com>
---
htest/Test/Ganeti/TestHelper.hs | 6 +++---
htest/test.hs | 5 ++---
2 files changed, 5 insertions(+), 6 deletions(-)
diff --git a/htest/Test/Ganeti/TestHelper.hs b/htest/Test/Ganeti/TestHelper.hs
index 9fe9dbf3e..04eb4908d 100644
--- a/htest/Test/Ganeti/TestHelper.hs
+++ b/htest/Test/Ganeti/TestHelper.hs
@@ -81,10 +81,10 @@ testSuite :: String -> [Name] -> Q [Dec]
testSuite tsname tdef = do
let fullname = mkName $ "test" ++ mapSlashes tsname
tests <- mapM run tdef
- sigtype <- [t| (String, [Test]) |]
+ sigtype <- [t| Test |]
+ body <- [| testGroup $(litE $ stringL tsname) $(return $ ListE tests) |]
return [ SigD fullname sigtype
- , ValD (VarP fullname) (NormalB (TupE [LitE (StringL tsname),
- ListE tests])) []
+ , ValD (VarP fullname) (NormalB body) []
]
-- | Builds an arbitrary value for a given constructor. This doesn't
diff --git a/htest/test.hs b/htest/test.hs
index d7eb78019..9e00d3609 100644
--- a/htest/test.hs
+++ b/htest/test.hs
@@ -69,7 +69,7 @@ defOpts = TestOptions
}
-- | All our defined tests.
-allTests :: [(String, [Test])]
+allTests :: [Test]
allTests =
[ testBasicTypes
, testCommon
@@ -104,5 +104,4 @@ main :: IO ()
main = do
ropts <- getArgs >>= interpretArgsOrExit
let opts = maybe defOpts (defOpts `mappend`) $ ropt_test_options ropts
- tests = map (uncurry testGroup) allTests
- defaultMainWithOpts tests (ropts { ropt_test_options = Just opts })
+ defaultMainWithOpts allTests (ropts { ropt_test_options = Just opts })
--
GitLab