root / htools / Ganeti / HTools / QCHelper.hs @ adb77e3a
History | View | Annotate | Download (2.4 kB)
1 | 23fe06c2 | Iustin Pop | {-# LANGUAGE TemplateHaskell #-} |
---|---|---|---|
2 | 23fe06c2 | Iustin Pop | |
3 | 23fe06c2 | Iustin Pop | {-| Unittest helpers for ganeti-htools |
4 | 23fe06c2 | Iustin Pop | |
5 | 23fe06c2 | Iustin Pop | -} |
6 | 23fe06c2 | Iustin Pop | |
7 | 23fe06c2 | Iustin Pop | {- |
8 | 23fe06c2 | Iustin Pop | |
9 | 95f6c931 | Iustin Pop | Copyright (C) 2011, 2012 Google Inc. |
10 | 23fe06c2 | Iustin Pop | |
11 | 23fe06c2 | Iustin Pop | This program is free software; you can redistribute it and/or modify |
12 | 23fe06c2 | Iustin Pop | it under the terms of the GNU General Public License as published by |
13 | 23fe06c2 | Iustin Pop | the Free Software Foundation; either version 2 of the License, or |
14 | 23fe06c2 | Iustin Pop | (at your option) any later version. |
15 | 23fe06c2 | Iustin Pop | |
16 | 23fe06c2 | Iustin Pop | This program is distributed in the hope that it will be useful, but |
17 | 23fe06c2 | Iustin Pop | WITHOUT ANY WARRANTY; without even the implied warranty of |
18 | 23fe06c2 | Iustin Pop | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
19 | 23fe06c2 | Iustin Pop | General Public License for more details. |
20 | 23fe06c2 | Iustin Pop | |
21 | 23fe06c2 | Iustin Pop | You should have received a copy of the GNU General Public License |
22 | 23fe06c2 | Iustin Pop | along with this program; if not, write to the Free Software |
23 | 23fe06c2 | Iustin Pop | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
24 | 23fe06c2 | Iustin Pop | 02110-1301, USA. |
25 | 23fe06c2 | Iustin Pop | |
26 | 23fe06c2 | Iustin Pop | -} |
27 | 23fe06c2 | Iustin Pop | |
28 | 23fe06c2 | Iustin Pop | module Ganeti.HTools.QCHelper |
29 | ebf38064 | Iustin Pop | ( testSuite |
30 | ebf38064 | Iustin Pop | ) where |
31 | 23fe06c2 | Iustin Pop | |
32 | 6dd92942 | Iustin Pop | import Data.List (stripPrefix, isPrefixOf) |
33 | 95f6c931 | Iustin Pop | import Data.Maybe (fromMaybe) |
34 | 95f6c931 | Iustin Pop | import Test.Framework |
35 | 6dd92942 | Iustin Pop | import Test.Framework.Providers.HUnit |
36 | 95f6c931 | Iustin Pop | import Test.Framework.Providers.QuickCheck2 |
37 | 6dd92942 | Iustin Pop | import Test.HUnit (Assertion) |
38 | 6dd92942 | Iustin Pop | import Test.QuickCheck |
39 | 23fe06c2 | Iustin Pop | import Language.Haskell.TH |
40 | 23fe06c2 | Iustin Pop | |
41 | 95f6c931 | Iustin Pop | -- | Tries to drop a prefix from a string. |
42 | 95f6c931 | Iustin Pop | simplifyName :: String -> String -> String |
43 | 95f6c931 | Iustin Pop | simplifyName pfx string = fromMaybe string (stripPrefix pfx string) |
44 | 23fe06c2 | Iustin Pop | |
45 | 6dd92942 | Iustin Pop | -- | Builds a test from a QuickCheck property. |
46 | 6dd92942 | Iustin Pop | runQC :: Testable prop => String -> String -> prop -> Test |
47 | 6dd92942 | Iustin Pop | runQC pfx name = testProperty (simplifyName ("prop_" ++ pfx ++ "_") name) |
48 | 6dd92942 | Iustin Pop | |
49 | 6dd92942 | Iustin Pop | -- | Builds a test for a HUnit test case. |
50 | 6dd92942 | Iustin Pop | runHUnit :: String -> String -> Assertion -> Test |
51 | 6dd92942 | Iustin Pop | runHUnit pfx name = testCase (simplifyName ("case_" ++ pfx ++ "_") name) |
52 | 6dd92942 | Iustin Pop | |
53 | 6dd92942 | Iustin Pop | -- | Runs the correct test provider for a given test, based on its |
54 | 6dd92942 | Iustin Pop | -- name (not very nice, but...). |
55 | 6dd92942 | Iustin Pop | run :: String -> Name -> Q Exp |
56 | 6dd92942 | Iustin Pop | run tsname name = |
57 | 6dd92942 | Iustin Pop | let str = nameBase name |
58 | 6dd92942 | Iustin Pop | nameE = varE name |
59 | 6dd92942 | Iustin Pop | strE = litE (StringL str) |
60 | 6dd92942 | Iustin Pop | in case () of |
61 | 6dd92942 | Iustin Pop | _ | "prop_" `isPrefixOf` str -> [| runQC tsname $strE $nameE |] |
62 | 6dd92942 | Iustin Pop | | "case_" `isPrefixOf` str -> [| runHUnit tsname $strE $nameE |] |
63 | 6dd92942 | Iustin Pop | | otherwise -> fail $ "Unsupported test function name '" ++ str ++ "'" |
64 | 95f6c931 | Iustin Pop | |
65 | 95f6c931 | Iustin Pop | -- | Builds a test suite. |
66 | 23fe06c2 | Iustin Pop | testSuite :: String -> [Name] -> Q [Dec] |
67 | 23fe06c2 | Iustin Pop | testSuite tsname tdef = do |
68 | 23fe06c2 | Iustin Pop | let fullname = mkName $ "test" ++ tsname |
69 | 6dd92942 | Iustin Pop | tests <- mapM (run tsname) tdef |
70 | 95f6c931 | Iustin Pop | sigtype <- [t| (String, [Test]) |] |
71 | 05ff7a00 | Agata Murawska | return [ SigD fullname sigtype |
72 | 05ff7a00 | Agata Murawska | , ValD (VarP fullname) (NormalB (TupE [LitE (StringL tsname), |
73 | 05ff7a00 | Agata Murawska | ListE tests])) [] |
74 | 05ff7a00 | Agata Murawska | ] |