Commit f51eacf3 authored by Iustin Pop's avatar Iustin Pop
Browse files

Add a simple unittest for THH code

This is very THH specific, and applies to all serialisations generated
by THH, so I'm adding it in its own module.

Probably we should add some more generic tests, but in general THH
code is tested by the various definitions; this new field type however
is not (yet), so this is why I want this specific unittest.
Signed-off-by: default avatarIustin Pop <>
Reviewed-by: default avatarGuido Trotter <>
parent 9b156883
......@@ -496,6 +496,7 @@ HS_TEST_SRCS = \
htest/Test/Ganeti/Query/Query.hs \
htest/Test/Ganeti/Rpc.hs \
htest/Test/Ganeti/Ssconf.hs \
htest/Test/Ganeti/THH.hs \
htest/Test/Ganeti/TestCommon.hs \
htest/Test/Ganeti/TestHTools.hs \
htest/Test/Ganeti/TestHelper.hs \
{-# LANGUAGE TemplateHaskell #-}
{-| Unittests for our template-haskell generated code.
Copyright (C) 2012 Google Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA.
module Test.Ganeti.THH
( testTHH
) where
import Test.QuickCheck
import Text.JSON
import Ganeti.THH
import Ganeti.JSON
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
{-# ANN module "HLint: ignore Use camelCase" #-}
-- * Custom types
-- | Type used to test optional field implementation. Equivalent to
-- @data TestObj = TestObj { tobjA :: Maybe Int, tobjB :: Maybe Int
-- }@.
$(buildObject "TestObj" "tobj" $
[ optionalField $ simpleField "a" [t| Int |]
, optionalNullSerField $ simpleField "b" [t| Int |]
-- | Arbitrary instance for 'TestObj'.
$(genArbitrary ''TestObj)
-- | Tests that serialising an (arbitrary) 'TestObj' instance is
-- correct: fully optional fields are represented in the resulting
-- dictionary only when non-null, optional-but-required fields are
-- always represented (with either null or an actual value).
prop_OptFields :: TestObj -> Property
prop_OptFields to =
let a_member = case tobjA to of
Nothing -> []
Just x -> [("a", showJSON x)]
b_member = [("b", case tobjB to of
Nothing -> JSNull
Just x -> showJSON x)]
in showJSON to ==? makeObj (a_member ++ b_member)
testSuite "THH"
[ 'prop_OptFields
......@@ -31,22 +31,22 @@ import System.Environment (getArgs)
import Test.Ganeti.TestImports ()
import Test.Ganeti.BasicTypes
import Test.Ganeti.Confd.Utils
import Test.Ganeti.Common
import Test.Ganeti.Confd.Utils
import Test.Ganeti.Daemon
import Test.Ganeti.Errors
import Test.Ganeti.HTools.CLI
import Test.Ganeti.HTools.Cluster
import Test.Ganeti.HTools.Container
import Test.Ganeti.HTools.Loader
import Test.Ganeti.HTools.Instance
import Test.Ganeti.HTools.Loader
import Test.Ganeti.HTools.Node
import Test.Ganeti.HTools.PeerMap
import Test.Ganeti.HTools.Simu
import Test.Ganeti.HTools.Text
import Test.Ganeti.HTools.Types
import Test.Ganeti.Jobs
import Test.Ganeti.JSON
import Test.Ganeti.Jobs
import Test.Ganeti.Luxi
import Test.Ganeti.Objects
import Test.Ganeti.OpCodes
......@@ -55,6 +55,7 @@ import Test.Ganeti.Query.Language
import Test.Ganeti.Query.Query
import Test.Ganeti.Rpc
import Test.Ganeti.Ssconf
import Test.Ganeti.THH
import Test.Ganeti.Utils
-- | Our default test options, overring the built-in test-framework
......@@ -97,6 +98,7 @@ allTests =
, testQuery_Query
, testRpc
, testSsconf
, testTHH
, testUtils
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment