paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 07:47:59 +02:00
Code Issues Packages Projects Releases Wiki Activity

* improve pretty printing of symbols

Browse Source
This commit is contained in:
florian 2024-02-19 20:40:56 +01:00
parent 79ed0db624
commit 906571fa25
4 changed files with 36 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/pdecobj.pas
View File

@ -589,7 +589,7 @@ implementation
end
else
if oo_is_sealed in childof.objectoptions then
Message1(parser_e_sealed_descendant,childof.typename)
Message1(parser_e_sealed_descendant,childof.typesymbolprettyname)
else
childof:=find_real_class_definition(childof,true);
odt_interfacecorba,

8
compiler/pgenutil.pas
View File

@ -2001,12 +2001,18 @@ uses
else
begin
hadtypetoken:=false;
{ ensure a pretty name for error messages, might be chanced below }
if _prettyname<>'' then
ttypesym(srsym).fprettyname:=_prettyname
else
ttypesym(srsym).fprettyname:=prettyname;
read_named_type(result,srsym,genericdef,generictypelist,false,hadtypetoken);
ttypesym(srsym).typedef:=result;
result.typesym:=srsym;
end;
if _prettyname<>'' then
ttypesym(result.typesym).fprettyname:=_prettyname
else

20
compiler/symdef.pas
View File

@ -162,6 +162,7 @@ interface
function has_non_trivial_init_child(check_parent:boolean):boolean;override;
function rtti_mangledname(rt:trttitype):TSymStr;override;
function OwnerHierarchyName: string; override;
function OwnerHierarchyPrettyName: string; override;
function fullownerhierarchyname(skipprocparams:boolean):TSymStr;override;
function needs_separate_initrtti:boolean;override;
function in_currentunit: boolean;
@ -2222,6 +2223,25 @@ implementation
until tmp=nil;
end;
function tstoreddef.OwnerHierarchyPrettyName: string;
var
tmp: tdef;
begin
tmp:=self;
result:='';
repeat
{ can be not assigned in case of a forwarddef }
if assigned(tmp.owner) and
(tmp.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
tmp:=tdef(tmp.owner.defowner)
else
break;
result:=tabstractrecorddef(tmp).typesymbolprettyname+'.'+result;
until tmp=nil;
end;
function tstoreddef.fullownerhierarchyname(skipprocparams:boolean): TSymStr;
var
lastowner: tsymtable;

9
compiler/symtype.pas
View File

@ -88,6 +88,7 @@ interface
function getmangledparaname:TSymStr;virtual;
function rtti_mangledname(rt:trttitype):TSymStr;virtual;abstract;
function OwnerHierarchyName: string; virtual; abstract;
function OwnerHierarchyPrettyName: string; virtual; abstract;
function fullownerhierarchyname(skipprocparams:boolean):TSymStr;virtual;abstract;
function unique_id_str: string;
function size:asizeint;virtual;abstract;
@ -434,7 +435,7 @@ implementation
function tdef.typesymbolprettyname:string;
begin
result:=OwnerHierarchyName;
result:=OwnerHierarchyPrettyName;
if assigned(typesym) then
result:=result+typesym.prettyname
else
@ -676,8 +677,14 @@ implementation
function tsym.prettyname : string;
var
i: SizeInt;
begin
result:=realname;
{ strip type parameters in the name separated by '$' }
i:=pos('$',result);
if i>0 then
delete(result,i,MaxInt);
end;