Simple benchmarking framework, or how to enumerate published methods in Delphi

The article describes an old trick of enumerating and invoking published methods of a class. The trick is used in DUnit testing framework, and I came to the same idea while trying to bring some order into my benchmark routines.

So the idea was to declare benchmark routines as published methods of a class

type
  TDemoRunner = class(TRunner)
  published
    procedure Proc1;
    procedure Proc2;
  end;

and get these published methods automatically invoked by the framework.

I don’t want to dig into details of the solution because it supposed to be the solution that “just works” without need to dig into internals.

{$M+}
unit Runners;

interface

uses
  SysUtils;

const
  MillisPerDay = 24 * 60 * 60 * 1000;

type
  TBenchProc = procedure of object;

  PMethInfo = ^TMethInfo;
  TMethInfo = record
    Code: Pointer;
    Name: string;
  end;

  TMethArray = array of TMethInfo;

type
  TRunnerClass = class of TRunner;

  TRunner = class
  protected
    FElapsedMs: Integer;
    FMethArray: TMethArray;
    FMethIndex: Integer;
    procedure LogProc; virtual;
    procedure Init; virtual;
    procedure Run; virtual;
  public
    constructor Create; virtual;
    class procedure Exec(AClass: TRunnerClass);
  end;

implementation

{ TRunner }

constructor TRunner.Create;
begin
end;

procedure TRunner.Init;
type
  PMethodTable = ^TMethodTable;
  TMethodTable = packed record
    Count: SmallInt;
    Data: record end;
  end;

  PMethEntry = ^TMethEntry;
  TMethEntry = packed record
    Len: Word;
    Code: Pointer;
    Name: ShortString;
  end;

var
  MethTable: PMethodTable;
  I: Integer;
  Entry: PMethEntry;

begin
  FMethArray:= nil;
  MethTable:= PPointer(PByte(Self.ClassType) + vmtMethodTable)^;
  if (MethTable = nil) or (MethTable.Count <= 0) then Exit;
  Entry:= @MethTable.Data;
  SetLength(FMethArray, MethTable.Count);
  for I:= 0 to MethTable.Count - 1 do begin
    FMethArray[I].Code:= Entry.Code;
    FMethArray[I].Name:= string(Entry.Name);
    Inc(PByte(Entry), Entry.Len);
  end;
end;

procedure TRunner.LogProc;
begin
  Writeln(FMethArray[FMethIndex].Name, ' .. time: ', FElapsedMs, ' ms');
end;

procedure TRunner.Run;
var
  Proc: TBenchProc;
  StartTime: TDateTime;
  I: Integer;

begin
  Init;
  for I:= 0 to Length(FMethArray) - 1 do begin
    TMethod(Proc).Code:= FMethArray[I].Code;
    TMethod(Proc).Data:= Self;
    StartTime:= Now;
    Proc();
    FElapsedMs:= Round((Now - StartTime) * MillisPerDay);
    FMethIndex:= I;
    LogProc;
  end;
end;

class procedure TRunner.Exec(AClass: TRunnerClass);
var
  Instance: TRunner;

begin
  Instance:= AClass.Create;
  try
    Instance.Run;
  finally
    Instance.Free;
  end;
end;

end.

Here is the usage example.

Demo benchmarking class:

unit DemoRunners;

interface

uses Runners;

type
  TDemoRunner = class(TRunner)
  published
    procedure Proc1;
    procedure Proc2;
  end;

implementation

{ TDemoRunner }

procedure TDemoRunner.Proc1;
begin
  Writeln('Running Proc1');
end;

procedure TDemoRunner.Proc2;
begin
  Writeln('Running Proc2');
end;

end.

and benchmarking console application:

program BenchDemo;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Runners in 'Runners.pas',
  DemoRunners in 'DemoRunners.pas';

begin
  try
    TRunner.Exec(TDemoRunner);
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  Readln;
end.

The output: