## root / test / hs / Test / Ganeti / Locking / Locks.hs @ 69809ae3

History | View | Annotate | Download (2.7 kB)

1 |
{-# LANGUAGE TemplateHaskell #-} |
---|---|

2 |
{-# OPTIONS_GHC -fno-warn-orphans #-} |

3 | |

4 |
{-| Tests for the lock data structure |

5 | |

6 |
-} |

7 | |

8 |
{- |

9 | |

10 |
Copyright (C) 2014 Google Inc. |

11 | |

12 |
This program is free software; you can redistribute it and/or modify |

13 |
it under the terms of the GNU General Public License as published by |

14 |
the Free Software Foundation; either version 2 of the License, or |

15 |
(at your option) any later version. |

16 | |

17 |
This program is distributed in the hope that it will be useful, but |

18 |
WITHOUT ANY WARRANTY; without even the implied warranty of |

19 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |

20 |
General Public License for more details. |

21 | |

22 |
You should have received a copy of the GNU General Public License |

23 |
along with this program; if not, write to the Free Software |

24 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |

25 |
02110-1301, USA. |

26 | |

27 |
-} |

28 | |

29 |
module Test.Ganeti.Locking.Locks (testLocking_Locks) where |

30 | |

31 |
import Control.Applicative ((<$>), liftA2) |

32 | |

33 |
import Test.QuickCheck |

34 |
import Text.JSON |

35 | |

36 |
import Test.Ganeti.TestHelper |

37 |
import Test.Ganeti.TestCommon |

38 | |

39 |
import Ganeti.Locking.Locks |

40 |
import Ganeti.Locking.Types |

41 | |

42 |
instance Arbitrary GanetiLocks where |

43 |
arbitrary = oneof [ return BGL |

44 |
, return ClusterLockSet |

45 |
, return InstanceLockSet |

46 |
, Instance <$> genUUID |

47 |
, return NodeGroupLockSet |

48 |
, NodeGroup <$> genUUID |

49 |
, return NAL |

50 |
, return NodeAllocLockSet |

51 |
, return NodeResLockSet |

52 |
, NodeRes <$> genUUID |

53 |
, return NodeLockSet |

54 |
, Node <$> genUUID |

55 |
] |

56 | |

57 |
-- | Verify that readJSON . showJSON = Ok |

58 |
prop_ReadShow :: Property |

59 |
prop_ReadShow = forAll (arbitrary :: Gen GanetiLocks) $ \a -> |

60 |
readJSON (showJSON a) ==? Ok a |

61 | |

62 |
-- | Verify the implied locks are earlier in the lock order. |

63 |
prop_ImpliedOrder :: Property |

64 |
prop_ImpliedOrder = |

65 |
forAll ((arbitrary :: Gen GanetiLocks) |

66 |
`suchThat` (not . null . lockImplications)) $ \b -> |

67 |
printTestCase "Implied locks must be earlier in the lock order" |

68 |
. flip all (lockImplications b) $ \a -> |

69 |
a < b |

70 | |

71 |
-- | Verify the intervall property of the locks. |

72 |
prop_ImpliedIntervall :: Property |

73 |
prop_ImpliedIntervall = |

74 |
forAll ((arbitrary :: Gen GanetiLocks) |

75 |
`suchThat` (not . null . lockImplications)) $ \b -> |

76 |
forAll (elements $ lockImplications b) $ \a -> |

77 |
forAll (arbitrary `suchThat` liftA2 (&&) (a <) (<= b)) $ \x -> |

78 |
printTestCase ("Locks between a group and a member of the group" |

79 |
++ " must also belong to the group") |

80 |
$ a `elem` lockImplications x |

81 | |

82 |
testSuite "Locking/Locks" |

83 |
[ 'prop_ReadShow |

84 |
, 'prop_ImpliedOrder |

85 |
, 'prop_ImpliedIntervall |

86 |
] |