Browse Source

* Write RTTI for function arguments as children of function RTTI, resolves #24540,#25002,#25128 (bugs are basically duplicate, so adding only first of them to the testsuite).

git-svn-id: trunk@27797 -
sergei 11 years ago
parent
commit
7e1c370c17
3 changed files with 41 additions and 0 deletions
  1. 1 0
      .gitattributes
  2. 17 0
      compiler/ncgrtti.pas
  3. 23 0
      tests/webtbs/tw24540.pp

+ 1 - 0
.gitattributes

@@ -13856,6 +13856,7 @@ tests/webtbs/tw24486.pp svneol=native#text/pascal
 tests/webtbs/tw2452.pp svneol=native#text/plain
 tests/webtbs/tw2452.pp svneol=native#text/plain
 tests/webtbs/tw24536.pp svneol=native#text/plain
 tests/webtbs/tw24536.pp svneol=native#text/plain
 tests/webtbs/tw2454.pp svneol=native#text/plain
 tests/webtbs/tw2454.pp svneol=native#text/plain
+tests/webtbs/tw24540.pp svneol=native#text/plain
 tests/webtbs/tw24651.pp svneol=native#text/pascal
 tests/webtbs/tw24651.pp svneol=native#text/pascal
 tests/webtbs/tw24705.pp svneol=native#text/pascal
 tests/webtbs/tw24705.pp svneol=native#text/pascal
 tests/webtbs/tw2473.pp svneol=native#text/plain
 tests/webtbs/tw2473.pp svneol=native#text/plain

+ 17 - 0
compiler/ncgrtti.pas

@@ -37,6 +37,7 @@ interface
       TRTTIWriter=class
       TRTTIWriter=class
       private
       private
         procedure fields_write_rtti(st:tsymtable;rt:trttitype);
         procedure fields_write_rtti(st:tsymtable;rt:trttitype);
+        procedure params_write_rtti(def:tabstractprocdef;rt:trttitype);
         procedure fields_write_rtti_data(def:tabstractrecorddef;rt:trttitype);
         procedure fields_write_rtti_data(def:tabstractrecorddef;rt:trttitype);
         procedure write_rtti_extrasyms(def:Tdef;rt:Trttitype;mainrtti:Tasmsymbol);
         procedure write_rtti_extrasyms(def:Tdef;rt:Trttitype;mainrtti:Tasmsymbol);
         procedure published_write_rtti(st:tsymtable;rt:trttitype);
         procedure published_write_rtti(st:tsymtable;rt:trttitype);
@@ -204,6 +205,20 @@ implementation
       end;
       end;
 
 
 
 
+    procedure TRTTIWriter.params_write_rtti(def:tabstractprocdef;rt:trttitype);
+      var
+        i   : longint;
+        sym : tparavarsym;
+      begin
+        for i:=0 to def.paras.count-1 do
+          begin
+            sym:=tparavarsym(def.paras[i]);
+            if not (vo_is_hidden_para in sym.varoptions) then
+              write_rtti(sym.vardef,rt);
+          end;
+      end;
+
+
     procedure TRTTIWriter.published_write_rtti(st:tsymtable;rt:trttitype);
     procedure TRTTIWriter.published_write_rtti(st:tsymtable;rt:trttitype);
       var
       var
         i   : longint;
         i   : longint;
@@ -1295,6 +1310,8 @@ implementation
           pointerdef:
           pointerdef:
             if not is_objc_class_or_protocol(tabstractpointerdef(def).pointeddef) then
             if not is_objc_class_or_protocol(tabstractpointerdef(def).pointeddef) then
               write_rtti(tabstractpointerdef(def).pointeddef,rt);
               write_rtti(tabstractpointerdef(def).pointeddef,rt);
+          procvardef:
+            params_write_rtti(tabstractprocdef(def),rt);
         end;
         end;
       end;
       end;
 
 

+ 23 - 0
tests/webtbs/tw24540.pp

@@ -0,0 +1,23 @@
+{%norun}
+{$MODE OBJFPC}
+uses typinfo;
+
+type
+  TMyRecord = record end;
+
+  {$M+}
+  TMyClass = class
+  published
+    procedure MyMethod(MyArgument: TMyRecord); virtual;
+  end;
+  {$M-}
+
+procedure TMyClass.MyMethod(MyArgument: TMyRecord);
+begin
+end;
+
+var
+  X: PTypeInfo;
+begin
+  X := TypeInfo(@TMyClass.MyMethod);
+end.