Browse Source

* Do not include class and array properties in RTTI

Michaël Van Canneyt 1 year ago
parent
commit
87137a4aaa
3 changed files with 81 additions and 3 deletions
  1. 9 3
      compiler/ncgrtti.pas
  2. 36 0
      tests/test/texrtti17.pp
  3. 36 0
      tests/test/texrtti18.pp

+ 9 - 3
compiler/ncgrtti.pas

@@ -953,6 +953,7 @@ implementation
         tbltcb : ttai_typedconstbuilder;
         tbltcb : ttai_typedconstbuilder;
         tbllab : tasmlabel;
         tbllab : tasmlabel;
         tbldef : tdef;
         tbldef : tdef;
+        visbyte : byte;
 
 
         procedure writeaccessproc(tcb: ttai_typedconstbuilder; pap:tpropaccesslisttypes; shiftvalue : byte; unsetvalue: byte);
         procedure writeaccessproc(tcb: ttai_typedconstbuilder; pap:tpropaccesslisttypes; shiftvalue : byte; unsetvalue: byte);
         var
         var
@@ -1060,7 +1061,9 @@ implementation
               begin
               begin
                 sym:=tsym(st.SymList[i]);
                 sym:=tsym(st.SymList[i]);
                 if (tsym(sym).typ=propertysym) and
                 if (tsym(sym).typ=propertysym) and
-                   (sym.visibility in visibilities) then
+                   (sym.visibility in visibilities) and
+                   (tpropertysym(sym).parast=Nil) and
+                   not (sp_static in sym.symoptions) then
                   inc(result);
                   inc(result);
               end;
               end;
           end;
           end;
@@ -1149,7 +1152,9 @@ implementation
           begin
           begin
             sym:=tsym(st.SymList[i]);
             sym:=tsym(st.SymList[i]);
             if (sym.typ=propertysym) and
             if (sym.typ=propertysym) and
-               (sym.visibility in visibilities) then
+               (sym.visibility in visibilities) and
+               (tpropertysym(sym).parast=Nil) and
+               not (sp_static in sym.symoptions) then
               begin
               begin
                 if extended_rtti then
                 if extended_rtti then
                   begin
                   begin
@@ -1165,7 +1170,8 @@ implementation
                       targetinfos[target_info.system]^.alignment.recordalignmin);
                       targetinfos[target_info.system]^.alignment.recordalignmin);
                     { write visiblity flags for extended RTTI }
                     { write visiblity flags for extended RTTI }
                     maybe_add_comment(tcb,#9'visibility flags');
                     maybe_add_comment(tcb,#9'visibility flags');
-                    tcb.emit_ord_const(byte(visibility_to_rtti_flags(sym.visibility)),u8inttype);
+                    visbyte:=byte(visibility_to_rtti_flags(sym.visibility));
+                    tcb.emit_ord_const(visByte,u8inttype);
                     { create separate constant builder }
                     { create separate constant builder }
                     current_asmdata.getglobaldatalabel(tbllab);
                     current_asmdata.getglobaldatalabel(tbllab);
                     tbltcb:=ctai_typedconstbuilder.create([tcalo_is_lab,tcalo_make_dead_strippable]);
                     tbltcb:=ctai_typedconstbuilder.create([tcalo_is_lab,tcalo_make_dead_strippable]);

+ 36 - 0
tests/test/texrtti17.pp

@@ -0,0 +1,36 @@
+program texrtti17;
+
+{$mode objfpc}
+
+{ Test that class properties are not returned in RTTI }
+
+uses typinfo, uexrttiutil;
+
+{$RTTI INHERIT
+       METHODS(DefaultMethodRttiVisibility)
+       FIELDS(DefaultFieldRttiVisibility)
+       PROPERTIES(DefaultPropertyRttiVisibility)
+}
+
+Type
+  T1 = Class(TObject)
+    class function getsomething : integer; static;
+    class property Something : Integer Read GetSomething;
+  end;
+
+
+class function T1.getsomething : integer;
+
+begin
+  Result:=0;
+end;
+
+var
+  aCount : Integer;
+  P: PPropListEx;
+
+begin
+  aCount:=GetPropListEx(T1,P);
+  AssertEquals('class property not in RTTI properties',0,aCount);
+end.
+

+ 36 - 0
tests/test/texrtti18.pp

@@ -0,0 +1,36 @@
+program texrtti17;
+
+{$mode objfpc}
+
+{ Test that class properties are not returned in RTTI }
+
+uses typinfo, uexrttiutil;
+
+{$RTTI INHERIT
+       METHODS(DefaultMethodRttiVisibility)
+       FIELDS(DefaultFieldRttiVisibility)
+       PROPERTIES(DefaultPropertyRttiVisibility)
+}
+
+Type
+  T1 = Class(TObject)
+    class function getsomething : integer; static;
+    class property Something : Integer Read GetSomething;
+  end;
+
+
+class function T1.getsomething : integer;
+
+begin
+  Result:=0;
+end;
+
+var
+  aCount : Integer;
+  P: PPropListEx;
+
+begin
+  aCount:=GetPropListEx(T1,P);
+  AssertEquals('class property not in RTTI properties',0,aCount);
+end.
+