@@ -2,6 +2,7 @@
22
33{-# OPTIONS_GHC -fno-warn-orphans #-}
44
5+import Data.Binary (encode)
56import qualified Data.ByteString.Char8 as BC8
67import qualified Data.ByteString.Lazy as BL
78import qualified Data.ByteString.Lazy.Char8 as BL8
@@ -9,7 +10,8 @@ import Data.Char (ord)
910import Data.Functor ((<$>))
1011import qualified Data.UUID.Types as U
1112import Data.Word
12−import Foreign (alloca, peek, poke)
13+import Foreign (alloca, castPtr, peek, poke,
14+ sizeOf)
1315import System.IO.Unsafe (unsafePerformIO)
1416
1517import Test.QuickCheck (Arbitrary (arbitrary), choose)
@@ -18,6 +20,8 @@ import Test.Tasty (TestTree, defaultMain, testGroup)
1820import Test.Tasty.HUnit (assertBool, testCase, (@=?), (@?=))
1921import Test.Tasty.QuickCheck (testProperty)
2022
23+import ByteOrder
24+
2125-- orphan
2226instance Arbitrary U.UUID where
2327 -- the UUID random instance ignores bounds
@@ -51,13 +55,32 @@ test_fromByteString :: Test
5155test_fromByteString =
5256 testCase "UUID fromByteString" $
5357 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")
5559
5660-- | Test fromWords with a fixed-input
5761test_fromWords :: Test
5862test_fromWords =
5963 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
6184
6285inputUUID :: U.UUID
6386inputUUID = read "a5ca8566-d9c5-4835-99c8-e1f13e73b5e2"
@@ -155,7 +178,9 @@ main = do
155178 test_nil,
156179 test_conv,
157180 test_fromByteString,
158− test_fromWords
181+ test_fromWords,
182+ test_Storeable,
183+ test_Binary
159184 ]
160185 , [ prop_stringRoundTrip,
161186 prop_readShowRoundTrip,