fcl-passrc: nicer error message when calling property proc var with wrong args

git-svn-id: trunk@35735 -

packages/fcl-passrc/src/pasresolver.pp

@@ -4953,6 +4953,14 @@ begin
       else if FindCallData.Found is TPasType then
         // Note: check TPasType after TPasUnresolvedSymbolRef
         CheckTypeCast(TPasType(FindCallData.Found),Params,true)
+      else if FindCallData.Found is TPasVariable then
+        begin
+        TypeEl:=ResolveAliasType(TPasVariable(FindCallData.Found).VarType);
+        if TypeEl is TPasProcedureType then
+          CheckCallProcCompatibility(TPasProcedureType(TypeEl),Params,true)
+        else
+          RaiseMsg(20170405003522,nIllegalQualifier,sIllegalQualifier,['('],Params);
+        end
       else
         RaiseNotYetImplemented(20161003134755,FindCallData.Found);
       end;

packages/fcl-passrc/tests/tcresolver.pas

@@ -518,6 +518,8 @@ type
     Procedure TestProcType_AllowNested;
     Procedure TestProcType_AllowNestedOfObject;
     Procedure TestProcType_AsArgOtherUnit;
+    Procedure TestProcType_Property;
+    Procedure TestProcType_PropertyCallWrongArgFail;
   end;
 
 function LinesToStr(Args: array of const): string;
@@ -8360,6 +8362,51 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestProcType_Property;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class end;');
+  Add('  TNotifyEvent = procedure(Sender: TObject) of object;');
+  Add('  TControl = class');
+  Add('    FOnClick: TNotifyEvent;');
+  Add('    property OnClick: TNotifyEvent read FOnClick write FOnClick;');
+  Add('    procedure Click(Sender: TObject);');
+  Add('  end;');
+  Add('procedure TControl.Click(Sender: TObject);');
+  Add('begin');
+  Add('  if Assigned(OnClick) then ;');
+  Add('  OnClick:=@Click');
+  Add('  OnClick(Sender);');
+  Add('  Self.OnClick(Sender);');
+  Add('  with Self do OnClick(Sender);');
+  Add('end;');
+  Add('var Btn: TControl;');
+  Add('begin');
+  Add('  if Assigned(Btn.OnClick) then ;');
+  Add('  Btn.OnClick(Btn);');
+  Add('  Btn.OnClick(Btn);');
+  Add('  with Btn do OnClick(Btn);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcType_PropertyCallWrongArgFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class end;');
+  Add('  TNotifyEvent = procedure(Sender: TObject) of object;');
+  Add('  TControl = class');
+  Add('    FOnClick: TNotifyEvent;');
+  Add('    property OnClick: TNotifyEvent read FOnClick write FOnClick;');
+  Add('  end;');
+  Add('var Btn: TControl;');
+  Add('begin');
+  Add('  Btn.OnClick(3);');
+  CheckResolverException('Incompatible type arg no. 1: Got "Longint", expected "TObject"',
+    nIncompatibleTypeArgNo);
+end;
+
 initialization
   RegisterTests([TTestResolver]);