mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-12-05 14:47:21 +01:00
* 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:
parent
b5fb9beec9
commit
1adde89621
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -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
|
||||
|
||||
@ -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
38
tests/webtbs/tw31421a.pp
Normal 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.
|
||||
Loading…
Reference in New Issue
Block a user