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

symtable.pas:

Browse Source 
- moved "find_last_classhelper" out of "search_objectpascal_class_helper" so that it can be used in the "for ... in" code.
- renamed "find_last_classhelper" to "search_last_objectpascal_classhelper"
- fixed the unintentional use of a parameter ("srsymtable") of the parent function (it was intended as a variable from the beginning)
- "search_objectpascal_class_helper" now also checks whether the matched class helper method is visible; for this a new parameter for the contextclass was added which is passed when called from "searchsym_in_class"
nflw.pas: before checking for a "GetEnumerator" method in the class we now check whether one of the class helpers in the hierarchy that is available for that class (using "search_last_objectpascal_classhelper") implements such a method (I need yet to check whether Delphi supports the addition of "Current" and "MoveNext" as well)

git-svn-id: branches/svenbarth/classhelpers@16829 -
This commit is contained in:
svenbarth 2011-01-28 21:05:29 +00:00
parent 36ee46110c
commit a317827456
2 changed files with 54 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
compiler/nflw.pas
View File

@ -824,6 +824,7 @@ implementation
function create_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
var
pd, movenext: tprocdef;
classhelper: tobjectdef;
current: tpropertysym;
storefilepos: tfileposinfo;
begin
@ -861,7 +862,17 @@ implementation
pd:=search_enumerator_operator(expr.resultdef, hloopvar.resultdef);
// if there is no operator then search for class/object enumerator method
if (pd=nil) and (expr.resultdef.typ=objectdef) then
pd:=tobjectdef(expr.resultdef).search_enumerator_get;
begin
{ first search using the class helper hierarchy }
if search_last_objectpascal_classhelper(tobjectdef(expr.resultdef),classhelper) then
repeat
pd:=classhelper.search_enumerator_get;
classhelper:=classhelper.helperparent;
until (pd<>nil) or (classhelper=nil);
{ not found in class helper, so search in the class itself }
if pd=nil then
pd:=tobjectdef(expr.resultdef).search_enumerator_get;
end;
if pd<>nil then
begin
// seach movenext and current symbols

79
compiler/symtable.pas
View File

@ -229,7 +229,8 @@ interface
function search_struct_member(pd : tabstractrecorddef;const s : string):tsym;
function search_assignment_operator(from_def,to_def:Tdef;explicit:boolean):Tprocdef;
function search_enumerator_operator(from_def,to_def:Tdef):Tprocdef;
function search_objectpascal_class_helper(pd : tobjectdef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
function search_last_objectpascal_classhelper(pd : tobjectdef;out odef : tobjectdef):boolean;
function search_objectpascal_class_helper(pd,contextclassh : tobjectdef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
function search_class_helper(pd : tobjectdef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
function search_objc_method(const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
{Looks for macro s (must be given in upper case) in the macrosymbolstack, }
@ -2139,7 +2140,7 @@ implementation
class }
if is_class(classh) then
begin
result:=search_objectpascal_class_helper(classh,s,srsym,srsymtable);
result:=search_objectpascal_class_helper(classh,contextclassh,s,srsym,srsymtable);
if result then
exit;
end;
@ -2405,51 +2406,52 @@ implementation
end;
end;
function search_objectpascal_class_helper(pd : tobjectdef;const s: string; out srsym: tsym; out srsymtable: tsymtable):boolean;
function search_last_objectpascal_classhelper(pd : tobjectdef;out odef : tobjectdef):boolean;
var
stackitem : psymtablestackitem;
i : integer;
srsymtable : tsymtable;
begin
result:=false;
stackitem:=symtablestack.stack;
while assigned(stackitem) do
begin
srsymtable:=stackitem^.symtable;
if srsymtable.symtabletype in [staticsymtable,globalsymtable] then
begin
{ we need to search from last to first }
for i:=srsymtable.symlist.count-1 downto 0 do
begin
if not (srsymtable.symlist[i] is ttypesym) then
continue;
if not is_objectpascal_classhelper(ttypesym(srsymtable.symlist[i]).typedef) then
continue;
odef:=tobjectdef(ttypesym(srsymtable.symlist[i]).typedef);
{ does the class helper extend the correct class? }
result:=odef.childof=pd;
if result then
exit
else
odef:=nil;
end;
end;
stackitem:=stackitem^.next;
end;
end;
function find_last_classhelper(out odef : tobjectdef):boolean;
{ uses "pd" of parent function }
var
stackitem : psymtablestackitem;
i : integer;
begin
result:=false;
stackitem:=symtablestack.stack;
while assigned(stackitem) do
begin
srsymtable:=stackitem^.symtable;
if srsymtable.symtabletype in [staticsymtable,globalsymtable] then
begin
{ we need to search from last to first }
for i:=srsymtable.symlist.count-1 downto 0 do
begin
if not (srsymtable.symlist[i] is ttypesym) then
continue;
if not is_objectpascal_classhelper(ttypesym(srsymtable.symlist[i]).typedef) then
continue;
odef:=tobjectdef(ttypesym(srsymtable.symlist[i]).typedef);
{ does the class helper extend the correct class? }
result:=odef.childof=pd;
if result then
exit
else
odef:=nil;
end;
end;
stackitem:=stackitem^.next;
end;
end;
function search_objectpascal_class_helper(pd,contextclassh : tobjectdef;const s: string; out srsym: tsym; out srsymtable: tsymtable):boolean;
var
hashedid : THashedIDString;
classh : tobjectdef;
i: integer;
i : integer;
pdef : tprocdef;
begin
result:=false;
{ if there is no class helper for the class then there is no need to
search further }
if not find_last_classhelper(classh) then
if not search_last_objectpascal_classhelper(pd,classh) then
exit;
hashedid.id:=s;
@ -2467,6 +2469,9 @@ implementation
end;
for i:=0 to tprocsym(srsym).procdeflist.count-1 do
begin
pdef:=tprocdef(tprocsym(srsym).procdeflist[i]);
if not is_visible_for_object(pdef.owner,pdef.visibility,contextclassh) then
continue;
{ we need to know if a procedure references symbols
in the static symtable, because then it can't be
inlined from outside this unit }