@@ -1,18 +1,11 @@
11{-# LANGUAGE ViewPatterns #-}
2−import Control.Monad (replicateM)
3−import Data.Bits
42import qualified Data.ByteString.Lazy as BL
53import qualified Data.ByteString.Lazy.Char8 as BL8
64import qualified Data.ByteString.Char8 as BC8
75import Data.Char (ord)
86import Data.Functor ((<$>))
9−import Data.List (nub, (\\))
10−import Data.Maybe
117import Data.Word
12−import qualified Data.UUID as U
13−import qualified Data.UUID.V1 as U
14−import qualified Data.UUID.V3 as U3
15−import qualified Data.UUID.V5 as U5
8+import qualified Data.UUID.Types as U
169import Foreign (alloca, peek, poke)
1710import System.IO.Unsafe (unsafePerformIO)
1811import qualified Test.HUnit as H
@@ -23,14 +16,6 @@ import Test.Framework.Providers.HUnit (hUnitTestToTests)
2316import Test.Framework.Providers.QuickCheck2 (testProperty)
2417
2518
26−isValidVersion :: Int -> U.UUID -> Bool
27−isValidVersion v u = lenOK && variantOK && versionOK
28− where bs = U.toByteString u
29− lenOK = BL.length bs == 16
30− variantOK = (BL.index bs 8) .&. 0xc0 == 0x80
31− versionOK = (BL.index bs 6) .&. 0xf0 == fromIntegral (v `shiftL` 4)
32−
33−
3419instance Arbitrary U.UUID where
3520 -- the UUID random instance ignores bounds
3621 arbitrary = choose (U.nil, U.nil)
@@ -38,8 +23,7 @@ instance Arbitrary U.UUID where
3823
3924test_null :: H.Test
4025test_null = H.TestList [
41− "nil is null" ~: assertBool "" (U.null U.nil),
42− "namespaceDNS is not null" ~: assertBool "" (not $ U.null U3.namespaceDNS)
26+ "nil is null" ~: assertBool "" (U.null U.nil)
4327 ]
4428
4529test_nil :: H.Test
@@ -58,32 +42,6 @@ test_conv = H.TestList [
5842 where b16 = BL.pack [1..16]
5943 s16 = "01020304-0506-0708-090a-0b0c0d0e0f10"
6044
61−test_v1 :: [Maybe U.UUID] -> H.Test
62−test_v1 v1s = H.TestList [
63− "V1 unique" ~: nub (v1s \\ nub v1s) @?= [],
64− "V1 not null" ~: H.TestList $ map (testUUID (not . U.null)) v1s,
65− "V1 valid" ~: H.TestList $ map (testUUID (isValidVersion 1)) v1s
66− ]
67− where testUUID :: (U.UUID -> Bool) -> Maybe U.UUID -> H.Test
68− testUUID p u = maybe False p u ~? show u
69−
70−test_v3 :: H.Test
71−test_v3 = H.TestList [
72− "V3 computation" ~:
73− U3.generateNamed U3.namespaceDNS name @?= uV3
74− ]
75− where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8]
76− uV3 = fromJust $ U.fromString "3d813cbb-47fb-32ba-91df-831e1593ac29"
77−
78−test_v5 :: H.Test
79−test_v5 = H.TestList [
80− "V5 computation" ~:
81− U5.generateNamed U5.namespaceDNS name @?= uV5
82− ]
83− where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8]
84− uV5 = fromJust $ U.fromString "21f7f8de-8051-5b89-8680-0195ef798b6a"
85−
86−
8745-- | Test fromByteString with a fixed-input.
8846test_fromByteString :: H.Test
8947test_fromByteString =
@@ -131,31 +89,6 @@ prop_randomNotNull = testProperty "Random not null" randomNotNull
13189 where randomNotNull :: U.UUID -> Bool
13290 randomNotNull = not. U.null
13391
134−prop_randomsValid :: Test
135−prop_randomsValid = testProperty "Random valid" randomsValid
136− where randomsValid :: U.UUID -> Bool
137− randomsValid = isValidVersion 4
138−
139−prop_v3NotNull :: Test
140−prop_v3NotNull = testProperty "V3 not null" v3NotNull
141− where v3NotNull :: [Word8] -> Bool
142− v3NotNull = not . U.null . U3.generateNamed U3.namespaceDNS
143−
144−prop_v3Valid :: Test
145−prop_v3Valid = testProperty "V3 valid" v3Valid
146− where v3Valid :: [Word8] -> Bool
147− v3Valid = isValidVersion 3 . U3.generateNamed U3.namespaceDNS
148−
149−prop_v5NotNull :: Test
150−prop_v5NotNull = testProperty "V5 not null" v5NotNull
151− where v5NotNull :: [Word8] -> Bool
152− v5NotNull = not . U.null . U5.generateNamed U5.namespaceDNS
153−
154−prop_v5Valid :: Test
155−prop_v5Valid = testProperty "V5 valid" v5Valid
156− where v5Valid :: [Word8] -> Bool
157− v5Valid = isValidVersion 5 . U5.generateNamed U5.namespaceDNS
158−
15992prop_readShowRoundTrip :: Test
16093prop_readShowRoundTrip = testProperty "Read/Show round-trip" prop
16194 where -- we're using 'Maybe UUID' to add a bit of
@@ -210,16 +143,12 @@ prop_storableRoundTrip =
210143
211144main :: IO ()
212145main = do
213− v1s <- replicateM 100 U.nextUUID
214146 defaultMain $
215147 concat $
216148 [ hUnitTestToTests $ H.TestList [
217149 test_null,
218150 test_nil,
219151 test_conv,
220− test_v1 v1s,
221− test_v3,
222− test_v5,
223152 test_fromByteString,
224153 test_fromWords
225154 ]
@@ -230,12 +159,7 @@ main = do
230159 prop_stringLength,
231160 prop_byteStringLength,
232161 prop_randomsDiffer,
233− prop_randomNotNull,
234− prop_randomsValid,
235− prop_v3NotNull,
236− prop_v3Valid,
237− prop_v5NotNull,
238− prop_v5Valid
162+ prop_randomNotNull
239163 ]
240164 , [ testProperty "fromASCIIBytes_fromString1" fromASCIIBytes_fromString1
241165 , testProperty "fromASCIIBytes_fromString2" fromASCIIBytes_fromString2