paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-13 11:59:19 +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 and call by const parameter are assumed as
equal 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 { 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); } { 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 var
def1,def2 : TParaItem; def1,def2 : TParaItem;
begin begin
@ -389,13 +389,16 @@ implementation
{ when both lists are empty then the parameters are equal. Also { when both lists are empty then the parameters are equal. Also
when one list is empty and the other has a parameter with default when one list is empty and the other has a parameter with default
value assigned then the parameters are also equal } value assigned then the parameters are also equal }
if ((def1=nil) and ((def2=nil) or assigned(def2.defaultvalue))) or if ((def1=nil) and (def2=nil)) or
((def2=nil) and ((def1=nil) or assigned(def1.defaultvalue))) then (allowdefaults and
((assigned(def1) and assigned(def1.defaultvalue)) or
(assigned(def2) and assigned(def2.defaultvalue)))) then
equal_paras:=true equal_paras:=true
else else
equal_paras:=false; equal_paras:=false;
end; end;
function convertable_paras(paralist1,paralist2 : TLinkedList;acp : compare_type) : boolean; function convertable_paras(paralist1,paralist2 : TLinkedList;acp : compare_type) : boolean;
var var
def1,def2 : TParaItem; def1,def2 : TParaItem;
@ -479,7 +482,7 @@ implementation
{ check return value and para's and options, methodpointer is already checked { check return value and para's and options, methodpointer is already checked
parameters may also be convertable } parameters may also be convertable }
if is_equal(def1.rettype.def,def2.rettype.def) and 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 ((not exact) and convertable_paras(def1.para,def2.para,cp_all))) and
((po_comp * def1.procoptions)= (po_comp * def2.procoptions)) then ((po_comp * def1.procoptions)= (po_comp * def2.procoptions)) then
proc_to_procvar_equal:=true proc_to_procvar_equal:=true
@ -1132,7 +1135,7 @@ implementation
((tprocvardef(def1).procoptions * po_compatibility_options)= ((tprocvardef(def1).procoptions * po_compatibility_options)=
(tprocvardef(def2).procoptions * po_compatibility_options)) and (tprocvardef(def2).procoptions * po_compatibility_options)) and
is_equal(tprocvardef(def1).rettype.def,tprocvardef(def2).rettype.def) 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 end
else else
if (def1.deftype=arraydef) and (def2.deftype=arraydef) then if (def1.deftype=arraydef) and (def2.deftype=arraydef) then
@ -1953,7 +1956,10 @@ implementation
end. end.
{ {
$Log$ $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 * allow default parameters in equal_paras
Revision 1.10 2002/09/08 11:10:17 carl Revision 1.10 2002/09/08 11:10:17 carl

7
compiler/ncal.pas
View File

@ -1603,7 +1603,7 @@ implementation
hp:=procs; hp:=procs;
while assigned(hp) do while assigned(hp) do
begin 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 begin
found:=true; found:=true;
break; break;
@ -2604,7 +2604,10 @@ begin
end. end.
{ {
$Log$ $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 * don't have strict var parameter checking for procedures in the
system unit system unit

17
compiler/ncnv.pas
View File

@ -1915,6 +1915,8 @@ implementation
function tasnode.det_resulttype:tnode; function tasnode.det_resulttype:tnode;
var
hp : tnode;
begin begin
result:=nil; result:=nil;
resulttypepass(right); resulttypepass(right);
@ -1969,8 +1971,12 @@ implementation
{ load the GUID of the interface } { load the GUID of the interface }
if (right.nodetype=typen) then if (right.nodetype=typen) then
begin begin
if tobjectdef(left.resulttype.def).isiidguidvalid then if tobjectdef(right.resulttype.def).isiidguidvalid then
right:=cguidconstnode.create(tobjectdef(left.resulttype.def).iidguid) begin
hp:=cguidconstnode.create(tobjectdef(right.resulttype.def).iidguid);
right.free;
right:=hp;
end
else else
internalerror(200206282); internalerror(200206282);
resulttypepass(right); resulttypepass(right);
@ -2012,7 +2018,7 @@ implementation
else else
procname := 'fpc_intf_as'; procname := 'fpc_intf_as';
call := ccallnode.createinternres(procname, call := ccallnode.createinternres(procname,
ccallparanode.create(left,ccallparanode.create(right,nil)), ccallparanode.create(right,ccallparanode.create(left,nil)),
resulttype); resulttype);
end; end;
left := nil; left := nil;
@ -2037,7 +2043,10 @@ begin
end. end.
{ {
$Log$ $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 * cardinal -> longword
Revision 1.79 2002/09/07 15:25:03 peter 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 if not(po_virtualmethod in pd.procoptions) then
begin begin
if (not pdoverload or 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 (tstoredsym(procdefcoll^.data.procsym).is_visible_for_object(pd._class)) then
begin begin
if is_visible then if is_visible then
@ -624,7 +624,7 @@ implementation
begin begin
{ we start a new virtual tree, hide the old } { we start a new virtual tree, hide the old }
if (not pdoverload or 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 (tstoredsym(procdefcoll^.data.procsym).is_visible_for_object(pd._class)) then
begin begin
if is_visible then if is_visible then
@ -640,7 +640,7 @@ implementation
{ do nothing, the error will follow when adding the entry } { do nothing, the error will follow when adding the entry }
end end
{ same parameters } { 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 begin
{ overload is inherited } { overload is inherited }
if (po_overload in procdefcoll^.data.procoptions) then if (po_overload in procdefcoll^.data.procoptions) then
@ -694,7 +694,7 @@ implementation
if the new defintion has not the overload directive } if the new defintion has not the overload directive }
if is_visible and if is_visible and
((not pdoverload) or ((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; procdefcoll^.hidden:=true;
end; end;
end end
@ -704,7 +704,7 @@ implementation
has not the overload directive } has not the overload directive }
if is_visible and if is_visible and
((not pdoverload) or ((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; procdefcoll^.hidden:=true;
end; end;
end; { not hidden } end; { not hidden }
@ -1002,7 +1002,7 @@ implementation
for i:=1 to sym.procdef_count do for i:=1 to sym.procdef_count do
begin begin
implprocdef:=sym.procdef[i]; 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 (proc.proccalloption=implprocdef.proccalloption) then
begin begin
gintfgetcprocdef:=implprocdef; gintfgetcprocdef:=implprocdef;
@ -1301,7 +1301,10 @@ initialization
end. end.
{ {
$Log$ $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 * Make Tprocdef.defs protected
Revision 1.26 2002/09/03 15:44:44 peter 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 case sym.typ of
procsym : procsym :
begin begin
pd:=Tprocsym(sym).search_procdef_bypara(propertyparas,true); pd:=Tprocsym(sym).search_procdef_bypara(propertyparas,true,false);
if not(assigned(pd)) or if not(assigned(pd)) or
not(is_equal(pd.rettype.def,p.proptype.def)) then not(is_equal(pd.rettype.def,p.proptype.def)) then
Message(parser_e_ill_property_access_sym); Message(parser_e_ill_property_access_sym);
@ -423,7 +423,7 @@ implementation
begin begin
{ insert data entry to check access method } { insert data entry to check access method }
propertyparas.insert(datacoll); propertyparas.insert(datacoll);
pd:=Tprocsym(sym).search_procdef_bypara(propertyparas,true); pd:=Tprocsym(sym).search_procdef_bypara(propertyparas,true,false);
{ ... and remove it } { ... and remove it }
propertyparas.remove(datacoll); propertyparas.remove(datacoll);
if not(assigned(pd)) then if not(assigned(pd)) then
@ -1150,7 +1150,10 @@ implementation
end. end.
{ {
$Log$ $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 * tdicationary.replace added to replace and item in a dictionary. This
is only allowed for the same name is only allowed for the same name
* varsyms are inserted in symtable before the types are parsed. This * varsyms are inserted in symtable before the types are parsed. This

9
compiler/pdecsub.pas
View File

@ -1769,7 +1769,7 @@ const
) or ) or
{ check arguments } { 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 !! } { for operators equal_paras is not enough !! }
((aprocdef.proctypeoption<>potype_operator) or (optoken<>_ASSIGNMENT) or ((aprocdef.proctypeoption<>potype_operator) or (optoken<>_ASSIGNMENT) or
is_equal(hd.rettype.def,aprocdef.rettype.def)) is_equal(hd.rettype.def,aprocdef.rettype.def))
@ -1788,7 +1788,7 @@ const
( (
(m_repeat_forward in aktmodeswitches) and (m_repeat_forward in aktmodeswitches) and
(not((aprocdef.maxparacount=0) or (not((aprocdef.maxparacount=0) or
equal_paras(aprocdef.para,hd.para,cp_all))) equal_paras(aprocdef.para,hd.para,cp_all,false)))
) or ) or
( (
((m_repeat_forward in aktmodeswitches) or ((m_repeat_forward in aktmodeswitches) or
@ -1989,7 +1989,10 @@ const
end. end.
{ {
$Log$ $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 * don't insert parast in symtablestack, because typesyms should not be
searched in the the parast 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_nopara_boolret:Tprocdef;
function search_procdef_bytype(pt:Tproctypeoption):Tprocdef; function search_procdef_bytype(pt:Tproctypeoption):Tprocdef;
function search_procdef_bypara(params:Tparalinkedlist; function search_procdef_bypara(params:Tparalinkedlist;
allowconvert:boolean):Tprocdef; allowconvert,
allowdefault:boolean):Tprocdef;
function search_procdef_byprocvardef(d:Tprocvardef):Tprocdef; function search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
function search_procdef_by1paradef(firstpara:Tdef):Tprocdef; function search_procdef_by1paradef(firstpara:Tdef):Tprocdef;
function search_procdef_byretdef_by1paradef(retdef,firstpara:Tdef; function search_procdef_byretdef_by1paradef(retdef,firstpara:Tdef;
@ -915,18 +916,18 @@ implementation
procedure Tprocsym.add_para_match_to(Aprocsym:Tprocsym); procedure Tprocsym.add_para_match_to(Aprocsym:Tprocsym);
var
var pd:Pprocdeflist; pd:Pprocdeflist;
begin
begin
pd:=defs; pd:=defs;
while assigned(pd) do while assigned(pd) do
begin begin
if Aprocsym.search_procdef_bypara(pd^.def.para,false)=nil then if Aprocsym.search_procdef_bypara(pd^.def.para,false,true)=nil then
Aprocsym.addprocdef(pd^.def); Aprocsym.addprocdef(pd^.def);
pd:=pd^.next; pd:=pd^.next;
end; end;
end; end;
procedure Tprocsym.concat_procdefs_to(s:Tprocsym); procedure Tprocsym.concat_procdefs_to(s:Tprocsym);
@ -1010,7 +1011,8 @@ implementation
end; end;
function Tprocsym.search_procdef_bypara(params:Tparalinkedlist; function Tprocsym.search_procdef_bypara(params:Tparalinkedlist;
allowconvert:boolean):Tprocdef; allowconvert,
allowdefault:boolean):Tprocdef;
var pd:Pprocdeflist; var pd:Pprocdeflist;
@ -1019,7 +1021,7 @@ implementation
pd:=defs; pd:=defs;
while assigned(pd) do while assigned(pd) do
begin 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, (allowconvert and convertable_paras(pd^.def.para,params,
cp_value_equal_const)) then cp_value_equal_const)) then
begin begin
@ -2495,7 +2497,10 @@ implementation
end. end.
{ {
$Log$ $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 * tdicationary.replace added to replace and item in a dictionary. This
is only allowed for the same name is only allowed for the same name
* varsyms are inserted in symtable before the types are parsed. This * varsyms are inserted in symtable before the types are parsed. This