git.iko.soy/typeable/uuid
on master help sign in
Add unit-test for Binary & Storable instance
4ff31f3Herbert Valerio Riedel
uuid-types/tests/ByteOrder.hsnew file+16
compare with master
unifiedsplit
@@ -0,0 +1,16 @@
1+{-# LANGUAGE CPP #-}
2+
3+-- stolen from GHC.ByteOrder
4+module ByteOrder where
5+
6+#include "MachDeps.h"
7+
8+-- | Byte ordering.
9+data ByteOrder = BigEndian | LittleEndian deriving (Eq, Ord, Bounded, Enum, Read, Show)
10+
11+targetByteOrder :: ByteOrder
12+#if defined(WORDS_BIGENDIAN)
13+targetByteOrder = BigEndian
14+#else
15+targetByteOrder = LittleEndian
16+#endif
uuid-types/tests/TestUUID.hs+29−4
@@ -2,6 +2,7 @@
2
2
3{-# OPTIONS_GHC -fno-warn-orphans #-}
3{-# OPTIONS_GHC -fno-warn-orphans #-}
4
4
5+import Data.Binary (encode)
5import qualified Data.ByteString.Char8 as BC8
6import qualified Data.ByteString.Char8 as BC8
6import qualified Data.ByteString.Lazy as BL
7import qualified Data.ByteString.Lazy as BL
7import qualified Data.ByteString.Lazy.Char8 as BL8
8import qualified Data.ByteString.Lazy.Char8 as BL8
@@ -9,7 +10,8 @@ import Data.Char (ord)
9import Data.Functor ((<$>))
10import Data.Functor ((<$>))
10import qualified Data.UUID.Types as U
11import qualified Data.UUID.Types as U
11import Data.Word
12import Data.Word
12−import Foreign (alloca, peek, poke)
13+import Foreign (alloca, castPtr, peek, poke,
14+ sizeOf)
13import System.IO.Unsafe (unsafePerformIO)
15import System.IO.Unsafe (unsafePerformIO)
14
16
15import Test.QuickCheck (Arbitrary (arbitrary), choose)
17import Test.QuickCheck (Arbitrary (arbitrary), choose)
@@ -18,6 +20,8 @@ import Test.Tasty (TestTree, defaultMain, testGroup)
18import Test.Tasty.HUnit (assertBool, testCase, (@=?), (@?=))
20import Test.Tasty.HUnit (assertBool, testCase, (@=?), (@?=))
19import Test.Tasty.QuickCheck (testProperty)
21import Test.Tasty.QuickCheck (testProperty)
20
22
23+import ByteOrder
24+
21-- orphan
25-- orphan
22instance Arbitrary U.UUID where
26instance Arbitrary U.UUID where
23 -- the UUID random instance ignores bounds
27 -- the UUID random instance ignores bounds
@@ -51,13 +55,32 @@ test_fromByteString :: Test
51test_fromByteString =
55test_fromByteString =
52 testCase "UUID fromByteString" $
56 testCase "UUID fromByteString" $
53 Just inputUUID @=?
57 Just inputUUID @=?
54− U.fromByteString (BL8.pack "\165\202\133f\217\197H5\153\200\225\241>s\181\226")
58+ U.fromByteString (BL8.pack "\xa5\xca\x85\x66\xd9\xc5\x48\x35\x99\xc8\xe1\xf1\x3e\x73\xb5\xe2")
55
59
56-- | Test fromWords with a fixed-input
60-- | Test fromWords with a fixed-input
57test_fromWords :: Test
61test_fromWords :: Test
58test_fromWords =
62test_fromWords =
59 testCase "UUID fromWords" $
63 testCase "UUID fromWords" $
60− inputUUID @=? U.fromWords 2781513062 3653584949 2580079089 1047770594
64+ inputUUID @=? U.fromWords 0xa5ca8566 0xd9c54835 0x99c8e1f1 0x3e73b5e2
65+
66+
67+test_Storeable :: Test
68+test_Storeable =
69+ testCase "UUID Storeable(poke)" $
70+ case targetByteOrder of
71+ LittleEndian -> BC8.pack "\x66\x85\xca\xa5\xc5\xd9\x35\x48\x99\xc8\xe1\xf1\x3e\x73\xb5\xe2" @=? pokeAsBS inputUUID
72+ BigEndian -> BC8.pack "\xa5\xca\x85\x66\xd9\xc5\x48\x35\x99\xc8\xe1\xf1\x3e\x73\xb5\xe2" @=? pokeAsBS inputUUID
73+ where
74+ pokeAsBS :: U.UUID -> BC8.ByteString
75+ pokeAsBS uuid = unsafePerformIO $ do
76+ alloca $ \ptr -> do
77+ poke ptr uuid
78+ BC8.packCStringLen (castPtr ptr, sizeOf uuid)
79+
80+test_Binary :: Test
81+test_Binary =
82+ testCase "UUID Binary(encode)" $
83+ (BL8.pack "\xa5\xca\x85\x66\xd9\xc5\x48\x35\x99\xc8\xe1\xf1\x3e\x73\xb5\xe2") @=? encode inputUUID
61
84
62inputUUID :: U.UUID
85inputUUID :: U.UUID
63inputUUID = read "a5ca8566-d9c5-4835-99c8-e1f13e73b5e2"
86inputUUID = read "a5ca8566-d9c5-4835-99c8-e1f13e73b5e2"
@@ -155,7 +178,9 @@ main = do
155 test_nil,
178 test_nil,
156 test_conv,
179 test_conv,
157 test_fromByteString,
180 test_fromByteString,
158− test_fromWords
181+ test_fromWords,
182+ test_Storeable,
183+ test_Binary
159 ]
184 ]
160 , [ prop_stringRoundTrip,
185 , [ prop_stringRoundTrip,
161 prop_readShowRoundTrip,
186 prop_readShowRoundTrip,
uuid-types/uuid-types.cabal+2
@@ -58,6 +58,7 @@ Library
58test-suite testuuid
58test-suite testuuid
59 type: exitcode-stdio-1.0
59 type: exitcode-stdio-1.0
60 main-is: TestUUID.hs
60 main-is: TestUUID.hs
61+ other-modules: ByteOrder
61 hs-source-dirs: tests
62 hs-source-dirs: tests
62 default-language: Haskell2010
63 default-language: Haskell2010
63 other-extensions: ViewPatterns
64 other-extensions: ViewPatterns
@@ -66,6 +67,7 @@ test-suite testuuid
66 build-depends: uuid-types
67 build-depends: uuid-types
67 -- inherited constraints
68 -- inherited constraints
68 , base
69 , base
70+ , binary
69 , bytestring
71 , bytestring
70 -- deps w/o inherited constraints
72 -- deps w/o inherited constraints
71 , HUnit >= 1.2 && < 1.4
73 , HUnit >= 1.2 && < 1.4