-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TemplateHaskell, CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-| Unittests for ganeti-htools.
module Test.Ganeti.Utils (testUtils) where
-import Test.QuickCheck
+import Test.QuickCheck hiding (Result)
import Test.HUnit
+import Data.Char (isSpace)
import Data.List
import qualified Text.JSON as J
+#ifndef NO_REGEX_PCRE
+import Text.Regex.PCRE
+#endif
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
+import Ganeti.BasicTypes
+import qualified Ganeti.Constants as C
import qualified Ganeti.JSON as JSON
-import qualified Ganeti.HTools.Types as Types
import Ganeti.Utils
-- | Helper to generate a small string that doesn't contain commas.
prop_parseUnit :: NonNegative Int -> Property
prop_parseUnit (NonNegative n) =
- parseUnit (show n) ==? Types.Ok n .&&.
- parseUnit (show n ++ "m") ==? Types.Ok n .&&.
- parseUnit (show n ++ "M") ==? Types.Ok (truncate n_mb::Int) .&&.
- parseUnit (show n ++ "g") ==? Types.Ok (n*1024) .&&.
- parseUnit (show n ++ "G") ==? Types.Ok (truncate n_gb::Int) .&&.
- parseUnit (show n ++ "t") ==? Types.Ok (n*1048576) .&&.
- parseUnit (show n ++ "T") ==? Types.Ok (truncate n_tb::Int) .&&.
- printTestCase "Internal error/overflow?"
- (n_mb >=0 && n_gb >= 0 && n_tb >= 0) .&&.
- property (Types.isBad (parseUnit (show n ++ "x")::Types.Result Int))
+ conjoin
+ [ parseUnit (show n) ==? (Ok n::Result Int)
+ , parseUnit (show n ++ "m") ==? (Ok n::Result Int)
+ , parseUnit (show n ++ "M") ==? (Ok (truncate n_mb)::Result Int)
+ , parseUnit (show n ++ "g") ==? (Ok (n*1024)::Result Int)
+ , parseUnit (show n ++ "G") ==? (Ok (truncate n_gb)::Result Int)
+ , parseUnit (show n ++ "t") ==? (Ok (n*1048576)::Result Int)
+ , parseUnit (show n ++ "T") ==? (Ok (truncate n_tb)::Result Int)
+ , printTestCase "Internal error/overflow?"
+ (n_mb >=0 && n_gb >= 0 && n_tb >= 0)
+ , property (isBad (parseUnit (show n ++ "x")::Result Int))
+ ]
where n_mb = (fromIntegral n::Rational) * 1000 * 1000 / 1024 / 1024
n_gb = n_mb * 1000
n_tb = n_gb * 1000
-- itself, etc.).
prop_niceSort_single :: Property
prop_niceSort_single =
- forAll getName $ \name ->
+ forAll genName $ \name ->
conjoin
[ printTestCase "single string" $ [name] ==? niceSort [name]
, printTestCase "single plus empty" $ ["", name] ==? niceSort [name, ""]
zip numbers names)
]
+-- | Tests 'rstripSpace'.
+prop_rStripSpace :: NonEmptyList Char -> Property
+prop_rStripSpace (NonEmpty str) =
+ forAll (resize 50 $ listOf1 (arbitrary `suchThat` isSpace)) $ \whitespace ->
+ conjoin [ printTestCase "arb. string last char is not space" $
+ case rStripSpace str of
+ [] -> True
+ xs -> not . isSpace $ last xs
+ , printTestCase "whitespace suffix is stripped" $
+ rStripSpace str ==? rStripSpace (str ++ whitespace)
+ , printTestCase "whitespace reduced to null" $
+ rStripSpace whitespace ==? ""
+ , printTestCase "idempotent on empty strings" $
+ rStripSpace "" ==? ""
+ ]
+
+#ifndef NO_REGEX_PCRE
+{-# ANN case_new_uuid "HLint: ignore Use camelCase" #-}
+
+-- | Tests that the newUUID function produces valid UUIDs.
+case_new_uuid :: Assertion
+case_new_uuid = do
+ uuid <- newUUID
+ assertBool "newUUID" $ uuid =~ C.uuidRegex
+#endif
+
-- | Test list for the Utils module.
testSuite "Utils"
[ 'prop_commaJoinSplit
, 'prop_niceSort_generic
, 'prop_niceSort_numbers
, 'prop_niceSortKey_equiv
+ , 'prop_rStripSpace
+#ifndef NO_REGEX_PCRE
+ , 'case_new_uuid
+#endif
]