test/Streamly/Test/Data/Unbox.hs · streamly

git.iko.soy/streamly

on 668f2ef help sign in

streamly/test/Streamly/Test/Data/Unbox.hs

219 lines 6.9 kB history raw

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 #-}

9-- |

10-- Module : Streamly.Test.Data.Unbox

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(..))

29import Streamly.Internal.Data.Unboxed

30 ( PeekRep(..)

31 , PokeRep(..)

32 , SizeOfRep(..)

33 , Unbox(..)

34 , genericPeekByteIndex

35 , genericPokeByteIndex

36 , genericSizeOf

37 , newUnpinnedBytes

38 , pokeByteIndex

39 )

41import Test.Hspec as H

43--------------------------------------------------------------------------------

44-- Types

45--------------------------------------------------------------------------------

47-- Unit instance uses a hack, so test all cases

48data Unit =

49 Unit

50 deriving (Unbox, Show, Generic, Eq)

52data UnarySum

53 = Sum1

54 | Sum2

55 deriving (Unbox, Show, Generic, Eq)

57data UnarySum2

58 = UnitSum1 Unit

59 | UnitSum2 Unit

60 deriving (Generic, Unbox, Eq, Show)

62data Unit1 =

63 Unit1 Unit

64 deriving (Generic, Unbox, Eq, Show)

66data Unit2 =

67 Unit2 Unit Unit

68 deriving (Generic, Unbox, Eq, Show)

70data Unit3 =

71 Unit3 Int Unit Int

72 deriving (Generic, Unbox, Eq, Show)

74data Unit4 =

75 Unit4 Int Unit1 Int

76 deriving (Generic, Unbox, Eq, Show)

78{-# ANN Single "HLint: ignore" #-}

79data Single =

80 Single Int

81 deriving (Unbox, Show, Generic, Eq)

83data Product2 =

84 Product2 Int Char

85 deriving (Unbox, Show, Generic, Eq)

87data SumOfProducts

88 = SOP0

89 | SOP1 Int

90 | SOP2 Int Char

91 | SOP3 Int Int Int

92 deriving (Unbox, Show, Generic, Eq)

94data NestedSOP

95 = NSOP0 SumOfProducts

96 | NSOP1 SumOfProducts

97 deriving (Unbox, Show, Generic, Eq)

99--------------------------------------------------------------------------------

100-- Standalone derivations

101--------------------------------------------------------------------------------

102

103-- Ratio does not have a Generic instance by default

104deriving instance Generic (Ratio Int)

105

106--------------------------------------------------------------------------------

107-- Test helpers

108--------------------------------------------------------------------------------

109

110testSerialization ::

111 forall a. (Eq a, Show a, Unbox a)

112 => a

113 -> IO ()

114testSerialization val = do

115 arr <- newUnpinnedBytes (sizeOf (Proxy :: Proxy a))

116 pokeByteIndex 0 arr val

117 peekByteIndex 0 arr `shouldReturn` val

118

119testGenericConsistency ::

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 ()

131testGenericConsistency 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.

146checkSizeOf :: forall a. Unbox a => Proxy a -> Int -> IO ()

147checkSizeOf _ 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

160testCases :: Spec

161testCases = 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)

195

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)

205

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)

210

211--------------------------------------------------------------------------------

212-- Main function

213--------------------------------------------------------------------------------

214

215moduleName :: String

216moduleName = "Data.Unboxed"

217

218main :: IO ()

219main = hspec $ H.parallel $ describe moduleName testCases