From 87ef409de2bf6c714513d9c51c93ecea25d54e88 Mon Sep 17 00:00:00 2001 From: vincents Date: Wed, 16 Aug 2006 14:09:55 +0000 Subject: [PATCH] + added support for PlainText result writer from Darius - removed xmlreporter unit, now part of the FCL * console testrunner doesn't need the LCL git-svn-id: trunk@9723 - --- .gitattributes | 2 +- components/fpcunit/fpcunittestrunner.lpk | 25 +-- components/fpcunit/fpcunittestrunner.pas | 2 +- components/fpcunit/guitestrunner.pas | 12 +- components/fpcunit/ide/fpcunitlazideintf.pas | 123 +---------- components/fpcunit/ide/fpcunitproject1.inc | 160 ++++++++++++++ components/fpcunit/xmlreporter.pas | 217 ------------------- 7 files changed, 184 insertions(+), 357 deletions(-) create mode 100644 components/fpcunit/ide/fpcunitproject1.inc delete mode 100644 components/fpcunit/xmlreporter.pas diff --git a/.gitattributes b/.gitattributes index 3cb2ca5ddc..f85d38b2c8 100644 --- a/.gitattributes +++ b/.gitattributes @@ -150,12 +150,12 @@ components/fpcunit/ide/README.txt svneol=native#text/plain components/fpcunit/ide/fpcunitide.lpk svneol=native#text/pascal components/fpcunit/ide/fpcunitide.pas svneol=native#text/pascal components/fpcunit/ide/fpcunitlazideintf.pas svneol=native#text/pascal +components/fpcunit/ide/fpcunitproject1.inc svneol=native#text/plain components/fpcunit/ide/lib/README.txt svneol=native#text/plain components/fpcunit/ide/testcaseopts.lfm svneol=native#text/plain components/fpcunit/ide/testcaseopts.lrs svneol=native#text/pascal components/fpcunit/ide/testcaseopts.pas svneol=native#text/pascal components/fpcunit/lib/README.txt svneol=native#text/plain -components/fpcunit/xmlreporter.pas svneol=native#text/plain components/h2pas/h2pasconfig.pas svneol=native#text/plain components/h2pas/h2pasconvert.pas svneol=native#text/plain components/h2pas/h2pasdlg.lfm svneol=native#text/plain diff --git a/components/fpcunit/fpcunittestrunner.lpk b/components/fpcunit/fpcunittestrunner.lpk index cc4b9cc5c5..4b6c3c9daf 100644 --- a/components/fpcunit/fpcunittestrunner.lpk +++ b/components/fpcunit/fpcunittestrunner.lpk @@ -1,13 +1,15 @@ + + - - + + @@ -20,27 +22,23 @@ - + - - - - - - + + - - + + - + @@ -56,10 +54,11 @@ - + + diff --git a/components/fpcunit/fpcunittestrunner.pas b/components/fpcunit/fpcunittestrunner.pas index c45acc5f69..4b1148cbeb 100644 --- a/components/fpcunit/fpcunittestrunner.pas +++ b/components/fpcunit/fpcunittestrunner.pas @@ -7,7 +7,7 @@ unit FPCUnitTestRunner; interface uses - GuiTestRunner, xmlreporter; + GuiTestRunner; implementation diff --git a/components/fpcunit/guitestrunner.pas b/components/fpcunit/guitestrunner.pas index 6669ab7603..724032df9e 100644 --- a/components/fpcunit/guitestrunner.pas +++ b/components/fpcunit/guitestrunner.pas @@ -24,11 +24,13 @@ unit GuiTestRunner; {$mode objfpc}{$H+} -{ Uncomment this define, to use the old XML output routines. If it is left - commented out, it will use the XMLWrite unit that comes - with FPC. The benefit of using XMLWrite is that it creates valid XML data with - reserved characters escaped and allows for further processing with XSLT etc. } -{.$DEFINE UseOldXML} +{ By default the old XML unit will be used for FPC 2.0.2 and the new XML unit + for any FPC versions above 2.0.2. The benefit of using the new XML unit is + that it creates valid XML data with reserved characters escaped and allows + for further processing with XSLT etc. } +{$IFDEF VER2_0_2} + {$DEFINE UseOldXML} +{$ENDIF} interface diff --git a/components/fpcunit/ide/fpcunitlazideintf.pas b/components/fpcunit/ide/fpcunitlazideintf.pas index 7b7edbd6f5..8adaad700d 100644 --- a/components/fpcunit/ide/fpcunitlazideintf.pas +++ b/components/fpcunit/ide/fpcunitlazideintf.pas @@ -328,7 +328,6 @@ end; function TFPCUnitConsoleApplicationDescriptor.InitProject( AProject: TLazProject): TModalResult; var - le: string; NewSource: string; MainFile: TLazProjectFile; begin @@ -340,128 +339,12 @@ begin AProject.MainFileID:=0; // create program source - le:=LineEnding; - NewSource:='program FPCUnitProject1;'+le - +le - +'{$mode objfpc}{$H+}'+le - +le - +'uses'+le - +' custapp, classes, sysutils, fpcunit, testreport, testregistry;'+le - +le - +'Const'+le - +' ShortOpts = ''alh'';'+le - +' Longopts : Array[1..5] of String = ('+le - +' ''all'',''list'',''format:'',''suite:'',''help'');'+le - +' Version = ''Version 0.1'';'+le - +le - +'Type'+le - +' TTestRunner = Class(TCustomApplication)'+le - +' private'+le - +' FXMLResultsWriter: TXMLResultsWriter;'+le - +' protected'+le - +' procedure DoRun ; Override;'+le - +' procedure doTestRun(aTest: TTest); virtual;'+le - +' public'+le - +' constructor Create(AOwner: TComponent); override;'+le - +' destructor Destroy; override;'+le - +' end;'+le - +le - +'constructor TTestRunner.Create(AOwner: TComponent);'+le - +'begin'+le - +' inherited Create(AOwner);'+le - +' FXMLResultsWriter := TXMLResultsWriter.Create;'+le - +'end;'+le - +le - +'destructor TTestRunner.Destroy;'+le - +'begin'+le - +' FXMLResultsWriter.Free;'+le - +'end;'+le - +le - +'procedure TTestRunner.doTestRun(aTest: TTest);'+le - +'var'+le - +' testResult: TTestResult;'+le - +'begin'+le - +' testResult := TTestResult.Create;'+le - +' try'+le - +' testResult.AddListener(FXMLResultsWriter);'+le - +' FXMLResultsWriter.WriteHeader;'+le - +' aTest.Run(testResult);'+le - +' FXMLResultsWriter.WriteResult(testResult);'+le - +' finally'+le - +' testResult.Free;'+le - +' end;'+le - +'end;'+le - +le - +'procedure TTestRunner.DoRun;'+le - +'var'+le - +' I : Integer;'+le - +' S : String;'+le - +'begin'+le - +' S:=CheckOptions(ShortOpts,LongOpts);'+le - +' If (S<>'''') then'+le - +' Writeln(S);'+le - +' if HasOption(''h'', ''help'') or (ParamCount = 0) then'+le - +' begin'+le - +' writeln(Title);'+le - +' writeln(Version);'+le - +' writeln(''Usage: '');'+le - +' writeln(''-l or --list to show a list of registered tests'');'+le - +' writeln(''default format is xml, add --format=latex to output the list as latex source'');'+le - +' writeln(''-a or --all to run all the tests and show the results in xml format'');'+le - +' writeln(''The results can be redirected to an xml file,'');'+le - +' writeln(''for example: ./testrunner --all > results.xml'');'+le - +' writeln(''use --suite=MyTestSuiteName to run only the tests in a single test suite class'');'+le - +' end;'+le - +' if HasOption(''l'', ''list'') then'+le - +' begin'+le - +' if HasOption(''format'') then'+le - +' begin'+le - +' if GetOptionValue(''format'') = ''latex'' then'+le - +' writeln(GetSuiteAsLatex(GetTestRegistry))'+le - +' else'+le - +' writeln(GetSuiteAsXML(GetTestRegistry));'+le - +' end'+le - +' else'+le - +' writeln(GetSuiteAsXML(GetTestRegistry));'+le - +' end;'+le - +' if HasOption(''a'', ''all'') then'+le - +' begin'+le - +' doTestRun(GetTestRegistry)'+le - +' end'+le - +' else'+le - +' if HasOption(''suite'') then'+le - +' begin'+le - +' S := '''';'+le - +' S:=GetOptionValue(''suite'');'+le - +' if S = '''' then'+le - +' for I := 0 to GetTestRegistry.Tests.count - 1 do'+le - +' writeln(GetTestRegistry[i].TestName)'+le - +' else'+le - +' for I := 0 to GetTestRegistry.Tests.count - 1 do'+le - +' if GetTestRegistry[i].TestName = S then'+le - +' begin'+le - +' doTestRun(GetTestRegistry[i]);'+le - +' end;'+le - +' end;'+le - +' Terminate;'+le - +'end;'+le - +le - +'Var'+le - +' App : TTestRunner;'+le - +le - +'begin'+le - +' App:=TTestRunner.Create(Nil);'+le - +' App.Initialize;'+le - +' App.Title := ''FPCUnit Console Test Case runner.'';'+le - +' App.Run;'+le - +' App.Free;'+le - +'end.'+le - +le; + {$i fpcunitproject1.inc} + AProject.MainFile.SetSourceText(NewSource); - // add + // add FCL dependency AProject.AddPackageDependency('FCL'); - AProject.AddPackageDependency('FPCUnitTestRunner'); // compiler options AProject.LazCompilerOptions.UseLineInfoUnit:=true; diff --git a/components/fpcunit/ide/fpcunitproject1.inc b/components/fpcunit/ide/fpcunitproject1.inc new file mode 100644 index 0000000000..f42458813c --- /dev/null +++ b/components/fpcunit/ide/fpcunitproject1.inc @@ -0,0 +1,160 @@ +NewSource := + 'program FPCUnitProject1;' + #13 + + #13 + + '{$mode objfpc}{$H+}' + #13 + + #13 + + 'uses' + #13 + + ' custapp, Classes, SysUtils, fpcunit, testreport, testregistry;' + #13 + + #13 + + 'const' + #13 + + ' ShortOpts = ''alh'';' + #13 + + ' Longopts: array[1..5] of string = (''all'', ''list'', ''format:'', ''suite:'', ''help'');' + #13 + + ' Version = ''Version 0.1'';' + #13 + + #13 + + 'type' + #13 + + ' TFormat = (fPlain, fLatex, fXML);' + #13 + + #13 + + ' TTestRunner = class(TCustomApplication)' + #13 + + ' private' + #13 + + ' protected' + #13 + + ' procedure DoRun; override;' + #13 + + ' procedure doTestRun(aTest: TTest); virtual;' + #13 + + ' public' + #13 + + ' end;' + #13 + + #13 + + 'var' + #13 + + ' FormatParam: TFormat;' + #13 + + #13 + + ' procedure TTestRunner.doTestRun(aTest: TTest);' + #13 + + ' var' + #13 + + ' testResult: TTestResult;' + #13 + + #13 + + ' procedure doXMLTestRun(aText: TTest);' + #13 + + ' var' + #13 + + ' XMLResultsWriter: TXMLResultsWriter;' + #13 + + ' begin' + #13 + + ' try' + #13 + + ' XMLResultsWriter := TXMLResultsWriter.Create;' + #13 + + ' testResult.AddListener(XMLResultsWriter);' + #13 + + ' XMLResultsWriter.WriteHeader;' + #13 + + ' aTest.Run(testResult);' + #13 + + ' XMLResultsWriter.WriteResult(testResult);' + #13 + + ' finally' + #13 + + ' XMLResultsWriter.Free;' + #13 + + ' testResult.Free;' + #13 + + ' end;' + #13 + + ' end;' + #13 + + #13 + + ' {$IFNDEF VER2_0}' + #13 + + ' procedure doPlainTestRun(aText: TTest);' + #13 + + ' var' + #13 + + ' PlainResultsWriter: TPlainResultsWriter;' + #13 + + ' begin' + #13 + + ' try' + #13 + + ' PlainResultsWriter := TPlainResultsWriter.Create;' + #13 + + ' testResult.AddListener(PlainResultsWriter);' + #13 + + ' PlainResultsWriter.WriteHeader;' + #13 + + ' aTest.Run(testResult);' + #13 + + ' PlainResultsWriter.WriteResult(testResult);' + #13 + + ' finally' + #13 + + ' PlainResultsWriter.Free;' + #13 + + ' testResult.Free;' + #13 + + ' end;' + #13 + + ' end;' + #13 + + ' {$ENDIF}' + #13 + + #13 + + ' begin' + #13 + + ' testResult := TTestResult.Create;' + #13 + + #13 + + ' case FormatParam of' + #13 + + ' fLatex: doXMLTestRun(aTest); //no latex implemented yet' + #13 + + ' {$IFNDEF VER2_0}' + #13 + + ' fPlain: doPlainTestRun(aTest);' + #13 + + ' {$ENDIF}' + #13 + + ' else' + #13 + + ' doXMLTestRun(aTest);' + #13 + + ' end;' + #13 + + ' end;' + #13 + + #13 + + ' procedure TTestRunner.DoRun;' + #13 + + ' var' + #13 + + ' I: integer;' + #13 + + ' S: string;' + #13 + + ' begin' + #13 + + ' S := CheckOptions(ShortOpts, LongOpts);' + #13 + + ' if (S <> '''') then' + #13 + + ' Writeln(S);' + #13 + + #13 + + ' if HasOption(''h'', ''help'') or (ParamCount = 0) then' + #13 + + ' begin' + #13 + + ' writeln(Title);' + #13 + + ' writeln(Version);' + #13 + + ' writeln;' + #13 + + ' writeln(''Usage: '');' + #13 + + ' writeln('' --format=latex output as latex source (only list implemented)'');' + #13 + + ' {$IFNDEF VER2_0}' + #13 + + ' writeln('' --format=plain output as plain ASCII source'');' + #13 + + ' {$ENDIF}' + #13 + + ' writeln('' --format=xml output as XML source (default)'');' + #13 + + ' writeln;' + #13 + + ' writeln('' -l or --list show a list of registered tests'');' + #13 + + ' writeln('' -a or --all run all tests'');' + #13 + + ' writeln('' --suite=MyTestSuiteName run single test suite class'');' + #13 + + ' writeln;' + #13 + + ' writeln(''The results can be redirected to an xml file,'');' + #13 + + ' writeln(''for example: ./testrunner --all > results.xml'');' + #13 + + ' end;' + #13 + + #13 + + ' //get the format parameter' + #13 + + ' FormatParam := fXML;' + #13 + + ' if HasOption(''format'') then' + #13 + + ' begin' + #13 + + ' if GetOptionValue(''format'') = ''latex'' then' + #13 + + ' FormatParam := fLatex;' + #13 + + ' {$IFNDEF VER2_0}' + #13 + + ' if GetOptionValue(''format'') = ''plain'' then' + #13 + + ' FormatParam := fPlain;' + #13 + + ' {$ENDIF}' + #13 + + ' end;' + #13 + + #13 + + ' //get a list of all registed tests' + #13 + + ' if HasOption(''l'', ''list'') then' + #13 + + ' case FormatParam of' + #13 + + ' fLatex: Write(GetSuiteAsLatex(GetTestRegistry));' + #13 + + ' {$IFNDEF VER2_0}' + #13 + + ' fPlain: Write(GetSuiteAsPlain(GetTestRegistry));' + #13 + + ' {$ENDIF}' + #13 + + ' else' + #13 + + ' Write(GetSuiteAsXML(GetTestRegistry));' + #13 + + ' end;' + #13 + + #13 + + ' //run the tests' + #13 + + ' if HasOption(''a'', ''all'') then' + #13 + + ' doTestRun(GetTestRegistry)' + #13 + + ' else' + #13 + + ' if HasOption(''suite'') then' + #13 + + ' begin' + #13 + + ' S := '''';' + #13 + + ' S := GetOptionValue(''suite'');' + #13 + + ' if S = '''' then' + #13 + + ' for I := 0 to GetTestRegistry.Tests.Count - 1 do' + #13 + + ' writeln(GetTestRegistry[i].TestName)' + #13 + + ' else' + #13 + + ' for I := 0 to GetTestRegistry.Tests.Count - 1 do' + #13 + + ' if GetTestRegistry[i].TestName = S then' + #13 + + ' doTestRun(GetTestRegistry[i]);' + #13 + + ' end;' + #13 + + ' Terminate;' + #13 + + ' end;' + #13 + + #13 + + 'var' + #13 + + ' App: TTestRunner;' + #13 + + #13 + + 'begin' + #13 + + ' App := TTestRunner.Create(nil);' + #13 + + ' App.Initialize;' + #13 + + ' App.Title := ''FPCUnit Console Test Case runner.'';' + #13 + + ' App.Run;' + #13 + + ' App.Free;' + #13 + + 'end.' + #13 +; diff --git a/components/fpcunit/xmlreporter.pas b/components/fpcunit/xmlreporter.pas deleted file mode 100644 index 5c5d3eb3f0..0000000000 --- a/components/fpcunit/xmlreporter.pas +++ /dev/null @@ -1,217 +0,0 @@ -{ - Copyright (C) 2006 Graeme Geldenhuys - - This source is free software; you can redistribute it and/or modify it under - the terms of the GNU General Public License as published by the Free - Software Foundation; either version 2 of the License, or (at your option) - any later version. - - This code 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 General Public License for more - details. - - A copy of the GNU General Public License is available on the World Wide Web - at . You can also obtain it by writing - to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, - MA 02111-1307, USA. - - - Purpose: - This unit contains a XML TestListener for use with the fpcUnit testing - framework. It uses the XMLWrite unit, which is part of FPC, to generate - the XML document. The benefit of using the XMLWrite unit, is that the - data generated is valid XML, with resevered characters correctly escaped. - This allows the XML document to be further processed with XSTL etc without - any issues. - - Note: - This unit will possibly move at a later stage to the FPC repository. - It can't now (pre FPC 2.0.3) otherwise nobody will be able to use the new - XML funtionality in the GUITestRunner. -} - -unit xmlreporter; - -{$mode objfpc}{$H+} - -interface -uses - Classes - ,SysUtils - ,fpcUnit - ,TestUtils - ,dom - ,XMLWrite - ; - - -type - { XML Test Listner } - TXMLResultsWriter = class(TNoRefCountObject, ITestListener) - private - FDoc: TXMLDocument; - { These TDOMNodes are for easy access and a bit of optimization } - FResults: TDOMNode; - FListing: TDOMNode; - FFailures: TDOMNode; - FErrors: TDOMNode; - { Converts the actual test results into XML nodes. This gets called - by the public method WriteResult. } - procedure TestResultAsXML(pTestResult: TTestResult); - { This gets called in the class constructor and sets up the starting nodes } - procedure WriteHeader; - public - constructor Create; - destructor Destroy; override; - procedure WriteResult(aResult: TTestResult); - - { ITestListener interface requirements } - procedure AddFailure(ATest: TTest; AFailure: TTestFailure); - procedure AddError(ATest: TTest; AError: TTestFailure); - procedure StartTest(ATest: TTest); - procedure EndTest(ATest: TTest); - - { A public property to the internal XML document } - property Document: TXMLDocument read FDoc; - end; - - -implementation - - -{ TXMLResultsWriter } - -procedure TXMLResultsWriter.TestResultAsXML(pTestResult: TTestResult); -var - i: longint; - n, lResults: TDOMNode; -begin - lResults := FDoc.FindNode('TestResults'); - n := FDoc.CreateElement('NumberOfRunnedTests'); - n.AppendChild(FDoc.CreateTextNode(IntToStr(pTestResult.RunTests))); - lResults.AppendChild(n); - - n := FDoc.CreateElement('NumberOfErrors'); - n.AppendChild(FDoc.CreateTextNode(IntToStr(pTestResult.NumberOfErrors))); - lResults.AppendChild(n); - - n := FDoc.CreateElement('NumberOfFailures'); - n.AppendChild(FDoc.CreateTextNode(IntToStr(pTestResult.NumberOfFailures))); - lResults.AppendChild(n); - - if pTestResult.NumberOfErrors <> 0 then - begin - for i := 0 to pTestResult.Errors.Count - 1 do - AddError(nil, TTestFailure(pTestResult.Errors.Items[i])); - end; - - if pTestResult.NumberOfFailures <> 0 then - begin - for i := 0 to pTestResult.Failures.Count - 1 do - AddFailure(nil, TTestFailure(pTestResult.Failures.Items[i])); - end; -end; - - -procedure TXMLResultsWriter.WriteHeader; -begin - FResults := FDoc.CreateElement('TestResults'); - FResults.AppendChild(FDoc.CreateComment(' Generated using FPCUnit on ' - + FormatDateTime('yyyy-mm-dd hh:mm ', Now) )); - FDoc.AppendChild(FResults); - FListing := FDoc.CreateElement('TestListing'); - FResults.AppendChild(FListing); -end; - - -constructor TXMLResultsWriter.Create; -begin - FDoc := TXMLDocument.Create; - FResults := nil; - FFailures := nil; - FErrors := nil; - WriteHeader; -end; - - -destructor TXMLResultsWriter.Destroy; -begin - FDoc.Free; - inherited Destroy; -end; - - -procedure TXMLResultsWriter.WriteResult(aResult: TTestResult); -begin - TestResultAsXML(aResult); -end; - - -procedure TXMLResultsWriter.AddFailure(ATest: TTest; AFailure: TTestFailure); -var - n: TDOMElement; -begin - { Try and find the node first } - if not Assigned(FFailures) then - FFailures := FDoc.FindNode('ListOfFailures'); - { If we couldn't find it, create it } - if not Assigned(FFailures) then - begin - FFailures := FDoc.CreateElement('ListOfFailures'); - FResults.AppendChild(FFailures); - end; - - n := FDoc.CreateElement('Failure'); - n.AppendChild(FDoc.CreateElement('Message') ).AppendChild(FDoc.CreateTextNode(AFailure.AsString)); - n.AppendChild(FDoc.CreateElement('ExceptionClass') ).AppendChild(FDoc.CreateTextNode(AFailure.ExceptionClassName)); - n.AppendChild(FDoc.CreateElement('ExceptionMessage')).AppendChild(FDoc.CreateTextNode(AFailure.ExceptionMessage)); - FFailures.AppendChild(n); -end; - - -procedure TXMLResultsWriter.AddError(ATest: TTest; AError: TTestFailure); -var - n: TDOMElement; -begin - { Try and find the node first } - if not Assigned(FErrors) then - FErrors := FDoc.FindNode('ListOfErrors'); - { If we couldn't find it, create it } - if not Assigned(FErrors) then - begin - FErrors := FDoc.CreateElement('ListOfErrors'); - FResults.AppendChild(FErrors); - end; - - n := FDoc.CreateElement('Error'); - n.AppendChild(FDoc.CreateElement('Message') ).AppendChild(FDoc.CreateTextNode(AError.AsString)); - n.AppendChild(FDoc.CreateElement('ExceptionClass') ).AppendChild(FDoc.CreateTextNode(AError.ExceptionClassName)); - n.AppendChild(FDoc.CreateElement('ExceptionMessage')).AppendChild(FDoc.CreateTextNode(AError.ExceptionMessage)); - n.AppendChild(FDoc.CreateElement('SourceUnitName') ).AppendChild(FDoc.CreateTextNode(AError.SourceUnitName)); - n.AppendChild(FDoc.CreateElement('LineNumber') ).AppendChild(FDoc.CreateTextNode(IntToStr(AError.LineNumber))); - n.AppendChild(FDoc.CreateElement('FailedMethodName')).AppendChild(FDoc.CreateTextNode(AError.FailedMethodName)); - FErrors.AppendChild(n); -end; - - -procedure TXMLResultsWriter.StartTest(ATest: TTest); -var - n: TDOMElement; -begin - if not Assigned(FListing) then - exit; - n := FDoc.CreateElement('Test'); - n['Name'] := ATest.TestSuiteName + '.' + ATest.TestName; - FListing.AppendChild(n); -end; - - -procedure TXMLResultsWriter.EndTest(ATest: TTest); -begin - { do nothing } -end; - - -end. -