* make sure that anonymous inherited calls only call through to the

    overridden method, rather than to any method that can accept similar
    parameters as the current one (Delphi-compatible, and corresponds to
    what is described in our documentation)
  * do not flag "inherited" call nodes that are not "anonymous inherited"
    calls using the cnf_anon_inherited flag

git-svn-id: trunk@18162 -

.gitattributes

@@ -9133,6 +9133,7 @@ tests/tbs/tb0573.pp svneol=native#text/plain
 tests/tbs/tb0574.pp svneol=native#text/pascal
 tests/tbs/tb0575.pp svneol=native#text/plain
 tests/tbs/tb0576.pp svneol=native#text/plain
+tests/tbs/tb0577.pp svneol=native#text/plain
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain

compiler/htypechk.pas

@@ -67,12 +67,12 @@ interface
         FParaNode   : tnode;
         FParaLength : smallint;
         FAllowVariant : boolean;
-        procedure collect_overloads_in_struct(structdef:tabstractrecorddef;ProcdefOverloadList:TFPObjectList;searchhelpers:boolean);
+        procedure collect_overloads_in_struct(structdef:tabstractrecorddef;ProcdefOverloadList:TFPObjectList;searchhelpers,anoninherited:boolean);
         procedure collect_overloads_in_units(ProcdefOverloadList:TFPObjectList; objcidcall,explicitunit: boolean);
-        procedure create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers:boolean);
+        procedure create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited:boolean);
         function  proc_add(st:tsymtable;pd:tprocdef;objcidcall: boolean):pcandidate;
       public
-        constructor create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers:boolean);
+        constructor create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited:boolean);
         constructor create_operator(op:ttoken;ppn:tnode);
         destructor destroy;override;
         procedure list(all:boolean);
@@ -1758,7 +1758,7 @@ implementation
                            TCallCandidates
 ****************************************************************************}
 
-    constructor tcallcandidates.create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers:boolean);
+    constructor tcallcandidates.create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited:boolean);
       begin
         if not assigned(sym) then
           internalerror(200411015);
@@ -1766,7 +1766,7 @@ implementation
         FProcsym:=sym;
         FProcsymtable:=st;
         FParanode:=ppn;
-        create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers);
+        create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited);
       end;
 
 
@@ -1776,7 +1776,7 @@ implementation
         FProcsym:=nil;
         FProcsymtable:=nil;
         FParanode:=ppn;
-        create_candidate_list(false,false,false,false,false);
+        create_candidate_list(false,false,false,false,false,false);
       end;
 
 
@@ -1795,21 +1795,29 @@ implementation
       end;
 
 
-    procedure tcallcandidates.collect_overloads_in_struct(structdef:tabstractrecorddef;ProcdefOverloadList:TFPObjectList;searchhelpers:boolean);
+    procedure tcallcandidates.collect_overloads_in_struct(structdef:tabstractrecorddef;ProcdefOverloadList:TFPObjectList;searchhelpers,anoninherited:boolean);
 
-      function processprocsym(srsym:tprocsym):boolean;
+      function processprocsym(srsym:tprocsym; out foundanything: boolean):boolean;
         var
           j  : integer;
           pd : tprocdef;
         begin
-          { Store first procsym found }
-          if not assigned(FProcsym) then
-            FProcsym:=srsym;
           { add all definitions }
           result:=false;
+          foundanything:=false;
           for j:=0 to srsym.ProcdefList.Count-1 do
             begin
               pd:=tprocdef(srsym.ProcdefList[j]);
+              { in case of anonymous inherited, only match procdefs identical
+                to the current one (apart from hidden parameters), rather than
+                anything compatible to the parameters }
+              if anoninherited and
+                 (compare_paras(current_procinfo.procdef.paras,pd.paras,cp_all,[cpo_ignorehidden])<te_equal) then
+                continue;
+              foundanything:=true;
+              { Store first procsym found }
+              if not assigned(FProcsym) then
+                FProcsym:=tprocsym(srsym);
               if po_overload in pd.procoptions then
                 result:=true;
               ProcdefOverloadList.Add(srsym.ProcdefList[j]);
@@ -1819,7 +1827,8 @@ implementation
       var
         srsym      : tsym;
         hashedid   : THashedIDString;
-        hasoverload : boolean;
+        hasoverload,
+        foundanything : boolean;
         helperdef  : tobjectdef;
       begin
         if FOperator=NOTOKEN then
@@ -1843,9 +1852,10 @@ implementation
                            { Delphi allows hiding a property by a procedure with the same name }
                            (srsym.typ=procsym) then
                          begin
-                           hasoverload := processprocsym(tprocsym(srsym));
+                           hasoverload:=processprocsym(tprocsym(srsym),foundanything);
                            { when there is no explicit overload we stop searching }
-                           if not hasoverload then
+                           if foundanything and
+                              not hasoverload then
                              break;
                          end;
                        helperdef:=helperdef.childof;
@@ -1860,9 +1870,10 @@ implementation
               { Delphi allows hiding a property by a procedure with the same name }
               (srsym.typ=procsym) then
              begin
-               hasoverload:=processprocsym(tprocsym(srsym));
+               hasoverload:=processprocsym(tprocsym(srsym),foundanything);
                { when there is no explicit overload we stop searching }
-               if not hasoverload then
+               if foundanything and
+                  not hasoverload then
                  break;
              end;
            if is_objectpascal_helper(structdef) then
@@ -1875,9 +1886,10 @@ implementation
                   { Delphi allows hiding a property by a procedure with the same name }
                   (srsym.typ=procsym) then
                  begin
-                   hasoverload:=processprocsym(tprocsym(srsym));
+                   hasoverload:=processprocsym(tprocsym(srsym),foundanything);
                    { when there is no explicit overload we stop searching }
-                   if not hasoverload then
+                   if foundanything and
+                      not hasoverload then
                      break;
                  end;
              end;
@@ -1961,7 +1973,7 @@ implementation
       end;
 
 
-    procedure tcallcandidates.create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers:boolean);
+    procedure tcallcandidates.create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited:boolean);
       var
         j     : integer;
         pd    : tprocdef;
@@ -1979,7 +1991,7 @@ implementation
         if not objcidcall and
            (FOperator=NOTOKEN) and
            (FProcsym.owner.symtabletype in [objectsymtable,recordsymtable]) then
-          collect_overloads_in_struct(tabstractrecorddef(FProcsym.owner.defowner),ProcdefOverloadList,searchhelpers)
+          collect_overloads_in_struct(tabstractrecorddef(FProcsym.owner.defowner),ProcdefOverloadList,searchhelpers,anoninherited)
         else
         if (FOperator<>NOTOKEN) then
           begin
@@ -1989,7 +2001,7 @@ implementation
             while assigned(pt) do
               begin
                 if (pt.resultdef.typ=recorddef) then
-                  collect_overloads_in_struct(tabstractrecorddef(pt.resultdef),ProcdefOverloadList,searchhelpers);
+                  collect_overloads_in_struct(tabstractrecorddef(pt.resultdef),ProcdefOverloadList,searchhelpers,anoninherited);
                 pt:=tcallparanode(pt.right);
               end;
             collect_overloads_in_units(ProcdefOverloadList,objcidcall,explicitunit);

compiler/ncal.pas

@@ -2738,7 +2738,7 @@ implementation
                                     ((m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags));
                   candidates:=tcallcandidates.create(symtableprocentry,symtableproc,left,ignorevisibility,
                     not(nf_isproperty in flags),cnf_objc_id_call in callnodeflags,cnf_unit_specified in callnodeflags,
-                    callnodeflags*[cnf_anon_inherited,cnf_inherited]=[]);
+                    callnodeflags*[cnf_anon_inherited,cnf_inherited]=[],cnf_anon_inherited in callnodeflags);
 
                    { no procedures found? then there is something wrong
                      with the parameter size or the procedures are

compiler/pexpr.pas

@@ -2306,6 +2306,7 @@ implementation
          hs,hsorg   : string;
          hdef       : tdef;
          filepos    : tfileposinfo;
+         callflags  : tcallnodeflags;
          again,
          updatefpos,
          nodechanged  : boolean;
@@ -2452,7 +2453,10 @@ implementation
                              p1:=cerrornode.create;
                            end;
                        end;
-                       do_member_read(hclassdef,getaddr,srsym,p1,again,[cnf_inherited,cnf_anon_inherited]);
+                       callflags:=[cnf_inherited];
+                       if anon_inherited then
+                         include(callflags,cnf_anon_inherited);
+                       do_member_read(hclassdef,getaddr,srsym,p1,again,callflags);
                      end
                     else
                      begin

tests/tbs/tb0577.pp

@@ -0,0 +1,51 @@
+program tb0577;
+
+{$mode delphi}
+
+type
+  tc = class
+    procedure test(b: byte);virtual;overload;
+  end;
+
+  tc2 = class(tc)
+   strict protected
+    procedure test(b: byte; l: longint = 1234);virtual;overload;
+   public
+    procedure test(l: longint);virtual;overload;
+  end;
+
+  tc3 = class(tc2)
+    procedure test(b: byte);override;overload;
+  end;
+
+var
+  glob: longint;
+
+  procedure tc.test(b: byte);
+    begin
+      glob:=2;
+    end;
+
+  procedure tc2.test(l: longint);
+    begin
+      glob:=1;
+    end;
+
+  procedure tc2.test(b: byte; l: longint = 1234);
+    begin
+      glob:=3;
+    end;
+
+  procedure tc3.test(b: byte);
+    begin
+      inherited;
+    end;
+
+var
+  c: tc;
+begin
+  c:=tc3.create;
+  c.test(byte(4));
+  if glob<>2 then
+    halt(1);
+end.