{-# LANGUAGE CPP #-}---- Copyright (c) 2009-2012 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--{- |
This module defines the commandline options of the test driver provided by HTF.
-}moduleTest.Framework.CmdlineOptions(CmdlineOptions(..),defaultCmdlineOptions,parseTestArgs,helpString,testConfigFromCmdlineOptions)whereimportTest.Framework.TestReporterimportTest.Framework.TestTypesimportTest.Framework.ColorsimportTest.Framework.UtilsimportData.Char(toLower)importData.MaybeimportSystem.IOimportSystem.Console.GetOptimportqualifiedText.RegexasR#ifndef mingw32_HOST_OSimportSystem.Posix.TerminalimportSystem.Posix.IO(stdOutput)importSystem.Posix.Env(getEnv)#endif#ifdef COMPILER_GHCimportGHC.Conc(numCapabilities)#endif---- CmdlineOptions---- | Commandline options for running tests.dataCmdlineOptions=CmdlineOptions{opts_quiet::Bool-- ^ Be quiet or not.,opts_filter::TestFilter-- ^ Run only tests matching this filter.,opts_help::Bool-- ^ If 'True', display a help message and exit.,opts_negated::[String]-- ^ Regular expressions matching test names which should /not/ run.-- , opts_threads :: Maybe Int -- ^ Use @Just i@ for parallel execution with @i@ threads, @Nothing@ for sequential execution (currently unused).,opts_machineOutput::Bool-- ^ Format output for machines (JSON format) or humans. See 'Test.Framework.JsonOutput' for a definition of the JSON format.,opts_useColors::MaybeBool-- ^ Use @Just b@ to enable/disable use of colors, @Nothing@ infers the use of colors.,opts_outputFile::MaybeFilePath-- ^ The output file, defaults to stdout,opts_listTests::Bool-- ^ If 'True', lists all tests available and exits.,opts_split::Bool-- ^ If 'True', each message is sent to a new ouput file (derived by appending an index to 'opts_outputFile').}{- |
The default 'CmdlineOptions'.
-}defaultCmdlineOptions::CmdlineOptionsdefaultCmdlineOptions=CmdlineOptions{opts_quiet=False,opts_filter=constTrue,opts_help=False,opts_negated=[]-- , opts_threads = Nothing,opts_machineOutput=False,opts_useColors=Nothing,opts_outputFile=Nothing,opts_listTests=False,opts_split=False}processorCount::Int#ifdef COMPILER_GHCprocessorCount=numCapabilities#elseprocessorCount=1#endifoptionDescriptions::[OptDescr(CmdlineOptions->CmdlineOptions)]optionDescriptions=[Option['q']["quiet"](NoArg(\o->o{opts_quiet=True}))"only display errors",Option['n']["not"](ReqArg(\so->o{opts_negated=s:(opts_negatedo)})"PATTERN")"tests to exclude",Option['l']["list"](NoArg(\o->o{opts_listTests=True}))"list all matching tests"-- , Option ['j'] ["threads"] (OptArg (\ms o -> o { opts_threads = Just (parseThreads ms) }) "N")-- ("run N tests in parallel, default N=" ++ show processorCount),Option['o']["output-file"](ReqArg(\so->o{opts_outputFile=Justs})"FILE")"name of output file",Option[]["json"](NoArg(\o->o{opts_machineOutput=True}))"output results in machine-readable JSON format",Option[]["split"](NoArg(\o->o{opts_split=True}))"splits results in separate files to avoid file locking (requires -o/--output-file)",Option[]["colors"](ReqArg(\so->o{opts_useColors=Just(parseBools)})"BOOL")"use colors or not",Option['h']["help"](NoArg(\o->o{opts_help=True}))"display this message"]whereparseThreadsNothing=processorCountparseThreads(Justs)=casereadMsofJusti->iNothing->error("invalid number of threads: "++s)parseBools=ifmaptoLowers`elem`["1","true","yes","on"]thenTrueelseFalse{- |
Parse commandline arguments into 'CmdlineOptions'. Here's a synopsis
of the format of the commandline arguments:
> USAGE: COMMAND [OPTION ...] PATTERN ...
>
> where PATTERN is a posix regular expression matching
> the names of the tests to run.
>
> -q --quiet only display errors
> -n PATTERN --not=PATTERN tests to exclude
> -l --list list all matching tests
> -o FILE --output-file=FILE name of output file
> --json output results in machine-readable JSON format
> --split splits results in separate files to avoid file locking (requires -o/--output-file)
> --colors=BOOL use colors or not
> -h --help display this message
-}parseTestArgs::[String]->EitherStringCmdlineOptionsparseTestArgsargs=casegetOptPermuteoptionDescriptionsargsof(optTrans,tests,[])->letposStrs=testsnegStrs=opts_negatedoptspos=mapmkRegexposStrsneg=mapmkRegexnegStrspred(FlatTest_path__)=letflat=flatNamepathinif(any(\s->s`matches`flat)neg)thenFalseelsenullpos||any(\s->s`matches`flat)posopts=(foldr($)defaultCmdlineOptionsoptTrans){opts_filter=pred}incase(opts_outputFileopts,opts_splitopts)of(Nothing,True)->Left("Option --split requires -o or --output-file\n\n"++usageInfousageHeaderoptionDescriptions)_->Rightopts(_,_,errs)->Left(concaterrs++usageInfousageHeaderoptionDescriptions)wherematchesrs=isJust$R.matchRegexrsmkRegexs=R.mkRegexWithOptssTrueFalseusageHeader::StringusageHeader=("USAGE: COMMAND [OPTION ...] PATTERN ...\n\n"++" where PATTERN is a posix regular expression matching\n"++" the names of the tests to run.\n")-- | The string displayed for the @--help@ option.helpString::StringhelpString=usageInfousageHeaderoptionDescriptions---- TestConfig---- | Turn the 'CmdlineOptions' into a 'TestConfig'.testConfigFromCmdlineOptions::CmdlineOptions->IOTestConfigtestConfigFromCmdlineOptionsopts=do(output,colors)<-case(opts_outputFileopts,opts_splitopts)of(Justfname,True)->return(TestOutputSplittedfname,False)_->do(outputHandle,closeOutput,mOutputFd)<-openOutputFilecolors<-checkColorsmOutputFdreturn(TestOutputHandleoutputHandlecloseOutput,colors)setUseColorscolors-- let threads = opts_threads optsletreporters=defaultTestReportersFalse{-(isJust threads)-}(opts_machineOutputopts)return$TestConfig{tc_quiet=opts_quietopts-- , tc_threads = threads,tc_output=output,tc_reporters=reporters,tc_filter=opts_filteropts}where#ifdef mingw32_HOST_OSopenOutputFile=caseopts_outputFileoptsofNothing->return(stdout,False,Nothing)Justfname->dof<-openFilefnameWriteModereturn(f,True,Nothing)checkColorsmOutputFd=caseopts_useColorsoptsofJustb->returnbNothing->returnFalse#elseopenOutputFile=caseopts_outputFileoptsofNothing->return(stdout,False,JuststdOutput)Justfname->dof<-openFilefnameWriteModereturn(f,True,Nothing)checkColorsmOutputFd=caseopts_useColorsoptsofJustb->returnbNothing->domterm<-getEnv"TERM"casemtermofNothing->returnFalseJusts|maptoLowers=="dumb"->returnFalse_->domx<-getEnv"HTF_NO_COLORS"casemxofJusts|maptoLowers`elem`["","1","y","yes","true"]->returnFalse_->casemOutputFdofJustfd->queryTerminalfd_->returnFalse#endif