Revision 72bb6b4e htools/Ganeti/HTools/QC.hs

b/htools/Ganeti/HTools/QC.hs
107 107
isFailure (Types.OpFail _) = True
108 108
isFailure _ = False
109 109

  
110
-- | Checks for equality with proper annotation.
111
(==?) :: (Show a, Eq a) => a -> a -> Property
112
(==?) x y = printTestCase
113
            ("Expected equality, but '" ++
114
             show x ++ "' /= '" ++ show y ++ "'") (x == y)
115
infix 3 ==?
116

  
110 117
-- | Update an instance to be smaller than a node.
111 118
setInstanceSmallerThanNode node inst =
112 119
    inst { Instance.mem = Node.availMem node `div` 2
......
300 307
prop_Utils_commaJoinSplit =
301 308
    forAll (arbitrary `suchThat`
302 309
            (\l -> l /= [""] && all (not . elem ',') l )) $ \lst ->
303
    Utils.sepSplit ',' (Utils.commaJoin lst) == lst
310
    Utils.sepSplit ',' (Utils.commaJoin lst) ==? lst
304 311

  
305 312
-- | Split and join should always be idempotent.
306
prop_Utils_commaSplitJoin s = Utils.commaJoin (Utils.sepSplit ',' s) == s
313
prop_Utils_commaSplitJoin s =
314
    Utils.commaJoin (Utils.sepSplit ',' s) ==? s
307 315

  
308 316
-- | fromObjWithDefault, we test using the Maybe monad and an integer
309 317
-- value.
......
316 324
        where _types = def_value :: Integer
317 325

  
318 326
-- | Test that functional if' behaves like the syntactic sugar if.
319
prop_Utils_if'if :: Bool -> Int -> Int -> Bool
320
prop_Utils_if'if cnd a b = Utils.if' cnd a b == if cnd then a else b
327
prop_Utils_if'if :: Bool -> Int -> Int -> Gen Prop
328
prop_Utils_if'if cnd a b =
329
    Utils.if' cnd a b ==? if cnd then a else b
321 330

  
322 331
-- | Test basic select functionality
323
prop_Utils_select :: Int   -- ^ Default result
324
                  -> [Int] -- ^ List of False values
325
                  -> [Int] -- ^ List of True values
326
                  -> Bool  -- ^ Test result
332
prop_Utils_select :: Int      -- ^ Default result
333
                  -> [Int]    -- ^ List of False values
334
                  -> [Int]    -- ^ List of True values
335
                  -> Gen Prop -- ^ Test result
327 336
prop_Utils_select def lst1 lst2 =
328
  Utils.select def cndlist == expectedresult
337
  Utils.select def cndlist ==? expectedresult
329 338
  where expectedresult = Utils.if' (null lst2) def (head lst2)
330 339
        flist = map (\e -> (False, e)) lst1
331 340
        tlist = map (\e -> (True, e)) lst2
332 341
        cndlist = flist ++ tlist
333 342

  
334 343
-- | Test basic select functionality with undefined default
335
prop_Utils_select_undefd :: [Int] -- ^ List of False values
344
prop_Utils_select_undefd :: [Int]            -- ^ List of False values
336 345
                         -> NonEmptyList Int -- ^ List of True values
337
                         -> Bool  -- ^ Test result
346
                         -> Gen Prop         -- ^ Test result
338 347
prop_Utils_select_undefd lst1 (NonEmpty lst2) =
339
  Utils.select undefined cndlist == head lst2
348
  Utils.select undefined cndlist ==? head lst2
340 349
  where flist = map (\e -> (False, e)) lst1
341 350
        tlist = map (\e -> (True, e)) lst2
342 351
        cndlist = flist ++ tlist
343 352

  
344 353
-- | Test basic select functionality with undefined list values
345
prop_Utils_select_undefv :: [Int] -- ^ List of False values
354
prop_Utils_select_undefv :: [Int]            -- ^ List of False values
346 355
                         -> NonEmptyList Int -- ^ List of True values
347
                         -> Bool  -- ^ Test result
356
                         -> Gen Prop         -- ^ Test result
348 357
prop_Utils_select_undefv lst1 (NonEmpty lst2) =
349
  Utils.select undefined cndlist == head lst2
358
  Utils.select undefined cndlist ==? head lst2
350 359
  where flist = map (\e -> (False, e)) lst1
351 360
        tlist = map (\e -> (True, e)) lst2
352 361
        cndlist = flist ++ tlist ++ [undefined]
......
380 389

  
381 390
-- | Make sure add is idempotent.
382 391
prop_PeerMap_addIdempotent pmap key em =
383
    fn puniq == fn (fn puniq)
392
    fn puniq ==? fn (fn puniq)
384 393
    where _types = (pmap::PeerMap.PeerMap,
385 394
                    key::PeerMap.Key, em::PeerMap.Elem)
386 395
          fn = PeerMap.add key em
......
388 397

  
389 398
-- | Make sure remove is idempotent.
390 399
prop_PeerMap_removeIdempotent pmap key =
391
    fn puniq == fn (fn puniq)
400
    fn puniq ==? fn (fn puniq)
392 401
    where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key)
393 402
          fn = PeerMap.remove key
394 403
          puniq = PeerMap.accumArray const pmap
395 404

  
396 405
-- | Make sure a missing item returns 0.
397 406
prop_PeerMap_findMissing pmap key =
398
    PeerMap.find key (PeerMap.remove key puniq) == 0
407
    PeerMap.find key (PeerMap.remove key puniq) ==? 0
399 408
    where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key)
400 409
          puniq = PeerMap.accumArray const pmap
401 410

  
402 411
-- | Make sure an added item is found.
403 412
prop_PeerMap_addFind pmap key em =
404
    PeerMap.find key (PeerMap.add key em puniq) == em
413
    PeerMap.find key (PeerMap.add key em puniq) ==? em
405 414
    where _types = (pmap::PeerMap.PeerMap,
406 415
                    key::PeerMap.Key, em::PeerMap.Elem)
407 416
          puniq = PeerMap.accumArray const pmap
408 417

  
409 418
-- | Manual check that maxElem returns the maximum indeed, or 0 for null.
410 419
prop_PeerMap_maxElem pmap =
411
    PeerMap.maxElem puniq == if null puniq then 0
412
                             else (maximum . snd . unzip) puniq
420
    PeerMap.maxElem puniq ==? if null puniq then 0
421
                              else (maximum . snd . unzip) puniq
413 422
    where _types = pmap::PeerMap.PeerMap
414 423
          puniq = PeerMap.accumArray const pmap
415 424

  
......
435 444
prop_Container_nameOf node =
436 445
  let nl = makeSmallCluster node 1
437 446
      fnode = head (Container.elems nl)
438
  in Container.nameOf nl (Node.idx fnode) == Node.name fnode
447
  in Container.nameOf nl (Node.idx fnode) ==? Node.name fnode
439 448

  
440 449
-- | We test that in a cluster, given a random node, we can find it by
441 450
-- its name and alias, as long as all names and aliases are unique,
......
470 479
-- Simple instance tests, we only have setter/getters
471 480

  
472 481
prop_Instance_creat inst =
473
    Instance.name inst == Instance.alias inst
482
    Instance.name inst ==? Instance.alias inst
474 483

  
475 484
prop_Instance_setIdx inst idx =
476
    Instance.idx (Instance.setIdx inst idx) == idx
485
    Instance.idx (Instance.setIdx inst idx) ==? idx
477 486
    where _types = (inst::Instance.Instance, idx::Types.Idx)
478 487

  
479 488
prop_Instance_setName inst name =
......
489 498
          newinst = Instance.setAlias inst name
490 499

  
491 500
prop_Instance_setPri inst pdx =
492
    Instance.pNode (Instance.setPri inst pdx) == pdx
501
    Instance.pNode (Instance.setPri inst pdx) ==? pdx
493 502
    where _types = (inst::Instance.Instance, pdx::Types.Ndx)
494 503

  
495 504
prop_Instance_setSec inst sdx =
496
    Instance.sNode (Instance.setSec inst sdx) == sdx
505
    Instance.sNode (Instance.setSec inst sdx) ==? sdx
497 506
    where _types = (inst::Instance.Instance, sdx::Types.Ndx)
498 507

  
499 508
prop_Instance_setBoth inst pdx sdx =
......
549 558
    in Types.isBad $ Instance.shrinkByType inst' Types.FailDisk
550 559

  
551 560
prop_Instance_setMovable inst m =
552
    Instance.movable inst' == m
561
    Instance.movable inst' ==? m
553 562
    where inst' = Instance.setMovable inst m
554 563

  
555 564
testSuite "Instance"
......
681 690
          newnode = Node.setAlias node name
682 691

  
683 692
prop_Node_setOffline node status =
684
    Node.offline newnode == status
693
    Node.offline newnode ==? status
685 694
    where newnode = Node.setOffline node status
686 695

  
687 696
prop_Node_setXmem node xm =
688
    Node.xMem newnode == xm
697
    Node.xMem newnode ==? xm
689 698
    where newnode = Node.setXmem node xm
690 699

  
691 700
prop_Node_setMcpu node mc =
692
    Node.mCpu newnode == mc
701
    Node.mCpu newnode ==? mc
693 702
    where newnode = Node.setMcpu node mc
694 703

  
695 704
-- | Check that an instance add with too high memory or disk will be
......
778 787

  
779 788
-- Check tag maps
780 789
prop_Node_tagMaps_idempotent tags =
781
    Node.delTags (Node.addTags m tags) tags == m
790
    Node.delTags (Node.addTags m tags) tags ==? m
782 791
    where m = Data.Map.empty
783 792

  
784 793
prop_Node_tagMaps_reject tags =
785 794
    not (null tags) ==>
786
    any (\t -> Node.rejectAddTags m [t]) tags
795
    all (\t -> Node.rejectAddTags m [t]) tags
787 796
    where m = Node.addTags Data.Map.empty tags
788 797

  
789 798
prop_Node_showField node =
......
972 981
-- | Check that opcode serialization is idempotent.
973 982
prop_OpCodes_serialization op =
974 983
  case J.readJSON (J.showJSON op) of
975
    J.Error _ -> False
976
    J.Ok op' -> op == op'
984
    J.Error e -> printTestCase ("Cannot deserialise: " ++ e) False
985
    J.Ok op' -> op ==? op'
977 986
  where _types = op::OpCodes.OpCode
978 987

  
979 988
testSuite "OpCodes"
......
984 993
-- | Check that (queued) job\/opcode status serialization is idempotent.
985 994
prop_OpStatus_serialization os =
986 995
  case J.readJSON (J.showJSON os) of
987
    J.Error _ -> False
988
    J.Ok os' -> os == os'
996
    J.Error e -> printTestCase ("Cannot deserialise: " ++ e) False
997
    J.Ok os' -> os ==? os'
989 998
  where _types = os::Jobs.OpStatus
990 999

  
991 1000
prop_JobStatus_serialization js =
992 1001
  case J.readJSON (J.showJSON js) of
993
    J.Error _ -> False
994
    J.Ok js' -> js == js'
1002
    J.Error e -> printTestCase ("Cannot deserialise: " ++ e) False
1003
    J.Ok js' -> js ==? js'
995 1004
  where _types = js::Jobs.JobStatus
996 1005

  
997 1006
testSuite "Jobs"
......
1002 1011
-- ** Loader tests
1003 1012

  
1004 1013
prop_Loader_lookupNode ktn inst node =
1005
  Loader.lookupNode nl inst node == Data.Map.lookup node nl
1014
  Loader.lookupNode nl inst node ==? Data.Map.lookup node nl
1006 1015
  where nl = Data.Map.fromList ktn
1007 1016

  
1008 1017
prop_Loader_lookupInstance kti inst =
1009
  Loader.lookupInstance il inst == Data.Map.lookup inst il
1018
  Loader.lookupInstance il inst ==? Data.Map.lookup inst il
1010 1019
  where il = Data.Map.fromList kti
1011 1020

  
1012 1021
prop_Loader_assignIndices nodes =

Also available in: Unified diff