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

* don't search for overloads in parents for constructors

Browse Source
This commit is contained in:
peter 2003-10-30 16:23:13 +00:00
parent 9e66b09843
commit 19727a3609
7 changed files with 62 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
compiler/defcmp.pas
View File

@ -35,7 +35,9 @@ interface
type
{ if acp is cp_all the var const or nothing are considered equal }
compare_type = ( cp_none, cp_value_equal_const, cp_all,cp_procvar);
tcompare_paras_type = ( cp_none, cp_value_equal_const, cp_all,cp_procvar);
tcompare_paras_option = (cpo_allowdefaults,cpo_ignorehidden,cpo_allowconvert);
tcompare_paras_options = set of tcompare_paras_option;
tconverttype = (
tc_equal,
@ -103,7 +105,7 @@ interface
search for a routine with default parameters, before
searching for the same definition with no parameters)
}
function compare_paras(paralist1,paralist2 : TLinkedList; acp : compare_type;allowdefaults,ignorehidden:boolean):tequaltype;
function compare_paras(paralist1,paralist2 : TLinkedList; acp : tcompare_paras_type; cpoptions: tcompare_paras_options):tequaltype;
{ True if a function can be assigned to a procvar }
{ changed first argument type to pabstractprocdef so that it can also be }
@ -1065,7 +1067,7 @@ implementation
end;
function compare_paras(paralist1,paralist2 : TLinkedList; acp : compare_type;allowdefaults,ignorehidden:boolean):tequaltype;
function compare_paras(paralist1,paralist2 : TLinkedList; acp : tcompare_paras_type; cpoptions: tcompare_paras_options):tequaltype;
var
currpara1,
currpara2 : TParaItem;
@ -1079,7 +1081,7 @@ implementation
lowesteq:=high(tequaltype);
currpara1:=TParaItem(paralist1.first);
currpara2:=TParaItem(paralist2.first);
if ignorehidden then
if cpo_ignorehidden in cpoptions then
begin
while assigned(currpara1) and currpara1.is_hidden do
currpara1:=tparaitem(currpara1.next);
@ -1165,7 +1167,7 @@ implementation
end;
currpara1:=TParaItem(currpara1.next);
currpara2:=TParaItem(currpara2.next);
if ignorehidden then
if cpo_ignorehidden in cpoptions then
begin
while assigned(currpara1) and currpara1.is_hidden do
currpara1:=tparaitem(currpara1.next);
@ -1177,7 +1179,7 @@ implementation
when one list is empty and the other has a parameter with default
value assigned then the parameters are also equal }
if ((currpara1=nil) and (currpara2=nil)) or
(allowdefaults and
((cpo_allowdefaults in cpoptions) and
((assigned(currpara1) and assigned(currpara1.defaultvalue)) or
(assigned(currpara2) and assigned(currpara2.defaultvalue)))) then
compare_paras:=lowesteq;
@ -1211,7 +1213,7 @@ implementation
{ return equal type based on the parameters, but a proc->procvar
is never exact, so map an exact match of the parameters to
te_equal }
eq:=compare_paras(def1.para,def2.para,cp_procvar,false,false);
eq:=compare_paras(def1.para,def2.para,cp_procvar,[]);
if eq=te_exact then
eq:=te_equal;
proc_to_procvar_equal:=eq;
@ -1221,7 +1223,10 @@ implementation
end.
{
$Log$
Revision 1.34 2003-10-26 14:11:35 florian
Revision 1.35 2003-10-30 16:23:13 peter
* don't search for overloads in parents for constructors
Revision 1.34 2003/10/26 14:11:35 florian
* fixed web bug 2129: explicit float casts in Delphi mode must be handled by the default code
Revision 1.33 2003/10/14 12:23:06 florian

15
compiler/ncal.pas
View File

@ -1229,13 +1229,7 @@ type
for class entries as the tree keeps always the same }
if (not symtableprocentry.overloadchecked) and
(symtableprocentry.owner.symtabletype=objectsymtable) and
(
(
(symtableprocentry.first_procdef.proctypeoption=potype_constructor) and
is_class(tdef(symtableprocentry.owner.defowner))
) or
(po_overload in symtableprocentry.first_procdef.procoptions)
) then
(po_overload in symtableprocentry.first_procdef.procoptions) then
search_class_overloads(symtableprocentry);
{ when the class passed is defined in this unit we
@ -1320,7 +1314,7 @@ type
while assigned(hp) do
begin
{ Only compare visible parameters for the user }
if compare_paras(hp^.data.para,pd.para,cp_value_equal_const,false,true)>=te_equal then
if compare_paras(hp^.data.para,pd.para,cp_value_equal_const,[cpo_ignorehidden])>=te_equal then
begin
found:=true;
break;
@ -2591,7 +2585,10 @@ begin
end.
{
$Log$
Revision 1.201 2003-10-29 22:01:20 florian
Revision 1.202 2003-10-30 16:23:13 peter
* don't search for overloads in parents for constructors
Revision 1.201 2003/10/29 22:01:20 florian
* fixed passing of dyn. arrays to open array parameters
Revision 1.200 2003/10/23 14:44:07 peter

17
compiler/nobj.pas
View File

@ -634,7 +634,7 @@ implementation
begin
if tstoredsym(procdefcoll^.data.procsym).is_visible_for_object(pd._class) and
(not(pdoverload or hasoverloads) or
(compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false,false)>=te_equal)) then
(compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,[])>=te_equal)) then
begin
if is_visible then
procdefcoll^.hidden:=true;
@ -652,7 +652,7 @@ implementation
begin
{ we start a new virtual tree, hide the old }
if (not(pdoverload or hasoverloads) or
(compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false,false)>=te_equal)) and
(compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,[])>=te_equal)) and
(tstoredsym(procdefcoll^.data.procsym).is_visible_for_object(pd._class)) then
begin
if is_visible then
@ -668,7 +668,7 @@ implementation
{ do nothing, the error will follow when adding the entry }
end
{ same parameters }
else if (compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false,false)>=te_equal) then
else if (compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,[])>=te_equal) then
begin
{ overload is inherited }
if (po_overload in procdefcoll^.data.procoptions) then
@ -734,7 +734,7 @@ implementation
if the new defintion has not the overload directive }
if is_visible and
((not(pdoverload or hasoverloads)) or
(compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false,false)>=te_equal)) then
(compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,[])>=te_equal)) then
procdefcoll^.hidden:=true;
end;
end
@ -744,7 +744,7 @@ implementation
has not the overload directive }
if is_visible and
((not pdoverload) or
(compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false,false)>=te_equal)) then
(compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,[])>=te_equal)) then
procdefcoll^.hidden:=true;
end;
end; { not hidden }
@ -1057,7 +1057,7 @@ implementation
for i:=1 to tprocsym(sym).procdef_count do
begin
implprocdef:=tprocsym(sym).procdef[i];
if (compare_paras(proc.para,implprocdef.para,cp_none,false,false)>=te_equal) and
if (compare_paras(proc.para,implprocdef.para,cp_none,[])>=te_equal) and
(proc.proccalloption=implprocdef.proccalloption) then
begin
gintfgetcprocdef:=implprocdef;
@ -1368,7 +1368,10 @@ initialization
end.
{
$Log$
Revision 1.54 2003-10-29 19:48:50 peter
Revision 1.55 2003-10-30 16:23:13 peter
* don't search for overloads in parents for constructors
Revision 1.54 2003/10/29 19:48:50 peter
* renamed mangeldname_prefix to make_mangledname and made it more
generic
* make_mangledname is now also used for internal threadvar/resstring

9
compiler/pdecobj.pas
View File

@ -387,7 +387,7 @@ implementation
{ Insert hidden parameters }
calc_parast(readprocdef);
{ search procdefs matching readprocdef }
p.readaccess.procdef:=Tprocsym(sym).search_procdef_bypara(readprocdef.para,p.proptype.def,true,false);
p.readaccess.procdef:=Tprocsym(sym).search_procdef_bypara(readprocdef.para,p.proptype.def,[cpo_allowdefaults]);
if not assigned(p.readaccess.procdef) then
Message(parser_e_ill_property_access_sym);
end;
@ -431,7 +431,7 @@ implementation
{ Insert hidden parameters }
calc_parast(writeprocdef);
{ search procdefs matching writeprocdef }
p.writeaccess.procdef:=Tprocsym(sym).search_procdef_bypara(writeprocdef.para,writeprocdef.rettype.def,true,false);
p.writeaccess.procdef:=Tprocsym(sym).search_procdef_bypara(writeprocdef.para,writeprocdef.rettype.def,[cpo_allowdefaults]);
if not assigned(p.writeaccess.procdef) then
Message(parser_e_ill_property_access_sym);
end;
@ -1157,7 +1157,10 @@ implementation
end.
{
$Log$
Revision 1.71 2003-10-22 15:22:33 peter
Revision 1.72 2003-10-30 16:23:13 peter
* don't search for overloads in parents for constructors
Revision 1.71 2003/10/22 15:22:33 peter
* fixed unitsym-globalsymtable relation so the uses of a unit
is counted correctly

9
compiler/pdecsub.pas
View File

@ -1892,7 +1892,7 @@ const
) or
{ check arguments }
(
(compare_paras(pd.para,hd.para,cp_none,false,false)>=te_equal) and
(compare_paras(pd.para,hd.para,cp_none,[])>=te_equal) and
{ for operators equal_paras is not enough !! }
((pd.proctypeoption<>potype_operator) or (optoken<>_ASSIGNMENT) or
equal_defs(hd.rettype.def,pd.rettype.def))
@ -1911,7 +1911,7 @@ const
(
(m_repeat_forward in aktmodeswitches) and
(not((pd.maxparacount=0) or
(compare_paras(pd.para,hd.para,cp_all,false,false)>=te_equal)))
(compare_paras(pd.para,hd.para,cp_all,[])>=te_equal)))
) or
(
((m_repeat_forward in aktmodeswitches) or
@ -2132,7 +2132,10 @@ const
end.
{
$Log$
Revision 1.149 2003-10-28 15:36:01 peter
Revision 1.150 2003-10-30 16:23:13 peter
* don't search for overloads in parents for constructors
Revision 1.149 2003/10/28 15:36:01 peter
* absolute to object field supported, fixes tb0458
Revision 1.148 2003/10/07 21:14:33 peter

31
compiler/symsym.pas
View File

@ -31,7 +31,7 @@ interface
{ target }
globtype,globals,
{ symtable }
symconst,symbase,symtype,symdef,
symconst,symbase,symtype,symdef,defcmp,
{ ppu }
ppu,symppu,
cclasses,symnot,
@ -132,7 +132,7 @@ interface
procedure deref;override;
procedure addprocdef(p:tprocdef);
procedure addprocdef_deref(const d:tderef);
procedure add_para_match_to(Aprocsym:Tprocsym);
procedure add_para_match_to(Aprocsym:Tprocsym;cpoptions:tcompare_paras_options);
procedure concat_procdefs_to(s:Tprocsym);
procedure foreach_procdef_static(proc2call:Tprocdefcallback;arg:pointer);
function first_procdef:Tprocdef;
@ -141,8 +141,7 @@ interface
function search_procdef_bytype(pt:Tproctypeoption):Tprocdef;
function search_procdef_bypara(params:Tlinkedlist;
retdef:tdef;
allowconvert,
allowdefault:boolean):Tprocdef;
cpoptions:tcompare_paras_options):Tprocdef;
function search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
function search_procdef_unary_operator(firstpara:Tdef):Tprocdef;
function search_procdef_assignment_operator(fromdef,todef:tdef):Tprocdef;
@ -375,7 +374,7 @@ implementation
{ target }
systems,
{ symtable }
defutil,defcmp,symtable,
defutil,symtable,
{$ifdef GDB}
gdb,
{$endif GDB}
@ -866,7 +865,7 @@ implementation
procedure tprocsym.deref;
var
prev,hp,p : pprocdeflist;
p : pprocdeflist;
begin
{ We have removed the overloaded entries, because they
are not valid anymore and we can't deref them because
@ -875,13 +874,11 @@ implementation
unchain_overload;
{ Deref our own procdefs }
p:=pdlistfirst;
prev:=nil;
while assigned(p) do
begin
if not p^.own then
internalerror(200310291);
p^.def:=tprocdef(p^.defderef.resolve);
prev:=p;
p:=p^.next;
end;
end;
@ -953,14 +950,14 @@ implementation
end;
procedure Tprocsym.add_para_match_to(Aprocsym:Tprocsym);
procedure Tprocsym.add_para_match_to(Aprocsym:Tprocsym;cpoptions:tcompare_paras_options);
var
pd:pprocdeflist;
begin
pd:=pdlistfirst;
while assigned(pd) do
begin
if Aprocsym.search_procdef_bypara(pd^.def.para,nil,false,true)=nil then
if Aprocsym.search_procdef_bypara(pd^.def.para,nil,cpoptions)=nil then
Aprocsym.addprocdef(pd^.def);
pd:=pd^.next;
end;
@ -1050,8 +1047,7 @@ implementation
function Tprocsym.search_procdef_bypara(params:Tlinkedlist;
retdef:tdef;
allowconvert,
allowdefault:boolean):Tprocdef;
cpoptions:tcompare_paras_options):Tprocdef;
var
pd : pprocdeflist;
eq : tequaltype;
@ -1065,11 +1061,11 @@ implementation
else
eq:=te_equal;
if (eq>=te_equal) or
(allowconvert and (eq>te_incompatible)) then
((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then
begin
eq:=compare_paras(pd^.def.para,params,cp_value_equal_const,allowdefault,false);
eq:=compare_paras(pd^.def.para,params,cp_value_equal_const,cpoptions);
if (eq>=te_equal) or
(allowconvert and (eq>te_incompatible)) then
((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then
begin
search_procdef_bypara:=pd^.def;
break;
@ -2687,7 +2683,10 @@ implementation
end.
{
$Log$
Revision 1.133 2003-10-29 21:56:28 peter
Revision 1.134 2003-10-30 16:23:13 peter
* don't search for overloads in parents for constructors
Revision 1.133 2003/10/29 21:56:28 peter
* procsym.deref derefs only own procdefs
* reset paracount in procdef.deref so a second deref doesn't increase
the paracounts to invalid values

9
compiler/symtable.pas
View File

@ -262,7 +262,7 @@ implementation
{ target }
systems,
{ symtable }
symutil,
symutil,defcmp,
{ module }
fmodule,
{$ifdef GDB}
@ -2131,7 +2131,7 @@ implementation
internalerror(200111022);
if srsym.is_visible_for_object(tobjectdef(aprocsym.owner.defowner)) then
begin
srsym.add_para_match_to(Aprocsym);
srsym.add_para_match_to(Aprocsym,[cpo_ignorehidden,cpo_allowdefaults]);
{ we can stop if the overloads were already added
for the found symbol }
if srsym.overloadchecked then
@ -2297,7 +2297,10 @@ implementation
end.
{
$Log$
Revision 1.120 2003-10-23 14:44:07 peter
Revision 1.121 2003-10-30 16:23:13 peter
* don't search for overloads in parents for constructors
Revision 1.120 2003/10/23 14:44:07 peter
* splitted buildderef and buildderefimpl to fix interface crc
calculation