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

* prefer non-matching orddef conversions to orddef-to-pointer conversions

Browse Source 
(mantis #10002) and also to orddef-to-real conversions
    (delphi-compatible). More tests and fixes will follow later.

git-svn-id: trunk@9015 -
This commit is contained in:
Jonas Maebe 2007-10-31 17:20:37 +00:00
parent df2ecd14f5
commit 82a0749970
6 changed files with 82 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -7599,6 +7599,7 @@ tests/webtbs/tw0961.pp svneol=native#text/plain
tests/webtbs/tw0965.pp svneol=native#text/plain
tests/webtbs/tw0966.pp svneol=native#text/plain
tests/webtbs/tw0976.pp svneol=native#text/plain
tests/webtbs/tw10002.pp svneol=native#text/plain
tests/webtbs/tw10009.pp svneol=native#text/plain
tests/webtbs/tw10013.pp svneol=native#text/plain
tests/webtbs/tw10072.pp svneol=native#text/plain

8
compiler/defcmp.pas
View File

@ -252,7 +252,7 @@ implementation
eq:=te_incompatible
else if (not is_in_limit(def_from,def_to)) then
{ "punish" bad type conversions :) (JM) }
eq:=te_convert_l3
eq:=te_convert_l2
else
eq:=te_convert_l1;
end;
@ -505,7 +505,7 @@ implementation
(s64currencytype.typ = floatdef))) then
begin
doconv:=tc_int_2_real;
eq:=te_convert_l1;
eq:=te_convert_l3;
end
else if is_currency(def_from)
{ and (s64currencytype.typ = orddef)) } then
@ -528,7 +528,7 @@ implementation
(m_delphi in current_settings.modeswitches)) then
begin
doconv:=tc_real_2_real;
{ do we loose precision? }
{ do we lose precision? }
if def_to.size<def_from.size then
eq:=te_convert_l2
else
@ -906,7 +906,7 @@ implementation
if (m_delphi in current_settings.modeswitches) and is_integer(def_from) then
begin
doconv:=tc_cord_2_pointer;
eq:=te_convert_l2;
eq:=te_convert_l4;
end;
end;
{ allow explicit typecasts from ordinals to pointer.

71
compiler/htypechk.pas
View File

@ -48,6 +48,7 @@ interface
cl1_count,
cl2_count,
cl3_count,
cl4_count,
coper_count : integer; { should be signed }
ordinal_distance : double;
invalid : boolean;
@ -1895,6 +1896,7 @@ implementation
' l1: '+tostr(hp^.cl1_count)+
' l2: '+tostr(hp^.cl2_count)+
' l3: '+tostr(hp^.cl3_count)+
' l4: '+tostr(hp^.cl4_count)+
' oper: '+tostr(hp^.coper_count)+
' ord: '+realtostr(hp^.ordinal_distance));
{ Print parameters in left-right order }
@ -2127,6 +2129,8 @@ implementation
inc(hp^.cl2_count);
te_convert_l3 :
inc(hp^.cl3_count);
te_convert_l4 :
inc(hp^.cl4_count);
te_convert_operator :
inc(hp^.coper_count);
te_incompatible :
@ -2252,39 +2256,44 @@ implementation
res:=(bestpd^.coper_count-currpd^.coper_count);
if (res=0) then
begin
{ less cl3 parameters? }
res:=(bestpd^.cl3_count-currpd^.cl3_count);
{ less cl4 parameters? }
res:=(bestpd^.cl4_count-currpd^.cl4_count);
if (res=0) then
begin
{ less cl2 parameters? }
res:=(bestpd^.cl2_count-currpd^.cl2_count);
if (res=0) then
begin
{ less cl1 parameters? }
res:=(bestpd^.cl1_count-currpd^.cl1_count);
if (res=0) then
begin
{ more exact parameters? }
res:=(currpd^.exact_count-bestpd^.exact_count);
if (res=0) then
begin
{ less equal parameters? }
res:=(bestpd^.equal_count-currpd^.equal_count);
if (res=0) then
begin
{ smaller ordinal distance? }
if (currpd^.ordinal_distance<bestpd^.ordinal_distance) then
res:=1
else
if (currpd^.ordinal_distance>bestpd^.ordinal_distance) then
res:=-1
else
res:=0;
end;
end;
end;
end;
end;
{ less cl3 parameters? }
res:=(bestpd^.cl3_count-currpd^.cl3_count);
if (res=0) then
begin
{ less cl2 parameters? }
res:=(bestpd^.cl2_count-currpd^.cl2_count);
if (res=0) then
begin
{ less cl1 parameters? }
res:=(bestpd^.cl1_count-currpd^.cl1_count);
if (res=0) then
begin
{ more exact parameters? }
res:=(currpd^.exact_count-bestpd^.exact_count);
if (res=0) then
begin
{ less equal parameters? }
res:=(bestpd^.equal_count-currpd^.equal_count);
if (res=0) then
begin
{ smaller ordinal distance? }
if (currpd^.ordinal_distance<bestpd^.ordinal_distance) then
res:=1
else
if (currpd^.ordinal_distance>bestpd^.ordinal_distance) then
res:=-1
else
res:=0;
end;
end;
end;
end;
end;
end;
end;
end;
is_better_candidate:=res;

3
compiler/ncnv.pas
View File

@ -1714,7 +1714,8 @@ implementation
te_convert_l1,
te_convert_l2,
te_convert_l3 :
te_convert_l3,
te_convert_l4:
begin
result := simplify;
if assigned(result) then

7
compiler/symconst.pas
View File

@ -433,8 +433,9 @@ type
tequaltype = (
te_incompatible,
te_convert_operator,
te_convert_l3, { compatible conversion with possible loss of data }
te_convert_l2, { compatible less prefered conversion }
te_convert_l4, { and yet even less preferred conversion }
te_convert_l3, { even less preferred conversion (possibly with loss of data) }
te_convert_l2, { compatible less preferred conversion }
te_convert_l1, { compatible conversion }
te_equal, { the definitions are equal }
te_exact
@ -492,7 +493,7 @@ const
);
EqualTypeName : array[tequaltype] of string[16] = (
'incompatible','convert_operator','convert_l3','convert_l2',
'incompatible','convert_operator','convert_l4','convert_l3','convert_l2',
'convert_l1','equal','exact'
);

31
tests/webtbs/tw10002.pp Normal file
View File

@ -0,0 +1,31 @@
program OverloadMistaken;
{$ifdef fpc}
{$mode delphi}
{$endif}
type _ulong = Cardinal;
TCCC = class
public
constructor Create(Size: _ulong=0); overload;
constructor Create(Buffer: Pointer); overload;
end;
constructor TCCC.Create(Size: _ulong);
begin
inherited Create;
WriteLn('TCCC.Create(Size: _ulong) called.');
end;
constructor TCCC.Create(Buffer: Pointer);
begin
halt(1);
end;
var c: TCCC;
l: longint;
begin
c := TCCC.Create(20);
c := TCCC.Create(l);
end.