git.iko.soy/streamly
on eed4308 help sign in
streamly/test/Streamly/Test/Data/Unbox.hs
327 lines 9.2 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--------------------------------------------------------------------------------
23import Data.Complex (Complex ((:+)))
24import Data.Functor.Const (Const (..))
25import Data.Functor.Identity (Identity (..))
26import Data.Proxy (Proxy(..))
27import GHC.Generics (Generic, Rep(..))
28import GHC.Real (Ratio(..))
30import Streamly.Internal.Data.Serialize
32import Test.Hspec as H
34--------------------------------------------------------------------------------
35-- Types
36--------------------------------------------------------------------------------
38#ifdef USE_SERIALIZE
40#define MODULE_NAME "Data.Serialize.Deriving.TH"
41#define DERIVE_UNBOX(typ) $(deriveSerialize [d|instance Serialize typ|])
42#define PEEK(i, arr, sz) (deserialize i arr sz)
43#define POKE(i, arr, val) (serialize i arr val)
44#define TYPE_CLASS Serialize
46#else
48#define PEEK(i, arr, sz) peekByteIndexWithNextOff i arr
49#define POKE(i, arr, val) pokeByteIndexWithNextOff i arr val
50#define TYPE_CLASS Unbox
52#ifdef USE_TH
54#define MODULE_NAME "Data.Unbox.Deriving.TH"
55#define DERIVE_UNBOX(typ) $(deriveUnbox [d|instance Unbox typ|])
57#else
59#define MODULE_NAME "Data.Unbox.Deriving.Generic"
60#define DERIVE_UNBOX(typ) deriving instance Unbox (typ)
62#endif
64#endif
66--------------------------------------------------------------------------------
67-- Helpers
68--------------------------------------------------------------------------------
70#ifndef USE_SERIALIZE
72peekByteIndexWithNextOff ::
73 forall a. Unbox a
74 => Int
75 -> MutableByteArray
76 -> IO (Int, a)
77peekByteIndexWithNextOff i arr = do
78 val <- peekByteIndex i arr
79 pure (i + sizeOf (Proxy :: Proxy a), val)
81pokeByteIndexWithNextOff ::
82 forall a. Unbox a
83 => Int
84 -> MutableByteArray
85 -> a
86 -> IO Int
87pokeByteIndexWithNextOff i arr val = do
88 pokeByteIndex i arr val
89 pure $ i + sizeOf (Proxy :: Proxy a)
91#endif
93--------------------------------------------------------------------------------
94-- Types
95--------------------------------------------------------------------------------
97-- Unit instance uses a hack, so test all cases
98data Unit =
99 Unit
100 deriving (Show, Generic, Eq)
101DERIVE_UNBOX(Unit)
103data UnarySum
104 = Sum1
105 | Sum2
106 deriving (Show, Generic, Eq)
107DERIVE_UNBOX(UnarySum)
109data UnarySum2
110 = UnitSum1 Unit
111 | UnitSum2 Unit
112 deriving (Generic, Eq, Show)
113DERIVE_UNBOX(UnarySum2)
115data Unit1 =
116 Unit1 Unit
117 deriving (Generic, Eq, Show)
118DERIVE_UNBOX(Unit1)
120data Unit2 =
121 Unit2 Unit Unit
122 deriving (Generic, Eq, Show)
123DERIVE_UNBOX(Unit2)
125data Unit3 =
126 Unit3 Int Unit Int
127 deriving (Generic, Eq, Show)
128DERIVE_UNBOX(Unit3)
130data Unit4 =
131 Unit4 Int Unit1 Int
132 deriving (Generic, Eq, Show)
133DERIVE_UNBOX(Unit4)
135{-# ANN Single "HLint: ignore" #-}
136data Single =
137 Single Int
138 deriving (Show, Generic, Eq)
139DERIVE_UNBOX(Single)
141data Product2 =
142 Product2 Int Char
143 deriving (Show, Generic, Eq)
144DERIVE_UNBOX(Product2)
146data SumOfProducts
147 = SOP0
148 | SOP1 Int
149 | SOP2 Int Char
150 | SOP3 Int Int Int
151 deriving (Show, Generic, Eq)
152DERIVE_UNBOX(SumOfProducts)
154data NestedSOP
155 = NSOP0 SumOfProducts
156 | NSOP1 SumOfProducts
157 deriving (Show, Generic, Eq)
158DERIVE_UNBOX(NestedSOP)
160--------------------------------------------------------------------------------
161-- Standalone derivations
162--------------------------------------------------------------------------------
164-- Ratio does not have a Generic instance by default
165deriving instance Generic (Ratio Int)
167#if defined(USE_SERIALIZE)
168$(deriveSerialize
169 [d|instance Serialize a => Serialize (Complex a)|])
170$(deriveSerialize
171 [d|instance Serialize a => Serialize (Ratio a)|])
172$(deriveSerialize
173 [d|instance Serialize a => Serialize (Const a b)|])
174$(deriveSerialize
175 [d|instance Serialize a => Serialize (Identity a)|])
176#endif
178--------------------------------------------------------------------------------
179-- Test helpers
180--------------------------------------------------------------------------------
182#ifdef USE_SERIALIZE
183variableSizeOf ::
184 forall a. Serialize a
185 => a
186 -> Int
187variableSizeOf = size 0
188#endif
190testSerialization ::
191 forall a. (Eq a, Show a, TYPE_CLASS a)
192 => a
193 -> IO ()
194testSerialization val = do
195 let len =
196#ifdef USE_SERIALIZE
197 (variableSizeOf val)
198#else
199 (sizeOf (Proxy :: Proxy a))
200#endif
201 arr <- newBytes len
202 nextOff <- POKE(0, arr, val)
203 (nextOff1, val1) <- PEEK(0, arr, len)
204 val1 `shouldBe` val
205 nextOff1 `shouldBe` len
206 nextOff `shouldBe` len
208testGenericConsistency ::
209 forall a.
210 ( Eq a
211 , Show a
212#ifdef USE_SERIALIZE
213 , Serialize a
214#endif
215 , Unbox a
216 , Generic a
217 , SizeOfRep (Rep a)
218 , PeekRep (Rep a)
219 , PokeRep (Rep a)
220 )
221 => a
222 -> IO ()
223testGenericConsistency val = do
225 -- Test the generic sizeOf
226 let len =
227#ifdef USE_SERIALIZE
228 variableSizeOf val
229#else
230 sizeOf (Proxy :: Proxy a)
231#endif
232 len `shouldBe` genericSizeOf (Proxy :: Proxy a)
234 -- Test the serialization and deserialization
235 arr <- newBytes (sizeOf (Proxy :: Proxy a))
237 nextOff <- POKE(0, arr, val)
238 genericPeekByteIndex arr 0 `shouldReturn` val
240 genericPokeByteIndex arr 0 val
241 (nextOff1, val1) <- PEEK(0, arr, len)
242 val1 `shouldBe` val
244 nextOff1 `shouldBe` len
245 nextOff `shouldBe` len
248#ifndef USE_SERIALIZE
249-- Size is also implicitly tested while serializing and deserializing.
250checkSizeOf :: forall a. Unbox a => Proxy a -> Int -> IO ()
251checkSizeOf _ sz = sizeOf (Proxy :: Proxy a) `shouldBe` sz
253#endif
255--------------------------------------------------------------------------------
256-- CPP helpers
257--------------------------------------------------------------------------------
259#define CHECK_SIZE(type, expectation) \
260 it "checkSizeOf type" $ checkSizeOf (Proxy :: Proxy type) expectation
262--------------------------------------------------------------------------------
263-- Tests
264--------------------------------------------------------------------------------
266testCases :: Spec
267testCases = do
268 it "Unit" $ testSerialization Unit
269 it "Unit1" $ testSerialization (Unit1 Unit)
270 it "Unit2" $ testSerialization (Unit2 Unit Unit)
271 it "Unit3" $ testSerialization (Unit3 1234 Unit 4567)
272 it "Unit4" $ testSerialization (Unit4 1234 (Unit1 Unit) 4567)
273 it "UnarySum Sum1" $ testSerialization Sum1
274 it "UnarySum Sum2" $ testSerialization Sum2
275 it "UnarySum2 UnitSum1" $ testSerialization (UnitSum1 Unit)
276 it "UnarySum2 UnitSum2" $ testSerialization (UnitSum2 Unit)
277 it "Single" $ testSerialization (Single 2)
278 it "Product2" $ testSerialization (Product2 2 'b')
279 it "SumOfProducts SOP0" $ testSerialization SOP0
280 it "SumOfProducts SOP1" $ testSerialization (SOP1 1)
281 it "SumOfProducts SOP2" $ testSerialization (SOP2 1 'a')
282 it "SumOfProducts SOP3" $ testSerialization (SOP3 1 2 3)
284#ifndef USE_SERIALIZE
285 CHECK_SIZE(Unit, 1)
286 CHECK_SIZE(Unit1, 1)
287 CHECK_SIZE(Unit2, 2)
288 CHECK_SIZE(Unit3, 17)
289 CHECK_SIZE(Unit4, 17)
290 CHECK_SIZE(UnarySum, 1)
291 CHECK_SIZE(UnarySum2, 2)
292 CHECK_SIZE(Single, 8)
293 CHECK_SIZE(Product2, 12)
294 CHECK_SIZE(SumOfProducts, 25)
295 CHECK_SIZE(NestedSOP, 26)
296#endif
298 it "Bool" $ testSerialization True
299 it "Complex Int" $ testSerialization (5 :+ 3 :: Complex Int)
300 it "Ratio Int" $ testSerialization (5 :% 3 :: Ratio Int)
301 it "Const Float Int" $ testSerialization (Const 333.5678 :: Const Float Int)
302 it "Identity Int" $ testSerialization (Identity 56760 :: Identity Int)
304 it "GenericConsistency Bool" $ testGenericConsistency True
305 it "GenericConsistency (Complex Int)"
306 $ testGenericConsistency (5 :+ 3 :: Complex Int)
307 it "GenericConsistency (Ratio Int)"
308 $ testGenericConsistency (5 :% 3 :: Ratio Int)
309 it "GenericConsistency (Const Float Int)"
310 $ testGenericConsistency (Const 333.5678 :: Const Float Int)
311 it "GenericConsistency (Identity Int)"
312 $ testGenericConsistency (Identity 56760 :: Identity Int)
314 -- Fingerprint does not work for GHC 8.6.5
315 -- it "Fingerprint" $ testSerialization (Fingerprint 123456 876588)
316 -- it "GenericConsistency Fingerprint"
317 -- $ testGenericConsistency (Fingerprint 123456 876588)
319--------------------------------------------------------------------------------
320-- Main function
321--------------------------------------------------------------------------------
323moduleName :: String
324moduleName = MODULE_NAME
326main :: IO ()
327main = hspec $ H.parallel $ describe moduleName testCases