moduleTest.QuickCheck.Testwhere---------------------------------------------------------------------------- importsimportTest.QuickCheck.GenimportTest.QuickCheck.Propertyhiding(Result(reason,interrupted))importqualifiedTest.QuickCheck.PropertyasPimportTest.QuickCheck.TextimportTest.QuickCheck.StateimportTest.QuickCheck.ExceptionimportSystem.Random(split,newStdGen,StdGen)importData.Char(isSpace)importData.List(sort,group,groupBy,intersperse)---------------------------------------------------------------------------- quickCheck-- * Running tests-- | Args specifies arguments to the QuickCheck driverdataArgs=Args{replay::Maybe(StdGen,Int)-- ^ should we replay a previous test?,maxSuccess::Int-- ^ maximum number of successful tests before succeeding,maxDiscard::Int-- ^ maximum number of discarded tests before giving up,maxSize::Int-- ^ size to use for the biggest test cases,chatty::Bool-- ^ whether to print anything}deriving(Show,Read)-- | Result represents the test resultdataResult=Success-- a successful test run{numTests::Int-- ^ number of successful tests performed,labels::[(String,Int)]-- ^ labels and frequencies found during all tests,output::String-- ^ printed output}|GaveUp-- given up{numTests::Int-- ^ number of successful tests performed,labels::[(String,Int)]-- ^ labels and frequencies found during all tests,output::String-- ^ printed output}|Failure-- failed test run{numTests::Int-- ^ number of tests performed,numShrinks::Int-- ^ number of successful shrinking steps performed,usedSeed::StdGen-- ^ what seed was used,usedSize::Int-- ^ what was the test size,reason::String-- ^ what was the reason,labels::[(String,Int)]-- ^ labels and frequencies found during all successful tests,output::String-- ^ printed output}|NoExpectedFailure-- the expected failure did not happen{numTests::Int-- ^ number of tests performed,labels::[(String,Int)]-- ^ labels and frequencies found during all successful tests,output::String-- ^ printed output}deriving(Show,Read)-- | isSuccess checks if the test run result was a successisSuccess::Result->BoolisSuccessSuccess{}=TrueisSuccess_=False-- | stdArgs are the default test arguments usedstdArgs::ArgsstdArgs=Args{replay=Nothing,maxSuccess=100,maxDiscard=500,maxSize=100,chatty=True-- noShrinking flag?}-- | Tests a property and prints the results to 'stdout'.quickCheck::Testableprop=>prop->IO()quickCheckp=quickCheckWithstdArgsp-- | Tests a property, using test arguments, and prints the results to 'stdout'.quickCheckWith::Testableprop=>Args->prop->IO()quickCheckWithargsp=quickCheckWithResultargsp>>return()-- | Tests a property, produces a test result, and prints the results to 'stdout'.quickCheckResult::Testableprop=>prop->IOResultquickCheckResultp=quickCheckWithResultstdArgsp-- | Tests a property, using test arguments, produces a test result, and prints the results to 'stdout'.quickCheckWithResult::Testableprop=>Args->prop->IOResultquickCheckWithResultap=dotm<-ifchattyathennewStdioTerminalelsenewNullTerminalrnd<-casereplayaofNothing->newStdGenJust(rnd,_)->returnrndtestMkState{terminal=tm,maxSuccessTests=maxSuccessa,maxDiscardedTests=maxDiscarda,computeSize=casereplayaofNothing->computeSize'Just(_,s)->\__->s,numSuccessTests=0,numDiscardedTests=0,collected=[],expectedFailure=False,randomSeed=rnd,numSuccessShrinks=0,numTryShrinks=0}(unGen(propertyp))wherecomputeSize'nd-- e.g. with maxSuccess = 250, maxSize = 100, goes like this:-- 0, 1, 2, ..., 99, 0, 1, 2, ..., 99, 0, 2, 4, ..., 98.|n`roundTo`maxSizea+maxSizea<=maxSuccessa||n>=maxSuccessa||maxSuccessa`mod`maxSizea==0=n`mod`maxSizea+d`div`10|otherwise=(n`mod`maxSizea)*maxSizea`div`(maxSuccessa`mod`maxSizea)+d`div`10n`roundTo`m=(n`div`m)*m-- | Tests a property and prints the results and all test cases generated to 'stdout'.-- This is just a convenience function that means the same as 'quickCheck' '.' 'verbose'.verboseCheck::Testableprop=>prop->IO()verboseCheckp=quickCheck(verbosep)-- | Tests a property, using test arguments, and prints the results and all test cases generated to 'stdout'.-- This is just a convenience function that combines 'quickCheckWith' and 'verbose'.verboseCheckWith::Testableprop=>Args->prop->IO()verboseCheckWithargsp=quickCheckWithargs(verbosep)-- | Tests a property, produces a test result, and prints the results and all test cases generated to 'stdout'.-- This is just a convenience function that combines 'quickCheckResult' and 'verbose'.verboseCheckResult::Testableprop=>prop->IOResultverboseCheckResultp=quickCheckResult(verbosep)-- | Tests a property, using test arguments, produces a test result, and prints the results and all test cases generated to 'stdout'.-- This is just a convenience function that combines 'quickCheckWithResult' and 'verbose'.verboseCheckWithResult::Testableprop=>Args->prop->IOResultverboseCheckWithResultap=quickCheckWithResulta(verbosep)---------------------------------------------------------------------------- main test looptest::State->(StdGen->Int->Prop)->IOResultteststf|numSuccessTestsst>=maxSuccessTestsst=doneTestingstf|numDiscardedTestsst>=maxDiscardedTestsst=giveUpstf|otherwise=runATeststfdoneTesting::State->(StdGen->Int->Prop)->IOResultdoneTestingst_f=do-- CALLBACK done_testing?ifexpectedFailurestthenputPart(terminalst)("+++ OK, passed "++show(numSuccessTestsst)++" tests")elseputPart(terminalst)(bold("*** Failed!")++" Passed "++show(numSuccessTestsst)++" tests (expected failure)")successsttheOutput<-terminalOutput(terminalst)ifexpectedFailurestthenreturnSuccess{labels=summaryst,numTests=numSuccessTestsst,output=theOutput}elsereturnNoExpectedFailure{labels=summaryst,numTests=numSuccessTestsst,output=theOutput}giveUp::State->(StdGen->Int->Prop)->IOResultgiveUpst_f=do-- CALLBACK gave_up?putPart(terminalst)(bold("*** Gave up!")++" Passed only "++show(numSuccessTestsst)++" tests")successsttheOutput<-terminalOutput(terminalst)returnGaveUp{numTests=numSuccessTestsst,labels=summaryst,output=theOutput}runATest::State->(StdGen->Int->Prop)->IOResultrunATeststf=do-- CALLBACK before_testputTemp(terminalst)("("++number(numSuccessTestsst)"test"++concat["; "++show(numDiscardedTestsst)++" discarded"|numDiscardedTestsst>0]++")")letsize=computeSizest(numSuccessTestsst)(numDiscardedTestsst)MkRoserests<-protectRose(reduceRose(unProp(frnd1size)))callbackPostTeststrescaseresofMkResult{ok=JustTrue,stamp=stamp,expect=expect}->-- successful testdotestst{numSuccessTests=numSuccessTestsst+1,randomSeed=rnd2,collected=stamp:collectedst,expectedFailure=expect}fMkResult{ok=Nothing,expect=expect}->-- discarded testdotestst{numDiscardedTests=numDiscardedTestsst+1,randomSeed=rnd2,expectedFailure=expect}fMkResult{ok=JustFalse}->-- failed testdoifexpectresthenputPart(terminalst)(bold"*** Failed! ")elseputPart(terminalst)"+++ OK, failed as expected. "numShrinks<-foundFailurestreststheOutput<-terminalOutput(terminalst)ifnot(expectres)thenreturnSuccess{labels=summaryst,numTests=numSuccessTestsst+1,output=theOutput}elsereturnFailure{usedSeed=randomSeedst-- correct! (this will be split first),usedSize=size,numTests=numSuccessTestsst+1,numShrinks=numShrinks,output=theOutput,reason=P.reasonres,labels=summaryst}where(rnd1,rnd2)=split(randomSeedst)summary::State->[(String,Int)]summaryst=reverse.sort.map(\ss->(headss,(lengthss*100)`div`numSuccessTestsst)).group.sort$[concat(intersperse", "s')|s<-collectedst,lets'=[t|(t,_)<-s],not(nulls')]success::State->IO()successst=caseallLabels++coversof[]->doputLine(terminalst)"."[pt]->doputLine(terminalst)(" ("++dropWhileisSpacept++").")cases->doputLine(terminalst)":"sequence_[putLine(terminalst)pt|pt<-cases]whereallLabels=reverse.sort.map(\ss->(showP((lengthss*100)`div`numSuccessTestsst)++headss)).group.sort$[concat(intersperse", "s')|s<-collectedst,lets'=[t|(t,0)<-s],not(nulls')]covers=[("only "++showoccurP++"% "++fst(headlps)++"; not "++showreqP++"%")|lps<-groupByfirst.sort$[lp|lps<-collectedst,lp<-maxilps,sndlp>0],letoccurP=(100*lengthlps)`div`maxSuccessTestsstreqP=maximum(mapsndlps),occurP<reqP](x,_)`first`(y,_)=x==ymaxi=map(\lps->(fst(headlps),maximum(mapsndlps))).groupByfirst.sortshowPp=(ifp<10then" "else"")++showp++"% "---------------------------------------------------------------------------- main shrinking loopfoundFailure::State->P.Result->[RoseP.Result]->IOIntfoundFailurestrests=dolocalMinst{numTryShrinks=0}restslocalMin::State->P.Result->[RoseP.Result]->IOIntlocalMinstres_|P.interruptedres=localMinFoundstreslocalMinstrests=doputTemp(terminalst)(short26(P.reasonres)++" (after "++number(numSuccessTestsst+1)"test"++concat[" and "++show(numSuccessShrinksst)++concat["."++show(numTryShrinksst)|numTryShrinksst>0]++" shrink"++(ifnumSuccessShrinksst==1&&numTryShrinksst==0then""else"s")|numSuccessShrinksst>0||numTryShrinksst>0]++")...")r<-tryEvaluatetscaserofLefterr->localMinFoundst(exception"Exception while generating shrink-list"err){callbacks=callbacksres}Rightts'->localMin'strests'localMin'::State->P.Result->[RoseP.Result]->IOIntlocalMin'stres[]=localMinFoundstreslocalMin'stres(t:ts)=do-- CALLBACK before_testMkRoseres'ts'<-protectRose(reduceRoset)callbackPostTeststres'ifokres'==JustFalsethenfoundFailurest{numSuccessShrinks=numSuccessShrinksst+1}res'ts'elselocalMinst{numTryShrinks=numTryShrinksst+1}restslocalMinFound::State->P.Result->IOIntlocalMinFoundstres=doputLine(terminalst)(P.reasonres++" (after "++number(numSuccessTestsst+1)"test"++concat[" and "++number(numSuccessShrinksst)"shrink"|numSuccessShrinksst>0]++"): ")callbackPostFinalFailurestresreturn(numSuccessShrinksst)---------------------------------------------------------------------------- callbackscallbackPostTest::State->P.Result->IO()callbackPostTeststres=sequence_[safelyst(fstres)|PostTest_f<-callbacksres]callbackPostFinalFailure::State->P.Result->IO()callbackPostFinalFailurestres=sequence_[safelyst(fstres)|PostFinalFailure_f<-callbacksres]safely::State->IO()->IO()safelystx=dor<-tryEvaluateIOxcaserofLefte->putLine(terminalst)("*** Exception in callback: "++showe)Rightx->returnx---------------------------------------------------------------------------- the end.