* copy tcallnode.right after copying the callinitblock, as right can be a

temprefnode referring to a temp from the init block (mantis #31421)

git-svn-id: trunk@35478 -
This commit is contained in:
Jonas Maebe 2017-02-24 19:57:40 +00:00
parent b5fb9beec9
commit 1adde89621
3 changed files with 48 additions and 1 deletions

1
.gitattributes vendored
View File

@ -15381,6 +15381,7 @@ tests/webtbs/tw31305.pp svneol=native#text/pascal
tests/webtbs/tw3131.pp svneol=native#text/plain
tests/webtbs/tw31332.pp svneol=native#text/pascal
tests/webtbs/tw3137.pp svneol=native#text/plain
tests/webtbs/tw31421a.pp svneol=native#text/plain
tests/webtbs/tw3143.pp svneol=native#text/plain
tests/webtbs/tw3144.pp svneol=native#text/plain
tests/webtbs/tw3157.pp svneol=native#text/plain

View File

@ -1740,16 +1740,20 @@ implementation
n : tcallnode;
i : integer;
hp,hpn : tparavarsym;
oldleft : tnode;
oldleft, oldright : tnode;
para: tcallparanode;
begin
{ Need to use a hack here to prevent the parameters from being copied.
The parameters must be copied between callinitblock/callcleanupblock because
they can reference methodpointer }
{ same goes for right (= self/context for procvars) }
oldleft:=left;
left:=nil;
oldright:=right;
right:=nil;
n:=tcallnode(inherited dogetcopy);
left:=oldleft;
right:=oldright;
n.symtableprocentry:=symtableprocentry;
n.symtableproc:=symtableproc;
n.procdefinition:=procdefinition;
@ -1766,6 +1770,10 @@ implementation
n.left:=left.dogetcopy
else
n.left:=nil;
if assigned(right) then
n.right:=right.dogetcopy
else
n.right:=nil;
if assigned(methodpointer) then
n.methodpointer:=methodpointer.dogetcopy
else

38
tests/webtbs/tw31421a.pp Normal file
View File

@ -0,0 +1,38 @@
{ %norun }
{$mode objfpc}
{$h+}
unit tw31421a;
interface
type
TMessageReceivedEvent = function (const Received: TObject): boolean of object;
TMessageReceivedEventList = class
private
function Get(Index: Integer): TMessageReceivedEvent;
public
property MyItems[Index: Integer]: TMessageReceivedEvent read Get; default;
procedure ExecuteAll(A: TMessageReceivedEvent; const Received: TObject);
end;
implementation
{ TMessageReceivedEventList -------------------------------------------------- }
function TMessageReceivedEventList.Get(Index: Integer): TMessageReceivedEvent;
begin
//Result := ...;
end;
procedure TMessageReceivedEventList.ExecuteAll(A: TMessageReceivedEvent; const Received: TObject);
var
Handled: boolean;
begin
Handled := false;
Handled := MyItems[0](Received) or Handled;
end;
end.