mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-28 21:40:34 +02:00
* fix #39978: ensure that Self is captured when a method of the current class is captured into a function reference
+ added test
This commit is contained in:
parent
d221f42a57
commit
b051e7667c
@ -1094,10 +1094,23 @@ implementation
|
|||||||
{ does this need to capture Self? }
|
{ does this need to capture Self? }
|
||||||
else if not foreachnodestatic(pm_postprocess,n,@find_self_sym,@selfinfo) then
|
else if not foreachnodestatic(pm_postprocess,n,@find_self_sym,@selfinfo) then
|
||||||
begin
|
begin
|
||||||
{ does this need some other local variable or parameter? }
|
{ is this a method of the current class? }
|
||||||
foreachnodestatic(pm_postprocess,n,@collect_syms_to_capture,@pd)
|
if (n.resultdef.typ=procdef) and
|
||||||
end
|
assigned(tprocdef(n.resultdef).struct) and
|
||||||
else if not assigned(fieldsym) then
|
not (po_staticmethod in tprocdef(n.resultdef).procoptions) and
|
||||||
|
assigned(current_procinfo.procdef.struct) and
|
||||||
|
def_is_related(current_procinfo.procdef.struct,tprocdef(n.resultdef).struct) then
|
||||||
|
begin
|
||||||
|
selfinfo.selfsym:=tsym(current_procinfo.procdef.parast.find('self'));
|
||||||
|
if not assigned(selfinfo.selfsym) then
|
||||||
|
internalerror(2022110601);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
{ does this need some other local variable or parameter? }
|
||||||
|
foreachnodestatic(pm_postprocess,n,@collect_syms_to_capture,@pd)
|
||||||
|
end;
|
||||||
|
|
||||||
|
if assigned(selfinfo.selfsym) and not assigned(fieldsym) then
|
||||||
{ this isn't a procdef that was captured into a field, so capture the
|
{ this isn't a procdef that was captured into a field, so capture the
|
||||||
self }
|
self }
|
||||||
pd.add_captured_sym(selfinfo.selfsym,n.fileinfo);
|
pd.add_captured_sym(selfinfo.selfsym,n.fileinfo);
|
||||||
|
43
tests/webtbs/tw39978.pp
Normal file
43
tests/webtbs/tw39978.pp
Normal file
@ -0,0 +1,43 @@
|
|||||||
|
program tw39978;
|
||||||
|
|
||||||
|
{$IFDEF FPC}
|
||||||
|
{$mode delphi}
|
||||||
|
{$ModeSwitch functionreferences}
|
||||||
|
{$ELSE}
|
||||||
|
{$APPTYPE CONSOLE}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
type
|
||||||
|
TRefProc = reference to procedure(Sender: TObject);
|
||||||
|
|
||||||
|
procedure Test(P: TRefProc);
|
||||||
|
begin
|
||||||
|
P(nil);
|
||||||
|
end;
|
||||||
|
|
||||||
|
type
|
||||||
|
TMyObj = class(TObject)
|
||||||
|
public
|
||||||
|
procedure MyEvent(Sender: TObject);
|
||||||
|
procedure MyTest;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
Obj: TMyObj;
|
||||||
|
|
||||||
|
{ TMyObj }
|
||||||
|
procedure TMyObj.MyEvent(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if (Self<>Obj) then // solved with ObjFpc mode and Test(@MyEvent); using Self.MyEvent doesn't help either
|
||||||
|
Halt(1);
|
||||||
|
end;
|
||||||
|
procedure TMyObj.MyTest;
|
||||||
|
begin
|
||||||
|
Test(MyEvent);
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Obj := TMyObj.Create;
|
||||||
|
Obj.MyTest;
|
||||||
|
end.
|
||||||
|
|
Loading…
Reference in New Issue
Block a user