@@ -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 #-}
28
39-- |
410-- Module : Streamly.Test.Data.Unbox
@@ -10,70 +16,204 @@
1016
1117module Streamly.Test.Data.Unbox (main) where
1218
19+--------------------------------------------------------------------------------
20+-- Imports
21+--------------------------------------------------------------------------------
22+
23+import Data.Complex (Complex ((:+)))
24+import Data.Functor.Const (Const (..))
25+import Data.Functor.Identity (Identity (..))
1326import Data.Proxy (Proxy(..))
14−import GHC.Generics (Generic)
15−import Streamly.Internal.Data.Unboxed (Unbox(..))
16−import qualified Streamly.Internal.Data.IORef.Unboxed as IORef
27+import GHC.Generics (Generic, Rep(..))
28+import GHC.Real (Ratio(..))
29+import Streamly.Internal.Data.Unboxed
30+ ( PeekRep(..)
31+ , PokeRep(..)
32+ , SizeOfRep(..)
33+ , Unbox(..)
34+ , genericPeekByteIndex
35+ , genericPokeByteIndex
36+ , genericSizeOf
37+ , newUnpinnedBytes
38+ , pokeByteIndex
39+ )
1740
1841import Test.Hspec as H
19−import Test.Hspec.QuickCheck
20−import Test.QuickCheck (Property)
21−import Test.QuickCheck.Monadic (monadicIO, assert, run)
2242
23−data Unit = Unit deriving (Unbox, Show, Generic, Eq)
43+--------------------------------------------------------------------------------
44+-- Types
45+--------------------------------------------------------------------------------
46+
47+-- Unit instance uses a hack, so test all cases
48+data Unit =
49+ Unit
50+ deriving (Unbox, Show, Generic, Eq)
51+
52+data UnarySum
53+ = Sum1
54+ | Sum2
55+ deriving (Unbox, Show, Generic, Eq)
56+
57+data UnarySum2
58+ = UnitSum1 Unit
59+ | UnitSum2 Unit
60+ deriving (Generic, Unbox, Eq, Show)
61+
62+data Unit1 =
63+ Unit1 Unit
64+ deriving (Generic, Unbox, Eq, Show)
65+
66+data Unit2 =
67+ Unit2 Unit Unit
68+ deriving (Generic, Unbox, Eq, Show)
69+
70+data Unit3 =
71+ Unit3 Int Unit Int
72+ deriving (Generic, Unbox, Eq, Show)
73+
74+data Unit4 =
75+ Unit4 Int Unit1 Int
76+ deriving (Generic, Unbox, Eq, Show)
2477
2578{-# ANN Single "HLint: ignore" #-}
26−data Single = Single Int deriving (Unbox, Show, Generic, Eq)
79+data Single =
80+ Single Int
81+ deriving (Unbox, Show, Generic, Eq)
2782
28−data Product2 = Product2 Int Char deriving (Unbox, Show, Generic, Eq)
83+data Product2 =
84+ Product2 Int Char
85+ deriving (Unbox, Show, Generic, Eq)
2986
30−data SumOfProducts =
31− SOP0
87+data SumOfProducts
88+ = SOP0
3289 | SOP1 Int
3390 | SOP2 Int Char
34− | SOP3 Int Int Int deriving (Unbox, Show, Generic, Eq)
91+ | SOP3 Int Int Int
92+ deriving (Unbox, Show, Generic, Eq)
93+
94+data NestedSOP
95+ = NSOP0 SumOfProducts
96+ | NSOP1 SumOfProducts
97+ deriving (Unbox, Show, Generic, Eq)
98+
99+--------------------------------------------------------------------------------
100+-- Standalone derivations
101+--------------------------------------------------------------------------------
102+
103+-- Ratio does not have a Generic instance by default
104+deriving instance Generic (Ratio Int)
105+
106+--------------------------------------------------------------------------------
107+-- Test helpers
108+--------------------------------------------------------------------------------
109+
110+testSerialization ::
111+ forall a. (Eq a, Show a, Unbox a)
112+ => a
113+ -> IO ()
114+testSerialization val = do
115+ arr <- newUnpinnedBytes (sizeOf (Proxy :: Proxy a))
116+ pokeByteIndex 0 arr val
117+ peekByteIndex 0 arr `shouldReturn` val
118+
119+testGenericConsistency ::
120+ forall a.
121+ ( Eq a
122+ , Show a
123+ , Unbox a
124+ , Generic a
125+ , SizeOfRep (Rep a)
126+ , PeekRep (Rep a)
127+ , PokeRep (Rep a)
128+ )
129+ => a
130+ -> IO ()
131+testGenericConsistency val = do
132+
133+ -- Test the generic sizeOf
134+ sizeOf (Proxy :: Proxy a) `shouldBe` genericSizeOf (Proxy :: Proxy a)
135+
136+ -- Test the serialization and deserialization
137+ arr <- newUnpinnedBytes (sizeOf (Proxy :: Proxy a))
138+
139+ pokeByteIndex 0 arr val
140+ genericPeekByteIndex arr 0 `shouldReturn` val
141+
142+ genericPokeByteIndex arr 0 val
143+ peekByteIndex 0 arr `shouldReturn` val
144+
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
148+
149+--------------------------------------------------------------------------------
150+-- CPP helpers
151+--------------------------------------------------------------------------------
152+
153+#define CHECK_SIZE(type, expectation) \
154+ it "checkSizeOf type" $ checkSizeOf (Proxy :: Proxy type) expectation
155+
156+--------------------------------------------------------------------------------
157+-- Tests
158+--------------------------------------------------------------------------------
159+
160+testCases :: Spec
161+testCases = do
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)
177+
178+ CHECK_SIZE(Unit, 1)
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)
189+
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)
35195
36−data NestedSOP =
37− NSOP0 SumOfProducts
38− | NSOP1 SumOfProducts deriving (Unbox, Show, Generic, Eq)
196+ it "GenericConsistency Bool" $ testGenericConsistency True
197+ it "GenericConsistency (Complex Int)"
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)
39205
40−test ::(Unbox a, Eq a) => a -> a -> Property
41−test v1 v2 = monadicIO $ do
42− ref <- run $ IORef.newIORef v1
43− x1 <- run $ IORef.readIORef ref
44− run $ IORef.writeIORef ref v2
45− x2 <- run $ IORef.readIORef ref
46− assert (x2 == v2)
47− assert (x1 == v1)
206+ -- Fingerprint does not work for GHC 8.6.5
207+ -- it "Fingerprint" $ testSerialization (Fingerprint 123456 876588)
208+ -- it "GenericConsistency Fingerprint"
209+ -- $ testGenericConsistency (Fingerprint 123456 876588)
48210
49−checkSizeOf :: forall a. Unbox a => Proxy a -> Int -> Property
50−checkSizeOf _ size = monadicIO $
51− assert (sizeOf (Proxy :: Proxy a) == size)
211+--------------------------------------------------------------------------------
212+-- Main function
213+--------------------------------------------------------------------------------
52214
53215moduleName :: String
54−moduleName = "Data.Unbox"
55−
56−tests :: Spec
57−tests = do
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)
65−
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
216+moduleName = "Data.Unboxed"
72217
73218main :: IO ()
74−main =
75− hspec $
76− H.parallel $
77− modifyMaxSuccess (const 1) $ do
78− describe moduleName $ do
79− describe "Generic Unboxed Type" tests
219+main = hspec $ H.parallel $ describe moduleName testCases