Add test infrastructure and initial tests

This patch adds a QuickCheck-based test infrastructure and initial tests
based on it. The PeerMap module has a 100% coverage ☺

Side-note: one has to read the source of QuickCheck to see how to use it
(especially the Batch submodule), the docs are not enough…

diff --git a/.gitignore b/.gitignore
index 9f2bc4e..65824c5 100644 (file)
--- a/.gitignore
+++ b/.gitignore
@@ -1,4 +1,6 @@
-apidoc
+/apidoc/
+/.hpc/
+/coverage/
 
 *.o
 *.patch
@@ -15,8 +17,10 @@ hn1
 hbal
 hscan
 hail
+test
 *.prof*
 *.stat
+*.tix
 
 version
 Version.hs

diff --git a/Ganeti/HTools/Node.hs b/Ganeti/HTools/Node.hs
index 68f8300..05930cd 100644 (file)
--- a/Ganeti/HTools/Node.hs
+++ b/Ganeti/HTools/Node.hs
@@ -5,7 +5,7 @@
 -}
 
 module Ganeti.HTools.Node
-    ( Node(failN1, name, idx, t_mem, n_mem, f_mem, t_dsk, f_dsk,
+    ( Node(failN1, name, idx, t_mem, n_mem, f_mem, r_mem, t_dsk, f_dsk,
            p_mem, p_dsk, p_rem,
            plist, slist, offline)
     , List

diff --git a/Ganeti/HTools/QC.hs b/Ganeti/HTools/QC.hs
new file mode 100644 (file)
index 0000000..c861358
--- /dev/null
+++ b/Ganeti/HTools/QC.hs
@@ -0,0 +1,101 @@
+module Ganeti.HTools.QC
+    where
+
+import Test.QuickCheck
+import Data.Maybe
+import qualified Ganeti.HTools.CLI as CLI
+import qualified Ganeti.HTools.Cluster as Cluster
+import qualified Ganeti.HTools.Container as Container
+import qualified Ganeti.HTools.IAlloc as IAlloc
+import qualified Ganeti.HTools.Instance as Instance
+import qualified Ganeti.HTools.Loader as Loader
+import qualified Ganeti.HTools.Node as Node
+import qualified Ganeti.HTools.PeerMap as PeerMap
+import qualified Ganeti.HTools.Rapi as Rapi
+import qualified Ganeti.HTools.Text as Text
+import qualified Ganeti.HTools.Types as Types
+import qualified Ganeti.HTools.Utils as Utils
+
+-- copied from the introduction to quickcheck
+instance Arbitrary Char where
+    arbitrary     = choose ('\32', '\128')
+
+-- let's generate a random instance
+instance Arbitrary Instance.Instance where
+    arbitrary = do
+      name <- arbitrary
+      mem <- choose(0, 100)
+      dsk <- choose(0, 100)
+      run_st <- arbitrary
+      pn <- arbitrary
+      sn <- arbitrary
+      return $ Instance.create name mem dsk run_st pn sn
+
+-- and a random node
+instance Arbitrary Node.Node where
+    arbitrary = do
+      name <- arbitrary
+      mem_t <- arbitrary
+      mem_f <- choose (0, mem_t)
+      mem_n <- choose (0, mem_t - mem_f)
+      dsk_t <- arbitrary
+      dsk_f <- choose (0, dsk_t)
+      offl <- arbitrary
+      npeers <- choose (0, 100)
+      let n = Node.create name (fromIntegral mem_t) mem_n mem_f
+              (fromIntegral dsk_t) dsk_f offl
+          n' = Node.buildPeers n Container.empty npeers
+      return n'
+
+-- | Make sure add is idempotent
+prop_PeerMap_addIdempotent pmap key elem =
+    fn puniq == fn (fn puniq)
+    where fn = PeerMap.add key elem
+          puniq = PeerMap.accumArray const pmap
+          _types = (pmap::PeerMap.PeerMap,
+                    key::PeerMap.Key, elem::PeerMap.Elem)
+
+-- | Make sure remove is idempotent
+prop_PeerMap_removeIdempotent pmap key =
+    fn puniq == fn (fn puniq)
+    where fn = PeerMap.remove key
+          puniq = PeerMap.accumArray const pmap
+          _types = (pmap::PeerMap.PeerMap,
+                    key::PeerMap.Key)
+
+-- | Make sure a missing item returns 0
+prop_PeerMap_findMissing pmap key =
+    PeerMap.find key (PeerMap.remove key puniq) == 0
+    where fn = PeerMap.remove key
+          puniq = PeerMap.accumArray const pmap
+          _types = (pmap::PeerMap.PeerMap,
+                    key::PeerMap.Key)
+
+-- | Make sure an added item is found
+prop_PeerMap_addFind pmap key elem =
+    PeerMap.find key (PeerMap.add key elem puniq) == elem
+    where puniq = PeerMap.accumArray const pmap
+          _types = (pmap::PeerMap.PeerMap,
+                    key::PeerMap.Key, elem::PeerMap.Elem)
+
+-- | Manual check that maxElem returns the maximum indeed, or 0 for null
+prop_PeerMap_maxElem pmap =
+    PeerMap.maxElem puniq == if null puniq then 0
+                             else (maximum . snd . unzip) puniq
+    where
+          puniq = PeerMap.accumArray const pmap
+          _types = pmap::PeerMap.PeerMap
+
+prop_Node_addPri node inst = (Instance.mem inst >= Node.f_mem node ||
+                              Instance.dsk inst >= Node.f_dsk node) &&
+                             (not $ Node.failN1 node)
+                             ==>
+                             isNothing(Node.addPri node inst)
+    where _types = (node::Node.Node, inst::Instance.Instance)
+
+prop_Node_addSec node inst pdx =
+    (Instance.mem inst >= (Node.f_mem node - Node.r_mem node) ||
+     Instance.dsk inst >= Node.f_dsk node) &&
+    (not $ Node.failN1 node)
+    ==> isNothing(Node.addSec node inst pdx)
+        where _types = (node::Node.Node, inst::Instance.Instance, pdx::Int)

diff --git a/Makefile b/Makefile
index b349a8c..be3c899 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -1,15 +1,20 @@
-HPROGS = hbal hn1 hscan hail
+HPROGS = hbal hn1 hscan hail test
 HSRCS := $(wildcard Ganeti/HTools/*.hs)
 HDDIR = apidoc
 
 DOCS = README.html NEWS.html
 
+HFLAGS = -O2 -W -fwarn-monomorphism-restriction -fwarn-tabs
+HEXTRA =
+
+HPCEXCL = --exclude Main --exclude Ganeti.HTools.QC
+
 # Haskell rules
 
 all: $(HPROGS)
 
 $(HPROGS): %: %.hs Ganeti/HTools/Version.hs $(HSRCS) Makefile
-       ghc --make -O2 -W $@
+       ghc --make $(HFLAGS) $(HEXTRA) $@
 
 $(DOCS) : %.html : %
        rst2html $< $@
@@ -53,4 +58,15 @@ dist: Ganeti/HTools/Version.hs version doc
        gzip -v9 $$ANAME ; \
        tar tzvf $$ANAME.gz
 
-.PHONY : all doc maintainer-clean clean dist
+check:
+       rm -f *.tix *.mix test
+       $(MAKE) HEXTRA=-fhpc test
+       ./test
+ifeq ($(T),markup)
+       mkdir -p coverage
+       hpc markup --destdir=coverage test $(HPCEXCL)
+else
+       hpc report test $(HPCEXCL)
+endif
+
+.PHONY : all doc maintainer-clean clean dist check

diff --git a/test.hs b/test.hs
new file mode 100644 (file)
index 0000000..fbe765a
--- /dev/null
+++ b/test.hs
@@ -0,0 +1,27 @@
+{-| Unittest runner for htools
+
+-}
+
+module Main(main) where
+
+import Test.QuickCheck.Batch
+import Ganeti.HTools.QC
+
+options = TestOptions
+      { no_of_tests         = 500
+      , length_of_tests     = 5
+      , debug_tests         = False }
+
+main = do
+  runTests "PeerMap" options
+       [ run prop_PeerMap_addIdempotent
+       , run prop_PeerMap_removeIdempotent
+       , run prop_PeerMap_maxElem
+       , run prop_PeerMap_addFind
+       , run prop_PeerMap_findMissing
+       ]
+
+  runTests "Node" options
+       [ run prop_Node_addPri
+       , run prop_Node_addSec
+       ]