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