module Test.AC.Class.Ord where
import Test.AC.Test
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
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
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
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
]
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
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
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 ]
]