resolves #10509

* fixed SetInterfaceProp
+ PInterface
* extended trtti1

git-svn-id: trunk@10334 -

rtl/inc/objpash.inc

@@ -112,7 +112,7 @@
                   clock_seq_hi_and_reserved : byte;     // The high field of the clock sequence multiplexed with the variant
                   clock_seq_low : byte;                 // The low field of the clock sequence
                   node : array[0..5] of byte;           // The spatially unique node identifier
-                 );                  
+                 );
        end;
 
        // This enumerate is found both in the rtl and compiler. Do not change the order of the fields.
@@ -227,7 +227,7 @@
           property RefCount : longint read frefcount;
        end;
        TInterfacedClass = class of TInterfacedObject;
-       
+
        TAggregatedObject = class(TObject)
        private
           fcontroller: Pointer;
@@ -243,7 +243,7 @@
        end;
 
        TContainedObject = class(TAggregatedObject,IInterface)
-         protected 
+         protected
            function QueryInterface(const iid : tguid;out obj) : longint;virtual; stdcall;
          end;
 
@@ -252,6 +252,7 @@
        PPUnknown = ^PUnknown;
        PDispatch = ^IDispatch;
        PPDispatch = ^PDispatch;
+       PInterface = PUnknown;
 
 
        TExceptProc = Procedure (Obj : TObject; Addr : Pointer; FrameCount:Longint; Frame: PPointer);

rtl/objpas/typinfo.pp

@@ -142,7 +142,7 @@ unit typinfo;
                RawIntfUnit: ShortString;
                IIDStr: ShortString;
               );
-			      tkDynArray: 
+			      tkDynArray:
 			        (
 			        elSize     : PtrUInt;
 			        elType2    : PPTypeInfo;
@@ -306,9 +306,9 @@ Type
   TSetPropValue   = Procedure (Instance: TObject; const PropName: string; const Value: Variant);
   TGetVariantProp = Function (Instance: TObject; PropInfo : PPropInfo): Variant;
   TSetVariantProp = Procedure (Instance: TObject; PropInfo : PPropInfo; const Value: Variant);
-  
+
   EPropertyConvertError = class(Exception); // Not used (yet), but defined for compatibility.
-  
+
 Const
   OnGetPropValue   : TGetPropValue = Nil;
   OnSetPropValue   : TSetPropValue = Nil;
@@ -1123,13 +1123,34 @@ begin
 end;
 
 procedure SetInterfaceProp(Instance: TObject; PropInfo: PPropInfo; const Value: IInterface);
-
+type
+  TSetIntfStrProcIndex=procedure(index:longint;const i:IInterface) of object;
+  TSetIntfStrProc=procedure(i:IInterface) of object;
+var
+  AMethod : TMethod;
 begin
-{$ifdef cpu64}
+  case Propinfo^.PropType^.Kind of
-  SetInt64Prop(Instance,PropInfo,Int64(Value));
+    tkInterface:
-{$else cpu64}
+      begin
-  SetOrdProp(Instance,PropInfo,Integer(Value));
+        case (PropInfo^.PropProcs shr 2) and 3 of
-{$endif cpu64}
+          ptField:
+            PInterface(Pointer(Instance)+PtrUInt(PropInfo^.SetProc))^:=Value;
+          ptstatic,
+          ptvirtual :
+            begin
+              if ((PropInfo^.PropProcs shr 2) and 3)=ptStatic then
+                AMethod.Code:=PropInfo^.SetProc
+              else
+                AMethod.Code:=PPointer(Pointer(Instance.ClassType)+PtrUInt(PropInfo^.SetProc))^;
+              AMethod.Data:=Instance;
+              if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
+                TSetIntfStrProcIndex(AMethod)(PropInfo^.Index,Value)
+              else
+                TSetIntfStrProc(AMethod)(Value);
+            end;
+        end;
+      end;
+  end;
 end;
 
 { ---------------------------------------------------------------------

tests/test/trtti1.pp

@@ -31,6 +31,7 @@ Type
        FMyEnum   : TMyEnum;
        FAnsiString   : AnsiSTring;
        FObj      : TObject;
+       FIntf      : IInterface;
        FStored   : Boolean;
        Function GetBoolean : Boolean;
        Function GetByte : Byte;
@@ -83,6 +84,7 @@ Type
        Destructor Destroy;override;
        Published
        Property ObjField: TObject read FObj write FObj;
+       Property IntfField: IInterface read FIntf write FIntf;
        Property BooleanField : Boolean Read FBoolean Write FBoolean;
        Property ByteField : Byte Read FByte Write FByte;
        Property CharField : Char Read FChar Write FChar;
@@ -137,11 +139,14 @@ begin
   FExtended :=8.0; { Extended;}
   FMyEnum:=methird; { TMyEnum;}
   FAnsiString:='this is an AnsiString';
+  FObj:=TObject.Create;
+  FIntf:=TInterfacedObject.Create;
 end;
 
 Destructor TMyTestObject.Destroy;
 
 begin
+  FObj.Free;
   Inherited Destroy;
 end;
 
@@ -457,6 +462,7 @@ begin
       Writeln (' Default : ',Default,' Index : ',Index);
       Writeln (' NameIndex : ',NameIndex);
       end;
+    FreeMem (PP);
 end;
 
 Procedure PrintObject ( Obj: TMyTestObject);
@@ -465,6 +471,8 @@ begin
   With Obj do
     begin
     Writeln ('Field properties :');
+    Writeln ('Property ObjField        : ',PtrUInt(ObjField));
+    Writeln ('Property IntfField       : ',PtrUInt(IntfField));
     Writeln ('Property booleanField    : ',booleanField);
     Writeln ('Property ByteField       : ',ByteField);
     Writeln ('Property CharField       : ',CharField);
@@ -511,7 +519,7 @@ Var
     I,J : Longint;
     PP : PPropList;
     prI : PPropInfo;
-
+    Intf : IInterface;
 begin
   PI:=O.ClassInfo;
   Writeln ('Type kind : ',TypeNames[PI^.Kind]);
@@ -550,14 +558,28 @@ begin
                     flush (output);
                     Write(GetStrProp(O,Pri));
                     end;
+        tkInterface : begin
+                       Write ('value : ');
+                       flush (output);
+                       Write(PtrUInt(GetInterfaceProp(O,Pri)));
+                       { play a little bit with the interface to test SetInterfaceProp }
+                       SetInterfaceProp(O,Pri,TInterfacedObject.Create);
+                     end;
+        tkClass   : begin
+                       Write ('value : ');
+                       flush (output);
+                       Write(PtrUInt(GetObjectProp(O,Pri)));
+                     end;
         else
           Write ('Untested type:',ord(pri^.proptype^.kind));
         end;
           Writeln (')');
       end;
     end;
+  FreeMem (PP);
 end;
 
+
 Var O : TMyTestObject;
 
 begin
@@ -565,4 +587,5 @@ begin
   DumpTypeInfo(O);
   PrintObject(O);
   testget(o);
+  O.Free;
 end.