Browse Source

* extend tdef.fullownerhierarchyname() with a parameter that skips the inclusion of a procdef's parameter declaration using the new pno_noparams option

git-svn-id: trunk@35009 -
svenbarth 8 years ago
parent
commit
ee466b9a28
4 changed files with 21 additions and 13 deletions
  1. 1 1
      compiler/llvm/llvmdef.pas
  2. 3 3
      compiler/pgenutil.pas
  3. 15 7
      compiler/symdef.pas
  4. 2 2
      compiler/symtype.pas

+ 1 - 1
compiler/llvm/llvmdef.pas

@@ -129,7 +129,7 @@ implementation
     begin
     begin
       if not assigned(def.typesym) then
       if not assigned(def.typesym) then
         internalerror(2015041901);
         internalerror(2015041901);
-      result:='%"typ.'+def.fullownerhierarchyname+def.typesym.realname+'"'
+      result:='%"typ.'+def.fullownerhierarchyname(false)+def.typesym.realname+'"'
     end;
     end;
 
 
 
 

+ 3 - 3
compiler/pgenutil.pas

@@ -360,13 +360,13 @@ uses
                           begin
                           begin
                             { special handling for specializations inside generic function declarations }
                             { special handling for specializations inside generic function declarations }
                             namepart:=tdef(symtablestack.top.defowner).unique_id_str;
                             namepart:=tdef(symtablestack.top.defowner).unique_id_str;
-                            namepart:='genproc'+namepart+'_'+tdef(symtablestack.top.defowner).fullownerhierarchyname+'_'+tprocdef(symtablestack.top.defowner).procsym.realname+'_'+typeparam.resultdef.typename;
-                            prettynamepart:=tdef(symtablestack.top.defowner).fullownerhierarchyname+tprocdef(symtablestack.top.defowner).procsym.prettyname;
+                            namepart:='genproc'+namepart+'_'+tdef(symtablestack.top.defowner).fullownerhierarchyname(false)+'_'+tprocdef(symtablestack.top.defowner).procsym.realname+'_'+typeparam.resultdef.typename;
+                            prettynamepart:=tdef(symtablestack.top.defowner).fullownerhierarchyname(false)+tprocdef(symtablestack.top.defowner).procsym.prettyname;
                           end
                           end
                         else
                         else
                           begin
                           begin
                             namepart:=typeparam.resultdef.fulltypename;
                             namepart:=typeparam.resultdef.fulltypename;
-                            prettynamepart:=typeparam.resultdef.fullownerhierarchyname;
+                            prettynamepart:=typeparam.resultdef.fullownerhierarchyname(false);
                           end;
                           end;
                         specializename:=specializename+'$'+namepart;
                         specializename:=specializename+'$'+namepart;
                         if not first then
                         if not first then

+ 15 - 7
compiler/symdef.pas

@@ -114,7 +114,7 @@ interface
           function  needs_inittable : boolean;override;
           function  needs_inittable : boolean;override;
           function  rtti_mangledname(rt:trttitype):TSymStr;override;
           function  rtti_mangledname(rt:trttitype):TSymStr;override;
           function  OwnerHierarchyName: string; override;
           function  OwnerHierarchyName: string; override;
-          function  fullownerhierarchyname:TSymStr;override;
+          function  fullownerhierarchyname(skipprocparams:boolean):TSymStr;override;
           function  needs_separate_initrtti:boolean;override;
           function  needs_separate_initrtti:boolean;override;
           function  in_currentunit: boolean;
           function  in_currentunit: boolean;
           { regvars }
           { regvars }
@@ -1892,16 +1892,17 @@ implementation
         until tmp=nil;
         until tmp=nil;
       end;
       end;
 
 
-    function tstoreddef.fullownerhierarchyname: TSymStr;
+    function tstoreddef.fullownerhierarchyname(skipprocparams:boolean): TSymStr;
       var
       var
         lastowner: tsymtable;
         lastowner: tsymtable;
         tmp: tdef;
         tmp: tdef;
+        pno: tprocnameoptions;
       begin
       begin
 {$ifdef symansistr}
 {$ifdef symansistr}
-        if _fullownerhierarchyname<>'' then
+        if not skipprocparams and (_fullownerhierarchyname<>'') then
           exit(_fullownerhierarchyname);
           exit(_fullownerhierarchyname);
 {$else symansistr}
 {$else symansistr}
-        if assigned(_fullownerhierarchyname) then
+        if not skipprocparams and assigned(_fullownerhierarchyname) then
           exit(_fullownerhierarchyname^);
           exit(_fullownerhierarchyname^);
 {$endif symansistr}
 {$endif symansistr}
         { the def can only reside inside structured types or
         { the def can only reside inside structured types or
@@ -1921,16 +1922,23 @@ implementation
             result:=tabstractrecorddef(tmp).objrealname^+'.'+result
             result:=tabstractrecorddef(tmp).objrealname^+'.'+result
           else
           else
             if tmp.typ=procdef then
             if tmp.typ=procdef then
-              result:=tprocdef(tmp).customprocname([pno_paranames,pno_proctypeoption])+'.'+result;
+              begin
+                pno:=[pno_paranames,pno_proctypeoption];
+                if skipprocparams then
+                  include(pno,pno_noparams);
+                result:=tprocdef(tmp).customprocname(pno)+'.'+result;
+              end;
         until tmp=nil;
         until tmp=nil;
         { add the unit name }
         { add the unit name }
         if assigned(lastowner) and
         if assigned(lastowner) and
            assigned(lastowner.realname) then
            assigned(lastowner.realname) then
           result:=lastowner.realname^+'.'+result;
           result:=lastowner.realname^+'.'+result;
+        if not skipprocparams then
+          { don't store the name in this case }
 {$ifdef symansistr}
 {$ifdef symansistr}
-        _fullownerhierarchyname:=result;
+          _fullownerhierarchyname:=result;
 {$else symansistr}
 {$else symansistr}
-        _fullownerhierarchyname:=stringdup(result);
+          _fullownerhierarchyname:=stringdup(result);
 {$endif symansistr}
 {$endif symansistr}
       end;
       end;
 
 

+ 2 - 2
compiler/symtype.pas

@@ -75,7 +75,7 @@ interface
          function  getmangledparaname:TSymStr;virtual;
          function  getmangledparaname:TSymStr;virtual;
          function  rtti_mangledname(rt:trttitype):TSymStr;virtual;abstract;
          function  rtti_mangledname(rt:trttitype):TSymStr;virtual;abstract;
          function  OwnerHierarchyName: string; virtual; abstract;
          function  OwnerHierarchyName: string; virtual; abstract;
-         function  fullownerhierarchyname:TSymStr;virtual;abstract;
+         function  fullownerhierarchyname(skipprocparams:boolean):TSymStr;virtual;abstract;
          function  unique_id_str: string;
          function  unique_id_str: string;
          function  size:asizeint;virtual;abstract;
          function  size:asizeint;virtual;abstract;
          function  packedbitsize:asizeint;virtual;
          function  packedbitsize:asizeint;virtual;
@@ -296,7 +296,7 @@ implementation
 
 
     function tdef.fulltypename:string;
     function tdef.fulltypename:string;
       begin
       begin
-        result:=fullownerhierarchyname;
+        result:=fullownerhierarchyname(false);
         if assigned(typesym) and
         if assigned(typesym) and
            not(typ in [procvardef,procdef]) and
            not(typ in [procvardef,procdef]) and
            (typesym.realname[1]<>'$') then
            (typesym.realname[1]<>'$') then