cabal-install/tests/UnitTests/Distribution/Solver/Modular/WeightedPSQ.hs

   1 {-# LANGUAGE ParallelListComp #-}
   2
   3 module UnitTests.Distribution.Solver.Modular.WeightedPSQ
   4   ( tests
   5   ) where
   6
   7 import qualified Distribution.Solver.Modular.WeightedPSQ as W
   8
   9 import Data.List (sort)
  10
  11 import Test.Tasty (TestTree)
  12 import Test.Tasty.HUnit (testCase, (@?=))
  13 import Test.Tasty.QuickCheck (Blind (..), testProperty)
  14
  15 tests :: [TestTree]
  16 tests =
  17   [ testProperty "'toList . fromList' preserves elements" $ \xs ->
  18       sort (xs :: [(Int, Char, Bool)]) == sort (W.toList (W.fromList xs))
  19   , testProperty "'toList . fromList' sorts stably" $ \xs ->
  20       let indexAsValue :: [(Int, (), Int)]
  21           indexAsValue = [(x, (), i) | x <- xs | i <- [0 ..]]
  22        in isSorted $ W.toList $ W.fromList indexAsValue
  23   , testProperty "'mapWeightsWithKey' sorts by weight" $ \xs (Blind f) ->
  24       isSorted $
  25         W.weights $
  26           W.mapWeightsWithKey (f :: Int -> Int -> Int) $
  27             W.fromList (xs :: [(Int, Int, Int)])
  28   , testCase "applying 'mapWeightsWithKey' twice sorts twice" $
  29       let indexAsKey :: [((), Int, ())]
  30           indexAsKey = [((), i, ()) | i <- [0 .. 10]]
  31           actual =
  32             W.toList $
  33               W.mapWeightsWithKey (\_ _ -> ()) $
  34                 W.mapWeightsWithKey (\i _ -> -i) $ -- should not be ignored
  35                   W.fromList indexAsKey
  36        in reverse indexAsKey @?= actual
  37   , testProperty "'union' sorts by weight" $ \xs ys ->
  38       isSorted $
  39         W.weights $
  40           W.union (W.fromList xs) (W.fromList (ys :: [(Int, Int, Int)]))
  41   , testProperty "'union' preserves elements" $ \xs ys ->
  42       let union =
  43             W.union
  44               (W.fromList xs)
  45               (W.fromList (ys :: [(Int, Int, Int)]))
  46        in sort (xs ++ ys) == sort (W.toList union)
  47   , testCase "'lookup' returns first occurrence" $
  48       let xs = W.fromList [((), False, 'A'), ((), True, 'C'), ((), True, 'B')]
  49        in Just 'C' @?= W.lookup True xs
  50   ]
  51
  52 isSorted :: Ord a => [a] -> Bool
  53 isSorted (x1 : xs@(x2 : _)) = x1 <= x2 && isSorted xs
  54 isSorted _ = True