git.iko.soy/typeable/uuid
on 2330521 help sign in
typeable/uuid/uuid-types/tests/TestUUID.hs
175 lines 5.9 kB history raw
1{-# LANGUAGE ViewPatterns #-}
3import qualified Data.ByteString.Lazy as BL
4import qualified Data.ByteString.Lazy.Char8 as BL8
5import qualified Data.ByteString.Char8 as BC8
6import Data.Char (ord)
7import Data.Functor ((<$>))
8import Data.Word
9import qualified Data.UUID.Types as U
10import Foreign (alloca, peek, poke)
11import System.IO.Unsafe (unsafePerformIO)
13import Test.QuickCheck ( Arbitrary(arbitrary), choose )
15import Test.Tasty ( defaultMain, TestTree, testGroup )
16import Test.Tasty.HUnit ( assertBool, (@?=), (@=?), testCase )
17import Test.Tasty.QuickCheck ( testProperty )
20instance Arbitrary U.UUID where
21 -- the UUID random instance ignores bounds
22 arbitrary = choose (U.nil, U.nil)
24type Test = TestTree
26test_null :: Test
27test_null =
28 testCase "nil is null" $
29 assertBool "" (U.null U.nil)
31test_nil :: Test
32test_nil = testGroup "nil" [
33 testCase "nil string" $ U.toString U.nil @?= "00000000-0000-0000-0000-000000000000",
34 testCase "nil bytes" $ U.toByteString U.nil @?= BL.pack (replicate 16 0)
35 ]
37test_conv :: Test
38test_conv = testGroup "conversions" [
39 testCase "conv bytes to string" $
40 maybe "" (U.toString) (U.fromByteString b16) @?= s16,
41 testCase "conv string to bytes" $
42 maybe BL.empty (U.toByteString) (U.fromString s16) @?= b16
43 ]
44 where b16 = BL.pack [1..16]
45 s16 = "01020304-0506-0708-090a-0b0c0d0e0f10"
47-- | Test fromByteString with a fixed-input.
48test_fromByteString :: Test
49test_fromByteString =
50 testCase "UUID fromByteString" $
51 Just inputUUID @=?
52 U.fromByteString (BL8.pack "\165\202\133f\217\197H5\153\200\225\241>s\181\226")
54-- | Test fromWords with a fixed-input
55test_fromWords :: Test
56test_fromWords =
57 testCase "UUID fromWords" $
58 inputUUID @=? U.fromWords 2781513062 3653584949 2580079089 1047770594
60inputUUID :: U.UUID
61inputUUID = read "a5ca8566-d9c5-4835-99c8-e1f13e73b5e2"
63prop_stringRoundTrip :: Test
64prop_stringRoundTrip = testProperty "String round trip" stringRoundTrip
65 where stringRoundTrip :: U.UUID -> Bool
66 stringRoundTrip u = maybe False (== u) $ U.fromString (U.toString u)
68prop_byteStringRoundTrip :: Test
69prop_byteStringRoundTrip = testProperty "ByteString round trip" byteStringRoundTrip
70 where byteStringRoundTrip :: U.UUID -> Bool
71 byteStringRoundTrip u = maybe False (== u)
72 $ U.fromByteString (U.toByteString u)
74prop_stringLength :: Test
75prop_stringLength = testProperty "String length" stringLength
76 where stringLength :: U.UUID -> Bool
77 stringLength u = length (U.toString u) == 36
79prop_byteStringLength :: Test
80prop_byteStringLength = testProperty "ByteString length" byteStringLength
81 where byteStringLength :: U.UUID -> Bool
82 byteStringLength u = BL.length (U.toByteString u) == 16
84prop_randomsDiffer :: Test
85prop_randomsDiffer = testProperty "Randoms differ" randomsDiffer
86 where randomsDiffer :: (U.UUID, U.UUID) -> Bool
87 randomsDiffer (u1, u2) = u1 /= u2
89prop_randomNotNull :: Test
90prop_randomNotNull = testProperty "Random not null" randomNotNull
91 where randomNotNull :: U.UUID -> Bool
92 randomNotNull = not. U.null
94prop_readShowRoundTrip :: Test
95prop_readShowRoundTrip = testProperty "Read/Show round-trip" prop
96 where -- we're using 'Maybe UUID' to add a bit of
97 -- real-world complexity.
98 prop :: U.UUID -> Bool
99 prop uuid = read (show (Just uuid)) == Just uuid
101-- Mostly going to test for wrong UUIDs
102fromASCIIBytes_fromString1 :: String -> Bool
103fromASCIIBytes_fromString1 s =
104 if all (\c -> ord c < 256) s
105 then U.fromString s == U.fromASCIIBytes (BC8.pack s)
106 else True
108fromASCIIBytes_fromString2 :: U.UUID -> Bool
109fromASCIIBytes_fromString2 (U.toString -> s) =
110 U.fromString s == U.fromASCIIBytes (BC8.pack s)
112toASCIIBytes_toString :: U.UUID -> Bool
113toASCIIBytes_toString uuid =
114 U.toString uuid == BC8.unpack (U.toASCIIBytes uuid)
116fromASCIIBytes_toASCIIBytes :: U.UUID -> Bool
117fromASCIIBytes_toASCIIBytes (BC8.pack . U.toString -> bs) =
118 Just bs == (U.toASCIIBytes <$> U.fromASCIIBytes bs)
120toASCIIBytes_fromASCIIBytes :: U.UUID -> Bool
121toASCIIBytes_fromASCIIBytes uuid =
122 Just uuid == U.fromASCIIBytes (U.toASCIIBytes uuid)
124toWords_fromWords :: U.UUID -> Bool
125toWords_fromWords uuid =
126 uuid == myUncurry4 U.fromWords (U.toWords uuid)
128fromWords_toWords :: (Word32, Word32, Word32, Word32) -> Bool
129fromWords_toWords wds =
130 wds == U.toWords (myUncurry4 U.fromWords wds)
132myUncurry4 :: (x1 -> x2 -> x3 -> x4 -> y) -> (x1, x2, x3, x4) -> y
133myUncurry4 f (a,b,c,d) = f a b c d
135prop_storableRoundTrip :: Test
136prop_storableRoundTrip =
137 testProperty "Storeable round-trip" $ unsafePerformIO . prop
138 where
139 prop :: U.UUID -> IO Bool
140 prop uuid =
141 alloca $ \ptr -> do
142 poke ptr uuid
143 uuid2 <- peek ptr
144 return $ uuid == uuid2
146main :: IO ()
147main = do
148 defaultMain $
149 testGroup "tests" $
150 concat $
151 [ [
152 test_null,
153 test_nil,
154 test_conv,
155 test_fromByteString,
156 test_fromWords
157 ]
158 , [ prop_stringRoundTrip,
159 prop_readShowRoundTrip,
160 prop_byteStringRoundTrip,
161 prop_storableRoundTrip,
162 prop_stringLength,
163 prop_byteStringLength,
164 prop_randomsDiffer,
165 prop_randomNotNull
166 ]
167 , [ testProperty "fromASCIIBytes_fromString1" fromASCIIBytes_fromString1
168 , testProperty "fromASCIIBytes_fromString2" fromASCIIBytes_fromString2
169 , testProperty "fromASCIIBytes_toString" toASCIIBytes_toString
170 , testProperty "fromASCIIBytes_toASCIIBytes" fromASCIIBytes_toASCIIBytes
171 , testProperty "toASCIIBytes_fromASCIIBytes" toASCIIBytes_fromASCIIBytes
172 , testProperty "toWords_fromWords" toWords_fromWords
173 , testProperty "fromWords_toWords" fromWords_toWords
174 ]
175 ]