commit 5cefb2b2b638a13a288895bee110eca5f3aeee13
Author: Iustin Pop <iustin@google.com>
Date:   Mon May 7 12:07:10 2012 +0200

    Some unit tests improvements
    
    In preparation for unit-testing the Luxi definitions, this improves
    the auto-generation of OpCodes: currently this uses unbounded plain
    Strings for names and fields, and this creates too big test sizes
    (e.g. when automatically generating job sets).
    
    Furthermore, there are some more cleanups: switching from liftM to
    applicative style for easier definition, and some improvements in
    generators.
    
    Signed-off-by: Iustin Pop <iustin@google.com>
    Reviewed-by: René Nussbaumer <rn@google.com>

diff --git a/htools/Ganeti/HTools/QC.hs b/htools/Ganeti/HTools/QC.hs
index fef4f87..2c29968 100644
--- a/htools/Ganeti/HTools/QC.hs
+++ b/htools/Ganeti/HTools/QC.hs
@@ -48,6 +48,7 @@ import Data.List (findIndex, intercalate, nub, isPrefixOf)
 import qualified Data.Set as Set
 import Data.Maybe
 import Control.Monad
+import Control.Applicative
 import qualified System.Console.GetOpt as GetOpt
 import qualified Text.JSON as J
 import qualified Data.Map
@@ -106,6 +107,15 @@ maxVcpuRatio = 1024.0
 maxSpindleRatio :: Double
 maxSpindleRatio = 1024.0
 
+-- | Max nodes, used just to limit arbitrary instances for smaller
+-- opcode definitions (e.g. list of nodes in OpTestDelay).
+maxNodes :: Int
+maxNodes = 32
+
+-- | Max opcodes or jobs in a submit job and submit many jobs.
+maxOpCodes :: Int
+maxOpCodes = 16
+
 -- | All disk templates (used later)
 allDiskTemplates :: [Types.DiskTemplate]
 allDiskTemplates = [minBound..maxBound]
@@ -260,16 +270,31 @@ instance Arbitrary DNSChar where
 getName :: Gen String
 getName = do
   n <- choose (1, 64)
-  dn <- vector n::Gen [DNSChar]
+  dn <- vector n
   return (map dnsGetChar dn)
 
 -- | Generates an entire FQDN.
 getFQDN :: Gen String
 getFQDN = do
   ncomps <- choose (1, 4)
-  names <- mapM (const getName) [1..ncomps::Int]
+  names <- vectorOf ncomps getName
   return $ intercalate "." names
 
+-- | Combinator that generates a 'Maybe' using a sub-combinator.
+getMaybe :: Gen a -> Gen (Maybe a)
+getMaybe subgen = do
+  bool <- arbitrary
+  if bool
+    then Just <$> subgen
+    else return Nothing
+
+-- | Generates a fields list. This uses the same character set as a
+-- DNS name (just for simplicity).
+getFields :: Gen [String]
+getFields = do
+  n <- choose (1, 32)
+  vectorOf n getName
+
 -- | Defines a tag type.
 newtype TagChar = TagChar { tagGetChar :: Char }
 
@@ -386,16 +411,17 @@ instance Arbitrary OpCodes.OpCode where
                       ]
     case op_id of
       "OP_TEST_DELAY" ->
-        liftM3 OpCodes.OpTestDelay arbitrary arbitrary arbitrary
+        OpCodes.OpTestDelay <$> arbitrary <*> arbitrary
+                 <*> resize maxNodes (listOf getFQDN)
       "OP_INSTANCE_REPLACE_DISKS" ->
-        liftM5 OpCodes.OpInstanceReplaceDisks arbitrary arbitrary
-          arbitrary arbitrary arbitrary
+        OpCodes.OpInstanceReplaceDisks <$> getFQDN <*> getMaybe getFQDN <*>
+          arbitrary <*> resize C.maxDisks arbitrary <*> getMaybe getName
       "OP_INSTANCE_FAILOVER" ->
-        liftM3 OpCodes.OpInstanceFailover arbitrary arbitrary
-          arbitrary
+        OpCodes.OpInstanceFailover <$> getFQDN <*> arbitrary <*>
+          getMaybe getFQDN
       "OP_INSTANCE_MIGRATE" ->
-        liftM5 OpCodes.OpInstanceMigrate arbitrary arbitrary
-          arbitrary arbitrary arbitrary
+        OpCodes.OpInstanceMigrate <$> getFQDN <*> arbitrary <*>
+          arbitrary <*> arbitrary <*> getMaybe getFQDN
       _ -> fail "Wrong opcode"
 
 instance Arbitrary Jobs.OpStatus where
@@ -425,8 +451,8 @@ instance Arbitrary Types.EvacMode where
 instance Arbitrary a => Arbitrary (Types.OpResult a) where
   arbitrary = arbitrary >>= \c ->
               if c
-                then liftM Types.OpGood arbitrary
-                else liftM Types.OpFail arbitrary
+                then Types.OpGood <$> arbitrary
+                else Types.OpFail <$> arbitrary
 
 instance Arbitrary Types.ISpec where
   arbitrary = do
