Automated Testing using TestRunner
You should be familiar with the material in our tutorial entitled Object-Oriented Pascal before studying this section. We have put procedure CalcStats into its own unit (Stat) together with the global variables that it uses. We put the global variables into the interface section so that they can be accessed if necessary by the testing code in another unit.
The code of the main program is almost the same as that of TestRunner built into Lazarus. (We changed only the name and the uses section).
program TestStats2; { This file is part of the Free Component Library (FCL) Copyright (c) 2004 by Dean Zobec, Michael Van Canneyt an example of a console test runner of FPCUnit tests. See the file COPYING.FPC, included in this distribution, for details about the copyright. This program 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. } {$mode objfpc} {$h+} uses custapp, Classes, SysUtils, fpcunit, testreport, testregistry, TestCases1; //Add any other units of test cases here const ShortOpts = 'alh'; Longopts: Array[1..5] of String = ( 'all','list','format:','suite:','help'); Version = 'Version 0.2'; 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); 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 else; 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; readln; end.
Unit Testcases1
Unit Testcases1 requires each test to be in the published section. AssertEquals generates an exception if the second and third arguments are not equal. This exception generates an error message which includes the text of the first argument.
unit TestCases1; interface uses fpcunit, testregistry, Stats; type TTestCases1 = Class(TTestCase) published procedure Test1; procedure Test2; procedure Test3; procedure Test4; procedure Test5; procedure Test6; procedure Test7; end; implementation uses Sysutils, StrUtils; procedure TTestCases1.Test1; begin Stats.CalcStats('t1.csv'); AssertEquals('WRONG ERROR MESSAGE - ', 1, intError); end; procedure TTestCases1.Test2; begin Stats.CalcStats('t2.csv'); AssertEquals('WRONG ERROR MESSAGE - ', 2, intError); end; procedure TTestCases1.Test3; var f : text; strLine : string; begin Stats.CalcStats('t3.csv'); assignfile(f, 'results.csv'); reset(f); readln(f, strLine); strLine := RightStr(strLine, 1); AssertEquals('WRONG ERROR MESSAGE 1 - ', 5, strToInt(strLine)); readln(f, strLine); strLine := RightStr(strLine, 1); AssertEquals('WRONG ERROR MESSAGE 2 - ', 5, strToInt(strLine)); readln(f, strLine); strLine := RightStr(strLine, 1); AssertEquals('WRONG ERROR MESSAGE 3 - ', 3, strToInt(strLine)); readln(f, strLine); strLine := RightStr(strLine, 1); AssertEquals('WRONG ERROR MESSAGE 4 -3 ', 6, strToInt(strLine)); readln(f, strLine); strLine := RightStr(strLine, 1); AssertEquals('WRONG ERROR MESSAGE 5 - ', 6, strToInt(strLine)); readln(f, strLine); strLine := RightStr(strLine, 1); AssertEquals('WRONG ERROR MESSAGE 6 - ', 3, strToInt(strLine)); readln(f, strLine); strLine := RightStr(strLine, 1); AssertEquals('WRONG ERROR MESSAGE 7 - ', 3, strToInt(strLine)); closeFile(f); end; procedure TTestCases1.Test4; begin Stats.CalcStats('t4.csv'); AssertEquals('WRONG ERROR MESSAGE - ', 4, intError); end; procedure TTestCases1.Test5; begin Stats.CalcStats('t5.csv'); AssertEquals('WRONG male result - ', 'NoMales', strMalePassRate); AssertEquals('WRONG female result - ', '66.67', strFemalePassRate); end; procedure TTestCases1.Test6; begin Stats.CalcStats('t6.csv'); AssertEquals('WRONG male result - ', '66.67', strMalePassRate); AssertEquals('WRONG female result - ', 'NoFemales', strFemalePassRate); end; procedure TTestCases1.Test7; begin Stats.CalcStats('t7.csv'); AssertEquals('WRONG male result - ', '75.56', strMalePassRate); AssertEquals('WRONG female result - ', '78.18', strFemalePassRate); end; initialization RegisterTest(TTestCases1); end.
Unit Stats
We have placed procedure CalcStats in the implementation section of unit Stats. The procedure must be declared in the interface section so that it can be called from other units. Similarly, we have declared variables in the interface section so that test procedures can access them if necessary. The output of the test program follows this code.
unit Stats; interface const PASSMARK = 40; ERROR_MESSAGES : array [0..6] of string = ('', 'File not found', 'File empty', 'Comma should follow letter', 'First letter must be M or F', 'Mark must be between 0 and 100 inclusive', 'An integer must be after the comma'); var intCurrentScore, intMales, intFemales, intMalePasses, intFemalePasses, intLine, intError, intCount : integer; strCurrentScore, strMalePassRate, strFemalepassRate : string; charCurrentGender : char; rMalePassRate, rFemalePassRate : real; ErrorFound : Boolean; procedure CalcStats(strMarksFile : string); implementation uses SysUtils, StrUtils; procedure CalcStats(strMarksFile : string); var Marks, Results : Text; strCurrentLine : string; CommaPos, ErrorCode : integer; procedure OutPutError; begin ErrorFound := True; write(ERROR_MESSAGES[intError]); writeln(Results, 'error' + ',' + intToStr(intError)); if intLine = 0 then writeln else writeln(' at line ', intLine); end; //nested proc begin intError := 0; intLine := 0; assignFile(Results, 'results.csv'); rewrite(Results); if not fileExists(strMarksFile) then begin intError := 1; OutPutError; end else begin intMales := 0; intFemales := 0; intMalePasses :=0; intFemalepasses := 0; intCurrentScore := 0; ErrorFound := False; assignFile(Marks, strMarksFile); reset(Marks); if eof(Marks) then begin intError := 2; OutPutError; end else begin while not eof(Marks) do begin repeat readln(Marks, strCurrentLine); inc(intLine); until ((strCurrentLine <> ',') and (strCurrentLine <> '')) or eof(Marks); //Blank line or comma may be at the end of the file if not ((strCurrentLine = '') or (strcurrentline = ',')) then begin CommaPos := pos(',', strCurrentline); if (CommaPos <> 2) then begin intError := 3; //Comma should follow letter OutPutError; end else begin charCurrentGender := LeftStr(strCurrentLine, 1)[1]; charCurrentGender := UpCase(charCurrentGender); if not (charCurrentGender in ['M', 'F']) then begin intError := 4; OutPutError; end else begin strCurrentScore := rightStr(strCurrentLine, length(strCurrentLine) - 2); val(strCurrentScore, intCurrentScore, ErrorCode); if not (ErrorCode = 0) then begin intError := 6; OutPutError; end else begin if (intCurrentScore < 0) or (intCurrentScore > 100) then begin intError := 5; OutPutError; end else //no error detected begin if charCurrentGender = 'M' then begin inc(intMales); if intCurrentscore >= PASSMARK then inc(intMalePasses); end else //females begin inc(intFemales); if intCurrentscore >= PASSMARK then inc(intFemalePasses); end; end; //if (intCurrentScore < 0) or (intCurrentScore > 100) end; //if not (ErrorCode = 0) end; //if not (charCurrentGender in ['M', 'F']) end; //if CommaPos <> 2 end;//if strcurrentLine not a space or comma end; //while if not ErrorFound then begin if intMales = 0 then begin writeln('No males'); strMalePassRate := 'NoMales'; end else begin rMalePassRate := intMalePasses * 100 / intMales; strMalePassRate := FloatToStrf(rMalePassRate, ffFixed, 6, 2); writeln('Male Pass Rate (%): ', strMalePassRate); end; if intFemales = 0 then begin writeln('No females'); strFemalePassRate := 'NoFemales'; end else begin rFemalePassRate := intFemalePasses * 100 / intFemales; strFemalePassRate := FloatToStrf(rFemalePassRate, ffFixed, 6, 2); writeln('Female Pass Rate (%): ', strFemalePassRate); end; writeln(Results, strMalePassRate + ',' + strFemalePassRate); end; //if not ErrorFound end; //if eof(Marks) end; //if not fileExists(FileName) closeFile(Results); if fileExists(strMarksFile) then closeFile(Marks); end; end.

Output
- Type F:\Demo\TestStats2 -a at the command prompt
- Create a shortcut and append the parameters to the Target in the properties window:
Shortcut properties
- Type the command in the edit box at the bottom of the window opened with the Start button:
Start window
Program PassStats2
The main program contains very little code:
program PassStats2; {$APPTYPE CONSOLE} uses SysUtils, Stats; begin Stats.CalcStats('marksheet.csv'); readln; end.