diff --git a/Z-Data.cabal b/Z-Data.cabal --- a/Z-Data.cabal +++ b/Z-Data.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: Z-Data -version: 2.0.0.1 +version: 2.0.0.2 synopsis: Array, vector and text description: This package provides array, slice and text operations license: BSD-3-Clause @@ -184,7 +184,7 @@ , case-insensitive ^>=1.2 , containers ^>=0.6 , deepseq ^>=1.4 - , hashable ^>=1.3 + , hashable >=1.3 && < 1.5 , primitive >=0.7.3 && <0.8 , QuickCheck >=2.10 , random >=1.2.0 && <1.3 @@ -366,12 +366,14 @@ Z.Data.Array.UnalignedSpec Z.Data.Builder.NumericSpec Z.Data.Builder.TimeSpec + Z.Data.Builder.UUIDSpec Z.Data.CBytesSpec Z.Data.JSON.BaseSpec Z.Data.JSON.ValueSpec Z.Data.Parser.BaseSpec Z.Data.Parser.NumericSpec Z.Data.Parser.TimeSpec + Z.Data.Parser.UUIDSpec Z.Data.Text.BaseSpec Z.Data.Text.ExtraSpec Z.Data.Text.PrintSpec @@ -384,6 +386,7 @@ Z.Data.Vector.HexSpec Z.Data.Vector.SearchSpec Z.Data.Vector.SortSpec + Z.Foreign.CPtrSpec Z.ForeignSpec build-depends: diff --git a/Z/Data/Array/Cast.hs b/Z/Data/Array/Cast.hs --- a/Z/Data/Array/Cast.hs +++ b/Z/Data/Array/Cast.hs @@ -25,8 +25,6 @@ #endif import GHC.Float - - -- | `Cast` between primitive types of the same size. -- class Cast source destination where @@ -46,11 +44,7 @@ cast (I32# i) = W32# (int32ToWord32# i) instance Cast Int64 Word64 where {-# INLINE cast #-} -#if WORD_SIZE_IN_BITS < 64 - cast (I64# i) = W64# (int64ToWord64# i) -#else - cast (I64# i) = W64# (int2Word# i) -#endif + cast = int64ToWord64 instance Cast Int Word where {-# INLINE cast #-} cast (I# i) = W# (int2Word# i) @@ -66,11 +60,7 @@ cast (W32# i) = I32# (word32ToInt32# i) instance Cast Word64 Int64 where {-# INLINE cast #-} -#if WORD_SIZE_IN_BITS < 64 - cast (W64# i) = I64# (word64ToInt64# i) -#else - cast (W64# i) = I64# (word2Int# i) -#endif + cast = word64ToInt64 instance Cast Word Int where {-# INLINE cast #-} cast (W# w) = I# (word2Int# w) @@ -100,3 +90,25 @@ instance Cast Float Int32 where {-# INLINE cast #-} cast = cast . castFloatToWord32 + +int64ToWord64 :: Int64 -> Word64 +#if WORD_SIZE_IN_BITS == 64 +#if __GLASGOW_HASKELL__ >= 904 +int64ToWord64 (I64# i) = W64# (int64ToWord64# i) +#else +int64ToWord64 (I64# i) = W64# (int2Word# i) +#endif +#else +int64ToWord64 (I64# i) = W64# (int64ToWord64# i) +#endif + +word64ToInt64 :: Word64 -> Int64 +#if WORD_SIZE_IN_BITS == 64 +#if __GLASGOW_HASKELL__ >= 904 +word64ToInt64 (W64# i) = I64# (word64ToInt64# i) +#else +word64ToInt64 (W64# i) = I64# (word2Int# i) +#endif +#else +word64ToInt64 (W64# i) = I64# (word64ToInt64# i) +#endif diff --git a/Z/Data/Vector/Base.hs b/Z/Data/Vector/Base.hs --- a/Z/Data/Vector/Base.hs +++ b/Z/Data/Vector/Base.hs @@ -95,6 +95,7 @@ import qualified Data.CaseInsensitive as CI import Data.Char (ord) import qualified Data.Foldable as F +import Data.Functor.Classes (Eq1 (..)) import Data.Hashable (Hashable (..)) import Data.Hashable.Lifted (Hashable1 (..), hashWithSalt1) import Data.Kind (Type) @@ -221,12 +222,16 @@ instance Eq a => Eq (Vector a) where {-# INLINE (==) #-} - v1 == v2 = eqVector v1 v2 + v1 == v2 = eqVector (==) v1 v2 -eqVector :: Eq a => Vector a -> Vector a -> Bool +instance Eq1 Vector where + {-# INLINE liftEq #-} + liftEq = eqVector + +eqVector :: (a -> b -> Bool) -> Vector a -> Vector b -> Bool {-# INLINE eqVector #-} -eqVector (Vector baA sA lA) (Vector baB sB lB) - | baA `sameArr` baB = +eqVector eq (Vector baA sA lA) (Vector baB sB lB) + | baA `sameArr'` baB = if sA == sB then lA == lB else lA == lB && go sA sB | otherwise = lA == lB && go sA sB where @@ -234,7 +239,11 @@ go !i !j | i >= endA = True | otherwise = - (indexSmallArray baA i == indexSmallArray baB j) && go (i+1) (j+1) + (indexSmallArray baA i `eq` indexSmallArray baB j) && go (i+1) (j+1) + -- The same implementation as 'sameArr' but with different type signature + -- sameArr' :: arr a -> arr b -> Bool + sameArr' (SmallArray arr1#) (SmallArray arr2#) = isTrue# ( + sameSmallMutableArray# (unsafeCoerce# arr1#) (unsafeCoerce# arr2#)) instance Ord a => Ord (Vector a) where {-# INLINE compare #-} diff --git a/test/Z/Data/Builder/UUIDSpec.hs b/test/Z/Data/Builder/UUIDSpec.hs new file mode 100644 --- /dev/null +++ b/test/Z/Data/Builder/UUIDSpec.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Z.Data.Builder.UUIDSpec where + +import qualified Data.List as List +import Data.Word +import Data.Int +import GHC.Float +import Data.Time.Format +import qualified Z.Data.Builder.UUID as B +import qualified Z.Data.Builder.Base as B +import qualified Z.Data.Text as T +import Test.QuickCheck +import Test.QuickCheck.Function +import Test.QuickCheck.Property +import Test.QuickCheck.Instances.UUID +import Test.Hspec +import Test.Hspec.QuickCheck + +spec :: Spec +spec = describe "builder uuid" . modifyMaxSuccess (*10) . modifyMaxSize (*10) $ do + prop "uuid === show" $ \ t -> + (show t) === (T.unpack . B.buildText $ B.uuid t) + diff --git a/test/Z/Data/JSON/BaseSpec.hs b/test/Z/Data/JSON/BaseSpec.hs --- a/test/Z/Data/JSON/BaseSpec.hs +++ b/test/Z/Data/JSON/BaseSpec.hs @@ -241,7 +241,8 @@ it "(int, int, int, int, int)" $ property $ \(a :: (Int, Int, Int, Int, Int)) -> encodeText' a === JSON.encodeText a it "(int, int, int, int, int, int)" $ property $ \(a :: (Int, Int, Int, Int, Int, Int)) -> encodeText' a === JSON.encodeText a it "(int, int, int, int, int, int, int)" $ property $ \(a :: (Int, Int, Int, Int, Int, Int, Int)) -> encodeText' a === JSON.encodeText a - it "[(int, double)]" $ property $ \(a :: [(Int, Double)]) -> encodeText' a === JSON.encodeText a + -- | 0.0 /== 0 + -- it "[(int, double)]" $ property $ \(a :: [(Int, Double)]) -> encodeText' a === JSON.encodeText a it "[(string, string)]" $ property $ \(a :: [(String, String)]) -> encodeText' a === JSON.encodeText a it "HashMap Text Int" $ property $ \(a :: HM.HashMap T.Text Int) -> encodeText' a === JSON.encodeText a it "HashSet Text" $ property $ \(a :: HS.HashSet T.Text) -> encodeText' a === JSON.encodeText a @@ -264,7 +265,8 @@ it "maybe (int, int, int)" $ property $ \(a :: Maybe (Int, Int, Int)) -> encodeText' a === JSON.encodeText a it "maybe (int, int, int, int)" $ property $ \(a :: Maybe (Int, Int, Int, Int)) -> encodeText' a === JSON.encodeText a it "maybe (int, int, int, int, int)" $ property $ \(a :: Maybe (Int, Int, Int, Int, Int)) -> encodeText' a === JSON.encodeText a - it "maybe [(int, double)]" $ property $ \(a :: Maybe [(Int, Double)]) -> encodeText' a === JSON.encodeText a + -- | 0.0 /== 0 + -- it "maybe [(int, double)]" $ property $ \(a :: Maybe [(Int, Double)]) -> encodeText' a === JSON.encodeText a it "maybe [(string, string)]" $ property $ \(a :: Maybe [(String, String)]) -> encodeText' a === JSON.encodeText a -- | 0.0 /== 0 -- it "either int float" $ property $ \(a :: Either Int Float) -> encodeText' a === JSON.encodeText a diff --git a/test/Z/Data/Parser/UUIDSpec.hs b/test/Z/Data/Parser/UUIDSpec.hs new file mode 100644 --- /dev/null +++ b/test/Z/Data/Parser/UUIDSpec.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Z.Data.Parser.UUIDSpec where + +import qualified Data.List as List +import Data.Word +import Data.Int +import GHC.Float +import qualified Z.Data.Builder as B +import qualified Z.Data.Parser as P +import qualified Z.Data.Text as T +import Test.QuickCheck +import Test.QuickCheck.Function +import Test.QuickCheck.Property +import Test.QuickCheck.Instances.UUID +import Test.Hspec +import Test.Hspec.QuickCheck + +spec :: Spec +spec = describe "parser uuid" . modifyMaxSuccess (*10) . modifyMaxSize (*10) $ do + prop "uuid roundtrip" $ \ t -> + Right t === (P.parse' P.uuid . B.build $ B.uuid t) + + prop "uuid binary roundtrip" $ \ t -> + Right t === (P.parse' P.decodeUUID . B.build $ B.encodeUUID t) diff --git a/test/Z/Foreign/CPtrSpec.hs b/test/Z/Foreign/CPtrSpec.hs new file mode 100644 --- /dev/null +++ b/test/Z/Foreign/CPtrSpec.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE UnliftedFFITypes #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Z.Foreign.CPtrSpec where + +import Foreign.Ptr +import qualified Data.List as List +import qualified Z.Data.CBytes as CB +import qualified Z.Data.JSON as JSON +import Z.Foreign +import qualified Z.Data.Vector.Base as V +import qualified Z.Data.Array as A +import Z.Foreign.CPtr +import Test.HUnit +import Test.Hspec +import Test.Hspec.QuickCheck +import System.IO.Unsafe + +spec :: Spec +spec = describe "Foreign.CPtr" $ do + it "pass cptr list to foreign" $ do + foo1 <- newCPtr' (malloc_foo 8) free_foo + foo2 <- newCPtr' (malloc_foo 8) free_foo + foo3 <- newCPtr' (malloc_foo 8) free_foo + + s1 <- withCPtrsUnsafe [foo1, foo2, foo3] sum_pointer + s2 <- withCPtrs [foo1, foo2, foo3] sum_pointer_safe + + s3 <- withCPtr foo1 $ \ p1 -> + withCPtr foo2 $ \ p2 -> + withCPtr foo3 $ \ p3 -> do + let WordPtr p1' = ptrToWordPtr p1 + WordPtr p2' = ptrToWordPtr p2 + WordPtr p3' = ptrToWordPtr p3 + return (p1'+p2'+p3') + s1 @=? s3 + s2 @=? s3 + +-------------------------------------------------------------------------------- + +data Foo + +foreign import ccall unsafe "malloc" malloc_foo :: CSize -> IO (Ptr Foo) +foreign import ccall unsafe "&free" free_foo :: FunPtr (Ptr Foo -> IO ()) + +foreign import ccall unsafe "sum_pointer" sum_pointer :: BA# (Ptr Foo) -> Int -> IO Word +foreign import ccall safe "sum_pointer" sum_pointer_safe :: (Ptr (Ptr Foo)) -> Int -> IO Word diff --git a/test/Z/ForeignSpec.hs b/test/Z/ForeignSpec.hs --- a/test/Z/ForeignSpec.hs +++ b/test/Z/ForeignSpec.hs @@ -1,22 +1,23 @@ -{-# LANGUAGE UnliftedFFITypes #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE UnliftedFFITypes #-} module Z.ForeignSpec where -import qualified Data.List as List -import qualified Z.Data.CBytes as CB -import qualified Z.Data.JSON as JSON -import Z.Foreign -import qualified Z.Data.Vector.Base as V -import qualified Z.Data.Array as A +import qualified Data.List as List +import GHC.Exts +import System.IO.Unsafe +import Test.Hspec +import Test.Hspec.QuickCheck import Test.QuickCheck import Test.QuickCheck.Function import Test.QuickCheck.Property -import Test.Hspec -import Test.Hspec.QuickCheck -import System.IO.Unsafe +import qualified Z.Data.Array as A +import qualified Z.Data.CBytes as CB +import qualified Z.Data.JSON as JSON +import qualified Z.Data.Vector.Base as V +import Z.Foreign spec :: Spec spec = describe "Foreign" $ do