View Issue Details

IDProjectCategoryView StatusLast Update
0031029FPCRTLpublic2016-12-01 03:00
Reportersilvioprog Assigned ToSven Barth  
PrioritynormalSeverityminorReproducibilityhave not tried
Status closedResolutionfixed 
Product Version3.1.1 
Fixed in Version3.1.1 
Summary0031029: [PATCH] Delphi TypInfo compatibility: implement GetDynArrayProp()/SetDynArrayProp() routines
DescriptionHello,

Those functions are very useful for handling the value of a instance property that is a dynamic array type.

Docs:

1. http://docwiki.embarcadero.com/Libraries/Berlin/en/System.TypInfo.SetDynArrayProp
2. http://docwiki.embarcadero.com/Libraries/Berlin/en/System.TypInfo.GetDynArrayProp
Tagsrtl, RTTI, typinfo
Fixed in Revision35025
FPCOldBugId
FPCTarget
Attached Files

Activities

silvioprog

2016-11-29 06:42

reporter  

0001-rtl-fix-issue-31029-patch-by-Silvio-Clecio.patch (4,361 bytes)   
From 347d825c8c2625d37738be104c83dc31a6ef0c71 Mon Sep 17 00:00:00 2001
From: silvioprog <silvioprog@gmail.com>
Date: Tue, 29 Nov 2016 02:34:56 -0300
Subject: [PATCH] rtl: fix issue #31029 (patch by Silvio Clecio)

---
 rtl/objpas/typinfo.pp | 77 +++++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 74 insertions(+), 3 deletions(-)

diff --git a/rtl/objpas/typinfo.pp b/rtl/objpas/typinfo.pp
index d9b32f9..71038a1 100644
--- a/rtl/objpas/typinfo.pp
+++ b/rtl/objpas/typinfo.pp
@@ -491,6 +491,11 @@ function GetRawInterfaceProp(Instance: TObject; PropInfo: PPropInfo): Pointer;
 procedure SetRawInterfaceProp(Instance: TObject; const PropName: string; const Value: Pointer);
 procedure SetRawInterfaceProp(Instance: TObject; PropInfo: PPropInfo; const Value: Pointer);
 
+function GetDynArrayProp(Instance: TObject; const PropName: string): Pointer;
+function GetDynArrayProp(Instance: TObject; PropInfo: PPropInfo): Pointer;
+procedure SetDynArrayProp(Instance: TObject; const PropName: string; const Value: Pointer);
+procedure SetDynArrayProp(Instance: TObject; PropInfo: PPropInfo; const Value: Pointer);
+
 // Auxiliary routines, which may be useful
 Function GetEnumName(TypeInfo : PTypeInfo;Value : Integer) : string;
 Function GetEnumValue(TypeInfo : PTypeInfo;const Name : string) : Integer;
@@ -1381,12 +1386,9 @@ type
   TGetInterfaceProc=function:IInterface of object;
   TGetInterfaceProcIndex=function(index:longint):IInterface of object;
 var
-  TypeInfo: PTypeInfo;
   AMethod : TMethod;
 begin
   Result:=nil;
-
-  TypeInfo := PropInfo^.PropType;
   case (PropInfo^.PropProcs) and 3 of
     ptField:
       Result:=IInterface(PPointer(Pointer(Instance)+PtrUInt(PropInfo^.GetProc))^);
@@ -1507,6 +1509,75 @@ begin
 end;
 
 { ---------------------------------------------------------------------
+  Dynamic array properties
+  ---------------------------------------------------------------------}
+
+function GetDynArrayProp(Instance: TObject; const PropName: string): Pointer;
+begin
+  Result:=GetDynArrayProp(Instance,FindPropInfo(Instance,PropName));
+end;
+
+function GetDynArrayProp(Instance: TObject; PropInfo: PPropInfo): Pointer;
+type
+  PArrayOfByte = ^TArrayOfByte;
+  TArrayOfByte = array of Byte;
+  TGetDynArrayProc=function:TArrayOfByte of object;
+  TGetDynArrayProcIndex=function(index:longint):TArrayOfByte of object;
+var
+  AMethod : TMethod;
+begin
+  Result:=nil;
+  case (PropInfo^.PropProcs) and 3 of
+    ptField:
+      Result:=Pointer(PArrayOfByte(Pointer(Instance)+PtrUInt(PropInfo^.GetProc))^);
+    ptStatic,
+    ptVirtual:
+      begin
+        if (PropInfo^.PropProcs and 3)=ptStatic then
+          AMethod.Code:=PropInfo^.GetProc
+        else
+          AMethod.Code:=PCodePointer(Pointer(Instance.ClassType)+PtrUInt(PropInfo^.GetProc))^;
+        AMethod.Data:=Instance;
+        if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
+          Result:=PArrayOfByte(TGetDynArrayProcIndex(AMethod)(PropInfo^.Index))
+        else
+          Result:=PArrayOfByte(TGetDynArrayProc(AMethod)());
+      end;
+  end;
+end;
+
+procedure SetDynArrayProp(Instance: TObject; const PropName: string; const Value: Pointer);
+begin
+  SetDynArrayProp(Instance,FindPropInfo(Instance,PropName),Value);
+end;
+
+procedure SetDynArrayProp(Instance: TObject; PropInfo: PPropInfo; const Value: Pointer);
+type
+  TSetDynArrayProcIndex=procedure(index:longint;const i:Pointer) of object;
+  TSetDynArrayProc=procedure(i:Pointer) of object;
+var
+  AMethod: TMethod;
+begin
+  case (PropInfo^.PropProcs shr 2) and 3 of
+    ptField:
+      CopyArray(PPointer(Pointer(Instance)+PtrUInt(PropInfo^.SetProc)), @Value, PropInfo^.PropType, 1);
+    ptStatic,
+    ptVirtual:
+      begin
+        if ((PropInfo^.PropProcs shr 2) and 3)=ptStatic then
+          AMethod.Code:=PropInfo^.SetProc
+        else
+          AMethod.Code:=PCodePointer(Pointer(Instance.ClassType)+PtrUInt(PropInfo^.SetProc))^;
+        AMethod.Data:=Instance;
+        if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
+          TSetDynArrayProcIndex(AMethod)(PropInfo^.Index,Value)
+        else
+          TSetDynArrayProc(AMethod)(Value);
+      end;
+  end;
+end;
+
+{ ---------------------------------------------------------------------
   String properties
   ---------------------------------------------------------------------}
 
-- 
2.7.4

silvioprog

2016-11-29 06:42

reporter  

test.pp (3,680 bytes)

silvioprog

2016-11-29 06:43

reporter   ~0096374

Last edited: 2016-11-29 06:47

View 2 revisions

Patch and test in attachment.

(0001-rtl-fix-issue-31029-patch-by-Silvio-Clecio.patch/test2.pp)

silvioprog

2016-11-29 06:47

reporter  

test2.pp (3,706 bytes)

silvioprog

2016-11-30 16:44

reporter   ~0096424

Please change title from "[FEATURE REQUEST] Delphi TypInfo compatibility: implement GetDynArrayProp()/SetDynArrayProp() routines" to "[PATCH] Delphi TypInfo compatibility: implement GetDynArrayProp()/SetDynArrayProp() routines".

Sven Barth

2016-11-30 17:47

manager   ~0096427

Last edited: 2016-11-30 18:04

View 3 revisions

I changed the title however your code assumes that the array in question is a "array of Byte" that doesn't however need to be the case and could *potentially* lead to the compiler using the wrong type information.
I'll need to take a look what a better and more correct solution would be.

Sidenote: please don't include unrelated changes in patches, here the ones following line 1381.

Edit: additionally PArrayOfByte is completely wrong, because the pointer returned by the function or contained in the field is *not* a PArrayOfByte, but a dynamic array which in itself is already an implicit pointer.

Sven Barth

2016-11-30 20:36

manager   ~0096432

I've reworked your patch a little bit after I had made sure that it does the correct thing. Additionally I've also extended Get-/SetPropValue() to support tkDynArray as well.

Please note however that the usage of SetDynArrayProp() in your test isn't quite correct despite it working (which surprises me): you need to pass the array variable converted to a pointer, not the pointer to the array's first element. These are two different things.

Please test and close if okay.

silvioprog

2016-12-01 03:00

reporter   ~0096436

Awesome explanation regarding point. Thanks for applying the patch! :-)

Issue History

Date Modified Username Field Change
2016-11-28 20:02 silvioprog New Issue
2016-11-28 20:03 silvioprog Tag Attached: rtl
2016-11-28 20:03 silvioprog Tag Attached: RTTI
2016-11-28 20:03 silvioprog Tag Attached: typinfo
2016-11-29 06:42 silvioprog File Added: 0001-rtl-fix-issue-31029-patch-by-Silvio-Clecio.patch
2016-11-29 06:42 silvioprog File Added: test.pp
2016-11-29 06:43 silvioprog Note Added: 0096374
2016-11-29 06:47 silvioprog File Added: test2.pp
2016-11-29 06:47 silvioprog Note Edited: 0096374 View Revisions
2016-11-30 16:44 silvioprog Note Added: 0096424
2016-11-30 17:41 Sven Barth Summary [FEATURE REQUEST] Delphi TypInfo compatibility: implement GetDynArrayProp()/SetDynArrayProp() routines => [PATCH] Delphi TypInfo compatibility: implement GetDynArrayProp()/SetDynArrayProp() routines
2016-11-30 17:47 Sven Barth Note Added: 0096427
2016-11-30 18:04 Sven Barth Note Edited: 0096427 View Revisions
2016-11-30 18:04 Sven Barth Note Edited: 0096427 View Revisions
2016-11-30 19:00 Sven Barth Assigned To => Sven Barth
2016-11-30 19:00 Sven Barth Status new => assigned
2016-11-30 20:36 Sven Barth Fixed in Revision => 35025
2016-11-30 20:36 Sven Barth Note Added: 0096432
2016-11-30 20:36 Sven Barth Status assigned => resolved
2016-11-30 20:36 Sven Barth Fixed in Version => 3.1.1
2016-11-30 20:36 Sven Barth Resolution open => fixed
2016-12-01 03:00 silvioprog Note Added: 0096436
2016-12-01 03:00 silvioprog Status resolved => closed