浏览代码

* let procdef typename-related routines return ansistrings instead of
shortstrings to prevent cut-offs
+ ReplaceCase() ansistring overload in cutils to support the above
* always use the fully qualified name in case of nested types inside
the parameter lists of procdefs
* put extra information about array parameters between {} so they
can be passed back into the parser

git-svn-id: branches/jvmbackend@18431 -

Jonas Maebe 14 年之前
父节点
当前提交
c05bc8a931
共有 2 个文件被更改,包括 33 次插入11 次删除
  1. 21 0
      compiler/cutils.pas
  2. 12 11
      compiler/symdef.pas

+ 21 - 0
compiler/cutils.pas

@@ -59,6 +59,7 @@ interface
     procedure Replace(var s:string;s1:string;const s2:string);
     procedure Replace(var s:AnsiString;s1:string;const s2:AnsiString);
     procedure ReplaceCase(var s:string;const s1,s2:string);
+    procedure ReplaceCase(var s:ansistring;const s1,s2:ansistring);
     Function MatchPattern(const pattern,what:string):boolean;
     function upper(const c : char) : char;
     function upper(const s : string) : string;
@@ -395,6 +396,26 @@ implementation
       end;
 
 
+    procedure ReplaceCase(var s: ansistring; const s1, s2: ansistring);
+      var
+         last,
+         i  : longint;
+      begin
+        last:=0;
+        repeat
+          i:=pos(s1,s);
+          if i=last then
+           i:=0;
+          if (i>0) then
+           begin
+             Delete(s,i,length(s1));
+             Insert(s2,s,i);
+             last:=i;
+           end;
+        until (i=0);
+      end;
+
+
     Function MatchPattern(const pattern,what:string):boolean;
       var
         found : boolean;

+ 12 - 11
compiler/symdef.pas

@@ -444,7 +444,7 @@ interface
           procedure buildderef;override;
           procedure deref;override;
           procedure calcparas;
-          function  typename_paras(pno: tprocnameoptions): string;
+          function  typename_paras(pno: tprocnameoptions): ansistring;
           function  is_methodpointer:boolean;virtual;
           function  is_addressonly:boolean;virtual;
           function  no_self_node:boolean;
@@ -580,7 +580,7 @@ interface
           function  mangledname : string;
           procedure setmangledname(const s : string);
           function  fullprocname(showhidden:boolean):string;
-          function  customprocname(pno: tprocnameoptions):string;
+          function  customprocname(pno: tprocnameoptions):ansistring;
           function  defaultmangledname: string;
           function  cplusplusmangledname : string;
           function  objcmangledname : string;
@@ -2792,17 +2792,17 @@ implementation
              if (ado_isvariant in arrayoptions) or ((highrange=-1) and (lowrange=0)) then
                GetTypeName:='Array Of Const'
              else
-               GetTypeName:='Array Of Const/Constant Open Array of '+elementdef.typename;
+               GetTypeName:='{Array Of Const/Constant Open} Array of '+elementdef.typename;
            end
          else if (ado_IsDynamicArray in arrayoptions) then
-           GetTypeName:='Dynamic Array Of '+elementdef.typename
+           GetTypeName:='{Dynamic} Array Of '+elementdef.typename
          else if ((highrange=-1) and (lowrange=0)) then
-           GetTypeName:='Open Array Of '+elementdef.typename
+           GetTypeName:='{Open} Array Of '+elementdef.typename
          else
            begin
               result := '';
               if (ado_IsBitPacked in arrayoptions) then
-                result:='Packed ';
+                result:='BitPacked ';
               if rangedef.typ=enumdef then
                 result:=result+'Array['+rangedef.typename+'] Of '+elementdef.typename
               else
@@ -3316,9 +3316,9 @@ implementation
       end;
 
 
-    function tabstractprocdef.typename_paras(pno: tprocnameoptions) : string;
+    function tabstractprocdef.typename_paras(pno: tprocnameoptions) : ansistring;
       var
-        hs,s  : string;
+        hs,s  : ansistring;
         hp    : TParavarsym;
         hpc   : tconstsym;
         first : boolean;
@@ -3359,7 +3359,7 @@ implementation
                  begin
                    hs:=hp.vardef.typesym.realname;
                    if hs[1]<>'$' then
-                     s:=s+hs
+                     s:=s+hp.vardef.OwnerHierarchyName+hs
                    else
                      s:=s+hp.vardef.GetTypeName;
                  end
@@ -3793,9 +3793,9 @@ implementation
       end;
 
 
-    function tprocdef.customprocname(pno: tprocnameoptions):string;
+    function tprocdef.customprocname(pno: tprocnameoptions):ansistring;
       var
-        s : string;
+        s : ansistring;
         t : ttoken;
       begin
 {$ifdef EXTDEBUG}
@@ -5595,6 +5595,7 @@ implementation
           result:=import_lib^+'/'+result;
       end;
 
+
 {****************************************************************************
                              TImplementedInterface
 ****************************************************************************}