a897b62 · typeable/uuid

.travis.yml+1

compare with master

unifiedsplit

@@ -1,5 +1,6 @@

1language: haskell

2ghc:

3+ - 7.10

3 - 7.8

4 - 7.8

4 - 7.6

5 - 7.6

5 - 7.4

6 - 7.4

uuid-types/tests/BenchByteString.hsdeleted−82

@@ -1,82 +0,0 @@

1−import Control.Applicative ((<*>))

2−import Data.Functor ((<$>))

3−

4−import Data.ByteString (ByteString)

5−import qualified Data.ByteString.Char8 as BC8

6−import System.Random

7−import Test.QuickCheck

8−

9−import Criterion

10−import Criterion.Main

11−

12−import Data.UUID.Types

13−

14−instance Arbitrary UUID where

15− arbitrary =

16− fromWords <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary

17−

18−-- Testing what we do in the codebase

19−fromASCIIBytes_naive :: ByteString -> Maybe UUID

20−fromASCIIBytes_naive = fromString . BC8.unpack

21−

22−toASCIIBytes_naive :: UUID -> ByteString

23−toASCIIBytes_naive = BC8.pack . toString

24−

25−randomUUIDs :: IO [UUID]

26−randomUUIDs = sample' arbitrary

27−

28−randomCorrect :: IO [String]

29−randomCorrect = map toString <$> randomUUIDs

30−

31−randomSlightlyWrong :: IO [String]

32−randomSlightlyWrong = mapM screw =<< randomCorrect

33− where

34− screw s = do

35− ix <- randomRIO (0, length s - 1)

36− return (take ix s ++ "x" ++ drop (ix + 1) s)

37−

38−randomVeryWrong :: IO [String]

39−randomVeryWrong = sample' arbitrary

40−

41−main :: IO ()

42−main = do

43− uuids <- randomUUIDs

44− correct <- randomCorrect

45− let correctBytes = map BC8.pack correct

46− slightlyWrong <- randomSlightlyWrong

47− let slightlyWrongBytes = map BC8.pack slightlyWrong

48− veryWrong <- randomVeryWrong

49− let veryWrongBytes = map BC8.pack veryWrong

50−

51− defaultMain

52− [ bgroup "decoding"

53− [ bcompare

54− [ bgroup "correct"

55− [ bench "fromASCIIBytes" (nf (map fromASCIIBytes) correctBytes)

56− , bench "fromString" (nf (map fromString) correct)

57− , bench "fromASCIIBytes_naive" (nf (map fromASCIIBytes_naive) correctBytes)

58− ]

59− ]

60− , bcompare

61− [ bgroup "slightly wrong"

62− [ bench "fromASCIIBytes" (nf (map fromASCIIBytes) slightlyWrongBytes)

63− , bench "fromString" (nf (map fromString) slightlyWrong)

64− , bench "fromASCIIBytes_naive" (nf (map fromASCIIBytes_naive) slightlyWrongBytes)

65− ]

66− ]

67− , bcompare

68− [ bgroup "very wrong"

69− [ bench "fromASCIIBytes" (nf (map fromASCIIBytes) veryWrongBytes)

70− , bench "fromString" (nf (map fromString) veryWrong)

71− , bench "fromASCIIBytes_naive" (nf (map fromASCIIBytes_naive) veryWrongBytes)

72− ]

73− ]

74− ]

75− , bcompare

76− [ bgroup "encoding"

77− [ bench "toASCIIBytes" (nf (map toASCIIBytes) uuids)

78− , bench "toString" (nf (map toString) uuids)

79− , bench "toASCIIBytes_naive" (nf (map toASCIIBytes_naive) uuids)

80− ]

81− ]

82− ]

uuid-types/tests/BenchUUID.hs+1−1

@@ -55,7 +55,7 @@ main = do

55

56 bgroup "storable" [

57 bench "peek" $ nfIO (peek uuidPtr),

58− bench "poke" $ poke uuidPtr u1

58+ bench "poke" $ whnfIO $ poke uuidPtr u1

59 ]

60 ]

61

uuid-types/tests/TestUUID.hs+26−23

@@ -1,4 +1,5 @@

1{-# LANGUAGE ViewPatterns #-}

2+

2import qualified Data.ByteString.Lazy as BL

3import qualified Data.ByteString.Lazy as BL

3import qualified Data.ByteString.Lazy.Char8 as BL8

4import qualified Data.ByteString.Lazy.Char8 as BL8

4import qualified Data.ByteString.Char8 as BC8

5import qualified Data.ByteString.Char8 as BC8

@@ -8,51 +9,52 @@ import Data.Word

8import qualified Data.UUID.Types as U

9import qualified Data.UUID.Types as U

9import Foreign (alloca, peek, poke)

10import Foreign (alloca, peek, poke)

10import System.IO.Unsafe (unsafePerformIO)

11import System.IO.Unsafe (unsafePerformIO)

11−import qualified Test.HUnit as H

12+

12−import Test.HUnit hiding (Test)

13+import Test.QuickCheck ( Arbitrary(arbitrary), choose )

13−import Test.QuickCheck hiding ((.&.))

14+

14−import Test.Framework (defaultMain, Test)

15+import Test.Tasty ( defaultMain, TestTree, testGroup )

15−import Test.Framework.Providers.HUnit (hUnitTestToTests)

16+import Test.Tasty.HUnit ( assertBool, (@?=), (@=?), testCase )

16−import Test.Framework.Providers.QuickCheck2 (testProperty)

17+import Test.Tasty.QuickCheck ( testProperty )

17

18

19

19instance Arbitrary U.UUID where

20instance Arbitrary U.UUID where

20 -- the UUID random instance ignores bounds

21 -- the UUID random instance ignores bounds

21 arbitrary = choose (U.nil, U.nil)

22 arbitrary = choose (U.nil, U.nil)

22

23

24+type Test = TestTree

23

25

24−test_null :: H.Test

26+test_null :: Test

25−test_null = H.TestList [

27+test_null =

28+ testCase "nil is null" $

26− "nil is null" ~: assertBool "" (U.null U.nil)

29+ assertBool "" (U.null U.nil)

27− ]

28

30

29−test_nil :: H.Test

31+test_nil :: Test

30−test_nil = H.TestList [

32+test_nil = testGroup "nil" [

31− "nil string" ~: U.toString U.nil @?= "00000000-0000-0000-0000-000000000000",

33+ testCase "nil string" $ U.toString U.nil @?= "00000000-0000-0000-0000-000000000000",

32− "nil bytes" ~: U.toByteString U.nil @?= BL.pack (replicate 16 0)

34+ testCase "nil bytes" $ U.toByteString U.nil @?= BL.pack (replicate 16 0)

33 ]

35 ]

34

36

35−test_conv :: H.Test

37+test_conv :: Test

36−test_conv = H.TestList [

38+test_conv = testGroup "conversions" [

37− "conv bytes to string" ~:

39+ testCase "conv bytes to string" $

38 maybe "" (U.toString) (U.fromByteString b16) @?= s16,

40 maybe "" (U.toString) (U.fromByteString b16) @?= s16,

39− "conv string to bytes" ~:

41+ testCase "conv string to bytes" $

40 maybe BL.empty (U.toByteString) (U.fromString s16) @?= b16

42 maybe BL.empty (U.toByteString) (U.fromString s16) @?= b16

41 ]

43 ]

42 where b16 = BL.pack [1..16]

44 where b16 = BL.pack [1..16]

43 s16 = "01020304-0506-0708-090a-0b0c0d0e0f10"

45 s16 = "01020304-0506-0708-090a-0b0c0d0e0f10"

44

46

45-- | Test fromByteString with a fixed-input.

47-- | Test fromByteString with a fixed-input.

46−test_fromByteString :: H.Test

48+test_fromByteString :: Test

47test_fromByteString =

49test_fromByteString =

48− "UUID fromByteString" ~:

50+ testCase "UUID fromByteString" $

49 Just inputUUID @=?

51 Just inputUUID @=?

50 U.fromByteString (BL8.pack "\165\202\133f\217\197H5\153\200\225\241>s\181\226")

52 U.fromByteString (BL8.pack "\165\202\133f\217\197H5\153\200\225\241>s\181\226")

51

53

52-- | Test fromWords with a fixed-input

54-- | Test fromWords with a fixed-input

53−test_fromWords :: H.Test

55+test_fromWords :: Test

54test_fromWords =

56test_fromWords =

55− "UUID fromWords" ~:

57+ testCase "UUID fromWords" $

56 inputUUID @=? U.fromWords 2781513062 3653584949 2580079089 1047770594

58 inputUUID @=? U.fromWords 2781513062 3653584949 2580079089 1047770594

57

59

58inputUUID :: U.UUID

60inputUUID :: U.UUID

@@ -144,8 +146,9 @@ prop_storableRoundTrip =

144main :: IO ()

146main :: IO ()

145main = do

147main = do

146 defaultMain $

148 defaultMain $

149+ testGroup "tests" $

147 concat $

150 concat $

148− [ hUnitTestToTests $ H.TestList [

151+ [ [

149 test_null,

152 test_null,

150 test_nil,

153 test_nil,

151 test_conv,

154 test_conv,

uuid-types/uuid-types.cabal+6−18

@@ -57,10 +57,10 @@ Test-Suite testuuid

57 uuid-types,

58 bytestring >= 0.9 && < 0.11,

59 HUnit >=1.2 && < 1.3,

60− QuickCheck >=2.4 && < 2.8,

60+ QuickCheck >=2.4 && < 2.9,

61− test-framework == 0.8.*,

61+ tasty == 0.10.*,

62− test-framework-hunit == 0.3.*,

62+ tasty-hunit == 0.9.*,

63− test-framework-quickcheck2 == 0.3.*

63+ tasty-quickcheck == 0.8.*

64

65benchmark benchmark

66 Type: exitcode-stdio-1.0

@@ -72,18 +72,6 @@ benchmark benchmark

72 uuid-types,

73 bytestring >= 0.9 && < 0.11,

74 containers >= 0.4 && < 0.6,

75− criterion >= 0.4 && < 0.9,

75+ criterion >= 0.4 && < 1.2,

76− deepseq >= 1.1 && < 1.4,

76+ deepseq >= 1.1 && < 1.5,

77 random >= 1.0.1 && < 1.2

78−

79−benchmark benchbytestring

80− Type: exitcode-stdio-1.0

81− Hs-Source-Dirs: tests

82− Main-Is: BenchByteString.hs

83− Ghc-Options: -threaded -rtsopts -Wall -O2 -fno-warn-orphans

84− Build-Depends: base >= 4 && < 5

85− , uuid-types

86− , bytestring >= 0.10

87− , criterion >= 0.8

88− , random >= 1.0

89− , QuickCheck >= 2

uuid/tests/TestUUID.hs+34−29

@@ -1,4 +1,5 @@

1{-# LANGUAGE ViewPatterns #-}

2+

2import Control.Monad (replicateM)

3import Control.Monad (replicateM)

3import Data.Bits

4import Data.Bits

4import qualified Data.ByteString.Lazy as BL

5import qualified Data.ByteString.Lazy as BL

@@ -10,13 +11,14 @@ import qualified Data.UUID as U

10import qualified Data.UUID.V1 as U

11import qualified Data.UUID.V1 as U

11import qualified Data.UUID.V3 as U3

12import qualified Data.UUID.V3 as U3

12import qualified Data.UUID.V5 as U5

13import qualified Data.UUID.V5 as U5

13−import qualified Test.HUnit as H

14−import Test.HUnit hiding (Test)

15−import Test.QuickCheck hiding ((.&.))

16−import Test.Framework (defaultMain, Test)

17−import Test.Framework.Providers.HUnit (hUnitTestToTests)

18−import Test.Framework.Providers.QuickCheck2 (testProperty)

19

14

15+import Test.QuickCheck ( Arbitrary(arbitrary), choose )

16+import Test.Tasty ( TestTree, testGroup, defaultMain )

17+import Test.Tasty.HUnit

18+ ( Assertable(assert), assertBool, (@?=), testCase )

19+import Test.Tasty.QuickCheck ( testProperty )

20+

21+type Test = TestTree

20

22

21isValidVersion :: Int -> U.UUID -> Bool

23isValidVersion :: Int -> U.UUID -> Bool

22isValidVersion v u = lenOK && variantOK && versionOK

24isValidVersion v u = lenOK && variantOK && versionOK

@@ -31,33 +33,35 @@ instance Arbitrary U.UUID where

31 arbitrary = choose (U.nil, U.nil)

33 arbitrary = choose (U.nil, U.nil)

32

34

33

35

34−test_null :: H.Test

36+test_null :: Test

35−test_null = H.TestList [

37+test_null =

38+ testCase "namespaceDNS is not null" $

36− "namespaceDNS is not null" ~: assertBool "" (not $ U.null U3.namespaceDNS)

39+ assertBool "" (not $ U.null U3.namespaceDNS)

37− ]

38

40

39−test_v1 :: [Maybe U.UUID] -> H.Test

41+test_v1 :: [Maybe U.UUID] -> Test

40−test_v1 v1s = H.TestList [

42+test_v1 v1s = testGroup "version 1" [

41− "V1 unique" ~: nub (v1s \\ nub v1s) @?= [],

43+ testCase "V1 unique" $ nub (v1s \\ nub v1s) @?= [],

42− "V1 not null" ~: H.TestList $ map (testUUID (not . U.null)) v1s,

44+ testGroup "V1 not null" $ map (testUUID (not . U.null)) v1s,

43− "V1 valid" ~: H.TestList $ map (testUUID (isValidVersion 1)) v1s

45+ testGroup "V1 valid" $ map (testUUID (isValidVersion 1)) v1s

44 ]

46 ]

45− where testUUID :: (U.UUID -> Bool) -> Maybe U.UUID -> H.Test

47+ where testUUID :: (U.UUID -> Bool) -> Maybe U.UUID -> Test

46− testUUID p u = maybe False p u ~? show u

48+ testUUID p u =

47−

49+ testCase (show u) $

50+ assert $ maybe False p u

51+

48−test_v3 :: H.Test

52+test_v3 :: Test

49−test_v3 = H.TestList [

53+test_v3 =

50− "V3 computation" ~:

54+ testCase "V3 computation" $

51 U3.generateNamed U3.namespaceDNS name @?= uV3

55 U3.generateNamed U3.namespaceDNS name @?= uV3

52− ]

53− where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8]

54− uV3 = fromJust $ U.fromString "3d813cbb-47fb-32ba-91df-831e1593ac29"

55

56

56−test_v5 :: H.Test

57+ where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8]

58+ uV3 = fromJust $ U.fromString "3d813cbb-47fb-32ba-91df-831e1593ac29"

59+

60+test_v5 :: Test

57−test_v5 = H.TestList [

61+test_v5 =

58− "V5 computation" ~:

62+ testCase "V5 computation" $

59 U5.generateNamed U5.namespaceDNS name @?= uV5

63 U5.generateNamed U5.namespaceDNS name @?= uV5

60− ]

64+

61 where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8]

65 where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8]

62 uV5 = fromJust $ U.fromString "21f7f8de-8051-5b89-8680-0195ef798b6a"

66 uV5 = fromJust $ U.fromString "21f7f8de-8051-5b89-8680-0195ef798b6a"

63

67

@@ -91,8 +95,9 @@ main :: IO ()

91main = do

95main = do

92 v1s <- replicateM 100 U.nextUUID

96 v1s <- replicateM 100 U.nextUUID

93 defaultMain $

97 defaultMain $

98+ testGroup "tests" $

94 concat $

99 concat $

95− [ hUnitTestToTests $ H.TestList [

100+ [ [

96 test_null,

101 test_null,

97 test_v1 v1s,

102 test_v1 v1s,

98 test_v3,

103 test_v3,

uuid/uuid.cabal+5−5

@@ -64,11 +64,11 @@ Test-Suite testuuid

64 uuid,

65 bytestring >= 0.9 && < 0.11,

66 HUnit >=1.2 && < 1.3,

67− QuickCheck >=2.4 && < 2.8,

67+ QuickCheck >=2.4 && < 2.9,

68 random >= 1.0.1 && < 1.2,

69− test-framework == 0.8.*,

69+ tasty == 0.10.*,

70− test-framework-hunit == 0.3.*,

70+ tasty-hunit == 0.9.*,

71− test-framework-quickcheck2 == 0.3.*

71+ tasty-quickcheck == 0.8.*

72

73benchmark benchmark

74 Type: exitcode-stdio-1.0

@@ -78,6 +78,6 @@ benchmark benchmark

78 Ghc-Options: -Wall -fno-warn-orphans

79 Build-depends: base == 4.*,

80 uuid,

81− criterion >= 0.4 && < 0.9,

81+ criterion >= 0.4 && < 1.2,

82 mersenne-random-pure64,

83 random >= 1.0.1 && < 1.2