* allow specifying an external name for fields in external Java classes/

    interfaces using "var f: field; external name 'xxx';" (necessary for
    solving identifier clashes in imported classes)

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

compiler/jvmdef.pas

@@ -61,6 +61,7 @@ interface
     { returns the mangled base name for a tsym (type + symbol name, no
       visibility etc) }
     function jvmmangledbasename(sym: tsym): string;
+    function jvmmangledbasename(sym: tsym; const usesymname: string): string;
 
 implementation
 
@@ -326,7 +327,7 @@ implementation
       end;
 
 
-    function jvmmangledbasename(sym: tsym): string;
+    function jvmmangledbasename(sym: tsym; const usesymname: string): string;
       var
         vsym: tabstractvarsym;
         csym: tconstsym;
@@ -347,13 +348,13 @@ implementation
                       ([vo_is_funcret,vo_is_result] * tabstractnormalvarsym(vsym).varoptions <> []) then
                 result:='result '+result
               else
-                result:=vsym.realname+' '+result;
+                result:=usesymname+' '+result;
             end;
           constsym:
             begin
               csym:=tconstsym(sym);
               result:=jvmencodetype(csym.constdef);
-              result:=csym.realname+' '+result;
+              result:=usesymname+' '+result;
             end;
           else
             internalerror(2011021703);
@@ -361,6 +362,15 @@ implementation
       end;
 
 
+    function jvmmangledbasename(sym: tsym): string;
+      begin
+        if (sym.typ=fieldvarsym) and
+           assigned(tfieldvarsym(sym).externalname) then
+          result:=jvmmangledbasename(sym,tfieldvarsym(sym).externalname^)
+        else
+          result:=jvmmangledbasename(sym,sym.RealName);
+      end;
+
 {******************************************************************
                     jvm type validity checking
 *******************************************************************}

compiler/pdecvar.pas

@@ -1085,6 +1085,32 @@ implementation
       end;
 
 
+    procedure try_read_field_external(vs: tabstractvarsym);
+      var
+        extname: string;
+      begin
+        if try_to_consume(_EXTERNAL) then
+          begin
+            consume(_NAME);
+            extname:=get_stringconst;
+            tfieldvarsym(vs).set_externalname(extname);
+            consume(_SEMICOLON);
+          end;
+      end;
+
+
+    procedure try_read_field_external_sc(sc:TFPObjectList);
+    var
+      vs: tabstractvarsym;
+    begin
+      { only allowed for one var }
+      vs:=tabstractvarsym(sc[0]);
+      if sc.count>1 then
+        Message1(parser_e_directive_only_one_var,arraytokeninfo[idtoken].str);
+      try_read_field_external(vs);
+    end;
+
+
     procedure read_var_decls(options:Tvar_dec_options);
 
         procedure read_default_value(sc : TFPObjectList);
@@ -1652,7 +1678,6 @@ implementation
                 (hdef.typesym=nil) then
                handle_calling_convention(tprocvardef(hdef));
 
-             { check if it is a class field }
              if (vd_object in options) then
                begin
                  { if it is not a class var section and token=STATIC then it is a class field too }
@@ -1661,6 +1686,11 @@ implementation
                      consume(_SEMICOLON);
                      include(options, vd_class);
                    end;
+                 { Fields in Java classes/interfaces can have a separately
+                   specified external name }
+                 if is_java_class_or_interface(tdef(recst.defowner)) and
+                    (oo_is_external in tobjectdef(recst.defowner).objectoptions) then
+                   try_read_field_external_sc(sc);
                end;
              if vd_class in options then
                begin
@@ -1690,6 +1720,10 @@ implementation
                        inserting the new one }
                      fieldvs.Rename(internal_static_field_name(fieldvs.name));
                      recst.insert(hstaticvs);
+                     { has to be delayed until now, because the calculated
+                       mangled name depends on the owner }
+                     if (vo_has_mangledname in fieldvs.varoptions) then
+                       hstaticvs.set_mangledname(fieldvs.externalname^);
 {$endif not jvm}
                      if vd_final in options then
                        hstaticvs.varspez:=vs_final;

compiler/symsym.pas

@@ -156,10 +156,12 @@ interface
 
       tfieldvarsym = class(tabstractvarsym)
           fieldoffset   : asizeint;   { offset in record/object }
+          externalname  : pshortstring;
           cachedmangledname: pshortstring; { mangled name for ObjC or Java }
           constructor create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
           constructor ppuload(ppufile:tcompilerppufile);
           procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure set_externalname(const s:string);
           function mangledname:string;override;
           destructor destroy;override;
       end;
@@ -1201,6 +1203,10 @@ implementation
       begin
          inherited ppuload(fieldvarsym,ppufile);
          fieldoffset:=ppufile.getaint;
+         if (vo_has_mangledname in varoptions) then
+           externalname:=stringdup(ppufile.getstring)
+         else
+           externalname:=nil;
       end;
 
 
@@ -1208,10 +1214,30 @@ implementation
       begin
          inherited ppuwrite(ppufile);
          ppufile.putaint(fieldoffset);
+         if (vo_has_mangledname in varoptions) then
+           ppufile.putstring(externalname^);
          ppufile.writeentry(ibfieldvarsym);
       end;
 
 
+    procedure tfieldvarsym.set_externalname(const s: string);
+      var
+        tmp: string;
+      begin
+        { make sure it is recalculated }
+        stringdispose(cachedmangledname);
+{$ifdef jvm}
+        if is_java_class_or_interface(tdef(owner.defowner)) then
+          begin
+            externalname:=stringdup(s);
+            include(varoptions,vo_has_mangledname);
+          end
+        else
+{$endif jvm}
+          internalerror(2011031201);
+      end;
+
+
     function tfieldvarsym.mangledname:string;
       var
         srsym : tsym;
@@ -1402,10 +1428,16 @@ implementation
 
 
     procedure tstaticvarsym.set_mangledname(const s:string);
+{$ifdef jvm}
+      var
+        tmpname: string;
+{$endif}
       begin
         stringdispose(_mangledname);
 {$if defined(jvm)}
-        internalerror(2011011202);
+        tmpname:=jvmmangledbasename(self,s);
+        jvmaddtypeownerprefix(owner,tmpname);
+        _mangledname:=stringdup(tmpname);
 {$elseif defined(compress)}
         _mangledname:=stringdup(minilzw_encode(s));
 {$else}