Commit 1493a93b authored by Iustin Pop's avatar Iustin Pop

Add unittests for the BasicTypes module

This adds test properties for the various laws that the instances of
Result should follow; I could not find (offline) laws about `mappend',
but otherwise I implemented all laws that I could find.

Note that we have to silence hlint warnings for the things we want to
test, as otherwise hlint is all "this is already true based on the
functor law, why 'fmap id' and not just 'id'?".
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarRené Nussbaumer <rn@google.com>
parent e09c1fa0
...@@ -438,6 +438,7 @@ HS_LIB_SRCS = \ ...@@ -438,6 +438,7 @@ HS_LIB_SRCS = \
htools/Ganeti/THH.hs htools/Ganeti/THH.hs
HS_TEST_SRCS = \ HS_TEST_SRCS = \
htest/Test/Ganeti/BasicTypes.hs \
htest/Test/Ganeti/Confd/Utils.hs \ htest/Test/Ganeti/Confd/Utils.hs \
htest/Test/Ganeti/HTools/CLI.hs \ htest/Test/Ganeti/HTools/CLI.hs \
htest/Test/Ganeti/HTools/Cluster.hs \ htest/Test/Ganeti/HTools/Cluster.hs \
......
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-| Unittests for ganeti-htools.
-}
{-
Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA.
-}
module Test.Ganeti.BasicTypes (testBasicTypes) where
import Test.QuickCheck hiding (Result)
import Test.QuickCheck.Function
import Control.Applicative
import Control.Monad
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import Ganeti.BasicTypes
-- Since we actually want to test these, don't tell us not to use them :)
{-# ANN module "HLint: ignore Functor law" #-}
{-# ANN module "HLint: ignore Monad law, left identity" #-}
{-# ANN module "HLint: ignore Monad law, right identity" #-}
{-# ANN module "HLint: ignore Use >=>" #-}
-- * Arbitrary instances
instance (Arbitrary a) => Arbitrary (Result a) where
arbitrary = oneof [ Bad <$> arbitrary
, Ok <$> arbitrary
]
-- * Test cases
-- | Tests the functor identity law (fmap id == id).
prop_functor_id :: Result Int -> Property
prop_functor_id ri =
fmap id ri ==? ri
-- | Tests the functor composition law (fmap (f . g) == fmap f . fmap g).
prop_functor_composition :: Result Int
-> Fun Int Int -> Fun Int Int -> Property
prop_functor_composition ri (Fun _ f) (Fun _ g) =
fmap (f . g) ri ==? (fmap f . fmap g) ri
-- | Tests the applicative identity law (pure id <*> v = v).
prop_applicative_identity :: Result Int -> Property
prop_applicative_identity v =
pure id <*> v ==? v
-- | Tests the applicative composition law (pure (.) <*> u <*> v <*> w
-- = u <*> (v <*> w)).
prop_applicative_composition :: (Result (Fun Int Int))
-> (Result (Fun Int Int))
-> Result Int
-> Property
prop_applicative_composition u v w =
let u' = fmap apply u
v' = fmap apply v
in pure (.) <*> u' <*> v' <*> w ==? u' <*> (v' <*> w)
-- | Tests the applicative homomorphism law (pure f <*> pure x = pure (f x)).
prop_applicative_homomorphism :: Fun Int Int -> Int -> Property
prop_applicative_homomorphism (Fun _ f) x =
((pure f <*> pure x)::Result Int) ==?
(pure (f x))
-- | Tests the applicative interchange law (u <*> pure y = pure ($ y) <*> u).
prop_applicative_interchange :: Result (Fun Int Int)
-> Int -> Property
prop_applicative_interchange f y =
let u = fmap apply f -- need to extract the actual function from Fun
in u <*> pure y ==? pure ($ y) <*> u
-- | Tests the applicative\/functor correspondence (fmap f x = pure f <*> x).
prop_applicative_functor :: Fun Int Int -> Result Int -> Property
prop_applicative_functor (Fun _ f) x =
fmap f x ==? pure f <*> x
-- | Tests the applicative\/monad correspondence (pure = return and
-- (<*>) = ap).
prop_applicative_monad :: Int -> Result (Fun Int Int) -> Property
prop_applicative_monad v f =
let v' = pure v :: Result Int
f' = fmap apply f -- need to extract the actual function from Fun
in v' ==? return v .&&. (f' <*> v') ==? f' `ap` v'
-- | Tests the monad laws (return a >>= k == k a, m >>= return == m, m
-- >>= (\x -> k x >>= h) == (m >>= k) >>= h).
prop_monad_laws :: Int -> Result Int
-> Fun Int (Result Int)
-> Fun Int (Result Int)
-> Property
prop_monad_laws a m (Fun _ k) (Fun _ h) =
printTestCase "return a >>= k == k a" ((return a >>= k) ==? k a) .&&.
printTestCase "m >>= return == m" ((m >>= return) ==? m) .&&.
printTestCase "m >>= (\\x -> k x >>= h) == (m >>= k) >>= h)"
((m >>= (\x -> k x >>= h)) ==? ((m >>= k) >>= h))
-- | Tests the monad plus laws ( mzero >>= f = mzero, v >> mzero = mzero).
prop_monadplus_mzero :: Result Int -> Fun Int (Result Int) -> Property
prop_monadplus_mzero v (Fun _ f) =
printTestCase "mzero >>= f = mzero" ((mzero >>= f) ==? mzero) .&&.
-- FIXME: since we have "many" mzeros, we can't test for equality,
-- just that we got back a 'Bad' value; I'm not sure if this means
-- our MonadPlus instance is not sound or not...
printTestCase "v >> mzero = mzero" (isBad (v >> mzero))
testSuite "BasicTypes"
[ 'prop_functor_id
, 'prop_functor_composition
, 'prop_applicative_identity
, 'prop_applicative_composition
, 'prop_applicative_homomorphism
, 'prop_applicative_interchange
, 'prop_applicative_functor
, 'prop_applicative_monad
, 'prop_monad_laws
, 'prop_monadplus_mzero
]
...@@ -30,6 +30,7 @@ import Test.Framework ...@@ -30,6 +30,7 @@ import Test.Framework
import System.Environment (getArgs) import System.Environment (getArgs)
import Test.Ganeti.TestImports () import Test.Ganeti.TestImports ()
import Test.Ganeti.BasicTypes
import Test.Ganeti.Confd.Utils import Test.Ganeti.Confd.Utils
import Test.Ganeti.HTools.CLI import Test.Ganeti.HTools.CLI
import Test.Ganeti.HTools.Cluster import Test.Ganeti.HTools.Cluster
...@@ -73,7 +74,8 @@ slow = fast ...@@ -73,7 +74,8 @@ slow = fast
-- | All our defined tests. -- | All our defined tests.
allTests :: [(Bool, (String, [Test]))] allTests :: [(Bool, (String, [Test]))]
allTests = allTests =
[ (True, testConfd_Utils) [ (True, testBasicTypes)
, (True, testConfd_Utils)
, (True, testHTools_CLI) , (True, testHTools_CLI)
, (True, testHTools_Container) , (True, testHTools_Container)
, (True, testHTools_Instance) , (True, testHTools_Instance)
......
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