From cea50f71854c139f9adeaca104ac3de11c1956a0 Mon Sep 17 00:00:00 2001
From: peter <peter@freepascal.org>
Date: Mon, 16 Sep 2002 14:11:12 +0000
Subject: [PATCH] * add argument to equal_paras() to support default values
or not
---
compiler/defbase.pas | 20 +++++++++++++-------
compiler/ncal.pas | 7 +++++--
compiler/ncnv.pas | 17 +++++++++++++----
compiler/nobj.pas | 17 ++++++++++-------
compiler/pdecobj.pas | 9 ++++++---
compiler/pdecsub.pas | 9 ++++++---
compiler/symsym.pas | 33 +++++++++++++++++++--------------
7 files changed, 72 insertions(+), 40 deletions(-)
diff --git a/compiler/defbase.pas b/compiler/defbase.pas
index 66bdd321d9..16d137e311 100644
--- a/compiler/defbase.pas
+++ b/compiler/defbase.pas
@@ -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
diff --git a/compiler/ncal.pas b/compiler/ncal.pas
index 9ef844933a..21c42914f8 100644
--- a/compiler/ncal.pas
+++ b/compiler/ncal.pas
@@ -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
diff --git a/compiler/ncnv.pas b/compiler/ncnv.pas
index de6a97884c..78972990a1 100644
--- a/compiler/ncnv.pas
+++ b/compiler/ncnv.pas
@@ -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
diff --git a/compiler/nobj.pas b/compiler/nobj.pas
index c0c3997164..dc1e37ca51 100644
--- a/compiler/nobj.pas
+++ b/compiler/nobj.pas
@@ -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
diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas
index 05f0b2203d..12c0dedbff 100644
--- a/compiler/pdecobj.pas
+++ b/compiler/pdecobj.pas
@@ -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
diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
index c7268a6c38..65a4e42888 100644
--- a/compiler/pdecsub.pas
+++ b/compiler/pdecsub.pas
@@ -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
diff --git a/compiler/symsym.pas b/compiler/symsym.pas
index d31c58846c..154bb6397f 100644
--- a/compiler/symsym.pas
+++ b/compiler/symsym.pas
@@ -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