fpc/tests/webtbs/tw29086.pp
Jonas Maebe 0c4edd2aa9 * 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 -
2015-11-25 19:28:17 +00:00

60 lines
1.1 KiB
ObjectPascal
Executable File

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.