mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-12 13:31:14 +02:00
* 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:
parent
0ad1a26c61
commit
b72251389b
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -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
|
||||
|
@ -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
48
tests/webtbs/tw22864.pp
Normal 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.
|
Loading…
Reference in New Issue
Block a user