on master help sign in
added tests for random and V5 UUIDs
e219414Mark Lentczner
tests/TestUUID.hs+57−2
@@ -1,5 +1,8 @@
1+import Data.Bits
1import qualified Data.ByteString.Lazy as B
2import qualified Data.ByteString.Lazy as B
3+import Data.Char (ord)
2import Data.Maybe
4import Data.Maybe
5+import Data.Word
3import qualified Data.UUID as U
6import qualified Data.UUID as U
4import qualified Data.UUID.V5 as U
7import qualified Data.UUID.V5 as U
5import Test.HUnit
8import Test.HUnit
@@ -8,10 +11,23 @@ import System.IO
8import System.Random
11import System.Random
9
12
10
13
14+isValidVersion :: Int -> U.UUID -> Bool
15+isValidVersion v u = lenOK && variantOK && versionOK
16+ where bs = U.toByteString u
17+ lenOK = B.length bs == 16
18+ variantOK = (B.index bs 8) .&. 0xc0 == 0x80
19+ versionOK = (B.index bs 6) .&. 0xf0 == fromIntegral (v `shiftL` 4)
20+
21+
11instance Arbitrary U.UUID where
22instance Arbitrary U.UUID where
12 arbitrary = (fst . random) `fmap` rand
23 arbitrary = (fst . random) `fmap` rand
13 coarbitrary = undefined
24 coarbitrary = undefined
14
25
26+instance Arbitrary Word8 where
27+ arbitrary = (fromIntegral . fst . randomR (0,255::Int)) `fmap` rand
28+ coarbitrary = undefined
29+
30+
15test_null = TestList [
31test_null = TestList [
16 "nil is null" ~: assertBool "" (U.null U.nil),
32 "nil is null" ~: assertBool "" (U.null U.nil),
17 "namespaceDNS is not null" ~: assertBool "" (not $ U.null U.namespaceDNS)
33 "namespaceDNS is not null" ~: assertBool "" (not $ U.null U.namespaceDNS)
@@ -31,6 +47,14 @@ test_conv = TestList [
31 where b16 = B.pack [1..16]
47 where b16 = B.pack [1..16]
32 s16 = "01020304-0506-0708-090a-0b0c0d0e0f10"
48 s16 = "01020304-0506-0708-090a-0b0c0d0e0f10"
33
49
50+test_v5 = TestList [
51+ "V5 computation" ~:
52+ U.generateNamed U.namespaceDNS name @?= uV5
53+ ]
54+ where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8]
55+ -- uV3 = fromJust $ U.fromString "3d813cbb-47fb-32ba-91df-831e1593ac29"
56+ uV5 = fromJust $ U.fromString "21f7f8de-8051-5b89-8680-0195ef798b6a"
57+
34prop_stringRoundTrip = label "String round trip" stringRoundTrip
58prop_stringRoundTrip = label "String round trip" stringRoundTrip
35 where stringRoundTrip :: U.UUID -> Bool
59 where stringRoundTrip :: U.UUID -> Bool
36 stringRoundTrip u = maybe False (== u) $ U.fromString (U.toString u)
60 stringRoundTrip u = maybe False (== u) $ U.fromString (U.toString u)
@@ -48,17 +72,48 @@ prop_byteStringLength = label "ByteString length" byteStringLength
48 where byteStringLength :: U.UUID -> Bool
72 where byteStringLength :: U.UUID -> Bool
49 byteStringLength u = B.length (U.toByteString u) == 16
73 byteStringLength u = B.length (U.toByteString u) == 16
50
74
75+prop_randomsDiffer :: Property
76+prop_randomsDiffer = label "Randoms differ" randomsDiffer
77+ where randomsDiffer :: (U.UUID, U.UUID) -> Bool
78+ randomsDiffer (u1, u2) = u1 /= u2
79+
80+prop_randomNotNull :: Property
81+prop_randomNotNull = label "Random not null" randomNotNull
82+ where randomNotNull :: U.UUID -> Bool
83+ randomNotNull = not. U.null
84+
85+prop_randomsValid :: Property
86+prop_randomsValid = label "Random valid" randomsValid
87+ where randomsValid :: U.UUID -> Bool
88+ randomsValid = isValidVersion 4
89+
90+prop_v5NotNull :: Property
91+prop_v5NotNull = label "V5 not null" v5NotNull
92+ where v5NotNull :: [Word8] -> Bool
93+ v5NotNull = not . U.null . U.generateNamed U.namespaceDNS
94+
95+prop_v5Valid :: Property
96+prop_v5Valid = label "V5 valid" v5Valid
97+ where v5Valid :: [Word8] -> Bool
98+ v5Valid = isValidVersion 5 . U.generateNamed U.namespaceDNS
99+
51
100
52main :: IO ()
101main :: IO ()
53main = do
102main = do
54 runTestText (putTextToHandle stderr False) (TestList [
103 runTestText (putTextToHandle stderr False) (TestList [
55 test_null,
104 test_null,
56 test_nil,
105 test_nil,
57− test_conv
106+ test_conv,
107+ test_v5
58 ])
108 ])
59 mapM_ quickCheck $ [
109 mapM_ quickCheck $ [
60 prop_stringRoundTrip,
110 prop_stringRoundTrip,
61 prop_byteStringRoundTrip,
111 prop_byteStringRoundTrip,
62 prop_stringLength,
112 prop_stringLength,
63− prop_byteStringLength
113+ prop_byteStringLength,
114+ prop_randomsDiffer,
115+ prop_randomNotNull,
116+ prop_randomsValid,
117+ prop_v5NotNull,
118+ prop_v5Valid
64 ]
119 ]