paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 21:09:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fix #39902: correctly handle assignment of procvars to properties with a field write accessor

Browse Source 
+ added adjusted/extended test
This commit is contained in:
Sven/Sarah Barth 2022-09-16 15:12:48 +02:00
parent 68253e2a73
commit 13fb30c52e
2 changed files with 58 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
compiler/pexpr.pas
View File

@ -1308,7 +1308,17 @@ implementation
include(p1.flags,nf_isproperty);
consume(_ASSIGNMENT);
{ read the expression }
if propsym.propdef.typ=procvardef then
getprocvardef:=tprocvardef(propsym.propdef)
else if is_invokable(propsym.propdef) then
getfuncrefdef:=tobjectdef(propsym.propdef);
p2:=comp_expr([ef_accept_equal]);
if assigned(getprocvardef) then
handle_procvar(getprocvardef,p2)
else if assigned(getfuncrefdef) then
handle_funcref(getfuncrefdef,p2);
getprocvardef:=nil;
getfuncrefdef:=nil;
p1:=cassignmentnode.create(p1,p2);
end
else

48
tests/webtbs/tw39902a.pp Normal file
View File

@ -0,0 +1,48 @@
{ %NORUN }
program tw39902a;
{$mode delphi}
uses Classes;
type TTest = class(TObject)
FEvent: TNotifyEvent;
procedure SetEvent(aValue: TNotifyEvent);
procedure SomeEvent (Sender: NativeInt); overload;
procedure SomeEvent (Sender: TObject); overload;
property Event1: TNotifyEvent read FEvent write FEvent;
property Event2: TNotifyEvent read FEvent write SetEvent;
end;
procedure TTest.SetEvent(aValue: TNotifyEvent);
begin
FEvent:=aValue;
end;
procedure TTest.SomeEvent (Sender: TObject);
begin
end;
procedure TTest.SomeEvent (Sender: NativeInt);
begin
end;
procedure Foo(aArg: TNotifyEvent);
begin
end;
var
x: TTest;
//y: TStringList;
m: TNotifyEvent;
begin
x := TTest.Create;
//y := TStringList.Create;
//y.OnChange := x.SomeEvent;
x.Event1 := x.SomeEvent;
x.Event2 := x.SomeEvent;
m := x.SomeEvent;
Foo(x.someEvent);
end.