mirror of
https://github.com/composewell/streamly.git
synced 2024-09-11 19:47:10 +03:00
Add a template haskell test suite
This commit is contained in:
parent
1d6b85f542
commit
63407dc47d
@ -130,6 +130,7 @@ extra-source-files:
|
||||
test/Streamly/Test/Unicode/ucd/NormalizationTest.txt
|
||||
test/Streamly/Test/Unicode/extra/NormalizationTest.txt
|
||||
test/Streamly/Test/Data/Unbox.hs
|
||||
test/Streamly/Test/Data/Unbox/*.hs
|
||||
benchmark/Streamly/Benchmark/Unicode/data/AllChars.txt
|
||||
benchmark/Streamly/Benchmark/Unicode/data/Devanagari.txt
|
||||
benchmark/Streamly/Benchmark/Unicode/data/Japanese.txt
|
||||
|
145
test/Streamly/Test/Data/Unbox/TH.hs
Normal file
145
test/Streamly/Test/Data/Unbox/TH.hs
Normal file
@ -0,0 +1,145 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
-- |
|
||||
-- Module : Streamly.Test.Data.Unbox.TH
|
||||
-- Copyright : (c) 2022 Composewell technologies
|
||||
-- License : BSD-3-Clause
|
||||
-- Maintainer : streamly@composewell.com
|
||||
-- Stability : experimental
|
||||
-- Portability : GHC
|
||||
|
||||
module Streamly.Test.Data.Unbox.TH (main) where
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Imports
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Data.Proxy (Proxy(..))
|
||||
import Streamly.Internal.Data.Unbox.TH
|
||||
import Streamly.Internal.Data.Unbox (Unbox(..), newBytes, pokeByteIndex)
|
||||
|
||||
import Test.Hspec as H
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Test helpers
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
testSerialization ::
|
||||
forall a. (Eq a, Show a, Unbox a)
|
||||
=> a
|
||||
-> IO ()
|
||||
testSerialization val = do
|
||||
arr <- newBytes (sizeOf (Proxy :: Proxy a))
|
||||
pokeByteIndex 0 arr val
|
||||
peekByteIndex 0 arr `shouldReturn` val
|
||||
|
||||
-- Size is also implicitly tested while serializing and deserializing.
|
||||
checkSizeOf :: forall a. Unbox a => Proxy a -> Int -> IO ()
|
||||
checkSizeOf _ size = sizeOf (Proxy :: Proxy a) `shouldBe` size
|
||||
|
||||
checkSizeOfNew :: forall a. Unbox a => String -> Proxy a -> Int -> Spec
|
||||
checkSizeOfNew tag proxy expectation =
|
||||
it ("checkSizeOf " ++ tag) $ checkSizeOf proxy expectation
|
||||
|
||||
data CustomDataType1 =
|
||||
CustomDataType1
|
||||
deriving (Show, Eq)
|
||||
|
||||
data CustomDataType2
|
||||
= CDT2Constructor1
|
||||
| CDT2Constructor2
|
||||
| CDT2Constructor3
|
||||
deriving (Show, Eq)
|
||||
|
||||
data CustomDataType3 a b c
|
||||
= CDT3Constructor1 a
|
||||
| CDT3Constructor2 a b
|
||||
| CDT3Constructor3 a b c
|
||||
deriving (Show, Eq)
|
||||
|
||||
data CustomDataType4 a b
|
||||
= CDT4Constructor1
|
||||
| CDT4Constructor2 Bool
|
||||
| CDT4Constructor3 Bool b
|
||||
deriving (Show, Eq)
|
||||
|
||||
$(deriveUnbox ''CustomDataType1)
|
||||
$(deriveUnbox ''CustomDataType2)
|
||||
$(deriveUnbox ''CustomDataType3)
|
||||
$(deriveUnboxWith ["b"] ''CustomDataType4)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- CPP helpers
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
#define CHECK_SIZE(type, expectation) \
|
||||
it "checkSizeOf type" $ checkSizeOf (Proxy :: Proxy type) expectation
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Tests
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
testCustomDatatype1TH :: Spec
|
||||
testCustomDatatype1TH = do
|
||||
it "CustomDataType1" $ testSerialization CustomDataType1
|
||||
|
||||
CHECK_SIZE(CustomDataType1, 1)
|
||||
|
||||
testCustomDatatype2TH :: Spec
|
||||
testCustomDatatype2TH = do
|
||||
it "CustomDataType2 1" $ testSerialization CDT2Constructor1
|
||||
it "CustomDataType2 2" $ testSerialization CDT2Constructor2
|
||||
it "CustomDataType2 3" $ testSerialization CDT2Constructor3
|
||||
|
||||
CHECK_SIZE(CustomDataType2, 1)
|
||||
|
||||
testCustomDatatype3TH :: Spec
|
||||
testCustomDatatype3TH = do
|
||||
it "CustomDataType3 1"
|
||||
$ testSerialization
|
||||
(CDT3Constructor1 3 :: CustomDataType3 Int Bool Double)
|
||||
it "CustomDataType3 2"
|
||||
$ testSerialization
|
||||
(CDT3Constructor2 3 False :: CustomDataType3 Int Bool Double)
|
||||
it "CustomDataType3 3"
|
||||
$ testSerialization (CDT3Constructor3 (3 :: Int) False (5 :: Double))
|
||||
|
||||
checkSizeOfNew
|
||||
"CustomDataType3"
|
||||
(Proxy :: Proxy (CustomDataType3 Int Bool Double))
|
||||
(1 + sizeOf (Proxy :: Proxy Int)
|
||||
+ sizeOf (Proxy :: Proxy Bool)
|
||||
+ sizeOf (Proxy :: Proxy Double))
|
||||
|
||||
testCustomDatatype4TH :: Spec
|
||||
testCustomDatatype4TH = do
|
||||
it "CustomDataType4 1"
|
||||
$ testSerialization (CDT4Constructor1 :: CustomDataType4 a Int)
|
||||
it "CustomDataType4 2"
|
||||
$ testSerialization
|
||||
(CDT4Constructor2 True :: CustomDataType4 a Int)
|
||||
it "CustomDataType4 3"
|
||||
$ testSerialization (CDT4Constructor3 False (5 :: Int))
|
||||
|
||||
checkSizeOfNew
|
||||
"CustomDataType4"
|
||||
(Proxy :: Proxy (CustomDataType4 a Int))
|
||||
(1 + sizeOf (Proxy :: Proxy Bool) + sizeOf (Proxy :: Proxy Int))
|
||||
|
||||
testCases :: Spec
|
||||
testCases = do
|
||||
|
||||
testCustomDatatype1TH
|
||||
testCustomDatatype2TH
|
||||
testCustomDatatype3TH
|
||||
testCustomDatatype4TH
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Main function
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
moduleName :: String
|
||||
moduleName = "Data.Unboxed.TH"
|
||||
|
||||
main :: IO ()
|
||||
main = hspec $ H.parallel $ describe moduleName testCases
|
@ -159,6 +159,7 @@ common test-dependencies
|
||||
, temporary >= 1.3 && < 1.4
|
||||
, network >= 3.1 && < 3.2
|
||||
, scientific >= 0.0 && < 0.4
|
||||
, template-haskell >= 2.12 && < 2.21
|
||||
|
||||
if !flag(use-streamly-core)
|
||||
build-depends: streamly
|
||||
@ -268,6 +269,12 @@ test-suite Data.Unbox
|
||||
main-is: Streamly/Test/Data/Unbox.hs
|
||||
ghc-options: -main-is Streamly.Test.Data.Unbox.main
|
||||
|
||||
test-suite Data.Unbox.TH
|
||||
import: test-options
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Streamly/Test/Data/Unbox/TH.hs
|
||||
ghc-options: -main-is Streamly.Test.Data.Unbox.TH.main
|
||||
|
||||
test-suite Data.Serialize
|
||||
import: test-options
|
||||
type: exitcode-stdio-1.0
|
||||
|
Loading…
Reference in New Issue
Block a user