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.
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
