* Patch from Daniel Plachotich to allow regular procedures as iterators

git-svn-id: trunk@33221 -

.gitattributes

@@ -1926,6 +1926,7 @@ packages/fcl-base/examples/b64test2.pp svneol=native#text/plain
 packages/fcl-base/examples/base64decodingtestcase.pas svneol=native#text/plain
 packages/fcl-base/examples/cachetest.pp svneol=native#text/plain
 packages/fcl-base/examples/cfgtest.pp svneol=native#text/plain
+packages/fcl-base/examples/contit.pp svneol=native#text/plain
 packages/fcl-base/examples/crittest.pp svneol=native#text/plain
 packages/fcl-base/examples/dbugsrv.pp svneol=native#text/plain
 packages/fcl-base/examples/debugtest.pp svneol=native#text/plain

packages/fcl-base/examples/README.txt

@@ -73,4 +73,5 @@ poolmm2.pp   Test for pooledmm (nonfree) (VS)
 testweb.pp   Test for fpcgi (MVC)
 daemon.pp    Test for daemonapp (MVC)
 testtimer.pp Test for TFPTimer (MVC)
-testini.pp   Test/Demo for inifiles, ReadSectionValues.
+testini.pp   Test/Demo for inifiles, ReadSectionValues.
+contit.pp    Test/Demo for iterators in contnr.pp

packages/fcl-base/examples/contit.pp

@@ -0,0 +1,118 @@
+{$MODE OBJFPC}
+{$H+}
+{$C+}
+program test;
+
+uses
+  contnrs,
+  sysutils;
+
+const
+  KEYS: array [0..5] of string = (
+    'a',
+    'b',
+    'c',
+    'd',
+    'e',
+    'f'
+    );
+
+  TERMINATE_KEY_ID = 2;
+
+
+procedure DataStaticIterator(Item: Pointer; const Key: string; var Continue: Boolean);
+begin
+  Assert(Key = String(Item^));
+  Continue := TRUE;
+end;
+
+procedure DataStaticIteratorTerminated(Item: Pointer; const Key: string; var Continue: Boolean);
+begin
+  Continue := Key <> KEYS[TERMINATE_KEY_ID];
+end;
+
+
+procedure StringStaticIterator(Item: String; const Key: string; var Continue: Boolean);
+begin
+  Assert(Key = Item);
+  Continue := TRUE;
+end;
+
+procedure StringStaticIteratorTerminated(Item: String; const Key: string; var Continue: Boolean);
+begin
+  Continue := Key <> KEYS[TERMINATE_KEY_ID];
+end;
+
+
+type
+  TTestObject = class
+  private
+    FStr: string;
+  public
+    constructor Create(const S: string);
+    property Str: string read FStr;
+  end;
+
+constructor TTestObject.Create(const S: string);
+begin
+  FStr := S;
+end;
+
+
+procedure ObjectStaticIterator(Item: TObject; const Key: string; var Continue: Boolean);
+begin
+  Assert(Key = TTestObject(Item).Str);
+  Continue := TRUE;
+end;
+
+procedure ObjectStaticIteratorTerminated(Item: TObject; const Key: string; var Continue: Boolean);
+begin
+  Continue := Key <> KEYS[TERMINATE_KEY_ID];
+end;
+
+
+var
+  i: integer;
+  data_hash_table: TFPDataHashTable;
+  last_data: pointer;
+  string_hash_table: TFPStringHashTable;
+  last_string: string;
+  object_hash_table: TFPObjectHashTable;
+  last_object: TTestObject;
+
+begin
+  data_hash_table := TFPDataHashTable.Create;
+  for i := 0 to High(KEYS) do
+    data_hash_table.Add(KEYS[i], @KEYS[i]);
+
+  last_data := data_hash_table.Iterate(@DataStaticIterator);
+  Assert(last_data = NIL);
+  last_data := data_hash_table.Iterate(@DataStaticIteratorTerminated);
+  Assert(last_data = @KEYS[TERMINATE_KEY_ID]);
+
+  data_hash_table.Free;
+
+  string_hash_table := TFPStringHashTable.Create;
+  for i := 0 to High(KEYS) do
+    string_hash_table.Add(KEYS[i], KEYS[i]);
+
+  last_string := string_hash_table.Iterate(@StringStaticIterator);
+  Assert(last_string = '');
+  last_string := string_hash_table.Iterate(@StringStaticIteratorTerminated);
+  Assert(last_string = KEYS[TERMINATE_KEY_ID]);
+
+  string_hash_table.Free;
+
+  object_hash_table := TFPObjectHashTable.Create(TRUE);
+  for i := 0 to High(KEYS) do
+    object_hash_table.Add(KEYS[i], TTestObject.Create(KEYS[i]));
+
+  last_object := TTestObject(object_hash_table.Iterate(@ObjectStaticIterator));
+  Assert(last_object = NIL);
+  last_object := TTestObject(object_hash_table.Iterate(@ObjectStaticIteratorTerminated));
+  Assert(last_object.Str = KEYS[TERMINATE_KEY_ID]);
+
+  object_hash_table.Free;
+
+  WriteLn('All is OK');
+end.

packages/fcl-base/src/contnrs.pp

@@ -412,10 +412,15 @@ type
   THTNode = THTDataNode;
 
   TDataIteratorMethod = Procedure(Item: Pointer; const Key: string; var Continue: Boolean) of object;
+  TDataIteratorCallBack = Procedure(Item: Pointer; const Key: string; var Continue: Boolean);
+
   // For compatibility
   TIteratorMethod = TDataIteratorMethod;
 
   TFPDataHashTable = Class(TFPCustomHashTable)
+  Private
+    FIteratorCallBack: TDataIteratorCallBack;
+    Procedure CallbackIterator(Item: Pointer; const Key: string; var Continue: Boolean);
   Protected
     Function CreateNewNode(const aKey : String) : THTCustomNode; override;
     Procedure AddNode(ANode : THTCustomNode); override;
@@ -424,6 +429,7 @@ type
     Function ForEachCall(aMethod: TDataIteratorMethod): THTDataNode; virtual;
   Public
     Function Iterate(aMethod: TDataIteratorMethod): Pointer; virtual;
+    Function Iterate(aMethod: TDataIteratorCallBack): Pointer; virtual;
     Procedure Add(const aKey: string; AItem: pointer); virtual;
     property Items[const index: string]: Pointer read GetData write SetData; default;
   end;
@@ -435,9 +441,14 @@ type
   public
     property Data: String read FData write FData;
   end;
+  
   TStringIteratorMethod = Procedure(Item: String; const Key: string; var Continue: Boolean) of object;
+  TStringIteratorCallback = Procedure(Item: String; const Key: string; var Continue: Boolean);
 
   TFPStringHashTable = Class(TFPCustomHashTable)
+  Private
+    FIteratorCallBack: TStringIteratorCallback;
+    Procedure CallbackIterator(Item: String; const Key: string; var Continue: Boolean);
   Protected
     Function CreateNewNode(const aKey : String) : THTCustomNode; override;
     Procedure AddNode(ANode : THTCustomNode); override;
@@ -446,6 +457,7 @@ type
     Function ForEachCall(aMethod: TStringIteratorMethod): THTStringNode; virtual;
   Public
     Function Iterate(aMethod: TStringIteratorMethod): String; virtual;
+    Function Iterate(aMethod: TStringIteratorCallback): String; virtual;
     Procedure Add(const aKey,aItem: string); virtual;
     property Items[const index: string]: String read GetData write SetData; default;
   end;
@@ -464,11 +476,15 @@ type
   public
     destructor Destroy; override;
   end;
+
   TObjectIteratorMethod = Procedure(Item: TObject; const Key: string; var Continue: Boolean) of object;
+  TObjectIteratorCallback = Procedure(Item: TObject; const Key: string; var Continue: Boolean);
 
   TFPObjectHashTable = Class(TFPCustomHashTable)
   Private
     FOwnsObjects : Boolean;
+    FIteratorCallBack: TObjectIteratorCallback;
+    procedure CallbackIterator(Item: TObject; const Key: string; var Continue: Boolean);
   Protected
     Function CreateNewNode(const aKey : String) : THTCustomNode; override;
     Procedure AddNode(ANode : THTCustomNode); override;
@@ -479,6 +495,7 @@ type
     constructor Create(AOwnsObjects : Boolean = True);
     constructor CreateWith(AHashTableSize: Longword; aHashFunc: THashFunction; AOwnsObjects : Boolean = True);
     Function Iterate(aMethod: TObjectIteratorMethod): TObject; virtual;
+    Function Iterate(aMethod: TObjectIteratorCallback): TObject; virtual;
     Procedure Add(const aKey: string; AItem : TObject); virtual;
     property Items[const index: string]: TObject read GetData write SetData; default;
     Property OwnsObjects : Boolean Read FOwnsObjects;
@@ -2242,6 +2259,17 @@ begin
     Result:=nil;
 end;
 
+Procedure TFPDataHashTable.CallbackIterator(Item: Pointer; const Key: string; var Continue: Boolean);
+begin
+  FIteratorCallBack(Item, Key, Continue);
+end;
+
+Function TFPDataHashTable.Iterate(aMethod: TDataIteratorCallBack): Pointer;
+begin
+  FIteratorCallBack := aMethod;
+  Result := Iterate(@CallbackIterator);
+end;
+
 Function TFPDataHashTable.ForEachCall(aMethod: TDataIteratorMethod): THTDataNode;
 var
   i, j: Longword;
@@ -2321,6 +2349,17 @@ begin
     Result:='';
 end;
 
+Procedure TFPStringHashTable.CallbackIterator(Item: String; const Key: string; var Continue: Boolean);
+begin
+  FIteratorCallBack(Item, Key, Continue);
+end;
+
+Function TFPStringHashTable.Iterate(aMethod: TStringIteratorCallback): String;
+begin
+  FIteratorCallBack := aMethod;
+  Result := Iterate(@CallbackIterator);
+end;
+
 Function TFPStringHashTable.ForEachCall(aMethod: TStringIteratorMethod): THTStringNode;
 var
   i, j: Longword;
@@ -2398,6 +2437,17 @@ begin
     Result:=nil;
 end;
 
+Procedure TFPObjectHashTable.CallbackIterator(Item: TObject; const Key: string; var Continue: Boolean);
+begin
+  FIteratorCallBack(Item, Key, Continue);
+end;
+
+Function TFPObjectHashTable.Iterate(aMethod: TObjectIteratorCallback): TObject;
+begin
+  FIteratorCallBack := aMethod;
+  Result := Iterate(@CallbackIterator);
+end;
+
 Function TFPObjectHashTable.ForEachCall(aMethod: TObjectIteratorMethod): THTObjectNode;
 var
   i, j: Longword;