compiler: nested class types:

- fix is_visible_for_object to work correctly if symbol is in the objectsymtable but no current_objectdef present
  - fix ClassName for nested classes
  + test
  

git-svn-id: trunk@14617 -
This commit is contained in:
paul 2010-01-11 19:44:02 +00:00
parent 55702ed4c0
commit 6b087799ef
5 changed files with 87 additions and 22 deletions

1
.gitattributes vendored
View File

@ -8895,6 +8895,7 @@ tests/test/tclass11b.pp svneol=native#text/pascal
tests/test/tclass12a.pp svneol=native#text/pascal
tests/test/tclass12b.pp svneol=native#text/pascal
tests/test/tclass12c.pp svneol=native#text/pascal
tests/test/tclass13.pp svneol=native#text/pascal
tests/test/tclass2.pp svneol=native#text/plain
tests/test/tclass3.pp svneol=native#text/plain
tests/test/tclass4.pp svneol=native#text/plain

View File

@ -1394,13 +1394,11 @@ implementation
methodnametable,intmessagetable,
strmessagetable,classnamelabel,
fieldtablelabel : tasmlabel;
hs: string;
{$ifdef WITHDMT}
dmtlabel : tasmlabel;
{$endif WITHDMT}
interfacetable : tasmlabel;
{$ifdef vtentry}
hs: string;
{$endif vtentry}
begin
{$ifdef WITHDMT}
dmtlabel:=gendmt;
@ -1422,8 +1420,9 @@ implementation
fieldtablelabel:=generate_field_table;
{ write class name }
current_asmdata.asmlists[al_globals].concat(Tai_label.Create(classnamelabel));
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_8bit(length(_class.objrealname^)));
current_asmdata.asmlists[al_globals].concat(Tai_string.Create(_class.objrealname^));
hs:=_class.RttiName;
current_asmdata.asmlists[al_globals].concat(Tai_const.Create_8bit(length(hs)));
current_asmdata.asmlists[al_globals].concat(Tai_string.Create(hs));
{ generate message and dynamic tables }
if (oo_has_msgstr in _class.objectoptions) then

View File

@ -316,6 +316,7 @@ interface
procedure finish_objc_data;
{ C++ }
procedure finish_cpp_data;
function RttiName: string;
end;
tclassrefdef = class(tabstractpointerdef)
@ -3230,7 +3231,6 @@ implementation
var
s : string;
t : ttoken;
tmp: tobjectdef;
begin
{$ifdef EXTDEBUG}
showhidden:=true;
@ -3238,15 +3238,7 @@ implementation
s:='';
if assigned(_class) then
begin
tmp:=_class;
while assigned(tmp) do
begin
s:=tmp.objrealname^+'.'+s;
if assigned(tmp.owner) and (tmp.owner.symtabletype=ObjectSymtable) then
tmp:=tobjectdef(tmp.owner.defowner)
else
tmp:=nil;
end;
s:=_class.RttiName+'.';
if (po_classmethod in procoptions) then
s:='class ' + s;
end;
@ -4848,6 +4840,21 @@ implementation
self.symtable.DefList.ForEachCall(@do_cpp_import_info,nil);
end;
function tobjectdef.RttiName: string;
var
tmp: tobjectdef;
begin
Result:=objrealname^;
tmp:=self;
repeat
if tmp.owner.symtabletype=ObjectSymtable then
tmp:=tobjectdef(tmp.owner.defowner)
else
break;
Result:=tmp.objrealname^+'.'+Result;
until tmp=nil;
end;
{****************************************************************************
TImplementedInterface

View File

@ -1601,10 +1601,16 @@ implementation
) or
( // the case of specialize inside the generic declaration
(symownerdef.owner.symtabletype = objectsymtable) and
assigned(current_objectdef) and
(
(current_objectdef=symownerdef) or
(current_objectdef.owner.moduleid=symownerdef.owner.moduleid)
assigned(current_objectdef) and
(
(current_objectdef=symownerdef) or
(current_objectdef.owner.moduleid=symownerdef.owner.moduleid)
)
) or
(
not assigned(current_objectdef) and
(symownerdef.owner.moduleid=current_module.moduleid)
)
);
end;
@ -1636,11 +1642,17 @@ implementation
) or
( // the case of specialize inside the generic declaration
(symownerdef.owner.symtabletype = objectsymtable) and
assigned(current_objectdef) and
(
(current_objectdef=symownerdef) or
(current_objectdef.owner.moduleid=symownerdef.owner.moduleid)
)
assigned(current_objectdef) and
(
(current_objectdef=symownerdef) or
(current_objectdef.owner.moduleid=symownerdef.owner.moduleid)
)
) or
(
not assigned(current_objectdef) and
(symownerdef.owner.moduleid=current_module.moduleid)
)
)
);
end;

46
tests/test/tclass13.pp Normal file
View File

@ -0,0 +1,46 @@
program tclass13;
{$ifdef fpc}
{$mode delphi}{$H+}
{$endif}
{$apptype console}
uses
typinfo;
type
TRootClass = class
public
type
TNode = class
private
FTest: Integer;
type
TNode = class
end;
en = (e1,e2);
published
property Test: Integer read FTest write FTest;
end;
class procedure DoTest;
end;
class procedure TRootClass.DoTest;
var
Test: TNode;
Test1: TNode.TNode;
begin
Test := TNode.Create;
Test.Test := 1;
if Test.ClassName <> 'TRootClass.TNode' then
halt(1);
Test.Free;
Test1 := TNode.TNode.Create;
if Test1.ClassName <> 'TRootClass.TNode.TNode' then
halt(2);
Test1.Free;
end;
begin
TRootClass.DoTest;
if GetEnumName(TypeInfo(TRootClass.TNode.en), ord(e1))<>'e1' then
halt(3);
end.