From dcb5c10cac82759e76039cd993483e9474ff7fa7 Mon Sep 17 00:00:00 2001
From: mattias <mattias@idefix.freepascal.org>
Date: Sun, 24 Feb 2019 09:45:01 +0000
Subject: [PATCH] rtl: added TCustomAttribute

---
 packages/rtl/system.pas  |  6 ++++++
 packages/rtl/typinfo.pas | 42 ++++++++++++++++++++++++++++++++++++++++
 2 files changed, 48 insertions(+)

diff --git a/packages/rtl/system.pas b/packages/rtl/system.pas
index 65b3d93..b9a387a 100644
--- a/packages/rtl/system.pas
+++ b/packages/rtl/system.pas
@@ -134,6 +134,12 @@ type
     function ToString: String; virtual;
   end;
 
+  { TCustomAttribute - base class of all user defined attributes. }
+
+  TCustomAttribute = class
+  end;
+  TCustomAttributeArray = array of TCustomAttribute;
+
 const
   { IInterface }
   S_OK          = 0;
diff --git a/packages/rtl/typinfo.pas b/packages/rtl/typinfo.pas
index 3b99d81..f9a455a 100644
--- a/packages/rtl/typinfo.pas
+++ b/packages/rtl/typinfo.pas
@@ -68,12 +68,15 @@ const
   tkProperties = tkAny-tkMethods-[tkUnknown];
 
 type
+  TTypeInfoAttributes = type TJSValueDynArray;
+
   { TTypeInfo }
 
   TTypeInfo = class external name 'rtl.tTypeInfo'
   public
     Name: String external name 'name';
     Kind: TTypeKind external name 'kind';
+    Attributes: TTypeInfoAttributes external name 'attr'; // can be undefined
   end;
   TTypeInfoClassOf = class of TTypeInfo;
 
@@ -222,6 +225,7 @@ type
   public
     Name: String external name 'name';
     Kind: TTypeMemberKind external name 'kind';
+    Attributes: TTypeInfoAttributes external name 'attr'; // can be undefined
   end;
   TTypeMemberDynArray = array of TTypeMember;
 
@@ -362,6 +366,8 @@ function GetInterfaceMembers(aTIInterface: TTypeInfoInterface): TTypeMemberDynAr
 function GetInterfaceMember(aTIInterface: TTypeInfoInterface; const aName: String): TTypeMember;
 function GetInterfaceMethods(aTIInterface: TTypeInfoInterface): TTypeMemberMethodDynArray;
 
+function GetRTTIAttributes(const Attributes: TTypeInfoAttributes): TCustomAttributeArray;
+
 function GetPropInfos(aTIStruct: TTypeInfoStruct): TTypeMemberPropertyDynArray;
 function GetPropList(aTIStruct: TTypeInfoStruct; TypeKinds: TTypeKinds; Sorted: boolean = true): TTypeMemberPropertyDynArray;
 function GetPropList(aTIStruct: TTypeInfoStruct): TTypeMemberPropertyDynArray;
@@ -623,6 +629,42 @@ begin
   end;
 end;
 
+type
+  TCreatorAttribute = class external name 'attr'
+    class function Create(const ProcName: string): TCustomAttribute; overload; external name '$create';
+    class function Create(const ProcName: string; Params: jsvalue): TCustomAttribute; overload; external name '$create';
+  end;
+  TCreatorAttributeClass = class of TCreatorAttribute;
+
+function GetRTTIAttributes(const Attributes: TTypeInfoAttributes
+  ): TCustomAttributeArray;
+var
+  i, len: Integer;
+  AttrClass: TCreatorAttributeClass;
+  ProcName: String;
+  Attr: TCustomAttribute;
+begin
+  Result:=nil;
+  if Attributes=Undefined then exit;
+  i:=0;
+  len:=length(Attributes);
+  while i<len do
+    begin
+    AttrClass:=TCreatorAttributeClass(Attributes[i]);
+    inc(i);
+    ProcName:=String(Attributes[i]);
+    inc(i);
+    if (i<len) and isArray(Attributes[i]) then
+      begin
+      Attr:=AttrClass.Create(ProcName,Attributes[i]);
+      inc(i);
+      end
+    else
+      Attr:=AttrClass.Create(ProcName);
+    Insert(Attr,Result,length(Result));
+    end;
+end;
+
 function GetPropInfos(aTIStruct: TTypeInfoStruct): TTypeMemberPropertyDynArray;
 var
   C: TTypeInfoStruct;