{- |
Properties for testing that instances of the 'Ord' class perform
correctly.
'p_symmetric' and 'p_transitive' check the basic properties of the
ordering. In other words, they test the 'compare' method. 'p_equal'
checks that 'Ord' agrees with 'Eq' (that is, 'compare' returns 'EQ'
when '==' returns 'True'). The "Test.AC.Class.Eq" module already
checks that 'Eq' is reflexive, so if 'Ord' agrees with 'Eq' then
'Ord' too is reflexive, and we don't need a seperate test for that.
The remaining tests (i.e., 'p_compare', 'p_min' and 'p_max') check
for the extraordinarily unlikely case that the various 'Ord'
methods do not agree with each other. (Usually they are implemented
in terms of each other.)
-}
module Test.AC.Class.Ord where
import Test.AC.Test
-- | Check that 'compare' agrees with '==' on equity.
p_equal :: (Show x, Ord x) => x -> x -> Test
p_equal x y =
title "compare agrees with (==)" $
argument "x" x $
argument "y" y $
temporary "x == y" (x == y) $
temporary "compare x y" (compare x y) $
if x == y
then compare x y ?= EQ
else compare x y ?/= EQ
-- | Check that swapping the arguments to 'compare' works correctly.
p_symmetric :: (Show x, Ord x) => x -> x -> Test
p_symmetric x y =
title "if x < y then y > x" $
argument "x" x $
argument "y" y $
temporary "compare x y" (compare x y) $
case compare x y of
EQ -> compare y x ?= EQ
LT -> compare y x ?= GT
GT -> compare y x ?= LT
-- | Check that if @x \< y@ and @y \< z@ then @x \< z@.
p_transitive :: (Show x, Ord x) => x -> x -> x -> Test
p_transitive x y z =
title "if x < y and y < z then x < z" $
argument "x" x $
argument "y" y $
argument "z" z $
temporary "compare x y" (compare x y) $
temporary "compare y z" (compare y z) $
case (compare x y, compare y z) of
(EQ, c ) -> compare x z ?= c
(c , EQ) -> compare x z ?= c
(c1, c2) -> if c1 == c2 then compare x z ?= c1 else inapplicable
-- | Check that 'compare' agrees with '>', '<', etc.
p_compare :: (Show x, Ord x) => x -> x -> Test
p_compare x y =
title "compare x y agrees with (<), (>), etc." $
argument "x" x $
argument "y" y $
temporary "compare x y" (compare x y) $
let
(b1, b2, b3, b4) =
case compare x y of
LT -> (True , True , False, False)
EQ -> (False, True , False, True )
GT -> (False, False, True , True )
in
tests
[
title "x < y" $ (x < y) ?= b1,
title "x <= y" $ (x <= y) ?= b2,
title "x > y" $ (x > y) ?= b3,
title "x >= y" $ (x >= y) ?= b4
]
-- | Check that 'min' works correctly.
p_min :: (Show x, Ord x) => x -> x -> Test
p_min x y =
title "min x y" $
argument "x" x $
argument "y" y $
temporary "compare x y" (compare x y) $
case compare x y of
EQ -> tests [title "min x y == x" $ min x y ?= x, title "min x y == y" $ min x y ?= y]
LT -> min x y ?= x
GT -> min x y ?= y
-- | Check that 'max' works correctly.
p_max :: (Show x, Ord x) => x -> x -> Test
p_max x y =
title "max x y" $
argument "x" x $
argument "y" y $
temporary "compare x y" (compare x y) $
case compare x y of
EQ -> tests [title "max x y == x" $ max x y ?= x, title "max x y == y" $ max x y ?= y]
LT -> max x y ?= y
GT -> max x y ?= x
{- |
Given a list of /distinct/ values, perform all applicable tests
on all possible combinations of inputs. (If the inputs are not
distinct, some redundant tests are performed.)
-}
p_Ord :: (Show x, Ord x) => [x] -> Test
p_Ord xs =
title "p_Eq" $
argument "xs" xs $
tests
[
title "p_equal" $ tests [ p_equal x y | x <- xs, y <- xs ],
title "p_symmetric" $ tests [ p_symmetric x y | x <- xs, y <- xs ],
title "p_transitive" $ tests [ p_transitive x y z | x <- xs, y <- xs, z <- xs ],
title "p_compare" $ tests [ p_compare x y | x <- xs, y <- xs ],
title "p_min" $ tests [ p_min x y | x <- xs, y <- xs ],
title "p_max" $ tests [ p_max x y | x <- xs, y <- xs ]
]