* give an error if a routine definition defines default values for

parameters that do not appear in forward/interface definitions
    (mantis #19434)
  * added test for #17136 already works

git-svn-id: trunk@21524 -

.gitattributes

@@ -11616,6 +11616,7 @@ tests/webtbf/tw19213.pp svneol=native#text/plain
 tests/webtbf/tw1927.pp svneol=native#text/plain
 tests/webtbf/tw1928.pp svneol=native#text/plain
 tests/webtbf/tw1939.pp svneol=native#text/plain
+tests/webtbf/tw19434.pp svneol=native#text/plain
 tests/webtbf/tw19463.pp svneol=native#text/pascal
 tests/webtbf/tw1949.pp svneol=native#text/plain
 tests/webtbf/tw19591.pp svneol=native#text/plain
@@ -12363,6 +12364,7 @@ tests/webtbs/tw16980.pp svneol=native#text/plain
 tests/webtbs/tw1699.pp svneol=native#text/plain
 tests/webtbs/tw1709.pp svneol=native#text/plain
 tests/webtbs/tw17118.pp svneol=native#text/plain
+tests/webtbs/tw17136.pp svneol=native#text/plain
 tests/webtbs/tw17164.pp svneol=native#text/plain
 tests/webtbs/tw17180.pp svneol=native#text/plain
 tests/webtbs/tw17181.pp svneol=native#text/plain
@@ -12495,6 +12497,8 @@ tests/webtbs/tw1935.pp svneol=native#text/plain
 tests/webtbs/tw1936.pp svneol=native#text/plain
 tests/webtbs/tw19368.pp svneol=native#text/pascal
 tests/webtbs/tw1938.pp svneol=native#text/plain
+tests/webtbs/tw19434a.pp svneol=native#text/plain
+tests/webtbs/tw19434b.pp svneol=native#text/plain
 tests/webtbs/tw1948.pp svneol=native#text/plain
 tests/webtbs/tw19498.pp svneol=native#text/pascal
 tests/webtbs/tw19499.pp svneol=native#text/pascal

compiler/defcmp.pas

@@ -133,6 +133,10 @@ interface
       are allowed (in this case, the search order will first
       search for a routine with default parameters, before
       searching for the same definition with no parameters)
+
+      para1 is expected to be parameter list of the first encountered
+      declaration (interface, forward), and para2 that of the second one
+      (important in case of cpo_comparedefaultvalue)
     }
     function compare_paras(para1,para2 : TFPObjectList; acp : tcompare_paras_type; cpoptions: tcompare_paras_options):tequaltype;
 
@@ -1964,13 +1968,19 @@ implementation
               if eq<lowesteq then
                 lowesteq:=eq;
               { also check default value if both have it declared }
-              if (cpo_comparedefaultvalue in cpoptions) and
-                 assigned(currpara1.defaultconstsym) and
-                 assigned(currpara2.defaultconstsym) then
-               begin
-                 if not equal_constsym(tconstsym(currpara1.defaultconstsym),tconstsym(currpara2.defaultconstsym)) then
-                   exit;
-               end;
+              if (cpo_comparedefaultvalue in cpoptions) then
+                begin
+                  if assigned(currpara1.defaultconstsym) and
+                     assigned(currpara2.defaultconstsym) then
+                    begin
+                      if not equal_constsym(tconstsym(currpara1.defaultconstsym),tconstsym(currpara2.defaultconstsym)) then
+                        exit;
+                    end
+                  { cannot have that the second (= implementation) has a default value declared and the
+                    other (interface) doesn't }
+                  else if not assigned(currpara1.defaultconstsym) and assigned(currpara2.defaultconstsym) then
+                    exit;
+                end;
               if not(cpo_compilerproc in cpoptions) and
                  not(cpo_rtlproc in cpoptions) and
                  is_ansistring(currpara1.vardef) and

compiler/nobj.pas

@@ -557,7 +557,7 @@ implementation
                   begin
                     implprocdef:=tprocdef(tprocsym(srsym).ProcdefList[i]);
                     if (implprocdef.procsym=tprocsym(srsym)) and
-                       (compare_paras(proc.paras,implprocdef.paras,cp_all,[cpo_ignorehidden,cpo_comparedefaultvalue,cpo_ignoreuniv])>=te_equal) and
+                       (compare_paras(proc.paras,implprocdef.paras,cp_all,[cpo_ignorehidden,cpo_ignoreuniv])>=te_equal) and
                        (compare_defs(proc.returndef,implprocdef.returndef,nothingn)>=te_equal) and
                        (proc.proccalloption=implprocdef.proccalloption) and
                        (proc.proctypeoption=implprocdef.proctypeoption) and

compiler/pdecsub.pas

@@ -2939,9 +2939,13 @@ const
                not(po_overload in fwpd.procoptions)
               ) or
               { check arguments, we need to check only the user visible parameters. The hidden parameters
-                can be in a different location because of the calling convention, eg. L-R vs. R-L order (PFV) }
+                can be in a different location because of the calling convention, eg. L-R vs. R-L order (PFV)
+
+                don't check default values here, because routines that are the same except for their default
+                values should be reported as mismatches (since you can't overload based on different default
+                parameter values) }
               (
-               (compare_paras(currpd.paras,fwpd.paras,cp_none,[cpo_comparedefaultvalue,cpo_ignorehidden,cpo_openequalisexact,cpo_ignoreuniv])=te_exact) and
+               (compare_paras(fwpd.paras,currpd.paras,cp_none,[cpo_ignorehidden,cpo_openequalisexact,cpo_ignoreuniv])=te_exact) and
                (compare_defs(fwpd.returndef,currpd.returndef,nothingn)=te_exact)
               ) then
              begin
@@ -3009,10 +3013,13 @@ const
                     end;
 
                    { Check if the procedure type and return type are correct,
-                     also the parameters must match also with the type }
+                     also the parameters must match also with the type and that
+                     if the implementation has default parameters, the interface
+                     also has them and that if they both have them, that they
+                     have the same value }
                    if ((m_repeat_forward in current_settings.modeswitches) or
                        not is_bareprocdef(currpd)) and
-                      ((compare_paras(currpd.paras,fwpd.paras,cp_all,paracompopt)<>te_exact) or
+                      ((compare_paras(fwpd.paras,currpd.paras,cp_all,paracompopt)<>te_exact) or
                        (compare_defs(fwpd.returndef,currpd.returndef,nothingn)<>te_exact)) then
                      begin
                        MessagePos1(currpd.fileinfo,parser_e_header_dont_match_forward,

tests/webtbf/tw19434.pp

@@ -0,0 +1,18 @@
+{ %fail }
+
+unit tw19434;
+{$mode delphi}
+
+interface
+
+function PostMessage2MainWnd(Msg: cardinal; wParam: longint;
+  lParam: longint): boolean;
+
+implementation
+
+function PostMessage2MainWnd(Msg: cardinal; wParam: longint = 0;
+  lParam: longint = 0): boolean; 
+begin
+end;
+
+end.

tests/webtbs/tw17136.pp

@@ -0,0 +1,27 @@
+{ %opt=-vw -Sew }
+
+{$mode objfpc}
+
+type
+  TA = class
+  public
+    procedure A(X: boolean = false); virtual; abstract;
+  end;
+
+  TB = class(TA)
+  public
+    procedure A(X: boolean = true); override;
+  end;
+
+procedure TB.A(X: boolean = true);
+begin
+  writeln('hi');
+end;
+
+var
+  B: TB;
+begin
+  B := TB.Create;
+  B.A;
+  B.Free;
+end.

tests/webtbs/tw19434a.pp

@@ -0,0 +1,23 @@
+{ %norun }
+
+unit tw19434a;
+{$mode delphi}
+
+interface
+
+    function Connect(const aHost: string; const aPort: Word = 21): Boolean; overload;
+    function Connect: Boolean; overload;
+
+implementation
+
+    function Connect(const aHost: string; const aPort: Word): Boolean;
+      begin
+      end;
+
+
+    function Connect: Boolean;
+      begin
+      end;
+
+end.
+

tests/webtbs/tw19434b.pp

@@ -0,0 +1,28 @@
+{ %norun }
+
+unit tw19434b;
+{$ifdef fpc}
+{$mode delphi}
+{$endif}
+
+interface
+
+type
+  tintf = interface
+    procedure connect(s: string; port: longint = 23);
+  end;
+
+  tc = class(tinterfacedobject,tintf)
+    procedure connect(s: string; port: longint);
+  end;
+
+
+implementation
+
+
+  procedure tc.connect(s: string; port: longint);
+    begin
+    end;
+
+end.
+