------------------------------------------------------------------------------- |-- Module : Distribution.Simple.Test-- Copyright : Thomas Tuegel 2010---- Maintainer : cabal-devel@haskell.org-- Portability : portable---- This is the entry point into testing a built package. It performs the-- \"@.\/setup test@\" action. It runs test suites designated in the package-- description and reports on the results.{- All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* Neither the name of Isaac Jones nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}moduleDistribution.Simple.Test(test,stubMain,writeSimpleTestStub,stubFilePath,stubName,PackageLog(..),TestSuiteLog(..),TestLogs(..),suitePassed,suiteFailed,suiteError)whereimportDistribution.Compat.TempFile(openTempFile)importDistribution.ModuleName(ModuleName)importDistribution.Package(PackageId)importqualifiedDistribution.PackageDescriptionasPD(PackageDescription(..),BuildInfo(buildable),TestSuite(..),TestSuiteInterface(..),testType,hasTests)importDistribution.Simple.Build.PathsModule(pkgPathEnvVar)importDistribution.Simple.BuildPaths(exeExtension)importDistribution.Simple.Compiler(Compiler(..),CompilerId)importDistribution.Simple.Hpc(markupPackage,markupTest,tixDir,tixFilePath)importDistribution.Simple.InstallDirs(fromPathTemplate,initialPathTemplateEnv,PathTemplateVariable(..),substPathTemplate,toPathTemplate,PathTemplate)importqualifiedDistribution.Simple.LocalBuildInfoasLBI(LocalBuildInfo(..))importDistribution.Simple.Setup(TestFlags(..),TestShowDetails(..),fromFlag)importDistribution.Simple.Utils(die,notice)importDistribution.TestSuite(OptionDescr(..),Options,Progress(..),Result(..),TestInstance(..),Test(..))importDistribution.TextimportDistribution.Verbosity(normal,Verbosity)importDistribution.System(buildPlatform,Platform)importControl.Exception(bracket)importControl.Monad(when,unless,filterM)importData.Char(toUpper)importData.Maybe(mapMaybe)importSystem.Directory(createDirectoryIfMissing,doesDirectoryExist,doesFileExist,getCurrentDirectory,getDirectoryContents,removeDirectoryRecursive,removeFile)importSystem.Environment(getEnvironment)importSystem.Exit(ExitCode(..),exitFailure,exitWith)importSystem.FilePath((</>),(<.>))importSystem.IO(hClose,IOMode(..),openFile)importSystem.Process(runProcess,waitForProcess)-- | Logs all test results for a package, broken down first by test suite and-- then by test case.dataPackageLog=PackageLog{package::PackageId,compiler::CompilerId,platform::Platform,testSuites::[TestSuiteLog]}deriving(Read,Show,Eq)-- | A 'PackageLog' with package and platform information specified.localPackageLog::PD.PackageDescription->LBI.LocalBuildInfo->PackageLoglocalPackageLogpkg_descrlbi=PackageLog{package=PD.packagepkg_descr,compiler=compilerId$LBI.compilerlbi,platform=buildPlatform,testSuites=[]}-- | Logs test suite results, itemized by test case.dataTestSuiteLog=TestSuiteLog{testSuiteName::String,testLogs::TestLogs,logFile::FilePath-- path to human-readable log file}deriving(Read,Show,Eq)dataTestLogs=TestLog{testName::String,testOptionsReturned::Options,testResult::Result}|GroupLogsString[TestLogs]deriving(Read,Show,Eq)-- | Count the number of pass, fail, and error test results in a 'TestLogs'-- tree.countTestResults::TestLogs->(Int,Int,Int)-- ^ Passes, fails, and errors,-- respectively.countTestResults=go(0,0,0)wherego(p,f,e)(TestLog{testResult=r})=caserofPass->(p+1,f,e)Fail_->(p,f+1,e)Error_->(p,f,e+1)go(p,f,e)(GroupLogs_ts)=foldlgo(p,f,e)ts-- | From a 'TestSuiteLog', determine if the test suite passed.suitePassed::TestSuiteLog->BoolsuitePassedl=casecountTestResults(testLogsl)of(_,0,0)->True_->False-- | From a 'TestSuiteLog', determine if the test suite failed.suiteFailed::TestSuiteLog->BoolsuiteFailedl=casecountTestResults(testLogsl)of(_,0,_)->False_->True-- | From a 'TestSuiteLog', determine if the test suite encountered errors.suiteError::TestSuiteLog->BoolsuiteErrorl=casecountTestResults(testLogsl)of(_,_,0)->False_->True-- | Run a test executable, logging the output and generating the appropriate-- summary messages.testController::TestFlags-- ^ flags Cabal was invoked with->PD.PackageDescription-- ^ description of package the test suite belongs to->LBI.LocalBuildInfo-- ^ information from the configure step->PD.TestSuite-- ^ TestSuite being tested->(FilePath->String)-- ^ prepare standard input for test executable->FilePath-- ^ executable name->(ExitCode->String->TestSuiteLog)-- ^ generator for the TestSuiteLog->(TestSuiteLog->FilePath)-- ^ generator for final human-readable log filename->IOTestSuiteLogtestControllerflagspkg_descrlbisuitepreTestcmdpostTestlogNamer=doletdistPref=fromFlag$testDistPrefflagsverbosity=fromFlag$testVerbosityflagstestLogDir=distPref</>"test"opts=map(testOptionpkg_descrlbisuite)$testOptionsflagspwd<-getCurrentDirectoryexistingEnv<-getEnvironmentletdataDirPath=pwd</>PD.dataDirpkg_descrshellEnv=Just$(pkgPathEnvVarpkg_descr"datadir",dataDirPath):("HPCTIXFILE",(</>)pwd$tixFilePathdistPref$PD.testNamesuite):existingEnvbracket(openCabalTemptestLogDir)deleteIfExists$\tempLog->bracket(openCabalTemptestLogDir)deleteIfExists$\tempInput->do-- Check that the test executable exists.exists<-doesFileExistcmdunlessexists$die$"Error: Could not find test program \""++cmd++"\". Did you build the package first?"-- Remove old .tix files if appropriate.unless(fromFlag$testKeepTixflags)$dolettDir=tixDirdistPref$PD.testNamesuiteexists'<-doesDirectoryExisttDirwhenexists'$removeDirectoryRecursivetDir-- Create directory for HPC files.createDirectoryIfMissingTrue$tixDirdistPref$PD.testNamesuite-- Write summary notices indicating start of test suitenoticeverbosity$summarizeSuiteStart$PD.testNamesuite-- Prepare standard input for test executableappendFiletempInput$preTesttempInput-- Run test executableexit<-dohLog<-openFiletempLogAppendModehIn<-openFiletempInputReadMode-- these handles get closed by runProcessproc<-runProcesscmdoptsNothingshellEnv(JusthIn)(JusthLog)(JusthLog)waitForProcessproc-- Generate TestSuiteLog from executable exit code and a machine--- readable test logsuiteLog<-fmap(postTestexit$!)$readFiletempInput-- Generate final log file nameletfinalLogName=testLogDir</>logNamersuiteLogsuiteLog'=suiteLog{logFile=finalLogName}-- Write summary notice to log file indicating start of test suiteappendFile(logFilesuiteLog')$summarizeSuiteStart$PD.testNamesuite-- Append contents of temporary log file to the final human--- readable log filereadFiletempLog>>=appendFile(logFilesuiteLog')-- Write end-of-suite summary notice to log fileappendFile(logFilesuiteLog')$summarizeSuiteFinishsuiteLog'-- Show the contents of the human-readable log file on the terminal-- if there is a failure and/or detailed output is requestedletdetails=fromFlag$testShowDetailsflagswhenPrinting=when$(details>Never)&&(not(suitePassedsuiteLog)||details==Always)&&verbosity>=normalwhenPrinting$readFiletempLog>>=putStr.unlines.lines-- Write summary notice to terminal indicating end of test suitenoticeverbosity$summarizeSuiteFinishsuiteLog'markupTestverbositylbidistPref(display$PD.packagepkg_descr)suitereturnsuiteLog'wheredeleteIfExistsfile=doexists<-doesFileExistfilewhenexists$removeFilefileopenCabalTemptestLogDir=do(f,h)<-openTempFiletestLogDir$"cabal-test-"<.>"log"hCloseh>>returnf-- |Perform the \"@.\/setup test@\" action.test::PD.PackageDescription-- ^information from the .cabal file->LBI.LocalBuildInfo-- ^information from the configure step->TestFlags-- ^flags sent to test->IO()testpkg_descrlbiflags=doletverbosity=fromFlag$testVerbosityflagshumanTemplate=fromFlag$testHumanLogflagsmachineTemplate=fromFlag$testMachineLogflagsdistPref=fromFlag$testDistPrefflagstestLogDir=distPref</>"test"testNames=fromFlag$testListflagspkgTests=PD.testSuitespkg_descrenabledTests=[t|t<-pkgTests,PD.testEnabledt,PD.buildable(PD.testBuildInfot)]doTest::(PD.TestSuite,MaybeTestSuiteLog)->IOTestSuiteLogdoTest(suite,_)=dolettestLogPath=testSuiteLogPathhumanTemplatepkg_descrlbigoprecmdpost=testControllerflagspkg_descrlbisuiteprecmdposttestLogPathcasePD.testInterfacesuiteofPD.TestSuiteExeV10__->doletcmd=LBI.buildDirlbi</>PD.testNamesuite</>PD.testNamesuite<.>exeExtensionpreTest_=""postTestexit_=letr=caseexitofExitSuccess->PassExitFailurec->Fail$"exit code: "++showcinTestSuiteLog{testSuiteName=PD.testNamesuite,testLogs=TestLog{testName=PD.testNamesuite,testOptionsReturned=[],testResult=r},logFile=""}gopreTestcmdpostTestPD.TestSuiteLibV09__->doletcmd=LBI.buildDirlbi</>stubNamesuite</>stubNamesuite<.>exeExtensionpreTestf=show(f,PD.testNamesuite)postTest_=readgopreTestcmdpostTest_->returnTestSuiteLog{testSuiteName=PD.testNamesuite,testLogs=TestLog{testName=PD.testNamesuite,testOptionsReturned=[],testResult=Error$"No support for running test suite type: "++show(disp$PD.testTypesuite)},logFile=""}when(not$PD.hasTestspkg_descr)$donoticeverbosity"Package has no test suites."exitWithExitSuccesswhen(PD.hasTestspkg_descr&&nullenabledTests)$die$"No test suites enabled. Did you remember to configure with "++"\'--enable-tests\'?"testsToRun<-casetestNamesof[]->return$zipenabledTests$repeatNothingnames->flipmapMnames$\tName->lettestMap=zipenabledNamesenabledTestsenabledNames=mapPD.testNameenabledTestsallNames=mapPD.testNamepkgTestsincaselookuptNametestMapofJustt->return(t,Nothing)_|tName`elem`allNames->die$"Package configured with test suite "++tName++" disabled."|otherwise->die$"no such test: "++tNamecreateDirectoryIfMissingTruetestLogDir-- Delete ordinary files from test log directory.getDirectoryContentstestLogDir>>=filterMdoesFileExist.map(testLogDir</>)>>=mapM_removeFilelettotalSuites=lengthtestsToRunnoticeverbosity$"Running "++showtotalSuites++" test suites..."suites<-mapMdoTesttestsToRunletpackageLog=(localPackageLogpkg_descrlbi){testSuites=suites}packageLogFile=(</>)testLogDir$packageLogPathmachineTemplatepkg_descrlbiallOk<-summarizePackageverbositypackageLogwriteFilepackageLogFile$showpackageLogmarkupPackageverbositylbidistPref(display$PD.packagepkg_descr)$mapfsttestsToRununlessallOkexitFailure-- | Print a summary to the console after all test suites have been run-- indicating the number of successful test suites and cases. Returns 'True' if-- all test suites passed and 'False' otherwise.summarizePackage::Verbosity->PackageLog->IOBoolsummarizePackageverbositypackageLog=doletcounts=map(countTestResults.testLogs)$testSuitespackageLog(passed,failed,errors)=foldl1addTriplecountstotalCases=passed+failed+errorspassedSuites=length$filtersuitePassed$testSuitespackageLogtotalSuites=length$testSuitespackageLognoticeverbosity$showpassedSuites++" of "++showtotalSuites++" test suites ("++showpassed++" of "++showtotalCases++" test cases) passed."return$!passedSuites==totalSuiteswhereaddTriple(p1,f1,e1)(p2,f2,e2)=(p1+p2,f1+f2,e1+e2)-- | Print a summary of a single test case's result to the console, supressing-- output for certain verbosity or test filter levels.summarizeTest::Verbosity->TestShowDetails->TestLogs->IO()summarizeTest__(GroupLogs{})=return()summarizeTestverbositydetailst=whenshouldPrint$noticeverbosity$"Test case "++testNamet++": "++show(testResultt)whereshouldPrint=(details>Never)&&(notPassed||details==Always)notPassed=testResultt/=Pass-- | Print a summary of the test suite's results on the console, suppressing-- output for certain verbosity or test filter levels.summarizeSuiteFinish::TestSuiteLog->StringsummarizeSuiteFinishtestLog=unlines["Test suite "++testSuiteNametestLog++": "++resStr,"Test suite logged to: "++logFiletestLog]whereresStr=maptoUpper(resultStringtestLog)summarizeSuiteStart::String->StringsummarizeSuiteStartn="Test suite "++n++": RUNNING...\n"resultString::TestSuiteLog->StringresultStringl|suiteErrorl="error"|suiteFailedl="fail"|otherwise="pass"testSuiteLogPath::PathTemplate->PD.PackageDescription->LBI.LocalBuildInfo->TestSuiteLog->FilePathtestSuiteLogPathtemplatepkg_descrlbitestLog=fromPathTemplate$substPathTemplateenvtemplatewhereenv=initialPathTemplateEnv(PD.packagepkg_descr)(compilerId$LBI.compilerlbi)++[(TestSuiteNameVar,toPathTemplate$testSuiteNametestLog),(TestSuiteResultVar,result)]result=toPathTemplate$resultStringtestLog-- TODO: This is abusing the notion of a 'PathTemplate'. The result-- isn't neccesarily a path.testOption::PD.PackageDescription->LBI.LocalBuildInfo->PD.TestSuite->PathTemplate->StringtestOptionpkg_descrlbisuitetemplate=fromPathTemplate$substPathTemplateenvtemplatewhereenv=initialPathTemplateEnv(PD.packagepkg_descr)(compilerId$LBI.compilerlbi)++[(TestSuiteNameVar,toPathTemplate$PD.testNamesuite)]packageLogPath::PathTemplate->PD.PackageDescription->LBI.LocalBuildInfo->FilePathpackageLogPathtemplatepkg_descrlbi=fromPathTemplate$substPathTemplateenvtemplatewhereenv=initialPathTemplateEnv(PD.packagepkg_descr)(compilerId$LBI.compilerlbi)-- | The filename of the source file for the stub executable associated with a-- library 'TestSuite'.stubFilePath::PD.TestSuite->FilePathstubFilePatht=stubNamet<.>"hs"-- | The name of the stub executable associated with a library 'TestSuite'.stubName::PD.TestSuite->FilePathstubNamet=PD.testNamet++"Stub"-- | Write the source file for a library 'TestSuite' stub executable.writeSimpleTestStub::PD.TestSuite-- ^ library 'TestSuite' for which a stub-- is being created->FilePath-- ^ path to directory where stub source-- should be located->IO()writeSimpleTestStubtdir=docreateDirectoryIfMissingTruedirletfilename=dir</>stubFilePathtPD.TestSuiteLibV09_m=PD.testInterfacetwriteFilefilename$simpleTestStubm-- | Source code for library test suite stub executablesimpleTestStub::ModuleName->StringsimpleTestStubm=unlines["module Main ( main ) where","import Distribution.Simple.Test ( stubMain )","import "++show(dispm)++" ( tests )","main :: IO ()","main = stubMain tests"]-- | Main function for test stubs. Once, it was written directly into the stub,-- but minimizing the amount of code actually in the stub maximizes the number-- of detectable errors when Cabal is compiled.stubMain::IO[Test]->IO()stubMaintests=do(f,n)<-fmapreadgetContentstests>>=stubRunTests>>=stubWriteLogfn-- | The test runner used in library "TestSuite" stub executables. Runs a list-- of 'Test's. An executable calling this function is meant to be invoked as-- the child of a Cabal process during @.\/setup test@. A 'TestSuiteLog',-- provided by Cabal, is read from the standard input; it supplies the name of-- the test suite and the location of the machine-readable test suite log file.-- Human-readable log information is written to the standard output for capture-- by the calling Cabal process.stubRunTests::[Test]->IOTestLogsstubRunTeststests=dologs<-mapMstubRunTests'testsreturn$GroupLogs"Default"logswherestubRunTests'(Testt)=dol<-runt>>=finishsummarizeTestnormalAlwayslreturnlwherefinish(Finishedresult)=returnTestLog{testName=namet,testOptionsReturned=defaultOptionst,testResult=result}finish(Progress_next)=next>>=finishstubRunTests'g@(Group{})=dologs<-mapMstubRunTests'$groupTestsgreturn$GroupLogs(groupNameg)logsstubRunTests'(ExtraOptions_t)=stubRunTests'tmaybeDefaultOptionopt=maybeNothing(\d->Just(optionNameopt,d))$optionDefaultoptdefaultOptionstestInst=mapMaybemaybeDefaultOption$optionstestInst-- | From a test stub, write the 'TestSuiteLog' to temporary file for the calling-- Cabal process to read.stubWriteLog::FilePath->String->TestLogs->IO()stubWriteLogfnlogs=dolettestLog=TestSuiteLog{testSuiteName=n,testLogs=logs,logFile=f}writeFile(logFiletestLog)$showtestLogwhen(suiteErrortestLog)$exitWith$ExitFailure2when(suiteFailedtestLog)$exitWith$ExitFailure1exitWithExitSuccess