* check all overloaded routines for mangled name conflicts on the JVM

    platform, as different Pascal declarations are mapped to the same
    JVM representation

git-svn-id: trunk@27520 -

.gitattributes

@@ -10889,6 +10889,8 @@ tests/test/jvm/tnestdynarr.pp svneol=native#text/plain
 tests/test/jvm/tnestedset.pp svneol=native#text/plain
 tests/test/jvm/tnestproc.pp svneol=native#text/plain
 tests/test/jvm/topovl.pp svneol=native#text/plain
+tests/test/jvm/toverload.pp svneol=native#text/plain
+tests/test/jvm/toverload2.pp svneol=native#text/plain
 tests/test/jvm/tprop.pp svneol=native#text/plain
 tests/test/jvm/tprop2.pp svneol=native#text/plain
 tests/test/jvm/tprop3.pp svneol=native#text/plain

compiler/jvm/symcpu.pas

@@ -149,6 +149,7 @@ type
   tcpunamespacesymclass = class of tcpunamespacesym;
 
   tcpuprocsym = class(tprocsym)
+    procedure check_forward; override;
   end;
   tcpuprocsymclass = class of tcpuprocsym;
 
@@ -204,11 +205,15 @@ const
 implementation
 
   uses
-    verbose,cutils,
+    verbose,cutils,cclasses,
     symconst,symbase,jvmdef,
     paramgr;
 
 
+{****************************************************************************
+                             tcpuenumdef
+****************************************************************************}
+
   procedure tcpuenumdef.ppuload_platform(ppufile: tcompilerppufile);
     begin
       inherited;
@@ -405,6 +410,42 @@ implementation
       tcpuprocvardef(result).classdef:=classdef;
     end;
 
+
+{****************************************************************************
+                             tcpuprocsym
+****************************************************************************}
+
+  procedure tcpuprocsym.check_forward;
+    var
+      curri, checki: longint;
+      currpd, checkpd: tprocdef;
+    begin
+      inherited;
+      { check for conflicts based on mangled name, because several FPC
+        types/constructs map to the same JVM mangled name }
+      for curri:=0 to FProcdefList.Count-2 do
+        begin
+          currpd:=tprocdef(FProcdefList[curri]);
+          if (po_external in currpd.procoptions) or
+             (currpd.proccalloption=pocall_internproc) then
+            continue;
+          for checki:=curri+1 to FProcdefList.Count-1 do
+            begin
+              checkpd:=tprocdef(FProcdefList[checki]);
+              if po_external in checkpd.procoptions then
+                continue;
+              if currpd.mangledname=checkpd.mangledname then
+                begin
+                  MessagePos(checkpd.fileinfo,parser_e_overloaded_have_same_mangled_name);
+                  MessagePos1(currpd.fileinfo,sym_h_param_list,currpd.customprocname([pno_mangledname]));
+                  MessagePos1(checkpd.fileinfo,sym_h_param_list,checkpd.customprocname([pno_mangledname]));
+                end;
+            end;
+        end;
+      inherited;
+    end;
+
+
 {****************************************************************************
                              tcpustaticvarsym
 ****************************************************************************}

compiler/msg/errore.msg

@@ -400,7 +400,7 @@ scan_e_unsupported_switch=02095_E_Directive $1 is not supported on this target
 #
 # Parser
 #
-# 03335 is the last used one
+# 03336 is the last used one
 #
 % \section{Parser messages}
 % This section lists all parser messages. The parser takes care of the
@@ -1503,6 +1503,11 @@ parser_e_no_assembler_in_generic=03334_E_Assembler blocks not allowed inside gen
 parser_e_property_only_sgr=03335_E_Properties can be only static, global or inside structured types
 % Properties cannot be declared local, only global, using the static
 % directive or inside structured types.
+parser_e_overloaded_have_same_mangled_name=03336_E_Overloaded routines have the same mangled name
+% Some platforms, such as the JVM platform, encode the parameters in the routine name in
+% a prescribed way, and this encoding may map different Pascal types to the same encoded
+% (a.k.a.\ ``mangled'') name. This error can only be solved by removing or changing the
+% conflicting definitions' parameter declarations or routine names.
 %
 %
 % \end{description}

compiler/msgidx.inc

@@ -434,6 +434,7 @@ const
   parser_e_dir_not_allowed=03333;
   parser_e_no_assembler_in_generic=03334;
   parser_e_property_only_sgr=03335;
+  parser_e_overloaded_have_same_mangled_name=03336;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -983,9 +984,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 71077;
+  MsgTxtSize = 71132;
 
   MsgIdxMax : array[1..20] of longint=(
-    26,96,336,121,88,56,126,27,202,64,
+    26,96,337,121,88,56,126,27,202,64,
     57,20,1,1,1,1,1,1,1,1
   );

compiler/symdef.pas

@@ -529,7 +529,8 @@ interface
        { tabstractprocdef }
 
        tprocnameoption = (pno_showhidden, pno_proctypeoption, pno_paranames,
-         pno_ownername, pno_noclassmarker, pno_noleadingdollar);
+         pno_ownername, pno_noclassmarker, pno_noleadingdollar,
+         pno_mangledname);
        tprocnameoptions = set of tprocnameoption;
        tproccopytyp = (pc_normal,
                        { always creates a top-level function, removes all
@@ -5037,6 +5038,8 @@ implementation
         if (po_staticmethod in procoptions) and
            not (proctypeoption in [potype_class_constructor,potype_class_destructor]) then
           s:=s+' Static;';
+        if pno_mangledname in pno then
+          s:=s+' -- mangled name: '+mangledname;
         customprocname:=s;
       end;
 

compiler/symsym.pas

@@ -120,7 +120,7 @@ interface
           procedure write_parameter_lists(skipdef:tprocdef);
           { tests, if all procedures definitions are defined and not }
           { only forward                                             }
-          procedure check_forward;
+          procedure check_forward; virtual;
           { do not override this routine in platform-specific subclasses,
             override ppuwrite_platform instead }
           procedure ppuwrite(ppufile:tcompilerppufile);override;final;

tests/test/jvm/testall.bat

@@ -284,3 +284,9 @@ ppcjvm -O2 -g -B  -CTinitlocals tsmallintarr
 if %errorlevel% neq 0 exit /b %errorlevel%
 java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tsmallintarr
 if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g -vh toverload
+if %errorlevel% eq 0 exit /b 1
+echo " ** Compilation failed as expected"
+ppcjvm -O2 -g -B  toverload2
+if %errorlevel% eq 0 exit /b 1
+echo " ** Compilation failed as expected"

tests/test/jvm/testall.sh

@@ -158,3 +158,17 @@ $PPC -O2 -g -B -Sa -CTinitlocals tinitvar
 java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/$RTLDIR:. org.freepascal.test.tinitvar.tinitvar
 $PPC -O2 -g -B -Sa tsmallintarr
 java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/$RTLDIR:. tsmallintarr
+set +e
+$PPC -O2 -g -B -Sa toverload
+if [ $? -eq 0 ]; then
+  echo " ** Should have failed compilation"
+else
+  echo " ** Compilation failed as expected"
+fi
+$PPC -O2 -g -B -Sa toverload2
+if [ $? -eq 0 ]; then
+  echo " ** Should have failed compilation"
+else
+  echo " ** Compilation failed as expected"
+fi
+set -e

tests/test/jvm/toverload.pp

@@ -0,0 +1,12 @@
+{ %fail }
+
+procedure test(var b: byte);
+begin
+end;
+
+procedure test(const b: array of byte);
+begin
+end;
+
+begin
+end.

tests/test/jvm/toverload2.pp

@@ -0,0 +1,19 @@
+{ %fail }
+
+{$mode objfpc}
+type
+  tc = class
+    procedure test(var b: byte);
+    procedure test(const b: array of byte);
+  end;
+
+procedure tc.test(var b: byte);
+begin
+end;
+
+procedure tc.test(const b: array of byte);
+begin
+end;
+
+begin
+end.