From a9fe42b5f02077f3e8340c64dcfec43d26f32e1f Mon Sep 17 00:00:00 2001 From: michael Date: Mon, 21 Mar 2016 21:01:38 +0000 Subject: [PATCH] * Generic linked list class, donated by Denis Volodarsky (bug ID 24501) git-svn-id: trunk@33311 - --- .gitattributes | 2 + packages/fcl-stl/fpmake.pp | 1 + packages/fcl-stl/src/glinkedlist.pp | 360 ++++++++++++++++++++++ packages/fcl-stl/tests/glinkedlisttest.pp | 176 +++++++++++ 4 files changed, 539 insertions(+) create mode 100644 packages/fcl-stl/src/glinkedlist.pp create mode 100644 packages/fcl-stl/tests/glinkedlisttest.pp diff --git a/.gitattributes b/.gitattributes index bb671f7e2e..6968acacd5 100644 --- a/.gitattributes +++ b/.gitattributes @@ -2901,6 +2901,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 @@ -2915,6 +2916,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 diff --git a/packages/fcl-stl/fpmake.pp b/packages/fcl-stl/fpmake.pp index 49c6989afd..3b04d77104 100644 --- a/packages/fcl-stl/fpmake.pp +++ b/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 diff --git a/packages/fcl-stl/src/glinkedlist.pp b/packages/fcl-stl/src/glinkedlist.pp new file mode 100644 index 0000000000..b403e97df7 --- /dev/null +++ b/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 = procedure(Sender: TObject; const Item: T; + Action: TCollectionNotification) of object; + +type + + { TLinkedList } + + TLinkedList = class + type + PItem = ^TItem; + + TItem = record + private + List: TLinkedList; // 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; + 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 read FOnNotify write FOnNotify; + + type + + { TEnumerator } + + TEnumerator = class + private + FList: TLinkedList; + FCurrent: PItem; + protected + function DoGetCurrent: T; + function DoMoveNext: boolean; + public + constructor Create(AList: TLinkedList); + function MoveNext: boolean; + property Current: T read DoGetCurrent; + end; + + function GetEnumerator: TEnumerator; reintroduce; + + end; + +implementation + +{ TLinkedList.TItem } + +function TLinkedList.TItem.InsertAfter(const Value: T): PItem; +begin + Result := List.InsertAfter(@self, Value); +end; + +function TLinkedList.TItem.InsertBefore(const Value: T): PItem; +begin + Result := List.InsertBefore(@self, Value); +end; + +function TLinkedList.TItem.IsFirst: boolean; +begin + Result := not Assigned(Prev); +end; + +function TLinkedList.TItem.IsLast: boolean; +begin + Result := not Assigned(Next); +end; + +function TLinkedList.TItem.IsSingle: boolean; +begin + Result := IsFirst and IsLast; +end; + +{ TLinkedList } + +destructor TLinkedList.Destroy; +begin + Clear; + Inherited; +end; + +procedure TLinkedList.DoNotify(const Item: T; Action: TCollectionNotification); +begin + if Assigned(FOnNotify) then + FOnNotify(self, Item, Action); +end; + +procedure TLinkedList.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.Delete(Item: PItem); +begin + if Assigned(Item) then + begin + Unlink(Item); + Dec(FCount); + DoNotify(Item^.Data, cnRemoved); + Dispose(Item); + end; +end; + +procedure TLinkedList.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.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.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.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.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.InsertLast(const Value: T): PItem; +begin + if FCount = 0 then + Result := InsertFirst(Value) + else + Result := InsertAfter(FLast, Value); +end; + +procedure TLinkedList.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.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.RotateLeft; +var + tmp: PItem; +begin + if FCount > 1 then + begin + tmp := FFirst; + Unlink(tmp); + LinkAfter(FLast, tmp); + end; +end; + +procedure TLinkedList.RotateRight; +var + tmp: PItem; +begin + if FCount > 1 then + begin + tmp := FLast; + Unlink(tmp); + LinkBefore(FFirst, tmp); + end; +end; + +constructor TLinkedList.TEnumerator.Create(AList: TLinkedList); +begin + inherited Create; + FList := AList; + FCurrent := nil; +end; + +function TLinkedList.TEnumerator.MoveNext: boolean; +begin + Result := DoMoveNext; +end; + +function TLinkedList.TEnumerator.DoGetCurrent: T; +begin + Result := FCurrent.Data; +end; + +function TLinkedList.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.GetEnumerator: TEnumerator; +begin + Result := TEnumerator.Create(self); +end; + +end. diff --git a/packages/fcl-stl/tests/glinkedlisttest.pp b/packages/fcl-stl/tests/glinkedlisttest.pp new file mode 100644 index 0000000000..f712da4b6d --- /dev/null +++ b/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; + + { 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. +