1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
module Data.HashPSQ.Tests
( tests
) where
import Prelude hiding (lookup)
import Test.HUnit (Assertion, assert)
import Test.QuickCheck (Property, arbitrary, forAll)
import Test.Tasty (TestTree)
import Test.Tasty.HUnit (testCase)
import Test.Tasty.QuickCheck (testProperty)
import Data.HashPSQ.Internal
import qualified Data.OrdPSQ as OrdPSQ
import Data.PSQ.Class.Gen
import Data.PSQ.Class.Util
--------------------------------------------------------------------------------
-- Index of tests
--------------------------------------------------------------------------------
tests :: [TestTree]
tests =
[ testCase "showBucket" test_showBucket
, testCase "toBucket" test_toBucket
, testProperty "unsafeLookupIncreasePriority"
prop_unsafeLookupIncreasePriority
, testProperty "unsafeInsertIncreasePriority"
prop_unsafeInsertIncreasePriority
, testProperty "unsafeInsertIncreasePriorityView"
prop_unsafeInsertIncreasePriorityView
]
--------------------------------------------------------------------------------
-- Unit tests
--------------------------------------------------------------------------------
test_showBucket :: Assertion
test_showBucket =
assert $ length (coverShowInstance bucket) > 0
where
bucket :: Bucket Int Int Char
bucket = B 1 'a' OrdPSQ.empty
test_toBucket :: Assertion
test_toBucket =
assert True
-- TODO (jaspervdj)
-- assert $ mkBucket (OrdPSQ.empty :: OrdPSQ.OrdPSQ Int Int Char)
--------------------------------------------------------------------------------
-- Properties
--------------------------------------------------------------------------------
prop_unsafeLookupIncreasePriority :: Property
prop_unsafeLookupIncreasePriority =
forAll arbitraryPSQ $ \t ->
forAll arbitrary $ \k ->
let newP = maybe 0 ((+ 1) . fst) (lookup k t)
(mbPx, t') = unsafeLookupIncreasePriority k newP t
expect = case mbPx of
Nothing -> Nothing
Just (p, x) -> Just (p + 1, x)
in valid (t' :: HashPSQ LousyHashedInt Int Char) &&
lookup k t' == expect &&
lookup k t == mbPx
prop_unsafeInsertIncreasePriority :: Property
prop_unsafeInsertIncreasePriority =
forAll arbitraryPSQ $ \t ->
forAll arbitrary $ \k ->
forAll arbitrary $ \x ->
let prio = largerThanMaxPrio t
t' = unsafeInsertIncreasePriority k prio x t
in valid (t' :: HashPSQ LousyHashedInt Int Char) &&
lookup k t' == Just (prio, x)
prop_unsafeInsertIncreasePriorityView :: Property
prop_unsafeInsertIncreasePriorityView =
forAll arbitraryPSQ $ \t ->
forAll arbitrary $ \k ->
forAll arbitrary $ \x ->
let prio = largerThanMaxPrio t
(mbPx, t') = unsafeInsertIncreasePriorityView k prio x t
in valid (t' :: HashPSQ LousyHashedInt Int Char) &&
lookup k t' == Just (prio, x) &&
lookup k t == mbPx
|
