paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-14 05:40:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

* prefer overloaded methods in current object over

Browse Source 
inherited overloaded methods

git-svn-id: trunk@7355 -
This commit is contained in:
peter 2007-05-16 08:12:14 +00:00
parent 2d2469c45e
commit ea92a0e1a7
3 changed files with 68 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -8221,6 +8221,7 @@ tests/webtbs/tw8777g.pp svneol=native#text/plain
tests/webtbs/tw8777i.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

14
compiler/htypechk.pas
View File

@ -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);
@ -1645,7 +1645,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;
@ -1710,7 +1710,7 @@ implementation
hp:=hp^.next;
end;
if not found then
proc_add(pd);
proc_add(srprocsym,pd);
end;
end;
end;
@ -1792,7 +1792,7 @@ implementation
hp:=hp^.next;
end;
if not found then
proc_add(pd);
proc_add(srprocsym,pd);
end;
end;
end;
@ -1817,7 +1817,7 @@ implementation
end;
function tcallcandidates.proc_add(pd:tprocdef):pcandidate;
function tcallcandidates.proc_add(ps:tprocsym;pd:tprocdef):pcandidate;
var
defaultparacnt : integer;
begin
@ -1844,6 +1844,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;

58
tests/webtbs/tw8847.pp Normal file
View File

@ -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.