mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 05:08:06 +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? }
|
||||
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
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