Browse Source

+ ttypesym.prettyname
* write names of specialization type syms more pretty

git-svn-id: trunk@18241 -

florian 14 years ago
parent
commit
79a96ab287
7 changed files with 43 additions and 14 deletions
  1. 1 1
      compiler/pexpr.pas
  2. 1 1
      compiler/ppu.pas
  3. 20 5
      compiler/ptype.pas
  4. 1 1
      compiler/symdef.pas
  5. 13 0
      compiler/symsym.pas
  6. 6 6
      compiler/symtable.pas
  7. 1 0
      compiler/symtype.pas

+ 1 - 1
compiler/pexpr.pas

@@ -1492,7 +1492,7 @@ implementation
                        if (df_generic in hdef.defoptions) and
                           (token=_LT) and
                           (m_delphi in current_settings.modeswitches) then
-                          generate_specialization(hdef,false);
+                          generate_specialization(hdef,false,'');
                        if try_to_consume(_LKLAMMER) then
                         begin
                           p1:=comp_expr(true,false);

+ 1 - 1
compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 134;
+  CurrentPPUVersion = 135;
 
 { buffer sizes }
   maxentrysize = 1024;

+ 20 - 5
compiler/ptype.pas

@@ -52,7 +52,7 @@ interface
     { generate persistent type information like VMT, RTTI and inittables }
     procedure write_persistent_type_info(st:tsymtable);
 
-    procedure generate_specialization(var tt:tdef;parse_class_parent:boolean);
+    procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;_prettyname : string);
 
 implementation
 
@@ -143,7 +143,7 @@ implementation
       end;
 
 
-    procedure generate_specialization(var tt:tdef;parse_class_parent:boolean);
+    procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;_prettyname : string);
       var
         st  : TSymtable;
         srsym : tsym;
@@ -159,6 +159,7 @@ implementation
         oldextendeddefs    : TFPHashObjectList;
         hmodule : tmodule;
         pu : tused_unit;
+        prettyname : ansistring;
         uspecializename,
         specializename : string;
         vmtbuilder : TVMTBuilder;
@@ -228,6 +229,7 @@ implementation
         if not assigned(genericdef.typesym) then
           internalerror(200710173);
         specializename:=genericdef.typesym.realname;
+        prettyname:=genericdef.typesym.prettyname+'<';
         for i:=0 to st.SymList.Count-1 do
           begin
             sym:=tsym(st.SymList[i]);
@@ -247,7 +249,13 @@ implementation
                     if not assigned(pt2.resultdef.typesym) then
                       message(type_e_generics_cannot_reference_itself)
                     else
-                      specializename:=specializename+'$'+pt2.resultdef.typesym.realname;
+                      begin
+                        specializename:=specializename+'$'+pt2.resultdef.typesym.realname;
+                        if i=0 then
+                          prettyname:=prettyname+pt2.resultdef.typesym.prettyname
+                        else
+                          prettyname:=prettyname+','+pt2.resultdef.typesym.prettyname;
+                      end;
                   end
                 else
                   begin
@@ -257,6 +265,8 @@ implementation
                 pt2.free;
               end;
           end;
+        prettyname:=prettyname+'>';
+
         uspecializename:=upper(specializename);
         { force correct error location if too much type parameters are passed }
         if not (token in [_RSHARPBRACKET,_GT]) then
@@ -335,6 +345,11 @@ implementation
                 ttypesym(srsym).typedef:=tt;
                 tt.typesym:=srsym;
 
+                if _prettyname<>'' then
+                  ttypesym(tt.typesym).fprettyname:=_prettyname
+                else
+                  ttypesym(tt.typesym).fprettyname:=prettyname;
+
                 case tt.typ of
                   { Build VMT indexes for classes }
                   objectdef:
@@ -616,7 +631,7 @@ implementation
            (m_delphi in current_settings.modeswitches) then
           dospecialize:=token=_LSHARPBRACKET;
         if dospecialize then
-          generate_specialization(def,stoParseClassParent in options)
+          generate_specialization(def,stoParseClassParent in options,'')
         else
           begin
             if assigned(current_specializedef) and (def=current_specializedef.genericdef) then
@@ -1075,7 +1090,7 @@ implementation
                    if (m_delphi in current_settings.modeswitches) then
                      dospecialize:=token=_LSHARPBRACKET;
                    if dospecialize then
-                     generate_specialization(def,false)
+                     generate_specialization(def,false,name)
                    else
                      begin
                        if assigned(current_specializedef) and (def=current_specializedef.genericdef) then

+ 1 - 1
compiler/symdef.pas

@@ -4612,7 +4612,7 @@ implementation
         if not assigned(typesym) then
           result:='<Currently Parsed Class>'
         else
-          result:=typename;
+          result:=typesymbolprettyname;
       end;
 
 

+ 13 - 0
compiler/symsym.pas

@@ -112,11 +112,13 @@ interface
        ttypesym = class(Tstoredsym)
           typedef      : tdef;
           typedefderef : tderef;
+          fprettyname : ansistring;
           constructor create(const n : string;def:tdef);
           constructor ppuload(ppufile:tcompilerppufile);
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderef;override;
           procedure deref;override;
+          function prettyname : string;override;
        end;
 
        tabstractvarsym = class(tstoredsym)
@@ -1850,6 +1852,7 @@ implementation
       begin
          inherited ppuload(typesym,ppufile);
          ppufile.getderef(typedefderef);
+         fprettyname:=ppufile.getansistring;
       end;
 
 
@@ -1869,10 +1872,20 @@ implementation
       begin
          inherited ppuwrite(ppufile);
          ppufile.putderef(typedefderef);
+         ppufile.putansistring(fprettyname);
          ppufile.writeentry(ibtypesym);
       end;
 
 
+    function ttypesym.prettyname : string;
+      begin
+        if fprettyname<>'' then
+          result:=fprettyname
+        else
+          result:=inherited prettyname;
+      end;
+
+
 {****************************************************************************
                                   TSYSSYM
 ****************************************************************************}

+ 6 - 6
compiler/symtable.pas

@@ -663,7 +663,7 @@ implementation
                  else if (tsym(sym).owner.symtabletype=parasymtable) then
                    MessagePos1(tsym(sym).fileinfo,sym_h_para_identifier_not_used,tsym(sym).prettyname)
                  else if (tsym(sym).owner.symtabletype in [ObjectSymtable,recordsymtable]) then
-                   MessagePos2(tsym(sym).fileinfo,sym_n_private_identifier_not_used,tabstractrecorddef(tsym(sym).owner.defowner).RttiName,tsym(sym).prettyname)
+                   MessagePos2(tsym(sym).fileinfo,sym_n_private_identifier_not_used,tabstractrecorddef(tsym(sym).owner.defowner).GetTypeName,tsym(sym).prettyname)
                  else
                    MessagePos1(tsym(sym).fileinfo,sym_n_local_identifier_not_used,tsym(sym).prettyname);
               end
@@ -676,7 +676,7 @@ implementation
                        MessagePos1(tsym(sym).fileinfo,sym_h_para_identifier_only_set,tsym(sym).prettyname)
                    end
                  else if (tsym(sym).owner.symtabletype in [ObjectSymtable,recordsymtable]) then
-                   MessagePos2(tsym(sym).fileinfo,sym_n_private_identifier_only_set,tabstractrecorddef(tsym(sym).owner.defowner).RttiName,tsym(sym).prettyname)
+                   MessagePos2(tsym(sym).fileinfo,sym_n_private_identifier_only_set,tabstractrecorddef(tsym(sym).owner.defowner).GetTypeName,tsym(sym).prettyname)
                  else if tabstractvarsym(sym).varoptions*[vo_is_funcret,vo_is_public,vo_is_external]=[] then
                    MessagePos1(tsym(sym).fileinfo,sym_n_local_identifier_only_set,tsym(sym).prettyname);
               end
@@ -694,13 +694,13 @@ implementation
            if (tsym(sym).refs=0) and (tsym(sym).owner.symtabletype in [ObjectSymtable,recordsymtable]) then
              case tsym(sym).typ of
                typesym:
-                 MessagePos2(tsym(sym).fileinfo,sym_n_private_type_not_used,tabstractrecorddef(tsym(sym).owner.defowner).RttiName,tsym(sym).prettyname);
+                 MessagePos2(tsym(sym).fileinfo,sym_n_private_type_not_used,tabstractrecorddef(tsym(sym).owner.defowner).GetTypeName,tsym(sym).prettyname);
                constsym:
-                 MessagePos2(tsym(sym).fileinfo,sym_n_private_const_not_used,tabstractrecorddef(tsym(sym).owner.defowner).RttiName,tsym(sym).prettyname);
+                 MessagePos2(tsym(sym).fileinfo,sym_n_private_const_not_used,tabstractrecorddef(tsym(sym).owner.defowner).GetTypeName,tsym(sym).prettyname);
                propertysym:
-                 MessagePos2(tsym(sym).fileinfo,sym_n_private_property_not_used,tabstractrecorddef(tsym(sym).owner.defowner).RttiName,tsym(sym).prettyname);
+                 MessagePos2(tsym(sym).fileinfo,sym_n_private_property_not_used,tabstractrecorddef(tsym(sym).owner.defowner).GetTypeName,tsym(sym).prettyname);
              else
-               MessagePos2(tsym(sym).fileinfo,sym_n_private_method_not_used,tabstractrecorddef(tsym(sym).owner.defowner).RttiName,tsym(sym).prettyname);
+               MessagePos2(tsym(sym).fileinfo,sym_n_private_method_not_used,tabstractrecorddef(tsym(sym).owner.defowner).GetTypeName,tsym(sym).prettyname);
              end
            { units references are problematic }
            else

+ 1 - 0
compiler/symtype.pas

@@ -286,6 +286,7 @@ implementation
           result:=result+'<no type symbol>'
       end;
 
+
     function tdef.mangledparaname:string;
       begin
         if assigned(typesym) then