Browse Source

* Allow to ask pretty format when giving full hierarchy name

Michaël Van Canneyt 1 ngày trước cách đây
mục cha
commit
d57974dde7
4 tập tin đã thay đổi với 17 bổ sung11 xóa
  1. 4 4
      compiler/pgenutil.pas
  2. 1 1
      compiler/symcreat.pas
  3. 10 4
      compiler/symdef.pas
  4. 2 2
      compiler/symtype.pas

+ 4 - 4
compiler/pgenutil.pas

@@ -111,11 +111,11 @@ uses
             (paramtype.owner=symtablestack.top) then
           begin
             { special handling for specializations inside generic function declarations }
-            prettynamepart:=tdef(symtablestack.top.defowner).fullownerhierarchyname(true)+tprocdef(symtablestack.top.defowner).procsym.prettyname;
+            prettynamepart:=tdef(symtablestack.top.defowner).fullownerhierarchyname(true,true)+tprocdef(symtablestack.top.defowner).procsym.prettyname;
           end
         else
           begin
-            prettynamepart:=paramtype.fullownerhierarchyname(true);
+            prettynamepart:=paramtype.fullownerhierarchyname(true,true);
           end;
         specializename:=specializename+namepart;
         if not first then
@@ -583,7 +583,7 @@ uses
               internalerror(2016112801);
             namepart:='_$'+hexstr(module.moduleid,8)+'$$'+parsedtype.unique_id_str;
             specializename:='$'+namepart;
-            prettyname:=parsedtype.fullownerhierarchyname(true)+parsedtype.typesym.prettyname;
+            prettyname:=parsedtype.fullownerhierarchyname(true,true)+parsedtype.typesym.prettyname;
             if assigned(poslist) then
               begin
                 New(parampos);
@@ -800,7 +800,7 @@ uses
                     same number of array elements of a particular type }
                   def:=carraydef.getreusable(tarraydef(def).elementdef,tarraydef(def).highrange-tarraydef(def).lowrange+1);
                 end;
-              newtype:=ctypesym.create(def.fullownerhierarchyname(false)+typName[def.typ]+'$'+def.unique_id_str,def);
+              newtype:=ctypesym.create(def.fullownerhierarchyname(false,true)+typName[def.typ]+'$'+def.unique_id_str,def);
               include(newtype.symoptions,sp_generic_unnamed_type);
               newtype.owner:=def.owner;
               { ensure that there's no warning }

+ 1 - 1
compiler/symcreat.pas

@@ -1440,7 +1440,7 @@ implementation
       exit('pointer');
     if (vardef is tprocvardef) then
       begin
-      result:=vardef.fullownerhierarchyname(false);
+      result:=vardef.fullownerhierarchyname(false,false);
       if Assigned(vardef.typesym) then
         Result:=Result+(vardef.typesym.Name);
       end

+ 10 - 4
compiler/symdef.pas

@@ -164,7 +164,8 @@ interface
           function  rtti_mangledname(rt:trttitype):TSymStr;override;
           function  OwnerHierarchyName: string; override;
           function  OwnerHierarchyPrettyName: string; override;
-          function  fullownerhierarchyname(skipprocparams:boolean):TSymStr;override;
+          function  fullownerhierarchyname(skipprocparams:boolean;use_pretty : boolean):TSymStr;override;
+
           function  needs_separate_initrtti:boolean;override;
           function  in_currentunit: boolean;
           { regvars }
@@ -2253,7 +2254,7 @@ implementation
       end;
 
 
-    function tstoreddef.fullownerhierarchyname(skipprocparams:boolean): TSymStr;
+    function tstoreddef.fullownerhierarchyname(skipprocparams:boolean; use_pretty : boolean): TSymStr;
       var
         lastowner: tsymtable;
         tmp: tdef;
@@ -2280,7 +2281,12 @@ implementation
           if not assigned(tmp) then
             break;
           if tmp.typ in [recorddef,objectdef] then
-            result:=tabstractrecorddef(tmp).objrealname^+'.'+result
+            begin
+              if use_pretty then
+                result:=tabstractrecorddef(tmp).typesymbolprettyname+'.'+result
+              else
+                result:=tabstractrecorddef(tmp).objrealname^+'.'+result;
+            end
           else
             if tmp.typ=procdef then
               begin
@@ -2691,7 +2697,7 @@ implementation
            tmod:=find_module_from_symtable(owner);
             if assigned(tmod) and assigned(current_module) and (tmod<>current_module) then
               begin
-                comment(v_error,'Definition '+fullownerhierarchyname(false)+' from module '+tmod.mainsource+' registered with current module '+current_module.mainsource);
+                comment(v_error,'Definition '+fullownerhierarchyname(false,true)+' from module '+tmod.mainsource+' registered with current module '+current_module.mainsource);
               end;
            if not assigned(tmod) then
              tmod:=current_module;

+ 2 - 2
compiler/symtype.pas

@@ -89,7 +89,7 @@ interface
          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  fullownerhierarchyname(skipprocparams:boolean;use_pretty : boolean):TSymStr;virtual;abstract;
          function  unique_id_str: string;
          function  size:asizeint;virtual;abstract;
          function  packedbitsize:asizeint;virtual;
@@ -418,7 +418,7 @@ implementation
 
     function tdef.fulltypename:string;
       begin
-        result:=fullownerhierarchyname(false);
+        result:=fullownerhierarchyname(false,false);
         if assigned(typesym) and
            not(typ in [procvardef,procdef]) and
            (typesym.realname[1]<>'$') then