@@ -1,4 +1,10 @@
1−{-# LANGUAGE DeriveAnyClass #-}
1+{-# LANGUAGE StandaloneDeriving, DeriveAnyClass #-}
2+{-# LANGUAGE DataKinds #-}
3+{-# LANGUAGE TypeApplications #-}
4+{-# HLINT ignore "Use newtype instead of data" #-}
5+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
6+{-# OPTIONS_GHC -Wno-orphans #-}
7+{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}
4-- Module : Streamly.Test.Data.Unbox
10-- Module : Streamly.Test.Data.Unbox
@@ -10,70 +16,204 @@
11module Streamly.Test.Data.Unbox (main) where
17module Streamly.Test.Data.Unbox (main) where
19+--------------------------------------------------------------------------------
21+--------------------------------------------------------------------------------
23+import Data.Complex (Complex ((:+)))
24+import Data.Functor.Const (Const (..))
25+import Data.Functor.Identity (Identity (..))
13import Data.Proxy (Proxy(..))
26import Data.Proxy (Proxy(..))
14−import GHC.Generics (Generic)
27+import GHC.Generics (Generic, Rep(..))
28+import GHC.Real (Ratio(..))
15−import Streamly.Internal.Data.Unboxed (Unbox(..))
29+import Streamly.Internal.Data.Unboxed
16−import qualified Streamly.Internal.Data.IORef.Unboxed as IORef
30+ ( PeekRep(..)
34+ , genericPeekByteIndex
35+ , genericPokeByteIndex
18import Test.Hspec as H
41import Test.Hspec as H
19−import Test.Hspec.QuickCheck
20−import Test.QuickCheck (Property)
21−import Test.QuickCheck.Monadic (monadicIO, assert, run)
43+--------------------------------------------------------------------------------
45+--------------------------------------------------------------------------------
47+-- Unit instance uses a hack, so test all cases
50+ deriving (Unbox, Show, Generic, Eq)
55+ deriving (Unbox, Show, Generic, Eq)
60+ deriving (Generic, Unbox, Eq, Show)
64+ deriving (Generic, Unbox, Eq, Show)
23−data Unit = Unit deriving (Unbox, Show, Generic, Eq)
68+ deriving (Generic, Unbox, Eq, Show)
72+ deriving (Generic, Unbox, Eq, Show)
76+ deriving (Generic, Unbox, Eq, Show)
25{-# ANN Single "HLint: ignore" #-}
78{-# ANN Single "HLint: ignore" #-}
26−data Single = Single Int deriving (Unbox, Show, Generic, Eq)
81+ deriving (Unbox, Show, Generic, Eq)
28−data Product2 = Product2 Int Char deriving (Unbox, Show, Generic, Eq)
85+ deriving (Unbox, Show, Generic, Eq)
30−data SumOfProducts =
87+data SumOfProducts
32 | SOP1 Int
89 | SOP1 Int
33 | SOP2 Int Char
90 | SOP2 Int Char
92+ deriving (Unbox, Show, Generic, Eq)
95+ = NSOP0 SumOfProducts
96+ | NSOP1 SumOfProducts
34− | SOP3 Int Int Int deriving (Unbox, Show, Generic, Eq)
97+ deriving (Unbox, Show, Generic, Eq)
99+--------------------------------------------------------------------------------
100+-- Standalone derivations
101+--------------------------------------------------------------------------------
103+-- Ratio does not have a Generic instance by default
104+deriving instance Generic (Ratio Int)
106+--------------------------------------------------------------------------------
108+--------------------------------------------------------------------------------
111+ forall a. (Eq a, Show a, Unbox a)
114+testSerialization val = do
115+ arr <- newUnpinnedBytes (sizeOf (Proxy :: Proxy a))
116+ pokeByteIndex 0 arr val
117+ peekByteIndex 0 arr `shouldReturn` val
119+testGenericConsistency ::
131+testGenericConsistency val = do
133+ -- Test the generic sizeOf
134+ sizeOf (Proxy :: Proxy a) `shouldBe` genericSizeOf (Proxy :: Proxy a)
136+ -- Test the serialization and deserialization
137+ arr <- newUnpinnedBytes (sizeOf (Proxy :: Proxy a))
139+ pokeByteIndex 0 arr val
140+ genericPeekByteIndex arr 0 `shouldReturn` val
142+ genericPokeByteIndex arr 0 val
143+ peekByteIndex 0 arr `shouldReturn` val
145+-- Size is also implicitly tested while serializing and deserializing.
146+checkSizeOf :: forall a. Unbox a => Proxy a -> Int -> IO ()
147+checkSizeOf _ size = sizeOf (Proxy :: Proxy a) `shouldBe` size
149+--------------------------------------------------------------------------------
151+--------------------------------------------------------------------------------
153+#define CHECK_SIZE(type, expectation) \
154+ it "checkSizeOf type" $ checkSizeOf (Proxy :: Proxy type) expectation
156+--------------------------------------------------------------------------------
158+--------------------------------------------------------------------------------
162+ it "Unit" $ testSerialization Unit
163+ it "Unit1" $ testSerialization (Unit1 Unit)
164+ it "Unit2" $ testSerialization (Unit2 Unit Unit)
165+ it "Unit3" $ testSerialization (Unit3 1234 Unit 4567)
166+ it "Unit4" $ testSerialization (Unit4 1234 (Unit1 Unit) 4567)
167+ it "UnarySum Sum1" $ testSerialization Sum1
168+ it "UnarySum Sum2" $ testSerialization Sum2
169+ it "UnarySum2 UnitSum1" $ testSerialization (UnitSum1 Unit)
170+ it "UnarySum2 UnitSum2" $ testSerialization (UnitSum2 Unit)
171+ it "Single" $ testSerialization (Single 2)
172+ it "Product2" $ testSerialization (Product2 2 'b')
173+ it "SumOfProducts SOP0" $ testSerialization SOP0
174+ it "SumOfProducts SOP1" $ testSerialization (SOP1 1)
175+ it "SumOfProducts SOP2" $ testSerialization (SOP2 1 'a')
176+ it "SumOfProducts SOP3" $ testSerialization (SOP3 1 2 3)
179+ CHECK_SIZE(Unit1, 1)
180+ CHECK_SIZE(Unit2, 2)
181+ CHECK_SIZE(Unit3, 17)
182+ CHECK_SIZE(Unit4, 17)
183+ CHECK_SIZE(UnarySum, 1)
184+ CHECK_SIZE(UnarySum2, 2)
185+ CHECK_SIZE(Single, 8)
186+ CHECK_SIZE(Product2, 12)
187+ CHECK_SIZE(SumOfProducts, 25)
188+ CHECK_SIZE(NestedSOP, 26)
190+ it "Bool" $ testSerialization True
191+ it "Complex Int" $ testSerialization (5 :+ 3 :: Complex Int)
192+ it "Ratio Int" $ testSerialization (5 :% 3 :: Ratio Int)
193+ it "Const Float Int" $ testSerialization (Const 333.5678 :: Const Float Int)
194+ it "Identity Int" $ testSerialization (Identity 56760 :: Identity Int)
36−data NestedSOP =
196+ it "GenericConsistency Bool" $ testGenericConsistency True
37− NSOP0 SumOfProducts
197+ it "GenericConsistency (Complex Int)"
38− | NSOP1 SumOfProducts deriving (Unbox, Show, Generic, Eq)
198+ $ testGenericConsistency (5 :+ 3 :: Complex Int)
199+ it "GenericConsistency (Ratio Int)"
200+ $ testGenericConsistency (5 :% 3 :: Ratio Int)
201+ it "GenericConsistency (Const Float Int)"
202+ $ testGenericConsistency (Const 333.5678 :: Const Float Int)
203+ it "GenericConsistency (Identity Int)"
204+ $ testGenericConsistency (Identity 56760 :: Identity Int)
40−test ::(Unbox a, Eq a) => a -> a -> Property
206+ -- Fingerprint does not work for GHC 8.6.5
41−test v1 v2 = monadicIO $ do
207+ -- it "Fingerprint" $ testSerialization (Fingerprint 123456 876588)
42− ref <- run $ IORef.newIORef v1
208+ -- it "GenericConsistency Fingerprint"
43− x1 <- run $ IORef.readIORef ref
209+ -- $ testGenericConsistency (Fingerprint 123456 876588)
44− run $ IORef.writeIORef ref v2
45− x2 <- run $ IORef.readIORef ref
49−checkSizeOf :: forall a. Unbox a => Proxy a -> Int -> Property
211+--------------------------------------------------------------------------------
50−checkSizeOf _ size = monadicIO $
212+-- Main function
51− assert (sizeOf (Proxy :: Proxy a) == size)
213+--------------------------------------------------------------------------------
53moduleName :: String
215moduleName :: String
54−moduleName = "Data.Unbox"
216+moduleName = "Data.Unboxed"
58− prop "test Unit Unit" $ test Unit Unit
59− prop "(Single 0) (Single 1)" $ test (Single 0) (Single 1)
60− prop "(Product2 0 'a') (Product2 1 'b')"
61− $ test (Product2 0 'a') (Product2 1 'b')
62− prop "(SOP0) (SOP1 1)" $ test SOP0 (SOP1 1)
63− prop "(SOP0) (SOP2 1 'a')" $ test SOP0 (SOP2 1 'a')
64− prop "(SOP0) (SOP3 1 2 3)" $ test SOP0 (SOP3 1 2 3)
66− prop "checkSizeOf Unit" $ checkSizeOf (Proxy :: Proxy Unit) 1
67− prop "checkSizeOf Single" $ checkSizeOf (Proxy :: Proxy Single) 8
68− prop "checkSizeOf Product2" $ checkSizeOf (Proxy :: Proxy Product2) 12
69− prop "checkSizeOf SumOfProducts"
70− $ checkSizeOf (Proxy :: Proxy SumOfProducts) 25
71− prop "checkSizeOf NestedSOP" $ checkSizeOf (Proxy :: Proxy NestedSOP) 26
73main :: IO ()
218main :: IO ()
77− modifyMaxSuccess (const 1) $ do
78− describe moduleName $ do
219+main = hspec $ H.parallel $ describe moduleName testCases
79− describe "Generic Unboxed Type" tests