git.iko.soy/streamly
on 52ddfee help sign in
streamly/test/Streamly/Test/Data/Unbox.hs
310 lines 8.5 kB history raw
1{-# LANGUAGE StandaloneDeriving #-}
2{-# LANGUAGE DeriveAnyClass #-}
3{-# LANGUAGE TemplateHaskell #-}
5-- This module has a lot of orphan instances as we are deriving it here. We can
6-- ignore this warning.
7{-# OPTIONS_GHC -Wno-orphans #-}
9-- |
10-- Module : Streamly.Test.Data.Unbox
11-- Copyright : (c) 2022 Composewell technologies
12-- License : BSD-3-Clause
13-- Maintainer : streamly@composewell.com
14-- Stability : experimental
15-- Portability : GHC
17module Streamly.Test.Data.Unbox (main) where
19--------------------------------------------------------------------------------
20-- Imports
21--------------------------------------------------------------------------------
23#ifdef USE_SERIALIZE
24import Control.Monad (void)
25#endif
26import Data.Complex (Complex ((:+)))
27import Data.Functor.Const (Const (..))
28import Data.Functor.Identity (Identity (..))
29import Data.Proxy (Proxy(..))
30import GHC.Generics (Generic, Rep(..))
31import GHC.Real (Ratio(..))
33#ifdef USE_SERIALIZE
35import Streamly.Internal.Data.Serialize (Serialize(..), Size(..))
36import Streamly.Internal.Data.Serialize.TH
38#else
40#ifdef USE_TH
41import Streamly.Internal.Data.Unbox.TH
42#endif
44#endif
46import Streamly.Internal.Data.Unbox
47 ( PeekRep(..)
48 , PokeRep(..)
49 , SizeOfRep(..)
50 , Unbox(..)
51 , genericPeekByteIndex
52 , genericPokeByteIndex
53 , genericSizeOf
54 , newBytes
55 )
57import Test.Hspec as H
59--------------------------------------------------------------------------------
60-- Types
61--------------------------------------------------------------------------------
63#ifdef USE_SERIALIZE
65#define MODULE_NAME "Data.Serialize.Deriving.TH"
66#define DERIVE_UNBOX(typ) $(deriveSerialize ''typ)
67#define PEEK(i, arr) fmap snd (deserialize i arr)
68#define POKE(i, arr, val) void (serialize i arr val)
69#define TYPE_CLASS Serialize
71#else
73#define PEEK(i, arr) peekByteIndex i arr
74#define POKE(i, arr, val) pokeByteIndex i arr val
75#define TYPE_CLASS Unbox
77#ifdef USE_TH
79#define MODULE_NAME "Data.Unbox.Deriving.TH"
80#define DERIVE_UNBOX(typ) $(deriveUnbox ''typ)
82#else
84#define MODULE_NAME "Data.Unbox.Deriving.Generic"
85#define DERIVE_UNBOX(typ) deriving instance Unbox (typ)
87#endif
89#endif
91--------------------------------------------------------------------------------
92-- Types
93--------------------------------------------------------------------------------
95-- Unit instance uses a hack, so test all cases
96data Unit =
97 Unit
98 deriving (Show, Generic, Eq)
99DERIVE_UNBOX(Unit)
101data UnarySum
102 = Sum1
103 | Sum2
104 deriving (Show, Generic, Eq)
105DERIVE_UNBOX(UnarySum)
108data UnarySum2
109 = UnitSum1 Unit
110 | UnitSum2 Unit
111 deriving (Generic, Eq, Show)
112DERIVE_UNBOX(UnarySum2)
114data Unit1 =
115 Unit1 Unit
116 deriving (Generic, Eq, Show)
117DERIVE_UNBOX(Unit1)
119data Unit2 =
120 Unit2 Unit Unit
121 deriving (Generic, Eq, Show)
122DERIVE_UNBOX(Unit2)
124data Unit3 =
125 Unit3 Int Unit Int
126 deriving (Generic, Eq, Show)
127DERIVE_UNBOX(Unit3)
129data Unit4 =
130 Unit4 Int Unit1 Int
131 deriving (Generic, Eq, Show)
132DERIVE_UNBOX(Unit4)
134{-# ANN Single "HLint: ignore" #-}
135data Single =
136 Single Int
137 deriving (Show, Generic, Eq)
138DERIVE_UNBOX(Single)
140data Product2 =
141 Product2 Int Char
142 deriving (Show, Generic, Eq)
143DERIVE_UNBOX(Product2)
145data SumOfProducts
146 = SOP0
147 | SOP1 Int
148 | SOP2 Int Char
149 | SOP3 Int Int Int
150 deriving (Show, Generic, Eq)
151DERIVE_UNBOX(SumOfProducts)
153data NestedSOP
154 = NSOP0 SumOfProducts
155 | NSOP1 SumOfProducts
156 deriving (Show, Generic, Eq)
157DERIVE_UNBOX(NestedSOP)
159--------------------------------------------------------------------------------
160-- Standalone derivations
161--------------------------------------------------------------------------------
163-- Ratio does not have a Generic instance by default
164deriving instance Generic (Ratio Int)
166#if defined(USE_SERIALIZE)
167$(deriveSerialize ''Complex)
168$(deriveSerialize ''Ratio)
169$(deriveSerializeWith ["a"] ''Const)
170$(deriveSerialize ''Identity)
171#endif
173--------------------------------------------------------------------------------
174-- Test helpers
175--------------------------------------------------------------------------------
177testSerialization ::
178 forall a. (Eq a, Show a, TYPE_CLASS a)
179 => a
180 -> IO ()
181testSerialization val = do
182 arr <- newBytes
183#ifdef USE_SERIALIZE
184 (case size :: Size a of
185 ConstSize x -> x
186 VarSize f -> f val)
187#else
188 (sizeOf (Proxy :: Proxy a))
189#endif
190 POKE(0, arr, val)
191 PEEK(0, arr) `shouldReturn` val
193testGenericConsistency ::
194 forall a.
195 ( Eq a
196 , Show a
197#ifdef USE_SERIALIZE
198 , Serialize a, Unbox a
199#else
200 , Unbox a
201#endif
202 , Generic a
203 , SizeOfRep (Rep a)
204 , PeekRep (Rep a)
205 , PokeRep (Rep a)
206 )
207 => a
208 -> IO ()
209testGenericConsistency val = do
211 -- Test the generic sizeOf
212#ifdef USE_SERIALIZE
213 (case size :: Size a of
214 ConstSize x -> x
215 VarSize f -> f val)
216#else
217 sizeOf (Proxy :: Proxy a)
218#endif
219 `shouldBe` genericSizeOf (Proxy :: Proxy a)
221 -- Test the serialization and deserialization
222 arr <- newBytes (sizeOf (Proxy :: Proxy a))
224 POKE(0, arr, val)
225 genericPeekByteIndex arr 0 `shouldReturn` val
227 genericPokeByteIndex arr 0 val
228 PEEK(0, arr) `shouldReturn` val
231#ifndef USE_SERIALIZE
232-- Size is also implicitly tested while serializing and deserializing.
233checkSizeOf :: forall a. Unbox a => Proxy a -> Int -> IO ()
234checkSizeOf _ size = sizeOf (Proxy :: Proxy a) `shouldBe` size
236#endif
238--------------------------------------------------------------------------------
239-- CPP helpers
240--------------------------------------------------------------------------------
242#define CHECK_SIZE(type, expectation) \
243 it "checkSizeOf type" $ checkSizeOf (Proxy :: Proxy type) expectation
245--------------------------------------------------------------------------------
246-- Tests
247--------------------------------------------------------------------------------
249testCases :: Spec
250testCases = do
251 it "Unit" $ testSerialization Unit
252 it "Unit1" $ testSerialization (Unit1 Unit)
253 it "Unit2" $ testSerialization (Unit2 Unit Unit)
254 it "Unit3" $ testSerialization (Unit3 1234 Unit 4567)
255 it "Unit4" $ testSerialization (Unit4 1234 (Unit1 Unit) 4567)
256 it "UnarySum Sum1" $ testSerialization Sum1
257 it "UnarySum Sum2" $ testSerialization Sum2
258 it "UnarySum2 UnitSum1" $ testSerialization (UnitSum1 Unit)
259 it "UnarySum2 UnitSum2" $ testSerialization (UnitSum2 Unit)
260 it "Single" $ testSerialization (Single 2)
261 it "Product2" $ testSerialization (Product2 2 'b')
262 it "SumOfProducts SOP0" $ testSerialization SOP0
263 it "SumOfProducts SOP1" $ testSerialization (SOP1 1)
264 it "SumOfProducts SOP2" $ testSerialization (SOP2 1 'a')
265 it "SumOfProducts SOP3" $ testSerialization (SOP3 1 2 3)
267#ifndef USE_SERIALIZE
268 CHECK_SIZE(Unit, 1)
269 CHECK_SIZE(Unit1, 1)
270 CHECK_SIZE(Unit2, 2)
271 CHECK_SIZE(Unit3, 17)
272 CHECK_SIZE(Unit4, 17)
273 CHECK_SIZE(UnarySum, 1)
274 CHECK_SIZE(UnarySum2, 2)
275 CHECK_SIZE(Single, 8)
276 CHECK_SIZE(Product2, 12)
277 CHECK_SIZE(SumOfProducts, 25)
278 CHECK_SIZE(NestedSOP, 26)
279#endif
281 it "Bool" $ testSerialization True
282 it "Complex Int" $ testSerialization (5 :+ 3 :: Complex Int)
283 it "Ratio Int" $ testSerialization (5 :% 3 :: Ratio Int)
284 it "Const Float Int" $ testSerialization (Const 333.5678 :: Const Float Int)
285 it "Identity Int" $ testSerialization (Identity 56760 :: Identity Int)
287 it "GenericConsistency Bool" $ testGenericConsistency True
288 it "GenericConsistency (Complex Int)"
289 $ testGenericConsistency (5 :+ 3 :: Complex Int)
290 it "GenericConsistency (Ratio Int)"
291 $ testGenericConsistency (5 :% 3 :: Ratio Int)
292 it "GenericConsistency (Const Float Int)"
293 $ testGenericConsistency (Const 333.5678 :: Const Float Int)
294 it "GenericConsistency (Identity Int)"
295 $ testGenericConsistency (Identity 56760 :: Identity Int)
297 -- Fingerprint does not work for GHC 8.6.5
298 -- it "Fingerprint" $ testSerialization (Fingerprint 123456 876588)
299 -- it "GenericConsistency Fingerprint"
300 -- $ testGenericConsistency (Fingerprint 123456 876588)
302--------------------------------------------------------------------------------
303-- Main function
304--------------------------------------------------------------------------------
306moduleName :: String
307moduleName = MODULE_NAME
309main :: IO ()
310main = hspec $ H.parallel $ describe moduleName testCases