Browse Source

* improve pretty printing of symbols

florian 1 year ago
parent
commit
906571fa25
4 changed files with 36 additions and 3 deletions
  1. 1 1
      compiler/pdecobj.pas
  2. 7 1
      compiler/pgenutil.pas
  3. 20 0
      compiler/symdef.pas
  4. 8 1
      compiler/symtype.pas

+ 1 - 1
compiler/pdecobj.pas

@@ -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,

+ 7 - 1
compiler/pgenutil.pas

@@ -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 - 0
compiler/symdef.pas

@@ -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;

+ 8 - 1
compiler/symtype.pas

@@ -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;