mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-11 20:26:00 +02:00
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:
parent
55702ed4c0
commit
6b087799ef
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
46
tests/test/tclass13.pp
Normal 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.
|
Loading…
Reference in New Issue
Block a user