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

Program PassStats2

The main program contains very little code:

program PassStats2;
  {$APPTYPE CONSOLE}
uses
  SysUtils, Stats;
begin
  Stats.CalcStats('marksheet.csv');
  readln;
end.