paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-10 19:26:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Patch from Daniel Plachotich to allow regular procedures as iterators

Browse Source 
git-svn-id: trunk@33221 -
This commit is contained in:
michael 2016-03-12 09:49:21 +00:00
parent e160b09468
commit 674b539293
4 changed files with 171 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -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

3
packages/fcl-base/examples/README.txt
View File

@ -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

118
packages/fcl-base/examples/contit.pp Normal file
View File

@ -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.

50
packages/fcl-base/src/contnrs.pp
View File

@ -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;