* enable converting procedure callnodes with only default parameters into

procvars in tp/delphi mode (mantis #11771)

git-svn-id: trunk@13400 -

.gitattributes

@@ -9058,6 +9058,7 @@ tests/webtbs/tw11638.pp svneol=native#text/plain
 tests/webtbs/tw11711.pp svneol=native#text/plain
 tests/webtbs/tw11762.pp svneol=native#text/plain
 tests/webtbs/tw11763.pp svneol=native#text/plain
+tests/webtbs/tw11771.pp svneol=native#text/plain
 tests/webtbs/tw11786.pp svneol=native#text/plain
 tests/webtbs/tw11791.pp svneol=native#text/plain
 tests/webtbs/tw1181.pp svneol=native#text/plain

compiler/ncal.pas

@@ -144,6 +144,7 @@ interface
           function  docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
           function  para_count:longint;
+          function  required_para_count:longint;
           { checks if there are any parameters which end up at the stack, i.e.
             which have LOC_REFERENCE and set pi_has_stackparameter if this applies }
           procedure check_stack_parameters;
@@ -1219,6 +1220,23 @@ implementation
       end;
 
 
+    function tcallnode.required_para_count: longint;
+      var
+        ppn : tcallparanode;
+      begin
+        result:=0;
+        ppn:=tcallparanode(left);
+        while assigned(ppn) do
+          begin
+            if not(assigned(ppn.parasym) and
+                   ((vo_is_hidden_para in ppn.parasym.varoptions) or
+                    assigned(ppn.parasym.defaultconstsym))) then
+              inc(result);
+            ppn:=tcallparanode(ppn.right);
+          end;
+      end;
+
+
     function tcallnode.is_simple_para_load(p:tnode; may_be_in_reg: boolean):boolean;
       var
         hp : tnode;

compiler/ncnv.pas

@@ -1716,7 +1716,7 @@ implementation
                     a procvar. Because isconvertable cannot check for procedures we
                     use an extra check for them.}
                   if (left.nodetype=calln) and
-                     (tcallnode(left).para_count=0) and
+                     (tcallnode(left).required_para_count=0) and
                      (resultdef.typ=procvardef) and
                      (
                       (m_tp_procvar in current_settings.modeswitches) or

tests/webtbs/tw11771.pp

@@ -0,0 +1,54 @@
+{$MODE delphi}
+
+unit tw11771;
+
+interface
+
+
+type
+  
+   TEvent = procedure(A : TObject) of object;
+
+
+   TTest = class
+   private
+     FProc: TEvent;
+     procedure Proc1(A : TObject);
+     procedure Proc2(A : TObject = nil);
+
+   public 
+     constructor Create;
+     procedure B(A : TEvent);
+     property A	: TEvent read FProc write FProc;
+     end;	
+
+implementation
+
+     constructor TTest.Create;
+     begin
+//    FProc := Proc1;
+//    FProc := Proc2;
+    A := Proc1;
+    A := Proc2;
+//    B(Proc1);
+    B(Proc2);
+    
+     end;
+
+
+procedure ttest.Proc1(A : TObject);
+begin
+end;
+    
+
+procedure ttest.Proc2(A : TObject = nil);
+begin
+end;
+
+
+procedure ttest.B(A : TEvent);
+begin
+end;
+
+
+end.