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