swish-0.2.1: Swish/HaskellUtils/TestHelpers.hs
--------------------------------------------------------------------------------
-- $Id: TestHelpers.hs,v 1.2 2004/01/13 12:18:34 graham Exp $
--
-- Copyright (c) 2003, G. KLYNE. All rights reserved.
-- See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
-- Module : TestHelpers
-- Copyright : (c) 2003, Graham Klyne
-- License : GPL V2
--
-- Maintainer : Graham Klyne
-- Stability : provisional
-- Portability : H98
--
-- This module contains test case helper functions, providing a range of
-- commonly-used test cases.
--
--------------------------------------------------------------------------------
module Swish.HaskellUtils.TestHelpers
( test, testEq, testLe, testGe, testElem
, testJust, testNothing
, testEqv, testEqv2, testHasEqv, testMaybeEqv
)
where
import Swish.HaskellUtils.ListHelpers
( equiv )
import Test.HUnit
( Test(TestCase,TestList)
, Assertion
, assertBool, assertEqual, assertFailure
, runTestTT
)
import Control.Monad
( unless )
import Data.Maybe
( isJust )
------------------------------------------------------------
-- Test case helpers
------------------------------------------------------------
assertMember :: (Eq a, Show a) => String -> a -> [a] -> Assertion
assertMember preface item list =
unless (item `elem` list) (assertFailure msg)
where msg = (if null preface then "" else preface ++ "\n") ++
"expected: " ++ show item ++ "\nin list: " ++ show list
test :: String -> Bool -> Test
test lab bv =
TestCase ( assertBool ("test:"++lab) bv )
testEq :: (Eq a, Show a) => String -> a -> a -> Test
testEq lab a1 a2 =
TestCase ( assertEqual ("testEq:"++lab) a1 a2 )
testLe :: (Ord a, Show a) => String -> a -> a -> Test
testLe lab a1 a2 =
TestCase ( assertBool ("testLe:"++lab++vals) (a1<=a2) )
where
vals = ", fail: "++show a1++" <= "++show a2
testGe :: (Ord a, Show a) => String -> a -> a -> Test
testGe lab a1 a2 =
TestCase ( assertBool ("testGe:"++lab++vals) (a1>=a2) )
where
vals = ", fail: "++show a1++" >= "++show a2
-- Test for Just x or Nothing
testJust :: String -> Maybe a -> Test
testJust lab av =
TestCase ( assertBool ("testJust:"++lab) (isJust av) )
testNothing :: String -> Maybe a -> Test
testNothing lab av =
TestCase ( assertBool ("testJust:"++lab) (not $ isJust av) )
-- Test for list membership
testElem :: (Eq a, Show a) => String -> a -> [a] -> Test
testElem lab a1 as =
TestCase ( assertMember ("testElem:"++lab) a1 as )
-- Compare lists and lists of lists and Maybe lists for set equivalence:
data ListTest a = ListTest [a]
instance (Eq a) => Eq (ListTest a) where
(ListTest a1) == (ListTest a2) = a1 `equiv` a2
instance (Show a) => Show (ListTest a) where
show (ListTest a) = show a
data MaybeListTest a = MaybeListTest (Maybe [a])
instance (Eq a) => Eq (MaybeListTest a) where
MaybeListTest (Just a1) == MaybeListTest (Just a2) = a1 `equiv` a2
MaybeListTest Nothing == MaybeListTest Nothing = True
_ == _ = False
instance (Show a) => Show (MaybeListTest a) where
show (MaybeListTest a) = show a
testEqv :: (Eq a, Show a) => String -> [a] -> [a] -> Test
testEqv lab a1 a2 =
TestCase ( assertEqual ("testEqv:"++lab) (ListTest a1) (ListTest a2) )
testEqv2 :: (Eq a, Show a) => String -> [[a]] -> [[a]] -> Test
testEqv2 lab a1 a2 =
TestCase ( assertEqual ("testEqv2:"++lab) ma1 ma2 )
where
ma1 = ListTest $ map ListTest a1
ma2 = ListTest $ map ListTest a2
testHasEqv :: (Eq a, Show a) => String -> [a] -> [[a]] -> Test
testHasEqv lab a1 a2 =
TestCase ( assertMember ("testHasEqv:"++lab) ma1 ma2 )
where
ma1 = ListTest a1
ma2 = map ListTest a2
testMaybeEqv :: (Eq a, Show a) => String -> Maybe [a] -> Maybe [a] -> Test
testMaybeEqv lab a1 a2 =
TestCase ( assertEqual ("testMaybeEqv:"++lab) ma1 ma2 )
where
ma1 = (MaybeListTest a1)
ma2 = (MaybeListTest a2)
------------------------------------------------------------
-- Test suites for the above
------------------------------------------------------------
testSuccessSuite = TestList
[ test "01" True
, testEq "02" 2 2
, testLe "03" 1 2
, testLe "04" 2 2
, testGe "05" 3 2
, testGe "07" 2 2
, testJust "08" (Just "08")
, testNothing "09" (Nothing :: Maybe String)
, testElem "10" 'b' "abc"
, testEqv "11" "abc" "bca"
, testEqv "12" "abc" "bbccaa"
, testEqv2 "13" ["abc","def","ghi"] ["fed","ghi","bca"]
, testHasEqv "14" "abc" ["fed","ghi","bca"]
, testHasEqv "15" "ghi" ["fed","ghi","bca"]
, testHasEqv "16" "def" ["fed","ghi","bca"]
, testMaybeEqv "17" (Just "abc") (Just "bca")
, testMaybeEqv "18" Nothing (Nothing :: Maybe String)
]
-- All of these tests should be failures:
-- Look for number of failures == total number of tests
testFailureSuite = TestList
[ test "01" False
, testEq "02" 2 22
, testLe "03" 2 1
, testGe "04" 2 3
, testJust "05" (Nothing :: Maybe String)
, testNothing "06" (Just "09")
, testElem "07" 'd' "abc"
, testEqv "08" "abd" "bca"
, testEqv2 "09" ["abd","def","ghi"] ["fed","ghi","bca"]
, testHasEqv "10" "abd" ["fed","ghi","bca"]
, testMaybeEqv "11" (Just "abc") (Just "bda")
, testMaybeEqv "12" Nothing (Just "bda")
]
------------------------------------------------------------
-- All tests
------------------------------------------------------------
allSuccessTests = TestList
[ testSuccessSuite
]
allFailureTests = TestList
[ testFailureSuite
]
mainS = runTestTT allSuccessTests
mainF = runTestTT allFailureTests
--------------------------------------------------------------------------------
--
-- Copyright (c) 2003, G. KLYNE. All rights reserved.
--
-- This file is part of Swish.
--
-- Swish is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2 of the License, or
-- (at your option) any later version.
--
-- Swish is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with Swish; if not, write to:
-- The Free Software Foundation, Inc.,
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
--
--------------------------------------------------------------------------------
-- $Source: /file/cvsdev/HaskellUtils/TestHelpers.hs,v $
-- $Author: graham $
-- $Revision: 1.2 $
-- $Log: TestHelpers.hs,v $
-- Revision 1.2 2004/01/13 12:18:34 graham
-- Clean up test case helpers module.
--
-- Revision 1.1.1.1 2004/01/13 12:15:56 graham
-- Fix up name of HaskellUtils project