* when forcing left into memory during code generation of a subscript node then the type of left must be passed else memory corruption happens

git-svn-id: trunk@22385 -
This commit is contained in:
florian 2012-09-13 19:22:42 +00:00
parent 0ad1a26c61
commit b72251389b
3 changed files with 50 additions and 1 deletions

1
.gitattributes vendored
View File

@ -12825,6 +12825,7 @@ tests/webtbs/tw22744.pp svneol=native#text/pascal
tests/webtbs/tw2277.pp svneol=native#text/plain
tests/webtbs/tw2280.pp svneol=native#text/plain
tests/webtbs/tw22860.pp svneol=native#text/plain
tests/webtbs/tw22864.pp svneol=native#text/pascal
tests/webtbs/tw22869.pp svneol=native#text/plain
tests/webtbs/tw2289.pp svneol=native#text/plain
tests/webtbs/tw2291.pp svneol=native#text/plain

View File

@ -368,7 +368,7 @@ implementation
if not tstoreddef(left.resultdef).is_intregable or
not tstoreddef(resultdef).is_intregable or
(location.loc in [LOC_MMREGISTER,LOC_FPUREGISTER]) then
hlcg.location_force_mem(current_asmdata.CurrAsmList,location,resultdef)
hlcg.location_force_mem(current_asmdata.CurrAsmList,location,left.resultdef)
else
begin
if (left.location.loc = LOC_REGISTER) then

48
tests/webtbs/tw22864.pp Normal file
View File

@ -0,0 +1,48 @@
program testmethodpointer;
{$mode objfpc}{$H+}
type
TOnIdentifierFound = function(): integer of object;
TTest=class
OnIdentifierFound: TOnIdentifierFound;
FoundProc: pointer;
function testm():integer;
end;
TTest2=class
function testmm(Params:TTest;var c,d,e:integer):boolean;
end;
function TTest.testm():integer;
begin
end;
function TTest2.testmm(Params:TTest;var c,d,e:integer):boolean;
var k,l:integer;
function testm2(Params1:TTest;var m,n:integer):boolean;
var a,b:integer;
begin
if (Params.OnIdentifierFound<>@Params.testm) then halt(1);
if (Params.FoundProc<>pointer($deadbeef)) then halt(1);
end;
begin
testm2(Params,k,l);
end;
var
Test : TTest;
Test2 : TTest2;
c,d,e : integer;
begin
Test:=TTest.Create;
Test.OnIdentifierFound:=@Test.testm;
Test.FoundProc:=pointer($deadbeef);
Test2:=TTest2.Create;
Test2.testmm(Test,c,d,e);
Test.Free;
Test2.Free;
writeln('ok');
end.