Adding support for indexed properties in extended RTTI

compiler/ncgrtti.pas

@@ -69,6 +69,7 @@ interface
         procedure write_callconv(tcb:ttai_typedconstbuilder;def:tabstractprocdef);
         procedure write_paralocs(tcb:ttai_typedconstbuilder;para:pcgpara);
         procedure write_param_flag(tcb:ttai_typedconstbuilder;parasym:tparavarsym);
+        procedure write_param(tcb:ttai_typedconstbuilder;para:tparavarsym);
         procedure write_mop_offset_table(tcb:ttai_typedconstbuilder;def:tabstractrecorddef;mop:tmanagementoperator);
         procedure maybe_add_comment(tcb:ttai_typedconstbuilder;const comment : string); inline;
       public
@@ -333,32 +334,7 @@ implementation
                       end;
 
                     for k:=0 to def.paras.count-1 do
-                      begin
-                        para:=tparavarsym(def.paras[k]);
-
-                        maybe_add_comment(tcb,'RTTI: begin param '+para.prettyname);
-                        tcb.begin_anonymous_record('',defaultpacking,min(reqalign,SizeOf(PInt)),
-                          targetinfos[target_info.system]^.alignment.recordalignmin);
-
-                        maybe_add_comment(tcb,#9'type');
-                        if is_open_array(para.vardef) or is_array_of_const(para.vardef) then
-                          write_rtti_reference(tcb,tarraydef(para.vardef).elementdef,fullrtti)
-                        else if para.vardef=cformaltype then
-                          write_rtti_reference(tcb,nil,fullrtti)
-                        else
-                          write_rtti_reference(tcb,para.vardef,fullrtti);
-                        maybe_add_comment(tcb,#9'flags');
-                        write_param_flag(tcb,para);
-
-                        maybe_add_comment(tcb,#9'name');
-                        tcb.emit_pooled_shortstring_const_ref(para.realname);
-
-                        maybe_add_comment(tcb,#9'locs');
-                        write_paralocs(tcb,@para.paraloc[callerside]);
-
-                        tcb.end_anonymous_record;
-                        maybe_add_comment(tcb,'RTTI: end param '+para.prettyname);
-                      end;
+                        write_param(tcb,tparavarsym(def.paras[k]));
 
                     if not is_void(def.returndef) then
                       begin
@@ -562,6 +538,33 @@ implementation
         tcb.emit_ord_const(paraspec,u16inttype);
       end;
 
+    procedure TRTTIWriter.write_param(tcb: ttai_typedconstbuilder;
+      para: tparavarsym);
+      begin
+        maybe_add_comment(tcb,'RTTI: begin param '+para.prettyname);
+        tcb.begin_anonymous_record('',defaultpacking,min(reqalign,SizeOf(PInt)),
+          targetinfos[target_info.system]^.alignment.recordalignmin);
+
+        maybe_add_comment(tcb,#9'type');
+        if is_open_array(para.vardef) or is_array_of_const(para.vardef) then
+          write_rtti_reference(tcb,tarraydef(para.vardef).elementdef,fullrtti)
+        else if para.vardef=cformaltype then
+          write_rtti_reference(tcb,nil,fullrtti)
+        else
+          write_rtti_reference(tcb,para.vardef,fullrtti);
+        maybe_add_comment(tcb,#9'flags');
+        write_param_flag(tcb,para);
+
+        maybe_add_comment(tcb,#9'name');
+        tcb.emit_pooled_shortstring_const_ref(para.realname);
+
+        maybe_add_comment(tcb,#9'locs');
+        write_paralocs(tcb,@para.paraloc[callerside]);
+
+        tcb.end_anonymous_record;
+        maybe_add_comment(tcb,'RTTI: end param '+para.prettyname);
+      end;
+
 
     function compare_mop_offset_entry(item1,item2:pointer):longint;
       var
@@ -1062,12 +1065,40 @@ implementation
                 sym:=tsym(st.SymList[i]);
                 if (tsym(sym).typ=propertysym) and
                    (sym.visibility in visibilities) and
-                   (tpropertysym(sym).parast=Nil) and
+                   (extended_rtti or (tpropertysym(sym).parast=Nil)) and
                    not (sp_static in sym.symoptions) then
                   inc(result);
               end;
           end;
 
+        procedure write_prop_params(tcb:ttai_typedconstbuilder;paramst:tsymtable);
+          var
+            paramtcb : ttai_typedconstbuilder;
+            paramlbl : tasmlabel;
+            paramdef : tdef;
+            i : longint;
+          begin
+              tcb.start_internal_data_builder(current_asmdata.AsmLists[al_rtti],sec_rodata,'',paramtcb,paramlbl);
+
+              paramtcb.begin_anonymous_record('',defaultpacking,min(reqalign,SizeOf(PInt)),
+                targetinfos[target_info.system]^.alignment.recordalignmin);
+
+              { paramcount }
+              paramtcb.emit_ord_const(paramst.symlist.count,u32inttype);
+              for i:=0 to paramst.symlist.count-1 do
+                begin
+                  if tsym(paramst.symlist[i]).typ<>paravarsym then
+                    Internalerror(2024103101);
+                  write_param(paramtcb,tparavarsym(paramst.symlist[i]));
+                end;
+
+
+              paramdef:=paramtcb.end_anonymous_record;
+              tcb.finish_internal_data_builder(paramtcb,paramlbl,paramdef,sizeof(pint));
+
+              tcb.emit_tai(tai_const.Create_sym(paramlbl),voidpointertype);
+          end;
+
         function write_propinfo_data(tcb: ttai_typedconstbuilder; sym: tpropertysym): tdef;
           begin
             { we can only easily reuse defs if the property is not stored,
@@ -1127,6 +1158,13 @@ implementation
             if addcomments then
               tcb.emit_comment(#9'proc types');
             tcb.emit_ord_const(proctypesinfo,u8inttype);
+            { index parameters }
+            if addcomments then
+              tcb.emit_comment(#9'indexed params');
+            if extended_rtti and assigned(tpropertysym(sym).parast) then
+              write_prop_params(tcb,sym.parast)
+            else
+              tcb.emit_tai(tai_const.create_nil_dataptr,voidpointertype);
             { write reference to attribute table }
             if addcomments then
               tcb.emit_comment(#9'attributes');
@@ -1153,7 +1191,7 @@ implementation
             sym:=tsym(st.SymList[i]);
             if (sym.typ=propertysym) and
                (sym.visibility in visibilities) and
-               (tpropertysym(sym).parast=Nil) and
+               (extended_rtti or (tpropertysym(sym).parast=Nil)) and
                not (sp_static in sym.symoptions) then
               begin
                 if extended_rtti then

rtl/objpas/typinfo.pp

@@ -1092,6 +1092,16 @@ unit TypInfo;
       PPropListEx = ^TPropListEx;
       TPropListEx = array[0..{$ifdef cpu16}(32768 div sizeof(PPropInfoEx))-2{$else}65535{$endif}] of PPropInfoEx;
 
+      TPropParams =
+      {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+      packed
+      {$ENDIF FPC_REQUIRES_PROPER_ALIGNMENT}
+      record
+        Count: LongInt;
+        Params: array[0..0] of TVmtMethodParam;
+      end;
+      PPropParams = ^TPropParams;
+
 {$PACKRECORDS 1}
       TPropInfo = packed record
       private
@@ -1114,6 +1124,8 @@ unit TypInfo;
         //     6 : true, constant index property
         PropProcs : Byte;
 
+        PropParams : PPropParams;
+
         {$ifdef PROVIDE_ATTR_TABLE}
         AttributeTable : PAttributeTable;
         {$endif}

tests/test/texrtti19.pp

@@ -0,0 +1,43 @@
+{$Mode ObjFpc}
+
+uses TypInfo;
+
+type
+  {$RTTI EXPLICIT 
+    FIELDS([vcPublic])
+    PROPERTIES([vcPublic,vcPublished])
+    METHODS([vcPublic,vcPublished])
+  }
+  TTestClass = class
+  public 
+    fa:integer;
+    function MyMethod(const arg1: Integer): Integer;
+    property TestIProp[const i: Longint]: Integer read MyMethod; 
+    property TestProp: Integer read fa;
+  end;
+
+function TTestClass.MyMethod(const arg1: Integer): Integer;
+begin
+  Result := arg1;
+end;
+
+var
+  pcd: PClassData;
+begin
+  pcd:=PClassData(GetTypeData(TypeInfo(TTestClass)));
+  if pcd^.ExRTTITable^.PropCount <> 2 then
+    Halt(1);
+  if not assigned(pcd^.ExRTTITable^.Prop[0]^.Info^.PropParams) then
+    Halt(2);
+  if pcd^.ExRTTITable^.Prop[0]^.Info^.PropParams^.Count<>1 then
+    Halt(3);
+  if pcd^.ExRTTITable^.Prop[0]^.Info^.PropParams^.Params[0].Name<>'i' then
+    Halt(4);
+  if not (pfconst in pcd^.ExRTTITable^.Prop[0]^.Info^.PropParams^.Params[0].flags) then
+    Halt(5);
+  if pcd^.ExRTTITable^.Prop[0]^.Info^.PropParams^.Params[0].ParamType^^.Name<>'LongInt' then
+    Halt(6);
+  if assigned(pcd^.ExRTTITable^.Prop[1]^.Info^.PropParams) then
+    Halt(7);
+  WriteLn('Ok');
+end.

tests/test/texrtti20.pp

@@ -0,0 +1,35 @@
+{$Mode ObjFpc}
+
+uses TypInfo;
+
+type
+  {$RTTI EXPLICIT 
+    FIELDS([vcPublic])
+    PROPERTIES([vcPublic,vcPublished])
+    METHODS([vcPublic,vcPublished])
+  }
+  TTestClass = class
+  public 
+    fa:integer;
+    function MyMethod(const arg1: Integer): Integer;
+    property TestIProp[const i: Longint]: Integer read MyMethod; 
+  published
+    property TestProp: Integer read fa;
+  end;
+
+function TTestClass.MyMethod(const arg1: Integer): Integer;
+begin
+  Result := arg1;
+end;
+
+var
+  pcd: PClassData;
+begin
+  pcd:=PClassData(GetTypeData(TypeInfo(TTestClass)));
+  WriteLn(pcd^.PropertyTable^.PropCount);
+  if pcd^.PropertyTable^.PropCount <> 1 then
+    Halt(1);
+  if assigned(pcd^.PropertyTable^.Prop[0]^.PropParams) then
+    Halt(2);
+  WriteLn('Ok');
+end.