Revision f56013fd htest/Test/Ganeti/OpCodes.hs
b/htest/Test/Ganeti/OpCodes.hs | ||
---|---|---|
31 | 31 |
, OpCodes.OpCode(..) |
32 | 32 |
) where |
33 | 33 |
|
34 |
import qualified Test.HUnit as HUnit
|
|
35 |
import Test.QuickCheck |
|
34 |
import Test.HUnit as HUnit |
|
35 |
import Test.QuickCheck as QuickCheck
|
|
36 | 36 |
|
37 | 37 |
import Control.Applicative |
38 | 38 |
import Control.Monad |
... | ... | |
47 | 47 |
import Test.Ganeti.Types () |
48 | 48 |
import Test.Ganeti.Query.Language |
49 | 49 |
|
50 |
import Ganeti.BasicTypes |
|
50 | 51 |
import qualified Ganeti.Constants as C |
51 | 52 |
import qualified Ganeti.OpCodes as OpCodes |
52 | 53 |
import Ganeti.Types |
... | ... | |
395 | 396 |
-- | Arbitrary instance for MetaOpCode, defined here due to TH ordering. |
396 | 397 |
$(genArbitrary ''OpCodes.MetaOpCode) |
397 | 398 |
|
399 |
-- | Small helper to check for a failed JSON deserialisation |
|
400 |
isJsonError :: J.Result a -> Bool |
|
401 |
isJsonError (J.Error _) = True |
|
402 |
isJsonError _ = False |
|
403 |
|
|
398 | 404 |
-- * Test cases |
399 | 405 |
|
400 | 406 |
-- | Check that opcode serialization is idempotent. |
... | ... | |
508 | 514 |
let (OpCodes.MetaOpCode common _) = OpCodes.setOpComment comment op |
509 | 515 |
in OpCodes.opComment common ==? Just comment |
510 | 516 |
|
517 |
-- | Tests wrong tag object building (cluster takes only jsnull, the |
|
518 |
-- other take a string, so we test the opposites). |
|
519 |
case_TagObject_fail :: Assertion |
|
520 |
case_TagObject_fail = |
|
521 |
mapM_ (\(t, j) -> assertEqual (show t ++ "/" ++ J.encode j) Nothing $ |
|
522 |
tagObjectFrom t j) |
|
523 |
[ (TagTypeCluster, J.showJSON "abc") |
|
524 |
, (TagTypeInstance, J.JSNull) |
|
525 |
, (TagTypeNode, J.JSNull) |
|
526 |
, (TagTypeGroup, J.JSNull) |
|
527 |
] |
|
528 |
|
|
529 |
-- | Tests wrong (negative) disk index. |
|
530 |
prop_mkDiskIndex_fail :: QuickCheck.Positive Int -> Property |
|
531 |
prop_mkDiskIndex_fail (Positive i) = |
|
532 |
case mkDiskIndex (negate i) of |
|
533 |
Bad msg -> printTestCase "error message " $ |
|
534 |
"Invalid value" `isPrefixOf` msg |
|
535 |
Ok v -> failTest $ "Succeeded to build disk index '" ++ show v ++ |
|
536 |
"' from negative value " ++ show (negate i) |
|
537 |
|
|
538 |
-- | Tests a few invalid 'readRecreateDisks' cases. |
|
539 |
case_readRecreateDisks_fail :: Assertion |
|
540 |
case_readRecreateDisks_fail = do |
|
541 |
assertBool "null" $ |
|
542 |
isJsonError (J.readJSON J.JSNull::J.Result RecreateDisksInfo) |
|
543 |
assertBool "string" $ |
|
544 |
isJsonError (J.readJSON (J.showJSON "abc")::J.Result RecreateDisksInfo) |
|
545 |
|
|
546 |
-- | Tests a few invalid 'readDdmOldChanges' cases. |
|
547 |
case_readDdmOldChanges_fail :: Assertion |
|
548 |
case_readDdmOldChanges_fail = do |
|
549 |
assertBool "null" $ |
|
550 |
isJsonError (J.readJSON J.JSNull::J.Result DdmOldChanges) |
|
551 |
assertBool "string" $ |
|
552 |
isJsonError (J.readJSON (J.showJSON "abc")::J.Result DdmOldChanges) |
|
553 |
|
|
554 |
-- | Tests a few invalid 'readExportTarget' cases. |
|
555 |
case_readExportTarget_fail :: Assertion |
|
556 |
case_readExportTarget_fail = do |
|
557 |
assertBool "null" $ |
|
558 |
isJsonError (J.readJSON J.JSNull::J.Result ExportTarget) |
|
559 |
assertBool "int" $ |
|
560 |
isJsonError (J.readJSON (J.showJSON (5::Int))::J.Result ExportTarget) |
|
561 |
|
|
511 | 562 |
testSuite "OpCodes" |
512 | 563 |
[ 'prop_serialization |
513 | 564 |
, 'case_AllDefined |
514 | 565 |
, 'case_py_compat_types |
515 | 566 |
, 'case_py_compat_fields |
516 | 567 |
, 'prop_setOpComment |
568 |
, 'case_TagObject_fail |
|
569 |
, 'prop_mkDiskIndex_fail |
|
570 |
, 'case_readRecreateDisks_fail |
|
571 |
, 'case_readDdmOldChanges_fail |
|
572 |
, 'case_readExportTarget_fail |
|
517 | 573 |
] |
Also available in: Unified diff