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

Use a set instead of boolean arguments to TCallCandidates.

Browse Source
This commit is contained in:
Rika Ichinose 2022-04-20 23:08:13 +03:00 committed by FPK
parent 326776c7fa
commit 510a281c3f
2 changed files with 63 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
compiler/htypechk.pas
View File

@ -69,6 +69,12 @@ interface
wrongparanr : byte; wrongparanr : byte;
end; end;
tcallcandidatesflag =
(
cc_ignorevisibility,cc_allowdefaultparas,cc_objcidcall,cc_explicitunit,cc_searchhelpers,cc_anoninherited
);
tcallcandidatesflags = set of tcallcandidatesflag;
tcallcandidates = object tcallcandidates = object
private private
FProcsym : tprocsym; FProcsym : tprocsym;
@ -81,13 +87,13 @@ interface
FParaLength : smallint; FParaLength : smallint;
FAllowVariant : boolean; FAllowVariant : boolean;
FParaAnonSyms : tfplist; FParaAnonSyms : tfplist;
procedure collect_overloads_in_struct(structdef:tabstractrecorddef;ProcdefOverloadList:TFPObjectList;searchhelpers,anoninherited:boolean;spezcontext:tspecializationcontext); procedure collect_overloads_in_struct(structdef:tabstractrecorddef;ProcdefOverloadList:TFPObjectList;flags:tcallcandidatesflags;spezcontext:tspecializationcontext);
procedure collect_overloads_in_units(ProcdefOverloadList:TFPObjectList; objcidcall,explicitunit: boolean;spezcontext:tspecializationcontext); procedure collect_overloads_in_units(ProcdefOverloadList:TFPObjectList; flags:tcallcandidatesflags;spezcontext:tspecializationcontext);
procedure create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited:boolean;spezcontext:tspecializationcontext); procedure create_candidate_list(flags:tcallcandidatesflags;spezcontext:tspecializationcontext);
procedure calc_distance(st_root:tsymtable;objcidcall: boolean); procedure calc_distance(st_root:tsymtable;flags:tcallcandidatesflags);
function proc_add(st:tsymtable;pd:tprocdef;objcidcall: boolean):pcandidate; function proc_add(st:tsymtable;pd:tprocdef):pcandidate;
public public
constructor init(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited:boolean;spezcontext:tspecializationcontext); constructor init(sym:tprocsym;st:TSymtable;ppn:tnode;flags:tcallcandidatesflags;spezcontext:tspecializationcontext);
constructor init_operator(op:ttoken;ppn:tnode); constructor init_operator(op:ttoken;ppn:tnode);
destructor done; destructor done;
procedure list(all:boolean); procedure list(all:boolean);
@ -2194,7 +2200,7 @@ implementation
TCallCandidates TCallCandidates
****************************************************************************} ****************************************************************************}
constructor tcallcandidates.init(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited:boolean;spezcontext:tspecializationcontext); constructor tcallcandidates.init(sym:tprocsym;st:TSymtable;ppn:tnode;flags:tcallcandidatesflags;spezcontext:tspecializationcontext);
begin begin
if not assigned(sym) then if not assigned(sym) then
internalerror(200411015); internalerror(200411015);
@ -2202,7 +2208,7 @@ implementation
FProcsym:=sym; FProcsym:=sym;
FProcsymtable:=st; FProcsymtable:=st;
FParanode:=ppn; FParanode:=ppn;
create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited,spezcontext); create_candidate_list(flags,spezcontext);
end; end;
@ -2212,7 +2218,7 @@ implementation
FProcsym:=nil; FProcsym:=nil;
FProcsymtable:=nil; FProcsymtable:=nil;
FParanode:=ppn; FParanode:=ppn;
create_candidate_list(false,false,false,false,false,false,nil); create_candidate_list([],nil);
end; end;
@ -2253,7 +2259,7 @@ implementation
end; end;
procedure tcallcandidates.collect_overloads_in_struct(structdef:tabstractrecorddef;ProcdefOverloadList:TFPObjectList;searchhelpers,anoninherited:boolean;spezcontext:tspecializationcontext); procedure tcallcandidates.collect_overloads_in_struct(structdef:tabstractrecorddef;ProcdefOverloadList:TFPObjectList;flags:tcallcandidatesflags;spezcontext:tspecializationcontext);
var var
changedhierarchy : boolean; changedhierarchy : boolean;
@ -2285,7 +2291,7 @@ implementation
anything compatible to the parameters -- except in case of anything compatible to the parameters -- except in case of
the presence of a messagestr/int, in which case those have to the presence of a messagestr/int, in which case those have to
match exactly } match exactly }
if anoninherited then if cc_anoninherited in flags then
if po_msgint in current_procinfo.procdef.procoptions then if po_msgint in current_procinfo.procdef.procoptions then
begin begin
if not(po_msgint in pd.procoptions) or if not(po_msgint in pd.procoptions) or
@ -2366,7 +2372,7 @@ implementation
(tobjectdef(structdef).objecttype in objecttypes_with_helpers) (tobjectdef(structdef).objecttype in objecttypes_with_helpers)
) )
) )
and searchhelpers then and (cc_searchhelpers in flags) then
begin begin
if m_multi_helpers in current_settings.modeswitches then if m_multi_helpers in current_settings.modeswitches then
begin begin
@ -2441,7 +2447,7 @@ implementation
end; end;
procedure tcallcandidates.collect_overloads_in_units(ProcdefOverloadList:TFPObjectList; objcidcall,explicitunit: boolean;spezcontext:tspecializationcontext); procedure tcallcandidates.collect_overloads_in_units(ProcdefOverloadList:TFPObjectList; flags:tcallcandidatesflags;spezcontext:tspecializationcontext);
var var
j : integer; j : integer;
pd : tprocdef; pd : tprocdef;
@ -2457,7 +2463,7 @@ implementation
the list can change in every situation } the list can change in every situation }
if FOperator=NOTOKEN then if FOperator=NOTOKEN then
begin begin
if not objcidcall then if not (cc_objcidcall in flags) then
hashedid.id:=FProcsym.name hashedid.id:=FProcsym.name
else else
hashedid.id:=class_helper_prefix+FProcsym.name; hashedid.id:=class_helper_prefix+FProcsym.name;
@ -2479,7 +2485,7 @@ implementation
specified explicitly, stop searching after its symtable(s) have specified explicitly, stop searching after its symtable(s) have
been checked (can be both the static and the global symtable been checked (can be both the static and the global symtable
in case it's the current unit itself) } in case it's the current unit itself) }
if explicitunit and if (cc_explicitunit in flags) and
(FProcsymtable.symtabletype in [globalsymtable,staticsymtable]) and (FProcsymtable.symtabletype in [globalsymtable,staticsymtable]) and
(srsymtable.moduleid<>FProcsymtable.moduleid) then (srsymtable.moduleid<>FProcsymtable.moduleid) then
break; break;
@ -2525,7 +2531,7 @@ implementation
except for Objective-C methods called via id } except for Objective-C methods called via id }
if foundanything and if foundanything and
not hasoverload and not hasoverload and
not objcidcall then not (cc_objcidcall in flags) then
break; break;
end; end;
end; end;
@ -2534,7 +2540,7 @@ implementation
end; end;
procedure tcallcandidates.create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited:boolean;spezcontext:tspecializationcontext); procedure tcallcandidates.create_candidate_list(flags:tcallcandidatesflags;spezcontext:tspecializationcontext);
var var
j : integer; j : integer;
pd : tprocdef; pd : tprocdef;
@ -2551,10 +2557,10 @@ implementation
{ Find all available overloads for this procsym } { Find all available overloads for this procsym }
ProcdefOverloadList:=TFPObjectList.Create(false); ProcdefOverloadList:=TFPObjectList.Create(false);
if not objcidcall and if not (cc_objcidcall in flags) and
(FOperator=NOTOKEN) and (FOperator=NOTOKEN) and
(FProcsym.owner.symtabletype in [objectsymtable,recordsymtable]) then (FProcsym.owner.symtabletype in [objectsymtable,recordsymtable]) then
collect_overloads_in_struct(tabstractrecorddef(FProcsym.owner.defowner),ProcdefOverloadList,searchhelpers,anoninherited,spezcontext) collect_overloads_in_struct(tabstractrecorddef(FProcsym.owner.defowner),ProcdefOverloadList,flags,spezcontext)
else else
if (FOperator<>NOTOKEN) then if (FOperator<>NOTOKEN) then
begin begin
@ -2565,13 +2571,13 @@ implementation
begin begin
if (pt.resultdef.typ=recorddef) and if (pt.resultdef.typ=recorddef) and
(sto_has_operator in tabstractrecorddef(pt.resultdef).symtable.tableoptions) then (sto_has_operator in tabstractrecorddef(pt.resultdef).symtable.tableoptions) then
collect_overloads_in_struct(tabstractrecorddef(pt.resultdef),ProcdefOverloadList,searchhelpers,anoninherited,spezcontext); collect_overloads_in_struct(tabstractrecorddef(pt.resultdef),ProcdefOverloadList,flags,spezcontext);
pt:=tcallparanode(pt.right); pt:=tcallparanode(pt.right);
end; end;
collect_overloads_in_units(ProcdefOverloadList,objcidcall,explicitunit,spezcontext); collect_overloads_in_units(ProcdefOverloadList,flags,spezcontext);
end end
else else
collect_overloads_in_units(ProcdefOverloadList,objcidcall,explicitunit,spezcontext); collect_overloads_in_units(ProcdefOverloadList,flags,spezcontext);
{ determine length of parameter list. { determine length of parameter list.
for operators also enable the variant-operators if for operators also enable the variant-operators if
@ -2623,19 +2629,19 @@ implementation
{$endif} {$endif}
( (
( (
allowdefaultparas and (cc_allowdefaultparas in flags) and
( (
(FParalength<=pd.maxparacount) or (FParalength<=pd.maxparacount) or
(po_varargs in pd.procoptions) (po_varargs in pd.procoptions)
) )
) or ) or
( (
not allowdefaultparas and not (cc_allowdefaultparas in flags) and
(FParalength=pd.maxparacount) (FParalength=pd.maxparacount)
) )
) and ) and
( (
ignorevisibility or (cc_ignorevisibility in flags) or
( (
pd.is_specialization and not assigned(pd.owner) and pd.is_specialization and not assigned(pd.owner) and
( (
@ -2675,7 +2681,7 @@ implementation
{$endif} {$endif}
if not found then if not found then
begin begin
proc_add(st,pd,objcidcall); proc_add(st,pd);
added:=true; added:=true;
{$ifndef DISABLE_FAST_OVERLOAD_PATCH} {$ifndef DISABLE_FAST_OVERLOAD_PATCH}
pd.seenmarker:=pointer(@self); pd.seenmarker:=pointer(@self);
@ -2702,13 +2708,13 @@ implementation
end; end;
{$endif} {$endif}
calc_distance(st,objcidcall); calc_distance(st,flags);
ProcdefOverloadList.Free; ProcdefOverloadList.Free;
end; end;
procedure tcallcandidates.calc_distance(st_root: tsymtable; objcidcall: boolean); procedure tcallcandidates.calc_distance(st_root: tsymtable; flags:tcallcandidatesflags);
var var
pd:tprocdef; pd:tprocdef;
candidate:pcandidate; candidate:pcandidate;
@ -2717,7 +2723,7 @@ implementation
{ Give a small penalty for overloaded methods not defined in the { Give a small penalty for overloaded methods not defined in the
current class/unit } current class/unit }
st:=nil; st:=nil;
if objcidcall or if (cc_objcidcall in flags) or
not assigned(st_root) or not assigned(st_root) or
not assigned(st_root.defowner) or not assigned(st_root.defowner) or
(st_root.defowner.typ<>objectdef) then (st_root.defowner.typ<>objectdef) then
@ -2774,7 +2780,7 @@ implementation
want to give the methods of that particular objcclass precedence want to give the methods of that particular objcclass precedence
over other methods, so instead check against the symtable in over other methods, so instead check against the symtable in
which this objcclass is defined } which this objcclass is defined }
if objcidcall then if cc_objcidcall in flags then
st:=st.defowner.owner; st:=st.defowner.owner;
while assigned(candidate) do while assigned(candidate) do
begin begin
@ -2788,7 +2794,7 @@ implementation
end; end;
function tcallcandidates.proc_add(st:tsymtable;pd:tprocdef;objcidcall: boolean):pcandidate; function tcallcandidates.proc_add(st:tsymtable;pd:tprocdef):pcandidate;
var var
defaultparacnt : integer; defaultparacnt : integer;
begin begin

31
compiler/ncal.pas
View File

@ -3947,6 +3947,7 @@ implementation
var var
candidates : tcallcandidates; candidates : tcallcandidates;
ccflags : tcallcandidatesflags;
oldcallnode : tcallnode; oldcallnode : tcallnode;
hpt,tmp : tnode; hpt,tmp : tnode;
pt : tcallparanode; pt : tcallparanode;
@ -3955,7 +3956,6 @@ implementation
cand_cnt : integer; cand_cnt : integer;
i : longint; i : longint;
ignoregenericparacall, ignoregenericparacall,
ignorevisibility,
is_const : boolean; is_const : boolean;
statements : tstatementnode; statements : tstatementnode;
converted_result_data : ttempcreatenode; converted_result_data : ttempcreatenode;
@ -4078,13 +4078,32 @@ implementation
exit; exit;
end; end;
end; end;
ccflags:=[];
{ ignore possible private for properties or in delphi mode for anon. inherited (FK) } { ignore possible private for properties or in delphi mode for anon. inherited (FK) }
ignorevisibility:=(nf_isproperty in flags) or if (nf_isproperty in flags) or
((m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags)) or ((m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags)) or
(cnf_ignore_visibility in callnodeflags); (cnf_ignore_visibility in callnodeflags)
candidates.init(symtableprocentry,symtableproc,left,ignorevisibility, then
not(nf_isproperty in flags),cnf_objc_id_call in callnodeflags,cnf_unit_specified in callnodeflags, ccflags:=ccflags+[cc_ignorevisibility];
callnodeflags*[cnf_anon_inherited,cnf_inherited]=[],cnf_anon_inherited in callnodeflags,spezcontext);
if not(nf_isproperty in flags) then
ccflags:=ccflags+[cc_allowdefaultparas];
if cnf_objc_id_call in callnodeflags then
ccflags:=ccflags+[cc_objcidcall];
if cnf_unit_specified in callnodeflags then
ccflags:=ccflags+[cc_explicitunit];
if callnodeflags*[cnf_anon_inherited,cnf_inherited]=[] then
ccflags:=ccflags+[cc_searchhelpers];
if cnf_anon_inherited in callnodeflags then
ccflags:=ccflags+[cc_anoninherited];
candidates.init(symtableprocentry,symtableproc,left,ccflags,spezcontext);
{ no procedures found? then there is something wrong { no procedures found? then there is something wrong
with the parameter size or the procedures are with the parameter size or the procedures are