Browse Source

* Tests for Stack/Queue comparison with pas2js

git-svn-id: trunk@45610 -
michael 5 years ago
parent
commit
816ff7966b

+ 2 - 0
.gitattributes

@@ -8867,7 +8867,9 @@ packages/rtl-generics/tests/tests.generics.arrayhelper.pas svneol=native#text/pa
 packages/rtl-generics/tests/tests.generics.bugs.pas svneol=native#text/pascal
 packages/rtl-generics/tests/tests.generics.dictionary.pas svneol=native#text/plain
 packages/rtl-generics/tests/tests.generics.hashmaps.pas svneol=native#text/pascal
+packages/rtl-generics/tests/tests.generics.queue.pas svneol=native#text/plain
 packages/rtl-generics/tests/tests.generics.sets.pas svneol=native#text/pascal
+packages/rtl-generics/tests/tests.generics.stack.pas svneol=native#text/plain
 packages/rtl-generics/tests/tests.generics.stdcollections.pas svneol=native#text/pascal
 packages/rtl-generics/tests/tests.generics.trees.pas svneol=native#text/pascal
 packages/rtl-generics/tests/tests.generics.utils.pas svneol=native#text/pascal

+ 9 - 1
packages/rtl-generics/tests/testrunner.rtlgenerics.lpi

@@ -27,7 +27,7 @@
         <CommandLineParams Value="-a --format=plain"/>
       </local>
     </RunParams>
-    <Units Count="8">
+    <Units Count="10">
       <Unit0>
         <Filename Value="testrunner.rtlgenerics.pp"/>
         <IsPartOfProject Value="True"/>
@@ -60,6 +60,14 @@
         <Filename Value="tests.generics.dictionary.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit7>
+      <Unit8>
+        <Filename Value="tests.generics.stack.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit9>
+      <Unit9>
+        <Filename Value="tests.generics.queue.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit9>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

+ 2 - 0
packages/rtl-generics/tests/testrunner.rtlgenerics.pp

@@ -13,6 +13,8 @@ uses
   tests.generics.trees,
   tests.generics.stdcollections,
   tests.generics.sets,
+  tests.generics.queue,
+  tests.generics.stack,
   tests.generics.dictionary
   ;
 

+ 388 - 0
packages/rtl-generics/tests/tests.generics.queue.pas

@@ -0,0 +1,388 @@
+unit tests.generics.queue;
+
+{$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.
+

+ 403 - 0
packages/rtl-generics/tests/tests.generics.stack.pas

@@ -0,0 +1,403 @@
+unit tests.generics.stack;
+
+{$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[i-1]);
+    end;
+end;
+
+
+procedure TTestSimpleStack.TestEnumerator;
+
+Var
+  A : String;
+  I : Integer;
+  SI : String;
+
+begin
+  DoAdd(3);
+  I:=1;
+  For A in Stack do
+    begin
+    SI:=IntToStr(i);
+    AssertEquals('Value '+SI,SI,A);
+    Inc(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],False);
+  Stack.Clear;
+  DoneExpectValues;
+end;
+
+begin
+  RegisterTests([ TTestSimpleStack,TTestSingleObjectStack]);
+end.
+