* Adding it here till a solution for fpcunit-based tests exists

git-svn-id: trunk@11087 -

.gitattributes

@@ -7716,6 +7716,32 @@ tests/test/units/dos/tidos.pp svneol=native#text/plain
 tests/test/units/dos/tidos2.pp svneol=native#text/plain
 tests/test/units/dos/tverify.pp svneol=native#text/plain
 tests/test/units/dos/tversion.pp svneol=native#text/plain
+tests/test/units/fpcunit/fplists.pp svneol=native#text/plain
+tests/test/units/fpcunit/gencomptest.dpr svneol=native#text/plain
+tests/test/units/fpcunit/lists.pp svneol=native#text/plain
+tests/test/units/fpcunit/resref.inc svneol=native#text/plain
+tests/test/units/fpcunit/searchbuf.inc svneol=native#text/plain
+tests/test/units/fpcunit/sllist.inc svneol=native#text/plain
+tests/test/units/fpcunit/tbucketlist.lpi svneol=native#text/plain
+tests/test/units/fpcunit/tbucketlist.lpr svneol=native#text/plain
+tests/test/units/fpcunit/tcbucketlist.pp svneol=native#text/plain
+tests/test/units/fpcunit/tccollection.pp svneol=native#text/plain
+tests/test/units/fpcunit/tccomponent.pp svneol=native#text/plain
+tests/test/units/fpcunit/tccompstreaming.pp svneol=native#text/plain
+tests/test/units/fpcunit/tcfindnested.pp svneol=native#text/plain
+tests/test/units/fpcunit/tclinkedlist.pp svneol=native#text/plain
+tests/test/units/fpcunit/tclist.pp svneol=native#text/plain
+tests/test/units/fpcunit/tcpersistent.pp svneol=native#text/plain
+tests/test/units/fpcunit/tcresref.pp svneol=native#text/plain
+tests/test/units/fpcunit/tcstreaming.pp svneol=native#text/plain
+tests/test/units/fpcunit/tcstringlist.pp svneol=native#text/plain
+tests/test/units/fpcunit/tcstrutils.pp svneol=native#text/plain
+tests/test/units/fpcunit/tctparser.pp svneol=native#text/plain
+tests/test/units/fpcunit/testclasses.lpi svneol=native#text/plain
+tests/test/units/fpcunit/testclasses.lpr svneol=native#text/plain
+tests/test/units/fpcunit/testcomps.pp svneol=native#text/plain
+tests/test/units/fpcunit/tstrutils.lpi svneol=native#text/plain
+tests/test/units/fpcunit/tstrutils.lpr svneol=native#text/plain
 tests/test/units/math/tmask.inc svneol=native#text/plain
 tests/test/units/math/tmask.pp svneol=native#text/plain
 tests/test/units/math/tmask2.pp svneol=native#text/plain

tests/test/units/fpcunit/fplists.pp

@@ -0,0 +1,127 @@
+{$mode objfpc}
+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 : 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.

tests/test/units/fpcunit/gencomptest.dpr

@@ -0,0 +1,402 @@
+program gencomptest;
+
+{$APPTYPE CONSOLE}
+
+uses
+  SysUtils,
+  classes,
+  typinfo,
+  tcstreaming in 'tcstreaming.pas',
+  testcomps in 'testcomps.pas';
+
+Var
+  Indent : String;
+  Src,
+  Procs : TStrings;
+
+Procedure AddLn(S : String); overload;
+
+begin
+  Src.Add(Indent+S);
+end;
+
+Procedure AddLn(Fmt : String; Args : Array of Const); overload;
+
+begin
+  AddLn(Format(Fmt,Args));
+end;
+
+Function CreateString(S : String) : string;
+
+begin
+  Result:=StringReplace(S,'''','''''',[rfReplaceAll]);
+  Result:=''''+Result+'''';
+end;
+
+Function ValName(V : TValueType) : String;
+
+begin
+  Result:=GetEnumName(TypeInfo(TValueType),Ord(v));
+end;
+
+Function AddExpectValue(V : TValueType) : String;
+
+begin
+  AddLn('ExpectValue(%s);',[ValName(V)]);
+end;
+
+
+// This is a reworked version of ObjectBinaryToText.
+// Instead of a text stream, it outputs testsuite code.
+// Note it will only work on i386/AMD64 platforms.
+
+Procedure AnalyzeStream(Input : TStream);
+
+var
+  NestingLevel: Integer;
+  SaveSeparator: Char;
+  Reader: TReader;
+  ObjectName, PropName: string;
+
+
+  procedure ConvertValue; forward;
+
+  procedure ConvertHeader;
+  var
+    ClassName: string;
+    Flags: TFilerFlags;
+    F : TFilerFlag;
+    Position: Integer;
+    S : String;
+
+  begin
+    Position:=0;
+    Reader.ReadPrefix(Flags, Position);
+    S:='';
+    For F:=Low(TFilerFlag) to High(TFilerFlag) do
+      if F in Flags then
+        begin
+        If (S<>'') then
+          S:=S+',';
+        S:=S+GetEnumName(TypeInfo(TFilerFlag),Ord(F));
+        end;
+    Addln('ExpectFlags([%s],%d);',[S,Position]);
+    ClassName := Reader.ReadStr;
+    Addln('ExpectBareString(%s);',[CreateString(ClassName)]);
+    ObjectName := Reader.ReadStr;
+    Addln('ExpectBareString(%s);',[CreateString(ObjectName)]);
+  end;
+
+  procedure ConvertBinary;
+  const
+    BytesPerLine = 32;
+  var
+    I,j: Integer;
+    Count: Longint;
+    Buffer: array[0..BytesPerLine - 1] of Char;
+    V : TValueTYpe;
+
+  begin
+    V:=Reader.ReadValue;
+    AddExpectValue(V);
+    Reader.Read(Count, SizeOf(Count));
+    Addln('ExpectInteger(%d);',[Count]);
+    while Count > 0 do
+      begin
+      if Count >= 32 then I := 32 else I := Count;
+      Reader.Read(Buffer, I);
+      For J:=0 to I-1 do
+        Addln('ExpectByte(%d);',[Byte(Buffer[J])]);
+      Dec(Count, I);
+      end;
+  end;
+
+  procedure ConvertProperty; forward;
+
+  procedure ConvertValue;
+  var
+    S: string;
+    W: WideString;
+    V : TValueType;
+
+  begin
+    V:=Reader.NextValue;
+    case V of
+      vaList:
+        begin
+          V:=Reader.ReadValue;
+          AddExpectValue(V);
+          Inc(NestingLevel);
+          while not Reader.EndOfList do
+          begin
+            ConvertValue;
+          end;
+          Reader.ReadListEnd;
+          Addln('ExpectListEnd');
+          Dec(NestingLevel);
+        end;
+      vaInt8, vaInt16, vaInt32:
+        begin
+        Addln('ExpectInteger(%d);',[Reader.ReadInteger]);
+        end;
+      vaExtended:
+        Addln('ExpectExtended(%f);',[Reader.ReadFloat]);
+      vaSingle:
+        Addln('ExpectSingle(%f);',[Reader.ReadSingle]);
+      vaCurrency:
+        Addln('ExpectCurrency(%f);',[Reader.ReadCurrency]);
+      vaDate:
+        Addln('ExpectDate(%f);',[Reader.ReadDate]);
+      vaWString, vaUTF8String:
+        begin
+          W := Reader.ReadWideString;
+          Addln('ExpectWideString(%s);',[CreateString(W)]);
+        end;
+      vaString, vaLString:
+        begin
+          S := Reader.ReadString;
+          Addln('ExpectString(%s);',[CreateString(S)]);
+        end;
+      vaIdent, vaFalse, vaTrue, vaNil, vaNull:
+        Addln('ExpectIdent(%s);',[CreateString(Reader.ReadIdent)]);
+      vaBinary:
+        ConvertBinary;
+      vaSet:
+        begin
+          V:=Reader.ReadValue;
+          AddExpectValue(V);
+          while True do
+            begin
+            S := Reader.ReadStr;
+            Addln('ExpectBareString(%s);',[CreateString(S)]);
+            if S = '' then Break;
+            end;
+        end;
+      vaCollection:
+        begin
+          V:=Reader.ReadValue;
+          AddExpectValue(V);
+          Inc(NestingLevel);
+          while not Reader.EndOfList do
+          begin
+            V:=Reader.NextValue;
+            if V in [vaInt8, vaInt16, vaInt32] then
+              begin
+              ConvertValue;
+              end;
+            Reader.CheckValue(vaList);
+            AddExpectValue(vaList);
+            Inc(NestingLevel);
+            while not Reader.EndOfList do
+              ConvertProperty;
+            Reader.ReadListEnd;
+            Addln('ExpectEndOfList;');
+            Dec(NestingLevel);
+          end;
+          Reader.ReadListEnd;
+          Addln('ExpectEndOfList;');
+          Dec(NestingLevel);
+        end;
+      vaInt64:
+        Addln('ExpectInt64(%d);',[Reader.ReadInt64]);
+    else
+       Raise Exception.Create('Invalid stream');
+    end;
+  end;
+
+  procedure ConvertProperty;
+  begin
+    PropName := Reader.ReadStr;  // save for error reporting
+    Addln('ExpectBareString(%s);',[CreateString(PropName)]);
+    ConvertValue;
+  end;
+
+  procedure ConvertObject;
+  begin
+    ConvertHeader;
+    Inc(NestingLevel);
+    while not Reader.EndOfList do ConvertProperty;
+    Reader.ReadListEnd;
+    Addln('ExpectEndOfList;');
+    while not Reader.EndOfList do ConvertObject;
+    Reader.ReadListEnd;
+    Addln('ExpectEndOfList;');
+    Dec(NestingLevel);
+  end;
+
+begin
+  NestingLevel := 0;
+  Reader := TReader.Create(Input, 4096);
+  SaveSeparator := DecimalSeparator;
+  DecimalSeparator := '.';
+  try
+    Reader.ReadSignature;
+    Addln('ExpectSignature;');
+    ConvertObject;
+  finally
+    DecimalSeparator := SaveSeparator;
+    Reader.Free;
+  end;
+end;
+
+Procedure TestComponent(AClass : TComponentClass; AOwner : TComponent);
+
+Var
+  S : TMemoryStream;
+  C : TComponent;
+  N,O : String;
+
+begin
+  Addln('');
+  Addln('');
+  Addln('Procedure TTestComponentStream.Test%s;',[AClass.ClassName]);
+  Addln('');
+  Addln('Var');
+  Addln('  C : TComponent;');
+  Addln('');
+  Addln('begin');
+  Indent:='  ';
+  N:=AClass.ClassName;
+  Procs.Add('Test'+N);
+  If (AOwner=Nil) then
+    O:='Nil'
+  else
+    O:=AOwner.Name;
+  AddLn('C:=%s.Create(%s);',[N,O]);
+  Addln('Try');
+  Indent:='    ';
+  Addln('SaveToStream(C);');
+  S:=TMemoryStream.Create;
+  try
+    C:=AClass.Create(AOwner);
+    Try
+      C.Name:='Test'+C.ClassName;
+      S.WriteComponent(C);
+      S.Position:=0;
+      AnalyzeStream(S);
+      With TFileStream.Create(AClass.ClassName+'.dat',fmCreate) do
+        try
+          CopyFrom(S,0);
+        finally
+          Free;
+        end;
+    Finally
+      C.Free;
+    end;
+  finally
+    S.Free;
+  end;
+  Indent:='  ';
+  Addln('Finally');
+  Indent:='    ';
+  Addln('C.Free;');
+  Addln('end;');
+  Indent:='';
+  Addln('end;');
+end;
+
+Procedure GenTests;
+
+begin
+  TestComponent(TEmptyComponent,Nil);
+  TestComponent(TIntegerComponent,Nil);
+  TestComponent(TIntegerComponent2,Nil);
+  TestComponent(TIntegerComponent3,Nil);
+  TestComponent(TIntegerComponent4,Nil);
+  TestComponent(TIntegerComponent5,Nil);
+  TestComponent(TInt64Component,Nil);
+  TestComponent(TInt64Component2,Nil);
+  TestComponent(TInt64Component3,Nil);
+  TestComponent(TInt64Component4,Nil);
+  TestComponent(TInt64Component5,Nil);
+  TestComponent(TInt64Component6,Nil);
+  TestComponent(TStringComponent,Nil);
+  TestComponent(TStringComponent2,Nil);
+  TestComponent(TWideStringComponent,Nil);
+  TestComponent(TWideStringComponent2,Nil);
+  TestComponent(TSingleComponent,Nil);
+  TestComponent(TDoubleComponent,Nil);
+  TestComponent(TExtendedComponent,Nil);
+  TestComponent(TCompComponent,Nil);
+  TestComponent(TCurrencyComponent,Nil);
+  TestComponent(TDateTimeComponent,Nil);
+  TestComponent(TDateTimeComponent2,Nil);
+  TestComponent(TDateTimeComponent3,Nil);
+  TestComponent(TEnumComponent,Nil);
+  TestComponent(TEnumComponent2,Nil);
+  TestComponent(TEnumComponent3,Nil);
+  TestComponent(TEnumComponent4,Nil);
+  TestComponent(TSetComponent,Nil);
+  TestComponent(TSetComponent2,Nil);
+  TestComponent(TSetComponent3,Nil);
+  TestComponent(TSetComponent4,Nil);
+  TestComponent(TMultipleComponent,Nil);
+  TestComponent(TPersistentComponent,Nil);
+  TestComponent(TCollectionComponent,Nil);
+  TestComponent(TCollectionComponent2,Nil);
+  TestComponent(TCollectionComponent3,Nil);
+  TestComponent(TCollectionComponent4,Nil);
+  TestComponent(TOwnedComponent,Nil);
+  TestComponent(TStreamedOwnedComponent,Nil);
+  TestComponent(TMethodComponent,Nil);
+  TestComponent(TMethodComponent2,Nil);
+end;
+
+
+Procedure GenUnit;
+
+Var
+  I : Integer;
+  F : Text;
+
+begin
+  Assign(f,'tctestcompstreaming.pas');
+  Rewrite(F);
+  try
+  Writeln(F,'Unit tctestcompstreaming;');
+  Writeln(F);
+  Writeln(F,'interface');
+  Writeln(F);
+  Writeln(F,'Uses');
+  Writeln(F,'  SysUtils,Classes,tcstreaming;');
+  Writeln(F);
+  Writeln(F,'Type ');
+  Writeln(F,'  TTestComponentStream = Class(TTestStreaming)');
+  Writeln(F,'  Published');
+  For I:=0 to Procs.Count-1 do
+    Writeln(F,'    Procedure '+Procs[i]+';');
+  Writeln(F,'  end;');
+  Writeln(F);
+  Writeln(F,'Implementation');
+  Writeln(F);
+  Writeln(F,'uses testcomps;');
+  For I:=0 to Src.Count-1 do
+    Writeln(F,Src[i]);
+  Writeln(F);
+  Writeln(F,'end.');
+  Finally
+    Close(f);
+  end;
+end;
+
+Procedure GenCode;
+
+begin
+  Src:=TStringList.Create;
+  try
+    Procs:=TStringList.Create;
+    try
+      GenTests;
+      GenUnit;
+    finally
+      Procs.Free;
+    end;
+  finally
+    Src.Free;
+  end;
+end;
+
+
+begin
+  GenCode;
+end.

tests/test/units/fpcunit/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  
+

tests/test/units/fpcunit/resref.inc

@@ -0,0 +1,453 @@
+
+
+type
+  // Quadruple representing an unresolved component property.
+
+  { TUnresolvedReference }
+
+  TUnresolvedReference = class(TlinkedListItem)
+  Private
+    FRoot: TComponent;     // Root component when streaming
+    FPropInfo: PPropInfo;  // Property to set.
+    FGlobal,               // Global component.
+    FRelative : string;    // Path relative to global component.
+    Function Resolve(Instance : TPersistent) : Boolean; // Resolve this reference
+    Function RootMatches(ARoot : TComponent) : Boolean; Inline; // True if Froot matches or ARoot is nil.
+    Function NextRef : TUnresolvedReference; inline;
+  end;
+  
+  TLocalUnResolvedReference = class(TUnresolvedReference)
+    Finstance : TPersistent;
+  end;
+
+  // Linked list of TPersistent items that have unresolved properties.  
+
+  { TUnResolvedInstance }
+
+  TUnResolvedInstance = Class(TLinkedListItem)
+    Instance : TPersistent; // Instance we're handling unresolveds for
+    FUnresolved : TLinkedList; // The list
+    Destructor Destroy; override;
+    Function AddReference(ARoot : TComponent; APropInfo : PPropInfo; AGlobal,ARelative : String) : TUnresolvedReference;
+    Function RootUnresolved : TUnresolvedReference; inline; // Return root element in list.
+    Function ResolveReferences : Boolean; // Return true if all unresolveds were resolved.
+  end;
+
+  // Builds a list of TUnResolvedInstances, removes them from global list on free.
+  TBuildListVisitor = Class(TLinkedListVisitor)
+    List : TFPList;
+    Procedure Add(Item : TlinkedListItem); // Add TUnResolvedInstance item to list. Create list if needed
+    Destructor Destroy; override; // All elements in list (if any) are removed from the global list.
+  end;
+  
+  // Visitor used to try and resolve instances in the global list
+  TResolveReferenceVisitor = Class(TBuildListVisitor)
+    Function Visit(Item : TLinkedListItem) : Boolean; override;
+  end;
+  
+  // Visitor used to remove all references to a certain component.
+  TRemoveReferenceVisitor = Class(TBuildListVisitor)
+    FRef : String;
+    FRoot : TComponent;
+    Constructor Create(ARoot : TComponent;Const ARef : String);
+    Function Visit(Item : TLinkedListItem) : Boolean; override;
+  end;
+
+  // Visitor used to collect reference names.
+  TReferenceNamesVisitor = Class(TLinkedListVisitor)
+    FList : TStrings;
+    FRoot : TComponent;
+    Function Visit(Item : TLinkedListItem) : Boolean; override;
+    Constructor Create(ARoot : TComponent;AList : TStrings);
+  end;
+
+  // Visitor used to collect instance names.  
+  TReferenceInstancesVisitor = Class(TLinkedListVisitor)
+    FList : TStrings;
+    FRef  : String;
+    FRoot : TComponent;
+    Function Visit(Item : TLinkedListItem) : Boolean; override;
+    Constructor Create(ARoot : TComponent;Const ARef : String; AList : TStrings);
+  end;
+  
+  // Visitor used to redirect links to another root component.
+  TRedirectReferenceVisitor = Class(TLinkedListVisitor)
+    FOld,
+    FNew : String;
+    FRoot : TComponent;
+    Function Visit(Item : TLinkedListItem) : Boolean; override;
+    Constructor Create(ARoot : TComponent;Const AOld,ANew : String);
+  end;
+  
+var
+  NeedResolving : TLinkedList;
+  ResolveSection : TRTLCriticalSection;
+  LastAddInstance : TUnresolvedInstance;
+
+// Add an instance to the global list of instances which need resolving.
+Function FindUnresolvedInstance(AInstance: TPersistent) : TUnResolvedInstance;
+
+begin
+  Result:=Nil;
+  EnterCriticalSection(ResolveSection);
+  Try
+    If Assigned(NeedResolving) then
+      begin
+      Result:=TUnResolvedInstance(NeedResolving.Root);
+      While (Result<>Nil) and (Result.Instance<>AInstance) do
+        Result:=TUnResolvedInstance(Result.Next);
+      end;
+  finally
+    LeaveCriticalSection(ResolveSection);
+  end;
+end;
+
+Function AddtoResolveList(AInstance: TPersistent) : TUnResolvedInstance;
+
+begin
+  Result:=FindUnresolvedInstance(AInstance);
+  If (Result=Nil) then
+    begin
+    EnterCriticalSection(ResolveSection);
+    Try
+      If not Assigned(NeedResolving) then
+        NeedResolving:=TLinkedList.Create(TUnResolvedInstance);
+      Result:=NeedResolving.Add as TUnResolvedInstance;
+      Result.Instance:=AInstance;
+    finally
+      LeaveCriticalSection(ResolveSection);
+    end;
+    end;
+end;
+
+// Walk through the global list of instances to be resolved.  
+
+Procedure VisitResolveList(V : TLinkedListVisitor);
+
+begin
+  EnterCriticalSection(ResolveSection);
+  Try
+    try
+      NeedResolving.Foreach(V);
+    Finally
+      FreeAndNil(V);
+    end;  
+  Finally
+    LeaveCriticalSection(ResolveSection);
+  end;  
+end;
+
+procedure GlobalFixupReferences;
+
+var
+  V : TResolveReferenceVisitor;
+  I : Integer;
+    
+begin
+  If (NeedResolving=Nil) then 
+    Exit;
+  GlobalNameSpace.BeginWrite;
+  try
+    VisitResolveList(TResolveReferenceVisitor.Create);
+  finally
+    GlobalNameSpace.EndWrite;
+  end;
+end;
+
+
+procedure GetFixupReferenceNames(Root: TComponent; Names: TStrings);
+
+begin
+  If (NeedResolving=Nil) then 
+    Exit;
+  VisitResolveList(TReferenceNamesVisitor.Create(Root,Names));
+end;
+
+procedure GetFixupInstanceNames(Root: TComponent; const ReferenceRootName: string; Names: TStrings);
+
+begin
+  If (NeedResolving=Nil) then
+    Exit;
+  VisitResolveList(TReferenceInstancesVisitor.Create(Root,ReferenceRootName,Names));
+end;
+
+procedure RedirectFixupReferences(Root: TComponent; const OldRootName, NewRootName: string);
+
+begin
+  If (NeedResolving=Nil) then
+      Exit;
+  VisitResolveList(TRedirectReferenceVisitor.Create(Root,OldRootName,NewRootName));
+end;
+
+procedure RemoveFixupReferences(Root: TComponent; const RootName: string);
+
+begin
+  If (NeedResolving=Nil) then
+      Exit;
+  VisitResolveList(TRemoveReferenceVisitor.Create(Root,RootName));
+end;
+
+procedure RemoveFixups(Instance: TPersistent);
+
+begin
+  // This needs work.
+{
+  if not Assigned(GlobalFixupList) then
+    exit;
+
+  with GlobalFixupList.LockList do
+    try
+      for i := Count - 1 downto 0 do
+      begin
+        CurFixup := TPropFixup(Items[i]);
+        if (CurFixup.FInstance = Instance) then
+        begin
+          Delete(i);
+          CurFixup.Free;
+        end;
+      end;
+    finally
+      GlobalFixupList.UnlockList;
+    end;
+}
+end;
+
+{ TUnresolvedReference }
+
+Function TUnresolvedReference.Resolve(Instance : TPersistent) : Boolean;
+
+Var
+  C : TComponent;
+
+begin
+  C:=FindGlobalComponent(FGlobal);
+  Result:=(C<>Nil);
+  If Result then
+    begin
+    C:=FindNestedComponent(C,FRelative);
+    Result:=C<>Nil;
+    If Result then
+      SetObjectProp(Instance, FPropInfo,C);
+    end;
+end; 
+
+Function TUnresolvedReference.RootMatches(ARoot : TComponent) : Boolean; Inline;
+
+begin
+  Result:=(ARoot=Nil) or (ARoot=FRoot);
+end;
+
+Function TUnResolvedReference.NextRef : TUnresolvedReference;
+
+begin
+  Result:=TUnresolvedReference(Next);
+end;
+
+{ TUnResolvedInstance }
+
+destructor TUnResolvedInstance.Destroy;
+begin
+  FUnresolved.Free;
+  inherited Destroy;
+end;
+
+function TUnResolvedInstance.AddReference(ARoot: TComponent;
+  APropInfo: PPropInfo; AGlobal, ARelative: String): TUnresolvedReference;
+begin
+  If (FUnResolved=Nil) then
+    FUnResolved:=TLinkedList.Create(TUnresolvedReference);
+  Result:=FUnResolved.Add as TUnresolvedReference;
+  Result.FGlobal:=AGLobal;
+  Result.FRelative:=ARelative;
+  Result.FPropInfo:=APropInfo;
+  Result.FRoot:=ARoot;
+end;
+
+Function TUnResolvedInstance.RootUnresolved : TUnresolvedReference; 
+
+begin
+  Result:=Nil;
+  If Assigned(FUnResolved) then
+    Result:=TUnresolvedReference(FUnResolved.Root);
+end;
+
+Function TUnResolvedInstance.ResolveReferences:Boolean;
+
+Var
+  R,RN : TUnresolvedReference;
+
+begin
+  R:=RootUnResolved;
+  While (R<>Nil) do
+    begin
+    RN:=R.NextRef;
+    If R.Resolve(Self.Instance) then
+      FUnresolved.RemoveItem(R,True);
+    R:=RN;
+    end;
+  Result:=RootUnResolved=Nil;
+end;
+
+{ TReferenceNamesVisitor }
+
+Constructor TReferenceNamesVisitor.Create(ARoot : TComponent;AList : TStrings);
+
+begin
+  FRoot:=ARoot;
+  FList:=AList;
+end;
+
+Function TReferenceNamesVisitor.Visit(Item : TLinkedListItem) : Boolean;
+
+Var
+  R : TUnresolvedReference;
+
+begin
+  R:=TUnResolvedInstance(Item).RootUnresolved;
+  While (R<>Nil) do
+    begin
+    If R.RootMatches(FRoot) then
+      If (FList.IndexOf(R.FGlobal)=-1) then 
+        FList.Add(R.FGlobal);
+    R:=R.NextRef;
+    end;
+  Result:=True;
+end;
+
+{ TReferenceInstancesVisitor }
+
+Constructor TReferenceInstancesVisitor.Create(ARoot : TComponent; Const ARef : String;AList : TStrings);
+
+begin
+  FRoot:=ARoot;
+  FRef:=UpperCase(ARef);
+  FList:=AList;
+end;
+
+Function TReferenceInstancesVisitor.Visit(Item : TLinkedListItem) : Boolean;
+
+Var
+  R : TUnresolvedReference;
+
+begin
+  R:=TUnResolvedInstance(Item).RootUnresolved;
+  While (R<>Nil) do
+    begin
+    If (FRoot=R.FRoot) and (FRef=UpperCase(R.FGLobal)) Then
+      If Flist.IndexOf(R.FRelative)=-1 then
+        Flist.Add(R.FRelative);
+    R:=R.NextRef;
+    end;
+  Result:=True;
+end;
+
+{ TRedirectReferenceVisitor }
+
+Constructor TRedirectReferenceVisitor.Create(ARoot : TComponent; Const AOld,ANew  : String);
+
+begin
+  FRoot:=ARoot;
+  FOld:=UpperCase(AOld);
+  FNew:=ANew;
+end;
+
+Function TRedirectReferenceVisitor.Visit(Item : TLinkedListItem) : Boolean;
+
+Var
+  R : TUnresolvedReference;
+
+begin
+  R:=TUnResolvedInstance(Item).RootUnresolved;
+  While (R<>Nil) do
+    begin
+    If R.RootMatches(FRoot) and (FOld=UpperCase(R.FGLobal)) Then
+      R.FGlobal:=FNew;
+    R:=R.NextRef;
+    end;
+  Result:=True;
+end;
+
+{ TRemoveReferenceVisitor }
+
+Constructor TRemoveReferenceVisitor.Create(ARoot : TComponent; Const ARef  : String);
+
+begin
+  FRoot:=ARoot;
+  FRef:=UpperCase(ARef);
+end;
+
+Function TRemoveReferenceVisitor.Visit(Item : TLinkedListItem) : Boolean;
+
+Var
+  I : Integer;
+  UI : TUnResolvedInstance;
+  R : TUnresolvedReference;
+  L : TFPList;
+  
+begin
+  UI:=TUnResolvedInstance(Item);
+  R:=UI.RootUnresolved;
+  L:=Nil;
+  Try
+    // Collect all matches.
+    While (R<>Nil) do
+      begin
+      If R.RootMatches(FRoot) and (FRef=UpperCase(R.FGLobal)) Then
+        begin
+        If Not Assigned(L) then
+          L:=TFPList.Create;
+        L.Add(R);
+        end;
+      R:=R.NextRef;
+      end;
+    // Remove all matches.
+    IF Assigned(L) then
+      begin
+      For I:=0 to L.Count-1 do
+        UI.FUnresolved.RemoveItem(TLinkedListitem(L[i]),True);
+      end;
+    // If any references are left, leave them.
+    If UI.FUnResolved.Root=Nil then
+      begin
+      If List=Nil then
+        List:=TFPList.Create;
+      List.Add(UI);
+      end;
+  Finally
+    L.Free;
+  end;
+  Result:=True;
+end;
+
+{ TBuildListVisitor }
+
+Procedure TBuildListVisitor.Add(Item : TlinkedListItem);
+
+begin
+  If (List=Nil) then
+    List:=TFPList.Create;
+  List.Add(Item);
+end;  
+
+Destructor TBuildListVisitor.Destroy;
+
+Var
+  I : Integer;
+
+begin
+  If Assigned(List) then
+    For I:=0 to List.Count-1 do
+      NeedResolving.RemoveItem(TLinkedListItem(List[I]),True);
+  FreeAndNil(List);
+  Inherited;
+end;
+
+{ TResolveReferenceVisitor }
+
+Function TResolveReferenceVisitor.Visit(Item : TLinkedListItem) : Boolean; 
+
+begin
+  If TUnResolvedInstance(Item).ResolveReferences then
+    Add(Item);
+  Result:=True;  
+end;

tests/test/units/fpcunit/searchbuf.inc

@@ -0,0 +1,114 @@
+type
+  TEqualFunction = function (const a,b : char) : boolean;
+
+function EqualWithCase (const a,b : char) : boolean;
+begin
+  result := (a = b);
+end;
+
+function EqualWithoutCase (const a,b : char) : boolean;
+begin
+  result := (lowerCase(a) = lowerCase(b));
+end;
+
+function IsWholeWord (bufstart, bufend, wordstart, wordend : pchar) : boolean;
+begin
+            // Check start
+  result := ((wordstart = bufstart) or ((wordstart-1)^ in worddelimiters)) and
+            // Check end
+            ((wordend = bufend) or ((wordend+1)^ in worddelimiters));
+end;
+
+function SearchDown(buf,aStart,endchar:pchar; SearchString:string;
+    Equals : TEqualFunction; WholeWords:boolean) : pchar;
+var Found : boolean;
+    s, c : pchar;
+begin
+  result := aStart;
+  Found := false;
+  while not Found and (result <= endchar) do
+    begin
+    // Search first letter
+    while (result <= endchar) and not Equals(result^,SearchString[1]) do
+      inc (result);
+    // Check if following is searchstring
+    c := result;
+    s := @(Searchstring[1]);
+    Found := true;
+    while (c <= endchar) and (s^ <> #0) and Found do
+      begin
+      Found := Equals(c^, s^);
+      inc (c);
+      inc (s);
+      end;
+    if s^ <> #0 then
+      Found := false;
+    // Check if it is a word
+    if Found and WholeWords then
+      Found := IsWholeWord(buf,endchar,result,c-1);
+    if not found then
+      inc (result);
+    end;
+  if not Found then
+    result := nil;
+end;
+
+function SearchUp(buf,aStart,endchar:pchar; SearchString:string;
+    equals : TEqualFunction; WholeWords:boolean) : pchar;
+var Found : boolean;
+    s, c, l : pchar;
+begin
+  result := aStart;
+  Found := false;
+  l := @(SearchString[length(SearchString)]);
+  while not Found and (result >= buf) do
+    begin
+    // Search last letter
+    while (result >= buf) and not Equals(result^,l^) do
+      dec (result);
+    // Check if before is searchstring
+    c := result;
+    s := l;
+    Found := true;
+    while (c >= buf) and (s >= @SearchString[1]) and Found do
+      begin
+      Found := Equals(c^, s^);
+      dec (c);
+      dec (s);
+      end;
+    if (s >= @(SearchString[1])) then
+      Found := false;
+    // Check if it is a word
+    if Found and WholeWords then
+      Found := IsWholeWord(buf,endchar,c+1,result);
+    if found then
+      result := c+1
+    else
+      dec (result);
+    end;
+  if not Found then
+    result := nil;
+end;
+
+//function SearchDown(buf,aStart,endchar:pchar; SearchString:string; equal : TEqualFunction; WholeWords:boolean) : pchar;
+function SearchBuf(Buf: PChar;BufLen: Integer;SelStart: Integer;SelLength: Integer;
+    SearchString: String;Options: TStringSearchOptions):PChar;
+var
+  equal : TEqualFunction;
+begin
+  SelStart := SelStart + SelLength;
+  if (SearchString = '') or (SelStart > BufLen) or (SelStart < 0) then
+    result := nil
+  else
+    begin
+    if soMatchCase in Options then
+      Equal := @EqualWithCase
+    else
+      Equal := @EqualWithoutCase;
+    if soDown in Options then
+      result := SearchDown(buf,buf+SelStart,Buf+(BufLen-1), SearchString, Equal, (soWholeWord in Options))
+    else
+      result := SearchUp(buf,buf+SelStart,Buf+(Buflen-1), SearchString, Equal, (soWholeWord in Options));
+    end;
+end;
+

tests/test/units/fpcunit/sllist.inc

@@ -0,0 +1,117 @@
+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;
+
+{ 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;
+

tests/test/units/fpcunit/tbucketlist.lpi

@@ -0,0 +1,206 @@
+<?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="3">
+      <Unit0>
+        <Filename Value="tbucketlist.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tbucketlist"/>
+        <UsageCount Value="20"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="tcbucketlist.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tcbucketlist"/>
+        <CursorPos X="1" Y="144"/>
+        <TopLine Value="94"/>
+        <EditorIndex Value="0"/>
+        <UsageCount Value="20"/>
+        <Loaded Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="bucketlist.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="bucketlist"/>
+        <CursorPos X="22" Y="78"/>
+        <TopLine Value="39"/>
+        <EditorIndex Value="1"/>
+        <UsageCount Value="20"/>
+        <Loaded Value="True"/>
+      </Unit2>
+    </Units>
+    <JumpHistory Count="30" HistoryIndex="29">
+      <Position1>
+        <Filename Value="tcbucketlist.pp"/>
+        <Caret Line="58" Column="1" TopLine="8"/>
+      </Position1>
+      <Position2>
+        <Filename Value="tcbucketlist.pp"/>
+        <Caret Line="24" Column="47" TopLine="24"/>
+      </Position2>
+      <Position3>
+        <Filename Value="tcbucketlist.pp"/>
+        <Caret Line="70" Column="13" TopLine="29"/>
+      </Position3>
+      <Position4>
+        <Filename Value="tcbucketlist.pp"/>
+        <Caret Line="40" Column="24" TopLine="32"/>
+      </Position4>
+      <Position5>
+        <Filename Value="tcbucketlist.pp"/>
+        <Caret Line="45" Column="31" TopLine="20"/>
+      </Position5>
+      <Position6>
+        <Filename Value="tcbucketlist.pp"/>
+        <Caret Line="70" Column="32" TopLine="37"/>
+      </Position6>
+      <Position7>
+        <Filename Value="tcbucketlist.pp"/>
+        <Caret Line="59" Column="39" TopLine="34"/>
+      </Position7>
+      <Position8>
+        <Filename Value="bucketlist.pp"/>
+        <Caret Line="320" Column="38" TopLine="304"/>
+      </Position8>
+      <Position9>
+        <Filename Value="bucketlist.pp"/>
+        <Caret Line="98" Column="3" TopLine="74"/>
+      </Position9>
+      <Position10>
+        <Filename Value="bucketlist.pp"/>
+        <Caret Line="148" Column="1" TopLine="139"/>
+      </Position10>
+      <Position11>
+        <Filename Value="bucketlist.pp"/>
+        <Caret Line="164" Column="10" TopLine="131"/>
+      </Position11>
+      <Position12>
+        <Filename Value="bucketlist.pp"/>
+        <Caret Line="149" Column="14" TopLine="130"/>
+      </Position12>
+      <Position13>
+        <Filename Value="bucketlist.pp"/>
+        <Caret Line="370" Column="5" TopLine="346"/>
+      </Position13>
+      <Position14>
+        <Filename Value="bucketlist.pp"/>
+        <Caret Line="147" Column="8" TopLine="126"/>
+      </Position14>
+      <Position15>
+        <Filename Value="bucketlist.pp"/>
+        <Caret Line="325" Column="1" TopLine="303"/>
+      </Position15>
+      <Position16>
+        <Filename Value="tcbucketlist.pp"/>
+        <Caret Line="21" Column="3" TopLine="18"/>
+      </Position16>
+      <Position17>
+        <Filename Value="tcbucketlist.pp"/>
+        <Caret Line="27" Column="32" TopLine="26"/>
+      </Position17>
+      <Position18>
+        <Filename Value="tcbucketlist.pp"/>
+        <Caret Line="111" Column="33" TopLine="92"/>
+      </Position18>
+      <Position19>
+        <Filename Value="tcbucketlist.pp"/>
+        <Caret Line="104" Column="5" TopLine="49"/>
+      </Position19>
+      <Position20>
+        <Filename Value="tcbucketlist.pp"/>
+        <Caret Line="99" Column="1" TopLine="71"/>
+      </Position20>
+      <Position21>
+        <Filename Value="tcbucketlist.pp"/>
+        <Caret Line="28" Column="32" TopLine="27"/>
+      </Position21>
+      <Position22>
+        <Filename Value="tcbucketlist.pp"/>
+        <Caret Line="93" Column="1" TopLine="67"/>
+      </Position22>
+      <Position23>
+        <Filename Value="tcbucketlist.pp"/>
+        <Caret Line="120" Column="37" TopLine="95"/>
+      </Position23>
+      <Position24>
+        <Filename Value="tcbucketlist.pp"/>
+        <Caret Line="36" Column="1" TopLine="1"/>
+      </Position24>
+      <Position25>
+        <Filename Value="tcbucketlist.pp"/>
+        <Caret Line="29" Column="26" TopLine="28"/>
+      </Position25>
+      <Position26>
+        <Filename Value="tcbucketlist.pp"/>
+        <Caret Line="130" Column="54" TopLine="95"/>
+      </Position26>
+      <Position27>
+        <Filename Value="tcbucketlist.pp"/>
+        <Caret Line="129" Column="19" TopLine="100"/>
+      </Position27>
+      <Position28>
+        <Filename Value="tcbucketlist.pp"/>
+        <Caret Line="38" Column="1" TopLine="4"/>
+      </Position28>
+      <Position29>
+        <Filename Value="tcbucketlist.pp"/>
+        <Caret Line="137" Column="5" TopLine="82"/>
+      </Position29>
+      <Position30>
+        <Filename Value="tcbucketlist.pp"/>
+        <Caret Line="29" Column="27" TopLine="28"/>
+      </Position30>
+    </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>

tests/test/units/fpcunit/tbucketlist.lpr

@@ -0,0 +1,26 @@
+program tbucketlist;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, consoletestrunner, tcbucketlist, bucketlist;
+
+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.

tests/test/units/fpcunit/tcbucketlist.pp

@@ -0,0 +1,182 @@
+unit tcbucketlist;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, testregistry,
+  BucketList;
+
+type
+  TMyBucketList = Class(TBucketList)
+  public
+    property BucketCount;
+  end;
+
+  PPtrInt= ^PtrInt;
+
+  { TTestBucketList }
+
+  TTestBucketList= class(TTestCase)
+  Private
+    FList : TMyBucketList;
+    FData : Array[1..10] of PtrInt;
+    FPointers : Array[1..10] of PPtrInt;
+    procedure DoDuplicate;
+    Procedure AddPointers(ACount : Integer);
+    function GetCount: Integer;
+  protected
+    procedure SetUp; override; 
+    procedure TearDown; override; 
+  published
+    procedure TestCreate;
+    procedure TestAdd;
+    procedure TestAdd2;
+    procedure TestAddDuplicate;
+    procedure TestDelete;
+    procedure TestDelete2;
+    procedure TestClear;
+  end;
+
+implementation
+
+Type
+
+{ TCounter }
+
+TCounter = Class(TObject)
+private
+  FCount: Integer;
+Public
+  procedure CountItems(AItem, AData: Pointer; out AContinue: Boolean);
+  Property Count : Integer Read FCount;
+end;
+
+
+procedure TCounter.CountItems(AItem, AData: Pointer; out AContinue: Boolean);
+
+begin
+  Inc(FCount);
+end;
+
+procedure TTestBucketList.TestAdd;
+
+Var
+  P : POinter;
+
+begin
+  P:=FList.add(FPointers[1],Pointer(FData[1]));
+  AssertSame('Add returns data pointer',P,Pointer(FData[1]));
+  AssertEquals('Item count is 1',1,GetCount);
+end;
+
+procedure TTestBucketList.TestAdd2;
+
+begin
+  AddPointers(2);
+  With TCounter.Create do
+    try
+      FList.ForEach(@CountItems);
+      AssertEquals('Item count is 1',2,Count);
+    Finally
+      Free;
+    end;
+end;
+
+procedure TTestBucketList.DoDuplicate;
+
+begin
+  AddPointers(1);
+end;
+
+Function TTestBucketList.GetCount : Integer;
+
+begin
+  With TCounter.Create do
+    try
+      FList.ForEach(@CountItems);
+      Result:=Count;
+    Finally
+      Free;
+    end;
+end;
+
+
+procedure TTestBucketList.AddPointers(ACount: Integer);
+
+Var
+  I : Integer;
+
+begin
+  For I:=1 to ACount do
+    FList.Add(FPointers[I],Pointer(FData[i]));
+end;
+
+procedure TTestBucketList.TestAddDuplicate;
+
+begin
+  AddPointers(1);
+  self.AssertException('Adding duplicate raises exception',EListError,@DoDuplicate);
+end;
+
+procedure TTestBucketList.TestDelete;
+
+begin
+  AddPointers(3);
+  FList.Remove(FPointers[3]);
+  AssertEquals('Deleted no longer exists',False,Flist.Exists(FPointers[3]));
+  AssertEquals('Remaining 2 exists',True,Flist.Exists(FPointers[2]));
+  AssertEquals('Remaining 1 exists',True,Flist.Exists(FPointers[1]));
+end;
+
+procedure TTestBucketList.TestDelete2;
+
+begin
+  AddPointers(3);
+  FList.Remove(FPointers[3]);
+  AssertEquals('Count after delete is 2',2,GetCount);
+  FList.Remove(FPointers[2]);
+  AssertEquals('Count after delete is 2',1,GetCount);
+  FList.Remove(FPointers[1]);
+  AssertEquals('Count after delete is 2',0,GetCount);
+end;
+
+procedure TTestBucketList.TestClear;
+begin
+  AddPointers(10);
+  FList.Clear;
+  AssertEquals('Count after Clear is 0',0,GetCount);
+end;
+
+procedure TTestBucketList.TestCreate;
+
+begin
+  AssertEquals('Count should be 64',64,Flist.BucketCount);
+  AssertEquals('Item count is 0',0,GetCount);
+end;
+
+procedure TTestBucketList.SetUp; 
+
+Var
+  I : integer;
+
+begin
+  FList:=TMyBucketList.create(bl64);
+  For I:=1 to 10 do
+    begin
+    FData[i]:=I;
+    FPointers[i]:=@FData[i];
+    end;
+end; 
+
+procedure TTestBucketList.TearDown; 
+begin
+  FreeAndNil(FList);
+end; 
+
+initialization
+
+  RegisterTest(TTestBucketList); 
+end.
+

tests/test/units/fpcunit/tccollection.pp

@@ -0,0 +1,496 @@
+unit tccollection;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry;
+
+type
+
+  { TMyItem }
+
+  TMyItem = Class(TCollectionItem)
+  private
+    FNr: integer;
+  protected
+    // Expose
+    function GetOwner: TPersistent; override;
+  published
+    Property Nr : integer Read FNr Write FNr;
+  end;
+  
+  { TMyCollection }
+
+  TMyCollection = Class(TCollection)
+  Private
+    FOwner : TPersistent;
+    FUpdateCount : Integer;
+    FLastNotifyItem,
+    FLastUpdate : TCollectionItem;
+    FNotifyCount : Integer;
+    FLastNotify : TCollectionNotification;
+    Function GetOwner : TPersistent; override;
+  Public
+    procedure Update(Item: TCollectionItem); override;
+    procedure Notify(Item: TCollectionItem;Action: TCollectionNotification); override;
+    Procedure ResetUpdate;
+    Procedure ResetNotify;
+    property PropName;
+  end;
+  
+  
+  { TTestTCollection }
+
+  TTestTCollection= class(TTestCase)
+  private
+    procedure AccessNegativeIndex;
+    procedure AccessTooBigIndex;
+    procedure DeleteNegativeIndex;
+    procedure DeleteTooBigIndex;
+    procedure MoveNegativeIndex;
+    procedure MoveTooBigIndex;
+  protected
+    FColl : TMyCollection;
+    Function MyItem(I : integer) : TMyItem;
+    procedure AddItems(ACount : Integer);
+    procedure SetUp; override; 
+    procedure TearDown; override; 
+  published
+    procedure TestCreate;
+    procedure TestAdd;
+    procedure TestItemCollection;
+    procedure TestAddTwo;
+    Procedure TestDelete;
+    procedure TestClear;
+    Procedure TestFreeItem;
+    Procedure TestMoveForward;
+    Procedure TestMoveBackward;
+    Procedure TestID;
+    Procedure TestItemOwner;
+    Procedure TestDisplayName;
+    procedure TestOwnerNamePath;
+    Procedure TestItemNamePath;
+    Procedure TestOwnerItemNamePath;
+    Procedure TestChangeCollection;
+    procedure TestAccesIndexOutOfBounds;
+    procedure TestDeleteIndexOutOfBounds;
+    procedure TestMoveIndexOutOfBounds;
+    Procedure TestUpdateAdd;
+    Procedure TestUpdateDelete;
+    Procedure TestUpdateDisplayName;
+    Procedure TestUpdateCount;
+    Procedure TestUpdateCountNested;
+    Procedure TestUpdateMove;
+    Procedure TestNotifyAdd;
+    Procedure TestNotifyDelete;
+  end;
+
+implementation
+
+procedure TTestTCollection.TestCreate;
+begin
+  AssertEquals('Item count 0 at create',0,FColl.Count);
+  AssertEquals('ItemClass is TMyItem',TMyItem,FColl.ItemClass);
+end;
+
+procedure TTestTCollection.TestAdd;
+begin
+  AddItems(1);
+  AssertEquals('Item count is 1 after add',1,FColl.Count);
+  AssertEquals('Item class is correct',FColl.ItemClass,FColl.Items[0].ClassType);
+  AssertEquals('Item index is 0',0,FColl.Items[0].Index);
+  AssertEquals('Item ID is 0',0,FColl.Items[0].Id);
+end;
+
+procedure TTestTCollection.TestItemCollection;
+begin
+  AddItems(1);
+  If MyItem(0).Collection<>FColl then
+    Fail('Item''s Collection is not collection');
+end;
+
+procedure TTestTCollection.TestAddTwo;
+
+Var
+  I: Integer;
+  
+begin
+  AddItems(3);
+  AssertEquals('Item count is 3 after add',3,FColl.Count);
+  For I:=0 to 2 do
+    begin
+    AssertEquals(Format('Item %d class is correct',[i]),FColl.ItemClass,FColl.Items[i].ClassType);
+    AssertEquals(Format('Item %d index is 0',[i]),i,FColl.Items[i].Index);
+    AssertEquals(Format('Item %d ID is 0',[i]),i,FColl.Items[i].Id);
+    AssertEquals(Format('Item %d ID is %d',[i,i+1]),i+1,MyItem(i).Nr);
+    end;
+end;
+
+procedure TTestTCollection.TestDelete;
+begin
+  AddItems(3);
+  FColl.Delete(1);
+  AssertEquals('Item count after delete',2,FColl.Count);
+  AssertEquals('Item 0 ok after delete',1,MyItem(0).Nr);
+  AssertEquals('Item 1 ok after delete',3,MyItem(1).Nr);
+end;
+
+procedure TTestTCollection.TestClear;
+begin
+  AddItems(3);
+  FColl.Clear;
+  AssertEquals('Item count after clear',0,FColl.Count);
+end;
+
+procedure TTestTCollection.TestFreeItem;
+begin
+  AddItems(3);
+  MyItem(1).Free;
+  AssertEquals('Item count after free',2,FColl.Count);
+  AssertEquals('Item 0 ok after free',1,MyItem(0).Nr);
+  AssertEquals('Item 1 ok after free',3,MyItem(1).Nr);
+end;
+
+procedure TTestTCollection.TestMoveForward;
+begin
+  AddItems(5);
+  MyItem(4).Index:=1;
+  AssertEquals('Item 0 ok after move',1,MyItem(0).Nr);
+  AssertEquals('Item 1 ok after move',5,MyItem(1).Nr);
+  AssertEquals('Item 2 ok after move',2,MyItem(2).Nr);
+  AssertEquals('Item 3 ok after move',3,MyItem(3).Nr);
+  AssertEquals('Item 4 ok after move',4,MyItem(4).Nr);
+end;
+
+procedure TTestTCollection.TestMoveBackward;
+
+begin
+  AddItems(5);
+  MyItem(1).Index:=3;
+  AssertEquals('Item 0 ok after move',1,MyItem(0).Nr);
+  AssertEquals('Item 1 ok after move',3,MyItem(1).Nr);
+  AssertEquals('Item 2 ok after move',4,MyItem(2).Nr);
+  AssertEquals('Item 3 ok after move',2,MyItem(3).Nr);
+  AssertEquals('Item 4 ok after move',5,MyItem(4).Nr);
+end;
+
+procedure TTestTCollection.TestID;
+
+Var
+  I : TMyItem;
+  
+begin
+  AddItems(5);
+  FColl.Delete(2);
+  FColl.Delete(2);
+  I:=TMyItem(FColl.Add);
+  AssertEquals('ID keeps counting up',5,I.Id)
+end;
+
+procedure TTestTCollection.TestItemOwner;
+begin
+  AddItems(1);
+  If (MyItem(0).GetOwner<>FColl) then
+    Fail('Item owner is not collection');
+end;
+
+procedure TTestTCollection.TestDisplayName;
+begin
+  AddItems(1);
+  AssertEquals('Displayname is classname','TMyItem',MyItem(0).DisplayName);
+end;
+
+procedure TTestTCollection.TestItemNamePath;
+begin
+  AddItems(2);
+  AssertEquals('Item namepath is collection namepath+index',FColl.GetNamePath+'[0]',MyItem(0).GetNamePath);
+  AssertEquals('Item namepath is collection namepath+index',FColl.GetNamePath+'[1]',MyItem(1).GetNamePath);
+end;
+
+procedure TTestTCollection.TestOwnerItemNamePath;
+
+Var
+  P : TPersistent;
+
+begin
+  P:=TPersistent.Create;
+  try
+    TMyCollection(FColl).FOwner:=P;
+    AddItems(2);
+    TMyCollection(FColl).PropName:='Something';
+    AssertEquals('Item namepath is collection namepath+index','TPersistent.Something[0]',MyItem(0).GetNamePath);
+  finally
+    P.Free;
+  end;
+end;
+
+procedure TTestTCollection.TestOwnerNamePath;
+
+Var
+  P : TPersistent;
+
+begin
+  P:=TPersistent.Create;
+  try
+    TMyCollection(FColl).FOwner:=P;
+    AddItems(2);
+    TMyCollection(FColl).PropName:='Something';
+    AssertEquals('Namepath is collection namepath+index','TPersistent.Something',FColl.GetNamePath);
+  finally
+    P.Free;
+  end;
+end;
+
+procedure TTestTCollection.TestChangeCollection;
+
+Var
+  FCol2 : TCollection;
+  I : TCollectionItem;
+  
+begin
+  AddItems(2);
+  FCol2:=TCollection.Create(TMyItem);
+  try
+    I:=FCol2.Add;
+    I.Collection:=FColl;
+    AssertEquals('Moved item, count of source is zero',0,FCol2.Count);
+    AssertEquals('Moved item, count of dest is 1',3,FColl.Count);
+    AssertEquals('Moved item, index is 2',2,I.Index);
+    If (FColl.Items[0].Collection<>FColl) then
+      Fail('Collection owner is not set correctly after move');
+    AssertEquals('Moved item, ID is 2',2,I.ID);
+  finally
+    FCol2.free;
+  end;
+end;
+
+procedure TTestTCollection.AccessNegativeIndex;
+
+begin
+  FColl.Items[-1];
+end;
+
+procedure TTestTCollection.AccessTooBigIndex;
+
+begin
+  FColl.Items[3];
+end;
+
+
+procedure TTestTCollection.TestAccesIndexOutOfBounds;
+begin
+  AddItems(3);
+  AssertException('Access Negative Index',EListError,@AccessNegativeIndex);
+  AssertException('Access Index too big',EListError,@AccessTooBigIndex);
+end;
+
+procedure TTestTCollection.DeleteNegativeIndex;
+begin
+  FColl.Delete(-1);
+end;
+
+procedure TTestTCollection.DeleteTooBigIndex;
+begin
+  FColl.Delete(3);
+end;
+
+procedure TTestTCollection.TestDeleteIndexOutOfBounds;
+begin
+  AddItems(3);
+  AssertException('Delete Negative Index',EListError,@DeleteNegativeIndex);
+  AssertException('Delete Index too big',EListError,@DeleteTooBigIndex);
+end;
+
+procedure TTestTCollection.MoveNegativeIndex;
+begin
+  FColl.Items[1].Index:=-1;
+end;
+
+procedure TTestTCollection.MoveTooBigIndex;
+begin
+  FColl.Items[1].Index:=3;
+end;
+
+procedure TTestTCollection.TestMoveIndexOutOfBounds;
+begin
+  AddItems(3);
+  AssertException('Move Negative first index',EListError,@MoveNegativeIndex);
+  AssertException('Exchange Negative second index',EListError,@MoveTooBigIndex);
+end;
+
+procedure TTestTCollection.TestUpdateAdd;
+begin
+  AddItems(1);
+  If (FColl.FLastUpdate<>Nil) then
+    Fail('update item found !');
+  AssertEquals('Update count is 1',1,FColl.FUpdateCount);
+
+end;
+
+procedure TTestTCollection.TestUpdateDelete;
+begin
+  AddItems(1);
+  FColl.ResetUpdate;
+  FColl.Delete(0);
+  If (FColl.FLastUpdate<>Nil) then
+    Fail('update item found !');
+  AssertEquals('Update count is 1',1,FColl.FUpdateCount);
+
+end;
+
+procedure TTestTCollection.TestUpdateDisplayName;
+begin
+  AddItems(1);
+  FColl.ResetUpdate;
+  MyItem(0).DisplayName:='Something';
+  AssertEquals('Display name notification. Update count is 1',1,FColl.FUpdateCount);
+  If (FColl.FLastUpdate<>MyItem(0)) then
+    Fail('No displayname update');
+end;
+
+procedure TTestTCollection.TestUpdateCount;
+begin
+  FColl.BeginUpdate;
+  Try
+    AddItems(2);
+    
+    AssertEquals('Beginupdate; adds. Update count is 0',0,FColl.FUpdateCount);
+    If (FColl.FLastUpdate<>Nil) then
+      Fail('Beginupdate; FlastUpdate not nil');
+  finally
+    FColl.EndUpdate;
+  end;
+  AssertEquals('Endupdate; adds. Update count is 1',1,FColl.FUpdateCount);
+  If (FColl.FLastUpdate<>Nil) then
+    Fail('Endupdate; FlastUpdate not nil');
+end;
+
+procedure TTestTCollection.TestUpdateCountNested;
+begin
+  FColl.BeginUpdate;
+  Try
+    AddItems(2);
+    FColl.BeginUpdate;
+    Try
+      AddItems(2);
+      AssertEquals('Beginupdate 2; adds. Update count is 0',0,FColl.FUpdateCount);
+      If (FColl.FLastUpdate<>Nil) then
+        Fail('Beginupdate 2; FlastUpdate not nil');
+    finally
+      FColl.EndUpdate;
+    end;
+    AssertEquals('Endupdate 1; Update count is 0',0,FColl.FUpdateCount);
+    If (FColl.FLastUpdate<>Nil) then
+      Fail('EndUpdate 1; FlastUpdate not nil');
+  finally
+    FColl.EndUpdate;
+  end;
+  AssertEquals('Endupdate 2; adds. Update count is 1',1,FColl.FUpdateCount);
+  If (FColl.FLastUpdate<>Nil) then
+    Fail('Endupdate 2; FlastUpdate not nil');
+end;
+
+procedure TTestTCollection.TestUpdateMove;
+begin
+  AddItems(5);
+  FColl.ResetUpdate;
+  MyItem(4).Index:=2;
+  AssertEquals('Moved item. Update count is 1',1,FColl.FUpdateCount);
+  If (FColl.FLastUpdate<>Nil) then
+    Fail('Moved item notification - not all items updated');
+end;
+
+procedure TTestTCollection.TestNotifyAdd;
+begin
+  AddItems(1);
+  If (FColl.FLastNotifyItem<>MyItem(0)) then
+    Fail('No notify item found !');
+  AssertEquals('Notify count is 1',1,FColl.FNotifyCount);
+  AssertEquals('Notify action is cnAdded',Ord(cnAdded),Ord(FColl.FLastNotify));
+end;
+
+procedure TTestTCollection.TestNotifyDelete;
+
+begin
+  AddItems(3);
+  FColl.ResetNotify;
+  FColl.Delete(1);
+  // cnDeleting/cnExtracing. Can't currently test for 2 events...
+  AssertEquals('Notify count is 2',2,FColl.FNotifyCount);
+  AssertEquals('Notify action is cnExtracted',Ord(cnExtracting),Ord(FColl.FLastNotify));
+end;
+
+function TTestTCollection.MyItem(I: integer): TMyItem;
+begin
+  Result:=TMyItem(FColl.Items[i]);
+end;
+
+procedure TTestTCollection.AddItems(ACount: Integer);
+
+Var
+  I : integer;
+  
+begin
+  For I:=1 to ACount do
+    TMyItem(FColl.Add).Nr:=I;
+end;
+
+procedure TTestTCollection.SetUp; 
+begin
+  FColl:=TMyCollection.Create(TMyItem);
+end; 
+
+procedure TTestTCollection.TearDown; 
+begin
+   FreeAndNil(FColl);
+end; 
+
+{ TMyItem }
+
+function TMyItem.GetOwner: TPersistent;
+begin
+  Result:=inherited GetOwner;
+end;
+
+{ TMyCollection }
+
+function TMyCollection.GetOwner: TPersistent;
+begin
+  Result:=FOwner;
+  If (Result=Nil) then
+    Result:=Inherited GetOwner;
+end;
+
+procedure TMyCollection.Update(Item: TCollectionItem);
+begin
+  Inc(FUpdateCount);
+  FLastUpdate:=Item;
+end;
+
+procedure TMyCollection.Notify(Item: TCollectionItem;
+  Action: TCollectionNotification);
+begin
+  Inc(FNotifyCount);
+  FLastNotify:=Action;
+  FLastNotifyItem:=Item;
+end;
+
+procedure TMyCollection.ResetUpdate;
+begin
+  FUpdateCount:=0;
+  FLastUpdate:=Nil;
+end;
+
+procedure TMyCollection.ResetNotify;
+begin
+  FNotifyCount:=0;
+  FLastNotifyItem:=Nil;
+end;
+
+initialization
+
+  RegisterTest(TTestTCollection); 
+end.
+

tests/test/units/fpcunit/tccomponent.pp

@@ -0,0 +1,437 @@
+unit tccomponent;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry;
+
+type
+
+  { TEventSink }
+
+  TEventSink = Class(TObject)
+    FEventCount : Integer;
+    FLastSender : TObject;
+    Procedure Event(Sender : TObject); virtual;
+    Procedure ResetEvent;
+  end;
+
+  { TNotification }
+  
+  TNotification = Class(TCollectionItem)
+  Public
+    ASender,
+    AComponent : TComponent;
+    AOperation : TOperation;
+  end;
+
+  { TNotificationSink }
+
+  TNotificationSink = Class(TObject)
+  private
+    Fevents : TCollection;
+    function GetNot(Index : Integer): TNotification;
+  Public
+    Destructor Destroy; override;
+    procedure Notification(Sender, AComponent: TComponent; Operation: TOperation); virtual;
+    Procedure Reset;
+    Function EventCount : Integer;
+    Property Notifications [Index : Integer] : TNotification Read GetNot;
+  end;
+
+  { TMyComponent }
+
+  TNotificationEvent = procedure (Sender : TComponent; AComponent: TComponent; Operation: TOperation) of object;
+
+  TMyComponent = Class(TComponent)
+  private
+    FOnDestroy: TNotifyEvent;
+    FOnNotify: TNotificationEvent;
+  Public
+    Destructor Destroy; override;
+    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+    Property OnDestroy : TNotifyEvent Read FOnDestroy Write FOnDestroy;
+    Property OnNotification : TNotificationEvent Read FOnNotify Write FOnNotify;
+  end;
+
+  { TTestTComponentBase }
+
+  TTestTComponentBase = class(TTestCase)
+  protected
+    FRoot : TMyComponent;
+    Procedure CreateComponents(ACount : Integer);
+    Procedure CreateComponents(ACount : Integer; Const BaseName : String);
+    Procedure CreateComponents(ACount : Integer; AClass : TComponentClass);
+    Procedure CreateComponents(ACount : Integer; AClass : TComponentClass; Const BaseName : String);
+    procedure SetUp; override;
+    procedure TearDown; override; 
+  end;
+  
+  { TTestTComponent }
+
+  TTestTComponent = Class(TTestTComponentBase)
+  private
+    procedure TestDoubleName;
+    procedure TestTextName;
+    procedure TestNumberName;
+    procedure TestNumberTextName;
+  Published
+    Procedure TestCreate;
+    Procedure TestName;
+    procedure TestIdentiFierName;
+    procedure TestIdentiFierNameTwo;
+    procedure TestIdentiFierNameThree;
+    procedure TestIdentiFierNameFour;
+    procedure TestOwner;
+    procedure TestChildren;
+    Procedure TestDestroyChild;
+    Procedure TestDestroyChildren;
+    Procedure TestUniqueName;
+    Procedure TestRemoveComponent;
+  end;
+  
+  { TTestTComponentNotifies }
+
+  TTestTComponentNotifies = Class(TTestTComponentBase)
+  Protected
+    N : TNotificationSink;
+    procedure SetUp; override;
+    procedure TearDown; override;
+  Published
+    Procedure TestInsertNotification;
+    Procedure TestRemoveNotification;
+  end;
+
+
+implementation
+
+procedure TTestTComponentBase.CreateComponents(ACount: Integer);
+begin
+  CreateComponents(ACount,'');
+end;
+
+procedure TTestTComponentBase.CreateComponents(ACount: Integer;
+  const BaseName: String);
+begin
+  CreateComponents(ACount,TMyComponent,BaseName);
+end;
+
+procedure TTestTComponentBase.CreateComponents(ACount: Integer;
+  AClass: TComponentClass);
+begin
+  CreateComponents(ACount,AClass,'');
+end;
+
+procedure TTestTComponentBase.CreateComponents(ACount: Integer;
+  AClass: TComponentClass; const BaseName: String);
+  
+Var
+  I : Integer;
+  C : TComponent;
+  
+begin
+  For I:=0 to ACount-1 do
+    begin
+    C:=TMyComponent.Create(FRoot);
+    If (BaseName<>'') then
+      C.Name:=BaseName+IntToStr(I+1);
+    end;
+end;
+
+procedure TTestTComponentBase.SetUp; 
+begin
+  FRoot:=TMyComponent.Create(Nil);
+  FRoot.Name:='Root';
+end; 
+
+procedure TTestTComponentBase.TearDown; 
+begin
+  FreeAndNil(FRoot);
+end; 
+
+{ TTestTComponent }
+
+procedure TTestTComponent.TestCreate;
+begin
+  FreeAndNil(Froot);
+  FRoot:=TMyComponent.Create(Nil);
+  AssertEquals('Empty name','',FRoot.Name);
+  AssertEquals('No owned components',0,FRoot.ComponentCount);
+  If (FRoot.ComponentState<>[]) then
+    Fail('Componentstate is not empty');
+  If (FRoot.Owner<>Nil) then
+    Fail('Owner is not nil');
+end;
+
+procedure TTestTComponent.TestName;
+begin
+  AssertEquals('Name is Root','Root',FRoot.Name);
+end;
+
+procedure TTestTComponent.TestOwner;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TComponent.Create(FRoot);
+  If (C.Owner<>FRoot) then
+    Fail('Owner not saved after create');
+end;
+
+procedure TTestTComponent.TestChildren;
+begin
+  CreateComponents(3,'Child');
+  AssertEquals('Componentcount is 3',3,FRoot.ComponentCount);
+  AssertEquals('Child component 0 is child1','Child1',FRoot.Components[0].Name);
+  AssertEquals('Child component 1 is child2','Child2',FRoot.Components[1].Name);
+  AssertEquals('Child component 2 is child3','Child3',FRoot.Components[2].Name);
+end;
+
+procedure TTestTComponent.TestDestroyChild;
+
+Var
+  S : TEventSink;
+
+begin
+  CreateComponents(1);
+  S:=TEventSink.Create;
+  try
+    TMyComponent(FRoot.Components[0]).OnDestroy:[email protected];
+    FreeAndNil(FRoot);
+    AssertEquals('One child destroyed',1,S.FEventcount);
+    If (S.FLastSender=Nil) then
+      Fail('No sender passed');
+  finally
+    S.Free;
+  end;
+end;
+
+procedure TTestTComponent.TestDestroyChildren;
+
+Var
+  S : TEventSink;
+  I : Integer;
+
+begin
+  CreateComponents(3);
+  S:=TEventSink.Create;
+  try
+    For I:=0 to 2 do
+      TMyComponent(FRoot.Components[I]).OnDestroy:[email protected];
+    FreeAndNil(FRoot);
+    AssertEquals('One child destroyed',3,S.FEventcount);
+    If (S.FLastSender=Nil) then
+      Fail('No sender passed');
+  finally
+    S.Free;
+  end;
+end;
+
+procedure TTestTComponent.TestDoubleName;
+
+begin
+  FRoot.Components[1].Name:='Child1';
+end;
+
+procedure TTestTComponent.TestUniqueName;
+begin
+  CreateComponents(3,'Child');
+  AssertException('Unique name',EComponentError,@TestDoubleName);
+end;
+
+procedure TTestTComponent.TestRemoveComponent;
+
+Var
+  C : TComponent;
+
+begin
+  CreateComponents(1);
+  C:=FRoot.Components[0];
+  FRoot.RemoveComponent(C);
+  Try
+    AssertEquals('No components left',0,FRoot.ComponentCount);
+    AssertSame('Component has no owner',Nil,C.Owner);
+  Finally
+    C.Free;
+  end;
+end;
+
+
+procedure TTestTComponent.TestTextName;
+
+begin
+  FRoot.Name:='Child 1';
+end;
+
+procedure TTestTComponent.TestNumberName;
+begin
+  FRoot.Name:='1';
+end;
+
+procedure TTestTComponent.TestNumberTextName;
+begin
+  FRoot.Name:='1Too';
+end;
+
+procedure TTestTComponent.TestIdentiFierName;
+begin
+  AssertException('Identifier name',EComponentError,@TestTextName);
+end;
+
+procedure TTestTComponent.TestIdentiFierNameTwo;
+
+begin
+  AssertException('Identifier name',EComponentError,@TestNumberTextName);
+end;
+
+procedure TTestTComponent.TestIdentiFierNameThree;
+begin
+  AssertException('Identifier name',EComponentError,@TestNumberName);
+end;
+
+procedure TTestTComponent.TestIdentiFierNameFour;
+
+Var
+  Failed : Boolean;
+
+begin
+  Failed:=False;
+  Try
+    FRoot.Name:='Some1';
+  except
+    Failed:=True;
+  end;
+  If Failed then
+    Fail('No identifier ending on 1 accepted ?');
+end;
+
+{ TMyComponent }
+
+destructor TMyComponent.Destroy;
+begin
+  If Assigned(FOnDestroy) then
+    FOnDestroy(Self);
+  inherited Destroy;
+end;
+
+procedure TMyComponent.Notification(AComponent: TComponent;
+  Operation: TOperation);
+begin
+  If Assigned(FOnNotify) then
+    FOnNotify(Self, AComponent, Operation);
+  inherited Notification(AComponent, Operation);
+end;
+
+{ TEventSink }
+
+procedure TEventSink.Event(Sender: TObject);
+begin
+  Inc(FEventCount);
+  FLastSender:=Sender;
+end;
+
+procedure TEventSink.ResetEvent;
+begin
+  FLastSender:=Nil;
+  FEventCount:=0;
+end;
+
+{ TNotificationSink }
+
+function TNotificationSink.GetNot(Index : Integer): TNotification;
+begin
+  If Assigned(FEvents) then
+    Result:=TNotification(FEvents.Items[Index])
+  else
+    Result:=Nil;
+end;
+
+destructor TNotificationSink.Destroy;
+begin
+  FreeAndNil(FEvents);
+  inherited Destroy;
+end;
+
+procedure TNotificationSink.Notification(Sender, AComponent: TComponent;
+  Operation: TOperation);
+  
+Var
+  N : TNotification;
+  
+begin
+  If (Fevents=Nil) then
+    FEvents:=TCollection.Create(TNotification);
+  N:=FEvents.Add as TNotification;
+  N.AComponent:=AComponent;
+  N.ASender:=Sender;
+  N.AOperation:=Operation;
+end;
+
+procedure TNotificationSink.Reset;
+begin
+  FreeAndNil(FEvents);
+end;
+
+function TNotificationSink.EventCount: Integer;
+begin
+  If (Fevents<>Nil) then
+    Result:=FEvents.Count
+  else
+    Result:=0;
+end;
+
+{ TTestTComponentNotifies }
+
+procedure TTestTComponentNotifies.SetUp;
+begin
+  inherited SetUp;
+  N:=TNotificationSink.Create;
+  FRoot.OnNotification:[email protected];
+end;
+
+procedure TTestTComponentNotifies.TearDown;
+begin
+  FreeAndNil(N);
+  inherited TearDown;
+end;
+
+procedure TTestTComponentNotifies.TestInsertNotification;
+
+Var
+  E : TNotification;
+
+begin
+  CreateComponents(1);
+  AssertEquals('One notification received',1,N.EventCount);
+  E:=N.Notifications[0];
+  AssertEquals('Insert notification received',Ord(opInsert),Ord(E.AOperation));
+end;
+
+procedure TTestTComponentNotifies.TestRemoveNotification;
+
+Var
+  C : TComponent;
+  E : TNotification;
+
+begin
+  CreateComponents(1);
+  N.Reset;
+  C:=FRoot.Components[0];
+  FRoot.RemoveComponent(C);
+  Try
+    AssertEquals('One notification received',1,N.EventCount);
+    E:=N.Notifications[0];
+  Finally
+    C.Free;
+  end;
+end;
+
+
+initialization
+
+  RegisterTests([TTestTComponent,TTestTComponentNotifies]);
+end.
+

tests/test/units/fpcunit/tccompstreaming.pp

@@ -0,0 +1,1413 @@
+Unit tccompstreaming;
+
+interface
+
+Uses
+  SysUtils,Classes,tcstreaming,fpcunit, testregistry;
+
+Type 
+
+{ TTestComponentStream }
+
+TTestComponentStream = Class(TTestStreaming)
+  Published
+    Procedure TestTEmptyComponent;
+    Procedure TestTIntegerComponent;
+    Procedure TestTIntegerComponent2;
+    Procedure TestTIntegerComponent3;
+    Procedure TestTIntegerComponent4;
+    Procedure TestTIntegerComponent5;
+    Procedure TestTInt64Component;
+    Procedure TestTInt64Component2;
+    Procedure TestTInt64Component3;
+    Procedure TestTInt64Component4;
+    Procedure TestTInt64Component5;
+    Procedure TestTInt64Component6;
+    Procedure TestTStringComponent;
+    Procedure TestTStringComponent2;
+    Procedure TestTWideStringComponent;
+    Procedure TestTWideStringComponent2;
+    Procedure TestTSingleComponent;
+    Procedure TestTDoubleComponent;
+    Procedure TestTExtendedComponent;
+    Procedure TestTCompComponent;
+    Procedure TestTCurrencyComponent;
+    Procedure TestTDateTimeComponent;
+    Procedure TestTDateTimeComponent2;
+    Procedure TestTDateTimeComponent3;
+    Procedure TestTEnumComponent;
+    Procedure TestTEnumComponent2;
+    Procedure TestTEnumComponent3;
+    Procedure TestTEnumComponent4;
+    Procedure TestTEnumComponent5;
+    Procedure TestTSetComponent;
+    Procedure TestTSetComponent2;
+    Procedure TestTSetComponent3;
+    Procedure TestTSetComponent4;
+    Procedure TestTMultipleComponent;
+    Procedure TestTPersistentComponent;
+    Procedure TestTCollectionComponent;
+    Procedure TestTCollectionComponent2;
+    Procedure TestTCollectionComponent3;
+    Procedure TestTCollectionComponent4;
+    Procedure TestTCollectionComponent5;
+    Procedure TestTOwnedComponent;
+    Procedure TestTStreamedOwnedComponent;
+    Procedure TestTStreamedOwnedComponents;
+    Procedure TestTMethodComponent;
+    Procedure TestTMethodComponent2;
+  end;
+  { TMyItem }
+
+  TMyItem = Class(TCollectionItem)
+  private
+    FNR: Integer;
+    FStr: String;
+  Public
+    Procedure Assign(Source : TPersistent); override;
+  Published
+    Property Nr : Integer Read FNR Write FNR;
+    Property Str: String Read FStr Write FStr;
+  end;
+
+  { TMyColl }
+
+  TMyColl = Class(TCollection)
+  private
+    function GetIt(index : Integer): TMyItem;
+    procedure SetIt(index : Integer; const AValue: TMyItem);
+  Public
+    Property It[index : Integer] : TMyItem Read GetIt Write SetIt; default;
+  end;
+
+  { TCollComp }
+
+  TCollComp = Class(TComponent)
+  private
+    FMyColl: TMyColl;
+    procedure SetMyColl(const AValue: TMyColl);
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+    Function ToStream : TStream;
+    Procedure FromStream(AStream : TStream);
+  Published
+    Property MyColl : TMyColl Read FMyColl Write SetMyColl;
+  end;
+
+
+  { TTestCollectionStream }
+
+  TTestCollectionStream = Class(TTestCase)
+
+  private
+    procedure CompareColl(CA, CB: TMyColl);
+    function CreateColl(Anr: Integer): TCollComp;
+    function EmptyComp: TCollComp;
+    procedure TestNr(ACount: Integer);
+  Published
+    procedure Test1;
+    procedure Test2;
+    procedure Test3;
+    procedure TestClear;
+    procedure TestEmpty;
+  end;
+
+Implementation
+
+uses testcomps;
+
+
+Procedure TTestComponentStream.TestTEmptyComponent;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TEmptyComponent.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TEmptyComponent');
+    ExpectBareString('TestTEmptyComponent');
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTIntegerComponent;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TIntegerComponent.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TIntegerComponent');
+    ExpectBareString('TestTIntegerComponent');
+    ExpectBareString('IntProp');
+    ExpectInteger(3);
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTIntegerComponent2;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TIntegerComponent2.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TIntegerComponent2');
+    ExpectBareString('TestTIntegerComponent2');
+    ExpectBareString('IntProp');
+    ExpectInteger(1024);
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTIntegerComponent3;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TIntegerComponent3.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TIntegerComponent3');
+    ExpectBareString('TestTIntegerComponent3');
+    ExpectBareString('IntProp');
+    ExpectInteger(262144);
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTIntegerComponent4;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TIntegerComponent4.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TIntegerComponent4');
+    ExpectBareString('TestTIntegerComponent4');
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTIntegerComponent5;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TIntegerComponent5.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TIntegerComponent5');
+    ExpectBareString('TestTIntegerComponent5');
+    ExpectBareString('IntProp');
+    ExpectInteger(5);
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTInt64Component;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TInt64Component.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TInt64Component');
+    ExpectBareString('TestTInt64Component');
+    ExpectBareString('Int64Prop');
+    ExpectInteger(4);
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTInt64Component2;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TInt64Component2.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TInt64Component2');
+    ExpectBareString('TestTInt64Component2');
+    ExpectBareString('Int64Prop');
+    ExpectInteger(1024);
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTInt64Component3;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TInt64Component3.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TInt64Component3');
+    ExpectBareString('TestTInt64Component3');
+    ExpectBareString('Int64Prop');
+    ExpectInteger(262144);
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTInt64Component4;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TInt64Component4.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TInt64Component4');
+    ExpectBareString('TestTInt64Component4');
+    ExpectBareString('Int64Prop');
+    ExpectInt64(2147745791);
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTInt64Component5;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TInt64Component5.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TInt64Component5');
+    ExpectBareString('TestTInt64Component5');
+    ExpectBareString('Int64Prop');
+    ExpectInteger(7);
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTInt64Component6;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TInt64Component6.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TInt64Component6');
+    ExpectBareString('TestTInt64Component6');
+    ExpectBareString('Int64Prop');
+    ExpectInteger(8);
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTStringComponent;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TStringComponent.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TStringComponent');
+    ExpectBareString('TestTStringComponent');
+    ExpectBareString('StringProp');
+    ExpectString('A string');
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTStringComponent2;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TStringComponent2.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TStringComponent2');
+    ExpectBareString('TestTStringComponent2');
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTWideStringComponent;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TWideStringComponent.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TWideStringComponent');
+    ExpectBareString('TestTWideStringComponent');
+    ExpectBareString('WideStringProp');
+    ExpectString('Some WideString');
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTWideStringComponent2;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TWideStringComponent2.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TWideStringComponent2');
+    ExpectBareString('TestTWideStringComponent2');
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTSingleComponent;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TSingleComponent.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TSingleComponent');
+    ExpectBareString('TestTSingleComponent');
+    ExpectBareString('SingleProp');
+    ExpectExtended(1.23);
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTDoubleComponent;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TDoubleComponent.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TDoubleComponent');
+    ExpectBareString('TestTDoubleComponent');
+    ExpectBareString('DoubleProp');
+    ExpectExtended(2.34);
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTExtendedComponent;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TExtendedComponent.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TExtendedComponent');
+    ExpectBareString('TestTExtendedComponent');
+    ExpectBareString('ExtendedProp');
+    ExpectExtended(3.45);
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTCompComponent;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TCompComponent.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TCompComponent');
+    ExpectBareString('TestTCompComponent');
+    ExpectBareString('ExtendedProp');
+    ExpectExtended(5.00);
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTCurrencyComponent;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TCurrencyComponent.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TCurrencyComponent');
+    ExpectBareString('TestTCurrencyComponent');
+    ExpectBareString('CurrencyProp');
+    ExpectExtended(5.67);
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTDateTimeComponent;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TDateTimeComponent.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TDateTimeComponent');
+    ExpectBareString('TestTDateTimeComponent');
+    ExpectBareString('DateTimeProp');
+    ExpectExtended(35278.00);
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTDateTimeComponent2;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TDateTimeComponent2.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TDateTimeComponent2');
+    ExpectBareString('TestTDateTimeComponent2');
+    ExpectBareString('DateTimeProp');
+    ExpectExtended(0.97);
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTDateTimeComponent3;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TDateTimeComponent3.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TDateTimeComponent3');
+    ExpectBareString('TestTDateTimeComponent3');
+    ExpectBareString('DateTimeProp');
+    ExpectExtended(35278.97);
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTEnumComponent;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TEnumComponent.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TEnumComponent');
+    ExpectBareString('TestTEnumComponent');
+    ExpectBareString('Dice');
+    ExpectIdent('four');
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTEnumComponent2;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TEnumComponent2.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TEnumComponent2');
+    ExpectBareString('TestTEnumComponent2');
+{$ifndef FPC}
+    // FPC does not stream an undeclared default value, it assumes the
+    // 0-the value is the default.
+    ExpectBareString('Dice');
+    ExpectIdent('one');
+{$endif FPC}
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTEnumComponent3;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TEnumComponent3.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TEnumComponent3');
+    ExpectBareString('TestTEnumComponent3');
+    ExpectBareString('Dice');
+    ExpectIdent('three');
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTEnumComponent4;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TEnumComponent4.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TEnumComponent4');
+    ExpectBareString('TestTEnumComponent4');
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+Procedure TTestComponentStream.TestTEnumComponent5;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TEnumComponent5.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TEnumComponent5');
+    ExpectBareString('TestTEnumComponent5');
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTSetComponent;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TSetComponent.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TSetComponent');
+    ExpectBareString('TestTSetComponent');
+    ExpectBareString('Throw');
+    ExpectValue(vaSet);
+    ExpectBareString('two');
+    ExpectBareString('five');
+    ExpectBareString('');
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTSetComponent2;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TSetComponent2.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TSetComponent2');
+    ExpectBareString('TestTSetComponent2');
+{$ifndef FPC}
+    // Same as for sets: a set with undeclared default is regarded as
+    // A set with default [], and is not streamed if it is empty.
+    ExpectBareString('Throw');
+    ExpectValue(vaSet);
+    ExpectBareString('');
+{$endif FPC}
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTSetComponent3;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TSetComponent3.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TSetComponent3');
+    ExpectBareString('TestTSetComponent3');
+    ExpectBareString('Throw');
+    ExpectValue(vaSet);
+    ExpectBareString('one');
+    ExpectBareString('four');
+    ExpectBareString('');
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTSetComponent4;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TSetComponent4.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TSetComponent4');
+    ExpectBareString('TestTSetComponent4');
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTMultipleComponent;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TMultipleComponent.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TMultipleComponent');
+    ExpectBareString('TestTMultipleComponent');
+    ExpectBareString('IntProp');
+    ExpectInteger(1);
+    ExpectBareString('StringProp');
+    ExpectString('A String');
+    ExpectBareString('CurrencyProp');
+    ExpectExtended(2.30);
+    ExpectBareString('Dice');
+    ExpectIdent('two');
+    ExpectBareString('Throw');
+    ExpectValue(vaSet);
+    ExpectBareString('three');
+    ExpectBareString('four');
+    ExpectBareString('');
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTPersistentComponent;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TPersistentComponent.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TPersistentComponent');
+    ExpectBareString('TestTPersistentComponent');
+    ExpectBareString('Persist.AInteger');
+    ExpectInteger(3);
+    ExpectBareString('Persist.AString');
+    ExpectString('A persistent string');
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTCollectionComponent;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TCollectionComponent.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TCollectionComponent');
+    ExpectBareString('TestTCollectionComponent');
+    ExpectBareString('Coll');
+    ExpectValue(vaCollection);
+    ExpectEndOfList;
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTCollectionComponent2;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TCollectionComponent2.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TCollectionComponent2');
+    ExpectBareString('TestTCollectionComponent2');
+    ExpectBareString('Coll');
+    ExpectValue(vaCollection);
+    ExpectValue(vaList);
+    ExpectBareString('StrProp');
+    ExpectString('First');
+    ExpectEndOfList;
+    ExpectValue(vaList);
+    ExpectBareString('StrProp');
+    ExpectString('Second');
+    ExpectEndOfList;
+    ExpectValue(vaList);
+    ExpectBareString('StrProp');
+    ExpectString('Third');
+    ExpectEndOfList;
+    ExpectEndOfList;
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTCollectionComponent3;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TCollectionComponent3.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TCollectionComponent3');
+    ExpectBareString('TestTCollectionComponent3');
+    ExpectBareString('Coll');
+    ExpectValue(vaCollection);
+    ExpectValue(vaList);
+    ExpectBareString('StrProp');
+    ExpectString('First');
+    ExpectEndOfList;
+    ExpectValue(vaList);
+    ExpectEndOfList;
+    ExpectValue(vaList);
+    ExpectBareString('StrProp');
+    ExpectString('Third');
+    ExpectEndOfList;
+    ExpectEndOfList;
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTCollectionComponent4;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TCollectionComponent4.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TCollectionComponent4');
+    ExpectBareString('TestTCollectionComponent4');
+    ExpectBareString('Coll');
+    ExpectValue(vaCollection);
+    ExpectValue(vaList);
+    ExpectBareString('StrProp');
+    ExpectString('Something');
+    ExpectEndOfList;
+    ExpectEndOfList;
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+Procedure TTestComponentStream.TestTCollectionComponent5;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TCollectionComponent5.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TCollectionComponent5');
+    ExpectBareString('TestTCollectionComponent5');
+    ExpectBareString('Coll');
+    ExpectValue(vaCollection);
+    ExpectValue(vaList);
+    ExpectBareString('StrProp1');
+    ExpectString('Something');
+    ExpectBareString('StrProp2');
+    ExpectString('Otherthing');
+    ExpectEndOfList;
+    ExpectValue(vaList);
+    ExpectBareString('StrProp1');
+    ExpectString('Something 2');
+    ExpectBareString('StrProp2');
+    ExpectString('Otherthing 2');
+    ExpectEndOfList;
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTOwnedComponent;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TOwnedComponent.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TOwnedComponent');
+    ExpectBareString('TestTOwnedComponent');
+    ExpectBareString('CompProp');
+    ExpectIdent('SubComponent');
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTStreamedOwnedComponent;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TStreamedOwnedComponent.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TStreamedOwnedComponent');
+    ExpectBareString('TestTStreamedOwnedComponent');
+    ExpectEndOfList;
+    ExpectFlags([],0);
+    ExpectBareString('TIntegerComponent');
+    ExpectBareString('Sub');
+    ExpectBareString('IntProp');
+    ExpectInteger(3);
+    ExpectEndOfList;
+    ExpectEndOfList;
+    ExpectEndOfList;
+    ExpectEndOfStream;
+  Finally
+    C.Free;
+    end;
+end;
+
+Procedure TTestComponentStream.TestTStreamedOwnedComponents;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TStreamedOwnedComponents.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TStreamedOwnedComponents');
+    ExpectBareString('TestTStreamedOwnedComponents');
+    ExpectEndOfList;
+    ExpectFlags([],0);
+    ExpectBareString('TIntegerComponent');
+    ExpectBareString('SubA');
+    ExpectBareString('IntProp');
+    ExpectInteger(3);
+    ExpectEndOfList;
+    ExpectEndOfList;
+    ExpectFlags([],0);
+    ExpectBareString('TStringComponent');
+    ExpectBareString('SubB');
+    ExpectBareString('StringProp');
+    ExpectString('A string');
+    ExpectEndOfList;
+    ExpectEndOfList;
+    ExpectEndOfList;
+    ExpectEndOfStream;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTMethodComponent;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TMethodComponent.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TMethodComponent');
+    ExpectBareString('TestTMethodComponent');
+    ExpectBareString('MethodProp');
+    ExpectIdent('MyMethod');
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+
+Procedure TTestComponentStream.TestTMethodComponent2;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TMethodComponent2.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TMethodComponent2');
+    ExpectBareString('TestTMethodComponent2');
+    ExpectEndOfList;
+    ExpectFlags([],0);
+    ExpectBareString('TMethodComponent');
+    ExpectBareString('AComponent');
+    ExpectBareString('MethodProp');
+    ExpectIdent('MyMethod2');
+    ExpectEndOfList;
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
+{ TMyColl }
+
+function TMyColl.GetIt(index : Integer): TMyItem;
+begin
+  Result:=Items[Index] as TMyItem;
+end;
+
+procedure TMyColl.SetIt(index : Integer; const AValue: TMyItem);
+begin
+  Items[Index]:=AValue;
+end;
+
+{ TCollComp }
+
+procedure TCollComp.SetMyColl(const AValue: TMyColl);
+begin
+  if (FMyColl=AValue) then
+    exit;
+  FMyColl.Assign(AValue);
+end;
+
+constructor TCollComp.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FMyColl:=TMyCOll.Create(TMyItem);
+end;
+
+destructor TCollComp.Destroy;
+begin
+  FreeAndNil(FMyColl);
+  inherited Destroy;
+end;
+
+function TCollComp.ToStream: TStream;
+begin
+  Result:=TMemoryStream.Create;
+  Result.WriteComponent(Self);
+  Result.Position:=0;
+end;
+
+procedure TCollComp.FromStream(AStream: TStream);
+begin
+  AStream.ReadComponent(Self);
+  Astream.Free;
+end;
+
+procedure TMyItem.Assign(Source: TPersistent);
+
+Var
+  I : TMyItem;
+
+begin
+  If (Source is TMyItem) then
+    begin
+    I:=Source as TMyItem;
+    FNR:=I.NR;
+    FStr:=I.Str;
+    end
+  else
+    inherited Assign(Source);
+end;
+
+Procedure TTestCollectionStream.CompareColl(CA,CB : TMyColl);
+
+Var
+  I : Integer;
+
+begin
+  AssertEquals('Counts differ: %d %d',CA.Count,CB.Count);
+  For I:=0 to CA.Count-1 do
+    begin
+    AssertEquals(Format('Nr property of element %d equals',[I]),CA[i].Nr,CB[i].Nr);
+    AssertEquals(Format('Str property of element %d equals',[I]),CA[i].Str,CB[i].Str);
+    end;
+end;
+
+Function TTestCollectionStream.EmptyComp : TCollComp;
+
+begin
+  Result:=TCollComp.Create(Nil);
+end;
+
+Function TTestCollectionStream.CreateColl(Anr : Integer) : TCollComp;
+
+Var
+  I : Integer;
+  T : TMyItem;
+
+begin
+  Result:=EmptyComp;
+  Result.Name:='C'+IntToStr(Anr);
+  For I:=0 to ANr-1 do
+    begin
+    T:=Result.MyColl.Add as TMyItem;
+    T.Nr:=I; // not I+1, so the default value gets tested too
+    T.Str:=IntToStr(I+1);
+    end;
+end;
+
+Procedure TTestCollectionStream.TestEmpty;
+
+Var
+ CA,CB : TCollComp;
+
+begin
+  CA:=CreateColl(0);
+  try
+    CB:=EmptyComp;
+    Try
+      CB.FromStream(CA.ToStream);
+      CompareColl(CA.MyColl,CB.MyColl);
+    Finally
+      CB.Free;
+    end;
+  Finally
+    CA.Free;
+  end;
+end;
+
+Procedure TTestCollectionStream.TestNr(ACount : Integer);
+
+Var
+ CA,CB : TCollComp;
+
+begin
+  CA:=CreateColl(ACount);
+  try
+    CB:=EmptyComp;
+    Try
+      CB.FromStream(CA.ToStream);
+      CompareColl(CA.MyColl,CB.MyColl);
+    Finally
+      CB.Free;
+    end;
+  Finally
+    CA.Free;
+  end;
+end;
+
+Procedure TTestCollectionStream.TestClear;
+
+Var
+ CA,CB : TCollComp;
+
+begin
+  CA:=CreateColl(3);
+  try
+    CB:=CreateColl(1);
+    CB.Name:='';
+    Try
+      // CB collection should be cleared before loading.
+      CB.FromStream(CA.ToStream);
+      CompareColl(CA.MyColl,CB.MyColl);
+    Finally
+      CB.Free;
+    end;
+  Finally
+    CA.Free;
+  end;
+end;
+
+Procedure TTestCollectionStream.Test1;
+
+begin
+  TestNr(1);
+end;
+
+Procedure TTestCollectionStream.Test2;
+
+begin
+  TestNr(2);
+end;
+
+Procedure TTestCollectionStream.Test3;
+
+begin
+  TestNr(3);
+end;
+
+begin
+  RegisterTests([TTestComponentStream,TTestCollectionStream]);
+end.

tests/test/units/fpcunit/tcfindnested.pp

@@ -0,0 +1,216 @@
+unit tcfindnested;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, 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.
+

tests/test/units/fpcunit/tclinkedlist.pp

@@ -0,0 +1,237 @@
+unit tclinkedlist;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, 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.
+

tests/test/units/fpcunit/tclist.pp

@@ -0,0 +1,576 @@
+unit tclist;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, testregistry; 
+
+type
+
+  { TTestTList }
+
+
+  TTestTList= class(TTestCase)
+  private
+    procedure AssertEquals(Msg: String; P1, P2: Pointer); overload;
+    procedure DeleteNegativeIndex;
+    procedure DeleteTooBigIndex;
+    procedure ExchangeNegativeIndex1;
+    procedure ExchangeNegativeIndex2;
+    procedure ExchangeTooBigIndex1;
+    procedure ExchangeTooBigIndex2;
+    procedure AccessNegativeIndex;
+    procedure AccessTooBigIndex;
+    procedure Shuffle;
+  protected
+    List : TList;
+    List2 : TList;
+    List3 : TList;
+    Pointers : Packed Array[0..20] of Byte;
+    procedure SetUp; override;
+    procedure TearDown; override; 
+    Procedure FillList(ACount : Integer); overload;
+    Procedure FillList(AList : TList; AOffSet, ACount : Integer); overload;
+    procedure HavePointer(I: Integer);
+  published
+    procedure TestCreate;
+    procedure TestAdd;
+    procedure TestAddIndex;
+    procedure TestAdd2;
+    procedure TestInsertFirst;
+    Procedure TestInsertMiddle;
+    procedure TestDelete;
+    Procedure TestClear;
+    Procedure TestIndexOf;
+    procedure TestExchange;
+    procedure TestAccesIndexOutOfBounds;
+    procedure TestDeleteIndexOutOfBounds;
+    procedure TestExchangeIndexOutOfBounds;
+    Procedure TestSort;
+    procedure TestExtractCount;
+    procedure TestExtractResult;
+    procedure TestExtractNonExisting;
+    procedure TestExtractNonExistingResult;
+    procedure TestExtractOnlyFirst;
+    Procedure TestNotifyAdd;
+    Procedure TestNotifyDelete;
+    Procedure TestNotifyExtract;
+    Procedure TestPack;
+    Procedure TestAssignCopy;
+    Procedure TestAssignCopy2;
+    Procedure TestAssignAnd;
+    procedure TestAssignAnd2;
+    Procedure TestAssignOr;
+    procedure TestAssignOr2;
+    procedure TestAssignXOr;
+    procedure TestAssignXOr2;
+    procedure TestAssignSrcUnique;
+    procedure TestAssignSrcUnique2;
+    procedure TestAssignDestUnique;
+    procedure TestAssignDestUnique2;
+  end;
+
+  { TMyList }
+
+  TMyList = Class(TList)
+    procedure Notify(Ptr: Pointer; Action: TListNotification); override;
+    FLastPointer : Pointer;
+    FLastAction : TListNotification;
+  end;
+  
+
+implementation
+
+
+
+procedure TTestTList.SetUp;
+
+Var
+  I : Integer;
+
+begin
+  List:=TMyList.Create;
+  List2:=TMyList.Create;
+  List3:=TMyList.Create;
+  For I:=0 to 20 do
+    Pointers[i]:=I; // Zero serves as sentinel.
+end; 
+
+procedure TTestTList.TearDown; 
+begin
+  FreeAndNil(List);
+  FreeAndNil(List2);
+  FreeAndNil(List3);
+end;
+
+procedure TTestTList.FillList(ACount: Integer);
+
+
+begin
+  FillList(List,0,ACount);
+end;
+
+procedure TTestTList.FillList(AList: TList; AOffSet, ACount: Integer);
+
+Var
+  I : integer;
+  
+begin
+  If ACount+AOffSet>20 then
+    Fail('Too many elements added to list. Max is 20');
+  For I:=1+AOffSet to AOffSet+ACount do
+    AList.Add(@Pointers[i]);
+end;
+
+procedure TTestTList.TestCreate;
+begin
+  AssertEquals('Empty list has count 0',0,List.Count);
+end;
+
+procedure TTestTList.AssertEquals(Msg : String; P1,P2 : Pointer);
+
+begin
+  If (P1<>P2) then
+    Fail(Format('%s: Pointers differ. Expected <%x>, got: <%x>',[Msg,PtrInt(P1),PtrInt(P2)]));
+end;
+
+procedure TTestTList.TestAdd;
+
+begin
+  FillList(1);
+  AssertEquals('Add 1 element, count is 1',1,List.Count);
+  AssertEquals('Add 1 element, last element is Ptrint(1)',@Pointers[1],List[0]);
+end;
+
+procedure TTestTList.TestAddIndex;
+
+begin
+  AssertEquals('Add first element at index 0',0,List.Add(Nil));
+  AssertEquals('Add second element, at index 1',1,List.Add(Nil));
+end;
+
+procedure TTestTList.TestAdd2;
+
+begin
+  FillList(2);
+  AssertEquals('Add 2 elements, count is 2',2,List.Count);
+  AssertEquals('Add 2 elements, first element is Pointers[1]',@Pointers[1],List[0]);
+  AssertEquals('Add 2 elements, second element is Pointers[2]',@Pointers[2],List[1]);
+end;
+
+procedure TTestTList.TestInsertFirst;
+begin
+  FillList(3);
+  List.Insert(0,@Pointers[0]);
+  AssertEquals('Insert 1 in 3, count is 4',4,List.Count);
+  AssertEquals('Insert 1 in 3, first is inserted',@Pointers[0],List[0]);
+  AssertEquals('Insert 1 in 3, second is old first',@Pointers[1],List[1]);
+end;
+
+procedure TTestTList.TestInsertMiddle;
+begin
+  FillList(3);
+  List.Insert(1,@Pointers[0]);
+  AssertEquals('Insert 1 in 3, count is 4',4,List.Count);
+  AssertEquals('Insert 1 in 3, 1 is inserted',@Pointers[0],List[1]);
+  AssertEquals('Insert 1 in 3, 2 is old 2',@Pointers[2],List[2]);
+  AssertEquals('Insert 1 in 3, 0 is untouched',@Pointers[1],List[0]);
+end;
+
+procedure TTestTList.TestClear;
+begin
+  FillList(3);
+  List.Clear;
+  AssertEquals('Clear: count is 0',0,List.Count);
+end;
+
+procedure TTestTList.TestIndexOf;
+begin
+  FillList(11);
+  AssertEquals('Find third element',2,List.IndexOf(@Pointers[3]));
+end;
+
+procedure TTestTList.TestDelete;
+
+begin
+  FillList(3);
+  List.Delete(1);
+  AssertEquals('Delete 1 from 3, count is 2',2,List.Count);
+  AssertEquals('Delete 1 from 3, first is pointers[1]',@Pointers[1],List[0]);
+  AssertEquals('Delete 1 from 3, second is "pointers[3]',@Pointers[3],List[1]);
+end;
+
+procedure TTestTList.TestExchange;
+
+begin
+  FillList(3);
+  List.Exchange(0,2);
+  AssertEquals('Exchange 0 and 2, count is 3',3,List.Count);
+  AssertEquals('Exchange 0 and 2, first is Pointers[3]',@Pointers[3],List[0]);
+  AssertEquals('Exchange 0 and 2, second is Pointers[2]',@Pointers[2],List[1]);
+  AssertEquals('Exchange 0 and 2, third is Pointers[1]',@Pointers[1],List[2]);
+end;
+
+procedure TTestTList.DeleteNegativeIndex;
+begin
+  List.Delete(-1);
+end;
+
+procedure TTestTList.DeleteTooBigIndex;
+begin
+  List.Delete(3);
+end;
+
+procedure TTestTList.ExchangeNegativeIndex1;
+begin
+  List.Exchange(-1,2);
+end;
+
+procedure TTestTList.ExchangeTooBigIndex1;
+begin
+  List.Exchange(3,2);
+end;
+
+procedure TTestTList.ExchangeNegativeIndex2;
+begin
+  List.Exchange(2,-1);
+
+end;
+
+procedure TTestTList.ExchangeTooBigIndex2;
+begin
+  List.Exchange(2,3);
+end;
+
+procedure TTestTList.AccessNegativeIndex;
+
+begin
+  List[-1];
+end;
+
+procedure TTestTList.AccessTooBigIndex;
+
+begin
+  List[3];
+end;
+
+procedure TTestTList.Shuffle;
+
+Var
+  I,I1,I2 : Integer;
+
+begin
+  For I:=1 to List.Count* 2 do
+    begin
+    I1:=Random(List.Count);
+    I2:=Random(List.Count);
+    if I1<>I2 then
+      List.Exchange(I1,I2);
+    end;
+end;
+
+procedure TTestTList.TestAccesIndexOutOfBounds;
+begin
+  FillList(3);
+  AssertException('Access Negative Index',EListError,@AccessNegativeIndex);
+  AssertException('Access Index too big',EListError,@AccessTooBigIndex);
+end;
+
+procedure TTestTList.TestDeleteIndexOutOfBounds;
+begin
+  FillList(3);
+  AssertException('Delete Negative Index',EListError,@DeleteNegativeIndex);
+  AssertException('Delete Index too big',EListError,@DeleteTooBigIndex);
+end;
+
+procedure TTestTList.TestExchangeIndexOutOfBounds;
+begin
+  FillList(3);
+  AssertException('Exchange Negative first index',EListError,@ExchangeNegativeIndex1);
+  AssertException('Exchange Negative second index',EListError,@ExchangeNegativeIndex2);
+  AssertException('Exchange first Index too big',EListError,@ExchangeTooBigIndex1);
+  AssertException('Exchange second Index too big',EListError,@ExchangeTooBigIndex2);
+end;
+
+Function CompareBytePointers(P1,P2 : Pointer) : Integer;
+
+begin
+  Result:=PByte(P1)^-PByte(P2)^;
+end;
+
+procedure TTestTList.TestSort;
+
+Var
+  I : Integer;
+
+begin
+  FillList(9);
+  Shuffle;
+  List.Sort(@CompareBytePointers);
+  For I:=0 to List.Count-1 do
+    If (List[i]<>@Pointers[i+1]) then
+      Fail(Format('Item at position %d is out of place (%d)',[I,PByte(List[i])^]));
+end;
+
+procedure TTestTList.TestExtractResult;
+begin
+  FillList(9);
+  AssertEquals('Extracting pointers[4]',@Pointers[4],List.Extract(@Pointers[4]));
+end;
+
+procedure TTestTList.TestExtractCount;
+begin
+  FillList(9);
+  List.Extract(@Pointers[4]);
+  AssertEquals('Extracting pointers[4], count is 8',8,List.Count);
+end;
+
+procedure TTestTList.TestExtractNonExisting;
+begin
+  FillList(9);
+  List.Extract(@List);
+  AssertEquals('Extracting unexisting, count remains 9',9,List.Count);
+end;
+
+procedure TTestTList.TestExtractNonExistingResult;
+begin
+  FillList(9);
+  AssertEquals('Extracting unexisting, result is nil',Nil,List.Extract(@List));
+end;
+
+procedure TTestTList.TestExtractOnlyFirst;
+begin
+  FillList(9);
+  List.Insert(0,@Pointers[4]);
+  List.Extract(@Pointers[4]);
+  AssertEquals('Extracting pointers[4], result is nil',3,List.IndexOf(@Pointers[4]));
+end;
+
+procedure TTestTList.TestNotifyAdd;
+begin
+  List.Add(@Pointers[1]);
+  AssertEquals('Add notification, pointer is pointer[1]',@Pointers[1],TMyList(List).FLastPointer);
+  AssertEquals('Add notification, action is lnAdded',ord(lnAdded),Ord(TMyList(List).FLastAction));
+end;
+
+procedure TTestTList.TestNotifyDelete;
+begin
+  FillList(9);
+  List.Delete(3);
+  AssertEquals('Delete notification, pointer is pointer[4]',@Pointers[4],TMyList(List).FLastPointer);
+  AssertEquals('Delete notification, action is lnDeleted',ord(lnDeleted),Ord(TMyList(List).FLastAction));
+end;
+
+procedure TTestTList.TestNotifyExtract;
+begin
+  FillList(9);
+  List.Extract(@Pointers[4]);
+  AssertEquals('Extract notification, pointer is pointer[4]',@Pointers[4],TMyList(List).FLastPointer);
+  AssertEquals('Extract notification, action is lnExtracted',ord(lnExtracted),Ord(TMyList(List).FLastAction));
+end;
+
+procedure TTestTList.TestPack;
+
+Var
+  I : integer;
+
+begin
+  FillList(9);
+  List[3]:=Nil;
+  List[6]:=Nil;
+  List.Pack;
+  AssertEquals('Pack, count is 7',7,List.Count);
+  For I:=0 to List.Count-1 do
+    If (List[i]=Nil) then
+      Fail(Format('Packed list contains nil pointer at position %d',[i]));
+  AssertEquals('Packed list[3] is @pointer[5]',@Pointers[5],List[3]);
+  AssertEquals('Packed list[6] is @pointer[9]',@pointers[9],List[6]);
+end;
+
+procedure TTestTList.TestAssignCopy;
+
+Var
+  I : Integer;
+begin
+  FillList(20);
+  List2.Assign(List,laCopy);
+  AssertEquals('20 elements copied',20,List2.Count);
+  For I:=0 to 19 do
+    AssertSame(Format('Element %d copied correctly',[i]),@Pointers[I+1],List2[i]);
+end;
+
+procedure TTestTList.TestAssignAnd;
+
+Var
+  I : Integer;
+begin
+  FillList(10); // 1--10
+  FillList(List2,5,10); // 6--15
+  List.Assign(List2,laAnd); // Should have 6-10
+  AssertEquals('5 elements copied',5,List.Count);
+  For I:=0 to 4 do
+    HavePointer(6+i);
+end;
+
+procedure TTestTList.TestAssignAnd2;
+
+Var
+  I : Integer;
+begin
+  FillList(10); // 1--10
+  FillList(List2,5,10); // 6--15
+  FillList(List3,10,9); // 11--19
+  List.Assign(List2,laAnd,List3); // Should have 11-15
+  AssertEquals('5 elements copied',5,List.Count);
+  For I:=0 to 4 do
+    HavePointer(11+i);
+end;
+
+procedure TTestTList.TestAssignOr;
+
+Var
+  I : Integer;
+begin
+  FillList(10); // 1--10
+  FillList(List2,5,10); // 6--15
+  List.Assign(List2,laOr); // Should have 6-10
+  AssertEquals('15 elements copied',15,List.Count);
+  For I:=0 to 14 do
+    HavePointer(1+i);
+end;
+
+procedure TTestTList.TestAssignOr2;
+
+Var
+  I : Integer;
+begin
+  FillList(10); // 1--10
+  FillList(List2,5,10); // 6--15
+  FillList(List3,10,9); // 11--19
+  List.Assign(List2,laOr,List3); // Should have 6-19
+  AssertEquals('14 elements copied',14,List.Count);
+  For I:=0 to 13 do
+    HavePointer(6+i);
+end;
+
+procedure TTestTList.TestAssignXOr;
+
+Var
+  I : Integer;
+begin
+  FillList(10); // 1--10
+  FillList(List2,5,10); // 6--15
+  List.Assign(List2,laxOr); // Should have 1-5 and 11-15
+  AssertEquals('10 elements copied',10,List.Count);
+  For I:=0 to 4 do
+    HavePointer(1+i);
+  For I:=5 to 9 do
+    HavePointer(6+i);
+end;
+
+procedure TTestTList.TestAssignXOr2;
+
+Var
+  I : Integer;
+begin
+  FillList(10); // 1--10
+  FillList(List2,5,10); // 6--15
+  FillList(List3,10,9); // 11--19
+  List.Assign(List2,laXor,List3); // Should have 6-10 and 16-19
+  AssertEquals('14 elements copied',9,List.Count);
+  For I:=0 to 4 do
+    HavePointer(6+i);
+  For I:=5 to 8 do
+    HavePointer(11+i);
+end;
+
+procedure TTestTList.TestAssignSrcUnique;
+
+Var
+  I : Integer;
+begin
+  FillList(10); // 1--10
+  FillList(List2,5,10); // 6--15
+  List.Assign(List2,laSrcUnique); // Should have 1-5
+  AssertEquals('5 elements copied',5,List.Count);
+  For I:=0 to 4 do
+    HavePointer(1+i);
+end;
+
+procedure TTestTList.TestAssignSrcUnique2;
+
+Var
+  I : Integer;
+begin
+  FillList(10); // 1--10
+  FillList(List2,5,10); // 6--15
+  FillList(List3,10,9); // 11--19
+  List.Assign(List2,laSrcUnique,List3); // Should have 6-10
+  AssertEquals('5 elements copied',5,List.Count);
+  For I:=0 to 4 do
+    HavePointer(6+i);
+end;
+
+procedure TTestTList.HavePointer(I : Integer);
+
+begin
+  If List.IndexOf(@Pointers[i])=-1 then
+    Fail(Format('Pointer to %d not in list',[i]));
+end;
+procedure TTestTList.TestAssignDestUnique;
+
+Var
+  I : Integer;
+begin
+  FillList(10); // 1--10
+  FillList(List2,5,10); // 6--15
+  List.Assign(List2,laDestUnique); // Should have 11-15
+  AssertEquals('5 elements copied',5,List.Count);
+  For I:=0 to 4 do
+    HavePointer(11+I);
+end;
+
+procedure TTestTList.TestAssignDestUnique2;
+
+Var
+  I : Integer;
+begin
+  FillList(10); // 1--10
+  FillList(List2,5,10); // 6--15
+  FillList(List3,10,9); // 11--19
+  List.Assign(List2,laDestUnique,List3); // Should have 16-19
+  AssertEquals('4 elements copied',4,List.Count);
+  For I:=0 to 3 do
+    HavePointer(16+i);
+end;
+
+procedure TTestTList.TestAssignCopy2;
+Var
+  I : Integer;
+begin
+  FillList(6); // 1--6
+  FillList(List2,6,6); // 7--12
+  FillList(List3,12,6); // 13--18
+  List.Assign(List2,laCopy,List3); // Should have 13-18
+  AssertEquals('6 elements copied',6,List.Count);
+  For I:=1 to 6 do
+    HavePointer(12+i);
+end;
+
+
+{ TMyList }
+
+procedure TMyList.Notify(Ptr: Pointer; Action: TListNotification);
+begin
+  inherited Notify(Ptr, Action);
+  FLastAction:=Action;
+  FLastPointer:=Ptr;
+end;
+
+initialization
+
+  RegisterTest(TTestTList); 
+end.
+

tests/test/units/fpcunit/tcpersistent.pp

@@ -0,0 +1,187 @@
+unit tcpersistent;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry;
+
+type
+
+  { TTestTPersistent }
+
+  TTestTPersistent= class(TTestCase)
+  protected
+    Instance : TPersistent;
+    procedure SetUp; override; 
+    procedure TearDown; override; 
+  published
+    procedure TestPropCount;
+    procedure TestNamePath;
+  end; 
+  
+  { TMyPersistent }
+
+  TMyPersistent = Class(TPersistent)
+  private
+    FMyProp: Integer;
+    FOwner : TPersistent;
+  protected
+    function GetOwner: TPersistent; override;
+  public
+    procedure Assign(Source: TPersistent); override;
+  published
+    Property MyProp : Integer Read FMyProp Write FMyProp;
+  end;
+
+  { TTestPersistentDescendent }
+
+  TTestPersistentDescendent = class(TTestCase)
+  private
+    procedure WrongAssign;
+  Protected
+    Instance : TMyPersistent;
+    procedure SetUp; override;
+    procedure TearDown; override;
+  published
+    procedure TestPropCount;
+    procedure TestNamePath;
+    procedure TestNamePathWithOwner;
+    Procedure TestAssign;
+    Procedure TestAssignFail;
+  end;
+
+
+implementation
+
+uses typinfo;
+
+procedure TTestTPersistent.TestPropCount;
+
+Var
+  ACOunt : Integer;
+  P : Pointer;
+  
+begin
+  P:=Nil;
+  ACOunt:=GetPropList(Instance,P);
+  AssertEquals('Property count of TPersistence is zero',0,ACount);
+end;
+
+procedure TTestTPersistent.TestNamePath;
+begin
+  AssertEquals('Namepath is class name if there is no owner','TPersistent',Instance.GetNamePath);
+end;
+
+procedure TTestTPersistent.SetUp; 
+begin
+  Instance:=TPersistent.Create;
+end;
+
+procedure TTestTPersistent.TearDown; 
+begin
+  FreeAndNil(Instance);
+end; 
+
+{ TTestPersistentDescendent }
+
+procedure TTestPersistentDescendent.SetUp;
+begin
+  Instance:=TMyPersistent.Create;
+end;
+
+procedure TTestPersistentDescendent.TearDown;
+begin
+  FreeAndNil(Instance);
+end;
+
+procedure TTestPersistentDescendent.TestPropCount;
+
+Var
+  ACOunt : Integer;
+  P : Pointer;
+
+begin
+  P:=Nil;
+  ACount:=GetPropList(Instance,P);
+  AssertEquals('Property count of TPersistence is zero',1,ACount);
+  Freemem(p);
+end;
+
+procedure TTestPersistentDescendent.TestNamePath;
+begin
+  AssertEquals('Namepath is class name if there is no owner','TMyPersistent',Instance.GetNamePath);
+end;
+
+procedure TTestPersistentDescendent.TestNamePathWithOwner;
+
+Var
+  AOwner : TMyPersistent;
+  
+begin
+  AOwner:=TMyPersistent.Create;
+  try
+    Instance.FOwner:=AOwner;
+    AssertEquals('Namepath is owner namepath plus class name','TMyPersistent.TMyPersistent',Instance.GetNamePath);
+  finally
+    Aowner.Free;
+  end;
+end;
+
+procedure TTestPersistentDescendent.TestAssign;
+
+Var
+  I2 : TMyPersistent;
+  
+begin
+  I2:=TMyPersistent.Create;
+  try
+    I2.MyProp:=2;
+    Instance.Assign(I2);
+    AssertEquals('Property passed on during assign',2,Instance.MyProp);
+  finally
+    I2.Free;
+  end;
+end;
+
+
+procedure TTestPersistentDescendent.TestAssignFail;
+
+begin
+  AssertException('Assigning the wrong class',EConvertError,@WrongAssign);
+end;
+
+procedure TTestPersistentDescendent.WrongAssign;
+Var
+  I2 : TPersistent;
+
+begin
+  I2:=TPersistent.Create;
+  try
+    Instance.Assign(I2);
+  finally
+    I2.Free;
+  end;
+end;
+
+{ TMyPersistent }
+
+function TMyPersistent.GetOwner: TPersistent;
+begin
+  Result:=FOwner;
+end;
+
+procedure TMyPersistent.Assign(Source: TPersistent);
+begin
+  If (Source is TMyPersistent) then
+    FMyProp:=TMyPersistent(Source).FMyProp
+  else
+    Inherited;
+end;
+
+initialization
+
+  RegisterTests([TTestTPersistent,TTestPersistentDescendent]);
+end.
+

tests/test/units/fpcunit/tcresref.pp

@@ -0,0 +1,541 @@
+unit tcresref;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, TypInfo, testutils, testregistry;
+
+type
+
+  { TRefComponent }
+
+  TRefComponent = Class(TComponent)
+  private
+    FRef1: TComponent;
+    FRef2: TComponent;
+  Published
+    Property Ref1 : TComponent Read FRef1 Write FRef1;
+    Property Ref2 : TComponent Read FRef2 Write FRef2;
+  end;
+  
+  TRootA = Class(TRefComponent)
+  end;
+  
+  TRootB = Class(TRefComponent)
+  end;
+  
+  TA = Class(TRefComponent)
+  end;
+  TB = Class(TRefComponent)
+  end;
+
+
+  { TTestResolveReference }
+
+  TTestResolveReference = class(TTestCase)
+  Private
+    RootA : TRootA;
+    RootB : TRootB;
+    PropA1,
+    PropA2,
+    PropB1,
+    PropB2 : PPRopInfo;
+    UnrA : TObject;
+    UnrB : TObject;
+  protected
+    procedure SetUp; override; 
+    procedure TearDown; override; 
+  published
+    procedure TestAddInst1;
+    procedure TestAddInst2;
+    procedure TestAddInst3;
+    procedure TestAdd2;
+    procedure TestAdd3;
+    Procedure TestFixupReferenceNames1;
+    procedure TestFixupReferenceNames2;
+    procedure TestFixupReferenceNames3;
+    Procedure TestFixupInstanceNames1;
+    Procedure TestFixupInstanceNames2;
+    procedure TestFixupInstanceNames3;
+    procedure TestFixupInstanceNames4;
+    procedure TestFixupInstanceNames5;
+    procedure TestRedirectFixupReferences1;
+    procedure TestRedirectFixupReferences2;
+    procedure TestRedirectFixupReferences3;
+    procedure TestRemoveFixupReferences1;
+    procedure TestRemoveFixupReferences2;
+    procedure TestFixupReferences1;
+    procedure TestFixupReferences2;
+    procedure TestFixupReferences3;
+  end;
+
+implementation
+
+
+{$i sllist.inc}
+{$i resref.inc}
+
+{ ---------------------------------------------------------------------
+  Auxiliary routines
+  ---------------------------------------------------------------------}
+
+// Simulate Adding RootA to unresolved instances
+Function RootAToResolveList(TC : TTestResolveReference) : TUnresolvedInstance;
+
+begin
+  Result:=AddToResolveList(TC.RootA);
+  TC.UnrA:=Result;
+end;
+
+// Simulate Adding RootB to unresolved instances
+Function RootBToResolveList(TC : TTestResolveReference) : TUnresolvedInstance;
+
+begin
+  Result:=AddToResolveList(TC.RootB);
+  TC.UnrB:=Result;
+end;
+
+// Simulate RootA.Ref1 -> RootB.A unresolved reference
+Function SetupARef1A(TC : TTestResolveReference) : TUnresolvedReference;
+
+begin
+  Result:=RootAToResolveList(TC).AddReference(TC.RootA,TC.PropA1,'RootB','A');
+end;
+
+// Simulate RootA.Ref1 -> RootB.B unresolved reference
+Function SetupARef1B(TC : TTestResolveReference) : TUnresolvedReference;
+
+begin
+  Result:=RootAToResolveList(TC).AddReference(TC.RootA,TC.PropA1,'RootB','B');
+end;
+
+
+// Simulate RootA.Ref2 -> RootB.A unresolved reference
+Function SetupARef2A(TC : TTestResolveReference) : TUnresolvedReference;
+
+begin
+  Result:=RootAToResolveList(TC).AddReference(TC.RootA,TC.PropA2,'RootB','A');
+end;
+// Simulate RootA.Ref2 -> RootB.B unresolved reference
+Function SetupARef2B(TC : TTestResolveReference) : TUnresolvedReference;
+
+begin
+  Result:=RootAToResolveList(TC).AddReference(TC.RootA,TC.PropA2,'RootB','B');
+end;
+
+// Simulate RootB.Ref2 -> RootA.B unresolved reference
+Function SetupBRef2B(TC : TTestResolveReference) : TUnresolvedReference;
+
+begin
+  Result:=RootBToResolveList(TC).AddReference(TC.RootB,TC.PropB2,'RootA','B');
+end;
+
+Function SetupBRef1A(TC : TTestResolveReference) : TUnresolvedReference;
+
+begin
+  Result:=RootBToResolveList(TC).AddReference(TC.RootB,TC.PropB1,'RootA','A');
+end;
+
+// Simulate RootB.Ref1 -> RootA.B unresolved reference
+Function SetupNRef1B(TC : TTestResolveReference) : TUnresolvedReference;
+
+begin
+  Result:=RootBToResolveList(TC).AddReference(TC.RootB,TC.PropB1,'RootA','B');
+end;
+
+// Simulate RootA.Ref2 -> RootA.A unresolved reference
+Function SetupBRef2A(TC : TTestResolveReference) : TUnresolvedReference;
+
+begin
+  Result:=RootBToResolveList(TC).AddReference(TC.RootB,TC.PropB2,'RootA','A');
+end;
+
+{ ---------------------------------------------------------------------
+  Search callback
+  ---------------------------------------------------------------------}
+
+Var
+  TI : TTestResolveReference;
+
+Function SearchRoots(Const AName : String) : TComponent;
+
+begin
+  Result:=Nil;
+  If Assigned(TI) then
+    begin
+    If CompareText(AName,'RootA')=0 then
+      Result:=TI.RootA
+    else If CompareText(AName,'RootB')=0 then
+      Result:=TI.RootB;
+    end;
+end;
+
+{ ---------------------------------------------------------------------
+  Setup/TearDown
+  ---------------------------------------------------------------------}
+
+procedure TTestResolveReference.SetUp;
+begin
+  TI:=Self;
+  RegisterFindGlobalComponentProc(@SearchRoots);
+  RootA:=TRootA.Create(Nil);
+  RootA.Name:='RootA';
+  With TA.Create(RootA) do
+    Name:='A';
+  With TB.Create(RootA) do
+    Name:='B';
+  RootB:=TRootB.Create(Nil);
+  With TA.Create(RootB) do
+    Name:='A';
+  With TB.Create(RootB) do
+    Name:='B';
+  PRopA1:=GetPropInfo(TRootA,'Ref1');
+  PRopA2:=GetPropInfo(TRootA,'Ref2');
+  PRopB1:=GetPropInfo(TRootB,'Ref1');
+  PRopB2:=GetPropInfo(TRootB,'Ref2');
+end;
+
+procedure TTestResolveReference.TearDown;
+begin
+  TI:=Nil;
+  UnRegisterFindGlobalComponentProc(@SearchRoots);
+  FreeAndNil(NeedResolving);
+  FreeAndNil(RootA);
+  FreeAndNil(RootB);
+end;
+
+{ ---------------------------------------------------------------------
+  Actual tests
+  ---------------------------------------------------------------------}
+
+procedure TTestResolveReference.TestAddInst1;
+
+Var
+  A : TObject;
+
+begin
+  A:=AddToResolveList(RootA);
+  If Not (A is TUnresolvedInstance) then
+    Fail('AddToResolveList returns TUnresolvedInstance');
+  AssertSame('UNresolvedinstance.Instance is RootA',RootA,TUnresolvedInstance(A).Instance);
+  AssertSame('UNresolvedinstance.Next is nil',Nil,TUnresolvedInstance(A).Next);
+end;
+
+procedure TTestResolveReference.TestAddInst2;
+
+Var
+  A,B : TObject;
+
+begin
+  A:=AddToResolveList(RootA);
+  B:=AddToResolveList(RootA);
+  AssertSame('UNresolvedinstance.Instance is RootA',A,B);
+end;
+
+procedure TTestResolveReference.TestAddInst3;
+
+Var
+  A,B : TUnresolvedInstance;
+
+begin
+  A:=AddToResolveList(RootA);
+  B:=AddToResolveList(RootB);
+  AssertSame('UnresolvedInstances are chained',A,B.Next);
+end;
+
+
+procedure TTestResolveReference.TestAdd2;
+
+Var
+  R : TUnresolvedReference;
+
+begin
+  R:=SetupARef1A(Self);
+  If (UnrA=Nil) then
+    Fail('UnresolvedInstance A not set');
+  AssertSame('TUnresolvedReference FRoot is rootA',RootA,R.FRoot);
+  AssertSame('TUnresolvedReference FPropInfo is PropA1',PropA1,R.FPropInfo);
+  AssertEquals('TUnresolvedReference FGlobal is rootB','RootB',R.FGlobal);
+  AssertEquals('TUnresolvedReference FRelative is A','A',R.FRelative);
+  AssertSame('Unresolved is root object',TUnresolvedinstance(UnrA).RootUnresolved,R);
+end;
+
+procedure TTestResolveReference.TestAdd3;
+
+Var
+  R1 : TUnresolvedReference;
+  R2 : TUnresolvedReference;
+
+begin
+  R1:=SetupARef1A(Self);
+  R2:=SetupARef2B(Self);
+  AssertSame('TUnresolvedReference FRoot is rootA',RootA,R2.FRoot);
+  AssertSame('TUnresolvedReference FPropInfo is PropA2',PropA2,R2.FPropInfo);
+  AssertEquals('TUnresolvedReference FGlobal is rootB','RootB',R2.FGlobal);
+  AssertEquals('TUnresolvedReference FRelative is A','B',R2.FRelative);
+  AssertSame('Unresolved references are chained',R1,R2.Next);
+end;
+
+procedure TTestResolveReference.TestFixupReferenceNames1;
+
+Var
+  L : TStringList;
+begin
+  SetupARef1A(Self);
+  L:=TstringList.Create;
+  try
+    GetFixupReferenceNames(RootA,L);
+    AssertEquals('Number of referenced components in root component RootA is 1',1,L.Count);
+    AssertEquals('Root component referred to is RootB','RootB',L[0]);
+  finally
+    L.Free;
+  end;
+end;
+
+procedure TTestResolveReference.TestFixupReferenceNames2;
+
+Var
+  L : TStringList;
+begin
+  // Should result in 1 referenced name only.
+  SetupARef1A(Self);
+  SetupARef2B(Self);
+  L:=TstringList.Create;
+  try
+    GetFixupReferenceNames(RootA,L);
+    AssertEquals('Number of referenced components in root component RootA is 1',1,L.Count);
+    AssertEquals('Root component referred to is always RootB','RootB',L[0]);
+  finally
+    L.Free;
+  end;
+end;
+
+procedure TTestResolveReference.TestFixupReferenceNames3;
+
+Var
+  L : TStringList;
+begin
+  // Should result in 1 referenced name only.
+  SetupARef1A(Self);
+  SetupARef2B(Self);
+  L:=TstringList.Create;
+  try
+    GetFixupReferenceNames(RootB,L);
+    AssertEquals('Number of referenced components in root component RootB is 0',0,L.Count);
+  finally
+    L.Free;
+  end;
+end;
+
+//procedure GetFixupInstanceNames(Root: TComponent; const ReferenceRootName: string; Names: TStrings);
+
+procedure TTestResolveReference.TestFixupInstanceNames1;
+
+Var
+  L : TStringList;
+begin
+  SetupARef1A(Self);
+  L:=TstringList.Create;
+  try
+    GetFixupinstanceNames(RootA,'RootB',L);
+    AssertEquals('Number of references in RootA to component RootB is 1',1,L.Count);
+    AssertEquals('Subcomponent of RootB referenced is A','A',L[0]);
+  finally
+    L.Free;
+  end;
+end;
+
+procedure TTestResolveReference.TestFixupInstanceNames2;
+
+Var
+  L : TStringList;
+begin
+  SetupARef1A(Self);
+  SetupARef2B(Self);
+  L:=TstringList.Create;
+  try
+    GetFixupinstanceNames(RootA,'RootB',L);
+    AssertEquals('Number of references in RootA to component RootB is 2',2,L.Count);
+    If L.IndexOf('A')=-1 then
+      Fail('A is not in list of references to RootB');
+    If L.IndexOf('B')=-1 then
+      Fail('B is not in list of references to RootB');
+  finally
+    L.Free;
+  end;
+end;
+
+procedure TTestResolveReference.TestFixupInstanceNames3;
+
+Var
+  L : TStringList;
+begin
+  SetupARef1A(Self);
+  SetupARef2B(Self);
+  L:=TstringList.Create;
+  try
+    GetFixupinstanceNames(RootA,'RootA',L);
+    AssertEquals('Number of references in RootA to component RootA is 0',0,L.Count);
+  finally
+    L.Free;
+  end;
+end;
+
+procedure TTestResolveReference.TestFixupInstanceNames4;
+
+Var
+  L : TStringList;
+begin
+  SetupARef1A(Self);
+  SetupARef2B(Self);
+  L:=TstringList.Create;
+  try
+    GetFixupinstanceNames(RootB,'RootB',L);
+    AssertEquals('Number of references in RootB to component RootB is 0',0,L.Count);
+  finally
+    L.Free;
+  end;
+end;
+
+procedure TTestResolveReference.TestFixupInstanceNames5;
+
+Var
+  L : TStringList;
+begin
+  SetupARef1A(Self);
+  SetupBRef2B(Self);
+  L:=TstringList.Create;
+  try
+    GetFixupinstanceNames(RootB,'RootB',L);
+    AssertEquals('Number of references in RootB to component RootB is 0',0,L.Count);
+  finally
+    L.Free;
+  end;
+end;
+
+// procedure RedirectFixupReferences(Root: TComponent; const OldRootName, NewRootName: string);
+
+procedure TTestResolveReference.TestRedirectFixupReferences1;
+
+Var
+  L : TStringList;
+  R1 : TUnresolvedReference;
+  R2 : TUnresolvedReference;
+  
+begin
+  R1:=SetupARef1A(Self);
+  R2:=SetupARef2B(Self);
+  RedirectFixupReferences(RootA,'RootB','RootC');
+  AssertEquals('Redirected R1.Root is RootC','RootC',R1.FGLobal);
+  AssertEquals('Redirected R1.Root is RootC','RootC',R2.FGLobal);
+end;
+
+procedure TTestResolveReference.TestRedirectFixupReferences2;
+
+Var
+  L : TStringList;
+  R1 : TUnresolvedReference;
+  R2 : TUnresolvedReference;
+
+begin
+  R1:=SetupARef1A(Self);
+  R2:=SetupBRef2B(Self);
+  RedirectFixupReferences(RootA,'RootB','RootC');
+  AssertEquals('Redirected R1.Root is RootC','RootC',R1.FGLobal);
+  AssertEquals('R2.Root is not redirected, remains RootA','RootA',R2.FGLobal);
+end;
+
+procedure TTestResolveReference.TestRedirectFixupReferences3;
+
+Var
+  R1,R2 : TUnresolvedReference;
+
+begin
+  R1:=SetupARef1A(Self);
+  R2:=SetupARef2B(Self);
+  RedirectFixupReferences(RootA,'RootC','RootQ');
+  AssertEquals('R1.Root is not redirected, remains RootB','RootB',R1.FGLobal);
+  AssertEquals('R2.Root is not redirected, remains RootB','RootB',R2.FGLobal);
+end;
+
+// procedure RemoveFixupReferences(Root: TComponent; const RootName: string);
+procedure TTestResolveReference.TestRemoveFixupReferences1;
+
+begin
+  SetupARef1A(Self);
+  SetupARef2A(Self);
+  RemoveFixupReferences(RootA,'RootB');
+  AssertSame('No references left',Nil,NeedResolving.Root);
+end;
+
+procedure TTestResolveReference.TestRemoveFixupReferences2;
+
+Var
+  RA,RB : TUnresolvedInstance;
+  R1,R2 : TUnresolvedReference;
+
+begin
+  RA:=RootAToResolveList(Self);
+  RB:=RootBToResolveList(Self);
+  R1:=SetupARef1A(Self);
+  R2:=SetupBRef2A(Self);
+  RemoveFixupReferences(RootA,'RootB');
+  AssertSame('1 reference left',RB,NeedResolving.Root);
+end;
+
+
+procedure TTestResolveReference.TestFixupReferences1;
+
+begin
+  SetupARef1A(Self);
+  GlobalFixupReferences;
+  AssertSame('RootA.Ref1 resolved to RootB.A',RootB.FindComponent('A'),RootA.Ref1);
+  AssertEquals('No more resolving needs to be done',0,NeedResolving.Count);
+end;
+
+procedure TTestResolveReference.TestFixupReferences2;
+
+Var
+  RI : TUnresolvedInstance;
+  UR : TUnresolvedReference;
+
+begin
+  // Add Not existing
+  RI:=RootBToResolveList(Self);
+  UR:=RI.AddReference(RootB,PropB1,'RootC','A');
+  // Add existing
+  SetupARef1A(Self);
+  GlobalFixupReferences;
+  AssertSame('RootA.Ref1 resolved to RootB.A',RootB.FindComponent('A'),RootA.Ref1);
+  AssertSame('Reference to RootC unresolved',RI,NeedResolving.Root);
+end;
+
+procedure TTestResolveReference.TestFixupReferences3;
+
+Var
+  RI : TUnresolvedInstance;
+  UR : TUnresolvedReference;
+
+begin
+  // Add Not existing
+  RI:=RootAToResolveList(Self);
+  UR:=RI.AddReference(RootA,PropA2,'RootC','A');
+  // Add existing
+  SetupARef1A(Self);
+  GlobalFixupReferences;
+  AssertSame('RootA.Ref1 resolved to RootB.A',RootB.FindComponent('A'),RootA.Ref1);
+  AssertSame('Reference to RootC unresolved',RI,NeedResolving.Root);
+  AssertSame('Reference to RootC unresolved',RI.RootUnresolved,UR);
+end;
+
+initialization
+  RegisterTest(TTestResolveReference);
+  InitCriticalSection(ResolveSection);
+  
+finalization
+  FreeAndNil(NeedResolving);
+  DoneCriticalsection(ResolveSection);
+end.
+

tests/test/units/fpcunit/tcstreaming.pp

@@ -0,0 +1,435 @@
+{$mode objfpc}
+{$h+}
+unit tcstreaming;
+
+interface
+
+Uses
+  SysUtils,Classes, fpcunit, testutils, testregistry;
+
+Type
+
+  { TTestStreaming }
+
+  TTestStreaming = Class(TTestCase)
+  Private
+    FStream : TMemoryStream;
+    Function ReadByte : byte;
+    Function ReadWord : Word;
+    Function ReadInteger : LongInt;
+    Function ReadInt64 : Int64;
+    function ReadBareStr: string;
+    function ReadString(V : TValueType): string;
+    function ReadWideString(V : TValueType): WideString;
+    Procedure Fail(FMt : String; Args : Array of const); overload;
+  Public
+    Procedure Setup; override;
+    Procedure TearDown; override;
+    Procedure SaveToStream(C : TComponent);
+    Function ReadValue : TValueType;
+    Procedure ExpectValue(AValue : TValueType);
+    Procedure ExpectFlags(Flags : TFilerFlags; APosition : Integer);
+    Procedure ExpectInteger(AValue : Integer);
+    Procedure ExpectByte(AValue : Byte);
+    Procedure ExpectInt64(AValue : Int64);
+    Procedure ExpectBareString(AValue : String);
+    Procedure ExpectString(AValue : String);
+    Procedure ExpectSingle(AValue : Single);
+    Procedure ExpectExtended(AValue : Extended);
+    Procedure ExpectCurrency(AValue : Currency);
+    Procedure ExpectIdent(AValue : String);
+    Procedure ExpectDate(AValue : TDateTime);
+    Procedure ExpectWideString(AValue : WideString);
+    Procedure ExpectEndofList;
+    Procedure ExpectSignature;
+    Procedure ExpectEndOfStream;
+  end;
+
+implementation
+
+uses typinfo;
+
+Function ValName(V : TValueType) : String;
+
+begin
+  Result:=GetEnumName(TypeInfo(TValueType),Ord(v));
+end;
+
+{ TTestStreaming }
+
+
+procedure TTestStreaming.ExpectByte(AValue: Byte);
+
+Var
+  B : Byte;
+
+begin
+  B:=ReadByte;
+  If (B<>AValue) then
+    Fail('Expected byte %d, got %d',[AValue,B]);
+end;
+
+procedure TTestStreaming.ExpectCurrency(AValue: Currency);
+
+Var
+  C : Currency;
+
+begin
+  ExpectValue(vaCurrency);
+  FStream.Read(C,Sizeof(C));
+  If (C<>AValue) then
+    Fail('Expected currency %f, got %f',[AValue,C]);
+end;
+
+procedure TTestStreaming.ExpectDate(AValue: TDateTime);
+
+Var
+  C : TDateTime;
+
+begin
+  ExpectValue(vaDate);
+  FStream.Read(C,Sizeof(C));
+  If (C<>AValue) then
+    Fail('Expected datetime %f, got %f',[AValue,C]);
+end;
+
+procedure TTestStreaming.ExpectEndofList;
+begin
+  ExpectValue(vaNull);
+end;
+
+procedure TTestStreaming.ExpectExtended(AValue: Extended);
+
+Var
+  E : Extended;
+
+begin
+  ExpectValue(vaExtended);
+  FStream.Read(E,Sizeof(E));
+  If Abs(E-AValue)>0.01 then
+    Fail('Expected extended %f, got %f',[AValue,E]);
+end;
+
+procedure TTestStreaming.ExpectFlags(Flags: TFilerFlags;
+  APosition: Integer);
+
+var
+  Prefix: Byte;
+  F : TFilerFlags;
+  B : Byte;
+  I : Integer;
+
+begin
+  F := [];
+  I:=0;
+  B:=ReadByte;
+  if B and $F0 = $F0 then
+    begin
+    Integer(F) := B and $0F;
+    if ffChildPos in Flags then
+      I:=ReadInteger;
+    end
+  else
+    FStream.Position:=FStream.Position-1;
+  If (FLags<>F) then
+    Fail('Wrong Flags, expected %d, got %d',[Integer(Flags),B]);
+  If I<>APosition then
+    Fail('Wrong position, expected %d, got %d',[APosition,I]);
+end;
+
+procedure TTestStreaming.ExpectIdent(AValue: String);
+
+var
+  L : Byte;
+  V : TValueType;
+  S : String;
+begin
+  V:=ReadValue;
+  case V of
+    vaIdent:
+      begin
+      L:=ReadByte;
+      SetLength(S,L);
+      FStream.Read(S[1], L);
+      end;
+    vaFalse:
+      S := 'False';
+    vaTrue:
+      S := 'True';
+    vaNil:
+      S := 'nil';
+    vaNull:
+      S := 'Null';
+  else
+    Fail('Expected identifier property type, got %s',[valName(V)]);
+  end;
+  If (S<>AValue) then
+    Fail('Wrong identifier %s, expected %s',[S,AValue]);
+end;
+
+procedure TTestStreaming.ExpectInt64(AValue: Int64);
+
+Var
+  V : TValueType;
+  I : Int64;
+
+begin
+  V:=ReadValue;
+  Case V of
+    vaInt8  : I:=ReadByte;
+    vaInt16 : I:=ReadWord;
+    vaInt32 : I:=ReadInteger;
+    vaInt64 : I:=ReadInt64;
+  else
+    Fail('Expected integer property type, got %s',[valName(V)]);
+  end;
+  If (AValue<>I) then
+    Fail('Expected integer %d, but got %d',[AValue,I]);
+end;
+
+procedure TTestStreaming.ExpectInteger(AValue: Integer);
+
+Var
+  V : TValueType;
+  I : Integer;
+
+begin
+  V:=ReadValue;
+  Case V of
+    vaInt8  : I:=ReadByte;
+    vaInt16 : I:=ReadWord;
+    vaInt32 : I:=ReadInteger;
+  else
+    Fail('Expected integer  property type, got %s',[valName(V)]);
+  end;
+  If (AValue<>I) then
+    Fail('Expected integer %d, but got %d',[AValue,I]);
+end;
+
+
+
+procedure TTestStreaming.ExpectSignature;
+
+const
+  Sig : array[1..4] of Char = 'TPF0';
+
+var
+  E,L : Longint;
+
+begin
+  L:=ReadInteger;
+  E:=Longint(Sig);
+  if L<>E then
+    Fail('Invalid signature %d, expected %d',[L,E]);
+end;
+
+procedure TTestStreaming.ExpectSingle(AValue: Single);
+
+Var
+  S : Single;
+
+begin
+  ExpectValue(vaSingle);
+  FStream.Read(S,SizeOf(Single));
+  If Abs(AValue-S)>0.0001 then
+    Fail('Expected single %f, but got %s',[AValue,S]);
+end;
+
+function TTestStreaming.ReadString(V : TValueType): string;
+
+var
+  L: Integer;
+  B : Byte;
+
+begin
+  If V in [vaWString, vaUTF8String] then
+    Result := ReadWideString(V)
+  else
+    begin
+    L := 0;
+    case V of
+      vaString:
+        begin
+        FStream.Read(B, SizeOf(B));
+        L:=B;
+        end;
+      vaLString:
+        FStream.Read(L, SizeOf(Integer));
+    else
+      Fail('Wrong type %s, expected string type.',[ValName(V)]);
+    end;
+    SetLength(Result, L);
+    If (L>0) then
+      FStream.Read(PByte(Result)^, L);
+    end;
+end;
+
+function TTestStreaming.ReadWideString(V : TValueType): WideString;
+
+var
+  L: Integer;
+  Temp: String;
+
+begin
+  if V in [vaString, vaLString] then
+    Result := ReadString(V)
+  else
+    begin
+    L := 0;
+    case V of
+      vaWString:
+        begin
+        FStream.Read(L, SizeOf(Integer));
+        SetLength(Result, L);
+        FStream.Read(Pointer(Result)^, L * 2);
+        end;
+      vaUTF8String:
+        begin
+        FStream.Read(L, SizeOf(Integer));
+        SetLength(Temp, L);
+        FStream.Read(Pointer(Temp)^, L);
+        Result:=Temp
+        end;
+    else
+      Fail('Wrong type %s, expected widestring type.',[ValName(V)]);
+    end;
+  end;
+end;
+
+procedure TTestStreaming.ExpectString(AValue: String);
+
+Var
+  V : TValueType;
+  S : String;
+begin
+  V:=ReadValue;
+  If v in [vaString,vaLstring,vaWString,vaUTF8String] then
+    S:=ReadString(V)
+  else
+    Fail('Expected string type, but got : %s',[ValName(V)]);
+  If (S<>AValue) then
+    Fail('Expected string "%s", but got "%s"',[AVAlue,S]);
+end;
+
+procedure TTestStreaming.ExpectValue(AValue: TValueType);
+
+Var
+  V : TValueType;
+
+begin
+  V:=ReadValue;
+  If (V<>AValue) then
+    Fail('Expecting value %s, but read %s',[ValName(AValue),ValName(V)]);
+end;
+
+procedure TTestStreaming.ExpectWideString(AValue: WideString);
+
+Var
+  W : WideString;
+  V : TValueType;
+
+begin
+  V:=ReadValue;
+  If v in [vaString,vaLstring,vaWString,vaUTF8String] then
+    W:=ReadWideString(V)
+  else
+    Fail('Expected string type, but got : %s',[ValName(V)]);
+  If (W<>AValue) then
+    Fail('Expected string "%s", but got "%s"',[AVAlue,W]);
+end;
+
+
+procedure TTestStreaming.Fail(Fmt: String; Args: array of const);
+begin
+  Fail(Format(Fmt,Args));
+end;
+
+function TTestStreaming.ReadValue: TValueType;
+{$IFDEF FPC}
+var b : byte;
+{$ENDIF}
+begin
+{$IFDEF FPC}
+  FStream.Read(b,1);
+  result := TValueType(b);
+{$ELSE}
+  FStream.Read(Result,SizeOf(Result));
+{$ENDIF}
+end;
+
+procedure TTestStreaming.Setup;
+begin
+  FStream:=TMemoryStream.Create;
+end;
+
+procedure TTestStreaming.SaveToStream(C: TComponent);
+var
+  s: TStream;
+begin
+  C.Name:='Test'+C.ClassName;
+  FStream.Clear;
+  FStream.WriteComponent(C);
+  FStream.Position:=0;
+  // for debugging purposes, you can write a component to file too
+  // set the class name of the component you want to write to disk in the next line
+  if (C.ClassName='TStreamedOwnedComponentsX') then begin
+    s := TFileStream.Create(C.ClassName+'.txt', fmCreate, fmShareDenyNone );
+    s.WriteComponent(C);
+    s.Free;
+  end;
+end;
+
+procedure TTestStreaming.TearDown;
+begin
+  FreeAndNil(FStream);
+end;
+
+function TTestStreaming.ReadByte: byte;
+begin
+  FStream.Read(Result,SizeOf(Result));
+end;
+
+function TTestStreaming.ReadInt64: Int64;
+begin
+  FStream.Read(Result,SizeOf(Result));
+end;
+
+function TTestStreaming.ReadInteger: LongInt;
+begin
+  FStream.Read(Result,SizeOf(Result));
+end;
+
+function TTestStreaming.ReadWord: Word;
+begin
+  FStream.Read(Result,SizeOf(Result));
+end;
+
+function TTestStreaming.ReadBareStr: string;
+
+var
+  L: Byte;
+begin
+  L:=ReadByte;
+  SetLength(Result,L);
+  Fstream.Read(Result[1], L);
+end;
+
+procedure TTestStreaming.ExpectBareString(AValue: String);
+
+Var
+  S : String;
+
+begin
+  S:=ReadBareStr;
+  If (S<>AValue) then
+    Fail('Expected bare string %s, got :%s',[AValue,S]);
+end;
+
+procedure TTestStreaming.ExpectEndOfStream;
+begin
+  If (FStream.Position<>FStream.Size) then
+    Fail('Expected at end of stream, current position=%d, size=%d',
+          [FStream.Position,FStream.Size]);
+end;
+
+end.

tests/test/units/fpcunit/tcstringlist.pp

@@ -0,0 +1,523 @@
+unit tcstringlist;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry;
+
+type
+
+  { TTestTStringList }
+
+  TTestTStringList= class(TTestCase)
+  private
+    procedure AddB;
+    procedure DeleteNegativeIndex;
+    procedure DeleteTooBigIndex;
+    procedure ExchangeNegativeIndex1;
+    procedure ExchangeTooBigIndex1;
+    procedure ExchangeNegativeIndex2;
+    procedure ExchangeTooBigIndex2;
+    procedure AccessNegativeIndex;
+    procedure AccessTooBigIndex;
+    Procedure Shuffle;
+  protected
+    List : TStringList;
+    Procedure FillList(ACount : Integer);
+    procedure SetUp; override; 
+    procedure TearDown; override; 
+  published
+    procedure TestCreate;
+    procedure TestAdd;
+    procedure TestAddIndex;
+    procedure TestAdd2;
+    procedure TestInsertFirst;
+    Procedure TestInsertMiddle;
+    procedure TestDelete;
+    Procedure TestClear;
+    Procedure TestIndexOf;
+    procedure TestExchange;
+    procedure TestAccesIndexOutOfBounds;
+    procedure TestDeleteIndexOutOfBounds;
+    procedure TestExchangeIndexOutOfBounds;
+    Procedure TestSort;
+    Procedure TestSorted;
+    Procedure TestSortedAdd;
+    Procedure TestSortedAddAll;
+    Procedure TestSortedDupError;
+    procedure TestSortedAddDuplicate;
+    Procedure TestSortedIndexOf;
+    Procedure TestChange;
+    procedure TestChangeAgain;
+    procedure TestChangeCount;
+    procedure TestChangeClear;
+    Procedure TestSetText;
+    procedure TestSetTextEOL;
+    procedure TestSetTextEmpty;
+    procedure TestSetTextEOLEmpty;
+  end;
+
+  { TEventSink }
+
+  TEventSink = Class(TObject)
+  private
+    FCOunt: Integer;
+    FSender: TObject;
+  public
+    Procedure Change(Sender : TObject);
+    Procedure Reset;
+    Property ChangeCount : Integer Read FCOunt;
+    Property LastSender : TObject Read FSender;
+  end;
+
+implementation
+
+procedure TTestTStringList.TestCreate;
+begin
+  AssertEquals('Empty list has count 0',0,List.Count);
+  AssertEquals('Empty list has sorted false',False,List.Sorted);
+  If List.Duplicates<>dupIgnore then
+    Fail('Empty list has duplicates=dupIgnore');
+end;
+
+procedure TTestTStringList.TestAdd;
+
+begin
+  FillList(1);
+  AssertEquals('Add 1 element, count is 1',1,List.Count);
+  AssertEquals('Add 1 element, last element is "Item 1"','Item 1',List[0]);
+end;
+
+procedure TTestTStringList.TestAddIndex;
+
+begin
+  AssertEquals('Add first element at index 0',0,List.Add('First'));
+  AssertEquals('Add second element, at index 1',1,List.Add('second'));
+end;
+
+procedure TTestTStringList.TestAdd2;
+
+begin
+  FillList(2);
+  AssertEquals('Add 2 elements, count is 2',2,List.Count);
+  AssertEquals('Add 2 elements, first element is "Item 1"','Item 1',List[0]);
+  AssertEquals('Add 2 elements, second element is "Item 2"','Item 2',List[1]);
+end;
+
+procedure TTestTStringList.TestInsertFirst;
+begin
+  FillList(3);
+  List.Insert(0,'New');
+  AssertEquals('Insert 1 in 3, count is 4',4,List.Count);
+  AssertEquals('Insert 1 in 3, first is inserted','New',List[0]);
+  AssertEquals('Insert 1 in 3, second is old first','Item 1',List[1]);
+end;
+
+procedure TTestTStringList.TestInsertMiddle;
+begin
+  FillList(3);
+  List.Insert(1,'New');
+  AssertEquals('Insert 1 in 3, count is 4',4,List.Count);
+  AssertEquals('Insert 1 in 3, 1 is inserted','New',List[1]);
+  AssertEquals('Insert 1 in 3, 2 is old 2','Item 2',List[2]);
+  AssertEquals('Insert 1 in 3, 0 is untouched','Item 1',List[0]);
+end;
+
+procedure TTestTStringList.TestClear;
+begin
+  FillList(3);
+  List.Clear;
+  AssertEquals('Clear: count is 0',0,List.Count);
+end;
+
+procedure TTestTStringList.TestIndexOf;
+begin
+  FillList(11);
+  AssertEquals('Find third element',2,List.IndexOf('Item 3'));
+  AssertEquals('Find third element, wrong case',2,List.IndexOf('ITEM 3'));
+end;
+
+procedure TTestTStringList.TestDelete;
+
+begin
+  FillList(3);
+  List.Delete(1);
+  AssertEquals('Delete 1 from 3, count is 2',2,List.Count);
+  AssertEquals('Delete 1 from 3, first is "Item 1"','Item 1',List[0]);
+  AssertEquals('Delete 1 from 3, second is "Item 3"','Item 3',List[1]);
+end;
+
+procedure TTestTStringList.TestExchange;
+
+begin
+  FillList(3);
+  List.Exchange(0,2);
+  AssertEquals('Exchange 0 and 2, count is 3',3,List.Count);
+  AssertEquals('Exchange 0 and 2, first is "Item 3"','Item 3',List[0]);
+  AssertEquals('Exchange 0 and 2, second is "Item 2"','Item 2',List[1]);
+  AssertEquals('Exchange 0 and 2, third is "Item 1"','Item 1',List[2]);
+end;
+
+procedure TTestTStringList.DeleteNegativeIndex;
+begin
+  List.Delete(-1);
+end;
+
+procedure TTestTStringList.DeleteTooBigIndex;
+begin
+  List.Delete(3);
+end;
+
+procedure TTestTStringList.ExchangeNegativeIndex1;
+begin
+  List.Exchange(-1,2);
+end;
+
+procedure TTestTStringList.ExchangeTooBigIndex1;
+begin
+  List.Exchange(3,2);
+end;
+
+procedure TTestTStringList.ExchangeNegativeIndex2;
+begin
+  List.Exchange(2,-1);
+
+end;
+
+procedure TTestTStringList.ExchangeTooBigIndex2;
+begin
+  List.Exchange(2,3);
+end;
+
+procedure TTestTStringList.AccessNegativeIndex;
+
+begin
+  List[-1];
+end;
+
+procedure TTestTStringList.AccessTooBigIndex;
+
+begin
+  List[3];
+end;
+
+procedure TTestTStringList.Shuffle;
+
+Var
+  I,I1,I2 : Integer;
+
+begin
+  For I:=1 to List.Count* 2 do
+    begin
+    I1:=Random(List.Count);
+    I2:=Random(List.Count);
+    if I1<>I2 then
+      List.Exchange(I1,I2);
+    end;
+end;
+
+procedure TTestTStringList.TestAccesIndexOutOfBounds;
+begin
+  FillList(3);
+  AssertException('Access Negative Index',EStringListError,@AccessNegativeIndex);
+  AssertException('Access Index too big',EStringListError,@AccessTooBigIndex);
+end;
+
+procedure TTestTStringList.TestDeleteIndexOutOfBounds;
+begin
+  FillList(3);
+  AssertException('Delete Negative Index',EStringListError,@DeleteNegativeIndex);
+  AssertException('Delete Index too big',EStringListError,@DeleteTooBigIndex);
+end;
+
+procedure TTestTStringList.TestExchangeIndexOutOfBounds;
+begin
+  FillList(3);
+  AssertException('Exchange Negative first index',EStringListError,@ExchangeNegativeIndex1);
+  AssertException('Exchange Negative second index',EStringListError,@ExchangeNegativeIndex2);
+  AssertException('Exchange first Index too big',EStringListError,@ExchangeTooBigIndex1);
+  AssertException('Exchange second Index too big',EStringListError,@ExchangeTooBigIndex2);
+end;
+
+procedure TTestTStringList.TestSort;
+
+Var
+  I : Integer;
+
+begin
+  FillList(9);
+  Shuffle;
+  List.Sort;
+  For I:=0 to List.Count-1 do
+    If (List[i]<>'Item '+IntToStr(I+1)) then
+      Fail(Format('Item at position %d is out of place (%s)',[I,List[i]]));
+end;
+
+procedure TTestTStringList.TestSorted;
+
+Var
+  I : Integer;
+begin
+  FillList(9);
+  Shuffle;
+  List.Sorted:=True;
+  For I:=0 to List.Count-1 do
+    If (List[i]<>'Item '+IntToStr(I+1)) then
+      Fail(Format('Item at position %d is out of place (%s)',[I,List[i]]));
+end;
+
+procedure TTestTStringList.TestSortedAdd;
+begin
+  List.Sorted:=True;
+  List.Add('B');
+  AssertEquals('Add second element at first location in sorted list',0,List.Add('A'));
+  AssertEquals('Add third element at first location in sorted list',1,List.Add('AB'));
+  AssertEquals('Add fourth element at last location in sorted list',3,List.Add('C'));
+end;
+
+procedure TTestTStringList.TestSortedAddAll;
+
+Var
+  I : Integer;
+  
+begin
+  List.Sorted:=True;
+  FillList(9);
+  For I:=0 to List.Count-1 do
+    If (List[i]<>'Item '+IntToStr(I+1)) then
+      Fail(Format('Item at position %d is out of place (%s)',[I,List[i]]));
+end;
+
+procedure TTestTStringList.AddB;
+
+begin
+  List.Add('B');
+end;
+
+procedure TTestTStringList.TestSortedDupError;
+begin
+  List.Sorted:=True;
+  List.Duplicates:=dupError;
+  List.Add('B');
+  AssertEquals('Add second element at first location in sorted list',0,List.Add('A'));
+  AssertException(EStringListError,@AddB);
+end;
+
+procedure TTestTStringList.TestSortedAddDuplicate;
+
+begin
+  List.Sorted:=True;
+  List.Duplicates:=dupAccept;
+  List.Add('B');
+  AssertEquals('Add second element at first location in sorted list',0,List.Add('A'));
+  AssertEquals('Add third element at first location in sorted list',1,List.Add('B'));
+  AssertEquals('Add fourth element at last location in sorted list',3,List.Add('C'));
+end;
+
+procedure TTestTStringList.TestSortedIndexOf;
+
+// Tests find, as find is called in case of sorted index
+
+begin
+  List.Sorted:=True;
+  FillList(11);
+  // 1 10 11 2 3 - so index 4
+  AssertEquals('Find third element',4,List.IndexOf('Item 3'));
+  AssertEquals('Find third element, wrong case',4,List.IndexOf('ITEM 3'));
+end;
+
+procedure TTestTStringList.TestChange;
+
+Var
+  S : TEventSink;
+
+begin
+  S:=TEventSink.Create;
+  try
+    List.OnChange:[email protected];
+    List.Add('new');
+    AssertEquals('Change count equals 1 after add',1,S.ChangeCount);
+    If List<>S.LastSender then
+      Fail('Sender is list');
+  finally
+    S.Free;
+  end;
+end;
+
+procedure TTestTStringList.TestChangeAgain;
+
+Var
+  S : TEventSink;
+
+begin
+  S:=TEventSink.Create;
+  try
+    List.BeginUpdate;
+    Try
+    List.OnChange:[email protected];
+    List.Add('new');
+      AssertEquals('Change count equals 0 after add (beginupdate)',0,S.ChangeCount);
+      If (Nil<>S.LastSender) then
+        Fail('Sender is nil');
+    Finally
+      List.EndUpdate;
+    end;
+    AssertEquals('Change count equals 1 after add endupdate',1,S.ChangeCount);
+    If List<>S.LastSender then
+      Fail('Sender is list');
+  finally
+    S.Free;
+  end;
+end;
+
+procedure TTestTStringList.TestChangeCount;
+
+Var
+  S : TEventSink;
+
+begin
+  S:=TEventSink.Create;
+  try
+    List.BeginUpdate;
+    Try
+      // Count is 1, no notification
+      List.OnChange:[email protected];
+      List.Add('new');
+      AssertEquals('Change count equals 0 after add (1st beginupdate)',0,S.ChangeCount);
+      If (Nil<>S.LastSender) then
+        Fail('Sender is nil');
+      List.BeginUpdate;
+      Try
+        List.Add('new2');
+        // Count is 2, no notification
+        AssertEquals('Change count equals 0 after add (2nd beginupdate)',0,S.ChangeCount);
+        If (Nil<>S.LastSender) then
+          Fail('Sender is nil');
+      Finally
+        List.EndUpdate;
+      end;
+      // Count is 1 again, no notification
+      AssertEquals('Change count equals 0 after first endupdate',0,S.ChangeCount);
+      If (Nil<>S.LastSender) then
+        Fail('Sender is nil after first endupdate');
+    Finally
+      List.EndUpdate;
+    end;
+    AssertEquals('Change count equals 1 after add endupdate',1,S.ChangeCount);
+    If List<>S.LastSender then
+      Fail('Sender is list');
+  finally
+    S.Free;
+  end;
+end;
+
+procedure TTestTStringList.TestChangeClear;
+
+Var
+  S : TEventSink;
+  
+begin
+  FillList(9);
+  S:=TEventSink.Create;
+  try
+    List.OnChange:[email protected];
+    List.Clear;
+    AssertEquals('Change count equals 1 after clear',1,S.ChangeCount);
+  finally
+    S.Free;
+  end;
+end;
+
+procedure TTestTStringList.TestSetText;
+
+Const
+  Lines = 'Line 1'+sLineBreak+'Line 2'+sLineBreak+'Line 3';
+
+begin
+  List.Text:=Lines;
+  AssertEquals('3 lines set',3,List.Count);
+  AssertEquals('First line is "Line 1"','Line 1',List[0]);
+  AssertEquals('Second line is "Line 2"','Line 2',List[1]);
+  AssertEquals('Third line is "Line 3"','Line 3',List[2]);
+end;
+
+procedure TTestTStringList.TestSetTextEOL;
+
+Const
+  Lines = 'Line 1'+sLineBreak+'Line 2'+sLineBreak;
+
+begin
+  List.Text:=Lines;
+  AssertEquals('2 lines set',2,List.Count);
+  AssertEquals('First line is "Line 1"','Line 1',List[0]);
+  AssertEquals('Second line is "Line 2"','Line 2',List[1]);
+end;
+
+procedure TTestTStringList.TestSetTextEOLEmpty;
+
+Const
+  Lines = 'Line 1'+sLineBreak+'Line 2'+sLineBreak+slineBreak;
+
+begin
+  List.Text:=Lines;
+  AssertEquals('3 lines set',3,List.Count);
+  AssertEquals('First line is "Line 1"','Line 1',List[0]);
+  AssertEquals('Second line is "Line 2"','Line 2',List[1]);
+  AssertEquals('Third line is empty','',List[2]);
+end;
+
+procedure TTestTStringList.TestSetTextEmpty;
+
+Const
+  Lines = 'Line 1'+sLineBreak+sLineBreak+SlineBreak+'Line 2';
+
+begin
+  List.Text:=Lines;
+  AssertEquals('4 lines set',4,List.Count);
+  AssertEquals('First line is "Line 1"','Line 1',List[0]);
+  AssertEquals('Second line is empty','',List[1]);
+  AssertEquals('Third line is empty','',List[2]);
+  AssertEquals('Fourth line is "Line 2"','Line 2',List[3]);
+end;
+
+
+procedure TTestTStringList.FillList(ACount: Integer);
+
+Var
+  I : integer;
+
+begin
+  For I:=1 to ACount do
+    List.Add('Item '+IntToStr(I));
+end;
+
+procedure TTestTStringList.SetUp; 
+begin
+  List:=TStringList.Create;
+end; 
+
+procedure TTestTStringList.TearDown; 
+begin
+  FreeAndNil(List);
+end;
+
+{ TEventSink }
+
+procedure TEventSink.Change(Sender: TObject);
+begin
+  Inc(FCount);
+  FSender:=Sender;
+end;
+
+procedure TEventSink.Reset;
+begin
+  FCount:=0;
+  FSender:=Nil;
+end;
+
+initialization
+  RegisterTest(TTestTStringList);
+end.
+

tests/test/units/fpcunit/tcstrutils.pp

@@ -0,0 +1,266 @@
+unit tcstrutils;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry, strutils;
+
+type
+
+  { TTestSearchBuf }
+
+  TTestSearchBuf= class(TTestCase)
+  Private
+    Procedure TestSearch(Sub:String; Start : Integer; O : TStringSearchOptions; Expected : Integer);
+  published
+    procedure TestSimple;
+    procedure TestSimpleNoRes;
+    procedure TestSimpleDown;
+    procedure TestSimpleDownNoRes;
+    procedure TestNotExistDown;
+    procedure TestNotExist;
+    procedure TestSimpleDownPos;
+    procedure TestSimplePos;
+    procedure TestSimpleCaseSensitive;
+    procedure TestSimpleCaseSensitiveDown;
+    procedure TestSimpleWholeWord;
+    procedure TestSimpleWholeWordDown;
+    procedure TestSimplePartialend;
+    procedure TestSimplePartialStart;
+    procedure TestEndMatchDown;
+    procedure TestEndMatch;
+    procedure TestWholeWordAtStart;
+    procedure TestWholeWordAtStartDown;
+    procedure TestWholeWordAtEnd;
+    procedure TestWholeWordAtEndDown;
+    procedure TestEmptySearchString;
+    procedure TestSelstartBeforeBuf;
+    procedure testSelstartAfterBuf;
+    Procedure TestDecodeSoundexInt;
+  end;
+
+implementation
+
+Const
+   // Don't move this comment, it indicates the positions.
+   //           1         2         3         4
+   //  1234567890123456789012345678901234567890123456789
+  S = 'Some very long string with some words in it';
+  SLen = Length(S);
+  
+{$define usenew}
+{$ifdef usenew}
+{$i searchbuf.inc}
+const
+  WhichSearchbuf = 'new';
+{$else}
+const
+  WhichSearchbuf = 'old';
+{$endif}
+
+procedure TTestSearchBuf.TestSearch(Sub: String; Start: Integer;
+  O: TStringSearchOptions; Expected: Integer);
+
+Var
+  P,PR : PChar;
+  I : Integer;
+  
+begin
+  P:=PChar(S);
+  PR:=SearchBuf(P,Length(S),Start,0,Sub,O);
+  If (PR=Nil) then
+    begin
+    If (Expected<>-1) then
+      Fail(Format('Search for "%s" failed, expected result at %d',[Sub,Expected]));
+    end
+  else
+    begin
+    I:=(PR-P)+1;
+    If (I<>Expected) then
+      Fail(Format('Wrong result for search for "%s", expected result at %d, got %d',[Sub,Expected,I]));
+    end;
+end;
+
+procedure TTestSearchBuf.TestSimpleNoRes;
+begin
+  TestSearch('very',0,[],-1);
+end;
+
+procedure TTestSearchBuf.TestSimple;
+begin
+  TestSearch('very',SLen,[],6);
+end;
+
+procedure TTestSearchBuf.TestSimpleDownNoRes;
+begin
+  TestSearch('very',0,[soDown],6);
+end;
+
+procedure TTestSearchBuf.TestSimpleDown;
+begin
+  TestSearch('very',SLen,[soDown],-1);
+end;
+
+procedure TTestSearchBuf.TestSimplePartialend;
+begin
+  TestSearch('its',0,[soDown],-1);
+end;
+
+procedure TTestSearchBuf.TestSimplePartialStart;
+begin
+  TestSearch('Tso',SLen,[],-1);
+end;
+
+procedure TTestSearchBuf.TestEndMatchDown;
+begin
+  TestSearch('it',30,[soDown],42);
+end;
+
+procedure TTestSearchBuf.TestEndMatch;
+begin
+  TestSearch('it',SLen,[],42);
+end;
+
+procedure TTestSearchBuf.TestWholeWordAtStart;
+begin
+  TestSearch('Some',20,[soWholeWord],1);
+end;
+
+procedure TTestSearchBuf.TestWholeWordAtStartDown;
+begin
+  TestSearch('Some',0,[soDown,soWholeWord],1);
+end;
+
+procedure TTestSearchBuf.TestWholeWordAtEnd;
+begin
+  TestSearch('it',SLen,[soWholeWord],42);
+end;
+
+procedure TTestSearchBuf.TestWholeWordAtEndDown;
+begin
+  TestSearch('it',30,[soDown,soWholeWord],42);
+end;
+
+procedure TTestSearchBuf.TestEmptySearchString;
+begin
+  TestSearch('',30,[],-1);
+end;
+
+procedure TTestSearchBuf.TestSelstartBeforeBuf;
+begin
+  TestSearch('very',-5,[soDown],-1);
+end;
+
+procedure TTestSearchBuf.testSelstartAfterBuf;
+begin
+  TestSearch('very',100,[],-1);
+end;
+
+procedure TTestSearchBuf.TestDecodeSoundexInt;
+
+Const
+  OrdA = Ord('A');
+  Ord0 = Ord('0');
+
+  Function CreateInt (Const S : String) : Integer;
+
+  var
+    I, Len : Integer;
+
+  begin
+    Result:=-1;
+    Len:=Length(S);
+    If Len>0 then
+      begin
+      Result:=Ord(S[1])-OrdA;
+      if Len > 1 then
+        begin
+        Result:=Result*26+(Ord(S[2])-Ord0);
+        for I:=3 to Len do
+          Result:=(Ord(S[I])-Ord0)+Result*7;
+        end;
+      Result:=Len+Result*9;
+      end;
+  end;
+
+
+  Procedure TestOneShot(S : String);
+
+  Var
+    R : String;
+
+  begin
+    R:=DecodeSoundexInt(CreateInt(S));
+    AssertEquals('Decoded Soundexint equals original soundex result:',S,R);
+  end;
+
+Var
+  C,J,K : Integer;
+  S : String;
+
+begin
+  For C:=Ord('A') to Ord('Z') do
+    begin
+    S:=Char(C);
+    TestOneShot(S);
+    for J:=1 to 6 do
+      begin
+      S:=Char(C);
+      For K:=1 to 6 do
+        begin
+        S:=S+Char(Ord('0')+k);
+        TestOneShot(S);
+        end;
+      end;
+    end;
+
+end;
+
+procedure TTestSearchBuf.TestSimpleDownPos;
+begin
+  TestSearch('it',30,[soDown],42);
+end;
+
+procedure TTestSearchBuf.TestSimplePos;
+begin
+  TestSearch('it',30,[],24);
+end;
+
+procedure TTestSearchBuf.TestNotExist;
+begin
+  TestSearch('quid',SLen,[],-1);
+end;
+
+procedure TTestSearchBuf.TestNotExistDown;
+begin
+  TestSearch('quid',0,[soDown],-1);
+end;
+
+procedure TTestSearchBuf.TestSimpleCaseSensitive;
+begin
+  TestSearch('Very',SLen,[soMatchCase],-1);
+end;
+
+procedure TTestSearchBuf.TestSimpleCaseSensitiveDown;
+begin
+  TestSearch('Very',0,[soMatchCase,soDown],-1);
+end;
+
+procedure TTestSearchBuf.TestSimpleWholeWord;
+begin
+  TestSearch('in',SLen,[soWholeWord],39);
+end;
+
+procedure TTestSearchBuf.TestSimpleWholeWordDown;
+begin
+  TestSearch('in',0,[soWholeWord,soDown],39);
+end;
+
+initialization
+  RegisterTest(TTestSearchBuf);
+  writeln ('Testing with ', WhichSearchbuf, ' implementation');
+  writeln;
+end.
+

tests/test/units/fpcunit/tctparser.pp

@@ -0,0 +1,911 @@
+{$mode objfpc}
+{$h+}
+unit tctparser;
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, testregistry;
+
+  { TTestToString }
+
+  TTestToString= class(TTestCase)
+  private
+    fStream : TMemoryStream;
+    fPar : TParser;
+  protected
+    procedure SetUp; override; 
+    procedure TearDown; override; 
+  published
+    procedure Test1;
+    procedure Test2;
+    procedure Test3;
+    procedure Test4;
+    procedure Test5;
+    procedure Test6;
+    procedure Test7;
+    procedure Test8;
+    procedure Test9;
+    procedure Test10;
+    procedure Test11;
+    procedure Test12;
+    procedure Test13;
+    procedure Test14;
+    procedure Test15;
+    procedure Test16;
+    procedure Test17;
+  end;
+
+  { TTestTokenInt }
+
+  TTestTokenInt= class(TTestCase)
+  private
+    fStream : TMemoryStream;
+    fPar : TParser;
+  protected
+    procedure SetUp; override; 
+    procedure TearDown; override; 
+  published
+    procedure Test1;
+    procedure Test2;
+    procedure Test3;
+  end;
+
+  { TTestTokenFloat }
+
+  TTestTokenFloat= class(TTestCase)
+  private
+    fStream : TMemoryStream;
+    fPar : TParser;
+  protected
+    procedure SetUp; override; 
+    procedure TearDown; override; 
+  published
+    procedure Test1;
+    procedure Test2;
+    procedure Test3;
+    procedure Test4;
+    procedure Test5;
+    procedure Test6;
+  end;
+
+  { TTestSymbol }
+
+  TTestSymbol= class(TTestCase)
+  private
+    fStream : TMemoryStream;
+    fPar : TParser;
+  protected
+    procedure SetUp; override; 
+    procedure TearDown; override;
+  published
+    procedure Test1;
+    procedure Test2;
+    procedure Test3;
+  end; 
+
+  { TTestPositions }
+
+  TTestPositions= class(TTestCase)
+  private
+    fStream : TMemoryStream;
+    fPar : TParser;
+  protected
+    procedure SetUp; override; 
+    procedure TearDown; override; 
+  published
+    procedure Test1;
+    procedure Test2;
+  end; 
+
+  { TTestBinary }
+
+  TTestBinary= class(TTestCase)
+  private
+    fStream : TMemoryStream;
+    fOutStr : TMemoryStream;
+    fPar : TParser;
+  protected
+    procedure SetUp; override; 
+    procedure TearDown; override; 
+  published
+    procedure Test1;
+    procedure Test2;
+  end; 
+
+Implementation
+
+{ ---------------------------------------------------------------------
+    TTestToString
+  ---------------------------------------------------------------------}
+  
+
+procedure TTestToString.Test1;
+const
+  aStr = '- 10';
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  fPar:=TParser.Create(fStream);
+  try
+    try
+      fPar.CheckToken('-');
+    except
+      on e : EParserError do Fail('CheckToken failed');
+    end;
+    AssertEquals('-',fPar.TokenString);
+    fPar.NextToken;
+    try
+      fPar.CheckToken(toInteger);
+    except
+      on e : EParserError do Fail('CheckToken failed');
+    end;
+    AssertEquals('10',fPar.TokenString);
+  finally
+    fPar.Free;
+  end;
+end;
+
+procedure TTestToString.Test2;
+const
+  aStr = '-10';
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  fPar:=TParser.Create(fStream);
+  try
+    try
+      fPar.CheckToken(toInteger);
+    except
+      on e : EParserError do Fail('CheckToken failed');
+    end;
+    AssertEquals('-10',fPar.TokenString);
+  finally
+    fPar.Free;
+  end;
+end;
+
+procedure TTestToString.Test3;
+const
+  aStr = '$AFz';
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  fPar:=TParser.Create(fStream);
+  try
+    try
+      fPar.CheckToken(toInteger);
+    except
+      on e : EParserError do Fail('CheckToken failed');
+    end;
+    AssertEquals('$AF',fPar.TokenString);
+    fPar.NextToken;
+    try
+      fPar.CheckToken(toSymbol);
+    except
+      on e : EParserError do Fail('CheckToken failed');
+    end;
+    AssertEquals('z',fPar.TokenString);
+  finally
+    fPar.Free;
+  end;
+end;
+
+procedure TTestToString.Test4;
+const
+  aStr : string = '$';
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  try
+    fPar:=TParser.Create(fStream);
+  except
+    on e : EParserError do exit
+    else
+    begin
+      fPar.Free;
+      Fail('EParserError should be raised');
+    end;
+  end;
+  fPar.Free;
+  Fail('EParserError should be raised');
+end;
+
+procedure TTestToString.Test5;
+const
+  aStr = '1.';
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  fPar:=TParser.Create(fStream);
+  try
+    try
+      fPar.CheckToken(toFloat);
+    except
+      on e : EParserError do Fail('CheckToken failed');
+    end;
+    AssertEquals('1.',fPar.TokenString);
+  finally
+    fPar.Free;
+  end;
+end;
+
+procedure TTestToString.Test6;
+const
+  aStr = '1.0';
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  fPar:=TParser.Create(fStream);
+  try
+    try
+      fPar.CheckToken(toFloat);
+    except
+      on e : EParserError do Fail('CheckToken failed');
+    end;
+    AssertEquals('1.0',fPar.TokenString);
+  finally
+    fPar.Free;
+  end;
+end;
+
+procedure TTestToString.Test7;
+const
+  aStr = '1E';
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  try
+    fPar:=TParser.Create(fStream);
+  except
+    on e : EParserError do exit
+    else
+    begin
+      fPar.Free;
+      Fail('EParserError should be raised');
+    end;
+  end;
+  fPar.Free;
+  Fail('EParserError should be raised');
+end;
+
+procedure TTestToString.Test8;
+const
+  aStr = '1E+';
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  try
+    fPar:=TParser.Create(fStream);
+  except
+    on e : EParserError do exit
+    else
+    begin
+      fPar.Free;
+      Fail('EParserError should be raised');
+    end;
+  end;
+  fPar.Free;
+  Fail('EParserError should be raised');
+end;
+
+procedure TTestToString.Test9;
+const
+  aStr = '1.E+2';
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  fPar:=TParser.Create(fStream);
+  try
+    try
+      fPar.CheckToken(toFloat);
+    except
+      on e : EParserError do Fail('CheckToken failed');
+    end;
+    AssertEquals('1.E+2',fPar.TokenString);
+  finally
+    fPar.Free;
+  end;
+end;
+
+procedure TTestToString.Test10;
+const
+  aStr = '1.E+2a';
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  fPar:=TParser.Create(fStream);
+  try
+    try
+      fPar.CheckToken(toFloat);
+    except
+      on e : EParserError do Fail('CheckToken failed');
+    end;
+    AssertEquals('1.E+2',fPar.TokenString);
+    fPar.NextToken;
+    try
+      fPar.CheckToken(toSymbol);
+    except
+      on e : EParserError do Fail('CheckToken failed');
+    end;
+    AssertEquals('a',fPar.TokenString);
+  finally
+    fPar.Free;
+  end;
+end;
+
+procedure TTestToString.Test11;
+const
+  aStr = '12s';
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  fPar:=TParser.Create(fStream);
+  try
+    try
+      fPar.CheckToken(toFloat);
+    except
+      on e : EParserError do Fail('CheckToken failed');
+    end;
+    AssertEquals('12s',fPar.TokenString);
+  finally
+    fPar.Free;
+  end;
+end;
+
+procedure TTestToString.Test12;
+const
+  aStr = '''string'''; //'string'
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  fPar:=TParser.Create(fStream);
+  try
+    try
+      fPar.CheckToken(toString);
+    except
+      on e : EParserError do Fail('CheckToken failed');
+    end;
+    AssertEquals('string',fPar.TokenString);
+  finally
+    fPar.Free;
+  end;
+end;
+
+procedure TTestToString.Test13;
+const
+  aStr = '''can''''t'''; //'can''t'
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  fPar:=TParser.Create(fStream);
+  try
+    try
+      fPar.CheckToken(toString);
+    except
+      on e : EParserError do Fail('CheckToken failed');
+    end;
+    AssertEquals('can''t',fPar.TokenString);
+  finally
+    fPar.Free;
+  end;
+end;
+
+procedure TTestToString.Test14;
+const
+  aStr = '''c''#97#110''''''''#116#32''open file''';  //'c'#97#110''''#116#32'open file'
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  fPar:=TParser.Create(fStream);
+  try
+    try
+      fPar.CheckToken(toString);
+    except
+      on e : EParserError do Fail('CheckToken failed');
+    end;
+    AssertEquals('can''t open file',fPar.TokenString);
+  finally
+    fPar.Free;
+  end;
+end;
+
+procedure TTestToString.Test15;
+const
+  aStr = '''perch''#232';
+var ws : widestring;
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  ws:='perch'#232;
+  fPar:=TParser.Create(fStream);
+  try
+    try
+      fPar.CheckToken(toWString);
+    except
+      on e : EParserError do Fail('CheckToken failed');
+    end;
+    AssertEquals(ws,fPar.TokenWideString);
+  finally
+    fPar.Free;
+  end;
+end;
+
+procedure TTestToString.Test16;
+const
+  aStr = '''unterminated string'#10'blah''';
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  try
+    fPar:=TParser.Create(fStream);
+  except
+    on e : EParserError do exit
+    else
+    begin
+      fPar.Free;
+      Fail('EParserError should be raised');
+    end;
+  end;
+  fPar.Free;
+  Fail('EParserError should be raised');
+end;
+
+procedure TTestToString.Test17;
+const
+  aStr = 'first.second.third';
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  fPar:=TParser.Create(fStream);
+  try
+    try
+      fPar.CheckToken(toSymbol);
+    except
+      on e : EParserError do Fail('CheckToken failed');
+    end;
+    AssertEquals('first',fPar.TokenString);
+    fPar.NextToken;
+    try
+      fPar.CheckToken('.');
+    except
+      on e : EParserError do Fail('CheckToken failed');
+    end;
+    AssertEquals('.',fPar.TokenString);
+    fPar.NextToken;
+    try
+      fPar.CheckToken(toSymbol);
+    except
+      on e : EParserError do Fail('CheckToken failed');
+    end;
+    AssertEquals('second',fPar.TokenString);
+    fPar.NextToken;
+    try
+      fPar.CheckToken('.');
+    except
+      on e : EParserError do Fail('CheckToken failed');
+    end;
+    AssertEquals('.',fPar.TokenString);
+    fPar.NextToken;
+    try
+      fPar.CheckToken(toSymbol);
+    except
+      on e : EParserError do Fail('CheckToken failed');
+    end;
+    AssertEquals('third',fPar.TokenString);
+  finally
+    fPar.Free;
+  end;
+end;
+
+procedure TTestToString.SetUp;
+begin
+  fStream:=TMemoryStream.Create;
+end; 
+
+procedure TTestToString.TearDown;
+begin
+  fStream.Free;
+end;
+
+{ ---------------------------------------------------------------------
+    TTestTokenInt
+  ---------------------------------------------------------------------}
+  
+
+procedure TTestTokenInt.Test1;
+const
+  aStr = '10';
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  fPar:=TParser.Create(fStream);
+  try
+    AssertEquals(toInteger,fPar.Token);
+    AssertEquals(10,fPar.TokenInt);
+  finally
+    fPar.Free;
+  end;
+end;
+
+procedure TTestTokenInt.Test2;
+const
+  aStr = '-10';
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  fPar:=TParser.Create(fStream);
+  try
+    AssertEquals(toInteger,fPar.Token);
+    AssertEquals(-10,fPar.TokenInt);
+  finally
+    fPar.Free;
+  end;
+end;
+
+procedure TTestTokenInt.Test3;
+const
+  aStr = '$AF';
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  fPar:=TParser.Create(fStream);
+  try
+    AssertEquals(toInteger,fPar.Token);
+    AssertEquals($AF,fPar.TokenInt);
+  finally
+    fPar.Free;
+  end;
+end;
+
+procedure TTestTokenInt.SetUp;
+begin
+  fStream:=TMemoryStream.Create;
+end;
+
+procedure TTestTokenInt.TearDown;
+begin
+  fStream.Free;
+end;
+
+{ ---------------------------------------------------------------------
+    TTestTokenFloat
+  ---------------------------------------------------------------------}
+  
+procedure TTestTokenFloat.Test1;
+const
+  aStr = '1.';
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  fPar:=TParser.Create(fStream);
+  try
+    AssertEquals(toFloat,fPar.Token);
+    AssertEquals(1.0,fPar.TokenFloat);
+    AssertEquals(#0,fPar.FloatType);
+  finally
+    fPar.Free;
+  end;
+end;
+
+procedure TTestTokenFloat.Test2;
+const
+  aStr = '1.0';
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  fPar:=TParser.Create(fStream);
+  try
+    AssertEquals(toFloat,fPar.Token);
+    AssertEquals(1.0,fPar.TokenFloat);
+    AssertEquals(#0,fPar.FloatType);
+  finally
+    fPar.Free;
+  end;
+end;
+
+procedure TTestTokenFloat.Test3;
+const
+  aStr = '1.E+2';
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  fPar:=TParser.Create(fStream);
+  try
+    AssertEquals(toFloat,fPar.Token);
+    AssertEquals(100.0,fPar.TokenFloat);
+    AssertEquals(#0,fPar.FloatType);
+  finally
+    fPar.Free;
+  end;
+end;
+
+procedure TTestTokenFloat.Test4;
+const
+  aStr = '12s';
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  fPar:=TParser.Create(fStream);
+  try
+    AssertEquals(toFloat,fPar.Token);
+    AssertEquals(12.0,fPar.TokenFloat);
+    AssertEquals('s',fPar.FloatType);
+  finally
+    fPar.Free;
+  end;
+end;
+
+procedure TTestTokenFloat.Test5;
+const
+  aStr = '12d';
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  fPar:=TParser.Create(fStream);
+  try
+    AssertEquals(toFloat,fPar.Token);
+    AssertEquals(12.0,fPar.TokenFloat);
+    AssertEquals('d',fPar.FloatType);
+  finally
+    fPar.Free;
+  end;
+end;
+
+procedure TTestTokenFloat.Test6;
+const
+  aStr = '12c';
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  fPar:=TParser.Create(fStream);
+  try
+    AssertEquals(toFloat,fPar.Token);
+    AssertEquals(12.0,fPar.TokenFloat);
+    AssertEquals('c',fPar.FloatType);
+  finally
+    fPar.Free;
+  end;
+end;
+
+procedure TTestTokenFloat.SetUp; 
+begin
+  fStream:=TMemoryStream.Create;
+end;
+
+procedure TTestTokenFloat.TearDown; 
+begin
+  fStream.Free;
+end;
+
+{ ---------------------------------------------------------------------
+    TTestSymbol
+  ---------------------------------------------------------------------}
+  
+
+procedure TTestSymbol.Test1;
+const
+  aStr = 'hello world';
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  fPar:=TParser.Create(fStream);
+  try
+    AssertTrue(fPar.TokenSymbolIs('HELLO'));
+    try
+      fPar.CheckTokenSymbol('HeLlO');
+    except
+      on e : EParserError do Fail('CheckTokenSymbol failed');
+    end;
+    AssertEquals('hello',fPar.TokenComponentIdent);
+    fPar.NextToken;
+    AssertTrue(fPar.TokenSymbolIs('world'));
+    try
+      fPar.CheckTokenSymbol('wOrLd');
+    except
+      on e : EParserError do Fail('CheckTokenSymbol failed');
+    end;
+    AssertEquals('world',fPar.TokenComponentIdent);
+  finally
+    fPar.Free;
+  end;
+end;
+
+procedure TTestSymbol.Test2;
+const
+  aStr = 'first.second.third';
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  fPar:=TParser.Create(fStream);
+  try
+    AssertTrue(fPar.TokenSymbolIs('first'));
+    try
+      fPar.CheckTokenSymbol('first');
+    except
+      on e : EParserError do Fail('CheckTokenSymbol failed');
+    end;
+    AssertEquals('first',fPar.TokenString);
+    AssertEquals('first.second.third',fPar.TokenComponentIdent);
+    AssertEquals('first.second.third',fPar.TokenString);
+  finally
+    fPar.Free;
+  end;
+end;
+
+procedure TTestSymbol.Test3;
+const
+  aStr = 'first.';
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  fPar:=TParser.Create(fStream);
+  try
+    AssertTrue(fPar.TokenSymbolIs('first'));
+    try
+      fPar.CheckTokenSymbol('first');
+    except
+      on e : EParserError do Fail('CheckTokenSymbol failed');
+    end;
+    AssertEquals('first',fPar.TokenString);
+    try
+      fPar.TokenComponentIdent;
+    except
+      on e : EParserError do exit
+      else
+        Fail('EParserError should be raised');
+    end;
+    Fail('EParserError should be raised');
+  finally
+    fPar.Free;
+  end;
+end;
+
+procedure TTestSymbol.SetUp; 
+begin
+  fStream:=TMemoryStream.Create;
+end;
+
+procedure TTestSymbol.TearDown;
+begin
+  fStream.Free;
+end;
+
+{ ---------------------------------------------------------------------
+    TTestPositions
+  ---------------------------------------------------------------------}
+  
+
+procedure TTestPositions.Test1;
+const
+  aStr = 'this is'#10'a '#13'test.'#13#10'Another line';
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  fPar:=TParser.Create(fStream);
+  try
+    //this
+    AssertEquals(1,fPar.SourceLine);
+    AssertEquals(4,fPar.SourcePos);
+    //is
+    fPar.NextToken;
+    AssertEquals(1,fPar.SourceLine);
+    AssertEquals(7,fPar.SourcePos);
+    //a
+    fPar.NextToken;
+    AssertEquals(2,fPar.SourceLine);
+    AssertEquals(9,fPar.SourcePos);
+    //test
+    fPar.NextToken;
+    AssertEquals(3,fPar.SourceLine);
+    AssertEquals(15,fPar.SourcePos);
+    //.
+    fPar.NextToken;
+    AssertEquals(3,fPar.SourceLine);
+    AssertEquals(16,fPar.SourcePos);
+    //Another
+    fPar.NextToken;
+    AssertEquals(4,fPar.SourceLine);
+    AssertEquals(25,fPar.SourcePos);
+    //line
+    fPar.NextToken;
+    AssertEquals(4,fPar.SourceLine);
+    AssertEquals(30,fPar.SourcePos);
+    //eof
+    fPar.NextToken;
+    AssertEquals(4,fPar.SourceLine);
+    AssertEquals(30,fPar.SourcePos);
+    AssertEquals(toEOF,fPar.Token);
+  finally
+    fPar.Free;
+  end;
+end;
+
+procedure TTestPositions.Test2;
+const
+  aStr = 'this is a test';
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  fPar:=TParser.Create(fStream);
+  try
+    //this
+    fPar.NextToken;
+    //is
+  finally
+    fPar.Free;
+  end;
+  AssertEquals(7,fStream.Position);
+end;
+
+procedure TTestPositions.SetUp; 
+begin
+  fStream:=TMemoryStream.Create;
+end;
+
+procedure TTestPositions.TearDown; 
+begin
+  fStream.Free;
+end;
+
+{ ---------------------------------------------------------------------
+    TTestBinary
+  ---------------------------------------------------------------------}
+  
+procedure TTestBinary.Test1;
+const
+  aStr = '{ 1234 56'+#13#10'789A somethingelse';
+var buf : array[0..4] of byte = ($12,$34,$56,$78,$9A);
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  fOutStr.Position:=0;
+  fPar:=TParser.Create(fStream);
+  try
+    fPar.HexToBinary(fOutStr);
+    AssertEquals(5,fOutStr.Size);
+    AssertTrue(CompareMem(@buf[0],fOutStr.Memory,5));
+    AssertEquals(16,fPar.SourcePos);
+  finally
+    fPar.Free;
+  end;
+end;
+
+procedure TTestBinary.Test2;
+const
+  aStr = '{ 123z';
+begin
+  fStream.WriteBuffer(aStr[1],length(aStr));
+  fStream.Position:=0;
+  fOutStr.Position:=0;
+  fPar:=TParser.Create(fStream);
+  try
+    try
+      fPar.HexToBinary(fOutStr);
+    except
+      on e : EParserError do exit
+      else Fail('EParserError should be raised');
+    end;
+    Fail('EParserError should be raised');
+  finally
+    fPar.Free;
+  end;
+end;
+
+procedure TTestBinary.SetUp; 
+begin
+  fStream:=TMemoryStream.Create;
+  fOutStr:=TMemoryStream.Create;
+end;
+
+procedure TTestBinary.TearDown; 
+begin
+  fStream.Free;
+  fOutStr.Free;
+end; 
+
+initialization
+
+  RegisterTests([TTestToString,TTestTokenInt,TTestTokenFloat,TTestSymbol,TTestBinary]);
+
+end.

tests/test/units/fpcunit/testclasses.lpi

@@ -0,0 +1,277 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="/"/>
+    <Version Value="6"/>
+    <General>
+      <MainUnit Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=""/>
+      <Title Value="findnested"/>
+      <ActiveEditorIndexAtStart Value="1"/>
+    </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="21">
+      <Unit0>
+        <Filename Value="testclasses.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="testclasses"/>
+        <CursorPos X="63" Y="7"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="0"/>
+        <UsageCount Value="92"/>
+        <Loaded Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="tcfindnested.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tcfindnested"/>
+        <CursorPos X="14" Y="17"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="92"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="tcstringlist.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tcstringlist"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="25"/>
+        <UsageCount Value="92"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="tccollection.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tccollection"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="436"/>
+        <UsageCount Value="92"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="tclist.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tclist"/>
+        <CursorPos X="27" Y="67"/>
+        <TopLine Value="51"/>
+        <EditorIndex Value="3"/>
+        <UsageCount Value="92"/>
+        <Loaded Value="True"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="tcpersistent.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tcpersistent"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="4"/>
+        <UsageCount Value="92"/>
+        <Loaded Value="True"/>
+      </Unit5>
+      <Unit6>
+        <Filename Value="tclinkedlist.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tclinkedlist"/>
+        <CursorPos X="30" Y="46"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="92"/>
+      </Unit6>
+      <Unit7>
+        <Filename Value="../../../../fpc/rtl/objpas/classes/classesh.inc"/>
+        <CursorPos X="14" Y="432"/>
+        <TopLine Value="401"/>
+        <UsageCount Value="3"/>
+      </Unit7>
+      <Unit8>
+        <Filename Value="../../../../fpc/rtl/objpas/classes/collect.inc"/>
+        <CursorPos X="51" Y="319"/>
+        <TopLine Value="293"/>
+        <UsageCount Value="3"/>
+      </Unit8>
+      <Unit9>
+        <Filename Value="../objpas/classes/stringl.inc"/>
+        <CursorPos X="25" Y="800"/>
+        <TopLine Value="787"/>
+        <UsageCount Value="4"/>
+      </Unit9>
+      <Unit10>
+        <Filename Value="../../../lazarus/components/fpcunit/console/consoletestrunner.pas"/>
+        <UnitName Value="consoletestrunner"/>
+        <CursorPos X="38" Y="309"/>
+        <TopLine Value="45"/>
+        <UsageCount Value="4"/>
+      </Unit10>
+      <Unit11>
+        <Filename Value="../../packages/fcl-fpcunit/src/testutils.pp"/>
+        <UnitName Value="testutils"/>
+        <CursorPos X="59" Y="10"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="45"/>
+      </Unit11>
+      <Unit12>
+        <Filename Value="../../packages/fcl-fpcunit/src/fpcunit.pp"/>
+        <UnitName Value="fpcunit"/>
+        <CursorPos X="1" Y="1042"/>
+        <TopLine Value="1020"/>
+        <EditorIndex Value="2"/>
+        <UsageCount Value="46"/>
+        <Loaded Value="True"/>
+      </Unit12>
+      <Unit13>
+        <Filename Value="../../packages/fcl-fpcunit/src/testregistry.pp"/>
+        <UnitName Value="testregistry"/>
+        <CursorPos X="1" Y="117"/>
+        <TopLine Value="94"/>
+        <UsageCount Value="45"/>
+      </Unit13>
+      <Unit14>
+        <Filename Value="../inc/system.inc"/>
+        <CursorPos X="1" Y="730"/>
+        <TopLine Value="707"/>
+        <UsageCount Value="4"/>
+      </Unit14>
+      <Unit15>
+        <Filename Value="../objpas/classes/classesh.inc"/>
+        <CursorPos X="15" Y="601"/>
+        <TopLine Value="579"/>
+        <UsageCount Value="4"/>
+      </Unit15>
+      <Unit16>
+        <Filename Value="../../../lazarus/components/fpcunit/console/fpcunitconsolerunner.pas"/>
+        <UnitName Value="fpcunitconsolerunner"/>
+        <CursorPos X="62" Y="14"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="22"/>
+      </Unit16>
+      <Unit17>
+        <Filename Value="tccompstreaming.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tccompstreaming"/>
+        <CursorPos X="34" Y="779"/>
+        <TopLine Value="777"/>
+        <EditorIndex Value="1"/>
+        <UsageCount Value="22"/>
+        <Loaded Value="True"/>
+      </Unit17>
+      <Unit18>
+        <Filename Value="../objpas/typinfo.pp"/>
+        <UnitName Value="typinfo"/>
+        <CursorPos X="38" Y="248"/>
+        <TopLine Value="244"/>
+        <UsageCount Value="11"/>
+      </Unit18>
+      <Unit19>
+        <Filename Value="tcresref.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tcresref"/>
+        <CursorPos X="12" Y="492"/>
+        <TopLine Value="484"/>
+        <EditorIndex Value="5"/>
+        <UsageCount Value="22"/>
+        <Loaded Value="True"/>
+      </Unit19>
+      <Unit20>
+        <Filename Value="resref.inc"/>
+        <CursorPos X="25" Y="185"/>
+        <TopLine Value="174"/>
+        <EditorIndex Value="6"/>
+        <UsageCount Value="11"/>
+        <Loaded Value="True"/>
+      </Unit20>
+    </Units>
+    <JumpHistory Count="9" HistoryIndex="8">
+      <Position1>
+        <Filename Value="tcresref.pp"/>
+        <Caret Line="201" Column="36" TopLine="151"/>
+      </Position1>
+      <Position2>
+        <Filename Value="resref.inc"/>
+        <Caret Line="278" Column="34" TopLine="238"/>
+      </Position2>
+      <Position3>
+        <Filename Value="resref.inc"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position3>
+      <Position4>
+        <Filename Value="resref.inc"/>
+        <Caret Line="151" Column="1" TopLine="115"/>
+      </Position4>
+      <Position5>
+        <Filename Value="resref.inc"/>
+        <Caret Line="152" Column="46" TopLine="126"/>
+      </Position5>
+      <Position6>
+        <Filename Value="resref.inc"/>
+        <Caret Line="403" Column="49" TopLine="403"/>
+      </Position6>
+      <Position7>
+        <Filename Value="resref.inc"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position7>
+      <Position8>
+        <Filename Value="tclist.pp"/>
+        <Caret Line="187" Column="9" TopLine="187"/>
+      </Position8>
+      <Position9>
+        <Filename Value="tcpersistent.pp"/>
+        <Caret Line="51" Column="15" TopLine="26"/>
+      </Position9>
+    </JumpHistory>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+      <TargetCPU Value="x86_64"/>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <GenerateDebugInfo Value="True"/>
+        <UseHeaptrc Value="True"/>
+      </Debugging>
+    </Linking>
+    <Other>
+      <CustomOptions Value="
+"/>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <BreakPoints Count="1">
+      <Item1>
+        <Source Value="tcfindnested.pp"/>
+        <Line Value="98"/>
+      </Item1>
+    </BreakPoints>
+    <Exceptions Count="2">
+      <Item1>
+        <Name Value="ECodetoolError"/>
+      </Item1>
+      <Item2>
+        <Name Value="EFOpenError"/>
+      </Item2>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

tests/test/units/fpcunit/testclasses.lpr

@@ -0,0 +1,29 @@
+program testclasses;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, tcfindnested, tcstringlist, tccollection, tclist,
+  tcpersistent, tclinkedlist, tccomponent, tcstreaming, tccompstreaming,
+  tcresref,
+  consoletestrunner;
+
+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:='Test classes';
+  Application.Run;
+  Application.Free;
+end.

tests/test/units/fpcunit/testcomps.pp

@@ -0,0 +1,954 @@
+unit testcomps;
+
+interface
+
+uses classes, sysutils;
+
+Type
+  TEmptyComponent = Class(TComponent)
+  end;
+
+  // Simple integer, fits in 1 byte
+  TIntegerComponent = Class(TComponent)
+  private
+    FIntProp: Integer;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property IntProp : Integer Read FIntProp Write FIntProp;
+  end;
+
+  // Simple integer, fits in 2 bytes
+  TIntegerComponent2 = Class(TComponent)
+  private
+    FIntProp: Integer;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property IntProp : Integer Read FIntProp Write FIntProp;
+  end;
+
+  // Simple integer, fits in 3 bytes
+  TIntegerComponent3 = Class(TComponent)
+  private
+    FIntProp: Integer;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property IntProp : Integer Read FIntProp Write FIntProp;
+  end;
+
+  // Simple integer, Default value. (set)
+  TIntegerComponent4 = Class(TComponent)
+  private
+    FIntProp: Integer;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property IntProp : Integer Read FIntProp Write FIntProp default 6;
+  end;
+
+  // Simple integer, Default value. (not set)
+  TIntegerComponent5 = Class(TComponent)
+  private
+    FIntProp: Integer;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property IntProp : Integer Read FIntProp Write FIntProp default 6;
+  end;
+
+  // Simple Int64 property fits in a single byte.
+  TInt64Component = Class(TComponent)
+  private
+    FIntProp: Int64;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property Int64Prop : Int64 Read FIntProp Write FIntProp;
+  end;
+
+  // Simple Int64 property fits 2 bytes.
+  TInt64Component2 = Class(TComponent)
+  private
+    FIntProp: Int64;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property Int64Prop : Int64 Read FIntProp Write FIntProp;
+  end;
+
+  // Simple Int64 property fits 3 bytes.
+  TInt64Component3 = Class(TComponent)
+  private
+    FIntProp: Int64;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property Int64Prop : Int64 Read FIntProp Write FIntProp;
+  end;
+
+  // Simple Int64 property fits 4 bytes.
+  TInt64Component4 = Class(TComponent)
+  private
+    FIntProp: Int64;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property Int64Prop : Int64 Read FIntProp Write FIntProp;
+  end;
+
+  // Int64 property with default, set.
+  TInt64Component5 = Class(TComponent)
+  private
+    FIntProp: Int64;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property Int64Prop : Int64 Read FIntProp Write FIntProp default 7;
+  end;
+
+  // Int64 property with default, not set.
+  TInt64Component6 = Class(TComponent)
+  private
+    FIntProp: Int64;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property Int64Prop : Int64 Read FIntProp Write FIntProp default 7;
+  end;
+
+  // String property.
+  TStringComponent = Class(TComponent)
+  private
+    F: String;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property StringProp : String Read F Write F;
+  end;
+
+  // String property, empty
+  TStringComponent2 = Class(TComponent)
+  private
+    F: String;
+  Published
+    Property StringProp : String Read F Write F;
+  end;
+
+  // WideString property
+  TWideStringComponent = Class(TComponent)
+  private
+    F: WideString;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property WideStringProp : WideString Read F Write F;
+  end;
+
+  // WideString property, empty
+  TWideStringComponent2 = Class(TComponent)
+  private
+    F: WideString;
+  Published
+    Property WideStringProp : WideString Read F Write F;
+  end;
+
+  // Single property
+  TSingleComponent = Class(TComponent)
+  private
+    F: Single;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property SingleProp : Single Read F Write F;
+  end;
+
+  // Double property
+  TDoubleComponent = Class(TComponent)
+  private
+    F: Double;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property DoubleProp : Double Read F Write F;
+  end;
+
+  // Extended property
+  TExtendedComponent = Class(TComponent)
+  private
+    F: Extended;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property ExtendedProp : Extended Read F Write F;
+  end;
+
+  // Comp property
+  TCompComponent = Class(TComponent)
+  private
+    F: Comp;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property ExtendedProp : Comp Read F Write F;
+  end;
+
+  // Currency property
+  TCurrencyComponent = Class(TComponent)
+  private
+    F: Currency;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property CurrencyProp : Currency Read F Write F;
+  end;
+
+  // DateTime property, date only
+  TDateTimeComponent = Class(TComponent)
+  private
+    F: TDateTime;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property DateTimeProp : TDateTime Read F Write F;
+  end;
+
+  // DateTime property, time only
+  TDateTimeComponent2 = Class(TComponent)
+  private
+    F: TDateTime;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property DateTimeProp : TDateTime Read F Write F;
+  end;
+
+  // DateTime property, Date and time
+  TDateTimeComponent3 = Class(TComponent)
+  private
+    F: TDateTime;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property DateTimeProp : TDateTime Read F Write F;
+  end;
+
+  TDice = (one,two,three,four,five,six);
+
+  // Enum property. No default (i.e. 0)
+  TEnumComponent = Class(TComponent)
+  private
+    F: TDice;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property Dice : TDice Read F Write F;
+  end;
+
+  // Enum  property, not set
+  TEnumComponent2 = Class(TComponent)
+  private
+    F: TDice;
+  Published
+    Property Dice : TDice Read F Write F;
+  end;
+
+  // Enum property with default, not set
+  TEnumComponent3 = Class(TComponent)
+  private
+    F: TDice;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property Dice : TDice Read F Write F default two;
+  end;
+
+  // Enum property with default, set
+  TEnumComponent4 = Class(TComponent)
+  private
+    F: TDice;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property Dice : TDice Read F Write F default two;
+  end;
+
+  // Enum property with default, no need to set
+  TEnumComponent5 = Class(TComponent)
+  private
+    F: TDice;
+  Published
+    Property Dice : TDice Read F Write F default one;
+  end;
+
+  Throws = Set of TDice;
+
+  // Set property, no default.
+  TSetComponent = Class(TComponent)
+  private
+    F: Throws;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property Throw : Throws Read F Write F;
+  end;
+
+  // Set property, no default, not set
+  TSetComponent2 = Class(TComponent)
+  private
+    F: Throws;
+  Published
+    Property Throw : Throws Read F Write F;
+  end;
+
+  // Set property, default, not set
+  TSetComponent3 = Class(TComponent)
+  private
+    F: Throws;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property Throw : Throws Read F Write F default [three,six];
+  end;
+
+  // Set property, default, set
+  TSetComponent4 = Class(TComponent)
+  private
+    F: Throws;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property Throw : Throws Read F Write F default [three,six];
+  end;
+
+  // Multiple components.
+  TMultipleComponent = Class(TComponent)
+  private
+    FCurrency: Currency;
+    FInt: Integer;
+    FString: String;
+    FDice: TDice;
+    F: Throws;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property IntProp : Integer Read FInt Write FInt;
+    Property StringProp : String Read FString Write FString;
+    Property CurrencyProp : Currency Read FCurrency Write FCurrency;
+    Property Dice : TDice Read FDice Write FDice;
+    Property Throw : Throws Read F Write F;
+  end;
+
+  TTestPersistent1 = Class(TPersistent)
+  private
+    FInt: Integer;
+    FAstring: String;
+  Public
+    Procedure Assign(ASource : TPersistent); override;
+  Published
+    Property AInteger : Integer Read FInt Write FInt;
+    Property AString : String Read FAstring Write FAsTring;
+  end;
+
+  // Persistent as a published property.
+  TPersistentComponent = Class(TComponent)
+  private
+    FPers: TTestPersistent1;
+    procedure SetPers(const Value: TTestPersistent1);
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+    Destructor Destroy; override;
+  Published
+    Property Persist : TTestPersistent1 Read FPers Write SetPers;
+  end;
+
+  // For use in collection streaming
+  TTestItem = Class(TCollectionItem)
+  Private
+    F : String;
+  Published
+    Property StrProp : String Read F Write F;
+  end;
+
+  // For use in collection streaming: items with two properties
+
+  { TTest2Item }
+
+  TTest2Item = Class(TCollectionItem)
+  Private
+    F1, F2 : String;
+  public
+  Published
+    Property StrProp1 : String Read F1 Write F1;
+    Property StrProp2 : String Read F2 Write F2;
+  end;
+
+
+  TTestCollection = Class(TCollection)
+  Public
+    Constructor Create;
+  end;
+
+  // Empty collection
+  TCollectionComponent = Class(TComponent)
+  Private
+    FColl : TCollection;
+    Procedure SetColl(AColl : TCollection);
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+  Published
+    Property Coll : TCollection Read FColl Write SetCOll;
+  end;
+
+  // collection with elements.
+  TCollectionComponent2 = Class(TCollectionComponent)
+  Public
+    Constructor Create(AOwner : TComponent); override;
+  end;
+
+  // collection with elements, one has no props
+  TCollectionComponent3 = Class(TCollectionComponent)
+  Public
+    Constructor Create(AOwner : TComponent); override;
+  end;
+
+  // collection with changed propname, one element
+  TCollectionComponent4 = Class(TComponent)
+    FColl : TTestCollection;
+    Procedure SetColl(AColl : TTestCollection);
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+  Published
+    Property Coll : TTestCollection Read FColl Write SetColl;
+  end;
+
+  // collection two elements, items with two properties
+  TCollectionComponent5 = Class(TComponent)
+    FColl : TCollection;
+    Procedure SetColl(AColl : TCollection);
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+  Published
+    Property Coll : TCollection Read FColl Write SetColl;
+  end;
+
+  // Component as published property
+  TOwnedComponent = Class(TComponent)
+    F : TComponent;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property CompProp : TComponent Read F Write F;
+  end;
+
+  // Use this if owned components should also be streamed.
+  TChildrenComponent = Class(TComponent)
+    // Owned components are children
+    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
+  end;
+
+  // Stream sub component.
+  TStreamedOwnedComponent = Class(TChildrenComponent)
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Sub : TIntegerComponent;
+  end;
+  
+  // Stream 2 sub components
+  TStreamedOwnedComponents = Class(TChildrenComponent)
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    SubA : TIntegerComponent;
+    SubB : TStringComponent;
+  end;
+
+  // Method tests.
+
+  THandler = Procedure of Object;
+
+  // Method property that points to own method.
+  TMethodComponent = Class(TComponent)
+  Private
+    F : THandler;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Procedure MyMethod;
+    Property MethodProp : THandler Read F Write F;
+  end;
+
+  // Method property of owned component that points to own method.
+  TMethodComponent2 = Class(TChildrenComponent)
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Procedure MyMethod2;
+  end;
+
+Implementation
+
+procedure TChildrenComponent.GetChildren(Proc: TGetChildProc; Root: TComponent);
+
+Var
+  I : Integer;
+
+begin
+  For I:=0 to ComponentCount-1 do
+    Proc(Components[i]);
+end;
+
+
+{ TIntegerComponent }
+
+constructor TIntegerComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  FIntProp:=3;
+end;
+
+
+{ TInt64Component }
+
+constructor TInt64Component.Create(AOwner: TComponent);
+begin
+  inherited;
+  FIntProp:=4;
+end;
+
+{ TInt64Component2 }
+
+constructor TInt64Component2.Create(AOwner: TComponent);
+begin
+  inherited;
+  FIntProp:=2 shl 9;
+end;
+
+{ TIntegerComponent2 }
+
+constructor TIntegerComponent2.Create(AOwner: TComponent);
+begin
+  inherited;
+  FintProp:=2 shl 9;
+end;
+
+{ TIntegerComponent3 }
+
+constructor TIntegerComponent3.Create(AOwner: TComponent);
+begin
+  inherited;
+  FintProp:=2 shl 17;
+end;
+
+{ TInt64Component3 }
+
+constructor TInt64Component3.Create(AOwner: TComponent);
+begin
+  inherited;
+  FintProp:=2 shl 17;
+end;
+
+{ TInt64Component4 }
+
+constructor TInt64Component4.Create(AOwner: TComponent);
+begin
+  inherited;
+  FintProp:=Int64(MaxInt)+Int64(2 shl 17);
+end;
+
+{ TStringComponent }
+
+constructor TStringComponent.Create(AOwner: TComponent);
+begin
+  Inherited;
+  F:='A string';
+end;
+
+{ TWideStringComponent }
+
+constructor TWideStringComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:='Some WideString';
+end;
+
+{ TSingleComponent }
+
+constructor TSingleComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=1.23;
+end;
+
+{ TDoubleComponent }
+
+constructor TDoubleComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=2.34;
+end;
+
+{ TExtendedComponent }
+
+constructor TExtendedComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=3.45;
+end;
+
+{ TCompComponent }
+
+constructor TCompComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=4.56;
+end;
+
+{ TCurrencyComponent }
+
+constructor TCurrencyComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=5.67;
+end;
+
+{ TDateTimeComponent }
+
+constructor TDateTimeComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=EncodeDate(1996,8,1);
+end;
+
+{ TDateTimeComponent2 }
+
+constructor TDateTimeComponent2.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=EncodeTime(23,20,0,0);
+end;
+
+{ TDateTimeComponent3 }
+
+constructor TDateTimeComponent3.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=EncodeDate(1996,8,1)+EncodeTime(23,20,0,0);
+end;
+
+{ TEnumComponent }
+
+constructor TEnumComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=Four;
+end;
+
+{ TSetComponent }
+
+constructor TSetComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=[two,five];
+end;
+
+{ TIntegerComponent4 }
+
+constructor TIntegerComponent4.Create(AOwner: TComponent);
+begin
+  inherited;
+  FIntProp:=6;
+end;
+
+{ TIntegerComponent5 }
+
+constructor TIntegerComponent5.Create(AOwner: TComponent);
+begin
+  inherited;
+  FintProp:=5;
+end;
+
+{ TInt64Component5 }
+
+constructor TInt64Component5.Create(AOwner: TComponent);
+begin
+  inherited;
+  FIntProp:=7;
+end;
+
+{ TInt64Component6 }
+
+constructor TInt64Component6.Create(AOwner: TComponent);
+begin
+  inherited;
+  FintProp:=8;
+end;
+
+{ TEnumComponent3 }
+
+constructor TEnumComponent3.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=Three;
+end;
+
+{ TEnumComponent4 }
+
+constructor TEnumComponent4.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=Two;
+end;
+
+{ TSetComponent4 }
+
+constructor TSetComponent4.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=[Three,Six];
+end;
+
+{ TSetComponent3 }
+
+constructor TSetComponent3.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=[One,Four];
+end;
+
+{ TMultipleComponent }
+
+constructor TMultipleComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  FInt:=1;
+  FCurrency:=2.3;
+  FString:='A String';
+  FDice:=two;
+  F:=[three,four];
+end;
+
+{ TTestPersistent1 }
+
+procedure TTestPersistent1.Assign(ASource: TPersistent);
+
+Var
+  T :TTestPersistent1;
+
+begin
+  If ASource is TTestPersistent1 then
+    begin
+    T:=ASource as TTestPersistent1;
+    FInt:=T.FInt;
+    FAString:=T.FAString;
+    end
+  else
+    inherited;
+end;
+
+{ TPersistentComponent }
+
+constructor TPersistentComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  FPers:=TTestPersistent1.Create;
+  FPers.AInteger:=3;
+  FPers.AString:='A persistent string';
+end;
+
+Destructor TPersistentComponent.Destroy;
+
+begin
+  FreeAndNil(FPers);
+  Inherited;
+end;
+
+procedure TPersistentComponent.SetPers(const Value: TTestPersistent1);
+begin
+  FPers.Assign(Value);
+end;
+
+{ TCollectionComponent }
+
+Procedure TCollectionComponent.SetColl(AColl : TCollection);
+
+begin
+  FColl.Assign(AColl);
+end;
+
+Constructor TCollectionComponent.Create(AOwner : TComponent);
+
+begin
+  Inherited;
+  FColl:=TCollection.Create(TTestItem);
+end;
+
+Destructor TCollectionComponent.Destroy;
+
+begin
+  FreeAndNil(FColl);
+  Inherited;
+end;
+
+{ TCollectionComponent2 }
+
+Constructor TCollectionComponent2.Create(AOwner : TComponent);
+
+begin
+  Inherited;
+  (FColl.Add as TTestItem).StrProp:='First';
+  (FColl.Add as TTestItem).StrProp:='Second';
+  (FColl.Add as TTestItem).StrProp:='Third';
+end;
+
+{ TCollectionComponen3 }
+
+Constructor TCollectionComponent3.Create(AOwner : TComponent);
+
+begin
+  Inherited;
+  (FColl.Add as TTestItem).StrProp:='First';
+  (FColl.Add as TTestItem).StrProp:='';
+  (FColl.Add as TTestItem).StrProp:='Third';
+end;
+
+{ TCollectionComponent4 }
+
+constructor TCollectionComponent4.Create(AOwner: TComponent);
+begin
+  inherited;
+  FColl:=TTestCollection.Create;
+  (FColl.Add as TTestItem).StrProp:='Something'
+end;
+
+destructor TCollectionComponent4.Destroy;
+begin
+  FreeAndNil(FColl);
+  inherited;
+end;
+
+procedure TCollectionComponent4.SetColl(AColl: TTestCollection);
+begin
+  FColl.Assign(AColl);
+end;
+
+{ TCollectionComponent5 }
+
+procedure TCollectionComponent5.SetColl(AColl: TCollection);
+begin
+  FColl.Assign(AColl);
+end;
+
+constructor TCollectionComponent5.Create(AOwner: TComponent);
+var
+  Item : TTest2Item;
+begin
+  inherited Create(AOwner);
+  FColl:=TCollection.Create(TTest2Item);
+  Item := FColl.Add as TTest2Item;
+  Item.StrProp1 := 'Something';
+  Item.StrProp2 := 'Otherthing';
+  Item := FColl.Add as TTest2Item;
+  Item.StrProp1 := 'Something 2';
+  Item.StrProp2 := 'Otherthing 2';
+end;
+
+destructor TCollectionComponent5.Destroy;
+begin
+  FreeAndNil(FColl);
+  inherited Destroy;
+end;
+
+{ TTestCollection }
+
+Constructor TTestCollection.Create;
+begin
+  Inherited Create(TTestitem);
+  PropName:='MyCollProp';
+end;
+
+{ TStreamedOwnedComponent }
+
+Constructor TStreamedOwnedComponent.Create(AOwner : TComponent);
+
+begin
+  Inherited;
+  Sub:=TIntegerComponent.Create(Self);
+  Sub.Name:='Sub';
+end;
+
+{ TStreamedOwnedComponents }
+
+constructor TStreamedOwnedComponents.Create(AOwner: TComponent);
+begin
+  inherited;
+  SubA:=TIntegerComponent.Create(Self);
+  SubA.Name:='SubA';
+  SubB:=TStringComponent.Create(Self);
+  SubB.Name:='SubB';
+end;
+
+
+Constructor TOwnedComponent.Create(AOwner : TComponent);
+
+Var
+  C: TComponent;
+
+begin
+  Inherited;
+  C:=TIntegerComponent.Create(Self);
+  C.Name:='SubComponent';
+  CompProp:=C;
+end;
+
+
+{ TMethodComponent }
+
+Constructor TMethodComponent.Create(AOwner : TComponent);
+
+begin
+  Inherited;
+{$ifdef fpc}
+  MethodProp:=@MyMethod;
+{$else}
+  MethodProp:=MyMethod;
+{$endif}
+end;
+
+Procedure TMethodComponent.MyMethod;
+
+begin
+  // Do nothing.
+end;
+
+{ TMethodComponent2 }
+
+constructor TMethodComponent2.Create(AOwner: TComponent);
+
+Var
+  C : TMethodComponent;
+
+begin
+  inherited;
+  C:=TMethodComponent.Create(Self);
+  C.Name:='AComponent';
+{$ifdef fpc}
+  C.MethodProp:=@MyMethod2;
+{$else}
+  C.MethodProp:=MyMethod2;
+{$endif}
+end;
+
+Procedure TMethodComponent2.MyMethod2;
+
+begin
+ // Do nothng
+end;
+
+
+end.

tests/test/units/fpcunit/tstrutils.lpi

@@ -0,0 +1,166 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="/"/>
+    <Version Value="6"/>
+    <General>
+      <MainUnit Value="0"/>
+      <IconPath Value="./"/>
+      <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="--suite=TTestTStringList --format=plain"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="2">
+      <Item1>
+        <PackageName Value="FCL"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="FPCUnitConsoleRunner"/>
+      </Item2>
+    </RequiredPackages>
+    <Units Count="11">
+      <Unit0>
+        <Filename Value="tstrutils.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tstrutils"/>
+        <CursorPos X="37" Y="6"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="6"/>
+        <UsageCount Value="44"/>
+        <Loaded Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="tcstrutils.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tcstrutils"/>
+        <CursorPos X="1" Y="163"/>
+        <TopLine Value="148"/>
+        <EditorIndex Value="0"/>
+        <UsageCount Value="44"/>
+        <Loaded Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="tcstringlist.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tcstringlist"/>
+        <CursorPos X="19" Y="47"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="2"/>
+        <UsageCount Value="44"/>
+        <Loaded Value="True"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="../../../../fpc/packages/fcl-fpcunit/src/fpcunit.pp"/>
+        <UnitName Value="fpcunit"/>
+        <CursorPos X="6" Y="554"/>
+        <TopLine Value="524"/>
+        <UsageCount Value="8"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="../../../../fpc/rtl/objpas/classes/classesh.inc"/>
+        <CursorPos X="1" Y="233"/>
+        <TopLine Value="212"/>
+        <EditorIndex Value="4"/>
+        <UsageCount Value="22"/>
+        <Loaded Value="True"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="searchbuf.inc"/>
+        <CursorPos X="47" Y="117"/>
+        <TopLine Value="65"/>
+        <UsageCount Value="8"/>
+      </Unit5>
+      <Unit6>
+        <Filename Value="tclist.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tclist"/>
+        <CursorPos X="66" Y="341"/>
+        <TopLine Value="346"/>
+        <EditorIndex Value="3"/>
+        <UsageCount Value="44"/>
+        <Loaded Value="True"/>
+      </Unit6>
+      <Unit7>
+        <Filename Value="../../../../fpc/rtl/objpas/classes/resreference.inc"/>
+        <CursorPos X="39" Y="345"/>
+        <TopLine Value="311"/>
+        <UsageCount Value="21"/>
+      </Unit7>
+      <Unit8>
+        <Filename Value="../../../../fpc/rtl/objpas/classes/lists.inc"/>
+        <CursorPos X="20" Y="271"/>
+        <TopLine Value="222"/>
+        <EditorIndex Value="5"/>
+        <UsageCount Value="21"/>
+        <Loaded Value="True"/>
+      </Unit8>
+      <Unit9>
+        <Filename Value="testll.pp"/>
+        <UnitName Value="Testll"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="20"/>
+      </Unit9>
+      <Unit10>
+        <Filename Value="../../../../testsi.pp"/>
+        <UnitName Value="testsi"/>
+        <CursorPos X="1" Y="12"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="1"/>
+        <UsageCount Value="10"/>
+        <Loaded Value="True"/>
+      </Unit10>
+    </Units>
+    <JumpHistory Count="2" HistoryIndex="1">
+      <Position1>
+        <Filename Value="tcstrutils.pp"/>
+        <Caret Line="164" Column="5" TopLine="109"/>
+      </Position1>
+      <Position2>
+        <Filename Value="tcstrutils.pp"/>
+        <Caret Line="163" Column="1" TopLine="161"/>
+      </Position2>
+    </JumpHistory>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <GenerateDebugInfo 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>

tests/test/units/fpcunit/tstrutils.lpr

@@ -0,0 +1,26 @@
+program tstrutils;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, consoletestrunner, tcstrutils, tcstringlist, tclist;
+
+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.