* Test routines for cleanroom implementation

git-svn-id: branches/cleanroom@9270 -

.gitattributes

@@ -5522,6 +5522,14 @@ rtl/symbian/uiq.pas -text
 rtl/symbian/uiqclasses.pas -text
 rtl/symbian/uiqinc/qikapplication.inc -text
 rtl/symbian/uiqinc/qikapplicationoo.inc -text
+rtl/tests/findnested.lpi svneol=native#text/plain
+rtl/tests/findnested.lpr svneol=native#text/plain
+rtl/tests/fplists.pp svneol=native#text/plain
+rtl/tests/lists.pp svneol=native#text/plain
+rtl/tests/lltests.lpi svneol=native#text/plain
+rtl/tests/lltests.lpr svneol=native#text/plain
+rtl/tests/tcfindnested.pp svneol=native#text/plain
+rtl/tests/testll.pp svneol=native#text/plain
 rtl/ucmaps/8859-1.txt svneol=native#text/plain
 rtl/ucmaps/8859-10.txt svneol=native#text/plain
 rtl/ucmaps/8859-13.txt svneol=native#text/plain

rtl/tests/findnested.lpi

@@ -0,0 +1,164 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="/"/>
+    <Version Value="6"/>
+    <General>
+      <MainUnit Value="0"/>
+      <TargetFileExt Value=""/>
+      <ActiveEditorIndexAtStart Value="0"/>
+    </General>
+    <VersionInfo>
+      <ProjectVersion Value=""/>
+      <Language Value=""/>
+      <CharSet Value=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="2">
+      <Item1>
+        <PackageName Value="FPCUnitConsoleRunner"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="FCL"/>
+      </Item2>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="findnested.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="findnested"/>
+        <UsageCount Value="20"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="tcfindnested.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tcfindnested"/>
+        <CursorPos X="1" Y="91"/>
+        <TopLine Value="61"/>
+        <EditorIndex Value="0"/>
+        <UsageCount Value="20"/>
+        <Loaded Value="True"/>
+      </Unit1>
+    </Units>
+    <JumpHistory Count="22" HistoryIndex="21">
+      <Position1>
+        <Filename Value="tcfindnested.pp"/>
+        <Caret Line="22" Column="17" TopLine="13"/>
+      </Position1>
+      <Position2>
+        <Filename Value="tcfindnested.pp"/>
+        <Caret Line="25" Column="102" TopLine="1"/>
+      </Position2>
+      <Position3>
+        <Filename Value="tcfindnested.pp"/>
+        <Caret Line="44" Column="27" TopLine="18"/>
+      </Position3>
+      <Position4>
+        <Filename Value="tcfindnested.pp"/>
+        <Caret Line="48" Column="7" TopLine="24"/>
+      </Position4>
+      <Position5>
+        <Filename Value="tcfindnested.pp"/>
+        <Caret Line="58" Column="1" TopLine="32"/>
+      </Position5>
+      <Position6>
+        <Filename Value="tcfindnested.pp"/>
+        <Caret Line="125" Column="5" TopLine="63"/>
+      </Position6>
+      <Position7>
+        <Filename Value="tcfindnested.pp"/>
+        <Caret Line="19" Column="38" TopLine="18"/>
+      </Position7>
+      <Position8>
+        <Filename Value="tcfindnested.pp"/>
+        <Caret Line="20" Column="33" TopLine="19"/>
+      </Position8>
+      <Position9>
+        <Filename Value="tcfindnested.pp"/>
+        <Caret Line="19" Column="29" TopLine="18"/>
+      </Position9>
+      <Position10>
+        <Filename Value="tcfindnested.pp"/>
+        <Caret Line="21" Column="34" TopLine="20"/>
+      </Position10>
+      <Position11>
+        <Filename Value="tcfindnested.pp"/>
+        <Caret Line="23" Column="28" TopLine="22"/>
+      </Position11>
+      <Position12>
+        <Filename Value="tcfindnested.pp"/>
+        <Caret Line="113" Column="1" TopLine="88"/>
+      </Position12>
+      <Position13>
+        <Filename Value="tcfindnested.pp"/>
+        <Caret Line="24" Column="30" TopLine="23"/>
+      </Position13>
+      <Position14>
+        <Filename Value="tcfindnested.pp"/>
+        <Caret Line="23" Column="28" TopLine="22"/>
+      </Position14>
+      <Position15>
+        <Filename Value="tcfindnested.pp"/>
+        <Caret Line="19" Column="32" TopLine="18"/>
+      </Position15>
+      <Position16>
+        <Filename Value="tcfindnested.pp"/>
+        <Caret Line="20" Column="35" TopLine="19"/>
+      </Position16>
+      <Position17>
+        <Filename Value="tcfindnested.pp"/>
+        <Caret Line="19" Column="35" TopLine="18"/>
+      </Position17>
+      <Position18>
+        <Filename Value="tcfindnested.pp"/>
+        <Caret Line="92" Column="1" TopLine="66"/>
+      </Position18>
+      <Position19>
+        <Filename Value="tcfindnested.pp"/>
+        <Caret Line="25" Column="28" TopLine="1"/>
+      </Position19>
+      <Position20>
+        <Filename Value="tcfindnested.pp"/>
+        <Caret Line="174" Column="28" TopLine="124"/>
+      </Position20>
+      <Position21>
+        <Filename Value="tcfindnested.pp"/>
+        <Caret Line="119" Column="1" TopLine="93"/>
+      </Position21>
+      <Position22>
+        <Filename Value="tcfindnested.pp"/>
+        <Caret Line="83" Column="1" TopLine="41"/>
+      </Position22>
+    </JumpHistory>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="2">
+      <Item1>
+        <Name Value="ECodetoolError"/>
+      </Item1>
+      <Item2>
+        <Name Value="EFOpenError"/>
+      </Item2>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

rtl/tests/findnested.lpr

@@ -0,0 +1,26 @@
+program findnested;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, consoletestrunner, tcfindnested;
+
+type
+
+  { TLazTestRunner }
+
+  TMyTestRunner = class(TTestRunner)
+  protected
+  // override the protected methods of TTestRunner to customize its behavior
+  end;
+
+var
+  Application: TMyTestRunner;
+
+begin
+  Application := TMyTestRunner.Create(nil);
+  Application.Initialize;
+  Application.Title := 'FPCUnit Console test runner';
+  Application.Run;
+  Application.Free;
+end.

rtl/tests/fplists.pp

@@ -0,0 +1,127 @@
+{$mode objpas}
+unit fplists;
+
+interface
+
+Type
+  TLinkedListItem = Class
+  Public
+    Next : TLinkedListItem;
+  end;
+  TLinkedListItemClass = Class of TLinkedListItem;
+  
+  { TLinkedListVisitor }
+
+  TLinkedListVisitor = Class
+    Function Visit(Item : TLinkedListItem) : Boolean; virtual; abstract;
+  end;
+  { TLinkedList }
+
+  TLinkedList = Class
+  private
+    FItemClass: TLinkedListItemClass;
+    FRoot: TLinkedListItem;
+    function GetCount: Integer;
+  Public
+    Constructor Create(AnItemClass : TLinkedListItemClass); virtual;
+    Destructor Destroy; override;
+    Procedure Clear;
+    Function Add : TLinkedListItem;
+    Procedure ForEach(Visitor: TLinkedListVisitor);
+    Procedure RemoveItem(Item : TLinkedListItem; FreeItem : Boolean = False);
+    Property Root : TLinkedListItem Read FRoot;
+    Property ItemClass : TLinkedListItemClass Read FItemClass;
+    Property Count : Integer Read GetCount;
+  end;
+
+Implementation  
+
+uses sysutils;
+
+{ TLinkedList }
+
+function TLinkedList.GetCount: Integer;
+
+Var
+  I : TLinkedListItem;
+
+begin
+  I:=FRoot;
+  Result:=0;
+  While I<>Nil do
+    begin
+    I:=I.Next;
+    Inc(Result);
+    end;
+end;
+
+constructor TLinkedList.Create(AnItemClass: TLinkedListItemClass);
+begin
+  FItemClass:=AnItemClass;
+end;
+
+destructor TLinkedList.Destroy;
+begin
+  Clear;
+  inherited Destroy;
+end;
+
+procedure TLinkedList.Clear;
+
+Var
+   I : TLinkedListItem;
+
+begin
+  // Can't use visitor, because it'd kill the next pointer...
+  I:=FRoot;
+  While I<>Nil do
+    begin
+    FRoot:=I;
+    I:=I.Next;
+    FRoot.Next:=Nil;
+    FreeAndNil(FRoot);
+    end;
+end;
+
+function TLinkedList.Add: TLinkedListItem;
+begin
+  Result:=FItemClass.Create;
+  Result.Next:=FRoot;
+  FRoot:=Result;
+end;
+
+procedure TLinkedList.ForEach(Visitor : TLinkedListVisitor);
+
+Var
+  I : TLinkedListItem;
+
+begin
+  I:=FRoot;
+  While (I<>Nil) and Visitor.Visit(I) do
+    I:=I.Next;
+end;
+
+procedure TLinkedList.RemoveItem(Item: TLinkedListItem; FreeItem : Boolean = False);
+
+Var
+  I,P : TLinkedListItem;
+
+begin
+  If (Item<>Nil) and (FRoot<>Nil) then
+    begin
+    If (Item=FRoot) then
+      FRoot:=Item.Next
+    else
+      begin
+      I:=FRoot;
+      While (I.Next<>Nil) and (I.Next<>Item) do
+        I:=I.Next;
+      If (I.Next=Item) then
+        I.Next:=Item.Next;
+      end;
+    If FreeItem Then
+      Item.Free;
+    end;
+end;
+
+end.

rtl/tests/lists.pp

@@ -0,0 +1,19 @@
+unit lists;
+
+interface
+
+Type
+  TLinkedListItem = Class
+    Next : TLinkedListItem;
+  end;
+  TLinkedListItemClass = Class of TLinkedListItem;
+  
+  TLinkedList = Class
+    Constructor Create(ItemClass : TLinkedListItemClass);
+    Procedure Clear;
+    Function Add : TLinkedListItem;
+    Property Root : TLinkedListItem Read FRoot;
+  end;
+
+Implementation  
+

rtl/tests/lltests.lpi

@@ -0,0 +1,211 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="/"/>
+    <Version Value="6"/>
+    <General>
+      <MainUnit Value="0"/>
+      <TargetFileExt Value=""/>
+      <ActiveEditorIndexAtStart Value="0"/>
+    </General>
+    <VersionInfo>
+      <ProjectVersion Value=""/>
+      <Language Value=""/>
+      <CharSet Value=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <CommandLineParams Value="--format=plain -a"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="2">
+      <Item1>
+        <PackageName Value="FPCUnitConsoleRunner"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="FCL"/>
+      </Item2>
+    </RequiredPackages>
+    <Units Count="3">
+      <Unit0>
+        <Filename Value="lltests.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="lltests"/>
+        <UsageCount Value="20"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="testll.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="Testll"/>
+        <CursorPos X="6" Y="207"/>
+        <TopLine Value="181"/>
+        <EditorIndex Value="0"/>
+        <UsageCount Value="20"/>
+        <Loaded Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="fplists.pp"/>
+        <UnitName Value="fplists"/>
+        <CursorPos X="1" Y="2"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="1"/>
+        <UsageCount Value="10"/>
+        <Loaded Value="True"/>
+      </Unit2>
+    </Units>
+    <JumpHistory Count="30" HistoryIndex="29">
+      <Position1>
+        <Filename Value="testll.pp"/>
+        <Caret Line="28" Column="27" TopLine="1"/>
+      </Position1>
+      <Position2>
+        <Filename Value="fplists.pp"/>
+        <Caret Line="111" Column="1" TopLine="61"/>
+      </Position2>
+      <Position3>
+        <Filename Value="fplists.pp"/>
+        <Caret Line="46" Column="12" TopLine="20"/>
+      </Position3>
+      <Position4>
+        <Filename Value="fplists.pp"/>
+        <Caret Line="72" Column="15" TopLine="46"/>
+      </Position4>
+      <Position5>
+        <Filename Value="fplists.pp"/>
+        <Caret Line="37" Column="15" TopLine="27"/>
+      </Position5>
+      <Position6>
+        <Filename Value="fplists.pp"/>
+        <Caret Line="81" Column="3" TopLine="55"/>
+      </Position6>
+      <Position7>
+        <Filename Value="fplists.pp"/>
+        <Caret Line="82" Column="10" TopLine="56"/>
+      </Position7>
+      <Position8>
+        <Filename Value="testll.pp"/>
+        <Caret Line="28" Column="27" TopLine="1"/>
+      </Position8>
+      <Position9>
+        <Filename Value="testll.pp"/>
+        <Caret Line="14" Column="3" TopLine="1"/>
+      </Position9>
+      <Position10>
+        <Filename Value="fplists.pp"/>
+        <Caret Line="65" Column="5" TopLine="8"/>
+      </Position10>
+      <Position11>
+        <Filename Value="testll.pp"/>
+        <Caret Line="50" Column="1" TopLine="2"/>
+      </Position11>
+      <Position12>
+        <Filename Value="testll.pp"/>
+        <Caret Line="52" Column="49" TopLine="9"/>
+      </Position12>
+      <Position13>
+        <Filename Value="testll.pp"/>
+        <Caret Line="93" Column="1" TopLine="51"/>
+      </Position13>
+      <Position14>
+        <Filename Value="testll.pp"/>
+        <Caret Line="72" Column="1" TopLine="47"/>
+      </Position14>
+      <Position15>
+        <Filename Value="testll.pp"/>
+        <Caret Line="20" Column="26" TopLine="1"/>
+      </Position15>
+      <Position16>
+        <Filename Value="testll.pp"/>
+        <Caret Line="53" Column="26" TopLine="1"/>
+      </Position16>
+      <Position17>
+        <Filename Value="testll.pp"/>
+        <Caret Line="95" Column="8" TopLine="95"/>
+      </Position17>
+      <Position18>
+        <Filename Value="fplists.pp"/>
+        <Caret Line="81" Column="19" TopLine="55"/>
+      </Position18>
+      <Position19>
+        <Filename Value="testll.pp"/>
+        <Caret Line="148" Column="9" TopLine="107"/>
+      </Position19>
+      <Position20>
+        <Filename Value="testll.pp"/>
+        <Caret Line="76" Column="1" TopLine="29"/>
+      </Position20>
+      <Position21>
+        <Filename Value="testll.pp"/>
+        <Caret Line="71" Column="15" TopLine="47"/>
+      </Position21>
+      <Position22>
+        <Filename Value="fplists.pp"/>
+        <Caret Line="87" Column="22" TopLine="70"/>
+      </Position22>
+      <Position23>
+        <Filename Value="fplists.pp"/>
+        <Caret Line="106" Column="5" TopLine="49"/>
+      </Position23>
+      <Position24>
+        <Filename Value="fplists.pp"/>
+        <Caret Line="30" Column="76" TopLine="4"/>
+      </Position24>
+      <Position25>
+        <Filename Value="fplists.pp"/>
+        <Caret Line="70" Column="1" TopLine="70"/>
+      </Position25>
+      <Position26>
+        <Filename Value="fplists.pp"/>
+        <Caret Line="124" Column="1" TopLine="72"/>
+      </Position26>
+      <Position27>
+        <Filename Value="testll.pp"/>
+        <Caret Line="178" Column="5" TopLine="121"/>
+      </Position27>
+      <Position28>
+        <Filename Value="testll.pp"/>
+        <Caret Line="180" Column="3" TopLine="141"/>
+      </Position28>
+      <Position29>
+        <Filename Value="testll.pp"/>
+        <Caret Line="199" Column="5" TopLine="171"/>
+      </Position29>
+      <Position30>
+        <Filename Value="testll.pp"/>
+        <Caret Line="221" Column="47" TopLine="177"/>
+      </Position30>
+    </JumpHistory>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <UseHeaptrc Value="True"/>
+      </Debugging>
+    </Linking>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="2">
+      <Item1>
+        <Name Value="ECodetoolError"/>
+      </Item1>
+      <Item2>
+        <Name Value="EFOpenError"/>
+      </Item2>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

rtl/tests/lltests.lpr

@@ -0,0 +1,26 @@
+program lltests;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, consoletestrunner, Testll;
+
+type
+
+  { TLazTestRunner }
+
+  TMyTestRunner = class(TTestRunner)
+  protected
+  // override the protected methods of TTestRunner to customize its behavior
+  end;
+
+var
+  Application: TMyTestRunner;
+
+begin
+  Application := TMyTestRunner.Create(nil);
+  Application.Initialize;
+  Application.Title := 'FPCUnit Console test runner';
+  Application.Run;
+  Application.Free;
+end.

rtl/tests/tcfindnested.pp

@@ -0,0 +1,216 @@
+unit tcfindnested;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, testregistry; 
+
+type
+
+  { TTestFindComponent }
+
+  TTestFindComponent= class(TTestCase)
+  Private
+    R,A,B,AC,BC,D : TComponent;
+    Function CreateNamed(AOwner : TComponent; AName : String) : TComponent;
+    Procedure CheckFind(Root : TComponent; AName : String; Expected : TComponent);
+  Protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+  published
+    procedure TestFindA;
+    procedure TestEmpty;
+    procedure TestFindB;
+    procedure TestFindACaseDiffer;
+    procedure TestFindBCaseDiffer;
+    procedure TestFindNonExist;
+    procedure TestFindNonExistSub;
+    procedure TestFindOwner;
+    procedure TestFindOwnerNameOwner;
+    procedure TestFindOwnerNamed;
+    procedure TestFindOwnerSelf;
+    procedure TestFindSubA;
+    procedure TestFindSubB;
+    procedure TestFindSubNoC;
+  end;
+
+implementation
+{$DEFINE USENEW}
+{$IFDEF USENEW}
+Function FindNestedComponent(Root : TComponent; APath : String; CStyle : Boolean = True) : TComponent;
+
+  Function GetNextName : String; inline;
+  
+  Var
+    P : Integer;
+    CM : Boolean;
+    
+  begin
+    P:=Pos('.',APath);
+    CM:=False;
+    If (P=0) then
+      begin
+      If CStyle then
+        begin
+        P:=Pos('->',APath);
+        CM:=P<>0;
+        end;
+      If (P=0) Then
+        P:=Length(APath)+1;
+      end;
+    Result:=Copy(APath,1,P-1);
+    Delete(APath,1,P+Ord(CM));
+  end;
+
+Var
+  C : TComponent;
+  S : String;
+begin
+  If (APath='') then
+    Result:=Nil
+  else
+    begin
+    Result:=Root;
+    While (APath<>'') And (Result<>Nil) do
+      begin
+      C:=Result;
+      S:=Uppercase(GetNextName);
+      Result:=C.FindComponent(S);
+      If (Result=Nil) And (S='OWNER') then
+        Result:=C;
+      end;
+    end;
+end;
+{$ENDIF}
+
+procedure TTestFindComponent.TestEmpty;
+
+begin
+  // Delphi crashes on this test, don't think we should copy that :-)
+  CheckFind(R,'',Nil);
+end;
+
+procedure TTestFindComponent.TestFindA;
+
+begin
+  CheckFind(R,'AAAA',A);
+end;
+
+procedure TTestFindComponent.TestFindB;
+
+begin
+  CheckFind(R,'BBBB',B);
+end;
+
+procedure TTestFindComponent.TestFindACaseDiffer;
+begin
+  CheckFind(R,'aaaa',A);
+end;
+
+procedure TTestFindComponent.TestFindBCaseDiffer;
+begin
+  CheckFind(R,'bbbb',B);
+end;
+
+procedure TTestFindComponent.TestFindNonExistSub;
+begin
+  CheckFind(R,'aaaa.bbbb',Nil);
+end;
+
+procedure TTestFindComponent.TestFindNonExist;
+begin
+  CheckFind(R,'qqqq',Nil);
+end;
+
+procedure TTestFindComponent.TestFindSubA;
+begin
+  CheckFind(R,'aaaa.cccc',ac);
+end;
+
+procedure TTestFindComponent.TestFindSubB;
+begin
+  CheckFind(R,'bbbb.cccc',bc);
+end;
+
+procedure TTestFindComponent.TestFindSubNoC;
+begin
+  CheckFind(R,'cccc',nil);
+end;
+
+procedure TTestFindComponent.TestFindOwnerNamed;
+begin
+  CheckFind(R,'BBBB.OWNER',D);
+end;
+
+procedure TTestFindComponent.TestFindOwner;
+begin
+  CheckFind(B,'OWNER',D);
+end;
+
+procedure TTestFindComponent.TestFindOwnerSelf;
+begin
+  CheckFind(A,'OWNER',A);
+end;
+
+procedure TTestFindComponent.TestFindOwnerNameOwner;
+begin
+  CheckFind(B,'OWNER.OWNER',D);
+end;
+
+function TTestFindComponent.CreateNamed(AOwner: TComponent; AName: String
+  ): TComponent;
+begin
+  Result:=TComponent.Create(AOwner);
+  Result.Name:=AName;
+end;
+
+procedure TTestFindComponent.CheckFind(Root: TComponent; AName: String;
+  Expected: TComponent);
+  
+  Function FN (C : TComponent): String;
+  
+  begin
+    If (C=Nil) then
+      Result:='<Nil>'
+    else
+      Result:=C.GetNamePath;
+  end;
+
+Var
+  Res : TComponent;
+  
+begin
+  Res:=FindNestedComponent(Root,AName);
+  If Res<>Expected then
+    Fail('Search for "'+AName+'" failed : Found "'+FN(Res)+'", expected : "'+Fn(Expected)+'"');
+end;
+
+procedure TTestFindComponent.SetUp;
+begin
+  R:=CreateNamed(Nil,'Root');
+  A:=CreateNamed(R,'AAAA');
+  B:=CreateNamed(R,'BBBB');
+  AC:=CreateNamed(A,'CCCC');
+  BC:=CreateNamed(B,'CCCC');
+  D:=CreateNamed(B,'OWNER');
+  inherited SetUp;
+end;
+
+procedure TTestFindComponent.TearDown;
+begin
+  FreeAndNil(R); // Will free the rest.
+  A:=Nil;
+  B:=Nil;
+  AC:=Nil;
+  BC:=Nil;
+  D:=Nil;
+end;
+
+
+initialization
+
+  RegisterTest(TTestFindComponent); 
+end.
+

rtl/tests/testll.pp

@@ -0,0 +1,237 @@
+unit Testll;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, testregistry, fplists;
+
+type
+
+  { TTestLinkedList }
+
+  TTestLinkedList= class(TTestCase)
+  published
+    procedure TestCreate;
+    procedure TestAdd;
+    procedure TestAdd2;
+    procedure TestClear;
+    procedure TestRemove;
+    procedure TestRemove2;
+    procedure TestRemove3;
+    Procedure TestVisit;
+  end;
+
+implementation
+
+
+procedure TTestLinkedList.TestCreate;
+
+Var
+  LL : TLinkedList;
+
+begin
+  LL:=TLinkedList.Create(TLinkedListItem);
+  Try
+    AssertEquals('Item class is TLinkedListItem.',TLinkedListItem,LL.ItemClass);
+    AssertEquals('Item count is 0',0,LL.Count);
+    If (LL.Root<>Nil) then
+      Fail('Root is not nil')
+  Finally
+    LL.Free;
+  end;
+end;
+
+procedure TTestLinkedList.TestAdd;
+
+Var
+  LL : TLinkedList;
+  I  : TLinkedListItem;
+  
+begin
+  LL:=TLinkedList.Create(TLinkedListItem);
+  Try
+    I:=LL.Add;
+    AssertEquals('Add result is TLinkedListItem.',TLinkedListItem,I.ClassType);
+    AssertEquals('Item count is 1',1,LL.Count);
+    If (I<>LL.Root) then
+      Fail('Root item is not added item');
+  Finally
+    LL.Free;
+  end;
+end;
+
+procedure TTestLinkedList.TestClear;
+
+Var
+  LL : TLinkedList;
+  I  : Integer;
+
+begin
+  LL:=TLinkedList.Create(TLinkedListItem);
+  Try
+    For I:=1 to 3 do
+      LL.Add;
+    LL.Clear;
+    AssertEquals('Item count after clear is 0',0,LL.Count);
+  Finally
+    LL.Free;
+  end;
+end;
+
+procedure TTestLinkedList.TestAdd2;
+
+Var
+  LL : TLinkedList;
+  I1,I2  : TLinkedListItem;
+  
+begin
+  LL:=TLinkedList.Create(TLinkedListItem);
+  Try
+    I1:=LL.Add;
+    I2:=LL.Add;
+    If (I2<>LL.Root) then
+      Fail('Root item is not last added item');
+    If (I2.Next<>I1) then
+      Fail('Items ordered in the wrong way');
+  Finally
+    LL.Free;
+  end;
+end;
+
+procedure TTestLinkedList.TestRemove;
+
+Var
+  LL : TLinkedList;
+  I  : TLinkedListItem;
+
+begin
+  LL:=TLinkedList.Create(TLinkedListItem);
+  Try
+    I:=LL.Add;
+    Try
+      LL.RemoveItem(I);
+      AssertEquals('After remove Item count is 0',0,LL.Count);
+      If (Nil<>LL.Root) then
+        Fail('Root item is not nil after last removed item');
+    Finally
+      I.Free;
+    end;
+  Finally
+    LL.Free;
+  end;
+end;
+
+procedure TTestLinkedList.TestRemove2;
+
+Var
+  LL : TLinkedList;
+  I1,I2  : TLinkedListItem;
+
+begin
+  LL:=TLinkedList.Create(TLinkedListItem);
+  Try
+    I1:=LL.Add;
+    Try
+      I2:=LL.Add;
+      LL.RemoveItem(I1);
+      AssertEquals('After remove first Item count is 1',1,LL.Count);
+      If (I2<>LL.Root) then
+        Fail('Root item is not I2 after remove of I1');
+    Finally
+      I1.Free;
+    end;
+  Finally
+    LL.Free;
+  end;
+end;
+
+procedure TTestLinkedList.TestRemove3;
+
+Var
+  LL : TLinkedList;
+  I1,I2, I3  : TLinkedListItem;
+
+begin
+  LL:=TLinkedList.Create(TLinkedListItem);
+  Try
+    I1:=LL.Add;
+    I2:=LL.Add;
+    I3:=LL.Add;
+    LL.RemoveItem(I2);
+    Try
+      AssertEquals('After remove I2 Item count is 2',2,LL.Count);
+      If (I3.Next<>I1) then
+        Fail('After Remove of I2, I3.Next<>I1');
+    Finally
+      I2.Free;
+    end;
+  Finally
+    LL.Free;
+  end;
+end;
+
+
+Type
+
+  { TCountVisitor }
+
+  TCountVisitor = Class(TLinkedListVisitor)
+    FCount : integer;
+    FMax : integer;
+    Function Visit(Item : TLinkedListItem) : Boolean; override;
+    Constructor Create(AMax : integer);
+  end;
+
+{ TCountVisitor }
+
+function TCountVisitor.Visit(Item: TLinkedListItem): Boolean;
+begin
+  Inc(FCount);
+  Result:=(FMax=-1) or (FCount<FMax);
+end;
+
+constructor TCountVisitor.Create(AMax: integer);
+begin
+  FMax:=AMax;
+end;
+
+procedure TTestLinkedList.TestVisit;
+
+Var
+  I  : Integer;
+  V  : TCountVisitor;
+  LL : TLinkedList;
+
+begin
+  LL:=TLinkedList.Create(TLinkedListItem);
+  Try
+    For I:=1 to 5 do
+      LL.Add;
+    V:=TCountVisitor.Create(-1);
+    Try
+      LL.Foreach(V);
+      AssertEquals('Counter visited all items',5,V.FCount);
+    Finally
+      V.Free;
+    end;
+    V:=TCountVisitor.Create(3);
+    Try
+      LL.Foreach(V);
+      AssertEquals('Counter visited 3 items',3,V.FCount);
+    Finally
+      V.Free;
+    end;
+  Finally
+    LL.Free;
+  end;
+
+end;
+
+
+initialization
+
+  RegisterTest(TTestLinkedList); 
+end.
+