Merged revisions 7355 via svnmerge from

svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
  r7355 | peter | 2007-05-16 10:12:14 +0200 (Wed, 16 May 2007) | 3 lines
  
    * prefer overloaded methods in current object over
      inherited overloaded methods
........

git-svn-id: branches/fixes_2_2@7384 -

.gitattributes

@@ -8100,6 +8100,7 @@ tests/webtbs/tw8685.pp svneol=native#text/plain
 tests/webtbs/tw8757.pp svneol=native#text/plain
 tests/webtbs/tw8810.pp svneol=native#text/plain
 tests/webtbs/tw8838.pp svneol=native#text/plain
+tests/webtbs/tw8847.pp svneol=native#text/plain
 tests/webtbs/tw8861.pp svneol=native#text/plain
 tests/webtbs/tw8870.pp svneol=native#text/plain
 tests/webtbs/tw8883.pp svneol=native#text/plain

compiler/htypechk.pas

@@ -63,7 +63,7 @@ interface
         FParaNode   : tnode;
         FParaLength : smallint;
         FAllowVariant : boolean;
-        function proc_add(pd:tprocdef):pcandidate;
+        function proc_add(ps:tprocsym;pd:tprocdef):pcandidate;
       public
         constructor create(sym:tprocsym;st:TSymtable;ppn:tnode;isprop,ignorevis : boolean);
         constructor create_operator(op:ttoken;ppn:tnode);
@@ -1615,7 +1615,7 @@ implementation
                if (FParalength>=pd.minparacount) and
                   ((po_varargs in pd.procoptions) or { varargs }
                    (FParalength<=pd.maxparacount)) then
-                 proc_add(pd);
+                 proc_add(sym,pd);
              end;
           end;
 
@@ -1680,7 +1680,7 @@ implementation
                                   hp:=hp^.next;
                                 end;
                                if not found then
-                                 proc_add(pd);
+                                 proc_add(srprocsym,pd);
                              end;
                          end;
                       end;
@@ -1762,7 +1762,7 @@ implementation
                                 hp:=hp^.next;
                               end;
                             if not found then
-                              proc_add(pd);
+                              proc_add(srprocsym,pd);
                           end;
                       end;
                   end;
@@ -1787,7 +1787,7 @@ implementation
       end;
 
 
-    function tcallcandidates.proc_add(pd:tprocdef):pcandidate;
+    function tcallcandidates.proc_add(ps:tprocsym;pd:tprocdef):pcandidate;
       var
         defaultparacnt : integer;
       begin
@@ -1814,6 +1814,10 @@ implementation
                dec(result^.firstparaidx,defaultparacnt);
              end;
          end;
+        { Give a small penalty for overloaded methods not in
+          defined the current class/unit }
+        if ps.owner<>pd.owner then
+          result^.ordinal_distance:=result^.ordinal_distance+1.0;
       end;
 
 

tests/webtbs/tw8847.pp

@@ -0,0 +1,58 @@
+{$ifdef fpc}{$mode objfpc}{$h+}{$endif}
+
+uses
+  Classes;
+
+type
+  tbase = class(tobject)
+  public
+    function add: tobject; overload;
+    function add(aitem: tobject): integer; overload;
+  end;
+
+  timpl = class(tbase)
+  public
+    function add: tpersistent; overload;
+    function add(aitem: tpersistent): integer; overload;
+  end;
+
+var
+  err : boolean;
+	
+function tbase.add: tobject;
+begin
+  writeln('tbase.add:tobject');
+  result := nil;
+end;
+
+function tbase.add(aitem: tobject): integer;
+begin
+  writeln('tbase.add(aitem: tobject)');
+  result := -1;
+end;
+
+function timpl.add: tpersistent;
+begin
+  writeln('timpl.add:tpersistent');
+  result := nil;
+end;
+
+function timpl.add(aitem: tpersistent): integer;
+begin
+  writeln('timpl.add(aitem: tpersistent)');
+	err:=false;
+  result := -1
+end;
+
+var
+  vimpl: timpl;
+
+begin
+  err:=true;
+  vimpl := timpl.create;
+  vimpl.add(nil);
+  vimpl.free;
+	if err then
+	  halt(1);
+end.
+