Snippets

Stefan Glienke TManagedObject speed test

Created by Stefan Glienke
program ManagedObjectSpeedTest;

{$APPTYPE CONSOLE}

uses
  Classes,
  Diagnostics,
  SysUtils,
  Mitov.Attributes, Mitov.Types,
  Spring;

type
  TCompiledFoo = class
  private
    fCount: Integer;
    fCount2: Integer;
    fCount3: Integer;
    fStrings: TStrings;
    fIntf: IInterface;
  public
    constructor Create;
    destructor Destroy; override;

    property Count: Integer read fCount;
    property Count2: Integer read fCount2;
    property Count3: Integer read fCount3;
    property Strings: TStrings read fStrings;
    property Intf: IInterface read fIntf;
  end;

  TSpringFoo = class(TManagedObject)
  private
    [Default(42)]
    fCount: Integer;

    [Default(42)]
    fCount2: Integer;

    [Default(42)]
    fCount3: Integer;

    [Managed(TStringList)]
    fStrings: TStrings;

    [Managed(TInterfacedObject)]
    fIntf: IInterface;
  public
    property Count: Integer read fCount;
    property Count2: Integer read fCount2;
    property Count3: Integer read fCount3;
    property Strings: TStrings read fStrings;
    property Intf: IInterface read fIntf;
  end;

  TMitovFoo = class(TBasicObject)
  private
    [Default(42)]
    fCount: Integer;

    [Default(42)]
    fCount2: Integer;

    [Default(42)]
    fCount3: Integer;

    [AutoManage(TStringList)]
    fStrings: TStrings;

    [AutoManage(TInterfacedObject)]
    fIntf: IInterface;
  public
    property Count: Integer read fCount;
    property Count2: Integer read fCount2;
    property Count3: Integer read fCount3;
    property Strings: TStrings read fStrings;
    property Intf: IInterface read fIntf;
  end;

{ TCompiledFoo }

constructor TCompiledFoo.Create;
begin
  inherited Create;
  fCount := 42;
  fCount2 := 42;
  fCount3 := 42;
  fStrings := TStringList.Create;
  fIntf := TInterfacedObject.Create;
end;

destructor TCompiledFoo.Destroy;
begin
  fStrings.Free;
  inherited;
end;

const
  MAXCOUNT = 10000;
  THREADCOUNT = 1;

type
  Test = record
    class procedure Run<T: class, constructor>; static;
  end;

class procedure Test.Run<T>;
var
  sw: TStopwatch;
  threads: array[1..THREADCOUNT] of TThread;
  i: Integer;
begin
  for i := 1 to THREADCOUNT do
  begin
    threads[i] := TThread.CreateAnonymousThread(
      procedure
      var
        i: Integer;
        o: T;
      begin
        for i := 1 to MAXCOUNT do
        begin
          o := T.Create;
          o.Free;
        end;
      end);
    threads[i].FreeOnTerminate := False;
  end;

  sw := TStopwatch.StartNew;
  for i := 1 to THREADCOUNT do
    threads[i].Start;

  for i := 1 to THREADCOUNT do
  begin
    threads[i].WaitFor;
    threads[i].Free;
  end;

  Writeln(T.ClassName, ': ', sw.ElapsedMilliseconds, ' ms');
end;

begin
  try
    Writeln('testing creating and destroying ', MAXCOUNT, ' instances in ', THREADCOUNT, ' threads');
    Writeln;
    Test.Run<TCompiledFoo>;
    Test.Run<TSpringFoo>;
    Test.Run<TMitovFoo>;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  ReportMemoryLeaksOnShutdown := True;
  Readln;
end.

Comments (0)

HTTPS SSH

You can clone a snippet to your computer for local editing. Learn more.