Browse Source

* fix #39902: correctly handle assignment of procvars to properties with a field write accessor
+ added adjusted/extended test

Sven/Sarah Barth 2 years ago
parent
commit
13fb30c52e
2 changed files with 58 additions and 0 deletions
  1. 10 0
      compiler/pexpr.pas
  2. 48 0
      tests/webtbs/tw39902a.pp

+ 10 - 0
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

+ 48 - 0
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.