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

* compare_defs_ext has now a options argument

Browse Source 
* fixes for variants
This commit is contained in:
peter 2004-02-13 15:42:21 +00:00
parent 4f913922fa
commit 3a3fdde6d1
5 changed files with 97 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

96
compiler/defcmp.pas
View File

@ -38,7 +38,10 @@ interface
tcompare_paras_type = ( cp_none, cp_value_equal_const, cp_all,cp_procvar);
tcompare_paras_option = (cpo_allowdefaults,cpo_ignorehidden,cpo_allowconvert,cpo_comparedefaultvalue);
tcompare_paras_options = set of tcompare_paras_option;
tcompare_defs_option = (cdo_explicit,cdo_check_operator,cdo_allow_variant);
tcompare_defs_options = set of tcompare_defs_option;
tconverttype = (
tc_equal,
tc_not_possible,
@ -79,10 +82,9 @@ interface
function compare_defs_ext(def_from,def_to : tdef;
fromtreetype : tnodetype;
explicit : boolean;
check_operator : boolean;
var doconv : tconverttype;
var operatorpd : tprocdef):tequaltype;
var operatorpd : tprocdef;
cdoptions:tcompare_defs_options):tequaltype;
{ Returns if the type def_from can be converted to def_to or if both types are equal }
function compare_defs(def_from,def_to:tdef;fromtreetype:tnodetype):tequaltype;
@ -123,10 +125,9 @@ implementation
function compare_defs_ext(def_from,def_to : tdef;
fromtreetype : tnodetype;
explicit : boolean;
check_operator : boolean;
var doconv : tconverttype;
var operatorpd : tprocdef):tequaltype;
var operatorpd : tprocdef;
cdoptions:tcompare_defs_options):tequaltype;
{ Tbasetype:
uvoid,
@ -214,7 +215,7 @@ implementation
end
else
begin
if explicit then
if cdo_explicit in cdoptions then
doconv:=basedefconvertsexplicit[basedeftbl[torddef(def_from).typ],basedeftbl[torddef(def_to).typ]]
else
doconv:=basedefconvertsimplicit[basedeftbl[torddef(def_from).typ],basedeftbl[torddef(def_to).typ]];
@ -232,7 +233,7 @@ implementation
enumdef :
begin
{ needed for char(enum) }
if explicit then
if cdo_explicit in cdoptions then
begin
doconv:=tc_int_2_int;
eq:=te_convert_l1;
@ -250,7 +251,7 @@ implementation
procvardef,
pointerdef :
begin
if explicit then
if cdo_explicit in cdoptions then
begin
eq:=te_convert_l1;
if (fromtreetype=niln) then
@ -398,7 +399,7 @@ implementation
eq:=te_equal
else
begin
if not(explicit) or
if not(cdo_explicit in cdoptions) or
not(m_delphi in aktmodeswitches) then
begin
doconv:=tc_real_2_real;
@ -418,7 +419,7 @@ implementation
case def_from.deftype of
enumdef :
begin
if explicit then
if cdo_explicit in cdoptions then
begin
eq:=te_convert_l1;
doconv:=tc_int_2_int;
@ -441,7 +442,7 @@ implementation
end;
orddef :
begin
if explicit then
if cdo_explicit in cdoptions then
begin
eq:=te_convert_l1;
doconv:=tc_int_2_int;
@ -493,7 +494,7 @@ implementation
begin
subeq:=compare_defs_ext(tarraydef(def_from).elementtype.def,
tarraydef(def_to).elementtype.def,
arrayconstructorn,false,true,hct,hpd);
arrayconstructorn,hct,hpd,[cdo_check_operator]);
if (subeq>=te_equal) then
begin
doconv:=tc_equal;
@ -617,22 +618,25 @@ implementation
end;
end;
variantdef :
begin
case def_from.deftype of
enumdef :
begin
doconv:=tc_enum_2_variant;
eq:=te_convert_l1;
begin
if (cdo_allow_variant in cdoptions) then
begin
case def_from.deftype of
enumdef :
begin
doconv:=tc_enum_2_variant;
eq:=te_convert_l1;
end;
arraydef :
begin
if is_dynamic_array(def_from) then
begin
doconv:=tc_dynarray_2_variant;
eq:=te_convert_l1;
end;
end;
end;
arraydef :
begin
if is_dynamic_array(def_from) then
begin
doconv:=tc_dynarray_2_variant;
eq:=te_convert_l1;
end;
end;
end;
end;
end;
pointerdef :
@ -649,7 +653,7 @@ implementation
eq:=te_convert_l1;
end
else
if explicit then
if cdo_explicit in cdoptions then
begin
{ pchar(ansistring) }
if is_pchar(def_to) and
@ -686,7 +690,7 @@ implementation
eq:=te_convert_l1;
end;
end;
if (eq=te_incompatible) and explicit then
if (eq=te_incompatible) and (cdo_explicit in cdoptions) then
begin
doconv:=tc_int_2_int;
eq:=te_convert_l1;
@ -926,7 +930,7 @@ implementation
else
begin
doconv:=tc_equal;
if explicit or
if (cdo_explicit in cdoptions) or
tobjectdef(tclassrefdef(def_from).pointertype.def).is_related(
tobjectdef(tclassrefdef(def_to).pointertype.def)) then
eq:=te_convert_l1;
@ -1014,9 +1018,19 @@ implementation
{ if we didn't find an appropriate type conversion yet
then we search also the := operator }
if (eq=te_incompatible) and
check_operator and
((def_from.deftype in [objectdef,recorddef,arraydef,stringdef,variantdef]) or
(def_to.deftype in [objectdef,recorddef,arraydef,stringdef,variantdef])) then
(
{ Check for variants? }
(
(cdo_allow_variant in cdoptions) and
((def_from.deftype=variantdef) or (def_to.deftype=variantdef))
) or
{ Check for operators? }
(
(cdo_check_operator in cdoptions) and
((def_from.deftype in [objectdef,recorddef,arraydef,stringdef,variantdef]) or
(def_to.deftype in [objectdef,recorddef,arraydef,stringdef,variantdef]))
)
) then
begin
operatorpd:=search_assignment_operator(def_from,def_to);
if assigned(operatorpd) then
@ -1039,7 +1053,7 @@ implementation
begin
{ Compare defs with nothingn and no explicit typecasts and
searching for overloaded operators is not needed }
equal_defs:=(compare_defs_ext(def_from,def_to,nothingn,false,false,convtyp,pd)>=te_equal);
equal_defs:=(compare_defs_ext(def_from,def_to,nothingn,convtyp,pd,[])>=te_equal);
end;
@ -1048,7 +1062,7 @@ implementation
doconv : tconverttype;
pd : tprocdef;
begin
compare_defs:=compare_defs_ext(def_from,def_to,fromtreetype,false,true,doconv,pd);
compare_defs:=compare_defs_ext(def_from,def_to,fromtreetype,doconv,pd,[cdo_check_operator,cdo_allow_variant]);
end;
@ -1166,7 +1180,7 @@ implementation
if (currpara1.paratyp<>currpara2.paratyp) then
exit;
eq:=compare_defs_ext(currpara1.paratype.def,currpara2.paratype.def,nothingn,
false,true,convtype,hpd);
convtype,hpd,[cdo_check_operator,cdo_allow_variant]);
if (eq>te_incompatible) and
(eq<te_equal) and
not(
@ -1252,7 +1266,11 @@ implementation
end.
{
$Log$
Revision 1.44 2004-02-04 22:15:15 daniel
Revision 1.45 2004-02-13 15:42:21 peter
* compare_defs_ext has now a options argument
* fixes for variants
Revision 1.44 2004/02/04 22:15:15 daniel
* Rtti generation moved to ncgutil
* Assmtai usage of symsym removed
* operator overloading cleanup up

8
compiler/htypechk.pas
View File

@ -264,7 +264,7 @@ implementation
case treetyp of
assignn :
begin
eq:=compare_defs_ext(rd,dd,nothingn,true,false,conv,pd);
eq:=compare_defs_ext(rd,dd,nothingn,conv,pd,[cdo_explicit]);
if eq<>te_incompatible then
begin
isunaryoperatoroverloadable:=false;
@ -938,7 +938,11 @@ implementation
end.
{
$Log$
Revision 1.78 2004-02-12 15:54:03 peter
Revision 1.79 2004-02-13 15:42:21 peter
* compare_defs_ext has now a options argument
* fixes for variants
Revision 1.78 2004/02/12 15:54:03 peter
* make extcycle is working again
Revision 1.77 2004/02/04 22:15:15 daniel

10
compiler/ncal.pas
View File

@ -1536,8 +1536,8 @@ type
else
{ generic type comparision }
begin
eq:=compare_defs_ext(def_from,def_to,pt.left.nodetype,
false,true,convtype,pdoper);
eq:=compare_defs_ext(def_from,def_to,pt.left.nodetype,convtype,pdoper,
[cdo_allow_variant,cdo_check_operator]);
{ when the types are not equal we need to check
some special case for parameter passing }
@ -2716,7 +2716,11 @@ begin
end.
{
$Log$
Revision 1.224 2004-02-12 15:54:03 peter
Revision 1.225 2004-02-13 15:42:21 peter
* compare_defs_ext has now a options argument
* fixes for variants
Revision 1.224 2004/02/12 15:54:03 peter
* make extcycle is working again
Revision 1.223 2004/02/05 01:24:08 florian

13
compiler/ncnv.pas
View File

@ -1125,6 +1125,7 @@ implementation
currprocdef,
aprocdef : tprocdef;
eq : tequaltype;
cdoptions : tcompare_defs_options;
begin
result:=nil;
resulttype:=totype;
@ -1140,8 +1141,10 @@ implementation
exit;
end;
eq:=compare_defs_ext(left.resulttype.def,resulttype.def,left.nodetype,
nf_explicit in flags,true,convtype,aprocdef);
cdoptions:=[cdo_check_operator,cdo_allow_variant];
if nf_explicit in flags then
include(cdoptions,cdo_explicit);
eq:=compare_defs_ext(left.resulttype.def,resulttype.def,left.nodetype,convtype,aprocdef,cdoptions);
case eq of
te_exact,
te_equal :
@ -2407,7 +2410,11 @@ begin
end.
{
$Log$
Revision 1.138 2004-02-05 01:24:08 florian
Revision 1.139 2004-02-13 15:42:21 peter
* compare_defs_ext has now a options argument
* fixes for variants
Revision 1.138 2004/02/05 01:24:08 florian
* several fixes to compile x86-64 system
Revision 1.137 2004/02/04 22:15:15 daniel

24
compiler/symsym.pas
View File

@ -960,10 +960,12 @@ implementation
besteq : tequaltype;
hpd : tprocdef;
currpara : tparaitem;
cdoptions : tcompare_defs_options;
begin
search_procdef_assignment_operator:=nil;
bestpd:=nil;
besteq:=te_incompatible;
cdoptions:=[];
pd:=pdlistfirst;
while assigned(pd) do
begin
@ -975,8 +977,7 @@ implementation
currpara:=tparaitem(currpara.next);
if assigned(currpara) then
begin
eq:=compare_defs_ext(fromdef,currpara.paratype.def,
nothingn,false,false,convtyp,hpd);
eq:=compare_defs_ext(fromdef,currpara.paratype.def,nothingn,convtyp,hpd,cdoptions);
if eq=te_exact then
begin
search_procdef_assignment_operator:=pd^.def;
@ -1006,10 +1007,17 @@ implementation
hpd : tprocdef;
nextpara,
currpara : tparaitem;
cdoptions : tcompare_defs_options;
begin
search_procdef_binary_operator:=nil;
bestpd:=nil;
bestlev:=0;
cdoptions:=[];
{ variants arguments must match exact, don't allow conversion to variants that
will then allow things like enum->string, because enum->variant is available
and select the operator variant->string }
if (def1.deftype=variantdef) or (def1.deftype=variantdef) then
cdoptions:=[cdo_allow_variant];
pd:=pdlistfirst;
while assigned(pd) do
begin
@ -1020,8 +1028,7 @@ implementation
if assigned(currpara) then
begin
{ Compare def1 with the first para }
eq1:=compare_defs_ext(def1,currpara.paratype.def,
nothingn,false,false,convtyp,hpd);
eq1:=compare_defs_ext(def1,currpara.paratype.def,nothingn,convtyp,hpd,cdoptions);
if eq1<>te_incompatible then
begin
{ Ignore vs_hidden parameters }
@ -1039,8 +1046,7 @@ implementation
if not assigned(nextpara) then
begin
{ Compare def2 with the last para }
eq2:=compare_defs_ext(def2,currpara.paratype.def,
nothingn,false,false,convtyp,hpd);
eq2:=compare_defs_ext(def2,currpara.paratype.def,nothingn,convtyp,hpd,cdoptions);
if (eq2<>te_incompatible) then
begin
{ check level }
@ -2360,7 +2366,11 @@ implementation
end.
{
$Log$
Revision 1.157 2004-02-11 19:59:06 peter
Revision 1.158 2004-02-13 15:42:21 peter
* compare_defs_ext has now a options argument
* fixes for variants
Revision 1.157 2004/02/11 19:59:06 peter
* fix compilation without GDB
Revision 1.156 2004/02/08 18:08:59 jonas