Browse Source

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

git-svn-id: trunk@34695 -
Jonas Maebe 8 years ago
parent
commit
5efb32285a
3 changed files with 39 additions and 3 deletions
  1. 1 0
      .gitattributes
  2. 5 3
      compiler/ncgrtti.pas
  3. 33 0
      tests/webtbs/tw30182.pp

+ 1 - 0
.gitattributes

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

+ 5 - 3
compiler/ncgrtti.pas

@@ -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 - 0
tests/webtbs/tw30182.pp

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