--- Merging r31381 into '.':

U    rtl/objpas/fgl.pp
--- Recording mergeinfo for merge of r31381 into '.':
 U   .
--- Merging r32942 into '.':
G    rtl/objpas/fgl.pp
--- Recording mergeinfo for merge of r32942 into '.':
 G   .
--- Merging r32947 into '.':
G    rtl/objpas/fgl.pp
--- Recording mergeinfo for merge of r32947 into '.':
 G   .
--- Merging r32959 into '.':
G    rtl/objpas/fgl.pp
--- Recording mergeinfo for merge of r32959 into '.':
 G   .
--- Merging r32987 into '.':
G    rtl/objpas/fgl.pp
--- Recording mergeinfo for merge of r32987 into '.':
 G   .
--- Merging r33098 into '.':
U    packages/fcl-stl/src/garrayutils.pp
--- Recording mergeinfo for merge of r33098 into '.':
 G   .
--- Merging r33311 into '.':
U    packages/fcl-stl/fpmake.pp
A    packages/fcl-stl/tests/glinkedlisttest.pp
A    packages/fcl-stl/src/glinkedlist.pp
--- Recording mergeinfo for merge of r33311 into '.':
 G   .
--- Merging r33341 into '.':
U    packages/fcl-stl/src/ghashmap.pp
--- Recording mergeinfo for merge of r33341 into '.':
 G   .

# revisions: 31381,32942,32947,32959,32987,33098,33311,33341

git-svn-id: branches/fixes_3_0@33403 -

.gitattributes

@@ -2835,6 +2835,7 @@ packages/fcl-stl/src/garrayutils.pp svneol=native#text/plain
 packages/fcl-stl/src/gdeque.pp svneol=native#text/plain
 packages/fcl-stl/src/ghashmap.pp svneol=native#text/plain
 packages/fcl-stl/src/ghashset.pp svneol=native#text/plain
+packages/fcl-stl/src/glinkedlist.pp svneol=native#text/plain
 packages/fcl-stl/src/gmap.pp svneol=native#text/plain
 packages/fcl-stl/src/gpriorityqueue.pp svneol=native#text/plain
 packages/fcl-stl/src/gqueue.pp svneol=native#text/plain
@@ -2849,6 +2850,7 @@ packages/fcl-stl/tests/gcompositetest.pp svneol=native#text/plain
 packages/fcl-stl/tests/gdequetest.pp svneol=native#text/plain
 packages/fcl-stl/tests/ghashmaptest.pp svneol=native#text/plain
 packages/fcl-stl/tests/ghashsettest.pp svneol=native#text/plain
+packages/fcl-stl/tests/glinkedlisttest.pp svneol=native#text/plain
 packages/fcl-stl/tests/gmaptest.pp svneol=native#text/plain
 packages/fcl-stl/tests/gmaptestzal.pp svneol=native#text/plain
 packages/fcl-stl/tests/gpriorityqueuetest.pp svneol=native#text/plain

packages/fcl-stl/fpmake.pp

@@ -48,6 +48,7 @@ begin
           AddUnit('gdeque');
         end;
     T:=P.Targets.AddUnit('gset.pp');
+    T:=P.Targets.AddUnit('glinkedlist.pp');
     T:=P.Targets.AddUnit('gtree.pp');
     T:=P.Targets.AddUnit('gstack.pp');
       with T.Dependencies do

packages/fcl-stl/src/garrayutils.pp

@@ -85,7 +85,7 @@ begin
 end;
 
 class procedure TOrderingArrayUtils.Sortrange(var Arr:TArr; Start,Fin,d:SizeUInt);
-var pivot,temp:Tvalue; i,j,k,l:SizeUInt;
+var pivot,temp:Tvalue; i,j,k,l:SizeInt;
 begin
   if (Fin-Start) <= InsertSortThreshold then
   begin

packages/fcl-stl/src/ghashmap.pp

@@ -12,15 +12,26 @@
   **********************************************************************}
   {$mode objfpc}
 
+  { $define STL_INTERFACE_EXT}
+
   unit ghashmap;
 
   interface
   uses gvector, gutil, garrayutils;
 
-  const baseFDataSize = 8;
+  const
+    baseFDataSize = 8;             // must be > 0
+    maxLoadingFactor = 1.0;
 
-  {Thash should have one class function hash(a:TKey, n:longint):longint which return uniformly distributed
-  value in range <0,n-1> base only on arguments, n will be always power of 2}
+  {
+    THash should have the class functions
+      hash(a: TKey, n: SizeUInt): SizeUInt;
+      	      return uniformly distributed i value in range <0,n-1> base only on arguments,
+	      n will be always power of 2
+      equal(const AKey1, AKey2: TKey): Boolean;            [when STL_INTERFACE_EXT is defined]
+              return the boolean test for equality of the two keys.  Typically this is operator=,
+              but it doesn't have to be (e.g. case-insensitive string comparison)
+  }
 
   type
     generic THashmapIterator<TKey, TValue, T, TTable>=class
@@ -30,6 +41,7 @@
         Fh,Fp:SizeUInt;
         FData:TTable;
         function Next:boolean;inline;
+        function Prev:boolean;inline;
         function GetData:T;inline;
         function GetKey:TKey;inline;
         function GetValue:TValue;inline;
@@ -66,17 +78,19 @@
         function contains(key:TKey):boolean;inline;
         function size:SizeUInt;inline;
         procedure delete(key:TKey);inline;
+        procedure erase(iter:TIterator);inline;
         function IsEmpty:boolean;inline;
         function GetData(key:TKey):TValue;inline;
+        function GetValue(key:TKey;out value:TValue):boolean;inline;
 
         property Items[i : TKey]: TValue read GetData write Insert; default;
 
-      function Iterator:TIterator;
+        function Iterator:TIterator;
   end;
 
 implementation
 
-function THashmap.Size:SizeUInt;inline;
+function THashmap.Size: SizeUInt;
 begin
   Size:=FDataSize;
 end;
@@ -84,36 +98,43 @@ end;
 destructor THashmap.Destroy;
 var i:SizeUInt;
 begin
-  for i:=0 to FData.size-1 do
+  i:=0;
+  while i < FData.size do
+  begin
     (FData[i]).Destroy;
+    inc(i);
+  end;
   FData.Destroy;
 end;
 
-function THashmap.IsEmpty():boolean;inline;
+function THashmap.IsEmpty(): boolean;
 begin
-  if Size()=0 then 
-    IsEmpty:=true
-  else 
-    IsEmpty:=false;
+  IsEmpty := Size()=0;
 end;
 
 procedure THashmap.EnlargeTable;
 var i,j,h,oldDataSize:SizeUInt; 
+    curbucket:TContainer;
     value:TPair;
 begin
+  //Assert(oldDataSize>0);
   oldDataSize:=FData.size;
   FData.resize(FData.size*2);
   for i:=oldDataSize to FData.size-1 do
     FData[i] := TContainer.create;
   for i:=oldDataSize-1 downto 0 do begin
+    curbucket:=FData[i];
     j := 0;
-    while j < (FData[i]).size do begin
-      value := (FData[i])[j];
-      h:=Thash.hash(value.key,FData.size);
+    while j < curbucket.size do begin
+      h:=THash.hash(curbucket[j].key,FData.size);
       if (h <> i) then begin
-        (FData[i])[j] := (FData[i]).back;
-        (FData[i]).popback;
-        (FData[h]).pushback(value);
+        if (j+1) < curbucket.size then begin
+          value:=curbucket[j];
+          curbucket[j]:= curbucket.back;
+          (FData[h]).pushback(value);
+        end else
+          (FData[h]).pushback(curbucket[j]);
+        curbucket.popback;
       end else
         inc(j);
     end;
@@ -121,7 +142,7 @@ begin
 end;
 
 constructor THashmap.create;
-var i:longint;
+var i: SizeUInt;
 begin
   FDataSize:=0;
   FData:=TTable.create;
@@ -130,56 +151,107 @@ begin
     FData[i]:=TContainer.create;
 end;
 
-function THashmap.contains(key:TKey):boolean;inline;
-var i,h,bs:longint;
+function THashmap.contains(key: TKey): boolean;
+var i,bs:SizeUInt;
+    curbucket:TContainer;
 begin
-  h:=Thash.hash(key,FData.size);
-  bs:=(FData[h]).size;
-  for i:=0 to bs-1 do begin
-    if (((FData[h])[i]).Key=key) then exit(true);
+  curbucket:=FData[THash.hash(key,FData.size)];
+  bs:=curbucket.size;
+  i:=0;
+  while i < bs do begin
+{$ifdef STL_INTERFACE_EXT}
+    if THash.equal(curbucket[i].Key, key) then exit(true);
+{$else}
+    if (curbucket[i].Key = key) then exit(true);
+{$endif}
+    inc(i);
   end;
   exit(false);
 end;
 
-function THashmap.GetData(key:TKey):TValue;inline;
-var i,h,bs:longint;
+function THashmap.GetData(key: TKey): TValue;
+var i,bs:SizeUInt;
+    curbucket:TContainer;
 begin
-  h:=Thash.hash(key,FData.size);
-  bs:=(FData[h]).size;
-  for i:=0 to bs-1 do begin
-    if (((FData[h])[i]).Key=key) then exit(((FData[h])[i]).Value);
+  curbucket:=FData[THash.hash(key,FData.size)];
+  bs:=curbucket.size;
+  i:=0;
+  while i < bs do begin
+{$ifdef STL_INTERFACE_EXT}
+    if THash.equal(curbucket[i].Key, key) then exit(curbucket[i].Value);
+{$else}
+    if (curbucket[i].Key = key) then exit(curbucket[i].Value);
+{$endif}
+    inc(i);
   end;
+  // exception?
 end;
 
-procedure THashmap.insert(key:TKey;value:TValue);inline;
-var pair:TPair; i,h,bs:longint;
+function THashmap.GetValue(key: TKey; out value: TValue): boolean;
+var i,bs:SizeUInt;
+    curbucket:TContainer;
 begin
-  h:=Thash.hash(key,FData.size);
-  bs:=(FData[h]).size;
-  for i:=0 to bs-1 do begin
-    if (((FData[h])[i]).Key=key) then begin
-      ((FData[h]).mutable[i])^.value := value;
+  curbucket:=FData[THash.hash(key,FData.size)];
+  bs:=curbucket.size;
+  i:=0;
+  while i < bs do begin
+{$ifdef STL_INTERFACE_EXT}
+    if THash.equal(curbucket[i].Key, key) then begin
+{$else}
+    if (curbucket[i].Key = key) then begin
+{$endif}
+      value:=curbucket[i].Value;
+      exit(true);
+    end;
+    inc(i);
+  end;
+  exit(false);
+end;
+
+procedure THashmap.insert(key: TKey; value: TValue);
+var pair:TPair;
+    i,bs:SizeUInt;
+    curbucket:TContainer;
+begin
+  curbucket:=FData[THash.hash(key,FData.size)];
+  bs:=curbucket.size;
+  i:=0;
+  while i < bs do begin
+{$ifdef STL_INTERFACE_EXT}
+    if THash.equal(curbucket[i].Key, key) then begin
+{$else}
+    if (curbucket[i].Key = key) then begin
+{$endif}
+      (curbucket.mutable[i])^.value := value;
       exit;
     end;
+    inc(i);
   end;
   pair.Key := key;
   pair.Value := value;
   inc(FDataSize);
-  (FData[h]).pushback(pair);
+  curbucket.pushback(pair);
 
-  if (FDataSize > 5*FData.size) then
+  if (FDataSize > maxLoadingFactor*FData.size) then
     EnlargeTable;
 end;
 
-procedure THashmap.delete(key:TKey);inline;
-var h,i:SizeUInt;
+procedure THashmap.delete(key: TKey);
+var i,bs:SizeUInt;
+    curbucket:TContainer;
 begin
-  h:=Thash.hash(key,FData.size);
+  curbucket:=FData[THash.hash(key,FData.size)];
+  bs:=curbucket.size;
   i:=0;
-  while i < (FData[h]).size do begin
-    if (((FData[h])[i]).key=key) then begin
-      (FData[h])[i] := (FData[h]).back;
-      (FData[h]).popback;
+  while i < bs do begin
+{$ifdef STL_INTERFACE_EXT}
+    if THash.equal(curbucket[i].Key, key) then begin
+{$else}
+    if (curbucket[i].Key = key) then begin
+{$endif}
+      //if (i+1) < bs then
+        curbucket[i] := curbucket.back;
+      curbucket.popback;
       dec(FDataSize);
       exit;
     end;
@@ -187,26 +259,58 @@ begin
   end;
 end;
 
-function THashmapIterator.Next:boolean;
+procedure THashmap.erase(iter: TIterator);
+var curbucket:TContainer;
+begin
+  curbucket:=FData[iter.Fh];
+  //if (iter.Fp+1) < curbucket.size then
+    curbucket[iter.Fp] := curbucket.back;
+  curbucket.popback;
+  dec(FDataSize);
+  iter.Prev;
+end;
+
+function THashmapIterator.Next: boolean;
 begin
+  Assert(Fh < FData.size);      // assumes FData.size>0 (i.e. buckets don't shrink) and cannot call Next again after reaching end
   inc(Fp);
-  if (Fp = (FData[Fh]).size) then begin
-    Fp:=0; inc(Fh);
-    while Fh < FData.size do begin
-      if ((FData[Fh]).size > 0) then break;
-      inc(Fh);
+  if (Fp < (FData[Fh]).size) then
+    exit(true);
+  Fp:=0; Inc(Fh);
+  while Fh < FData.size do begin
+    if ((FData[Fh]).size > 0) then
+      exit(true);
+    Inc(Fh);
+  end;
+  //Assert((Fp = 0) and (Fh = FData.size));
+  exit(false);
+end;
+
+function THashmapIterator.Prev: boolean;
+var bs:SizeUInt;
+begin
+  if (Fp > 0) then begin
+    dec(Fp);
+    exit(true);
+  end;
+  while Fh > 0 do begin
+    Dec(Fh);
+    bs:=(FData[Fh]).size;
+    if (bs > 0) then begin
+      Fp:=bs-1;
+      exit(true);
     end;
-    if (Fh = FData.size) then exit(false);
   end;
-  Next := true;
+  //Assert((Fp = 0) and (Fh = 0));
+  exit(false);
 end;
 
-function THashmapIterator.GetData:T;
+function THashmapIterator.GetData: T;
 begin
   GetData:=(FData[Fh])[Fp];
 end;
 
-function THashmap.Iterator:TIterator;
+function THashmap.Iterator: TIterator;
 var h,p:SizeUInt;
 begin
   h:=0;
@@ -222,22 +326,22 @@ begin
   Iterator.FData := FData;
 end;
 
-function THashmapIterator.GetKey:TKey;inline;
+function THashmapIterator.GetKey: TKey;
 begin
   GetKey:=((FData[Fh])[Fp]).Key;
 end;
 
-function THashmapIterator.GetValue:TValue;inline;
+function THashmapIterator.GetValue: TValue;
 begin
   GetValue:=((FData[Fh])[Fp]).Value;
 end;
 
-function THashmapIterator.GetMutable:PValue;inline;
+function THashmapIterator.GetMutable: PValue;
 begin
   GetMutable:=@((FData[Fh]).Mutable[Fp]^.Value);
 end;
 
-procedure THashmapIterator.SetValue(value:TValue);inline;
+procedure THashmapIterator.SetValue(value:TValue);
 begin
   ((FData[Fh]).mutable[Fp])^.Value := value;
 end;

packages/fcl-stl/src/glinkedlist.pp

@@ -0,0 +1,360 @@
+{
+   This file is part of the Free Pascal FCL library.
+   Donated in 2013 by Denis Volodarsky
+
+   This unit implements a generic double linked list for FPC.
+
+   See the file COPYING.FPC, included in this distribution,
+   for details about the copyright.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY;without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+{
+}
+unit glinkedlist;
+
+{$MODE DELPHI}
+
+interface
+
+type
+  // Delphi compatible types.
+  TCollectionNotification = (cnAdded, cnRemoved, cnExtracted);
+  TCollectionNotifyEvent<T> = procedure(Sender: TObject; const Item: T;
+    Action: TCollectionNotification) of object;
+
+type
+
+  { TLinkedList }
+
+  TLinkedList<T> = class
+  type
+    PItem = ^TItem;
+
+    TItem = record
+    private
+      List: TLinkedList<T>; // owner
+    public
+      Data: T;
+      Prev: PItem;
+      Next: PItem;
+      function IsFirst: boolean; inline;
+      function IsLast: boolean; inline;
+      function IsSingle: boolean; inline;
+      function InsertAfter(const Value: T): PItem; inline;
+      function InsertBefore(const Value: T): PItem; inline;
+    end;
+
+    TTraverseFunc = function(Item: PItem; ud: pointer): boolean;
+  private
+    FCount: integer;
+    FFirst, FLast: PItem;
+    FOnNotify: TCollectionNotifyEvent<T>;
+  protected
+    procedure DoNotify(const Item: T; Action: TCollectionNotification);
+    procedure Traverse(cb: TTraverseFunc; ud: pointer);
+
+    // Following Link/Unlink functions do not modify Count or call Notification.
+    procedure LinkAfter(Pos, Item: PItem); inline;
+    procedure LinkBefore(Pos, Item: PItem); inline;
+    procedure Unlink(Item: PItem); inline;
+  public
+    destructor Destroy; override;
+
+    procedure Clear;
+    procedure Delete(Item: PItem);
+
+    // Insert Value to start of the list.
+    function InsertFirst(const Value: T): PItem;
+
+    // Insert Value to end of the list.
+    function InsertLast(const Value: T): PItem;
+
+    function InsertAfter(Item: PItem; const Value: T): PItem;
+    function InsertBefore(Item: PItem; const Value: T): PItem;
+
+    // First item moved to end.
+    procedure RotateLeft;
+
+    // Last item moved to begin.
+    procedure RotateRight;
+
+    property Count: integer read FCount;
+    property First: PItem read FFirst;
+    property Last: PItem read FLast;
+    property OnNotify: TCollectionNotifyEvent<T> read FOnNotify write FOnNotify;
+
+  type
+
+    { TEnumerator }
+
+    TEnumerator = class
+    private
+      FList: TLinkedList<T>;
+      FCurrent: PItem;
+    protected
+      function DoGetCurrent: T;
+      function DoMoveNext: boolean;
+    public
+      constructor Create(AList: TLinkedList<T>);
+      function MoveNext: boolean;
+      property Current: T read DoGetCurrent;
+    end;
+
+  function GetEnumerator: TEnumerator; reintroduce;
+
+  end;
+
+implementation
+
+{ TLinkedList<T>.TItem }
+
+function TLinkedList<T>.TItem.InsertAfter(const Value: T): PItem;
+begin
+  Result := List.InsertAfter(@self, Value);
+end;
+
+function TLinkedList<T>.TItem.InsertBefore(const Value: T): PItem;
+begin
+  Result := List.InsertBefore(@self, Value);
+end;
+
+function TLinkedList<T>.TItem.IsFirst: boolean;
+begin
+  Result := not Assigned(Prev);
+end;
+
+function TLinkedList<T>.TItem.IsLast: boolean;
+begin
+  Result := not Assigned(Next);
+end;
+
+function TLinkedList<T>.TItem.IsSingle: boolean;
+begin
+  Result := IsFirst and IsLast;
+end;
+
+{ TLinkedList<T> }
+
+destructor TLinkedList<T>.Destroy;
+begin
+  Clear;
+  Inherited;
+end;
+
+procedure TLinkedList<T>.DoNotify(const Item: T; Action: TCollectionNotification);
+begin
+  if Assigned(FOnNotify) then
+    FOnNotify(self, Item, Action);
+end;
+
+procedure TLinkedList<T>.Clear;
+var
+  Next: PItem;
+  OldValue: T;
+begin
+  if (FCount <> 0) then
+  begin
+    while Assigned(FFirst) do
+    begin
+      OldValue := FFirst^.Data;
+      Next := FFirst^.Next;
+      Dispose(FFirst);
+      FFirst := Next;
+      if FFirst = nil then
+        FLast := nil;
+      dec(FCount);
+      DoNotify(OldValue, cnRemoved);
+    end;
+  end;
+end;
+
+procedure TLinkedList<T>.Delete(Item: PItem);
+begin
+  if Assigned(Item) then
+  begin
+    Unlink(Item);
+    Dec(FCount);
+    DoNotify(Item^.Data, cnRemoved);
+    Dispose(Item);
+  end;
+end;
+
+procedure TLinkedList<T>.Traverse(cb: TTraverseFunc; ud: pointer);
+var
+  Cur, Next: PItem;
+begin
+  if Assigned(cb) then
+  begin
+    Cur := First;
+    while Assigned(Cur) do
+    begin
+      Next := Cur^.Next;
+      if not cb(Cur, ud) then
+        break;
+      Cur := Next;
+    end;
+  end;
+end;
+
+procedure TLinkedList<T>.Unlink(Item: PItem);
+begin
+  if Item^.IsFirst then
+    FFirst := Item^.Next
+  else
+    Item^.Prev^.Next := Item^.Next;
+
+  if Item^.IsLast then
+    FLast := Item^.Prev
+  else
+    Item^.Next^.Prev := Item^.Prev;
+end;
+
+function TLinkedList<T>.InsertFirst(const Value: T): PItem;
+begin
+  if FCount <> 0 then
+    Exit(InsertBefore(FFirst, Value));
+
+  // List is empty: add first item.
+  new(Result);
+  Result^.List := self;
+  Result^.Data := Value;
+
+  Result^.Prev := nil;
+  Result^.Next := nil;
+  FFirst := Result;
+  FLast := Result;
+
+  inc(FCount);
+  DoNotify(Value, cnAdded);
+end;
+
+function TLinkedList<T>.InsertAfter(Item: PItem; const Value: T): PItem;
+begin
+  if Assigned(Item) then
+  begin
+    new(Result);
+    Result^.List := self;
+    Result^.Data := Value;
+    LinkAfter(Item, Result);
+    inc(FCount);
+    DoNotify(Value, cnAdded);
+    Exit;
+  end;
+  Exit(nil);
+end;
+
+function TLinkedList<T>.InsertBefore(Item: PItem; const Value: T): PItem;
+begin
+  if Assigned(Item) then
+  begin
+    new(Result);
+    Result^.List := self;
+    Result^.Data := Value;
+    LinkBefore(Item, Result);
+    inc(FCount);
+    DoNotify(Value, cnAdded);
+    Exit;
+  end;
+  Exit(nil);
+end;
+
+function TLinkedList<T>.InsertLast(const Value: T): PItem;
+begin
+  if FCount = 0 then
+    Result := InsertFirst(Value)
+  else
+    Result := InsertAfter(FLast, Value);
+end;
+
+procedure TLinkedList<T>.LinkAfter(Pos, Item: PItem);
+var
+  PosNext: PItem;
+begin
+  PosNext := Pos^.Next;
+  Pos^.Next := Item;
+  if Assigned(PosNext) then
+    PosNext^.Prev := Item
+  else
+    FLast := Item;
+  Item^.Prev := Pos;
+  Item^.Next := PosNext;
+end;
+
+procedure TLinkedList<T>.LinkBefore(Pos, Item: PItem);
+var
+  PosPrev: PItem;
+begin
+  PosPrev := Pos^.Prev;
+  Pos^.Prev := Item;
+  if Assigned(PosPrev) then
+    PosPrev^.Next := Item
+  else
+    FFirst := Item;
+  Item^.Prev := PosPrev;
+  Item^.Next := Pos;
+end;
+
+procedure TLinkedList<T>.RotateLeft;
+var
+  tmp: PItem;
+begin
+  if FCount > 1 then
+  begin
+    tmp := FFirst;
+    Unlink(tmp);
+    LinkAfter(FLast, tmp);
+  end;
+end;
+
+procedure TLinkedList<T>.RotateRight;
+var
+  tmp: PItem;
+begin
+  if FCount > 1 then
+  begin
+    tmp := FLast;
+    Unlink(tmp);
+    LinkBefore(FFirst, tmp);
+  end;
+end;
+
+constructor TLinkedList<T>.TEnumerator.Create(AList: TLinkedList<T>);
+begin
+  inherited Create;
+  FList := AList;
+  FCurrent := nil;
+end;
+
+function TLinkedList<T>.TEnumerator.MoveNext: boolean;
+begin
+  Result := DoMoveNext;
+end;
+
+function TLinkedList<T>.TEnumerator.DoGetCurrent: T;
+begin
+  Result := FCurrent.Data;
+end;
+
+function TLinkedList<T>.TEnumerator.DoMoveNext: boolean;
+begin
+  if not Assigned(FCurrent) then
+  begin
+    FCurrent := FList.First;
+    Result := Assigned(FCurrent);
+    Exit;
+  end;
+  Result := Assigned(FCurrent.Next);
+  if Result then
+    FCurrent := FCurrent.Next;
+end;
+
+function TLinkedList<T>.GetEnumerator: TEnumerator;
+begin
+  Result := TEnumerator.Create(self);
+end;
+
+end.

packages/fcl-stl/tests/glinkedlisttest.pp

@@ -0,0 +1,176 @@
+program LLTest;
+
+{$apptype console}
+
+uses
+  glinkedlist;
+
+type
+  IMyIntf = interface
+    function GetName: string;
+    property Name: string read GetName;
+  end;
+
+  { TMyClass }
+
+  TMyClass = class(TInterfacedObject, IMyIntf)
+  protected
+    FName: string;
+  public
+    constructor Create(const AName: string);
+    function GetName: string;
+  end;
+
+  TIntfLL = specialize TLinkedList<IMyIntf>;
+
+  { TTest }
+
+  TTest = class
+    FList: TIntfLL;
+    procedure Notification(Sender: TObject; const Item: IMyIntf; Action: TCollectionNotification);
+    procedure SetupItems;
+    procedure PrintList;
+    function Main: TTest;
+  end;
+
+operator :=(const AValue: string): IMyIntf;
+begin
+  Result := TMyClass.Create(AValue);
+end;
+
+{ TTest }
+
+procedure TTest.Notification(Sender: TObject; const Item: IMyIntf;
+  Action: TCollectionNotification);
+var
+  LL: TIntfLL;
+begin
+  LL := (Sender as TIntfLL);
+  case Action of
+    cnAdded:
+      write('added');
+    cnRemoved:
+      write('removed');
+  end;
+  write(' "', Item.GetName, '"; ');
+  write('count=', LL.Count, '; ');
+
+  write('first=');
+  if LL.First = nil then
+    write('nil')
+  else
+    write('"' + LL.First^.Data.Name, '"');
+
+  write(' ');
+
+  write('last=');
+  if LL.Last = nil then
+    write('nil')
+  else
+    write('"' + LL.Last^.Data.Name, '" ');
+
+  writeln;
+end;
+
+procedure TTest.SetupItems;
+begin
+  // add items "1" to "8"
+  FList.InsertLast('4')^.InsertAfter('5')^.InsertAfter('6');
+  FList.InsertFirst('3')^.InsertBefore('2')^.InsertBefore('1');
+  FList.Last^.InsertAfter('7')^.InsertAfter('8');
+end;
+
+procedure TTest.PrintList;
+var
+  i: IMyIntf;
+begin
+  write('"');
+  for i in FList do
+    write(i.GetName, ' ');
+  writeln('"');
+end;
+
+function TTest.Main: TTest;
+var
+  i: integer;
+  item: TIntfLL.PItem;
+begin
+  FList := TIntfLL.Create;
+  try
+    FList.OnNotify := @Notification;
+
+    // setup and print items
+    SetupItems;
+    PrintList;
+    WriteLn;
+    // print ROL
+    for i := 1 to 8 do
+    begin
+      FList.RotateLeft;
+      PrintList;
+    end;
+    WriteLn;
+    // print ROR
+    for i := 1 to 8 do
+    begin
+      FList.RotateRight;
+      PrintList;
+    end;
+    WriteLn;
+    // print deleting first item
+    for i := 1 to 8 do
+    begin
+      FList.Delete(FList.First);
+      PrintList;
+    end;
+    WriteLn;
+    // print deleting last item
+    SetupItems;
+    for i := 1 to 8 do
+    begin
+      FList.Delete(FList.Last);
+      PrintList;
+    end;
+    WriteLn;
+
+    // delete some item from middle
+    SetupItems;
+    PrintList;
+    item := FList.First^.Next^.Next^.Next;
+    WriteLn(item^.data.GetName);
+    FList.Delete(item);
+    PrintList;
+    WriteLn;
+
+    // clear all items
+    FList.Clear;
+    PrintList;
+    WriteLn;
+  finally
+    FList.Free;
+  end;
+  Result:=Self;
+end;
+
+{ TMyClass }
+
+constructor TMyClass.Create(const AName: string);
+begin
+  inherited Create;
+  FName := AName;
+end;
+
+function TMyClass.GetName: string;
+begin
+  Result := FName;
+end;
+
+begin
+  With TTest.Create do
+    try
+      Main;
+    finally
+      Free;
+    end;
+end.
+

rtl/objpas/fgl.pp

@@ -305,6 +305,57 @@ type
     function Add(const AKey: TKey; const AData: TData): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
     function Add(const AKey: TKey): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
     function Find(const AKey: TKey; out Index: Integer): Boolean; {$ifdef CLASSESINLINE} inline; {$endif}
+    function TryGetData(const AKey: TKey; out AData: TData): Boolean; {$ifdef CLASSESINLINE} inline; {$endif}
+    procedure AddOrSetData(const AKey: TKey; const AData: TData); {$ifdef CLASSESINLINE} inline; {$endif}
+    function IndexOf(const AKey: TKey): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
+    function IndexOfData(const AData: TData): Integer;
+    procedure InsertKey(Index: Integer; const AKey: TKey);
+    procedure InsertKeyData(Index: Integer; const AKey: TKey; const AData: TData);
+    function Remove(const AKey: TKey): Integer;
+    property Keys[Index: Integer]: TKey read GetKey write PutKey;
+    property Data[Index: Integer]: TData read GetData write PutData;
+    property KeyData[const AKey: TKey]: TData read GetKeyData write PutKeyData; default;
+    property OnCompare: TKeyCompareFunc read FOnKeyCompare write SetOnKeyCompare; //deprecated;
+    property OnKeyCompare: TKeyCompareFunc read FOnKeyCompare write SetOnKeyCompare;
+    property OnDataCompare: TDataCompareFunc read FOnDataCompare write SetOnDataCompare;
+  end;
+
+  generic TFPGMapObject<TKey, TData> = class(TFPSMap)
+  private
+    type
+      TKeyCompareFunc = function(const Key1, Key2: TKey): Integer;
+      TDataCompareFunc = function(const Data1, Data2: TData): Integer;
+      PKey = ^TKey;
+// unsed      PData = ^TData;
+  {$ifndef OldSyntax}protected var{$else}var protected{$endif}
+      FOnKeyCompare: TKeyCompareFunc;
+      FOnDataCompare: TDataCompareFunc;
+      FFreeObjects: Boolean;
+    procedure CopyItem(Src, Dest: Pointer); override;
+    procedure CopyKey(Src, Dest: Pointer); override;
+    procedure CopyData(Src, Dest: Pointer); override;
+    procedure Deref(Item: Pointer); override;
+    procedure InitOnPtrCompare; override;
+    function GetKey(Index: Integer): TKey; {$ifdef CLASSESINLINE} inline; {$endif}
+    function GetKeyData(const AKey: TKey): TData; {$ifdef CLASSESINLINE} inline; {$endif}
+    function GetData(Index: Integer): TData; {$ifdef CLASSESINLINE} inline; {$endif}
+    function KeyCompare(Key1, Key2: Pointer): Integer;
+    function KeyCustomCompare(Key1, Key2: Pointer): Integer;
+    //function DataCompare(Data1, Data2: Pointer): Integer;
+    function DataCustomCompare(Data1, Data2: Pointer): Integer;
+    procedure PutKey(Index: Integer; const NewKey: TKey); {$ifdef CLASSESINLINE} inline; {$endif}
+    procedure PutKeyData(const AKey: TKey; const NewData: TData); {$ifdef CLASSESINLINE} inline; {$endif}
+    procedure PutData(Index: Integer; const NewData: TData); {$ifdef CLASSESINLINE} inline; {$endif}
+    procedure SetOnKeyCompare(NewCompare: TKeyCompareFunc);
+    procedure SetOnDataCompare(NewCompare: TDataCompareFunc);
+  public
+    constructor Create(AFreeObjects: Boolean);
+    constructor Create;
+    function Add(const AKey: TKey; const AData: TData): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
+    function Add(const AKey: TKey): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
+    function Find(const AKey: TKey; out Index: Integer): Boolean; {$ifdef CLASSESINLINE} inline; {$endif}
+    function TryGetData(const AKey: TKey; out AData: TData): Boolean; {$ifdef CLASSESINLINE} inline; {$endif}
+    procedure AddOrSetData(const AKey: TKey; const AData: TData); {$ifdef CLASSESINLINE} inline; {$endif}
     function IndexOf(const AKey: TKey): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
     function IndexOfData(const AData: TData): Integer;
     procedure InsertKey(Index: Integer; const AKey: TKey);
@@ -350,6 +401,8 @@ type
     function Add(const AKey: TKey; const AData: TData): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
     function Add(const AKey: TKey): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
     function Find(const AKey: TKey; out Index: Integer): Boolean; {$ifdef CLASSESINLINE} inline; {$endif}
+    function TryGetData(const AKey: TKey; out AData: TData): Boolean; {$ifdef CLASSESINLINE} inline; {$endif}
+    procedure AddOrSetData(const AKey: TKey; const AData: TData); {$ifdef CLASSESINLINE} inline; {$endif}
     function IndexOf(const AKey: TKey): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
     function IndexOfData(const AData: TData): Integer;
     procedure InsertKey(Index: Integer; const AKey: TKey);
@@ -1257,7 +1310,7 @@ begin
   R := FCount-1;
   while L<=R do
   begin
-    I := (L+R) div 2;
+    I := L + (R - L) div 2;
     Dir := FOnKeyPtrCompare(Items[I], AKey);
     if Dir < 0 then
       L := I+1
@@ -1481,6 +1534,26 @@ begin
   Result := inherited Find(@AKey, Index);
 end;
 
+function TFPGMap.TryGetData(const AKey: TKey; out AData: TData): Boolean;
+var
+  I: Integer;
+begin
+  Result := inherited Find(@AKey, I);
+  if Result then
+    AData := TData(inherited GetData(I)^)
+  else
+{$IFDEF VER2_6}  
+    FillChar(AData,SizeOf(TData),0);
+{$ELSE}
+    AData := Default(TData);
+{$ENDIF}    
+end;
+
+procedure TFPGMap.AddOrSetData(const AKey: TKey; const AData: TData);
+begin
+  inherited PutKeyData(@AKey, @AData);
+end;
+
 function TFPGMap.IndexOf(const AKey: TKey): Integer;
 begin
   Result := inherited IndexOf(@AKey);
@@ -1507,6 +1580,191 @@ begin
   Result := inherited Remove(@AKey);
 end;
 
+{****************************************************************************
+                             TFPGMapObject
+ ****************************************************************************}
+
+constructor TFPGMapObject.Create(AFreeObjects: Boolean);
+begin
+  inherited Create(SizeOf(TKey), SizeOf(TData));
+  FFreeObjects := AFreeObjects;
+end;
+
+constructor TFPGMapObject.Create;
+begin
+  Create(True);
+end;
+
+procedure TFPGMapObject.CopyItem(Src, Dest: Pointer);
+begin
+  CopyKey(Src, Dest);
+  CopyData(PByte(Src)+KeySize, PByte(Dest)+KeySize);
+end;
+
+procedure TFPGMapObject.CopyKey(Src, Dest: Pointer);
+begin
+  TKey(Dest^) := TKey(Src^);
+end;
+
+procedure TFPGMapObject.CopyData(Src, Dest: Pointer);
+begin
+  if Assigned(Pointer(Dest^)) then
+    TData(Dest^).Free;
+  TData(Dest^) := TData(Src^);
+end;
+
+procedure TFPGMapObject.Deref(Item: Pointer);
+begin
+  Finalize(TKey(Item^));
+  if Assigned(PPointer(PByte(Item)+KeySize)^) and FFreeObjects then
+    TData(Pointer(PByte(Item)+KeySize)^).Free;
+end;
+
+function TFPGMapObject.GetKey(Index: Integer): TKey;
+begin
+  Result := TKey(inherited GetKey(Index)^);
+end;
+
+function TFPGMapObject.GetData(Index: Integer): TData;
+begin
+  Result := TData(inherited GetData(Index)^);
+end;
+
+function TFPGMapObject.GetKeyData(const AKey: TKey): TData;
+begin
+  Result := TData(inherited GetKeyData(@AKey)^);
+end;
+
+function TFPGMapObject.KeyCompare(Key1, Key2: Pointer): Integer;
+begin
+  if PKey(Key1)^ < PKey(Key2)^ then
+    Result := -1
+  else if PKey(Key1)^ > PKey(Key2)^ then
+    Result := 1
+  else
+    Result := 0;
+end;
+
+{function TFPGMapObject.DataCompare(Data1, Data2: Pointer): Integer;
+begin
+  if PData(Data1)^ < PData(Data2)^ then
+    Result := -1
+  else if PData(Data1)^ > PData(Data2)^ then
+    Result := 1
+  else
+    Result := 0;
+end;}
+
+function TFPGMapObject.KeyCustomCompare(Key1, Key2: Pointer): Integer;
+begin
+  Result := FOnKeyCompare(TKey(Key1^), TKey(Key2^));
+end;
+
+function TFPGMapObject.DataCustomCompare(Data1, Data2: Pointer): Integer;
+begin
+  Result := FOnDataCompare(TData(Data1^), TData(Data2^));
+end;
+
+procedure TFPGMapObject.SetOnKeyCompare(NewCompare: TKeyCompareFunc);
+begin
+  FOnKeyCompare := NewCompare;
+  if NewCompare <> nil then
+    OnKeyPtrCompare := @KeyCustomCompare
+  else
+    OnKeyPtrCompare := @KeyCompare;
+end;
+
+procedure TFPGMapObject.SetOnDataCompare(NewCompare: TDataCompareFunc);
+begin
+  FOnDataCompare := NewCompare;
+  if NewCompare <> nil then
+    OnDataPtrCompare := @DataCustomCompare
+  else
+    OnDataPtrCompare := nil;
+end;
+
+procedure TFPGMapObject.InitOnPtrCompare;
+begin
+  SetOnKeyCompare(nil);
+  SetOnDataCompare(nil);
+end;
+
+procedure TFPGMapObject.PutKey(Index: Integer; const NewKey: TKey);
+begin
+  inherited PutKey(Index, @NewKey);
+end;
+
+procedure TFPGMapObject.PutData(Index: Integer; const NewData: TData);
+begin
+  inherited PutData(Index, @NewData);
+end;
+
+procedure TFPGMapObject.PutKeyData(const AKey: TKey; const NewData: TData);
+begin
+  inherited PutKeyData(@AKey, @NewData);
+end;
+
+function TFPGMapObject.Add(const AKey: TKey): Integer;
+begin
+  Result := inherited Add(@AKey);
+end;
+
+function TFPGMapObject.Add(const AKey: TKey; const AData: TData): Integer;
+begin
+  Result := inherited Add(@AKey, @AData);
+end;
+
+function TFPGMapObject.Find(const AKey: TKey; out Index: Integer): Boolean;
+begin
+  Result := inherited Find(@AKey, Index);
+end;
+
+function TFPGMapObject.TryGetData(const AKey: TKey; out AData: TData): Boolean;
+var
+  I: Integer;
+begin
+  Result := inherited Find(@AKey, I);
+  if Result then
+    AData := TData(inherited GetData(I)^)
+  else
+{$IFDEF VER2_6}
+    FillChar(AData,SizeOf(TData),0);
+{$ELSE}
+    AData := Default(TData);
+{$ENDIF}
+end;
+
+procedure TFPGMapObject.AddOrSetData(const AKey: TKey; const AData: TData);
+begin
+  inherited PutKeyData(@AKey, @AData);
+end;
+
+function TFPGMapObject.IndexOf(const AKey: TKey): Integer;
+begin
+  Result := inherited IndexOf(@AKey);
+end;
+
+function TFPGMapObject.IndexOfData(const AData: TData): Integer;
+begin
+  { TODO: loop ? }
+  Result := inherited IndexOfData(@AData);
+end;
+
+procedure TFPGMapObject.InsertKey(Index: Integer; const AKey: TKey);
+begin
+  inherited InsertKey(Index, @AKey);
+end;
+
+procedure TFPGMapObject.InsertKeyData(Index: Integer; const AKey: TKey; const AData: TData);
+begin
+  inherited InsertKeyData(Index, @AKey, @AData);
+end;
+
+function TFPGMapObject.Remove(const AKey: TKey): Integer;
+begin
+  Result := inherited Remove(@AKey);
+end;
+
 {****************************************************************************
                              TFPGMapInterfacedObjectData
  ****************************************************************************}
@@ -1642,6 +1900,27 @@ begin
   Result := inherited Find(@AKey, Index);
 end;
 
+function TFPGMapInterfacedObjectData.TryGetData(const AKey: TKey; out AData: TData): Boolean;
+var
+  I: Integer;
+begin
+  Result := inherited Find(@AKey, I);
+  if Result then
+    AData := TData(inherited GetData(I)^)
+  else
+{$IFDEF VER2_6}
+    FillChar(AData,SizeOf(TData),0);
+{$ELSE}
+    AData := Default(TData);
+{$ENDIF}
+end;
+
+procedure TFPGMapInterfacedObjectData.AddOrSetData(const AKey: TKey;
+  const AData: TData);
+begin
+  inherited PutKeyData(@AKey, @AData);
+end;
+
 function TFPGMapInterfacedObjectData.IndexOf(const AKey: TKey): Integer;
 begin
   Result := inherited IndexOf(@AKey);