a897b62 · typeable/uuid

.travis.yml+1

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

11language: haskell

22ghc:

3+ - 7.10

34 - 7.8

45 - 7.6

56 - 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

5555

5656 bgroup "storable" [

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

58− bench "poke" $ poke uuidPtr u1

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

5959 ]

6060 ]

6161

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

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

11{-# LANGUAGE ViewPatterns #-}

2+

23import qualified Data.ByteString.Lazy as BL

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

45import qualified Data.ByteString.Char8 as BC8

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

89import qualified Data.UUID.Types as U

910import Foreign (alloca, peek, poke)

1011import System.IO.Unsafe (unsafePerformIO)

11−import qualified Test.HUnit as H

12−import Test.HUnit hiding (Test)

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

14−import Test.Framework (defaultMain, Test)

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

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

12+

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

14+

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

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

17+import Test.Tasty.QuickCheck ( testProperty )

1718

1819

1920instance Arbitrary U.UUID where

2021 -- the UUID random instance ignores bounds

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

2223

24+type Test = TestTree

2325

24−test_null :: H.Test

25−test_null = H.TestList [

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

27− ]

26+test_null :: Test

27+test_null =

28+ testCase "nil is null" $

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

2830

29−test_nil :: H.Test

30−test_nil = H.TestList [

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

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

31+test_nil :: Test

32+test_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)

3335 ]

3436

35−test_conv :: H.Test

36−test_conv = H.TestList [

37− "conv bytes to string" ~:

37+test_conv :: Test

38+test_conv = testGroup "conversions" [

39+ testCase "conv bytes to string" $

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

39− "conv string to bytes" ~:

41+ testCase "conv string to bytes" $

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

4143 ]

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

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

4446

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

46−test_fromByteString :: H.Test

48+test_fromByteString :: Test

4749test_fromByteString =

48− "UUID fromByteString" ~:

50+ testCase "UUID fromByteString" $

4951 Just inputUUID @=?

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

5153

5254-- | Test fromWords with a fixed-input

53−test_fromWords :: H.Test

55+test_fromWords :: Test

5456test_fromWords =

55− "UUID fromWords" ~:

57+ testCase "UUID fromWords" $

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

5759

5860inputUUID :: U.UUID

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

144146main :: IO ()

145147main = do

146148 defaultMain $

149+ testGroup "tests" $

147150 concat $

148− [ hUnitTestToTests $ H.TestList [

151+ [ [

149152 test_null,

150153 test_nil,

151154 test_conv,

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

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

5757 uuid-types,

5858 bytestring >= 0.9 && < 0.11,

5959 HUnit >=1.2 && < 1.3,

60− QuickCheck >=2.4 && < 2.8,

61− test-framework == 0.8.*,

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

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

60+ QuickCheck >=2.4 && < 2.9,

61+ tasty == 0.10.*,

62+ tasty-hunit == 0.9.*,

63+ tasty-quickcheck == 0.8.*

6464

6565benchmark benchmark

6666 Type: exitcode-stdio-1.0

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

7272 uuid-types,

7373 bytestring >= 0.9 && < 0.11,

7474 containers >= 0.4 && < 0.6,

75− criterion >= 0.4 && < 0.9,

76− deepseq >= 1.1 && < 1.4,

75+ criterion >= 0.4 && < 1.2,

76+ deepseq >= 1.1 && < 1.5,

7777 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 @@

11{-# LANGUAGE ViewPatterns #-}

2+

23import Control.Monad (replicateM)

34import Data.Bits

45import qualified Data.ByteString.Lazy as BL

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

1011import qualified Data.UUID.V1 as U

1112import qualified Data.UUID.V3 as U3

1213import 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)

1914

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

2022

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

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

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

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

3234

3335

34−test_null :: H.Test

35−test_null = H.TestList [

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

37− ]

36+test_null :: Test

37+test_null =

38+ testCase "namespaceDNS is not null" $

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

3840

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

40−test_v1 v1s = H.TestList [

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

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

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

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

42+test_v1 v1s = testGroup "version 1" [

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

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

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

4446 ]

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

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

47−

48−test_v3 :: H.Test

49−test_v3 = H.TestList [

50− "V3 computation" ~:

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

48+ testUUID p u =

49+ testCase (show u) $

50+ assert $ maybe False p u

51+

52+test_v3 :: Test

53+test_v3 =

54+ testCase "V3 computation" $

5155 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"

5556

56−test_v5 :: H.Test

57−test_v5 = H.TestList [

58− "V5 computation" ~:

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

61+test_v5 =

62+ testCase "V5 computation" $

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

60− ]

64+

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

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

6367

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

9195main = do

9296 v1s <- replicateM 100 U.nextUUID

9397 defaultMain $

98+ testGroup "tests" $

9499 concat $

95− [ hUnitTestToTests $ H.TestList [

100+ [ [

96101 test_null,

97102 test_v1 v1s,

98103 test_v3,

uuid/uuid.cabal+5−5

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

6464 uuid,

6565 bytestring >= 0.9 && < 0.11,

6666 HUnit >=1.2 && < 1.3,

67− QuickCheck >=2.4 && < 2.8,

67+ QuickCheck >=2.4 && < 2.9,

6868 random >= 1.0.1 && < 1.2,

69− test-framework == 0.8.*,

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

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

69+ tasty == 0.10.*,

70+ tasty-hunit == 0.9.*,

71+ tasty-quickcheck == 0.8.*

7272

7373benchmark benchmark

7474 Type: exitcode-stdio-1.0

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

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

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

8080 uuid,

81− criterion >= 0.4 && < 0.9,

81+ criterion >= 0.4 && < 1.2,

8282 mersenne-random-pure64,

8383 random >= 1.0.1 && < 1.2