From 674b539293f4bf4e3abd3a13d7190d02e547d60e Mon Sep 17 00:00:00 2001 From: michael Date: Sat, 12 Mar 2016 09:49:21 +0000 Subject: [PATCH] * Patch from Daniel Plachotich to allow regular procedures as iterators git-svn-id: trunk@33221 - --- .gitattributes | 1 + packages/fcl-base/examples/README.txt | 3 +- packages/fcl-base/examples/contit.pp | 118 ++++++++++++++++++++++++++ packages/fcl-base/src/contnrs.pp | 50 +++++++++++ 4 files changed, 171 insertions(+), 1 deletion(-) create mode 100644 packages/fcl-base/examples/contit.pp diff --git a/.gitattributes b/.gitattributes index 1e8b3870f5..1229a4a514 100644 --- a/.gitattributes +++ b/.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 diff --git a/packages/fcl-base/examples/README.txt b/packages/fcl-base/examples/README.txt index 2580e9e675..e6fdb1e2a6 100644 --- a/packages/fcl-base/examples/README.txt +++ b/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. \ No newline at end of file +testini.pp Test/Demo for inifiles, ReadSectionValues. +contit.pp Test/Demo for iterators in contnr.pp diff --git a/packages/fcl-base/examples/contit.pp b/packages/fcl-base/examples/contit.pp new file mode 100644 index 0000000000..11d58b12a1 --- /dev/null +++ b/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. diff --git a/packages/fcl-base/src/contnrs.pp b/packages/fcl-base/src/contnrs.pp index c1a8eaee23..36effe3cda 100644 --- a/packages/fcl-base/src/contnrs.pp +++ b/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;