Browse Source

* Additional tests for reference resolving and TList.Assign

git-svn-id: branches/cleanroom@9567 -
michael 18 years ago
parent
commit
9121ec9844
7 changed files with 1412 additions and 79 deletions
  1. 3 0
      .gitattributes
  2. 446 0
      rtl/tests/resref.inc
  3. 117 0
      rtl/tests/sllist.inc
  4. 206 8
      rtl/tests/tclist.pp
  5. 536 0
      rtl/tests/tcresref.pp
  6. 102 70
      rtl/tests/testclasses.lpi
  7. 2 1
      rtl/tests/testclasses.lpr

+ 3 - 0
.gitattributes

@@ -5527,7 +5527,9 @@ rtl/symbian/uiqinc/qikapplicationoo.inc -text
 rtl/tests/fplists.pp svneol=native#text/plain
 rtl/tests/fplists.pp svneol=native#text/plain
 rtl/tests/gencomptest.dpr svneol=native#text/plain
 rtl/tests/gencomptest.dpr svneol=native#text/plain
 rtl/tests/lists.pp svneol=native#text/plain
 rtl/tests/lists.pp svneol=native#text/plain
+rtl/tests/resref.inc svneol=native#text/plain
 rtl/tests/searchbuf.inc svneol=native#text/plain
 rtl/tests/searchbuf.inc svneol=native#text/plain
+rtl/tests/sllist.inc svneol=native#text/plain
 rtl/tests/tccollection.pp svneol=native#text/plain
 rtl/tests/tccollection.pp svneol=native#text/plain
 rtl/tests/tccomponent.pp svneol=native#text/plain
 rtl/tests/tccomponent.pp svneol=native#text/plain
 rtl/tests/tccompstreaming.pp svneol=native#text/plain
 rtl/tests/tccompstreaming.pp svneol=native#text/plain
@@ -5535,6 +5537,7 @@ rtl/tests/tcfindnested.pp svneol=native#text/plain
 rtl/tests/tclinkedlist.pp svneol=native#text/plain
 rtl/tests/tclinkedlist.pp svneol=native#text/plain
 rtl/tests/tclist.pp svneol=native#text/plain
 rtl/tests/tclist.pp svneol=native#text/plain
 rtl/tests/tcpersistent.pp svneol=native#text/plain
 rtl/tests/tcpersistent.pp svneol=native#text/plain
+rtl/tests/tcresref.pp svneol=native#text/plain
 rtl/tests/tcstreaming.pp svneol=native#text/plain
 rtl/tests/tcstreaming.pp svneol=native#text/plain
 rtl/tests/tcstringlist.pp svneol=native#text/plain
 rtl/tests/tcstringlist.pp svneol=native#text/plain
 rtl/tests/tcstrutils.pp svneol=native#text/plain
 rtl/tests/tcstrutils.pp svneol=native#text/plain

+ 446 - 0
rtl/tests/resref.inc

@@ -0,0 +1,446 @@
+
+
+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
+    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 }
+
+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);
+    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;

+ 117 - 0
rtl/tests/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;
+

+ 206 - 8
rtl/tests/tclist.pp

@@ -26,10 +26,14 @@ type
     procedure Shuffle;
     procedure Shuffle;
   protected
   protected
     List : TList;
     List : TList;
+    List2 : TList;
+    List3 : TList;
     Pointers : Packed Array[0..20] of Byte;
     Pointers : Packed Array[0..20] of Byte;
-    procedure SetUp; override; 
+    procedure SetUp; override;
     procedure TearDown; override; 
     procedure TearDown; override; 
-    Procedure FillList(ACount : Integer);
+    Procedure FillList(ACount : Integer); overload;
+    Procedure FillList(AList : TList; AOffSet, ACount : Integer); overload;
+    procedure HavePointer(I: Integer);
   published
   published
     procedure TestCreate;
     procedure TestCreate;
     procedure TestAdd;
     procedure TestAdd;
@@ -54,6 +58,18 @@ type
     Procedure TestNotifyDelete;
     Procedure TestNotifyDelete;
     Procedure TestNotifyExtract;
     Procedure TestNotifyExtract;
     Procedure TestPack;
     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;
   end;
 
 
   { TMyList }
   { TMyList }
@@ -63,6 +79,7 @@ type
     FLastPointer : Pointer;
     FLastPointer : Pointer;
     FLastAction : TListNotification;
     FLastAction : TListNotification;
   end;
   end;
+  
 
 
 implementation
 implementation
 
 
@@ -75,6 +92,8 @@ Var
 
 
 begin
 begin
   List:=TMyList.Create;
   List:=TMyList.Create;
+  List2:=TMyList.Create;
+  List3:=TMyList.Create;
   For I:=0 to 20 do
   For I:=0 to 20 do
     Pointers[i]:=I; // Zero serves as sentinel.
     Pointers[i]:=I; // Zero serves as sentinel.
 end; 
 end; 
@@ -82,6 +101,27 @@ end;
 procedure TTestTList.TearDown; 
 procedure TTestTList.TearDown; 
 begin
 begin
   FreeAndNil(List);
   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
+    List.Add(@Pointers[i]);
 end;
 end;
 
 
 procedure TTestTList.TestCreate;
 procedure TTestTList.TestCreate;
@@ -369,19 +409,177 @@ begin
   AssertEquals('Packed list[6] is @pointer[9]',@pointers[9],List[6]);
   AssertEquals('Packed list[6] is @pointer[9]',@pointers[9],List[6]);
 end;
 end;
 
 
+procedure TTestTList.TestAssignCopy;
 
 
-procedure TTestTList.FillList(ACount: Integer);
+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
 Var
-  I : integer;
+  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
 begin
-  If ACount>20 then
-    Fail('Too many elements added to list. Max is 20');
-  For I:=1 to ACount do
-    List.Add(@Pointers[i]);
+  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;
 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 }
 { TMyList }
 
 
 procedure TMyList.Notify(Ptr: Pointer; Action: TListNotification);
 procedure TMyList.Notify(Ptr: Pointer; Action: TListNotification);

+ 536 - 0
rtl/tests/tcresref.pp

@@ -0,0 +1,536 @@
+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);
+end.
+

+ 102 - 70
rtl/tests/testclasses.lpi

@@ -8,7 +8,7 @@
       <IconPath Value="./"/>
       <IconPath Value="./"/>
       <TargetFileExt Value=""/>
       <TargetFileExt Value=""/>
       <Title Value="Test classes"/>
       <Title Value="Test classes"/>
-      <ActiveEditorIndexAtStart Value="5"/>
+      <ActiveEditorIndexAtStart Value="4"/>
     </General>
     </General>
     <VersionInfo>
     <VersionInfo>
       <ProjectVersion Value=""/>
       <ProjectVersion Value=""/>
@@ -22,39 +22,40 @@
     <RunParams>
     <RunParams>
       <local>
       <local>
         <FormatVersion Value="1"/>
         <FormatVersion Value="1"/>
+        <CommandLineParams Value="--format=plain --suite=TTestResolveReference"/>
         <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
         <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
       </local>
     </RunParams>
     </RunParams>
     <RequiredPackages Count="2">
     <RequiredPackages Count="2">
       <Item1>
       <Item1>
-        <PackageName Value="FCL"/>
+        <PackageName Value="FPCUnitConsoleRunner"/>
       </Item1>
       </Item1>
       <Item2>
       <Item2>
-        <PackageName Value="FPCUnitConsoleRunner"/>
+        <PackageName Value="FCL"/>
       </Item2>
       </Item2>
     </RequiredPackages>
     </RequiredPackages>
-    <Units Count="15">
+    <Units Count="21">
       <Unit0>
       <Unit0>
         <Filename Value="testclasses.lpr"/>
         <Filename Value="testclasses.lpr"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="testclasses"/>
         <UnitName Value="testclasses"/>
-        <UsageCount Value="21"/>
+        <UsageCount Value="221"/>
       </Unit0>
       </Unit0>
       <Unit1>
       <Unit1>
         <Filename Value="tcfindnested.pp"/>
         <Filename Value="tcfindnested.pp"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="tcfindnested"/>
         <UnitName Value="tcfindnested"/>
-        <CursorPos X="1" Y="91"/>
-        <TopLine Value="61"/>
+        <CursorPos X="13" Y="116"/>
+        <TopLine Value="66"/>
         <EditorIndex Value="0"/>
         <EditorIndex Value="0"/>
-        <UsageCount Value="21"/>
+        <UsageCount Value="221"/>
         <Loaded Value="True"/>
         <Loaded Value="True"/>
       </Unit1>
       </Unit1>
       <Unit2>
       <Unit2>
         <Filename Value="tcstringlist.pp"/>
         <Filename Value="tcstringlist.pp"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="tcstringlist"/>
         <UnitName Value="tcstringlist"/>
-        <UsageCount Value="21"/>
+        <UsageCount Value="221"/>
         <SyntaxHighlighter Value="Text"/>
         <SyntaxHighlighter Value="Text"/>
       </Unit2>
       </Unit2>
       <Unit3>
       <Unit3>
@@ -63,51 +64,49 @@
         <UnitName Value="tccollection"/>
         <UnitName Value="tccollection"/>
         <CursorPos X="24" Y="66"/>
         <CursorPos X="24" Y="66"/>
         <TopLine Value="52"/>
         <TopLine Value="52"/>
-        <EditorIndex Value="2"/>
-        <UsageCount Value="21"/>
+        <EditorIndex Value="3"/>
+        <UsageCount Value="221"/>
         <Loaded Value="True"/>
         <Loaded Value="True"/>
       </Unit3>
       </Unit3>
       <Unit4>
       <Unit4>
         <Filename Value="tclist.pp"/>
         <Filename Value="tclist.pp"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="tclist"/>
         <UnitName Value="tclist"/>
-        <CursorPos X="1" Y="253"/>
-        <TopLine Value="203"/>
-        <EditorIndex Value="7"/>
-        <UsageCount Value="21"/>
+        <CursorPos X="1" Y="37"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="4"/>
+        <UsageCount Value="221"/>
         <Loaded Value="True"/>
         <Loaded Value="True"/>
       </Unit4>
       </Unit4>
       <Unit5>
       <Unit5>
         <Filename Value="tcpersistent.pp"/>
         <Filename Value="tcpersistent.pp"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="tcpersistent"/>
         <UnitName Value="tcpersistent"/>
-        <UsageCount Value="21"/>
+        <UsageCount Value="221"/>
         <SyntaxHighlighter Value="Text"/>
         <SyntaxHighlighter Value="Text"/>
       </Unit5>
       </Unit5>
       <Unit6>
       <Unit6>
         <Filename Value="tclinkedlist.pp"/>
         <Filename Value="tclinkedlist.pp"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="tclinkedlist"/>
         <UnitName Value="tclinkedlist"/>
-        <CursorPos X="14" Y="1"/>
-        <TopLine Value="1"/>
-        <EditorIndex Value="1"/>
-        <UsageCount Value="21"/>
+        <CursorPos X="22" Y="209"/>
+        <TopLine Value="176"/>
+        <EditorIndex Value="2"/>
+        <UsageCount Value="221"/>
         <Loaded Value="True"/>
         <Loaded Value="True"/>
       </Unit6>
       </Unit6>
       <Unit7>
       <Unit7>
         <Filename Value="../../../../fpc/rtl/objpas/classes/classesh.inc"/>
         <Filename Value="../../../../fpc/rtl/objpas/classes/classesh.inc"/>
-        <CursorPos X="1" Y="1430"/>
-        <TopLine Value="1402"/>
-        <EditorIndex Value="6"/>
-        <UsageCount Value="10"/>
-        <Loaded Value="True"/>
+        <CursorPos X="15" Y="195"/>
+        <TopLine Value="154"/>
+        <UsageCount Value="80"/>
       </Unit7>
       </Unit7>
       <Unit8>
       <Unit8>
         <Filename Value="../../../../fpc/rtl/objpas/classes/collect.inc"/>
         <Filename Value="../../../../fpc/rtl/objpas/classes/collect.inc"/>
         <CursorPos X="51" Y="319"/>
         <CursorPos X="51" Y="319"/>
         <TopLine Value="293"/>
         <TopLine Value="293"/>
-        <EditorIndex Value="8"/>
-        <UsageCount Value="10"/>
+        <EditorIndex Value="6"/>
+        <UsageCount Value="110"/>
         <Loaded Value="True"/>
         <Loaded Value="True"/>
       </Unit8>
       </Unit8>
       <Unit9>
       <Unit9>
@@ -116,83 +115,116 @@
         <UnitName Value="tccomponent"/>
         <UnitName Value="tccomponent"/>
         <CursorPos X="1" Y="260"/>
         <CursorPos X="1" Y="260"/>
         <TopLine Value="236"/>
         <TopLine Value="236"/>
-        <EditorIndex Value="3"/>
-        <UsageCount Value="21"/>
-        <Loaded Value="True"/>
+        <UsageCount Value="221"/>
       </Unit9>
       </Unit9>
       <Unit10>
       <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"/>
         <Filename Value="tcstreaming.pp"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="tcstreaming"/>
         <UnitName Value="tcstreaming"/>
         <CursorPos X="1" Y="337"/>
         <CursorPos X="1" Y="337"/>
         <TopLine Value="312"/>
         <TopLine Value="312"/>
-        <EditorIndex Value="4"/>
-        <UsageCount Value="20"/>
-        <Loaded Value="True"/>
-      </Unit11>
-      <Unit12>
+        <UsageCount Value="220"/>
+      </Unit10>
+      <Unit11>
         <Filename Value="tccompstreaming.pas"/>
         <Filename Value="tccompstreaming.pas"/>
         <UnitName Value="tctestcompstreaming"/>
         <UnitName Value="tctestcompstreaming"/>
         <CursorPos X="51" Y="4"/>
         <CursorPos X="51" Y="4"/>
         <TopLine Value="1"/>
         <TopLine Value="1"/>
-        <UsageCount Value="20"/>
-      </Unit12>
-      <Unit13>
+        <UsageCount Value="10"/>
+      </Unit11>
+      <Unit12>
         <Filename Value="testcomps.inc"/>
         <Filename Value="testcomps.inc"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
-        <UsageCount Value="20"/>
+        <UsageCount Value="220"/>
         <SyntaxHighlighter Value="Text"/>
         <SyntaxHighlighter Value="Text"/>
-      </Unit13>
-      <Unit14>
+      </Unit12>
+      <Unit13>
         <Filename Value="tccompstreaming.pp"/>
         <Filename Value="tccompstreaming.pp"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="tccompstreaming"/>
         <UnitName Value="tccompstreaming"/>
-        <UsageCount Value="20"/>
+        <UsageCount Value="220"/>
         <SyntaxHighlighter Value="Text"/>
         <SyntaxHighlighter Value="Text"/>
+      </Unit13>
+      <Unit14>
+        <Filename Value="tcresref.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tcresref"/>
+        <CursorPos X="14" Y="524"/>
+        <TopLine Value="483"/>
+        <EditorIndex Value="1"/>
+        <UsageCount Value="220"/>
+        <Loaded Value="True"/>
       </Unit14>
       </Unit14>
+      <Unit15>
+        <Filename Value="sllist.inc"/>
+        <IsPartOfProject Value="True"/>
+        <UsageCount Value="220"/>
+        <SyntaxHighlighter Value="Text"/>
+      </Unit15>
+      <Unit16>
+        <Filename Value="resref.inc"/>
+        <IsPartOfProject Value="True"/>
+        <CursorPos X="11" Y="28"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="220"/>
+      </Unit16>
+      <Unit17>
+        <Filename Value="../../../../fpc/rtl/objpas/classes/classes.inc"/>
+        <CursorPos X="3" Y="933"/>
+        <TopLine Value="930"/>
+        <UsageCount Value="80"/>
+      </Unit17>
+      <Unit18>
+        <Filename Value="../objpas/classes/reader.inc"/>
+        <CursorPos X="16" Y="1108"/>
+        <TopLine Value="1093"/>
+        <UsageCount Value="80"/>
+      </Unit18>
+      <Unit19>
+        <Filename Value="../../../../fpc/rtl/objpas/classes/lists.inc"/>
+        <CursorPos X="3" Y="1"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="10"/>
+      </Unit19>
+      <Unit20>
+        <Filename Value="../../../../tclist.pas"/>
+        <UnitName Value="tclist"/>
+        <CursorPos X="1" Y="40"/>
+        <TopLine Value="18"/>
+        <EditorIndex Value="5"/>
+        <UsageCount Value="10"/>
+        <Loaded Value="True"/>
+      </Unit20>
     </Units>
     </Units>
-    <JumpHistory Count="8" HistoryIndex="7">
+    <JumpHistory Count="7" HistoryIndex="6">
       <Position1>
       <Position1>
-        <Filename Value="tcstreaming.pp"/>
-        <Caret Line="1" Column="1" TopLine="1"/>
+        <Filename Value="tclist.pp"/>
+        <Caret Line="355" Column="10" TopLine="355"/>
       </Position1>
       </Position1>
       <Position2>
       <Position2>
-        <Filename Value="tcstreaming.pp"/>
-        <Caret Line="8" Column="20" TopLine="1"/>
+        <Filename Value="tclist.pp"/>
+        <Caret Line="60" Column="5" TopLine="26"/>
       </Position2>
       </Position2>
       <Position3>
       <Position3>
-        <Filename Value="tcstreaming.pp"/>
-        <Caret Line="66" Column="1" TopLine="30"/>
+        <Filename Value="../../../../tclist.pas"/>
+        <Caret Line="356" Column="1" TopLine="309"/>
       </Position3>
       </Position3>
       <Position4>
       <Position4>
-        <Filename Value="tcstreaming.pp"/>
-        <Caret Line="63" Column="13" TopLine="37"/>
+        <Filename Value="tclist.pp"/>
+        <Caret Line="617" Column="1" TopLine="567"/>
       </Position4>
       </Position4>
       <Position5>
       <Position5>
-        <Filename Value="tcstreaming.pp"/>
-        <Caret Line="21" Column="67" TopLine="1"/>
+        <Filename Value="tclist.pp"/>
+        <Caret Line="51" Column="1" TopLine="51"/>
       </Position5>
       </Position5>
       <Position6>
       <Position6>
-        <Filename Value="tcstreaming.pp"/>
-        <Caret Line="65" Column="46" TopLine="38"/>
+        <Filename Value="tclist.pp"/>
+        <Caret Line="411" Column="1" TopLine="409"/>
       </Position6>
       </Position6>
       <Position7>
       <Position7>
-        <Filename Value="tcstreaming.pp"/>
-        <Caret Line="124" Column="12" TopLine="99"/>
+        <Filename Value="tclist.pp"/>
+        <Caret Line="433" Column="16" TopLine="408"/>
       </Position7>
       </Position7>
-      <Position8>
-        <Filename Value="tcstreaming.pp"/>
-        <Caret Line="131" Column="53" TopLine="106"/>
-      </Position8>
     </JumpHistory>
     </JumpHistory>
   </ProjectOptions>
   </ProjectOptions>
   <CompilerOptions>
   <CompilerOptions>

+ 2 - 1
rtl/tests/testclasses.lpr

@@ -4,7 +4,8 @@ program testclasses;
 
 
 uses
 uses
   Classes, tcfindnested, tcstringlist, tccollection, tclist,
   Classes, tcfindnested, tcstringlist, tccollection, tclist,
-  tcpersistent, tclinkedlist, tccomponent, tcstreaming, tccompstreaming,consoletestrunner;
+  tcpersistent, tclinkedlist, tccomponent, tcstreaming, tccompstreaming,consoletestrunner,
+  tcresref;
 
 
 type
 type