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

* add argument to equal_paras() to support default values or not

Browse Source
This commit is contained in:
peter 2002-09-16 14:11:12 +00:00
parent fcec3ae6b0
commit cea50f7185
7 changed files with 72 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
compiler/defbase.pas
View File

@ -239,7 +239,7 @@ interface
and call by const parameter are assumed as
equal
}
function equal_paras(paralist1,paralist2 : tlinkedlist; acp : compare_type) : boolean;
function equal_paras(paralist1,paralist2 : TLinkedList; acp : compare_type;allowdefaults:boolean) : boolean;
{ True if a type can be allowed for another one
@ -333,7 +333,7 @@ implementation
{ compare_type = ( cp_none, cp_value_equal_const, cp_all); }
function equal_paras(paralist1,paralist2 : TLinkedList; acp : compare_type) : boolean;
function equal_paras(paralist1,paralist2 : TLinkedList; acp : compare_type;allowdefaults:boolean) : boolean;
var
def1,def2 : TParaItem;
begin
@ -389,13 +389,16 @@ implementation
{ when both lists are empty then the parameters are equal. Also
when one list is empty and the other has a parameter with default
value assigned then the parameters are also equal }
if ((def1=nil) and ((def2=nil) or assigned(def2.defaultvalue))) or
((def2=nil) and ((def1=nil) or assigned(def1.defaultvalue))) then
if ((def1=nil) and (def2=nil)) or
(allowdefaults and
((assigned(def1) and assigned(def1.defaultvalue)) or
(assigned(def2) and assigned(def2.defaultvalue)))) then
equal_paras:=true
else
equal_paras:=false;
end;
function convertable_paras(paralist1,paralist2 : TLinkedList;acp : compare_type) : boolean;
var
def1,def2 : TParaItem;
@ -479,7 +482,7 @@ implementation
{ check return value and para's and options, methodpointer is already checked
parameters may also be convertable }
if is_equal(def1.rettype.def,def2.rettype.def) and
(equal_paras(def1.para,def2.para,cp_all) or
(equal_paras(def1.para,def2.para,cp_all,false) or
((not exact) and convertable_paras(def1.para,def2.para,cp_all))) and
((po_comp * def1.procoptions)= (po_comp * def2.procoptions)) then
proc_to_procvar_equal:=true
@ -1132,7 +1135,7 @@ implementation
((tprocvardef(def1).procoptions * po_compatibility_options)=
(tprocvardef(def2).procoptions * po_compatibility_options)) and
is_equal(tprocvardef(def1).rettype.def,tprocvardef(def2).rettype.def) and
equal_paras(tprocvardef(def1).para,tprocvardef(def2).para,cp_all);
equal_paras(tprocvardef(def1).para,tprocvardef(def2).para,cp_all,false);
end
else
if (def1.deftype=arraydef) and (def2.deftype=arraydef) then
@ -1953,7 +1956,10 @@ implementation
end.
{
$Log$
Revision 1.11 2002-09-15 17:54:46 peter
Revision 1.12 2002-09-16 14:11:12 peter
* add argument to equal_paras() to support default values or not
Revision 1.11 2002/09/15 17:54:46 peter
* allow default parameters in equal_paras
Revision 1.10 2002/09/08 11:10:17 carl

7
compiler/ncal.pas
View File

@ -1603,7 +1603,7 @@ implementation
hp:=procs;
while assigned(hp) do
begin
if equal_paras(hp^.data.para,pd.para,cp_value_equal_const) then
if equal_paras(hp^.data.para,pd.para,cp_value_equal_const,false) then
begin
found:=true;
break;
@ -2604,7 +2604,10 @@ begin
end.
{
$Log$
Revision 1.100 2002-09-15 17:49:59 peter
Revision 1.101 2002-09-16 14:11:12 peter
* add argument to equal_paras() to support default values or not
Revision 1.100 2002/09/15 17:49:59 peter
* don't have strict var parameter checking for procedures in the
system unit

17
compiler/ncnv.pas
View File

@ -1915,6 +1915,8 @@ implementation
function tasnode.det_resulttype:tnode;
var
hp : tnode;
begin
result:=nil;
resulttypepass(right);
@ -1969,8 +1971,12 @@ implementation
{ load the GUID of the interface }
if (right.nodetype=typen) then
begin
if tobjectdef(left.resulttype.def).isiidguidvalid then
right:=cguidconstnode.create(tobjectdef(left.resulttype.def).iidguid)
if tobjectdef(right.resulttype.def).isiidguidvalid then
begin
hp:=cguidconstnode.create(tobjectdef(right.resulttype.def).iidguid);
right.free;
right:=hp;
end
else
internalerror(200206282);
resulttypepass(right);
@ -2012,7 +2018,7 @@ implementation
else
procname := 'fpc_intf_as';
call := ccallnode.createinternres(procname,
ccallparanode.create(left,ccallparanode.create(right,nil)),
ccallparanode.create(right,ccallparanode.create(left,nil)),
resulttype);
end;
left := nil;
@ -2037,7 +2043,10 @@ begin
end.
{
$Log$
Revision 1.80 2002-09-07 20:40:23 carl
Revision 1.81 2002-09-16 14:11:13 peter
* add argument to equal_paras() to support default values or not
Revision 1.80 2002/09/07 20:40:23 carl
* cardinal -> longword
Revision 1.79 2002/09/07 15:25:03 peter

17
compiler/nobj.pas
View File

@ -605,7 +605,7 @@ implementation
if not(po_virtualmethod in pd.procoptions) then
begin
if (not pdoverload or
equal_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const)) and
equal_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false)) and
(tstoredsym(procdefcoll^.data.procsym).is_visible_for_object(pd._class)) then
begin
if is_visible then
@ -624,7 +624,7 @@ implementation
begin
{ we start a new virtual tree, hide the old }
if (not pdoverload or
equal_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const)) and
equal_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false)) and
(tstoredsym(procdefcoll^.data.procsym).is_visible_for_object(pd._class)) then
begin
if is_visible then
@ -640,7 +640,7 @@ implementation
{ do nothing, the error will follow when adding the entry }
end
{ same parameters }
else if (equal_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const)) then
else if (equal_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false)) then
begin
{ overload is inherited }
if (po_overload in procdefcoll^.data.procoptions) then
@ -694,7 +694,7 @@ implementation
if the new defintion has not the overload directive }
if is_visible and
((not pdoverload) or
equal_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const)) then
equal_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false)) then
procdefcoll^.hidden:=true;
end;
end
@ -704,7 +704,7 @@ implementation
has not the overload directive }
if is_visible and
((not pdoverload) or
equal_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const)) then
equal_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false)) then
procdefcoll^.hidden:=true;
end;
end; { not hidden }
@ -1002,7 +1002,7 @@ implementation
for i:=1 to sym.procdef_count do
begin
implprocdef:=sym.procdef[i];
if equal_paras(proc.para,implprocdef.para,cp_none) and
if equal_paras(proc.para,implprocdef.para,cp_none,false) and
(proc.proccalloption=implprocdef.proccalloption) then
begin
gintfgetcprocdef:=implprocdef;
@ -1301,7 +1301,10 @@ initialization
end.
{
$Log$
Revision 1.27 2002-09-03 16:26:26 daniel
Revision 1.28 2002-09-16 14:11:13 peter
* add argument to equal_paras() to support default values or not
Revision 1.27 2002/09/03 16:26:26 daniel
* Make Tprocdef.defs protected
Revision 1.26 2002/09/03 15:44:44 peter

9
compiler/pdecobj.pas
View File

@ -388,7 +388,7 @@ implementation
case sym.typ of
procsym :
begin
pd:=Tprocsym(sym).search_procdef_bypara(propertyparas,true);
pd:=Tprocsym(sym).search_procdef_bypara(propertyparas,true,false);
if not(assigned(pd)) or
not(is_equal(pd.rettype.def,p.proptype.def)) then
Message(parser_e_ill_property_access_sym);
@ -423,7 +423,7 @@ implementation
begin
{ insert data entry to check access method }
propertyparas.insert(datacoll);
pd:=Tprocsym(sym).search_procdef_bypara(propertyparas,true);
pd:=Tprocsym(sym).search_procdef_bypara(propertyparas,true,false);
{ ... and remove it }
propertyparas.remove(datacoll);
if not(assigned(pd)) then
@ -1150,7 +1150,10 @@ implementation
end.
{
$Log$
Revision 1.51 2002-09-09 17:34:15 peter
Revision 1.52 2002-09-16 14:11:13 peter
* add argument to equal_paras() to support default values or not
Revision 1.51 2002/09/09 17:34:15 peter
* tdicationary.replace added to replace and item in a dictionary. This
is only allowed for the same name
* varsyms are inserted in symtable before the types are parsed. This

9
compiler/pdecsub.pas
View File

@ -1769,7 +1769,7 @@ const
) or
{ check arguments }
(
equal_paras(aprocdef.para,hd.para,cp_none) and
equal_paras(aprocdef.para,hd.para,cp_none,false) and
{ for operators equal_paras is not enough !! }
((aprocdef.proctypeoption<>potype_operator) or (optoken<>_ASSIGNMENT) or
is_equal(hd.rettype.def,aprocdef.rettype.def))
@ -1788,7 +1788,7 @@ const
(
(m_repeat_forward in aktmodeswitches) and
(not((aprocdef.maxparacount=0) or
equal_paras(aprocdef.para,hd.para,cp_all)))
equal_paras(aprocdef.para,hd.para,cp_all,false)))
) or
(
((m_repeat_forward in aktmodeswitches) or
@ -1989,7 +1989,10 @@ const
end.
{
$Log$
Revision 1.74 2002-09-10 16:27:28 peter
Revision 1.75 2002-09-16 14:11:13 peter
* add argument to equal_paras() to support default values or not
Revision 1.74 2002/09/10 16:27:28 peter
* don't insert parast in symtablestack, because typesyms should not be
searched in the the parast

33
compiler/symsym.pas
View File

@ -139,7 +139,8 @@ interface
function search_procdef_nopara_boolret:Tprocdef;
function search_procdef_bytype(pt:Tproctypeoption):Tprocdef;
function search_procdef_bypara(params:Tparalinkedlist;
allowconvert:boolean):Tprocdef;
allowconvert,
allowdefault:boolean):Tprocdef;
function search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
function search_procdef_by1paradef(firstpara:Tdef):Tprocdef;
function search_procdef_byretdef_by1paradef(retdef,firstpara:Tdef;
@ -915,18 +916,18 @@ implementation
procedure Tprocsym.add_para_match_to(Aprocsym:Tprocsym);
var pd:Pprocdeflist;
begin
var
pd:Pprocdeflist;
begin
pd:=defs;
while assigned(pd) do
begin
if Aprocsym.search_procdef_bypara(pd^.def.para,false)=nil then
Aprocsym.addprocdef(pd^.def);
pd:=pd^.next;
end;
end;
begin
if Aprocsym.search_procdef_bypara(pd^.def.para,false,true)=nil then
Aprocsym.addprocdef(pd^.def);
pd:=pd^.next;
end;
end;
procedure Tprocsym.concat_procdefs_to(s:Tprocsym);
@ -1010,7 +1011,8 @@ implementation
end;
function Tprocsym.search_procdef_bypara(params:Tparalinkedlist;
allowconvert:boolean):Tprocdef;
allowconvert,
allowdefault:boolean):Tprocdef;
var pd:Pprocdeflist;
@ -1019,7 +1021,7 @@ implementation
pd:=defs;
while assigned(pd) do
begin
if equal_paras(pd^.def.para,params,cp_value_equal_const) or
if equal_paras(pd^.def.para,params,cp_value_equal_const,allowdefault) or
(allowconvert and convertable_paras(pd^.def.para,params,
cp_value_equal_const)) then
begin
@ -2495,7 +2497,10 @@ implementation
end.
{
$Log$
Revision 1.65 2002-09-09 17:34:16 peter
Revision 1.66 2002-09-16 14:11:13 peter
* add argument to equal_paras() to support default values or not
Revision 1.65 2002/09/09 17:34:16 peter
* tdicationary.replace added to replace and item in a dictionary. This
is only allowed for the same name
* varsyms are inserted in symtable before the types are parsed. This