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

+ add ability to strictly compare defs with generic constraints (this is needed for declarations, while for normal code we're rather relaxed)

Browse Source
This commit is contained in:
Sven/Sarah Barth 2022-02-18 16:43:40 +01:00
parent 3e26beb1ed
commit 094a353d87
1 changed files with 87 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

89
compiler/defcmp.pas
View File

@ -59,8 +59,9 @@ interface
cdo_allow_variant,
cdo_parameter,
cdo_warn_incompatible_univ,
cdo_strict_undefined_check, // undefined defs are incompatible to everything except other undefined defs
cdo_equal_check // this call is only to check equality -> shortcut some expensive checks
cdo_strict_undefined_check, // undefined defs are incompatible to everything except other undefined defs
cdo_equal_check, // this call is only to check equality -> shortcut some expensive checks
cdo_strict_genconstraint_check // check that generic constraints match (used for forward declarations)
);
tcompare_defs_options = set of tcompare_defs_option;
@ -183,6 +184,18 @@ implementation
defutil,symutil;
function same_genconstraint_interfaces(intffrom,intfto:tobject):boolean;
begin
result:=equal_defs(tdef(intffrom),tdef(intfto));
end;
function same_objectdef_implementedinterfaces(intffrom,intfto:tobject):boolean;
begin
result:=equal_defs(TImplementedInterface(intffrom).IntfDef,TImplementedInterface(intfto).IntfDef);
end;
function compare_defs_ext(def_from,def_to : tdef;
fromtreetype : tnodetype;
var doconv : tconverttype;
@ -220,6 +233,27 @@ implementation
(tc_not_possible,tc_int_2_int,tc_int_2_int,tc_int_2_bool),
(tc_not_possible,tc_bool_2_int,tc_bool_2_int,tc_bool_2_bool));
type
tsame_interface_func = function(intffrom,intfto:tobject):boolean;
function same_interface_lists(listfrom,listto:tfpobjectlist;checkfunc:tsame_interface_func):boolean;
var
i : longint;
begin
result:=false;
if assigned(listfrom) xor assigned(listto) then
exit;
if not assigned(listfrom) and not assigned(listto) then
exit(true);
if listfrom.count<>listto.count then
exit;
for i:=0 to listfrom.count-1 do
if not checkfunc(tdef(listfrom[i]),tdef(listto[i])) then
exit;
result:=true;
end;
var
subeq,eq : tequaltype;
hd1,hd2 : tdef;
@ -230,6 +264,7 @@ implementation
i : longint;
diff : boolean;
symfrom,symto : tsym;
genconstrfrom,genconstrto : tgenericconstraintdata;
begin
eq:=te_incompatible;
doconv:=tc_not_possible;
@ -287,6 +322,18 @@ implementation
if (def_from.typ=undefineddef) or
(def_to.typ=undefineddef) then
begin
{ for strict checks with genconstraints pure undefineddefs are
not compatible with constrained defs }
if (cdo_strict_genconstraint_check in cdoptions) and
(
assigned(tstoreddef(def_from).genconstraintdata) or
assigned(tstoreddef(def_to).genconstraintdata)
) then
begin
doconv:=tc_not_possible;
compare_defs_ext:=te_incompatible;
exit;
end;
doconv:=tc_equal;
compare_defs_ext:=te_exact;
exit;
@ -312,6 +359,44 @@ implementation
exit;
end;
{ for a strict check of the generic constraints the constraints
of both parts need to match }
if cdo_strict_genconstraint_check in cdoptions then
begin
genconstrfrom:=tstoreddef(def_from).genconstraintdata;
genconstrto:=tstoreddef(def_to).genconstraintdata;
if (
{ both parts need to be constraints }
not assigned(genconstrfrom) or
not assigned(genconstrto)
) or (
{ same type of def required }
def_from.typ<>def_to.typ
) or (
{ for objectdefs same object type as well as parent required }
(def_from.typ=objectdef) and
(
(tobjectdef(def_from).objecttype<>tobjectdef(def_to).objecttype) or
not equal_defs(tobjectdef(def_from).childof,tobjectdef(def_to).childof)
)
) or (
{ the flags need to match }
genconstrfrom.flags<>genconstrto.flags
) or
{ the interfaces of the constraints need to match }
not same_interface_lists(genconstrfrom.interfaces,genconstrto.interfaces,@same_genconstraint_interfaces) or
(
{ for objectdefs the implemented interfaces need to match }
(def_from.typ=objectdef) and not
same_interface_lists(tobjectdef(def_from).implementedinterfaces,tobjectdef(def_to).implementedinterfaces,@same_objectdef_implementedinterfaces)
) then
begin
doconv:=tc_not_possible;
compare_defs_ext:=te_incompatible;
exit;
end;
end;
{ maybe we are in generic type declaration/implementation.
In this case constraint in comparison to not specialized generic
is not "exact" nor "incompatible" }