View Issue Details

IDProjectCategoryView StatusLast Update
0036358FPCPatchpublic2019-11-30 13:09
ReporterImants GulbisAssigned ToSven Barth 
PrioritynormalSeverityminorReproducibilityalways
Status feedbackResolutionopen 
Product Version3.3.1Product Build 
Target VersionFixed in Version 
Summary0036358: Rtti unit properties do not process object, interface and float properties
DescriptionI attached patch for support of objects, interfaces and float numbers in TRttiProperty class
TagsNo tags attached.
Fixed in Revision
FPCOldBugId
FPCTarget-
Attached Files
  • rtti.pp.patch (3,299 bytes)
    Index: packages/rtl-objpas/src/inc/rtti.pp
    ===================================================================
    --- packages/rtl-objpas/src/inc/rtti.pp	(revision 43584)
    +++ packages/rtl-objpas/src/inc/rtti.pp	(working copy)
    @@ -160,7 +160,8 @@
         class operator := (AValue: QWord): TValue; inline;
         class operator := (AValue: TObject): TValue; inline;
         class operator := (AValue: TClass): TValue; inline;
    -    class operator := (AValue: Boolean): TValue; inline;
    +    class operator := (AValue: Boolean): TValue; inline;  
    +    class operator := (AValue: IUnknown): TValue; inline;
         property DataSize: SizeInt read GetDataSize;
         property Kind: TTypeKind read GetTypeKind;
         property TypeData: PTypeData read GetTypeDataProp;
    @@ -2270,6 +2271,11 @@
     class operator TValue.:=(AValue: Boolean): TValue;
     begin
       Make(@AValue, System.TypeInfo(AValue), Result);
    +end;   
    +
    +class operator TValue.:= (AValue: IUnknown): TValue;
    +begin
    +  Make(@AValue, System.TypeInfo(AValue), Result);
     end;
     
     
    @@ -3865,6 +3871,15 @@
       i: int64;
       c: Char;
       wc: WideChar;
    +  o: TObject;
    +  intf: IInterface;
    +  Float: record
    +    S: Single;
    +    D: Double;
    +    E: Extended;
    +    C: Currency;
    +    Co: Comp;
    +  end;
     begin
       case FPropinfo^.PropType^.Kind of
         tkSString:
    @@ -3903,6 +3918,46 @@
             i := GetOrdProp(TObject(Instance), FPropInfo);
             TValue.Make(@i, FPropInfo^.PropType, result);
           end;
    +    tkClass:
    +    begin
    +      o := GetObjectProp(TObject(Instance), FPropInfo);
    +      TValue.Make(@o, FPropInfo^.PropType, Result);
    +    end;
    +    tkInterface: 
    +    begin
    +      intf := GetInterfaceProp(TObject(Instance), FPropInfo);
    +      TValue.Make(@intf, FPropInfo^.PropType, Result);
    +    end;
    +    tkFloat:
    +    begin
    +      case GetTypeData(FPropInfo^.PropType)^.FloatType of
    +        ftCurr   :
    +          begin
    +            Float.C := GetFloatProp(TObject(Instance), FPropInfo);   
    +            TValue.Make(@Float.C, FPropInfo^.PropType, Result);
    +          end;
    +        ftSingle :
    +          begin
    +            Float.S := GetFloatProp(TObject(Instance), FPropInfo);
    +            TValue.Make(@Float.S, FPropInfo^.PropType, Result);
    +          end;
    +        ftDouble :
    +          begin
    +            Float.D := GetFloatProp(TObject(Instance), FPropInfo);
    +            TValue.Make(@Float.D, FPropInfo^.PropType, Result);
    +          end;
    +        ftExtended:
    +          begin
    +            Float.E := GetFloatProp(TObject(Instance), FPropInfo);
    +            TValue.Make(@Float.E, FPropInfo^.PropType, Result);
    +          end;
    +        ftComp   :
    +          begin
    +            Float.Co := GetFloatProp(TObject(Instance), FPropInfo);
    +            TValue.Make(@Float.Co, FPropInfo^.PropType, Result);
    +          end;
    +      end;
    +    end;
       else
         result := TValue.Empty;
       end
    @@ -3921,6 +3976,12 @@
         tkBool,
         tkWChar:
           SetOrdProp(TObject(Instance), FPropInfo, AValue.AsOrdinal);
    +    tkClass:       
    +      SetObjectProp(TObject(Instance), FPropInfo, AValue.AsObject);  
    +    tkInterface:
    +      SetInterfaceProp(TObject(Instance), FPropInfo, AValue.AsInterface);
    +    tkFloat:
    +      SetFloatProp(TObject(Instance), FPropInfo, AValue.AsExtended);
       else
         raise exception.createFmt(SErrUnableToSetValueForType, [PropertyType.Name]);
       end
    
    rtti.pp.patch (3,299 bytes)
  • 2_rtti.pp.patch (4,290 bytes)
    Index: packages/rtl-objpas/src/inc/rtti.pp
    ===================================================================
    --- packages/rtl-objpas/src/inc/rtti.pp	(revision 43592)
    +++ packages/rtl-objpas/src/inc/rtti.pp	(working copy)
    @@ -138,7 +138,8 @@
         function AsInteger: Integer;
         function AsInt64: Int64;
         function AsUInt64: QWord;
    -    function AsInterface: IInterface;
    +    function AsInterface: IInterface;   
    +    function AsDynArray: Pointer;
         function ToString: String;
         function GetArrayLength: SizeInt;
         function GetArrayElement(AIndex: SizeInt): TValue;
    @@ -163,7 +164,8 @@
         class operator := (AValue: QWord): TValue; inline;
         class operator := (AValue: TObject): TValue; inline;
         class operator := (AValue: TClass): TValue; inline;
    -    class operator := (AValue: Boolean): TValue; inline;
    +    class operator := (AValue: Boolean): TValue; inline;  
    +    class operator := (AValue: IUnknown): TValue; inline;
         property DataSize: SizeInt read GetDataSize;
         property Kind: TTypeKind read GetTypeKind;
         property TypeData: PTypeData read GetTypeDataProp;
    @@ -1982,6 +1984,14 @@
         raise EInvalidCast.Create(SErrInvalidTypecast);
     end;
     
    +function TValue.AsDynArray: Pointer;
    +begin
    +  if Kind = tkDynArray then
    +    Result := PPointer(FData.FValueData.GetReferenceToRawData)^
    +  else
    +    raise EInvalidCast.Create(SErrInvalidTypecast);
    +end;
    +
     function TValue.AsInterface: IInterface;
     begin
       if Kind = tkInterface then
    @@ -2280,6 +2290,11 @@
     class operator TValue.:=(AValue: Boolean): TValue;
     begin
       Make(@AValue, System.TypeInfo(AValue), Result);
    +end;   
    +
    +class operator TValue.:= (AValue: IUnknown): TValue;
    +begin
    +  Make(@AValue, System.TypeInfo(AValue), Result);
     end;
     
     
    @@ -3875,6 +3890,16 @@
       i: int64;
       c: Char;
       wc: WideChar;
    +  o: TObject;
    +  intf: IInterface;
    +  Float: record
    +    S: Single;
    +    D: Double;
    +    E: Extended;
    +    C: Currency;
    +    Co: Comp;
    +  end;
    +  A: Pointer;
     begin
       case FPropinfo^.PropType^.Kind of
         tkSString:
    @@ -3913,6 +3938,51 @@
             i := GetOrdProp(TObject(Instance), FPropInfo);
             TValue.Make(@i, FPropInfo^.PropType, result);
           end;
    +    tkClass:
    +    begin
    +      o := GetObjectProp(TObject(Instance), FPropInfo);
    +      TValue.Make(@o, FPropInfo^.PropType, Result);
    +    end;
    +    tkInterface: 
    +    begin
    +      intf := GetInterfaceProp(TObject(Instance), FPropInfo);
    +      TValue.Make(@intf, FPropInfo^.PropType, Result);
    +    end;
    +    tkFloat:
    +    begin
    +      case GetTypeData(FPropInfo^.PropType)^.FloatType of
    +        ftCurr   :
    +          begin
    +            Float.C := GetFloatProp(TObject(Instance), FPropInfo);   
    +            TValue.Make(@Float.C, FPropInfo^.PropType, Result);
    +          end;
    +        ftSingle :
    +          begin
    +            Float.S := GetFloatProp(TObject(Instance), FPropInfo);
    +            TValue.Make(@Float.S, FPropInfo^.PropType, Result);
    +          end;
    +        ftDouble :
    +          begin
    +            Float.D := GetFloatProp(TObject(Instance), FPropInfo);
    +            TValue.Make(@Float.D, FPropInfo^.PropType, Result);
    +          end;
    +        ftExtended:
    +          begin
    +            Float.E := GetFloatProp(TObject(Instance), FPropInfo);
    +            TValue.Make(@Float.E, FPropInfo^.PropType, Result);
    +          end;
    +        ftComp   :
    +          begin
    +            Float.Co := GetFloatProp(TObject(Instance), FPropInfo);
    +            TValue.Make(@Float.Co, FPropInfo^.PropType, Result);
    +          end;
    +      end;
    +    end;
    +    tkDynArray:
    +      begin
    +        A := GetDynArrayProp(TObject(Instance), FPropInfo);
    +        TValue.Make(@A, FPropInfo^.PropType, Result);
    +      end
       else
         result := TValue.Empty;
       end
    @@ -3931,6 +4001,14 @@
         tkBool,
         tkWChar:
           SetOrdProp(TObject(Instance), FPropInfo, AValue.AsOrdinal);
    +    tkClass:       
    +      SetObjectProp(TObject(Instance), FPropInfo, AValue.AsObject);  
    +    tkInterface:
    +      SetInterfaceProp(TObject(Instance), FPropInfo, AValue.AsInterface);
    +    tkFloat:
    +      SetFloatProp(TObject(Instance), FPropInfo, AValue.AsExtended);
    +    tkDynArray:
    +      SetDynArrayProp(TObject(Instance), FPropInfo, AValue.AsDynArray);
       else
         raise exception.createFmt(SErrUnableToSetValueForType, [PropertyType.Name]);
       end
    
    2_rtti.pp.patch (4,290 bytes)

Activities

Imants Gulbis

2019-11-25 15:33

reporter  

rtti.pp.patch (3,299 bytes)
Index: packages/rtl-objpas/src/inc/rtti.pp
===================================================================
--- packages/rtl-objpas/src/inc/rtti.pp	(revision 43584)
+++ packages/rtl-objpas/src/inc/rtti.pp	(working copy)
@@ -160,7 +160,8 @@
     class operator := (AValue: QWord): TValue; inline;
     class operator := (AValue: TObject): TValue; inline;
     class operator := (AValue: TClass): TValue; inline;
-    class operator := (AValue: Boolean): TValue; inline;
+    class operator := (AValue: Boolean): TValue; inline;  
+    class operator := (AValue: IUnknown): TValue; inline;
     property DataSize: SizeInt read GetDataSize;
     property Kind: TTypeKind read GetTypeKind;
     property TypeData: PTypeData read GetTypeDataProp;
@@ -2270,6 +2271,11 @@
 class operator TValue.:=(AValue: Boolean): TValue;
 begin
   Make(@AValue, System.TypeInfo(AValue), Result);
+end;   
+
+class operator TValue.:= (AValue: IUnknown): TValue;
+begin
+  Make(@AValue, System.TypeInfo(AValue), Result);
 end;
 
 
@@ -3865,6 +3871,15 @@
   i: int64;
   c: Char;
   wc: WideChar;
+  o: TObject;
+  intf: IInterface;
+  Float: record
+    S: Single;
+    D: Double;
+    E: Extended;
+    C: Currency;
+    Co: Comp;
+  end;
 begin
   case FPropinfo^.PropType^.Kind of
     tkSString:
@@ -3903,6 +3918,46 @@
         i := GetOrdProp(TObject(Instance), FPropInfo);
         TValue.Make(@i, FPropInfo^.PropType, result);
       end;
+    tkClass:
+    begin
+      o := GetObjectProp(TObject(Instance), FPropInfo);
+      TValue.Make(@o, FPropInfo^.PropType, Result);
+    end;
+    tkInterface: 
+    begin
+      intf := GetInterfaceProp(TObject(Instance), FPropInfo);
+      TValue.Make(@intf, FPropInfo^.PropType, Result);
+    end;
+    tkFloat:
+    begin
+      case GetTypeData(FPropInfo^.PropType)^.FloatType of
+        ftCurr   :
+          begin
+            Float.C := GetFloatProp(TObject(Instance), FPropInfo);   
+            TValue.Make(@Float.C, FPropInfo^.PropType, Result);
+          end;
+        ftSingle :
+          begin
+            Float.S := GetFloatProp(TObject(Instance), FPropInfo);
+            TValue.Make(@Float.S, FPropInfo^.PropType, Result);
+          end;
+        ftDouble :
+          begin
+            Float.D := GetFloatProp(TObject(Instance), FPropInfo);
+            TValue.Make(@Float.D, FPropInfo^.PropType, Result);
+          end;
+        ftExtended:
+          begin
+            Float.E := GetFloatProp(TObject(Instance), FPropInfo);
+            TValue.Make(@Float.E, FPropInfo^.PropType, Result);
+          end;
+        ftComp   :
+          begin
+            Float.Co := GetFloatProp(TObject(Instance), FPropInfo);
+            TValue.Make(@Float.Co, FPropInfo^.PropType, Result);
+          end;
+      end;
+    end;
   else
     result := TValue.Empty;
   end
@@ -3921,6 +3976,12 @@
     tkBool,
     tkWChar:
       SetOrdProp(TObject(Instance), FPropInfo, AValue.AsOrdinal);
+    tkClass:       
+      SetObjectProp(TObject(Instance), FPropInfo, AValue.AsObject);  
+    tkInterface:
+      SetInterfaceProp(TObject(Instance), FPropInfo, AValue.AsInterface);
+    tkFloat:
+      SetFloatProp(TObject(Instance), FPropInfo, AValue.AsExtended);
   else
     raise exception.createFmt(SErrUnableToSetValueForType, [PropertyType.Name]);
   end
rtti.pp.patch (3,299 bytes)

Sven Barth

2019-11-26 00:11

manager   ~0119500

Is there a reason why you used a record for the float values?

Imants Gulbis

2019-11-26 06:58

reporter   ~0119503

I like to group together values with similar meaning. It increase code readability and it is possible to use same variable names for other groups. Considering that variable name was one letter and they all where floats I did that. Other than that it has no other meaning.

Imants Gulbis

2019-11-26 15:14

reporter   ~0119509

I added support of setting and getting dynamic array properties in 2_rtti.pp.patch

2_rtti.pp.patch (4,290 bytes)
Index: packages/rtl-objpas/src/inc/rtti.pp
===================================================================
--- packages/rtl-objpas/src/inc/rtti.pp	(revision 43592)
+++ packages/rtl-objpas/src/inc/rtti.pp	(working copy)
@@ -138,7 +138,8 @@
     function AsInteger: Integer;
     function AsInt64: Int64;
     function AsUInt64: QWord;
-    function AsInterface: IInterface;
+    function AsInterface: IInterface;   
+    function AsDynArray: Pointer;
     function ToString: String;
     function GetArrayLength: SizeInt;
     function GetArrayElement(AIndex: SizeInt): TValue;
@@ -163,7 +164,8 @@
     class operator := (AValue: QWord): TValue; inline;
     class operator := (AValue: TObject): TValue; inline;
     class operator := (AValue: TClass): TValue; inline;
-    class operator := (AValue: Boolean): TValue; inline;
+    class operator := (AValue: Boolean): TValue; inline;  
+    class operator := (AValue: IUnknown): TValue; inline;
     property DataSize: SizeInt read GetDataSize;
     property Kind: TTypeKind read GetTypeKind;
     property TypeData: PTypeData read GetTypeDataProp;
@@ -1982,6 +1984,14 @@
     raise EInvalidCast.Create(SErrInvalidTypecast);
 end;
 
+function TValue.AsDynArray: Pointer;
+begin
+  if Kind = tkDynArray then
+    Result := PPointer(FData.FValueData.GetReferenceToRawData)^
+  else
+    raise EInvalidCast.Create(SErrInvalidTypecast);
+end;
+
 function TValue.AsInterface: IInterface;
 begin
   if Kind = tkInterface then
@@ -2280,6 +2290,11 @@
 class operator TValue.:=(AValue: Boolean): TValue;
 begin
   Make(@AValue, System.TypeInfo(AValue), Result);
+end;   
+
+class operator TValue.:= (AValue: IUnknown): TValue;
+begin
+  Make(@AValue, System.TypeInfo(AValue), Result);
 end;
 
 
@@ -3875,6 +3890,16 @@
   i: int64;
   c: Char;
   wc: WideChar;
+  o: TObject;
+  intf: IInterface;
+  Float: record
+    S: Single;
+    D: Double;
+    E: Extended;
+    C: Currency;
+    Co: Comp;
+  end;
+  A: Pointer;
 begin
   case FPropinfo^.PropType^.Kind of
     tkSString:
@@ -3913,6 +3938,51 @@
         i := GetOrdProp(TObject(Instance), FPropInfo);
         TValue.Make(@i, FPropInfo^.PropType, result);
       end;
+    tkClass:
+    begin
+      o := GetObjectProp(TObject(Instance), FPropInfo);
+      TValue.Make(@o, FPropInfo^.PropType, Result);
+    end;
+    tkInterface: 
+    begin
+      intf := GetInterfaceProp(TObject(Instance), FPropInfo);
+      TValue.Make(@intf, FPropInfo^.PropType, Result);
+    end;
+    tkFloat:
+    begin
+      case GetTypeData(FPropInfo^.PropType)^.FloatType of
+        ftCurr   :
+          begin
+            Float.C := GetFloatProp(TObject(Instance), FPropInfo);   
+            TValue.Make(@Float.C, FPropInfo^.PropType, Result);
+          end;
+        ftSingle :
+          begin
+            Float.S := GetFloatProp(TObject(Instance), FPropInfo);
+            TValue.Make(@Float.S, FPropInfo^.PropType, Result);
+          end;
+        ftDouble :
+          begin
+            Float.D := GetFloatProp(TObject(Instance), FPropInfo);
+            TValue.Make(@Float.D, FPropInfo^.PropType, Result);
+          end;
+        ftExtended:
+          begin
+            Float.E := GetFloatProp(TObject(Instance), FPropInfo);
+            TValue.Make(@Float.E, FPropInfo^.PropType, Result);
+          end;
+        ftComp   :
+          begin
+            Float.Co := GetFloatProp(TObject(Instance), FPropInfo);
+            TValue.Make(@Float.Co, FPropInfo^.PropType, Result);
+          end;
+      end;
+    end;
+    tkDynArray:
+      begin
+        A := GetDynArrayProp(TObject(Instance), FPropInfo);
+        TValue.Make(@A, FPropInfo^.PropType, Result);
+      end
   else
     result := TValue.Empty;
   end
@@ -3931,6 +4001,14 @@
     tkBool,
     tkWChar:
       SetOrdProp(TObject(Instance), FPropInfo, AValue.AsOrdinal);
+    tkClass:       
+      SetObjectProp(TObject(Instance), FPropInfo, AValue.AsObject);  
+    tkInterface:
+      SetInterfaceProp(TObject(Instance), FPropInfo, AValue.AsInterface);
+    tkFloat:
+      SetFloatProp(TObject(Instance), FPropInfo, AValue.AsExtended);
+    tkDynArray:
+      SetDynArrayProp(TObject(Instance), FPropInfo, AValue.AsDynArray);
   else
     raise exception.createFmt(SErrUnableToSetValueForType, [PropertyType.Name]);
   end
2_rtti.pp.patch (4,290 bytes)

Sven Barth

2019-11-30 13:09

manager   ~0119558

Then I'd suggest you to use a variant record so that the amount of stack space that is required is reduced (all other non-managed variables could be moved in there as well). Due to the pointer being passed to TValue.Make the compiler can't optimize the stack space (I don't know if it even could do that otherwise, at least not currently...).

Also you need to pay attention to targets where Comp and/or Currency is Int64 (e.g. Win64). I currently don't know whether in that case GetInt64Prop should be used (that would need to be tested), but you can check for that case with FPC_CURRENCY_IS_INT64 and FPC_COMP_IS_INT64.

Additionally I'd ask you to extend the testsuite in packages/rtl-objpas/tests/tests.rtti.pas so that we can make sure that your added code works correctly and keeps working correctly.

Issue History

Date Modified Username Field Change
2019-11-25 15:33 Imants Gulbis New Issue
2019-11-25 15:33 Imants Gulbis File Added: rtti.pp.patch
2019-11-26 00:11 Sven Barth Note Added: 0119500
2019-11-26 00:11 Sven Barth Assigned To => Sven Barth
2019-11-26 00:11 Sven Barth Status new => feedback
2019-11-26 00:11 Sven Barth FPCTarget => -
2019-11-26 06:58 Imants Gulbis Note Added: 0119503
2019-11-26 06:58 Imants Gulbis Status feedback => assigned
2019-11-26 15:14 Imants Gulbis File Added: 2_rtti.pp.patch
2019-11-26 15:14 Imants Gulbis Note Added: 0119509
2019-11-30 13:09 Sven Barth Note Added: 0119558
2019-11-30 13:09 Sven Barth Status assigned => feedback