From 13fb30c52ef398c3c8a82c262ea64bb83567fe55 Mon Sep 17 00:00:00 2001
From: Sven/Sarah Barth <pascaldragon@gmail.com>
Date: Fri, 16 Sep 2022 15:12:48 +0200
Subject: [PATCH] * fix #39902: correctly handle assignment of procvars to
 properties with a field write accessor + added adjusted/extended test

---
 compiler/pexpr.pas       | 10 +++++++++
 tests/webtbs/tw39902a.pp | 48 ++++++++++++++++++++++++++++++++++++++++
 2 files changed, 58 insertions(+)
 create mode 100644 tests/webtbs/tw39902a.pp

diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index b5ab078b11..32985b2c0b 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -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
diff --git a/tests/webtbs/tw39902a.pp b/tests/webtbs/tw39902a.pp
new file mode 100644
index 0000000000..5ca848c90a
--- /dev/null
+++ b/tests/webtbs/tw39902a.pp
@@ -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.