From cc81abdd834eeb88ebb1cb080feead3e65626226 Mon Sep 17 00:00:00 2001 From: michael Date: Wed, 22 Feb 2017 21:14:35 +0000 Subject: [PATCH] * Patch from Michal Gawrycki to implement streaming interface properties (IComponent) Bug ID git-svn-id: trunk@35474 - --- rtl/objpas/classes/reader.inc | 9 ++- rtl/objpas/classes/writer.inc | 75 +++++++++++++++++++++ tests/test/units/fpcunit/tccompstreaming.pp | 23 +++++++ tests/test/units/fpcunit/testcomps.pp | 37 ++++++++++ 4 files changed, 142 insertions(+), 2 deletions(-) diff --git a/rtl/objpas/classes/reader.inc b/rtl/objpas/classes/reader.inc index 8765cdded7..6f9820661b 100644 --- a/rtl/objpas/classes/reader.inc +++ b/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 diff --git a/rtl/objpas/classes/writer.inc b/rtl/objpas/classes/writer.inc index 2a01ee5f88..d23632cea4 100644 --- a/rtl/objpas/classes/writer.inc +++ b/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; diff --git a/tests/test/units/fpcunit/tccompstreaming.pp b/tests/test/units/fpcunit/tccompstreaming.pp index 08d3a2f9ba..e4a6ef195c 100644 --- a/tests/test/units/fpcunit/tccompstreaming.pp +++ b/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; diff --git a/tests/test/units/fpcunit/testcomps.pp b/tests/test/units/fpcunit/testcomps.pp index 609396ee9f..bfe9471297 100644 --- a/tests/test/units/fpcunit/testcomps.pp +++ b/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.