* Added generic TStack/TObjectStack and tests

packages/rtl/generics.collections.pas

@@ -113,7 +113,6 @@ type
     property Count: SizeInt read GetCount;
     property Capacity: SizeInt read GetCapacity write SetCapacity;
     property OnNotify: TCollectionNotifyEvent<T> read FOnNotify write FOnNotify;
-
     procedure TrimExcess; virtual; abstract;
   end;
 
@@ -131,6 +130,20 @@ type
     constructor Create(AList: TCustomList<T>);
   end;
 
+  { TCustomInvertedListEnumerator }
+
+  TCustomInvertedListEnumerator<T> = class abstract(TEnumerator<T>)
+  private
+    FList: TCustomList<T>;
+    FIndex: SizeInt;
+  protected
+    function DoMoveNext: boolean; override;
+    function DoGetCurrent: T; override;
+    function GetCurrent: T; virtual;
+  public
+    constructor Create(AList: TCustomList<T>);
+  end;
+
   { TList }
 {$SCOPEDENUMS ON}
   TDirection = (FromBeginning,fromEnd);
@@ -268,6 +281,8 @@ type
     function Peek: T;
     procedure Clear;
     procedure TrimExcess; override;
+    // Maximum gap (=amount of empty slots in array before first element)
+    // before doing a rebase of the list. Defaults to 10.
     Property MaxGapLength : Integer Read FMaxGapLength Write FMaxGapLength;
   end;
 
@@ -281,7 +296,51 @@ type
   public
     constructor Create(AOwnsObjects: Boolean = True); overload;
     constructor Create2(const Collection: TEnumerable<T>; AOwnsObjects: Boolean = True); overload;
-    procedure Dequeue; reintroduce;
+    procedure Dequeue; reintroduce; // Can't use the result, it might have been freed;
+    property OwnsObjects: Boolean read FOwnsObjects write FOwnsObjects;
+  end;
+
+  { TStack }
+
+  TStack<T> = class(TCustomList<T>)
+  private
+  protected
+    function DoRemove(AIndex: SizeInt; ACollectionNotification: TCollectionNotification): T; override;
+    procedure SetCapacity(AValue: SizeInt); override;
+    function DoGetEnumerator: TEnumerator<T>; override;
+  public
+    type
+      TMyType = TStack<T>;
+
+      { TEnumerator }
+
+      TEnumerator = class(TCustomInvertedListEnumerator<T>)
+      public
+        constructor Create(AStack: TMyType);
+      end;
+    function GetEnumerator: TEnumerator; reintroduce;
+  Public
+    destructor Destroy; override;
+    procedure Clear;
+    procedure Push(const aValue: T);
+    function Pop: T;
+    function Peek: T;
+    function Extract: T;
+    procedure TrimExcess;
+    property Count: SizeInt read GetCount;
+  end;
+
+  { TObjectStack }
+
+  TObjectStack<T: class> = class(TStack<T>)
+  private
+    FOwnsObjects: Boolean;
+  protected
+    procedure Notify(const aValue: T; Action: TCollectionNotification); override;
+  public
+    constructor Create(AOwnsObjects: Boolean = True); overload;
+    constructor Create2(const Collection: TEnumerable<T>; AOwnsObjects: Boolean = True); overload;
+    procedure Pop; reintroduce; // Can't use the result, it might have been freed;
     property OwnsObjects: Boolean read FOwnsObjects write FOwnsObjects;
   end;
 
@@ -1814,9 +1873,13 @@ begin
 end;
 
 constructor TObjectQueue<T>.Create2(const Collection: TEnumerable<T>; AOwnsObjects: Boolean);
+Var
+  A : T;
+
 begin
-  inherited Create2(Collection);
-  FOwnsObjects := AOwnsObjects;
+  Create(aOwnsObjects);
+  For A in Collection do
+    EnQueue(A);
 end;
 
 procedure TObjectQueue<T>.Dequeue;
@@ -1824,4 +1887,146 @@ begin
   Inherited DeQueue;
 end;
 
+{ TStack }
+
+function TStack<T>.DoRemove(aIndex : SizeInt; ACollectionNotification: TCollectionNotification): T;
+
+begin
+  if (FLength=0) or (aIndex<>FLength-1) then
+    raise EArgumentOutOfRangeException.Create(SArgumentOutOfRange);
+  Result:=FItems[AIndex];
+  FItems[AIndex] := Default(T);
+  Dec(FLength);
+  Notify(Result, ACollectionNotification);
+end;
+
+procedure TStack<T>.SetCapacity(aValue: SizeInt);
+
+begin
+  if AValue < Count then
+    raise EArgumentOutOfRangeException.Create(SArgumentOutOfRange);
+  SetLength(FItems,aValue);
+end;
+
+function TStack<T>.DoGetEnumerator: TEnumerator<T>;
+begin
+  Result:=GetEnumerator;
+end;
+
+function TStack<T>.GetEnumerator: TEnumerator;
+begin
+  Result:=TEnumerator.Create(Self);
+end;
+
+
+destructor TStack<T>.Destroy;
+begin
+  Clear;
+  inherited Destroy;
+end;
+
+procedure TStack<T>.Clear;
+begin
+  While Count>0 do Pop;
+end;
+
+procedure TStack<T>.Push(const aValue: T);
+begin
+  if Capacity<=FLength then
+    SetCapacity(FLength+10);
+  FItems[FLength]:=aValue;
+  Inc(FLength);
+  Notify(aValue,cnAdded);
+end;
+
+function TStack<T>.Pop: T;
+begin
+  Result:=DoRemove(FLength-1,cnRemoved);
+end;
+
+function TStack<T>.Peek: T;
+begin
+  if Count<1 then
+    raise EArgumentOutOfRangeException.Create(SArgumentOutOfRange);
+  Result:=FItems[FLength-1];
+end;
+
+function TStack<T>.Extract: T;
+begin
+  Result:=DoRemove(FLength-1,cnExtracted);
+end;
+
+procedure TStack<T>.TrimExcess;
+begin
+  SetCapacity(FLength);
+end;
+
+{ TCustomInvertedListEnumerator }
+
+function TCustomInvertedListEnumerator<T>.DoMoveNext: boolean;
+begin
+  Result:=FIndex>0;
+  If Result then
+    Dec(FIndex);
+end;
+
+function TCustomInvertedListEnumerator<T>.DoGetCurrent: T;
+begin
+  Result:=FList.FItems[FIndex];
+end;
+
+function TCustomInvertedListEnumerator<T>.GetCurrent: T;
+begin
+  Result:=DoGetCurrent;
+end;
+
+constructor TCustomInvertedListEnumerator<T>.Create(AList: TCustomList<T>);
+begin
+  inherited Create;
+  FList:=AList;
+  FIndex:=AList.FLength;
+end;
+
+{ TStack.TEnumerator }
+
+constructor TStack<T>.TEnumerator.Create(AStack: TMyType);
+begin
+  Inherited Create(aStack);
+end;
+
+{ TObjectStack }
+
+procedure TObjectStack<T>.Notify(const aValue: T; Action: TCollectionNotification);
+
+Var
+  A : T absolute aValue;
+
+begin
+  inherited Notify(aValue, Action);
+  if (Action=cnRemoved) and FOwnsObjects then
+    a.Free;
+end;
+
+constructor TObjectStack<T>.Create(AOwnsObjects: Boolean);
+begin
+  Inherited Create;
+  FOwnsObjects:=aOwnsObjects;
+end;
+
+constructor TObjectStack<T>.Create2(const Collection: TEnumerable<T>; AOwnsObjects: Boolean);
+
+Var
+  A : T;
+
+begin
+  Create(aOwnsObjects);
+  For A in Collection do
+    Push(A);
+end;
+
+procedure TObjectStack<T>.Pop;
+begin
+  Inherited Pop;
+end;
+
 end.

test/tcgenericdictionary.pp

@@ -122,8 +122,18 @@ begin
 end;
 
 procedure TTestSingleObjectDict.TearDown;
+
+Var
+  I : integer;
+  A : TObject;
+
 begin
   FreeAndNil(FDict);
+  for I:=0 to FList.Count-1 do
+    begin
+    A:=TObject(FList[i]);
+    A.Free;
+    end;
   FreeAndNil(FList);
   inherited TearDown;
 end;
@@ -184,8 +194,17 @@ begin
 end;
 
 procedure TTestDualObjectDict.TearDown;
+Var
+  I : integer;
+  A : TObject;
+
 begin
   FreeAndNil(FDict);
+  for I:=0 to FList.Count-1 do
+    begin
+    A:=TObject(FList[i]);
+    A.Free;
+    end;
   FreeAndNil(FList);
   inherited TearDown;
 end;

test/tcgenericlist.pp

@@ -94,7 +94,16 @@ begin
 end;
 
 procedure TTestSingleObjectList.TearDown;
+
+Var
+  I : Integer;
+  A : TObject;
 begin
+  for I:=0 to FList.Count-1 do
+    begin
+    A:=TObject(FList[i]);
+    A.Free;
+    end;
   FreeAndNil(FList);
   FreeAndNil(FOList);
   inherited TearDown;

test/tcgenericqueue.pp

@@ -0,0 +1,388 @@
+unit tcgenericqueue;
+
+{$mode objfpc}
+
+interface
+
+uses
+  fpcunit, testregistry, Classes, SysUtils, Generics.Defaults, Generics.Collections;
+
+
+Type
+  TMySimpleQueue = Class(Specialize TQueue<String>);
+{$IFDEF FPC}
+  EList = EListError;
+{$ENDIF}
+
+  { TTestSimpleQueue }
+
+  TTestSimpleQueue = Class(TTestCase)
+  Private
+    FQueue : TMySimpleQueue;
+    FnotifyMessage : String;
+    FCurrentValueNotify : Integer;
+    FExpectValues : Array of String;
+    FExpectValueAction: Array of TCollectionNotification;
+    procedure DoAdd(aCount: Integer; aOffset: Integer=0);
+    procedure DoAdd2;
+    Procedure DoneExpectValues;
+    procedure DoGetValue(Match: String; ExceptionClass: TClass=nil);
+    procedure DoValueNotify(ASender: TObject; {$ifdef fpc}constref{$else}const{$endif} AItem: String; AAction: TCollectionNotification);
+  Public
+    Procedure SetExpectValues(aMessage : string; AKeys : Array of String; AActions : Array of TCollectionNotification; DoReverse : Boolean = False);
+    Procedure SetUp; override;
+    Procedure TearDown; override;
+    Property Queue : TMySimpleQueue Read FQueue;
+  Published
+    Procedure TestEmpty;
+    Procedure TestAdd;
+    Procedure TestClear;
+    Procedure TestGetValue;
+    Procedure TestPeek;
+    Procedure TestDequeue;
+    Procedure TestToArray;
+    Procedure TestEnumerator;
+    procedure TestValueNotification;
+    procedure TestValueNotificationDelete;
+  end;
+
+  { TMyObject }
+
+  TMyObject = Class(TObject)
+  Private
+    fOnDestroy : TNotifyEvent;
+    FID : Integer;
+  public
+    Constructor Create(aID : Integer; aOnDestroy : TNotifyEvent);
+    destructor destroy; override;
+    Property ID : Integer Read FID;
+  end;
+
+  TSingleObjectQueue = Class(Specialize TObjectQueue<TMyObject>);
+
+  { TTestSingleObjectQueue }
+
+  TTestSingleObjectQueue = Class(TTestCase)
+  private
+    FOQueue: TSingleObjectQueue;
+    FList : TFPList;
+    procedure DoAdd(aID: Integer);
+    procedure DoDestroy(Sender: TObject);
+  Public
+    Procedure SetUp; override;
+    Procedure TearDown; override;
+    Property Queue : TSingleObjectQueue Read FOQueue;
+  Published
+    Procedure TestEmpty;
+    Procedure TestFreeOnDequeue;
+    Procedure TestNoFreeOnDeQueue;
+  end;
+
+implementation
+
+{ TTestSingleObjectQueue }
+
+procedure TTestSingleObjectQueue.SetUp;
+begin
+  FOQueue:=TSingleObjectQueue.Create(True);
+  FList:=TFPList.Create;
+  inherited SetUp;
+end;
+
+procedure TTestSingleObjectQueue.TearDown;
+begin
+  FreeAndNil(FOQueue);
+  FreeAndNil(FList);
+  inherited TearDown;
+end;
+
+procedure TTestSingleObjectQueue.TestEmpty;
+begin
+  AssertNotNull('Have object',Queue);
+  AssertEquals('Have empty object',0,Queue.Count);
+end;
+
+procedure TTestSingleObjectQueue.DoAdd(aID : Integer);
+
+Var
+  O :  TMyObject;
+
+begin
+  O:=TMyObject.Create(aID,@DoDestroy);
+  FOQueue.EnQueue(O);
+  FList.Add(O);
+end;
+
+procedure TTestSingleObjectQueue.DoDestroy(Sender: TObject);
+
+Var
+  I : Integer;
+
+begin
+  I:=FList.IndexOf(Sender);
+  AssertTrue('Have object in Queue',I<>-1);
+  FList.Delete(I);
+end;
+
+procedure TTestSingleObjectQueue.TestFreeOnDeQueue;
+
+begin
+  DoAdd(1);
+  AssertEquals('Have obj',1,FList.Count);
+  Queue.Dequeue;
+  AssertEquals('Have no obj',0,FList.Count);
+end;
+
+procedure TTestSingleObjectQueue.TestNoFreeOnDeQueue;
+begin
+  Queue.OwnsObjects:=False;
+  DoAdd(1);
+  AssertEquals('Have obj',1,FList.Count);
+  Queue.DeQueue;
+  AssertEquals('Have  obj',1,FList.Count);
+end;
+
+
+{ TMyObject }
+
+constructor TMyObject.Create(aID: Integer; aOnDestroy: TNotifyEvent);
+begin
+  FOnDestroy:=aOnDestroy;
+  FID:=AID;
+end;
+
+destructor TMyObject.destroy;
+begin
+  if Assigned(FOnDestroy) then
+    FOnDestroy(Self);
+  inherited destroy;
+end;
+
+{ TTestSimpleQueue }
+
+procedure TTestSimpleQueue.SetUp;
+begin
+  inherited SetUp;
+  FQueue:=TMySimpleQueue.Create;
+  FCurrentValueNotify:=0;
+  FExpectValues:=[];
+  FExpectValueAction:=[];
+end;
+
+procedure TTestSimpleQueue.TearDown;
+begin
+  // So we don't get clear messages
+  FQueue.OnNotify:=Nil;
+  FreeAndNil(FQueue);
+  inherited TearDown;
+end;
+
+procedure TTestSimpleQueue.TestEmpty;
+begin
+  AssertNotNull('Have dictionary',Queue);
+  AssertEquals('empty dictionary',0,Queue.Count);
+end;
+
+procedure TTestSimpleQueue.DoAdd(aCount : Integer; aOffset : Integer=0);
+
+Var
+  I : Integer;
+
+begin
+  if aOffset=-1 then
+    aOffset:=Queue.Count;
+  For I:=aOffset+1 to aOffset+aCount do
+    Queue.EnQueue(IntToStr(i));
+end;
+
+procedure TTestSimpleQueue.TestAdd;
+
+begin
+  DoAdd(1);
+  AssertEquals('Count OK',1,Queue.Count);
+  DoAdd(1,1);
+  AssertEquals('Count OK',2,Queue.Count);
+end;
+
+procedure TTestSimpleQueue.TestClear;
+begin
+  DoAdd(3);
+  AssertEquals('Count OK',3,Queue.Count);
+  Queue.Clear;
+  AssertEquals('Count after clear OK',0,Queue.Count);
+end;
+
+procedure TTestSimpleQueue.DoGetValue(Match: String; ExceptionClass: TClass);
+
+Var
+  EC : TClass;
+  A,EM : String;
+
+begin
+  EC:=Nil;
+  try
+    A:=Queue.DeQueue;
+  except
+    On E : Exception do
+      begin
+      EC:=E.ClassType;
+      EM:=E.Message;
+      end
+  end;
+  if ExceptionClass=Nil then
+    begin
+    if EC<>Nil then
+      Fail('Got exception '+EC.ClassName+' with message: '+EM);
+    AssertEquals('Value is correct',Match,A)
+    end
+  else
+    begin
+    if EC=Nil then
+      Fail('Expected exception '+ExceptionClass.ClassName+' but got none');
+    if EC<>ExceptionClass then
+      Fail('Expected exception class '+ExceptionClass.ClassName+' but got '+EC.ClassName+' with message '+EM);
+    end;
+end;
+
+procedure TTestSimpleQueue.DoValueNotify(ASender: TObject; {$ifdef fpc}constref{$else}const{$endif} AItem: String; AAction: TCollectionNotification);
+begin
+//  Writeln(FnotifyMessage+' value Notification',FCurrentValueNotify);
+  AssertSame(FnotifyMessage+' value Correct sender', FQueue,aSender);
+  if (FCurrentValueNotify>=Length(FExpectValues)) then
+    Fail(FnotifyMessage+' Too many value notificiations');
+  AssertEquals(FnotifyMessage+' Notification value no '+IntToStr(FCurrentValueNotify),FExpectValues[FCurrentValueNotify],aItem);
+  Inc(FCurrentValueNotify);
+end;
+
+
+procedure TTestSimpleQueue.SetExpectValues(aMessage: string; AKeys: array of String;
+  AActions: array of TCollectionNotification; DoReverse: Boolean);
+Var
+  I,L : integer;
+
+begin
+  FnotifyMessage:=aMessage;
+  FCurrentValueNotify:=0;
+  L:=Length(aKeys);
+  AssertEquals('SetExpectValues: Lengths arrays equal',l,Length(aActions));
+  SetLength(FExpectValues,L);
+  SetLength(FExpectValueAction,L);
+  Dec(L);
+  if DoReverse then
+    For I:=0 to L do
+      begin
+      FExpectValues[L-i]:=AKeys[i];
+      FExpectValueAction[L-i]:=AActions[I];
+      end
+  else
+    For I:=0 to L do
+      begin
+      FExpectValues[i]:=AKeys[i];
+      FExpectValueAction[i]:=AActions[I];
+      end;
+end;
+
+procedure TTestSimpleQueue.TestGetValue;
+
+Var
+  I : integer;
+
+begin
+  DoAdd(3);
+  For I:=1 to 3 do
+    DoGetValue(IntToStr(I));
+  DoGetValue('4',EArgumentOutOfRangeException);
+end;
+
+procedure TTestSimpleQueue.TestPeek;
+Var
+  I : integer;
+
+begin
+  DoAdd(3);
+  For I:=1 to 3 do
+    begin
+    AssertEquals('Peek ',IntToStr(I),FQueue.Peek);
+    DoGetValue(IntToStr(I));
+    end;
+end;
+
+
+procedure TTestSimpleQueue.DoAdd2;
+
+begin
+  Queue.Enqueue('A new 2');
+end;
+
+procedure TTestSimpleQueue.DoneExpectValues;
+begin
+  AssertEquals(FnotifyMessage+' Expected number of values seen',Length(FExpectValues),FCurrentValueNotify);
+end;
+
+procedure TTestSimpleQueue.TestDequeue;
+
+begin
+  DoAdd(3);
+  AssertEquals('1',Queue.Dequeue);
+  AssertEquals('Count',2,Queue.Count);
+end;
+
+procedure TTestSimpleQueue.TestToArray;
+
+Var
+  A : specialize TArray<String>;
+
+  I : Integer;
+  SI : String;
+
+begin
+  DoAdd(3);
+  A:=Queue.ToArray;
+  AssertEquals('Length Ok',3,Length(A));
+  For I:=1 to 3 do
+    begin
+    SI:=IntToStr(I);
+    AssertEquals('Value '+SI,SI,A[i-1]);
+    end;
+end;
+
+
+procedure TTestSimpleQueue.TestEnumerator;
+
+Var
+  A : String;
+  I : Integer;
+  SI : String;
+
+begin
+  DoAdd(3);
+  I:=1;
+  For A in Queue do
+    begin
+    SI:=IntToStr(I);
+    AssertEquals('Value '+SI,SI,A);
+    Inc(I);
+    end;
+end;
+
+procedure TTestSimpleQueue.TestValueNotification;
+begin
+  Queue.OnNotify:=@DoValueNotify;
+  SetExpectValues('Add',['1','2','3'],[cnAdded,cnAdded,cnAdded]);
+  DoAdd(3);
+  DoneExpectValues;
+end;
+
+procedure TTestSimpleQueue.TestValueNotificationDelete;
+begin
+  DoAdd(3);
+  Queue.OnNotify:=@DoValueNotify;
+  SetExpectValues('Clear',['1','2','3'],[cnRemoved,cnRemoved,cnRemoved],{$IFDEF FPC}true{$ELSE}False{$endif});
+  Queue.Clear;
+  DoneExpectValues;
+end;
+
+begin
+  RegisterTests([ TTestSimpleQueue,TTestSingleObjectQueue]);
+end.
+

test/tcgenericstack.pp

@@ -0,0 +1,403 @@
+unit tcgenericstack;
+
+{$mode objfpc}
+
+interface
+
+uses
+  fpcunit, testregistry, Classes, SysUtils, Generics.Defaults, Generics.Collections;
+
+
+Type
+  TMySimpleStack = Class(Specialize TStack<String>);
+{$IFDEF FPC}
+  EList = EListError;
+{$ENDIF}
+
+  { TTestSimpleStack }
+
+  TTestSimpleStack = Class(TTestCase)
+  Private
+    FStack : TMySimpleStack;
+    FnotifyMessage : String;
+    FCurrentValueNotify : Integer;
+    FExpectValues : Array of String;
+    FExpectValueAction: Array of TCollectionNotification;
+    procedure DoAdd(aCount: Integer);
+    procedure DoAdd2;
+    Procedure DoneExpectValues;
+    procedure DoGetValue(Match: String; ExceptionClass: TClass=nil);
+    procedure DoValueNotify(ASender: TObject; {$ifdef fpc}constref{$else}const{$endif} AItem: String; AAction: TCollectionNotification);
+  Public
+    Procedure SetExpectValues(aMessage : string; AKeys : Array of String; AActions : Array of TCollectionNotification; DoReverse : Boolean = False);
+    Procedure SetUp; override;
+    Procedure TearDown; override;
+    Property Stack : TMySimpleStack Read FStack;
+  Published
+    Procedure TestEmpty;
+    Procedure TestAdd;
+    Procedure TestClear;
+    Procedure TestGetValue;
+    Procedure TestPeek;
+    Procedure TestPop;
+    Procedure TestToArray;
+    Procedure TestEnumerator;
+    procedure TestValueNotification;
+    procedure TestValueNotificationDelete;
+  end;
+
+  { TMyObject }
+
+  TMyObject = Class(TObject)
+  Private
+    fOnDestroy : TNotifyEvent;
+    FID : Integer;
+  public
+    Constructor Create(aID : Integer; aOnDestroy : TNotifyEvent);
+    destructor destroy; override;
+    Property ID : Integer Read FID;
+  end;
+
+  TSingleObjectStack = Class(Specialize TObjectStack<TMyObject>);
+
+  { TTestSingleObjectStack }
+
+  TTestSingleObjectStack = Class(TTestCase)
+  private
+    FOStack: TSingleObjectStack;
+    FList : TFPList;
+    procedure DoAdd(aID: Integer);
+    procedure DoDestroy(Sender: TObject);
+  Public
+    Procedure SetUp; override;
+    Procedure TearDown; override;
+    Property Stack : TSingleObjectStack Read FOStack;
+  Published
+    Procedure TestEmpty;
+    Procedure TestFreeOnPop;
+    Procedure TestNoFreeOnPop;
+  end;
+
+implementation
+
+{ TTestSingleObjectStack }
+
+procedure TTestSingleObjectStack.SetUp;
+begin
+  FOStack:=TSingleObjectStack.Create(True);
+  FList:=TFPList.Create;
+  inherited SetUp;
+end;
+
+procedure TTestSingleObjectStack.TearDown;
+
+Var
+  I : integer;
+  A : TObject;
+
+begin
+  FreeAndNil(FOStack);
+  for I:=0 to FList.Count-1 do
+    begin
+    A:=TObject(FList[i]);
+    A.Free;
+    end;
+  FreeAndNil(FList);
+  inherited TearDown;
+end;
+
+procedure TTestSingleObjectStack.TestEmpty;
+begin
+  AssertNotNull('Have object',Stack);
+  AssertEquals('Have empty object',0,Stack.Count);
+end;
+
+procedure TTestSingleObjectStack.DoAdd(aID : Integer);
+
+Var
+  O :  TMyObject;
+
+begin
+  O:=TMyObject.Create(aID,@DoDestroy);
+  FOStack.Push(O);
+  FList.Add(O);
+end;
+
+procedure TTestSingleObjectStack.DoDestroy(Sender: TObject);
+
+Var
+  I : Integer;
+
+begin
+  I:=FList.IndexOf(Sender);
+  AssertTrue('Have object in Stack',I<>-1);
+  FList.Delete(I);
+end;
+
+procedure TTestSingleObjectStack.TestFreeOnPop;
+
+begin
+  DoAdd(1);
+  AssertEquals('Have obj',1,FList.Count);
+  Stack.Pop;
+  AssertEquals('Have no obj',0,FList.Count);
+end;
+
+procedure TTestSingleObjectStack.TestNoFreeOnPop;
+begin
+  Stack.OwnsObjects:=False;
+  DoAdd(1);
+  AssertEquals('Have obj',1,FList.Count);
+  Stack.Pop;
+  AssertEquals('Have  obj',1,FList.Count);
+end;
+
+
+{ TMyObject }
+
+constructor TMyObject.Create(aID: Integer; aOnDestroy: TNotifyEvent);
+begin
+  FOnDestroy:=aOnDestroy;
+  FID:=AID;
+end;
+
+destructor TMyObject.destroy;
+begin
+  if Assigned(FOnDestroy) then
+    FOnDestroy(Self);
+  inherited destroy;
+end;
+
+{ TTestSimpleStack }
+
+procedure TTestSimpleStack.SetUp;
+begin
+  inherited SetUp;
+  FStack:=TMySimpleStack.Create;
+  FCurrentValueNotify:=0;
+  FExpectValues:=[];
+  FExpectValueAction:=[];
+end;
+
+procedure TTestSimpleStack.TearDown;
+begin
+  // So we don't get clear messages
+  FStack.OnNotify:=Nil;
+  FreeAndNil(FStack);
+  inherited TearDown;
+end;
+
+procedure TTestSimpleStack.TestEmpty;
+begin
+  AssertNotNull('Have dictionary',Stack);
+  AssertEquals('empty dictionary',0,Stack.Count);
+end;
+
+procedure TTestSimpleStack.DoAdd(aCount : Integer);
+
+Var
+  I : Integer;
+
+begin
+  For I:=1 to aCount do
+    Stack.Push(IntToStr(i));
+end;
+
+procedure TTestSimpleStack.TestAdd;
+
+begin
+  DoAdd(1);
+  AssertEquals('Count OK',1,Stack.Count);
+  DoAdd(1);
+  AssertEquals('Count OK',2,Stack.Count);
+end;
+
+procedure TTestSimpleStack.TestClear;
+begin
+  DoAdd(3);
+  AssertEquals('Count OK',3,Stack.Count);
+  Stack.Clear;
+  AssertEquals('Count after clear OK',0,Stack.Count);
+end;
+
+procedure TTestSimpleStack.DoGetValue(Match: String; ExceptionClass: TClass);
+
+Var
+  EC : TClass;
+  A,EM : String;
+
+begin
+  EC:=Nil;
+  try
+    A:=Stack.Pop;
+  except
+    On E : Exception do
+      begin
+      EC:=E.ClassType;
+      EM:=E.Message;
+      end
+  end;
+  if ExceptionClass=Nil then
+    begin
+    if EC<>Nil then
+      Fail('Got exception '+EC.ClassName+' with message: '+EM);
+    AssertEquals('Value is correct',Match,A)
+    end
+  else
+    begin
+    if EC=Nil then
+      Fail('Expected exception '+ExceptionClass.ClassName+' but got none');
+    if EC<>ExceptionClass then
+      Fail('Expected exception class '+ExceptionClass.ClassName+' but got '+EC.ClassName+' with message '+EM);
+    end;
+end;
+
+procedure TTestSimpleStack.DoValueNotify(ASender: TObject; {$ifdef fpc}constref{$else}const{$endif} AItem: String; AAction: TCollectionNotification);
+begin
+//  Writeln(FnotifyMessage+' value Notification',FCurrentValueNotify);
+  AssertSame(FnotifyMessage+' value Correct sender', FStack,aSender);
+  if (FCurrentValueNotify>=Length(FExpectValues)) then
+    Fail(FnotifyMessage+' Too many value notificiations');
+  AssertEquals(FnotifyMessage+' Notification value no '+IntToStr(FCurrentValueNotify),FExpectValues[FCurrentValueNotify],aItem);
+  Inc(FCurrentValueNotify);
+end;
+
+
+procedure TTestSimpleStack.SetExpectValues(aMessage: string; AKeys: array of String;
+  AActions: array of TCollectionNotification; DoReverse: Boolean);
+Var
+  I,L : integer;
+
+begin
+  FnotifyMessage:=aMessage;
+  FCurrentValueNotify:=0;
+  L:=Length(aKeys);
+  AssertEquals('SetExpectValues: Lengths arrays equal',l,Length(aActions));
+  SetLength(FExpectValues,L);
+  SetLength(FExpectValueAction,L);
+  Dec(L);
+  if DoReverse then
+    For I:=0 to L do
+      begin
+      FExpectValues[L-i]:=AKeys[i];
+      FExpectValueAction[L-i]:=AActions[I];
+      end
+  else
+    For I:=0 to L do
+      begin
+      FExpectValues[i]:=AKeys[i];
+      FExpectValueAction[i]:=AActions[I];
+      end;
+end;
+
+procedure TTestSimpleStack.TestGetValue;
+
+Var
+  I : integer;
+
+begin
+  DoAdd(3);
+  For I:=3 downto 1 do
+    DoGetValue(IntToStr(I));
+  DoGetValue('4',EArgumentOutOfRangeException);
+end;
+
+procedure TTestSimpleStack.TestPeek;
+Var
+  I : integer;
+
+begin
+  DoAdd(3);
+  For I:=3 downto 1 do
+    begin
+    AssertEquals('Peek ',IntToStr(I),FStack.Peek);
+    DoGetValue(IntToStr(I));
+    end;
+end;
+
+
+procedure TTestSimpleStack.DoAdd2;
+
+begin
+  Stack.Push('A new 2');
+end;
+
+procedure TTestSimpleStack.DoneExpectValues;
+begin
+  AssertEquals(FnotifyMessage+' Expected number of values seen',Length(FExpectValues),FCurrentValueNotify);
+end;
+
+procedure TTestSimpleStack.TestPop;
+
+Var
+  I : Integer;
+  SI : String;
+
+begin
+  DoAdd(3);
+  For I:=3 downto 1 do
+    begin
+    SI:=IntToStr(I);
+    AssertEquals('Value '+SI,SI,FStack.Pop);
+    end;
+  AssertEquals('Count',0,Stack.Count);
+end;
+
+procedure TTestSimpleStack.TestToArray;
+
+Var
+  A : specialize TArray<String>;
+  I : Integer;
+  SI : String;
+
+begin
+  DoAdd(3);
+  A:=Stack.ToArray;
+  AssertEquals('Length Ok',3,Length(A));
+  For I:=1 to 3 do
+    begin
+    SI:=IntToStr(I);
+    AssertEquals('Value '+SI,SI,A[3-i]);
+    end;
+end;
+
+
+procedure TTestSimpleStack.TestEnumerator;
+
+Var
+  A : String;
+  I : Integer;
+  SI : String;
+
+begin
+  DoAdd(3);
+  I:=3;
+  For A in Stack do
+    begin
+    SI:=IntToStr(i);
+    AssertEquals('Value '+SI,SI,A);
+    Dec(I);
+    end;
+end;
+
+procedure TTestSimpleStack.TestValueNotification;
+begin
+  Stack.OnNotify:=@DoValueNotify;
+  SetExpectValues('Add',['1','2','3'],[cnAdded,cnAdded,cnAdded]);
+  DoAdd(3);
+  DoneExpectValues;
+end;
+
+procedure TTestSimpleStack.TestValueNotificationDelete;
+begin
+  DoAdd(3);
+  Stack.OnNotify:=@DoValueNotify;
+  SetExpectValues('Clear',['3','2','1'],[cnRemoved,cnRemoved,cnRemoved],{$IFDEF FPC}true{$ELSE}False{$endif});
+  Stack.Clear;
+  DoneExpectValues;
+end;
+
+begin
+  RegisterTests([ TTestSimpleStack,TTestSingleObjectStack]);
+end.
+

test/testrtl.lpi

@@ -92,6 +92,10 @@
         <Filename Value="tcgenericqueue.pp"/>
         <IsPartOfProject Value="True"/>
       </Unit>
+      <Unit>
+        <Filename Value="tcgenericstack.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

test/testrtl.lpr

@@ -26,13 +26,16 @@ program testrtl;
 
 uses
   browserconsole, consoletestrunner, frmrtlrun, simplelinkedlist,
-//  tcstream, tccompstreaming, tcsyshelpers,
+  tcstream, tccompstreaming,
+    tcsyshelpers,
 //  tcgenarrayhelper,
-//  tcstringhelp,
-//  tcgenericdictionary,
-//  tcgenericlist,
-  tcgenericqueue,
-  strutils, sysutils;
+    tcstringhelp,
+    tcgenericdictionary,
+    tcgenericlist,
+    tcgenericqueue,
+    tcgenericstack,
+    strutils,
+    sysutils;
 
 var
   Application : TTestRunner;