diff --git a/.gitattributes b/.gitattributes index fdb9e2000d..d1e09cdcb0 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas index 73131e0701..1db9dab4b1 100644 --- a/compiler/htypechk.pas +++ b/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); @@ -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; diff --git a/tests/webtbs/tw8847.pp b/tests/webtbs/tw8847.pp new file mode 100644 index 0000000000..64331a3761 --- /dev/null +++ b/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. +