paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-04 14:39:36 +01:00
Code Issues Packages Projects Releases Wiki Activity

compiler: add all nested classes to the symtable stack while parsing method header (issue #0017952)

Browse Source 
git-svn-id: trunk@16439 -
This commit is contained in:
paul 2010-11-26 07:30:20 +00:00
parent 675c3391d1
commit 0c23029d8f
4 changed files with 86 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -10758,6 +10758,8 @@ tests/webtbs/tw17928.pp svneol=native#text/plain
tests/webtbs/tw1792a.pp svneol=native#text/plain
tests/webtbs/tw17945.pp svneol=native#text/pascal
tests/webtbs/tw17950.pp svneol=native#text/pascal
tests/webtbs/tw17952a.pp svneol=native#text/pascal
tests/webtbs/tw17952b.pp svneol=native#text/pascal
tests/webtbs/tw1798.pp svneol=native#text/plain
tests/webtbs/tw17998.pp svneol=native#text/plain
tests/webtbs/tw18013.pp svneol=native#text/plain

32
compiler/pdecsub.pas
View File

@ -720,6 +720,23 @@ 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;
@ -732,7 +749,7 @@ implementation
st,
genericst: TSymtable;
aprocsym : tprocsym;
popclass : boolean;
popclass : integer;
ImplIntf : TImplementedInterface;
old_parse_generic : boolean;
old_current_objectdef,
@ -997,13 +1014,13 @@ implementation
{ parse parameters }
if token=_LKLAMMER then
begin
{ Add ObjectSymtable to be able to find generic type definitions }
popclass:=false;
{ Add ObjectSymtable to be able to find nested type definitions }
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:=push_objects(pd._class);
old_current_objectdef:=current_objectdef;
old_current_genericdef:=current_genericdef;
old_current_specializedef:=current_specializedef;
@ -1012,7 +1029,6 @@ implementation
current_genericdef:=current_objectdef;
if assigned(current_objectdef) and (df_specialization in current_objectdef.defoptions) then
current_specializedef:=current_objectdef;
popclass:=true;
end;
{ Add parameter symtable }
if pd.parast.symtabletype<>staticsymtable then
@ -1020,12 +1036,14 @@ implementation
parse_parameter_dec(pd);
if pd.parast.symtabletype<>staticsymtable then
symtablestack.pop(pd.parast);
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_objects(pd._class));
if popclass<>0 then
internalerror(201011260); // 11 nov 2010 index 0
end;
end;

24
tests/webtbs/tw17952a.pp Normal file
View File

@ -0,0 +1,24 @@
program tw17952a;
{$mode delphi}
// check visibility of nested types in method headers
type
TFoo1 = class
public
type
TFoo2 = object
end;
TFoo3 = object
procedure Proc(value: TFoo2);
end;
end;
procedure TFoo1.TFoo3.Proc(value: TFoo2); // was error: Identifier not found "TFoo2"
begin
end;
begin
end.

29
tests/webtbs/tw17952b.pp Normal file
View File

@ -0,0 +1,29 @@
program tw17952b;
{$mode delphi}
// check visibility of nested types in method headers
type
TFoo1 = class
public
type
TFoo2 = object
end;
TFoo3 = object
procedure Proc(value: TFoo2);
end;
end;
TFoo2 = Integer;
// delphi gives an error here. fpc does not.
// people thinks that this is a bug in delphi (QC# 89846)
procedure TFoo1.TFoo3.Proc(value: TFoo2);
begin
end;
begin
end.