Synnefo » snf-ganeti

isFailure (Types.OpFail _) = True

isFailure _ = False

-- | Update an instance to be smaller than a node.

setInstanceSmallerThanNode node inst =

    inst { Instance.mem = Node.availMem node `div` 2

prop_Utils_commaJoinSplit =

    forAll (arbitrary `suchThat`

            (\l -> l /= [""] && all (not . elem ',') l )) $ \lst ->

-- | Split and join should always be idempotent.

-- | fromObjWithDefault, we test using the Maybe monad and an integer

-- value.

        where _types = def_value :: Integer

-- | Test that functional if' behaves like the syntactic sugar if.

-- | Test basic select functionality

prop_Utils_select def lst1 lst2 =

  where expectedresult = Utils.if' (null lst2) def (head lst2)

        flist = map (\e -> (False, e)) lst1

        tlist = map (\e -> (True, e)) lst2

        cndlist = flist ++ tlist

-- | Test basic select functionality with undefined default

                         -> NonEmptyList Int -- ^ List of True values

prop_Utils_select_undefd lst1 (NonEmpty lst2) =

  where flist = map (\e -> (False, e)) lst1

        tlist = map (\e -> (True, e)) lst2

        cndlist = flist ++ tlist

-- | Test basic select functionality with undefined list values

                         -> NonEmptyList Int -- ^ List of True values

prop_Utils_select_undefv lst1 (NonEmpty lst2) =

  where flist = map (\e -> (False, e)) lst1

        tlist = map (\e -> (True, e)) lst2

        cndlist = flist ++ tlist ++ [undefined]

-- | Make sure add is idempotent.

prop_PeerMap_addIdempotent pmap key em =

    where _types = (pmap::PeerMap.PeerMap,

                    key::PeerMap.Key, em::PeerMap.Elem)

          fn = PeerMap.add key em

-- | Make sure remove is idempotent.

prop_PeerMap_removeIdempotent pmap key =

    where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key)

          fn = PeerMap.remove key

          puniq = PeerMap.accumArray const pmap

-- | Make sure a missing item returns 0.

prop_PeerMap_findMissing pmap key =

    where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key)

          puniq = PeerMap.accumArray const pmap

-- | Make sure an added item is found.

prop_PeerMap_addFind pmap key em =

    where _types = (pmap::PeerMap.PeerMap,

                    key::PeerMap.Key, em::PeerMap.Elem)

          puniq = PeerMap.accumArray const pmap

-- | Manual check that maxElem returns the maximum indeed, or 0 for null.

prop_PeerMap_maxElem pmap =

    where _types = pmap::PeerMap.PeerMap

          puniq = PeerMap.accumArray const pmap

prop_Container_nameOf node =

  let nl = makeSmallCluster node 1

      fnode = head (Container.elems nl)

-- | We test that in a cluster, given a random node, we can find it by

-- its name and alias, as long as all names and aliases are unique,

-- Simple instance tests, we only have setter/getters

prop_Instance_creat inst =

prop_Instance_setIdx inst idx =

    where _types = (inst::Instance.Instance, idx::Types.Idx)

prop_Instance_setName inst name =

          newinst = Instance.setAlias inst name

prop_Instance_setPri inst pdx =

    where _types = (inst::Instance.Instance, pdx::Types.Ndx)

prop_Instance_setSec inst sdx =

    where _types = (inst::Instance.Instance, sdx::Types.Ndx)

prop_Instance_setBoth inst pdx sdx =

    in Types.isBad $ Instance.shrinkByType inst' Types.FailDisk

prop_Instance_setMovable inst m =

    where inst' = Instance.setMovable inst m

testSuite "Instance"

          newnode = Node.setAlias node name

prop_Node_setOffline node status =

    where newnode = Node.setOffline node status

prop_Node_setXmem node xm =

    where newnode = Node.setXmem node xm

prop_Node_setMcpu node mc =

    where newnode = Node.setMcpu node mc

-- | Check that an instance add with too high memory or disk will be

-- Check tag maps

prop_Node_tagMaps_idempotent tags =

    where m = Data.Map.empty

prop_Node_tagMaps_reject tags =

    not (null tags) ==>

    where m = Node.addTags Data.Map.empty tags

prop_Node_showField node =

-- | Check that opcode serialization is idempotent.

prop_OpCodes_serialization op =

  case J.readJSON (J.showJSON op) of

  where _types = op::OpCodes.OpCode

testSuite "OpCodes"

-- | Check that (queued) job\/opcode status serialization is idempotent.

prop_OpStatus_serialization os =

  case J.readJSON (J.showJSON os) of

  where _types = os::Jobs.OpStatus

prop_JobStatus_serialization js =

  case J.readJSON (J.showJSON js) of

  where _types = js::Jobs.JobStatus

testSuite "Jobs"

-- ** Loader tests

prop_Loader_lookupNode ktn inst node =

  where nl = Data.Map.fromList ktn

prop_Loader_lookupInstance kti inst =

  where il = Data.Map.fromList kti

prop_Loader_assignIndices nodes =

module Main(main) where

import Data.IORef

import Test.QuickCheck

import System.Console.GetOpt ()

import System.IO

  , (slow, testCluster)

  ]

transformTestOpts :: Args -> Options -> IO Args

transformTestOpts args opts = do

  r <- case optReplay opts of

  let wrap = map (wrapTest errs)

  cmd_args <- System.getArgs

  (opts, args) <- parseOpts cmd_args "test" options

  mapM_ (\(targs, (name, tl)) ->

             transformTestOpts targs opts >>= \newargs ->

             runTests name newargs (wrap tl) max_count) tests