diff --git a/.gitattributes b/.gitattributes index cb03d57635..97372e8a7f 100644 --- a/.gitattributes +++ b/.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 diff --git a/compiler/llvm/llvmdef.pas b/compiler/llvm/llvmdef.pas index 6a45784933..203160785f 100644 --- a/compiler/llvm/llvmdef.pas +++ b/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, diff --git a/compiler/ncgld.pas b/compiler/ncgld.pas index f8ee4cbf75..04e649c3e7 100644 --- a/compiler/ncgld.pas +++ b/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)); diff --git a/tests/webtbs/tw29086.pp b/tests/webtbs/tw29086.pp new file mode 100755 index 0000000000..314f409ea4 --- /dev/null +++ b/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. +