mORMot Open Source

program Project1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  System.Math,
  Mormot.core.collections;

type
  TTestRecord = record
    Test: Integer;
  end;

function SomeComparer(const Item1, Item2): Integer;
begin
  Result:=CompareValue(TTestRecord(Item1).Test,TTestRecord(Item2).Test);
end;

var
  ListUnderTest: IList<TTestRecord>;
begin
  try
    ListUnderTest:=Collections.NewPlainList<TTestRecord>([]);
    ListUnderTest.Comparer:=SomeComparer;

    var RecA:=Default(TTestRecord);
    RecA.Test:=321;
    var RecB:=Default(TTestRecord);
    RecB.Test:=123;

    ListUnderTest.AddSorted(RecA);
    ListUnderTest.AddSorted(RecB);

    for var LoopRec in ListUnderTest do
    begin
      Writeln(LoopRec.Test);
    end;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;

  readln;
end.

EIList: TIList<Project1.TTestRecord>.AddSorted() is not allowed  with loCreateUniqueIndex: use Add()

function TIListParent.DoAddSorted(const value; wasadded: PBoolean): integer;
begin
  if fHasher = nil then // << this check don't consider the compare function
    raise EIList.CreateUtf8('%.AddSorted() is not allowed  with ' +
      'loCreateUniqueIndex: use Add()', [self]);
  result := fDynArray.FastLocateOrAddSorted(value, wasadded);
end;

function TIListParent.DoAddSorted(const value; wasadded: PBoolean): integer;
begin
  if (fHasher = nil) and (@fDynArray.compare = nil) then // << consider also the compare function
    raise EIList.CreateUtf8('%.AddSorted() is not allowed  with ' +
      'loCreateUniqueIndex: use Add()', [self]);
  result := fDynArray.FastLocateOrAddSorted(value, wasadded);
end;

program SpringVsMormotCollections;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  System.Diagnostics,

  mormot.core.collections,

  Spring,
  Spring.Collections;

{ ----------------------------------------------------------------------- }

type

  TBenchmarks = class
   private
    function CreateTestListString(ACount: Integer; const APrefix: String): TArray<String>;
    procedure RunBenchmark(const AProc: TProc; ABenchmarkRounds: Integer);
    procedure ListBenchmark;
    procedure DictBenchmark;
   public
    procedure Run;
  end;

{ ======================================================================= }
{ TBenchmarks                                                             }
{ ======================================================================= }

function TBenchmarks.CreateTestListString(ACount: Integer; const APrefix: String): TArray<String>;
begin
  SetLength(Result, ACount);
  for var Loop:=0 to ACount-1
    do Result[Loop]:=APrefix+' #'+IntToStr(Loop+1);
end;

{ ----------------------------------------------------------------------- }

procedure TBenchmarks.DictBenchmark;
const
  BenchRounds = 100;
begin
  var TestKeys:=CreateTestListString(100000,'Key');
  var TestValues:=CreateTestListString(100000,'Value');

  var MormotDict:=Collections.NewKeyValue<String,String>;
  var SpringDict:=TCollections.CreateDictionary<String,String>;

  Writeln(Format('Populate MormotDict with %d items...',[Length(TestKeys)]));
  RunBenchmark(
    procedure
    begin
      MormotDict.Clear;
      for var Loop:=0 to Length(TestKeys)-1
        do MormotDict.Add(TestKeys[Loop],TestValues[Loop]);
    end,BenchRounds);

  Writeln(Format('Populate SpringDict with %d items...',[Length(TestKeys)]));
  RunBenchmark(
    procedure
    begin
      SpringDict.Clear;
      for var Loop:=0 to Length(TestKeys)-1
        do SpringDict.Add(TestKeys[Loop],TestValues[Loop]);
    end,BenchRounds);

  Writeln('Compare MormotDict with SpringDict...');
  RunBenchmark(
    procedure
    var
      CurKey        : String;
      CurMormotValue: String;
      CurSpringValue: String;
    begin
      for var Loop:=0 to Length(TestKeys)-1 do
      begin
        CurKey:=TestKeys[Loop];
        if not
          (
            MormotDict.TryGetValue(CurKey,CurMormotValue) and
            SpringDict.TryGetValue(CurKey,CurSpringValue) and
            (CurMormotValue=CurSpringValue)
          )
          then raise Exception.Create('Different content!');
      end;
    end,BenchRounds);

  Writeln('Iterate MormotDict by key (TryGetValue)...');
  RunBenchmark(
    procedure
    var
      CurKey  : String;
      CurValue: String;
    begin
      for var Loop:=0 to Length(TestKeys)-1 do
      begin
        CurKey:=TestKeys[Loop];
        if not MormotDict.TryGetValue(CurKey,CurValue)
          then raise Exception.Create('Something is wrong!');
      end;
    end,BenchRounds);

  Writeln('Iterate SpringDict by key (TryGetValue)...');
  RunBenchmark(
    procedure
    var
      CurKey  : String;
      CurValue: String;
    begin
      for var Loop:=0 to Length(TestKeys)-1 do
      begin
        CurKey:=TestKeys[Loop];
        if not SpringDict.TryGetValue(CurKey,CurValue)
          then raise Exception.Create('Something is wrong!');
      end;
    end,BenchRounds);

  Writeln('Iterate (for..in) MormotDict ...');
  RunBenchmark(
    procedure
    var
      CurKey  : String;
      CurValue: String;
    begin
      for var Entry in MormotDict do
      begin
        CurKey:=Entry.Key;
        CurValue:=Entry.Value;
      end;
    end,BenchRounds);

  Writeln('Iterate (for..in) SpringDict ...');
  RunBenchmark(
    procedure
    var
      CurKey  : String;
      CurValue: String;
    begin
      for var Entry in SpringDict do
      begin
        CurKey:=Entry.Key;
        CurValue:=Entry.Value;
      end;
    end,BenchRounds);
end;

{ ----------------------------------------------------------------------- }

procedure TBenchmarks.ListBenchmark;
const
  BenchRounds = 100;
begin
  var TestData:=CreateTestListString(100000,'Value');
  var MormotList:=Collections.NewList<String>;
  var SpringList:=TCollections.CreateList<String>;

  Writeln(Format('Populate MormotList with %d items...',[Length(TestData)]));
  RunBenchmark(
    procedure
    begin
      MormotList.Clear;
      for var Entry in TestData do
      begin
        MormotList.Add(Entry);
      end;
    end,BenchRounds);

  Writeln(Format('Populate SpringList with %d items...',[Length(TestData)]));
  RunBenchmark(
    procedure
    begin
      SpringList.Clear;
      for var Entry in TestData do
      begin
        SpringList.Add(Entry);
      end;
    end,BenchRounds);

  Writeln('Compare MormotList with SpringList...');
  RunBenchmark(
    procedure
    begin
      for var Loop:=0 to SpringList.Count-1 do
      begin
        if MormotList[Loop]<>SpringList[Loop]
          then raise Exception.Create('Different content!');
      end;
    end,BenchRounds);

  Writeln('Iterate (for..in) through MormotList...');
  RunBenchmark(
    procedure
    begin
      var LastEntry: String;
      for var Entry in MormotList do
      begin
        LastEntry:=Entry;
      end;
    end,BenchRounds);

  Writeln('Iterate (for..in) through SpringList...');
  RunBenchmark(
    procedure
    begin
      var LastEntry: String;
      for var Entry in SpringList do
      begin
        LastEntry:=Entry;
      end;
    end,BenchRounds);

  Writeln('Iterate (for..to) through MormotList...');
  RunBenchmark(
    procedure
    begin
      var LastEntry: String;
      for var Loop:=0 to MormotList.Count-1 do
      begin
        LastEntry:=MormotList[Loop];
      end;
    end,BenchRounds);

  Writeln('Iterate (for..to) through SpringList...');
  RunBenchmark(
    procedure
    begin
      var LastEntry: String;
      for var Loop:=0 to SpringList.Count-1 do
      begin
        LastEntry:=SpringList[Loop];
      end;
    end,BenchRounds);
end;

{ ----------------------------------------------------------------------- }

procedure TBenchmarks.RunBenchmark(const AProc: TProc; ABenchmarkRounds: Integer);
begin
  var Stopper:=TStopwatch.StartNew;
  for var Loop:=1 to ABenchmarkRounds do
  begin
    AProc;
  end;
  Stopper.Stop;
  Writeln(Format('- (%d runs in %d msec.)',[ABenchmarkRounds,Stopper.ElapsedMilliseconds]));
  Writeln;
end;

{ ----------------------------------------------------------------------- }

procedure TBenchmarks.Run;
begin
  Writeln('---ListBenchmark---');
  ListBenchmark;

  Writeln('---DictBenchmark---');
  DictBenchmark;
end;

{ ======================================================================= }

begin
  try
    var Benchmarks:=TBenchmarks.Create;
    try
      Benchmarks.Run;
    finally
      Benchmarks.Free;
    end;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;

  Writeln('Done. Press Enter for exit.');
  Readln;
end.

---ListBenchmark---
Populate MormotList with 100000 items...
- (100 runs in 260 msec.)

Populate SpringList with 100000 items...
- (100 runs in 228 msec.)

Compare MormotList with SpringList...
- (100 runs in 212 msec.)

Iterate (for..in) through MormotList...
- (100 runs in 353 msec.)

Iterate (for..in) through SpringList...
- (100 runs in 192 msec.)

Iterate (for..to) through MormotList...
- (100 runs in 100 msec.)

Iterate (for..to) through SpringList...
- (100 runs in 102 msec.)

---DictBenchmark---
Populate MormotDict with 100000 items...
- (100 runs in 1198 msec.)

Populate SpringDict with 100000 items...
- (100 runs in 926 msec.)

Compare MormotDict with SpringDict...
- (100 runs in 846 msec.)

Iterate MormotDict by key (TryGetValue)...
- (100 runs in 557 msec.)

Iterate SpringDict by key (TryGetValue)...
- (100 runs in 286 msec.)

Iterate (for..in) MormotDict ...
- (100 runs in 641 msec.)

Iterate (for..in) SpringDict ...
- (100 runs in 372 msec.)

007330f0 +000 Lauge.exe  SynCommons         14366  +0 SortDynArrayAnsiString
00733873 +013 Lauge.exe  SynCommons         15157  +2 TDynArray.Equals
00733f2f +04b Lauge.exe  SynCommons         15583  +8 TDynArrayHashed.HashFind
00733c04 +01c Lauge.exe  SynCommons         15414  +2 TDynArrayHashed.FindHashedForAdding
007497d0 +018 Lauge.exe  SQLite3             3322  +1 TSQLRestServerDB.PrepareStatement
007499e7 +1cf Lauge.exe  SQLite3             3380 +42 TSQLRestServerDB.GetAndPrepareStatement
0074a4e4 +068 Lauge.exe  SQLite3             3640  +8 TSQLRestServerDB.EngineList
007437cb +38b Lauge.exe  SQLite3Commons     11699 +79 TSQLRestServer.URI
0074b06b +073 Lauge.exe  SQLite3             3957  +4 TSQLRestClientDB.URI
007415ef +047 Lauge.exe  SQLite3Commons     10643  +3 TSQLRestClientURI.ExecuteList
00741fd7 +017 Lauge.exe  SQLite3Commons     10890  +1 TSQLRestClientURI.InternalListJSON
00740dfb +06f Lauge.exe  SQLite3Commons     10279  +3 TSQLRest.Retrieve
0073e98e +056 Lauge.exe  SQLite3Commons      8784  +3 TSQLRecord.Create
007e3275 +075 Lauge.exe  LaugeCDB             543  +4 TCategoriesDB.GetCategoryFromDB
...

function TCategoriesDB.GetCategoryFromDB(CategoryID:Int64;
    AdditionalWhereCondition:String):TSQLRecordCategory;
begin
    if AdditionalWhereCondition <> '' then
        AdditionalWhereCondition:=' AND ' + AdditionalWhereCondition;

    Result:=TSQLRecordCategory.Create(GLF.LDB.RestClient,
            '(SiteID = :(%):) AND (CategoryID = :(%):)%',
            [SiteID, CategoryID, AdditionalWhereCondition]);

    if Result.ID = 0 then
        FreeAndNil(Result);
end;

function TSQLRestServer.Retrieve(aID: integer; Value: TSQLRecord;
  ForUpdate: boolean): boolean;
var TableIndex: integer; // used by EngineRetrieve() for SQL statement caching
    Resp: RawUTF8;
    Static: TSQLRestServerStatic;
begin // this version handles locking and use fast EngineRetrieve() method
  // check parameters
  result := false;
  if Value=nil  then
    exit; // avoid GPF
  Value.fID := 0;
  if (self=nil) or (aID=0) then
    exit;
  TableIndex := Model.GetTableIndex(Value.RecordClass);
  if TableIndex<0 then
    exit;
  // try to lock before retrieval (if ForUpdate)
  if ForUpdate and not Model.Lock(TableIndex,aID) then
    exit;
  // get JSON object '{...}' in Resp
  Static := fStaticData[TableIndex]; // <-- Here, fStaticData may be nil or smaller TableIndex
  if Static<>nil then
    Resp := Static.EngineRetrieve(TableIndex,aID) else
    Resp := EngineRetrieve(TableIndex,aID);
  // fill Value from JSON if was correctly retrieved
  if Resp<>'' then begin
    Value.FillFrom(Resp);
    result := true;
  end;
end;

TSQLRecordImages = class(TSQLRecordMany);

TSQLRecordItem = class(TSQLRecord)
private
    FImages:TSQLRecordImages;
published
    property Images:TSQLRecordImages read FImages write FImages;
end;


function TSQLRecordItem.RetrievePictureURLs:TStringList;
var
    OneRecord:TSQLRecord;
begin    
    if not ((ID > 0) and (Images.FillMany(TSQLAccess.RestServer, ID) > 0)) then
        Exit(nil);
    Result:=TStringList.Create;
    while Images.FillOne do
    begin
        OneRecord:=TSQLAccess.RestServer.Retrieve(Images.Dest); // <--From this point to the upper posted code it happens
        try
            if Assigned(OneRecord) and (OneRecord is TSQLRecordImage) then
                Result.Add(UTF8ToString(TSQLRecordImage(OneRecord).URL));
        finally
            OneRecord.Free;
        end;
    end;
end;