* 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:
Sven/Sarah Barth 2022-11-06 21:58:07 +01:00
parent d221f42a57
commit b051e7667c
2 changed files with 60 additions and 4 deletions

View File

@ -1094,10 +1094,23 @@ implementation
{ does this need to capture Self? }
else if not foreachnodestatic(pm_postprocess,n,@find_self_sym,@selfinfo) then
begin
{ does this need some other local variable or parameter? }
foreachnodestatic(pm_postprocess,n,@collect_syms_to_capture,@pd)
end
else if not assigned(fieldsym) then
{ is this a method of the current class? }
if (n.resultdef.typ=procdef) and
assigned(tprocdef(n.resultdef).struct) and
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
self }
pd.add_captured_sym(selfinfo.selfsym,n.fileinfo);

43
tests/webtbs/tw39978.pp Normal file
View 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.