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…

.gitignore

-apidoc
+/apidoc/
+/.hpc/
+/coverage/
 
 *.o
 *.patch
@@ -15,8 +17,10 @@ hn1
 hbal
 hscan
 hail
+test
 *.prof*
 *.stat
+*.tix
 
 version
 Version.hs

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

Ganeti/HTools/QC.hs

+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)

Makefile

-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

test.hs

+{-| 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
+       ]