paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-22 14:53:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

compiler: push to the stack not only nested hierarchy but also class hierarchy for each nested entry both in method declaration and for method body, also push child hierarchy while parsing object members because in other case parent types are invisible for descendants (fixes mantis #0018124, mantis #0018127 and more) + extended test

Browse Source 
git-svn-id: trunk@16491 -
This commit is contained in:
paul 2010-12-02 03:04:23 +00:00
parent 37179a6558
commit 2155dadf5e
5 changed files with 102 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -10776,6 +10776,7 @@ tests/webtbs/tw18075.pp svneol=native#text/pascal
tests/webtbs/tw18082.pp svneol=native#text/plain
tests/webtbs/tw18085.pp svneol=native#text/pascal
tests/webtbs/tw18086.pp svneol=native#text/pascal
tests/webtbs/tw18127.pp svneol=native#text/pascal
tests/webtbs/tw1820.pp svneol=native#text/plain
tests/webtbs/tw1825.pp svneol=native#text/plain
tests/webtbs/tw1850.pp svneol=native#text/plain

8
compiler/pdecobj.pas
View File

@ -1047,11 +1047,13 @@ implementation
{ parse optional GUID for interfaces }
parse_guid;
{ parse and insert object members }
symtablestack.push(current_objectdef.symtable);
//symtablestack.push(current_objectdef.symtable);
push_child_hierarcy(current_objectdef);
insert_generic_parameter_types(genericdef,genericlist);
{ parse and insert object members }
parse_object_members;
symtablestack.pop(current_objectdef.symtable);
//symtablestack.pop(current_objectdef.symtable);
pop_child_hierarchy(current_objectdef);
end;
{ generate vmt space if needed }

89
compiler/pdecsub.pas
View File

@ -62,6 +62,14 @@ interface
function parse_proc_head(aclass:tobjectdef;potype:tproctypeoption;var pd:tprocdef):boolean;
function parse_proc_dec(isclassmethod:boolean; aclass:tobjectdef):tprocdef;
{ helper functions - they insert nested objects hierarcy to the symtablestack
with object hierarchy
}
function push_child_hierarcy(obj:tobjectdef):integer;
function pop_child_hierarchy(obj:tobjectdef):integer;
function push_nested_hierarchy(obj:tobjectdef):integer;
function pop_nested_hierarchy(obj:tobjectdef):integer;
implementation
uses
@ -89,6 +97,51 @@ implementation
Declaring it as string here results in an error when compiling (PFV) }
current_procinfo = 'error';
function push_child_hierarcy(obj:tobjectdef):integer;
var
_class,hp : tobjectdef;
begin
result:=0;
{ insert class hierarchy in the reverse order }
hp:=nil;
repeat
_class:=obj;
while _class.childof<>hp do
_class:=_class.childof;
hp:=_class;
symtablestack.push(_class.symtable);
inc(result);
until hp=obj;
end;
function push_nested_hierarchy(obj:tobjectdef):integer;
begin
result:=0;
if obj.owner.symtabletype=ObjectSymtable then
inc(result,push_nested_hierarchy(tobjectdef(obj.owner.defowner)));
inc(result,push_child_hierarcy(obj));
end;
function pop_child_hierarchy(obj:tobjectdef):integer;
var
_class : tobjectdef;
begin
result:=0;
_class:=obj;
while assigned(_class) do
begin
symtablestack.pop(_class.symtable);
_class:=_class.childof;
inc(result);
end;
end;
function pop_nested_hierarchy(obj:tobjectdef):integer;
begin
result:=pop_child_hierarchy(obj);
if obj.owner.symtabletype=ObjectSymtable then
inc(result,pop_nested_hierarchy(tobjectdef(obj.owner.defowner)));
end;
procedure insert_funcret_para(pd:tabstractprocdef);
var
@ -720,23 +773,6 @@ implementation
function parse_proc_head(aclass:tobjectdef;potype:tproctypeoption;var pd:tprocdef):boolean;
function push_objects(obj:tobjectdef):integer;
begin
result:=1;
if obj.owner.symtabletype=ObjectSymtable then
inc(result,push_objects(tobjectdef(obj.owner.defowner)));
symtablestack.push(obj.symtable);
end;
function pop_objects(obj:tobjectdef):integer;
begin
result:=1;
symtablestack.pop(obj.symtable);
if obj.owner.symtabletype=ObjectSymtable then
inc(result,pop_objects(tobjectdef(obj.owner.defowner)));
end;
var
hs : string;
orgsp,sp : TIDString;
@ -1020,7 +1056,7 @@ implementation
(pd.parast.symtablelevel=normal_function_level) and
(symtablestack.top.symtabletype<>ObjectSymtable) then
begin
popclass:=push_objects(pd._class);
popclass:=push_nested_hierarchy(pd._class);
old_current_objectdef:=current_objectdef;
old_current_genericdef:=current_genericdef;
old_current_specializedef:=current_specializedef;
@ -1041,7 +1077,7 @@ implementation
current_objectdef:=old_current_objectdef;
current_genericdef:=old_current_genericdef;
current_specializedef:=old_current_specializedef;
dec(popclass, pop_objects(pd._class));
dec(popclass,pop_nested_hierarchy(pd._class));
if popclass<>0 then
internalerror(201011260); // 11 nov 2010 index 0
end;
@ -1056,8 +1092,8 @@ implementation
var
pd : tprocdef;
locationstr: string;
old_parse_generic,
popclass: boolean;
old_parse_generic: boolean;
popclass: integer;
old_current_objectdef,
old_current_genericdef,
old_current_specializedef: tobjectdef;
@ -1078,13 +1114,12 @@ implementation
old_parse_generic:=parse_generic;
inc(testcurobject);
{ Add ObjectSymtable to be able to find generic type definitions }
popclass:=false;
popclass:=0;
if assigned(pd._class) and
(pd.parast.symtablelevel=normal_function_level) and
(symtablestack.top.symtabletype<>ObjectSymtable) then
begin
symtablestack.push(pd._class.symtable);
popclass:=true;
popclass:=push_nested_hierarchy(pd._class);
parse_generic:=(df_generic in pd._class.defoptions);
old_current_objectdef:=current_objectdef;
old_current_genericdef:=current_genericdef;
@ -1100,12 +1135,14 @@ implementation
if is_dispinterface(pd._class) and not is_automatable(pd.returndef) then
Message1(type_e_not_automatable,pd.returndef.typename);
if popclass then
if popclass>0 then
begin
current_objectdef:=old_current_objectdef;
current_genericdef:=old_current_genericdef;
current_specializedef:=old_current_specializedef;
symtablestack.pop(pd._class.symtable);
dec(popclass,pop_nested_hierarchy(pd._class));
if popclass<>0 then
internalerror(201012020);
end;
dec(testcurobject);
parse_generic:=old_parse_generic;

25
compiler/psub.pas
View File

@ -1271,25 +1271,13 @@ implementation
procedure tcgprocinfo.add_to_symtablestack;
var
_class,hp : tobjectdef;
begin
{ insert symtables for the class, but only if it is no nested function }
if assigned(procdef._class) and
not(assigned(parent) and
assigned(parent.procdef) and
assigned(parent.procdef._class)) then
begin
{ insert them in the reverse order }
hp:=nil;
repeat
_class:=procdef._class;
while _class.childof<>hp do
_class:=_class.childof;
hp:=_class;
symtablestack.push(_class.symtable);
until hp=procdef._class;
end;
push_nested_hierarchy(procdef._class);
{ insert parasymtable in symtablestack when parsing
a function }
@ -1305,8 +1293,6 @@ implementation
procedure tcgprocinfo.remove_from_symtablestack;
var
_class : tobjectdef;
begin
{ remove localsymtable }
if procdef.localst.symtablelevel>=normal_function_level then
@ -1321,14 +1307,7 @@ implementation
not(assigned(parent) and
assigned(parent.procdef) and
assigned(parent.procdef._class)) then
begin
_class:=procdef._class;
while assigned(_class) do
begin
symtablestack.pop(_class.symtable);
_class:=_class.childof;
end;
end;
pop_nested_hierarchy(procdef._class);
end;

31
tests/webtbs/tw18127.pp Normal file
View File

@ -0,0 +1,31 @@
{ %norun% }
program tw18127;
{$mode objfpc}{$H+}
type
TBar = class
public
type
TSomeInt = integer;
end;
TFoo1 = class(TBar)
public
const
one = 1;
type
TFoo2 = TSomeInt; // was error: Identifier not found "TSomeInt"
TFoo3 = class
function Func: TFoo2;
end;
end;
function TFoo1.TFoo3.Func: TFoo2; // was error: Identifier not found "TFoo2"
begin
Result := one; // was error: Identifier not found "one"
end;
begin
end.