[fpc-pascal] fgl unit bug in generic class TFPGMap

[Dennis Poon]

I think I found a bug in TFPGMap.
Hope some of you can verify it.

The bug seems to relate to the binary search used in the method "FIND" 
but it does not occur for all string key values or at all capacity of 
the map. Seems only occur at the second item added and when it is 
certain string values.

I tried to debug it but cannot step into the codes of fgl unit so cannot 
find the cause.

Please help.

Dennis

=====================
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
   Classes,  Forms, Controls,StdCtrls, SysUtils,  fgl;
type

   TMapOfObjects=class(specialize TFPGMap < String, TObject> )
   public
     function Locate(TheKey : String) : Boolean;
     function GetContent  :String;
   end;

   TForm1 = class(TForm)
   public
     Map :  TMapOfObjects;
     Memo1 : TMemo;
     ButtonAdd : TButton;
     Edit1 : TEdit;
     N : integer;
     procedure ButtonAddClick(TheSEnder : TObject);
     destructor Destroy;override;
     constructor Create(TheOwner : TComponent);override;
   end;

var
   Form1: TForm1;

implementation

{$R *.lfm}

function TMapOfObjects.Locate(TheKey: String): Boolean;
var i  : integer;
begin
   result := false;
   for i := 0 to count-1 do begin
     if Keys[i] = TheKey then begin
       result := true;
       exit;
     end;
   end;
end;

procedure TForm1.ButtonAddClick(TheSEnder: TObject);
var idx : integer;
   L : TObject;
   s : String;
begin
   inc(n);
   L := TObject.Create;
   Map.Add(Edit1.Text, L);

   if not Map.Find(Edit1.Text, idx) then begin
     Memo1.lines.add('#'+IntToStr(n)+'   '+Edit1.Text+ ' was just added 
but cannot be found by method "FIND" ! BUG!');
     if Map.Locate(Edit1.Text) then begin
       Memo1.lines.add('         BUT a simple loop of comparision can 
locate it, proving the item was added, just the method "FIND" is  BUGGY!');
       Memo1.lines.add('         List content = '+Map.GetContent);
     end;
   end else begin
     Memo1.lines.add('#'+IntToStr(n)+'   '+Edit1.Text+ ' was added and 
found as expected');
     Memo1.lines.add('         List content = '+Map.GetContent);
   end;
end;

destructor TForm1.Destroy;
var i : integer;
begin
   for i := 0 to map.count-1 do
     Map.Data[i].Free;
   Map.Free;
   inherited Destroy;
end;

constructor TForm1.Create(TheOwner: TComponent);
begin
   inherited Create(TheOwner);

   ButtonAdd := TBUtton.Create(self);
   ButtonAdd.Parent := self;
   ButtonAdd.Left := 10;
   ButtonAdd.Top := 5;
   ButtonAdd.Caption := 'Add';
   ButtonAdd.OnClick := @ButtonAddClick;

   Edit1 := TEdit.Create(SELF);
   Edit1.Parent := self;
   Edit1.Top := 10;
   Edit1.Left := 100;
   Edit1.Text := '';

   Memo1:= TMemo.Create(self);
   Memo1.Parent := self;
   Memo1.Left := 16;
   Memo1.Height := 342;
   Memo1.Top := 74;
   Memo1.Width := 575;
   Memo1.lines.Clear;

   Map := TMapOfObjects.Create;

   //no matter what I set below, the same bug will appear. also, 
duplicates are always added
//  Map.Duplicates:= dupError;
//  Map.Duplicates:= dupIgnore;

   n := 0;
   Edit1.Text := 'abc';
   ButtonAddClick(nil);

   Edit1.Text := 'HHIV4'; //will trigger bug;
//  Edit1.Text := 'defv4'; //but strangely if add 'defv4' wont' trigger bug
   ButtonAddClick(nil);

   Edit1.Text := 'ghiV4';  //bug seems to disappear after the 2nd item 
is added. perhaps the buy is in binary search
   ButtonAddClick(nil);
end;

function TMapOfObjects.GetContent: String;
var i :Integer;
begin
   result := '';
   for i := 0 to count-1 do begin
     result := result+Keys[i]+',';
   end;
end;

end.