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

* removed is_visible_for_proc

Browse Source 
* search also for class overloads when finding interface
    implementations
This commit is contained in:
peter 2003-10-13 14:05:12 +00:00
parent 604a77ead7
commit 303b5252e4
5 changed files with 123 additions and 160 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
compiler/ncal.pas
View File

@ -285,48 +285,6 @@ type
end;
procedure search_class_overloads(aprocsym : tprocsym);
{ searches n in symtable of pd and all anchestors }
var
speedvalue : cardinal;
srsym : tprocsym;
s : string;
objdef : tobjectdef;
begin
if aprocsym.overloadchecked then
exit;
aprocsym.overloadchecked:=true;
if (aprocsym.owner.symtabletype<>objectsymtable) then
internalerror(200111021);
objdef:=tobjectdef(aprocsym.owner.defowner);
{ we start in the parent }
if not assigned(objdef.childof) then
exit;
objdef:=objdef.childof;
s:=aprocsym.name;
speedvalue:=getspeedvalue(s);
while assigned(objdef) do
begin
srsym:=tprocsym(objdef.symtable.speedsearch(s,speedvalue));
if assigned(srsym) then
begin
if (srsym.typ<>procsym) then
internalerror(200111022);
if srsym.is_visible_for_proc(current_procinfo.procdef) then
begin
srsym.add_para_match_to(Aprocsym);
{ we can stop if the overloads were already added
for the found symbol }
if srsym.overloadchecked then
break;
end;
end;
{ next parent }
objdef:=objdef.childof;
end;
end;
function is_better_candidate(currpd,bestpd:pcandidate):integer;
var
res : integer;
@ -2612,7 +2570,12 @@ begin
end.
{
$Log$
Revision 1.195 2003-10-09 21:31:37 daniel
Revision 1.196 2003-10-13 14:05:12 peter
* removed is_visible_for_proc
* search also for class overloads when finding interface
implementations
Revision 1.195 2003/10/09 21:31:37 daniel
* Register allocator splitted, ans abstract now
Revision 1.194 2003/10/09 15:00:13 florian

67
compiler/nobj.pas
View File

@ -1036,60 +1036,72 @@ implementation
function tclassheader.gintfgetcprocdef(proc: tprocdef;const name: string): tprocdef;
var
sym: tprocsym;
sym: tsym;
implprocdef : Tprocdef;
i: cardinal;
begin
gintfgetcprocdef:=nil;
sym:=tprocsym(search_class_member(_class,name));
if assigned(sym) and (sym.typ=procsym) then
for i:=1 to sym.procdef_count do
begin
implprocdef:=sym.procdef[i];
if (compare_paras(proc.para,implprocdef.para,cp_none,false,false)>=te_equal) and
(proc.proccalloption=implprocdef.proccalloption) then
begin
gintfgetcprocdef:=implprocdef;
exit;
end;
end;
sym:=tsym(search_class_member(_class,name));
if assigned(sym) and
(sym.typ=procsym) then
begin
{ when the definition has overload directive set, we search for
overloaded definitions in the class, this only needs to be done once
for class entries as the tree keeps always the same }
if (not tprocsym(sym).overloadchecked) and
(po_overload in tprocsym(sym).first_procdef.procoptions) and
(tprocsym(sym).owner.symtabletype=objectsymtable) then
search_class_overloads(tprocsym(sym));
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
(proc.proccalloption=implprocdef.proccalloption) then
begin
gintfgetcprocdef:=implprocdef;
exit;
end;
end;
end;
end;
procedure tclassheader.gintfdoonintf(intf: tobjectdef; intfindex: longint);
var
i: longint;
proc: tprocdef;
def: tdef;
procname: string; { for error }
mappedname: string;
nextexist: pointer;
implprocdef: tprocdef;
begin
for i:=1 to intf.symtable.defindex.count do
def:=tdef(intf.symtable.defindex.first);
while assigned(def) do
begin
proc:=tprocdef(intf.symtable.defindex.search(i));
if proc.deftype=procdef then
if def.deftype=procdef then
begin
procname:='';
implprocdef:=nil;
nextexist:=nil;
repeat
mappedname:=_class.implementedinterfaces.getmappings(intfindex,proc.procsym.name,nextexist);
mappedname:=_class.implementedinterfaces.getmappings(intfindex,tprocdef(def).procsym.name,nextexist);
if procname='' then
procname:=proc.procsym.name;
procname:=tprocdef(def).procsym.name;
//mappedname; { for error messages }
if mappedname<>'' then
implprocdef:=gintfgetcprocdef(proc,mappedname);
implprocdef:=gintfgetcprocdef(tprocdef(def),mappedname);
until assigned(implprocdef) or not assigned(nextexist);
if not assigned(implprocdef) then
implprocdef:=gintfgetcprocdef(proc,proc.procsym.name);
implprocdef:=gintfgetcprocdef(tprocdef(def),tprocdef(def).procsym.name);
if procname='' then
procname:=proc.procsym.name;
procname:=tprocdef(def).procsym.name;
if assigned(implprocdef) then
_class.implementedinterfaces.addimplproc(intfindex,implprocdef)
else
Message1(sym_e_no_matching_implementation_found,proc.fullprocname(false));
Message1(sym_e_no_matching_implementation_found,tprocdef(def).fullprocname(false));
end;
def:=tdef(def.indexnext);
end;
end;
@ -1356,7 +1368,12 @@ initialization
end.
{
$Log$
Revision 1.52 2003-10-10 17:48:13 peter
Revision 1.53 2003-10-13 14:05:12 peter
* removed is_visible_for_proc
* search also for class overloads when finding interface
implementations
Revision 1.52 2003/10/10 17:48:13 peter
* old trgobj moved to x86/rgcpu and renamed to trgx86fpu
* tregisteralloctor renamed to trgobj
* removed rgobj from a lot of units

41
compiler/symdef.pas
View File

@ -555,7 +555,6 @@ interface
function cplusplusmangledname : string;
function is_methodpointer:boolean;override;
function is_addressonly:boolean;override;
// function is_visible_for_proc(currprocdef:tprocdef):boolean;
function is_visible_for_object(currobjdef:tobjectdef):boolean;
{ debug }
{$ifdef GDB}
@ -3731,39 +3730,6 @@ implementation
end;
(*
function tprocdef.is_visible_for_proc(currprocdef:tprocdef):boolean;
begin
is_visible_for_proc:=false;
{ private symbols are allowed when we are in the same
module as they are defined }
if (sp_private in symoptions) and
assigned(owner.defowner) and
(owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
(owner.defowner.owner.unitid<>0) then
exit;
{ protected symbols are vissible in the module that defines them and
also visible to related objects }
if (sp_protected in symoptions) and
(
(
(owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
(owner.defowner.owner.unitid<>0)
) and
not(
assigned(currprocdef) and
assigned(currprocdef._class) and
currprocdef._class.is_related(tobjectdef(owner.defowner))
)
) then
exit;
is_visible_for_proc:=true;
end;
*)
function tprocdef.is_visible_for_object(currobjdef:tobjectdef):boolean;
begin
is_visible_for_object:=false;
@ -5924,7 +5890,12 @@ implementation
end.
{
$Log$
Revision 1.177 2003-10-11 16:06:42 florian
Revision 1.178 2003-10-13 14:05:12 peter
* removed is_visible_for_proc
* search also for class overloads when finding interface
implementations
Revision 1.177 2003/10/11 16:06:42 florian
* fixed some MMX<->SSE
* started to fix ppc, needs an overhaul
+ stabs info improve for spilling, not sure if it works correctly/completly

41
compiler/symsym.pas
View File

@ -70,7 +70,6 @@ interface
{$endif GDB}
procedure load_references(ppufile:tcompilerppufile;locals:boolean);virtual;
function write_references(ppufile:tcompilerppufile;locals:boolean):boolean;virtual;
function is_visible_for_proc(currprocdef:tprocdef):boolean;
function is_visible_for_object(currobjdef:tobjectdef):boolean;
function mangledname : string;
procedure generate_mangledname;virtual;abstract;
@ -570,39 +569,6 @@ implementation
{$endif GDB}
function tstoredsym.is_visible_for_proc(currprocdef:tprocdef):boolean;
begin
is_visible_for_proc:=false;
{ private symbols are allowed when we are in the same
module as they are defined }
if (sp_private in symoptions) and
assigned(owner.defowner) and
(owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
(owner.defowner.owner.unitid<>0) then
exit;
{ protected symbols are vissible in the module that defines them and
also visible to related objects }
if (sp_protected in symoptions) and
(
(
assigned(owner.defowner) and
(owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
(owner.defowner.owner.unitid<>0)
) and
not(
assigned(currprocdef) and
assigned(currprocdef._class) and
currprocdef._class.is_related(tobjectdef(owner.defowner))
)
) then
exit;
is_visible_for_proc:=true;
end;
function tstoredsym.is_visible_for_object(currobjdef:tobjectdef):boolean;
begin
is_visible_for_object:=false;
@ -2676,7 +2642,12 @@ implementation
end.
{
$Log$
Revision 1.125 2003-10-08 19:19:45 peter
Revision 1.126 2003-10-13 14:05:12 peter
* removed is_visible_for_proc
* search also for class overloads when finding interface
implementations
Revision 1.125 2003/10/08 19:19:45 peter
* set_varstate cleanup
Revision 1.124 2003/10/07 21:14:33 peter

85
compiler/symtable.pas
View File

@ -209,6 +209,7 @@ interface
function search_class_member(pd : tobjectdef;const s : string):tsym;
{*** Object Helpers ***}
procedure search_class_overloads(aprocsym : tprocsym);
function search_default_property(pd : tobjectdef) : tpropertysym;
{*** symtable stack ***}
@ -1778,7 +1779,7 @@ implementation
srsym:=tsym(srsymtable.speedsearch(s,speedvalue));
if assigned(srsym) and
(not assigned(current_procinfo) or
tstoredsym(srsym).is_visible_for_proc(current_procinfo.procdef)) then
tstoredsym(srsym).is_visible_for_object(current_procinfo.procdef._class)) then
begin
searchsym:=true;
exit;
@ -1809,7 +1810,7 @@ implementation
srsym:=tsym(srsymtable.speedsearch(s,speedvalue));
if assigned(srsym) and
(not assigned(current_procinfo) or
tstoredsym(srsym).is_visible_for_proc(current_procinfo.procdef)) then
tstoredsym(srsym).is_visible_for_object(current_procinfo.procdef._class)) then
begin
result:=true;
exit;
@ -1865,25 +1866,19 @@ implementation
(classh.owner.unitid=0) then
topclassh:=classh
else
topclassh:=nil;
begin
if assigned(current_procinfo) then
topclassh:=current_procinfo.procdef._class
else
topclassh:=nil;
end;
sym:=nil;
while assigned(classh) do
begin
sym:=tsym(classh.symtable.speedsearch(s,speedvalue));
if assigned(sym) then
begin
if assigned(topclassh) then
begin
if tstoredsym(sym).is_visible_for_object(topclassh) then
break;
end
else
begin
if (not assigned(current_procinfo) or
tstoredsym(sym).is_visible_for_proc(current_procinfo.procdef)) then
break;
end;
end;
if assigned(sym) and
tstoredsym(sym).is_visible_for_object(topclassh) then
break;
classh:=classh.childof;
end;
searchsym_in_class:=sym;
@ -2086,24 +2081,65 @@ implementation
Object Helpers
****************************************************************************}
var
_defaultprop : tpropertysym;
procedure search_class_overloads(aprocsym : tprocsym);
{ searches n in symtable of pd and all anchestors }
var
speedvalue : cardinal;
srsym : tprocsym;
s : string;
objdef : tobjectdef;
begin
if aprocsym.overloadchecked then
exit;
aprocsym.overloadchecked:=true;
if (aprocsym.owner.symtabletype<>objectsymtable) then
internalerror(200111021);
objdef:=tobjectdef(aprocsym.owner.defowner);
{ we start in the parent }
if not assigned(objdef.childof) then
exit;
objdef:=objdef.childof;
s:=aprocsym.name;
speedvalue:=getspeedvalue(s);
while assigned(objdef) do
begin
srsym:=tprocsym(objdef.symtable.speedsearch(s,speedvalue));
if assigned(srsym) then
begin
if (srsym.typ<>procsym) then
internalerror(200111022);
if srsym.is_visible_for_object(tobjectdef(aprocsym.owner.defowner)) then
begin
srsym.add_para_match_to(Aprocsym);
{ we can stop if the overloads were already added
for the found symbol }
if srsym.overloadchecked then
break;
end;
end;
{ next parent }
objdef:=objdef.childof;
end;
end;
procedure tstoredsymtable.testfordefaultproperty(p : TNamedIndexItem;arg:pointer);
begin
if (tsym(p).typ=propertysym) and
(ppo_defaultproperty in tpropertysym(p).propoptions) then
_defaultprop:=tpropertysym(p);
ppointer(arg)^:=p;
end;
function search_default_property(pd : tobjectdef) : tpropertysym;
{ returns the default property of a class, searches also anchestors }
var
_defaultprop : tpropertysym;
begin
_defaultprop:=nil;
while assigned(pd) do
begin
pd.symtable.foreach({$ifdef FPCPROCVAR}@{$endif}tstoredsymtable(pd.symtable).testfordefaultproperty,nil);
pd.symtable.foreach({$ifdef FPCPROCVAR}@{$endif}tstoredsymtable(pd.symtable).testfordefaultproperty,@_defaultprop);
if assigned(_defaultprop) then
break;
pd:=pd.childof;
@ -2256,7 +2292,12 @@ implementation
end.
{
$Log$
Revision 1.114 2003-10-07 15:17:07 peter
Revision 1.115 2003-10-13 14:05:12 peter
* removed is_visible_for_proc
* search also for class overloads when finding interface
implementations
Revision 1.114 2003/10/07 15:17:07 peter
* inline supported again, LOC_REFERENCEs are used to pass the
parameters
* inlineparasymtable,inlinelocalsymtable removed