{$INCLUDE wst_global.inc} program wst_test_suite; {$DEFINE UseCThreads} uses {$IFDEF UNIX} cthreads, cwstring, {$ENDIF} custapp, classes, sysutils, fpcunit, testreport, testregistry, TestFormatter_unit, testmetadata_unit, server_service_soap, soap_formatter, base_binary_formatter, base_service_intf, base_soap_formatter, binary_formatter, binary_streamer, server_binary_formatter, metadata_repository, metadata_generator, server_service_intf, metadata_wsdl, base_xmlrpc_formatter, wst_fpc_xml, test_utilities, server_service_xmlrpc, test_parsers, wsdl_generator, xsd_generator, xsd_consts, base_json_formatter, wsdl_parser, test_support, basex_encode, test_basex_encode, json_formatter, server_service_json, filter_intf, same_process_protocol, test_json, test_suite_utils, test_generators, test_std_cursors, test_rtti_filter, test_wst_cursors, test_registry, test_soap_specific, test_generators_runtime, test_date_utils, test_filter; Const ShortOpts = 'alh'; Longopts : Array[1..5] of String = ( 'all','list','format:','suite:','help'); Version = 'Version 0.1'; Type TTestRunner = Class(TCustomApplication) private FXMLResultsWriter: TXMLResultsWriter; protected procedure DoRun ; Override; procedure doTestRun(aTest: TTest); virtual; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; end; constructor TTestRunner.Create(AOwner: TComponent); begin inherited Create(AOwner); FXMLResultsWriter := TXMLResultsWriter.Create; end; destructor TTestRunner.Destroy; begin FXMLResultsWriter.Free; end; procedure TTestRunner.doTestRun(aTest: TTest); var testResult: TTestResult; begin testResult := TTestResult.Create; try testResult.AddListener(FXMLResultsWriter); FXMLResultsWriter.WriteHeader; aTest.Run(testResult); FXMLResultsWriter.WriteResult(testResult); finally testResult.Free; end; end; procedure TTestRunner.DoRun; var I : Integer; S : String; begin S:=CheckOptions(ShortOpts,LongOpts); If (S<>'') then Writeln(S); if HasOption('h', 'help') or (ParamCount = 0) then begin writeln(Title); writeln(Version); writeln('Usage: '); writeln('-l or --list to show a list of registered tests'); writeln('default format is xml, add --format=latex to output the list as latex source'); writeln('-a or --all to run all the tests and show the results in xml format'); writeln('The results can be redirected to an xml file,'); writeln('for example: ./testrunner --all > results.xml'); writeln('use --suite=MyTestSuiteName to run only the tests in a single test suite class'); end; if HasOption('l', 'list') then begin if HasOption('format') then begin if GetOptionValue('format') = 'latex' then writeln(GetSuiteAsLatex(GetTestRegistry)) else writeln(GetSuiteAsXML(GetTestRegistry)); end else writeln(GetSuiteAsXML(GetTestRegistry)); end; if HasOption('a', 'all') then begin doTestRun(GetTestRegistry) end else if HasOption('suite') then begin S := ''; S:=GetOptionValue('suite'); if S = '' then for I := 0 to GetTestRegistry.Tests.count - 1 do writeln(GetTestRegistry[i].TestName) else for I := 0 to GetTestRegistry.Tests.count - 1 do if GetTestRegistry[i].TestName = S then begin doTestRun(GetTestRegistry[i]); end; end; Terminate; end; Var App : TTestRunner; begin App:=TTestRunner.Create(Nil); App.Initialize; App.Title := 'FPCUnit Console Test Case runner.'; App.Run; App.Free; end.