paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-10 09:49:27 +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/tw0965.pp svneol=native#text/plain
tests/webtbs/tw0966.pp svneol=native#text/plain tests/webtbs/tw0966.pp svneol=native#text/plain
tests/webtbs/tw0976.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/tw10009.pp svneol=native#text/plain
tests/webtbs/tw10013.pp svneol=native#text/plain tests/webtbs/tw10013.pp svneol=native#text/plain
tests/webtbs/tw10072.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 eq:=te_incompatible
else if (not is_in_limit(def_from,def_to)) then else if (not is_in_limit(def_from,def_to)) then
{ "punish" bad type conversions :) (JM) } { "punish" bad type conversions :) (JM) }
eq:=te_convert_l3 eq:=te_convert_l2
else else
eq:=te_convert_l1; eq:=te_convert_l1;
end; end;
@ -505,7 +505,7 @@ implementation
(s64currencytype.typ = floatdef))) then (s64currencytype.typ = floatdef))) then
begin begin
doconv:=tc_int_2_real; doconv:=tc_int_2_real;
eq:=te_convert_l1; eq:=te_convert_l3;
end end
else if is_currency(def_from) else if is_currency(def_from)
{ and (s64currencytype.typ = orddef)) } then { and (s64currencytype.typ = orddef)) } then
@ -528,7 +528,7 @@ implementation
(m_delphi in current_settings.modeswitches)) then (m_delphi in current_settings.modeswitches)) then
begin begin
doconv:=tc_real_2_real; doconv:=tc_real_2_real;
{ do we loose precision? } { do we lose precision? }
if def_to.size<def_from.size then if def_to.size<def_from.size then
eq:=te_convert_l2 eq:=te_convert_l2
else else
@ -906,7 +906,7 @@ implementation
if (m_delphi in current_settings.modeswitches) and is_integer(def_from) then if (m_delphi in current_settings.modeswitches) and is_integer(def_from) then
begin begin
doconv:=tc_cord_2_pointer; doconv:=tc_cord_2_pointer;
eq:=te_convert_l2; eq:=te_convert_l4;
end; end;
end; end;
{ allow explicit typecasts from ordinals to pointer. { allow explicit typecasts from ordinals to pointer.

71
compiler/htypechk.pas
View File

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

3
compiler/ncnv.pas
View File

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

7
compiler/symconst.pas
View File

@ -433,8 +433,9 @@ type
tequaltype = ( tequaltype = (
te_incompatible, te_incompatible,
te_convert_operator, te_convert_operator,
te_convert_l3, { compatible conversion with possible loss of data } te_convert_l4, { and yet even less preferred conversion }
te_convert_l2, { compatible less prefered 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_convert_l1, { compatible conversion }
te_equal, { the definitions are equal } te_equal, { the definitions are equal }
te_exact te_exact
@ -492,7 +493,7 @@ const
); );
EqualTypeName : array[tequaltype] of string[16] = ( 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' '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.