paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-05 23:47:52 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed alignment for interface RTTI (patch by Alfred, mantis #30182)

Browse Source 
git-svn-id: trunk@34695 -
This commit is contained in:
Jonas Maebe 2016-10-09 12:34:01 +00:00
parent 1d16ecbf0d
commit 5efb32285a
3 changed files with 39 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -15205,6 +15205,7 @@ tests/webtbs/tw30119b.pp svneol=native#text/pascal
tests/webtbs/tw3012.pp svneol=native#text/plain
tests/webtbs/tw30166.pp svneol=native#text/plain
tests/webtbs/tw30179.pp svneol=native#text/pascal
tests/webtbs/tw30182.pp svneol=native#text/plain
tests/webtbs/tw30202.pp svneol=native#text/pascal
tests/webtbs/tw30203.pp svneol=native#text/pascal
tests/webtbs/tw30207.pp svneol=native#text/plain

8
compiler/ncgrtti.pas
View File

@ -1096,6 +1096,10 @@ implementation
propnamelist:=TFPHashObjectList.Create;
collect_propnamelist(propnamelist,def);
tcb.begin_anonymous_record('',defaultpacking,reqalign,
targetinfos[target_info.system]^.alignment.recordalignmin,
targetinfos[target_info.system]^.alignment.maxCrecordalign);
{ write parent typeinfo }
write_rtti_reference(tcb,def.childof,fullrtti);
@ -1112,10 +1116,8 @@ implementation
{
ifDispatch, }
tcb.emit_ord_const(IntfFlags,u8inttype);
tcb.begin_anonymous_record('',defaultpacking,reqalign,
targetinfos[target_info.system]^.alignment.recordalignmin,
targetinfos[target_info.system]^.alignment.maxCrecordalign);
{ write GUID }
tcb.emit_guid_const(def.iidguid^);
{ write unit name }

33
tests/webtbs/tw30182.pp Normal file
View File

@ -0,0 +1,33 @@
program SmallTestInterfaceRTTI;
{$mode objfpc}{$H+}
uses
classes, typinfo;
type
IMyNewMPInterface = interface(IInvokable)
['{AA503475-0187-4108-8E27-41475F4EF818}']
procedure TestStdCall(LongParaName: TObject; const B: string; var C: integer; out D: byte); stdcall;
end;
var
ti:PTypeInfo;
td : PTypeData;
begin
ti:=TypeInfo(IMyNewMPInterface);
td := GetTypeData(ti);
// this gives an error (e.g. wrong data) on aarch64.
// after patch of ncgrtti.pas, data is correct (unit name)
if ti^.Kind = tkInterface then
begin
writeln('IntfUnit: ',td^.IntfUnit);
if td^.IntfUnit<>'SmallTestInterfaceRTTI' then
halt(1);
end
else
halt(2);
end.