* Patch from Michal Gawrycki to implement streaming interface properties (IComponent) Bug ID

git-svn-id: trunk@35474 -

rtl/objpas/classes/reader.inc

@@ -722,7 +722,10 @@ begin
         FOnReferenceName(Self,Ref);
       C:=FindNestedComponent(R.FRoot,Ref);
       If Assigned(C) then
-        SetObjectProp(R.FInstance,R.FPropInfo,C)
+        if R.FPropInfo^.PropType^.Kind = tkInterface then
+          SetInterfaceProp(R.FInstance,R.FPropInfo,C)
+        else
+          SetObjectProp(R.FInstance,R.FPropInfo,C)
       else
         begin
         P:=Pos('.',R.FRelative);
@@ -1256,6 +1259,8 @@ begin
 
         if PropInfo^.PropType^.Kind = tkClass then
           Obj := TObject(GetObjectProp(Instance, PropInfo))
+        //else if PropInfo^.PropType^.Kind = tkInterface then
+        //  Obj := TObject(GetInterfaceProp(Instance, PropInfo))
         else
           Obj := nil;
 
@@ -1385,7 +1390,7 @@ begin
       begin
         SetVariantProp(Instance,PropInfo,ReadVariant);
       end;
-    tkClass:
+    tkClass, tkInterface:
       case FDriver.NextValue of
         vaNil:
           begin

rtl/objpas/classes/writer.inc

@@ -874,6 +874,8 @@ var
   VarValue, DefVarValue : tvardata;
   BoolValue, DefBoolValue: boolean;
   Handled: Boolean;
+  IntfValue: IInterface;
+  CompRef: IInterfaceComponentReference;
 
 begin
   // do not stream properties without getter
@@ -1181,6 +1183,79 @@ begin
           Driver.EndProperty;
           end;
       end;
+    tkInterface:
+      begin
+        IntfValue := GetInterfaceProp(Instance, PropInfo);
+        if Assigned(IntfValue) and Supports(IntfValue, IInterfaceComponentReference, CompRef) then
+          begin
+          Component := CompRef.GetComponent;
+          if HasAncestor then
+          begin
+            AncestorObj := TObject(GetObjectProp(Ancestor, PropInfo));
+            if (AncestorObj is TComponent) then
+            begin
+              //writeln('TWriter.WriteProperty AncestorObj=',TComponent(AncestorObj).Name,' OwnerFit=',TComponent(AncestorObj).Owner = FRootAncestor,' ',TComponent(ObjValue).Name,' OwnerFit=',TComponent(ObjValue).Owner = Root);
+              if (AncestorObj<> Component) and
+               (TComponent(AncestorObj).Owner = FRootAncestor) and
+               (Component.Owner = Root) and
+               (UpperCase(TComponent(AncestorObj).Name) = UpperCase(Component.Name)) then
+              begin
+                // different components, but with the same name
+                // treat it like an override
+                AncestorObj := Component;
+              end;
+            end;
+          end else
+            AncestorObj := nil;
+
+          if not Assigned(Component) then
+            begin
+            if Component <> AncestorObj then
+              begin
+              Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
+              Driver.WriteIdent('NIL');
+              Driver.EndProperty;
+              end
+            end
+          else if ((not (csSubComponent in Component.ComponentStyle))
+                 or ((Component.Owner<>Instance) and (Component.Owner<>Nil))) then
+            begin
+            if (Component <> AncestorObj)
+                and not (csTransient in Component.ComponentStyle) then
+              begin
+              Name:= '';
+              C:= Component;
+              While (C<>Nil) and (C.Name<>'') do
+                begin
+                If (Name<>'') Then
+                  Name:='.'+Name;
+                if C.Owner = LookupRoot then
+                  begin
+                  Name := C.Name+Name;
+                  break;
+                  end
+                else if C = LookupRoot then
+                  begin
+                  Name := 'Owner' + Name;
+                  break;
+                  end;
+                Name:=C.Name + Name;
+                C:= C.Owner;
+                end;
+              if (C=nil) and (Component.Owner=nil) then
+                if (Name<>'') then              //foreign root
+                  Name:=Name+'.Owner';
+              if Length(Name) > 0 then
+                begin
+                Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
+                WriteIdent(Name);
+                Driver.EndProperty;
+                end;  // length Name>0
+              end; //(Component <> AncestorObj)
+            end;
+          end; //Assigned(IntfValue) and Supports(IntfValue,..
+               //else write NIL ?
+      end;
   end;
 end;
 

tests/test/units/fpcunit/tccompstreaming.pp

@@ -56,6 +56,7 @@ TTestComponentStream = Class(TTestStreaming)
     Procedure TestTStreamedOwnedComponents;
     Procedure TestTMethodComponent;
     Procedure TestTMethodComponent2;
+    Procedure TestTOwnedInterface;
   end;
   { TMyItem }
 
@@ -1229,6 +1230,28 @@ begin
     end;
 end;
 
+Procedure TTestComponentStream.TestTOwnedInterface;
+
+Var
+  C : TComponent;
+
+begin
+  C:=TOwnedInterface.Create(Nil);
+  Try
+    SaveToStream(C);
+    ExpectSignature;
+    ExpectFlags([],0);
+    ExpectBareString('TOwnedInterface');
+    ExpectBareString('TestTOwnedInterface');
+    ExpectBareString('IntfProp');
+    ExpectIdent('InterfacedComponent');
+    ExpectEndOfList;
+    ExpectEndOfList;
+  Finally
+    C.Free;
+    end;
+end;
+
 { TMyColl }
 
 function TMyColl.GetIt(index : Integer): TMyItem;

tests/test/units/fpcunit/testcomps.pp

@@ -491,6 +491,26 @@ Type
     Procedure MyMethod2;
   end;
 
+  // Interface as published property
+
+  ITestInterface = interface
+  end;
+
+  TTestIntfComponent = class(TComponent, ITestInterface)
+  end;
+
+  { TOwnedInterface }
+
+  TOwnedInterface = class(TComponent)
+  Private
+    F : ITestInterface;
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+  Published
+    Property IntfProp: ITestInterface Read F Write F;
+  end;
+
 Implementation
 
 procedure TChildrenComponent.GetChildren(Proc: TGetChildProc; Root: TComponent);
@@ -950,5 +970,22 @@ begin
  // Do nothng
 end;
 
+{ TOwnedInterface }
+
+constructor TOwnedInterface.Create(AOwner: TComponent);
+var
+  C : TTestIntfComponent;
+begin
+  inherited Create(AOwner);
+  C := TTestIntfComponent.Create(Self);
+  C.Name:='InterfacedComponent';
+  IntfProp:=C;
+end;
+
+Destructor TOwnedInterface.Destroy;
+begin
+  F := nil; // prevent memory leak
+  inherited;
+end;
 
 end.