Browse Source

* More tests for classes unit

git-svn-id: branches/cleanroom@9399 -
michael 18 years ago
parent
commit
784511c5e8

+ 5 - 0
.gitattributes

@@ -5523,18 +5523,23 @@ rtl/symbian/uiqclasses.pas -text
 rtl/symbian/uiqinc/qikapplication.inc -text
 rtl/symbian/uiqinc/qikapplicationoo.inc -text
 rtl/tests/fplists.pp svneol=native#text/plain
+rtl/tests/gencomptest.dpr svneol=native#text/plain
 rtl/tests/lists.pp svneol=native#text/plain
 rtl/tests/searchbuf.inc svneol=native#text/plain
 rtl/tests/tccollection.pp svneol=native#text/plain
+rtl/tests/tccomponent.pp svneol=native#text/plain
+rtl/tests/tccompstreaming.pp svneol=native#text/plain
 rtl/tests/tcfindnested.pp svneol=native#text/plain
 rtl/tests/tclinkedlist.pp svneol=native#text/plain
 rtl/tests/tclist.pp svneol=native#text/plain
 rtl/tests/tcpersistent.pp svneol=native#text/plain
+rtl/tests/tcstreaming.pp svneol=native#text/plain
 rtl/tests/tcstringlist.pp svneol=native#text/plain
 rtl/tests/tcstrutils.pp svneol=native#text/plain
 rtl/tests/tctparser.pp svneol=native#text/plain
 rtl/tests/testclasses.lpi svneol=native#text/plain
 rtl/tests/testclasses.lpr svneol=native#text/plain
+rtl/tests/testcomps.inc svneol=native#text/plain
 rtl/tests/tstrutils.lpi svneol=native#text/plain
 rtl/tests/tstrutils.lpr svneol=native#text/plain
 rtl/ucmaps/8859-1.txt svneol=native#text/plain

+ 399 - 0
rtl/tests/gencomptest.dpr

@@ -0,0 +1,399 @@
+program gencomptest;
+
+{$APPTYPE CONSOLE}
+
+uses
+  SysUtils,
+  classes,
+  typinfo;
+
+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);
+            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;
+
+{$i testcomps.inc}
+
+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(TOwnedComponent,Nil);
+  TestComponent(TStreamedOwnedComponent,Nil);
+  TestComponent(TMethodComponent,Nil);
+  TestComponent(TMethodComponent2,Nil);
+end;
+
+
+Procedure GenUnit;
+
+Var
+  I : Integer;
+  F : Text;
+
+begin
+  Assign(f,'tccompstreaming.pp');
+  Rewrite(F);
+  try
+  Writeln(F,'Unit tccompstreaming;');
+  Writeln(F);
+  Writeln(F,'interface');
+  Writeln(F);
+  Writeln(F,'Uses');
+  Writeln(F,'  SysUtils,Classes,tcstreaming, testregistry;');
+  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,'{$i testcomps.inc}');
+  For I:=0 to Src.Count-1 do
+    Writeln(F,Src[i]);
+  Writeln(F);
+  Writeln(F,'begin');
+  Writeln(F,'  RegisterTest(TTestComponentStream);');
+  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.

+ 63 - 0
rtl/tests/tccollection.pp

@@ -45,6 +45,12 @@ type
 
   TTestTCollection= class(TTestCase)
   private
+    procedure AccessNegativeIndex;
+    procedure AccessTooBigIndex;
+    procedure DeleteNegativeIndex;
+    procedure DeleteTooBigIndex;
+    procedure MoveNegativeIndex;
+    procedure MoveTooBigIndex;
   protected
     FColl : TMyCollection;
     Function MyItem(I : integer) : TMyItem;
@@ -68,6 +74,9 @@ type
     Procedure TestItemNamePath;
     Procedure TestOwnerItemNamePath;
     Procedure TestChangeCollection;
+    procedure TestAccesIndexOutOfBounds;
+    procedure TestDeleteIndexOutOfBounds;
+    procedure TestMoveIndexOutOfBounds;
     Procedure TestUpdateAdd;
     Procedure TestUpdateDelete;
     Procedure TestUpdateDisplayName;
@@ -257,6 +266,60 @@ begin
   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);

+ 438 - 0
rtl/tests/tccomponent.pp

@@ -0,0 +1,438 @@
+unit tccomponent;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, 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:=Nil
+  else
+    Result:=TNotification(FEvents.Items[Index]);
+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
+  C : TComponent;
+  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.
+

+ 949 - 0
rtl/tests/tccompstreaming.pp

@@ -0,0 +1,949 @@
+Unit tccompstreaming;
+
+interface
+
+Uses
+  SysUtils, Classes, tcstreaming, testregistry;
+
+Type 
+  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 TestTSetComponent;
+    Procedure TestTSetComponent2;
+    Procedure TestTSetComponent3;
+    Procedure TestTSetComponent4;
+    Procedure TestTMultipleComponent;
+    Procedure TestTPersistentComponent;
+    Procedure TestTOwnedComponent;
+    Procedure TestTStreamedOwnedComponent;
+    Procedure TestTMethodComponent;
+    Procedure TestTMethodComponent2;
+  end;
+
+Implementation
+
+{$i testcomps.inc}
+
+
+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');
+    ExpectBareString('Dice');
+    ExpectIdent('one');
+    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.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');
+    ExpectBareString('Throw');
+    ExpectValue(vaSet);
+    ExpectBareString('');
+    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.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;
+  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;
+
+begin
+  RegisterTest(TTestComponentStream);
+end.

+ 407 - 0
rtl/tests/tcstreaming.pp

@@ -0,0 +1,407 @@
+{$mode objfpc}
+{$h+}
+unit tcstreaming;
+
+interface
+
+Uses
+  SysUtils,Classes, fpcunit, testutils, testregistry;
+
+Type
+  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;
+  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;
+begin
+  FStream.Read(Result,SizeOf(Result));
+end;
+
+procedure TTestStreaming.Setup;
+begin
+  FStream:=TMemoryStream.Create;
+end;
+
+procedure TTestStreaming.SaveToStream(C: TComponent);
+begin
+  C.Name:='Test'+C.ClassName;
+  FStream.Clear;
+  FStream.WriteComponent(C);
+  FStream.Position:=0;
+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;
+
+end.

+ 84 - 125
rtl/tests/testclasses.lpi

@@ -7,13 +7,11 @@
       <MainUnit Value="0"/>
       <IconPath Value="./"/>
       <TargetFileExt Value=""/>
-      <Title Value="findnested"/>
-      <ActiveEditorIndexAtStart Value="2"/>
+      <Title Value="Test classes"/>
+      <ActiveEditorIndexAtStart Value="5"/>
     </General>
     <VersionInfo>
       <ProjectVersion Value=""/>
-      <Language Value=""/>
-      <CharSet Value=""/>
     </VersionInfo>
     <PublishOptions>
       <Version Value="2"/>
@@ -35,12 +33,12 @@
         <PackageName Value="FPCUnitConsoleRunner"/>
       </Item2>
     </RequiredPackages>
-    <Units Count="9">
+    <Units Count="15">
       <Unit0>
         <Filename Value="testclasses.lpr"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="testclasses"/>
-        <UsageCount Value="20"/>
+        <UsageCount Value="21"/>
       </Unit0>
       <Unit1>
         <Filename Value="tcfindnested.pp"/>
@@ -49,41 +47,41 @@
         <CursorPos X="1" Y="91"/>
         <TopLine Value="61"/>
         <EditorIndex Value="0"/>
-        <UsageCount Value="20"/>
+        <UsageCount Value="21"/>
         <Loaded Value="True"/>
       </Unit1>
       <Unit2>
         <Filename Value="tcstringlist.pp"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="tcstringlist"/>
-        <UsageCount Value="20"/>
+        <UsageCount Value="21"/>
         <SyntaxHighlighter Value="Text"/>
       </Unit2>
       <Unit3>
         <Filename Value="tccollection.pp"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="tccollection"/>
-        <CursorPos X="1" Y="360"/>
-        <TopLine Value="338"/>
+        <CursorPos X="24" Y="66"/>
+        <TopLine Value="52"/>
         <EditorIndex Value="2"/>
-        <UsageCount Value="20"/>
+        <UsageCount Value="21"/>
         <Loaded Value="True"/>
       </Unit3>
       <Unit4>
         <Filename Value="tclist.pp"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="tclist"/>
-        <CursorPos X="1" Y="336"/>
-        <TopLine Value="331"/>
-        <EditorIndex Value="4"/>
-        <UsageCount Value="20"/>
+        <CursorPos X="1" Y="253"/>
+        <TopLine Value="203"/>
+        <EditorIndex Value="7"/>
+        <UsageCount Value="21"/>
         <Loaded Value="True"/>
       </Unit4>
       <Unit5>
         <Filename Value="tcpersistent.pp"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="tcpersistent"/>
-        <UsageCount Value="20"/>
+        <UsageCount Value="21"/>
         <SyntaxHighlighter Value="Text"/>
       </Unit5>
       <Unit6>
@@ -93,14 +91,14 @@
         <CursorPos X="14" Y="1"/>
         <TopLine Value="1"/>
         <EditorIndex Value="1"/>
-        <UsageCount Value="20"/>
+        <UsageCount Value="21"/>
         <Loaded Value="True"/>
       </Unit6>
       <Unit7>
         <Filename Value="../../../../fpc/rtl/objpas/classes/classesh.inc"/>
-        <CursorPos X="14" Y="432"/>
-        <TopLine Value="401"/>
-        <EditorIndex Value="3"/>
+        <CursorPos X="1" Y="1430"/>
+        <TopLine Value="1402"/>
+        <EditorIndex Value="6"/>
         <UsageCount Value="10"/>
         <Loaded Value="True"/>
       </Unit7>
@@ -108,132 +106,93 @@
         <Filename Value="../../../../fpc/rtl/objpas/classes/collect.inc"/>
         <CursorPos X="51" Y="319"/>
         <TopLine Value="293"/>
-        <EditorIndex Value="5"/>
+        <EditorIndex Value="8"/>
         <UsageCount Value="10"/>
         <Loaded Value="True"/>
       </Unit8>
+      <Unit9>
+        <Filename Value="tccomponent.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tccomponent"/>
+        <CursorPos X="1" Y="260"/>
+        <TopLine Value="236"/>
+        <EditorIndex Value="3"/>
+        <UsageCount Value="21"/>
+        <Loaded Value="True"/>
+      </Unit9>
+      <Unit10>
+        <Filename Value="../../../../fpc/packages/fcl-fpcunit/src/fpcunit.pp"/>
+        <UnitName Value="fpcunit"/>
+        <CursorPos X="27" Y="111"/>
+        <TopLine Value="94"/>
+        <EditorIndex Value="5"/>
+        <UsageCount Value="10"/>
+        <Loaded Value="True"/>
+      </Unit10>
+      <Unit11>
+        <Filename Value="tcstreaming.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tcstreaming"/>
+        <CursorPos X="1" Y="337"/>
+        <TopLine Value="312"/>
+        <EditorIndex Value="4"/>
+        <UsageCount Value="20"/>
+        <Loaded Value="True"/>
+      </Unit11>
+      <Unit12>
+        <Filename Value="tccompstreaming.pas"/>
+        <UnitName Value="tctestcompstreaming"/>
+        <CursorPos X="51" Y="4"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="20"/>
+      </Unit12>
+      <Unit13>
+        <Filename Value="testcomps.inc"/>
+        <IsPartOfProject Value="True"/>
+        <UsageCount Value="20"/>
+        <SyntaxHighlighter Value="Text"/>
+      </Unit13>
+      <Unit14>
+        <Filename Value="tccompstreaming.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tccompstreaming"/>
+        <UsageCount Value="20"/>
+        <SyntaxHighlighter Value="Text"/>
+      </Unit14>
     </Units>
-    <JumpHistory Count="30" HistoryIndex="29">
+    <JumpHistory Count="8" HistoryIndex="7">
       <Position1>
-        <Filename Value="../../../../fpc/rtl/objpas/classes/collect.inc"/>
+        <Filename Value="tcstreaming.pp"/>
         <Caret Line="1" Column="1" TopLine="1"/>
       </Position1>
       <Position2>
-        <Filename Value="../../../../fpc/rtl/objpas/classes/collect.inc"/>
-        <Caret Line="51" Column="24" TopLine="22"/>
+        <Filename Value="tcstreaming.pp"/>
+        <Caret Line="8" Column="20" TopLine="1"/>
       </Position2>
       <Position3>
-        <Filename Value="../../../../fpc/rtl/objpas/classes/collect.inc"/>
-        <Caret Line="218" Column="12" TopLine="192"/>
+        <Filename Value="tcstreaming.pp"/>
+        <Caret Line="66" Column="1" TopLine="30"/>
       </Position3>
       <Position4>
-        <Filename Value="../../../../fpc/rtl/objpas/classes/collect.inc"/>
-        <Caret Line="240" Column="30" TopLine="214"/>
+        <Filename Value="tcstreaming.pp"/>
+        <Caret Line="63" Column="13" TopLine="37"/>
       </Position4>
       <Position5>
-        <Filename Value="../../../../fpc/rtl/objpas/classes/collect.inc"/>
-        <Caret Line="1" Column="1" TopLine="1"/>
+        <Filename Value="tcstreaming.pp"/>
+        <Caret Line="21" Column="67" TopLine="1"/>
       </Position5>
       <Position6>
-        <Filename Value="../../../../fpc/rtl/objpas/classes/collect.inc"/>
-        <Caret Line="42" Column="32" TopLine="22"/>
+        <Filename Value="tcstreaming.pp"/>
+        <Caret Line="65" Column="46" TopLine="38"/>
       </Position6>
       <Position7>
-        <Filename Value="../../../../fpc/rtl/objpas/classes/collect.inc"/>
-        <Caret Line="48" Column="24" TopLine="22"/>
+        <Filename Value="tcstreaming.pp"/>
+        <Caret Line="124" Column="12" TopLine="99"/>
       </Position7>
       <Position8>
-        <Filename Value="../../../../fpc/rtl/objpas/classes/collect.inc"/>
-        <Caret Line="50" Column="24" TopLine="24"/>
+        <Filename Value="tcstreaming.pp"/>
+        <Caret Line="131" Column="53" TopLine="106"/>
       </Position8>
-      <Position9>
-        <Filename Value="../../../../fpc/rtl/objpas/classes/collect.inc"/>
-        <Caret Line="218" Column="12" TopLine="192"/>
-      </Position9>
-      <Position10>
-        <Filename Value="../../../../fpc/rtl/objpas/classes/collect.inc"/>
-        <Caret Line="240" Column="30" TopLine="214"/>
-      </Position10>
-      <Position11>
-        <Filename Value="../../../../fpc/rtl/objpas/classes/collect.inc"/>
-        <Caret Line="1" Column="1" TopLine="1"/>
-      </Position11>
-      <Position12>
-        <Filename Value="../../../../fpc/rtl/objpas/classes/collect.inc"/>
-        <Caret Line="43" Column="34" TopLine="16"/>
-      </Position12>
-      <Position13>
-        <Filename Value="../../../../fpc/rtl/objpas/classes/collect.inc"/>
-        <Caret Line="91" Column="12" TopLine="65"/>
-      </Position13>
-      <Position14>
-        <Filename Value="../../../../fpc/rtl/objpas/classes/collect.inc"/>
-        <Caret Line="99" Column="10" TopLine="73"/>
-      </Position14>
-      <Position15>
-        <Filename Value="../../../../fpc/rtl/objpas/classes/collect.inc"/>
-        <Caret Line="29" Column="27" TopLine="14"/>
-      </Position15>
-      <Position16>
-        <Filename Value="../../../../fpc/rtl/objpas/classes/collect.inc"/>
-        <Caret Line="1" Column="1" TopLine="1"/>
-      </Position16>
-      <Position17>
-        <Filename Value="tccollection.pp"/>
-        <Caret Line="289" Column="5" TopLine="232"/>
-      </Position17>
-      <Position18>
-        <Filename Value="tccollection.pp"/>
-        <Caret Line="299" Column="14" TopLine="271"/>
-      </Position18>
-      <Position19>
-        <Filename Value="tccollection.pp"/>
-        <Caret Line="71" Column="1" TopLine="49"/>
-      </Position19>
-      <Position20>
-        <Filename Value="tccollection.pp"/>
-        <Caret Line="297" Column="50" TopLine="278"/>
-      </Position20>
-      <Position21>
-        <Filename Value="tccollection.pp"/>
-        <Caret Line="333" Column="5" TopLine="276"/>
-      </Position21>
-      <Position22>
-        <Filename Value="tccollection.pp"/>
-        <Caret Line="350" Column="5" TopLine="288"/>
-      </Position22>
-      <Position23>
-        <Filename Value="tccollection.pp"/>
-        <Caret Line="348" Column="71" TopLine="316"/>
-      </Position23>
-      <Position24>
-        <Filename Value="tccollection.pp"/>
-        <Caret Line="345" Column="28" TopLine="319"/>
-      </Position24>
-      <Position25>
-        <Filename Value="tccollection.pp"/>
-        <Caret Line="355" Column="18" TopLine="322"/>
-      </Position25>
-      <Position26>
-        <Filename Value="tccollection.pp"/>
-        <Caret Line="361" Column="22" TopLine="329"/>
-      </Position26>
-      <Position27>
-        <Filename Value="tccollection.pp"/>
-        <Caret Line="364" Column="45" TopLine="334"/>
-      </Position27>
-      <Position28>
-        <Filename Value="../../../../fpc/rtl/objpas/classes/collect.inc"/>
-        <Caret Line="195" Column="3" TopLine="192"/>
-      </Position28>
-      <Position29>
-        <Filename Value="../../../../fpc/rtl/objpas/classes/collect.inc"/>
-        <Caret Line="1" Column="1" TopLine="1"/>
-      </Position29>
-      <Position30>
-        <Filename Value="../../../../fpc/rtl/objpas/classes/collect.inc"/>
-        <Caret Line="176" Column="33" TopLine="150"/>
-      </Position30>
     </JumpHistory>
   </ProjectOptions>
   <CompilerOptions>

+ 2 - 2
rtl/tests/testclasses.lpr

@@ -4,7 +4,7 @@ program testclasses;
 
 uses
   Classes, consoletestrunner, tcfindnested, tcstringlist, tccollection, tclist,
-  tcpersistent, tclinkedlist;
+  tcpersistent, tclinkedlist, tccomponent, tcstreaming, tccompstreaming;
 
 type
 
@@ -21,7 +21,7 @@ var
 begin
   Application := TMyTestRunner.Create(nil);
   Application.Initialize;
-  Application.Title := 'FPCUnit Console test runner';
+  Application.Title:='Test classes';
   Application.Run;
   Application.Free;
 end.

+ 726 - 0
rtl/tests/testcomps.inc

@@ -0,0 +1,726 @@
+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;
+
+  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;
+  Published
+    Property Persist : TTestPersistent1 Read FPers Write SetPers;
+  end;
+
+  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;
+
+  TStreamedOwnedComponent = Class(TChildrenComponent)
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Sub : TIntegerComponent;
+  end;
+
+  THandler = Procedure of Object;
+
+  TMethodComponent = Class(TComponent)
+  Private
+    F : THandler;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Procedure MyMethod;
+    Property MethodProp : THandler Read F Write F;
+  end;
+
+  TMethodComponent2 = Class(TChildrenComponent)
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Procedure MyMethod2;
+  end;
+
+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
+  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;
+
+procedure TPersistentComponent.SetPers(const Value: TTestPersistent1);
+begin
+  FPers.Assign(Value);
+end;
+
+Constructor TStreamedOwnedComponent.Create(AOwner : TComponent);
+
+begin
+  Inherited;
+  Sub:=TIntegerComponent.Create(Self);
+  Sub.Name:='Sub';
+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;
+