{-# OPTIONS_GHC -cpp -pgmPcpphs -optP --layout -optP --hashes -optP --cpp #-}{-# LANGUAGE ScopedTypeVariables #-}---- Copyright (c) 2005, 2009 Stefan Wehr - http://www.stefanwehr.de---- This library is free software; you can redistribute it and/or-- modify it under the terms of the GNU Lesser General Public-- License as published by the Free Software Foundation; either-- version 2.1 of the License, or (at your option) any later version.---- This library 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-- Lesser General Public License for more details.---- You should have received a copy of the GNU Lesser General Public-- License along with this library; if not, write to the Free Software-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA--{-|
You should not use the functions provided by this module directly.
Instead, for each function @assertXXX_@ defined in this module,
there exist a preprocessor macro @assertXXX@, which provides
the "Location" parameter automatically.
|-}moduleTest.Framework.HUnitWrapper(-- * General failureassertFailure,-- * Assertions on Bool valuesassertBool_,assertBoolVerbose_,-- * Equality assertionsassertEqual_,assertEqualVerbose_,assertEqualPretty_,assertEqualPrettyVerbose_,assertEqualNoShow_,assertEqualNoShowVerbose_,-- * Assertions on listsassertListsEqualAsSets_,assertListsEqualAsSetsVerbose_,assertNotEmpty_,assertNotEmptyVerbose_,assertEmpty_,assertEmptyVerbose_,-- * Assertions for exceptionsassertThrows_,assertThrowsVerbose_,assertThrowsSome_,assertThrowsSomeVerbose_,-- * Assertions on Either valuesassertLeft_,assertLeftVerbose_,assertLeftNoShow_,assertLeftNoShowVerbose_,assertRight_,assertRightVerbose_,assertRightNoShow_,assertRightNoShowVerbose_,-- * Assertions on Just valuesassertJust_,assertJustVerbose_,assertNothing_,assertNothingVerbose_,assertNothingNoShow_,assertNothingNoShowVerbose_)whereimportSystem.IO(stderr)importData.List((\\))importControl.ExceptionimportControl.MonadimportqualifiedTest.HUnitasHUhiding(assertFailure)importTest.Framework.TestManagerimportTest.Framework.LocationimportTest.Framework.UtilsimportTest.Framework.Pretty-- WARNING: do not forget to add a preprocessor macro for new assertions!!assertFailure::String->IOaassertFailures=unitTestFailsmkMsg::String->String->String->StringmkMsgfunextraInfos=ifnullextraInfothenfun++(' ':s)elsefun++" ("++extraInfo++") "++s---- Dirty macro hackery (I'm too lazy ...)--#define CreateAssertionsGeneric(__name__, __ctx__, __type__, __ret__) \__name__##Verbose_::__ctx__Location->String->__type__->__ret__;\__name__##Verbose_=_##__name__##_(#__name__++"Verbose");\__name__##_::__ctx__Location->__type__->__ret__;\__name__##_loc=_##__name__##_#__name__loc""#define CreateAssertionsCtx(__name__, __ctx__, __type__) \CreateAssertionsGeneric(__name__,__ctx__=>,__type__,HU.Assertion)#define CreateAssertions(__name__, __type__) \CreateAssertionsGeneric(__name__,,__type__,HU.Assertion)#define CreateAssertionsCtxRet(__name__, __ctx__, __type__, __ret__) \CreateAssertionsGeneric(__name__,__ctx__=>,__type__,__ret__)#define CreateAssertionsRet(__name__, __type__, __ret__) \CreateAssertionsGeneric(__name__,,__type__,__ret__)---- Boolean Assertions--_assertBool_::String->Location->String->Bool->HU.Assertion_assertBool_namelocsFalse=assertFailure(mkMsgnames("failed at "++showLocloc))_assertBool____True=return()CreateAssertions(assertBool,Bool)---- Equality Assertions--_assertEqual_::(Eqa,Showa)=>String->Location->String->a->a->HU.Assertion_assertEqual_namelocsexpectedactual=ifexpected/=actualthenassertFailure(mkMsgnamesmsg)elsereturn()wheremsg="failed at "++showLocloc++"\n expected: "++showexpected++"\n but got: "++showactualCreateAssertionsCtx(assertEqual,(Eqa,Showa),a->a)_assertEqualPretty_::(Eqa,Prettya)=>String->Location->String->a->a->HU.Assertion_assertEqualPretty_namelocsexpectedactual=ifexpected/=actualthenassertFailure(mkMsgnamesmsg)elsereturn()wheremsg="assertEqual failed at "++showLocloc++"\n expected:\n"++showPrettyexpected++"\n but got:\n"++showPrettyactualCreateAssertionsCtx(assertEqualPretty,(Eqa,Prettya),a->a)_assertEqualNoShow_::Eqa=>String->Location->String->a->a->HU.Assertion_assertEqualNoShow_namelocsexpectedactual=ifexpected/=actualthenassertFailure(mkMsgnames("failed at "++showLocloc))elsereturn()CreateAssertionsCtx(assertEqualNoShow,Eqa,a->a)---- Assertions on Lists--_assertListsEqualAsSets_::(Eqa,Showa)=>String->Location->String->[a]->[a]->HU.Assertion_assertListsEqualAsSets_namelocsexpectedactual=letne=lengthexpectedna=lengthactualincase()of_|ne/=na->assertFailure(mkMsgnames("failed at "++showLocloc++"\n expected length: "++showne++"\n actual length: "++showna))|not(unorderedEqexpectedactual)->assertFailure(mkMsg"assertSetEqual"s("failed at "++showLocloc++"\n expected: "++showexpected++"\n actual: "++showactual))|otherwise->return()whereunorderedEql1l2=null(l1\\l2)&&null(l2\\l1)CreateAssertionsCtx(assertListsEqualAsSets,(Eqa,Showa),[a]->[a])_assertNotEmpty_::String->Location->String->[a]->HU.Assertion_assertNotEmpty_namelocs[]=assertFailure(mkMsgnames("failed at "++showLocloc))_assertNotEmpty____(_:_)=return()CreateAssertions(assertNotEmpty,[a])_assertEmpty_::String->Location->String->[a]->HU.Assertion_assertEmpty_namelocs(_:_)=assertFailure(mkMsgnames("failed at "++showLocloc))_assertEmpty____[]=return()CreateAssertions(assertEmpty,[a])---- Assertions for Exceptions--_assertThrows_::Exceptione=>String->Location->String->a->(e->Bool)->HU.Assertion_assertThrows_namelocsxf=dores<-try(evaluatex)caseresofRight_->assertFailure(mkMsgnames("failed at "++showLocloc++": no exception was thrown"))Lefte->iffethenreturn()elseassertFailure(mkMsgnames("failed at "++showLocloc++": wrong exception was thrown: "++showe))CreateAssertionsCtx(assertThrows,Exceptione,a->(e->Bool))_assertThrowsSome_::String->Location->String->a->HU.Assertion_assertThrowsSome_namelocsx=_assertThrows_namelocsx(\(e::SomeException)->True)CreateAssertions(assertThrowsSome,a)---- Assertions on Either--_assertLeft_::forallab.Showb=>String->Location->String->Eitherab->IOa_assertLeft____(Leftx)=returnx_assertLeft_namelocs(Rightx)=assertFailure(mkMsgnames("failed at "++showLocloc++": expected a Left value, given "++show(Rightx::Eitherbb)))CreateAssertionsCtxRet(assertLeft,Showb,Eitherab,IOa)_assertLeftNoShow_::String->Location->String->Eitherab->IOa_assertLeftNoShow____(Leftx)=returnx_assertLeftNoShow_namelocs(Right_)=assertFailure(mkMsgnames("failed at "++showLocloc++": expected a Left value, given a Right value"))CreateAssertionsRet(assertLeftNoShow,Eitherab,IOa)_assertRight_::forallab.Showa=>String->Location->String->Eitherab->IOb_assertRight____(Rightx)=returnx_assertRight_namelocs(Leftx)=assertFailure(mkMsgnames("failed at "++showLocloc++": expected a Right value, given "++show(Leftx::Eitheraa)))CreateAssertionsCtxRet(assertRight,Showa,Eitherab,IOb)_assertRightNoShow_::String->Location->String->Eitherab->IOb_assertRightNoShow____(Rightx)=returnx_assertRightNoShow_namelocs(Left_)=assertFailure(mkMsgnames("failed at "++showLocloc++": expected a Right value, given a Left value"))CreateAssertionsRet(assertRightNoShow,Eitherab,IOb)---- Assertions on Maybe--_assertJust_::String->Location->String->Maybea->IOa_assertJust____(Justx)=returnx_assertJust_namelocsNothing=assertFailure(mkMsgnames("failed at "++showLocloc++": expected a Just value, given Nothing"))CreateAssertionsRet(assertJust,Maybea,IOa)_assertNothing_::Showa=>String->Location->String->Maybea->HU.Assertion_assertNothing____Nothing=return()_assertNothing_namelocsjx=assertFailure(mkMsgnames("failed at "++showLocloc++": expected Nothing, given "++showjx))CreateAssertionsCtx(assertNothing,Showa,Maybea)_assertNothingNoShow_::String->Location->String->Maybea->HU.Assertion_assertNothingNoShow____Nothing=return()_assertNothingNoShow_namelocs_=assertFailure(mkMsgnames("failed at "++showLocloc++": expected Nothing, given a Just value"))CreateAssertions(assertNothingNoShow,Maybea)