paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-04 05:22:59 +01:00
Code Issues Packages Projects Releases Wiki Activity

* 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).

Browse Source 
git-svn-id: trunk@27797 -
This commit is contained in:
sergei 2014-05-16 20:09:32 +00:00
parent 9916cd839b
commit 7e1c370c17
3 changed files with 41 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -13856,6 +13856,7 @@ tests/webtbs/tw24486.pp svneol=native#text/pascal
tests/webtbs/tw2452.pp svneol=native#text/plain
tests/webtbs/tw24536.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/tw24705.pp svneol=native#text/pascal
tests/webtbs/tw2473.pp svneol=native#text/plain

17
compiler/ncgrtti.pas
View File

@ -37,6 +37,7 @@ interface
TRTTIWriter=class
private
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 write_rtti_extrasyms(def:Tdef;rt:Trttitype;mainrtti:Tasmsymbol);
procedure published_write_rtti(st:tsymtable;rt:trttitype);
@ -204,6 +205,20 @@ implementation
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);
var
i : longint;
@ -1295,6 +1310,8 @@ implementation
pointerdef:
if not is_objc_class_or_protocol(tabstractpointerdef(def).pointeddef) then
write_rtti(tabstractpointerdef(def).pointeddef,rt);
procvardef:
params_write_rtti(tabstractprocdef(def),rt);
end;
end;

23
tests/webtbs/tw24540.pp Normal file
View File

@ -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.