Explorar o código

* fixed getting address of interface methods after r32414: interfaces are not
a pointer to a vmt, but a pointer to a pointer to vmt (mantis #29086)
o also adjusted the llvm type for interfaces accordingly

git-svn-id: trunk@32530 -

Jonas Maebe %!s(int64=9) %!d(string=hai) anos
pai
achega
0c4edd2aa9
Modificáronse 4 ficheiros con 78 adicións e 12 borrados
  1. 1 0
      .gitattributes
  2. 2 2
      compiler/llvm/llvmdef.pas
  3. 16 10
      compiler/ncgld.pas
  4. 59 0
      tests/webtbs/tw29086.pp

+ 1 - 0
.gitattributes

@@ -14882,6 +14882,7 @@ tests/webtbs/tw29053.pp svneol=native#text/pascal
 tests/webtbs/tw29053b.pp svneol=native#text/pascal
 tests/webtbs/tw29064.pp svneol=native#text/plain
 tests/webtbs/tw2908.pp svneol=native#text/plain
+tests/webtbs/tw29086.pp -text svneol=native#text/plain
 tests/webtbs/tw2911.pp svneol=native#text/plain
 tests/webtbs/tw2912.pp svneol=native#text/plain
 tests/webtbs/tw2913.pp svneol=native#text/plain

+ 2 - 2
compiler/llvm/llvmdef.pas

@@ -482,10 +482,10 @@ implementation
               odt_interfacecorba,
               odt_dispinterface:
                 begin
-                  { type is a pointer to the vmt }
+                  { type is a pointer to a pointer to the vmt }
                   llvmaddencodedtype_intern(tobjectdef(def).vmt_def,flags,encodedstr);
                   if ([lef_typedecl,lef_noimplicitderef]*flags=[]) then
-                    encodedstr:=encodedstr+'*';
+                    encodedstr:=encodedstr+'**';
                 end;
               odt_interfacecom_function,
               odt_interfacecom_property,

+ 16 - 10
compiler/ncgld.pas

@@ -529,10 +529,8 @@ implementation
                              current_asmdata.CurrAsmList.Concat(tai_symbol.CreateName('VTREF'+tostr(current_asmdata.NextVTEntryNr)+'_'+procdef._class.vmt_mangledname+'$$'+tostr(vmtoffset div sizeof(pint)),AT_FUNCTION,0));
                            end;
             {$endif vtentry}
-                         { a classrefdef already points to the VMT, and
-                           so do interfaces }
-                         if (left.resultdef.typ<>classrefdef) and
-                            not is_any_interface_kind(left.resultdef) then
+                         if (left.resultdef.typ=objectdef) and
+                            assigned(tobjectdef(left.resultdef).vmt_field) then
                            begin
                              { vmt pointer is a pointer to the vmt record }
                              hlcg.reference_reset_base(href,vd,location.registerhi,0,vd.alignment);
@@ -541,15 +539,23 @@ implementation
                              hregister:=hlcg.getaddressregister(current_asmdata.CurrAsmList,vmtdef);
                              hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,tfieldvarsym(tobjectdef(left.resultdef).vmt_field).vardef,vmtdef,href,hregister);
                            end
-                         else
+                         else if left.resultdef.typ=classrefdef then
                            begin
+                             { classrefdef is a pointer to the vmt already }
                              hregister:=location.registerhi;
-                             if left.resultdef.typ=classrefdef then
-                               vmtdef:=cpointerdef.getreusable(tobjectdef(tclassrefdef(left.resultdef).pointeddef).vmt_def)
-                             else
-                               vmtdef:=cpointerdef.getreusable(tobjectdef(left.resultdef).vmt_def);
+                             vmtdef:=cpointerdef.getreusable(tobjectdef(tclassrefdef(left.resultdef).pointeddef).vmt_def);
                              hlcg.g_ptrtypecast_reg(current_asmdata.CurrAsmList,left.resultdef,vmtdef,hregister);
-                           end;
+                           end
+                         else if is_any_interface_kind(left.resultdef) then
+                           begin
+                             { an interface is a pointer to a pointer to a vmt }
+                             hlcg.reference_reset_base(href,vd,location.registerhi,0,vd.alignment);
+                             vmtdef:=cpointerdef.getreusable(tobjectdef(left.resultdef).vmt_def);
+                             hregister:=hlcg.getaddressregister(current_asmdata.CurrAsmList,vmtdef);
+                             hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,vmtdef,vmtdef,href,hregister);
+                           end
+                         else
+                           internalerror(2015112501);
                          { load method address }
                          vmtentry:=tabstractrecordsymtable(trecorddef(vmtdef.pointeddef).symtable).findfieldbyoffset(
                            tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber));

+ 59 - 0
tests/webtbs/tw29086.pp

@@ -0,0 +1,59 @@
+program project1;
+
+{$mode objfpc}{$h+}
+
+type
+  ITestInt = interface
+    function GetN(a:Integer):Integer;
+    function GetX(a:Integer):Integer;
+  end;
+
+  { TIntTest }
+
+  TIntTest = class(TInterfacedObject,ITestInt)
+    function GetN(a: Integer): Integer;
+    function GetX(a: Integer): Integer;
+  end;
+
+  TIntTestVal = record
+    FTestInt : ITestInt;
+  end;
+
+  TIntTestFunc = function(a:Integer):Integer of object;
+
+  TIntTestInclude = class
+    FValue : TIntTestVal;
+  end;
+
+  ttestobj = object
+    a, b : TIntTestFunc;
+  end;
+
+var
+  inttest : TIntTest;
+  inttestvalinc : TIntTestInclude;
+  x : ttestobj;
+
+{ TIntTest }
+
+function TIntTest.GetN(a: Integer): Integer;
+begin
+  Result:=a+1;
+end;
+
+function TIntTest.GetX(a: Integer): Integer;
+begin
+  Result:=a+2;
+end;
+
+
+begin
+  inttest:=TIntTest.Create;
+  inttestvalinc:=TIntTestInclude.Create;
+  inttestvalinc.FValue.FTestInt:=inttest;
+  x.a := @inttestvalinc.FValue.FTestInt.GetN;
+  x.b := @inttestvalinc.FValue.FTestInt.GetX;
+  writeln(x.a(1));
+  writeln(x.b(1));
+end.
+