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

* fix overload choosing if both normal proc and proc of object are available

Browse Source 
git-svn-id: trunk@1496 -
This commit is contained in:
peter 2005-10-19 07:56:08 +00:00
parent 0d299d5d2b
commit f9db030350
6 changed files with 47 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -6305,6 +6305,7 @@ tests/webtbs/tw4188.pp svneol=native#text/plain
tests/webtbs/tw4199.pp svneol=native#text/plain
tests/webtbs/tw4201.pp svneol=native#text/plain
tests/webtbs/tw4202.pp svneol=native#text/plain
tests/webtbs/tw4209.pp svneol=native#text/plain
tests/webtbs/tw4215.pp svneol=native#text/plain
tests/webtbs/tw4219.pp svneol=native#text/plain
tests/webtbs/tw4223.pp svneol=native#text/plain

14
compiler/defcmp.pas
View File

@ -114,7 +114,7 @@ interface
{ True if a function can be assigned to a procvar }
{ changed first argument type to pabstractprocdef so that it can also be }
{ used to test compatibility between two pprocvardefs (JM) }
function proc_to_procvar_equal(def1:tabstractprocdef;def2:tprocvardef;methoderr:boolean):tequaltype;
function proc_to_procvar_equal(def1:tabstractprocdef;def2:tprocvardef):tequaltype;
implementation
@ -1020,7 +1020,7 @@ implementation
if (m_tp_procvar in aktmodeswitches) or
(m_mac_procvar in aktmodeswitches) then
begin
subeq:=proc_to_procvar_equal(tprocdef(def_from),tprocvardef(def_to),true);
subeq:=proc_to_procvar_equal(tprocdef(def_from),tprocvardef(def_to));
if subeq>te_incompatible then
begin
doconv:=tc_proc_2_procvar;
@ -1031,7 +1031,7 @@ implementation
procvardef :
begin
{ procvar -> procvar }
eq:=proc_to_procvar_equal(tprocvardef(def_from),tprocvardef(def_to),false);
eq:=proc_to_procvar_equal(tprocvardef(def_from),tprocvardef(def_to));
end;
pointerdef :
begin
@ -1455,7 +1455,7 @@ implementation
end;
function proc_to_procvar_equal(def1:tabstractprocdef;def2:tprocvardef;methoderr:boolean):tequaltype;
function proc_to_procvar_equal(def1:tabstractprocdef;def2:tprocvardef):tequaltype;
var
eq : tequaltype;
po_comp : tprocoptions;
@ -1466,11 +1466,7 @@ implementation
{ check for method pointer }
if (def1.is_methodpointer xor def2.is_methodpointer) or
(def1.is_addressonly xor def2.is_addressonly) then
begin
if methoderr then
Message(type_e_no_method_and_procedure_not_compatible);
exit;
end;
exit;
{ check return value and options, methodpointer is already checked }
po_comp:=[po_staticmethod,po_interrupt,
po_iocheck,po_varargs];

9
compiler/htypechk.pas
View File

@ -1367,7 +1367,7 @@ implementation
if ((m_tp_procvar in aktmodeswitches) or
(m_mac_procvar in aktmodeswitches)) and
(p.left.nodetype=calln) and
(proc_to_procvar_equal(tprocdef(tcallnode(p.left).procdefinition),tprocvardef(def_to),true)>=te_equal) then
(proc_to_procvar_equal(tprocdef(tcallnode(p.left).procdefinition),tprocvardef(def_to))>=te_equal) then
eq:=te_equal
else
if (m_mac_procvar in aktmodeswitches) and
@ -1835,7 +1835,7 @@ implementation
end
else
{ for value and const parameters check precision of real, give
penalty for loosing of precision }
penalty for loosing of precision. var and out parameters must match exactly }
if not(currpara.varspez in [vs_var,vs_out]) and
is_real(def_from) and
is_real(def_to) then
@ -1864,8 +1864,9 @@ implementation
end
else
{ related object parameters also need to determine the distance between the current
object and the object we are comparing with }
if (def_from.deftype=objectdef) and
object and the object we are comparing with. var and out parameters must match exactly }
if not(currpara.varspez in [vs_var,vs_out]) and
(def_from.deftype=objectdef) and
(def_to.deftype=objectdef) and
(tobjectdef(def_from).objecttype=tobjectdef(def_to).objecttype) and
tobjectdef(def_from).is_related(tobjectdef(def_to)) then

3
compiler/ncnv.pas
View File

@ -1511,8 +1511,7 @@ implementation
{ Now check if the procedure we are going to assign to
the procvar, is compatible with the procvar's type }
if not(nf_explicit in flags) and
(proc_to_procvar_equal(currprocdef,
tprocvardef(resulttype.def),true)=te_incompatible) then
(proc_to_procvar_equal(currprocdef,tprocvardef(resulttype.def))=te_incompatible) then
IncompatibleTypes(left.resulttype.def,resulttype.def);
exit;
end;

2
compiler/symsym.pas
View File

@ -882,7 +882,7 @@ implementation
pd:=pdlistfirst;
while assigned(pd) do
begin
eq:=proc_to_procvar_equal(pd^.def,d,false);
eq:=proc_to_procvar_equal(pd^.def,d);
if eq>=te_equal then
begin
{ multiple procvars with the same equal level }

34
tests/webtbs/tw4209.pp Executable file
View File

@ -0,0 +1,34 @@
{ Source provided for Free Pascal Bug Report 4209 }
{ Submitted by "Ivo Steinmann" on 2005-07-22 }
{ e-mail: isteinmann@bluewin.ch }
Program testprog;
{$mode delphi}
var
err : boolean;
type
XMethod = procedure of object;
XProcedure = procedure;
procedure Test(const Callback: XMethod); overload;
begin
end;
procedure Test(const Callback: XProcedure); overload;
begin
writeln('ok');
err:=false;
end;
procedure Foobar;
begin
end;
begin
err:=true;
Test(Foobar);
if err then
halt(1);
end.