[Lazarus] Revision 16278 can not rebuild the IDE

Luiz Americo Pereira Camara luizmed at oi.com.br
Thu Aug 28 01:46:40 CEST 2008


On Mon, Aug 25, 2008 at 11:03 AM, Dave Coventry <dgcoventry at gmail.com> wrote:
>
> I've been googling for a way to return the index of a particular
> string in an array and have come across an old thread on this List
> referring to TFPHashTable, which sounds like what I need.
>
> However, I've been unable to find out how to use it.
> TFPHashTable looks as though it would suit my application.


TFPHashTable seems to be what you are looking for.  It's heavily
optimised for speed to easily handle 100,000+ items.

Here is a reply I got from Dean Zobac and a test case to show how to
use TFPHashTable. Enjoy!  GMail is awesome - I have a mailing list
archive of 3 years already :-)



---------- Forwarded message ----------
From: Dean Zobec <dezobec@*****.it>
Date: Wed, Sep 27, 2006 at 6:58 PM
Subject: Re: [fpc-pascal] THashedStringList vs TFPHashTable
To: FPC-Pascal users discussions <fpc-pascal at lists.freepascal.org>


Graeme Geldenhuys ha scritto:
> Hi,
>
> Is TFPHashTable the same as Delphi's THashedStringList?
>
> I am looking for a List class that can hold large amounts of objects
> with a ID string associated for quick lookups.
>
> Regards,
>  - Graeme -

Yes, similar to a THashedStringList, but with a special implementation
The TFPHashTable was highly optimized with a lot of profiling, while
trying to achieve the ease of use through object orientation and ease of
maintainance. It's a hash table with a customizable hash function (to
achieve constant performance in searches), chaining is used as a
collision resolution scheme. Some statistics are also provided to be
able to choose the appropriate hash function and the appropriate hash
table size.
The difference in performance with respect to a simple ordered
TStringList is evident when more then 100.000 elements are added to the
container, the number of elements the container can hold is huge
(longword, and obviously ram size, is the limit :). I have another idea
to further improve the performance of searches and I'm planning to
further profile it in the next weeks to see if there are other speed gains.
Be aware that the version in 2.0.4 and before contains a bug that was
solved by Marco in 2.1.1. and merged in 2.0.5 (an AV if the insertion is
made after a clear) due to the use of longwords in the for cycles.
I'm attaching the fpcunit tests for you to see how to use it, and I'll
give you all the assistance that you need. I'll be glad to receive some
feedback as usual.
Regards,
Dean

unit testfphashtable;

{$mode objfpc}{$H+}

interface

uses
 Classes, SysUtils, fpcunit, testutils, testregistry, contnrs;

type

 { TTestHtNode }

 TTestHtNode = class(TTestCase)
 published
   procedure TestNodeCreation;
   procedure TestKeyComparison;
 end;




 //inherited to be able to get access to protected methods
 TMyHashTable = class(TFPHashTable)
 end;

 { TTestFPHashTable }

 TTestFPHashTable= class(TTestCase)
 private
   ht: TMyHashTable;
   FSum: integer;
 protected
   procedure SetUp; override;
   procedure TearDown; override;
   procedure SumTest(Item: Pointer; const Key: string;
     var Continue: Boolean);
   procedure SumTestUntilFound100(Item: Pointer; const Key: string;
     var Continue: Boolean);
 published
   procedure TestCreate;
   procedure TestCreateWith;
   procedure TestIsEmpty;
   procedure TestAdd;
   procedure TestAddSimpleSyntax;
   procedure TestGetData;
   procedure TestChainLength;
   procedure TestDelete;
   procedure TestClear;
   procedure TestForEachCall;
   procedure TestForEachCallBreak;
   procedure TestHashTableGrow;
   procedure TestVoidSlots;
   //test for bug 0007292 fixed by marco guard all for loops with unsigned
   //loopcounter against overflow (rev.4507)
   procedure TestAddAfterClear;
 end;



implementation

procedure TTestFPHashTable.SetUp;
begin
 ht := TMyHashTable.CreateWith(9973, @RSHash);
 AssertEquals(12289, ht.HashTableSize);
end;

procedure TTestFPHashTable.TearDown;
begin
 ht.Free;
end;

procedure TTestFPHashTable.TestAdd;
begin
 ht.Add('1', pointer(1));
 ht.Add('2', pointer(2));
 ht.Add('nil', nil);
 AssertEquals('wrong number of items', 3, ht.Count);
end;

procedure TTestFPHashTable.TestAddSimpleSyntax;
begin
 ht['1'] := pointer(1);
 ht['2'] := pointer(2);
 ht['nil'] := nil;
 AssertEquals('wrong number of items', 3, ht.Count);
end;

procedure TTestFPHashTable.TestGetData;
var
 i: integer;
begin
 for i := 0 to 9999 do
   ht.Add(intToStr(i), pointer(i));
 AssertEquals(10000, ht.Count);
 for i := 0 to 9999 do
   AssertEquals(i, integer(ht[PChar(IntToStr(i))]));
 for i := 9999 downto 0 do
   AssertEquals(i, integer(ht[PChar(IntToStr(i))]));
end;

procedure TTestFPHashTable.TestChainLength;
var
 i: integer;
 sum: int64;
begin
 sum := 0;
 for i := 0 to 9999 do
   ht.Add(intToStr(i), pointer(i));
 AssertEquals(10000, ht.Count);
 for i := 0 to ht.HashTableSize-1 do
   if Assigned(ht.HashTable[i]) then
     Sum := Sum + ht.ChainLength(i);
 AssertEquals(10000, sum);
end;

procedure TTestFPHashTable.TestDelete;
var
 i: DWord;
begin
 for i := 0 to 9999 do
   ht.Add(intToStr(i), pointer(i));
 ht.Delete('994');
 AssertEquals('Wrong number of items after delete', 9999, ht.Count);
 AssertNull('Item not deleted', ht.Find('994'));
end;

procedure TTestFPHashTable.TestClear;
var
 i: integer;
begin
 for i := 0 to 9999 do
   ht.Add(intToStr(i), pointer(i));
 ht.Clear;
 AssertTrue('container not empty', ht.IsEmpty);
end;

procedure TTestFPHashTable.TestHashTableGrow;
var
 i: integer;
begin
 for i := 0 to 9999 do
   ht.Add(intToStr(i), pointer(i));
 ht.HashTableSize := ht.HashTableSize + 1;
 AssertEquals(24593, ht.HashTableSize);
 AssertEquals(10000, ht.Count);
 for i := 0 to 9999 do
   AssertEquals(i, integer(ht[PChar(IntToStr(i))]));
end;

procedure TTestFPHashTable.TestVoidSlots;
begin
 AssertEquals(12289, ht.VoidSlots);
 ht.Add('a', nil);
 AssertEquals(12288, ht.VoidSlots);
end;

procedure TTestFPHashTable.TestAddAfterClear;
var
 i: integer;
begin
 for i := 0 to 9999 do
   ht.Add(intToStr(i), pointer(i));
 ht.Clear;
 AssertTrue('container not empty', ht.IsEmpty);
 for i := 0 to 9999 do
   ht.Add(intToStr(i), pointer(i));
 AssertEquals(10000, ht.Count);
 for i := 0 to 9999 do
   AssertEquals(i, integer(ht[PChar(IntToStr(i))]));
 for i := 9999 downto 0 do
   AssertEquals(i, integer(ht[PChar(IntToStr(i))]));
end;

procedure TTestFPHashTable.TestForEachCall;
var
 i: integer;
 p: THTNode;
begin
 FSum := 0;
 for i := 1 to 10000 do
   ht.Add(intToStr(i), pointer(i));
 p := ht.ForEachCall(@SumTest);
 AssertEquals(10000*10001/2, FSum);
 AssertNull(p);
end;

procedure TTestFPHashTable.TestForEachCallBreak;
var
 i: integer;
 p: THTNode;
begin
 FSum := 0;
 for i := 1 to 10000 do
   ht.Add(intToStr(i), pointer(i));
 p := ht.ForEachCall(@SumTestUntilFound100);
 AssertEquals(100, integer(p.Data));
end;

procedure TTestFPHashTable.SumTest(Item: Pointer; const Key: string;
 var Continue: Boolean);
begin
 FSum := FSum + Integer(Item);
end;

procedure TTestFPHashTable.SumTestUntilFound100(Item: Pointer; const
Key: string;
 var Continue: Boolean);
begin
 FSum := FSum + Integer(Item);
 if Integer(Item) = 100 then
   Continue := false;
end;

procedure TTestFPHashTable.TestCreate;
var
 t: TFPHashTable;
begin
 t := TFPHashTable.Create;
 try
   AssertEquals(196613, t.HashTableSize);
 finally
   t.Free;
 end;
end;

procedure TTestFPHashTable.TestCreateWith;
var
 h: TMyHashTable;
begin
 h := TMyHashTable.CreateWith(7, @RSHash);
 try
   AssertEquals('wrong table size', 53, h.HashTableSize);
   AssertSame('wrong hash function', @RSHash, h.HashFunction);
 finally
   h.Free;
 end;
end;

procedure TTestFPHashTable.TestIsEmpty;
begin
 AssertTrue(ht.IsEmpty);
end;

{ TTestHtNode }


procedure TTestHtNode.TestNodeCreation;
var
 node: THTNode;
begin
 try
   node := THTNode.CreateWith('Dean');
   AssertEquals(4, Length(node.Key));
   AssertEquals('D', Node.Key[1]);
   AssertEquals('e', Node.Key[2]);
   AssertEquals('a', Node.Key[3]);
   AssertEquals('n', Node.Key[4]);
   AssertEquals(#0, Node.Key[5]);
 finally
   node.Free;
 end;
end;

procedure TTestHtNode.TestKeyComparison;
var
 node: THTNode;
begin
 try
   node := THTNode.CreateWith('Dean');
   AssertTrue('key not found', node.HasKey('Dean'));
   AssertFalse('wrong key found', node.HasKey('Dea'));
   AssertFalse('wrong key found', node.HasKey('Deanz'));
 finally
   node.Free;
 end;
end;


initialization

 RegisterTests( [TTestHTNode, TTestFPHashTable]);
end.


-------------------------- [ end ]------------------------



Regards,
 - Graeme -


_______________________________________________
fpGUI - a cross-platform Free Pascal GUI toolkit
http://opensoft.homeip.net/fpgui/



More information about the Lazarus mailing list