* various small support fixes for Java classes:

   o support formal external definitions (like for objcclass)
   o allow specifying an "import_dll" for external Java classes, which can
     be used to specify the Java package name (like the dll for cppclass)
   o take the package name into account when mangling the Java class name
   o several messages that were specific to Objective-Pascal classes have
     been generalised because they also apply to Java classes, same for
     several compiler function names
   o disabled some proccall directives for Java, but more needs to happen
     (Java methods are always either instance-virtual or class-static)

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

compiler/defcmp.pas

@@ -1266,8 +1266,8 @@ implementation
              begin
                { Objective-C classes (handle anonymous externals) }
                if (def_from.typ=objectdef) and
-                  (find_real_objcclass_definition(tobjectdef(def_from),false) =
-                   find_real_objcclass_definition(tobjectdef(def_to),false)) then
+                  (find_real_class_definition(tobjectdef(def_from),false) =
+                   find_real_class_definition(tobjectdef(def_to),false)) then
                  begin
                    doconv:=tc_equal;
                    { exact, not equal, because can change between interface

compiler/jvmdef.pas

@@ -181,7 +181,12 @@ implementation
             case tobjectdef(def).objecttype of
               odt_javaclass,
               odt_interfacejava:
-                encodedstr:=encodedstr+'L'+tobjectdef(def).objextname^+';';
+                begin
+                  encodedstr:=encodedstr+'L';
+                  if assigned(tobjectdef(def).import_lib) then
+                    encodedstr:=encodedstr+tobjectdef(def).import_lib^+'/';
+                  encodedstr:=encodedstr+tobjectdef(def).objextname^+';';
+                end
               else
                 result:=false;
             end;

compiler/msg/errore.msg

@@ -1268,9 +1268,9 @@ parser_e_objc_message_name_changed=03275_E_Message name "$1" in inherited class
 % An overriding Objective-C method cannot have a different message name than an inherited method. The reason
 % is that these message names uniquely define the message to the Objective-C runtime, which means that
 % giving them a different message name breaks the ``override'' semantics.
-parser_e_no_objc_unique=03276_E_It is not yet possible to make unique copies of Objective-C types
-% Duplicating an Objective-C type using \var{type x = type y;} is not yet supported. You may be able to
-% obtain the desired effect using \var{type x = objcclass(y) end;} instead.
+parser_e_unique_unsupported=03276_E_It is not yet possible to make unique copies of Objective-C or Java types
+% Duplicating an Objective-C or Java type using \var{type x = type y;} is not yet supported. You may be able to
+% obtain the desired effect using \var{type x = objcclass(y) end;} resp.{} \var{type x = class(y) end;} instead.
 parser_e_no_category_as_types=03277_E_Objective-C categories and Object Pascal class helpers cannot be used as types
 % It is not possible to declare a variable as an instance of an Objective-C
 % category or an Object Pascal class helper. A category/class helper adds
@@ -1997,8 +1997,8 @@ sym_w_experimental_unit=05079_W_Unit "$1" is experimental
 % declared as \var{experimental} is used. Experimental units
 % might disappear or change semantics in future versions. Usage of this unit
 % should be avoided as much as possible.
-sym_e_objc_formal_class_not_resolved=05080_E_No complete definition of the formally declared objcclass "$1" is in scope
-% Objecive-C classes can be imported formally, without using the the unit in which it is fully declared.
+sym_e_formal_class_not_resolved=05080_E_No complete definition of the formally declared class "$1" is in scope
+% Objecive-C and Java classes can be imported formally, without using the the unit in which it is fully declared.
 % This enables making forward references to such classes and breaking circular dependencies amongst units.
 % However, as soon as you wish to actually do something with an entity of this class type (such as
 % access one of its fields, send a message to it, or use it to inherit from), the compiler requires the full definition

compiler/msgidx.inc

@@ -367,7 +367,7 @@ const
   parser_e_must_use_override_objc=03273;
   parser_h_should_use_override_objc=03274;
   parser_e_objc_message_name_changed=03275;
-  parser_e_no_objc_unique=03276;
+  parser_e_unique_unsupported=03276;
   parser_e_no_category_as_types=03277;
   parser_e_no_category_override=03278;
   parser_e_must_use_reintroduce_objc=03279;
@@ -564,7 +564,7 @@ const
   sym_w_library_unit=05077;
   sym_w_non_implemented_unit=05078;
   sym_w_experimental_unit=05079;
-  sym_e_objc_formal_class_not_resolved=05080;
+  sym_e_formal_class_not_resolved=05080;
   sym_e_interprocgoto_into_init_final_code_not_allowed=05081;
   sym_e_external_class_name_mismatch1=05082;
   sym_e_external_class_name_mismatch2=05083;
@@ -900,7 +900,7 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 60991;
+  MsgTxtSize = 60995;
 
   MsgIdxMax : array[1..20] of longint=(
     26,89,314,103,85,54,111,23,202,63,

compiler/pdecl.pas

@@ -383,7 +383,7 @@ implementation
 
     procedure types_dec(in_structure: boolean);
 
-      procedure finalize_objc_class_or_protocol_external_status(od: tobjectdef);
+      procedure finalize_class_external_status(od: tobjectdef);
         begin
           if  [oo_is_external,oo_is_forward] <= od.objectoptions then
             begin
@@ -537,8 +537,9 @@ implementation
                     istyperenaming:=true;
                   if isunique then
                     begin
-                      if is_objc_class_or_protocol(hdef) then
-                        Message(parser_e_no_objc_unique);
+                      if is_objc_class_or_protocol(hdef) or
+                         is_java_class_or_interface(hdef) then
+                        Message(parser_e_unique_unsupported);
 
                       hdef:=tstoreddef(hdef).getcopy;
 
@@ -606,11 +607,12 @@ implementation
                     try_consume_hintdirective(newtype.symoptions,newtype.deprecatedmsg);
                     consume(_SEMICOLON);
 
-                    { change a forward and external objcclass declaration into
+                    { change a forward and external class declaration into
                       formal external definition, so the compiler does not
                       expect an real definition later }
-                    if is_objc_class_or_protocol(hdef) then
-                      finalize_objc_class_or_protocol_external_status(tobjectdef(hdef));
+                    if is_objc_class_or_protocol(hdef) or
+                       is_java_class_or_interface(hdef) then
+                      finalize_class_external_status(tobjectdef(hdef));
 
                     { Build VMT indexes, skip for type renaming and forward classes }
                     if (hdef.typesym=newtype) and

compiler/pdecobj.pas

@@ -280,7 +280,7 @@ implementation
 
     procedure handleImplementedProtocol(intfdef : tobjectdef);
       begin
-        intfdef:=find_real_objcclass_definition(intfdef,false);
+        intfdef:=find_real_class_definition(intfdef,false);
         if not is_objcprotocol(intfdef) then
           begin
              Message1(type_e_protocol_type_expected,intfdef.typename);
@@ -345,7 +345,7 @@ implementation
         p.free;
       end;
 
-    procedure get_cpp_class_external_status(od: tobjectdef);
+    procedure get_cpp_or_java_class_external_status(od: tobjectdef);
       var
         hs: string;
       begin
@@ -363,6 +363,9 @@ implementation
                   hs:=ChangeFileExt(hs,target_info.sharedlibext);
                 if Copy(hs,1,length(target_info.sharedlibprefix))<>target_info.sharedlibprefix then
                   hs:=target_info.sharedlibprefix+hs;
+                { the JVM expects java/lang/Object rather than java.lang.Object }
+                if target_info.system=system_jvm_java32 then
+                  Replace(hs,'.','/');
                 od.import_lib:=stringdup(hs);
               end;
             include(od.objectoptions, oo_is_external);
@@ -419,8 +422,9 @@ implementation
               if [oo_is_abstract, oo_is_sealed] * current_structdef.objectoptions = [oo_is_abstract, oo_is_sealed] then
                 Message(parser_e_abstract_and_sealed_conflict);
             end;
-          odt_cppclass:
-            get_cpp_class_external_status(current_objectdef);
+          odt_cppclass,
+          odt_javaclass:
+            get_cpp_or_java_class_external_status(current_objectdef);
           odt_objcclass,odt_objcprotocol,odt_objccategory:
             get_objc_class_or_protocol_external_status(current_objectdef);
           odt_helper: ; // nothing
@@ -460,10 +464,14 @@ implementation
                 { a mix of class, interfaces, objects and cppclasses
                   isn't allowed }
                 case current_objectdef.objecttype of
-                   odt_class:
-                     if not(is_class(childof)) then
+                   odt_class,
+                   odt_javaclass:
+                     if (childof.objecttype<>current_objectdef.objecttype) then
                        begin
-                          if is_interface(childof) then
+                          if (is_interface(childof) and
+                              is_class(current_objectdef)) or
+                             (is_javainterface(childof) and
+                              is_javaclass(current_objectdef)) then
                             begin
                                { we insert the interface after the child
                                  is set, see below
@@ -476,7 +484,9 @@ implementation
                        end
                      else
                        if oo_is_sealed in childof.objectoptions then
-                         Message1(parser_e_sealed_descendant,childof.typename);
+                         Message1(parser_e_sealed_descendant,childof.typename)
+                       else
+                         childof:=find_real_class_definition(childof,true);
                    odt_interfacecorba,
                    odt_interfacecom:
                      begin
@@ -507,7 +517,7 @@ implementation
                            Message(parser_e_mix_of_classes_and_objects);
                        end
                      else
-                       childof:=find_real_objcclass_definition(childof,true);
+                       childof:=find_real_class_definition(childof,true);
                    odt_objcprotocol:
                      begin
                        if not(is_objcprotocol(childof)) then
@@ -515,6 +525,13 @@ implementation
                        intfchildof:=childof;
                        childof:=nil;
                      end;
+                   odt_interfacejava:
+                     begin
+                       if not(is_javainterface(childof)) then
+                         Message(parser_e_mix_of_classes_and_objects);
+                       intfchildof:=find_real_class_definition(childof,true);
+                       childof:=nil;
+                     end;
                    odt_object:
                      if not(is_object(childof)) then
                        Message(parser_e_mix_of_classes_and_objects)
@@ -548,6 +565,9 @@ implementation
                 childof:=interface_idispatch;
               odt_objcclass:
                 CGMessage(parser_h_no_objc_parent);
+              odt_javaclass:
+                if current_objectdef<>java_jlobject then
+                  childof:=java_jlobject;
             end;
           end;
 
@@ -562,7 +582,7 @@ implementation
             else if not(oo_is_formal in childof.objectoptions) then
               current_objectdef.set_parent(childof)
             else
-              Message1(sym_e_objc_formal_class_not_resolved,childof.objrealname^);
+              Message1(sym_e_formal_class_not_resolved,childof.objrealname^);
           end;
 
         { remove forward flag, is resolved }
@@ -570,7 +590,7 @@ implementation
 
         if hasparentdefined then
           begin
-            if current_objectdef.objecttype in [odt_class,odt_objcclass,odt_objcprotocol] then
+            if current_objectdef.objecttype in [odt_class,odt_objcclass,odt_objcprotocol,odt_javaclass,odt_interfacejava] then
               begin
                 if assigned(intfchildof) then
                   if current_objectdef.objecttype=odt_class then
@@ -664,6 +684,15 @@ implementation
         end;
 
 
+      procedure chkjava(pd: tprocdef);
+        begin
+          if is_java_class_or_interface(pd.struct) then
+            begin
+              include(pd.procoptions,po_java);
+            end;
+        end;
+
+
         procedure chkcpp(pd:tprocdef);
           begin
             { nothing currently }
@@ -696,7 +725,7 @@ implementation
         vdoptions: tvar_dec_options;
       begin
         { empty class declaration ? }
-        if (current_objectdef.objecttype in [odt_class,odt_objcclass]) and
+        if (current_objectdef.objecttype in [odt_class,odt_objcclass,odt_javaclass]) and
            (token=_SEMICOLON) then
           exit;
 
@@ -749,7 +778,8 @@ implementation
                   _PRIVATE :
                     begin
                       if is_interface(current_structdef) or
-                         is_objc_protocol_or_category(current_structdef) then
+                         is_objc_protocol_or_category(current_structdef) or
+                         is_javainterface(current_structdef) then
                         Message(parser_e_no_access_specifier_in_interfaces);
                        consume(_PRIVATE);
                        current_structdef.symtable.currentvisibility:=vis_private;
@@ -762,7 +792,8 @@ implementation
                    _PROTECTED :
                      begin
                        if is_interface(current_structdef) or
-                          is_objc_protocol_or_category(current_structdef) then
+                          is_objc_protocol_or_category(current_structdef) or
+                          is_javainterface(current_structdef) then
                          Message(parser_e_no_access_specifier_in_interfaces);
                        consume(_PROTECTED);
                        current_structdef.symtable.currentvisibility:=vis_protected;
@@ -775,7 +806,8 @@ implementation
                    _PUBLIC :
                      begin
                        if is_interface(current_structdef) or
-                          is_objc_protocol_or_category(current_structdef) then
+                          is_objc_protocol_or_category(current_structdef) or
+                          is_javainterface(current_structdef) then
                          Message(parser_e_no_access_specifier_in_interfaces);
                        consume(_PUBLIC);
                        current_structdef.symtable.currentvisibility:=vis_public;
@@ -791,9 +823,10 @@ implementation
                        { this is the way, delphi does it                  }
                        if is_interface(current_structdef) then
                          Message(parser_e_no_access_specifier_in_interfaces);
-                       { Objective-C classes do not support "published",
+                       { Objective-C and Java classes do not support "published",
                          as basically everything is published.  }
-                       if is_objc_class_or_protocol(current_structdef) then
+                       if is_objc_class_or_protocol(current_structdef) or
+                          is_java_class_or_interface(current_structdef) then
                          Message(parser_e_no_objc_published);
                        consume(_PUBLISHED);
                        current_structdef.symtable.currentvisibility:=vis_published;
@@ -805,9 +838,10 @@ implementation
                    _STRICT :
                      begin
                        if is_interface(current_structdef) or
-                          is_objc_protocol_or_category(current_structdef) then
-                          Message(parser_e_no_access_specifier_in_interfaces);
-                        consume(_STRICT);
+                          is_objc_protocol_or_category(current_structdef) or
+                          is_javainterface(current_structdef) then
+                         Message(parser_e_no_access_specifier_in_interfaces);
+                         consume(_STRICT);
                         if token=_ID then
                           begin
                             case idtoken of
@@ -840,7 +874,8 @@ implementation
                           begin
                             if is_interface(current_structdef) or
                                is_objc_protocol_or_category(current_structdef) or
-                               is_objectpascal_helper(current_structdef) then
+                               is_objectpascal_helper(current_structdef) or
+                               is_javainterface(current_structdef) then
                               Message(parser_e_no_vars_in_interfaces);
 
                             if (current_structdef.symtable.currentvisibility=vis_published) and
@@ -937,6 +972,7 @@ implementation
 
                     chkcpp(pd);
                     chkobjc(pd);
+                    chkjava(pd);
                   end;
 
                 maybe_parse_hint_directives(pd);
@@ -1124,6 +1160,9 @@ implementation
                   odt_class :
                     if (current_structdef.objname^='TOBJECT') then
                       class_tobject:=current_objectdef;
+                  odt_javaclass:
+                    if (current_objectdef.objname^='TOBJECT') then
+                      java_jlobject:=current_objectdef;
                 end;
               end;
             if (current_module.modulename^='OBJCBASE') then
@@ -1149,11 +1188,11 @@ implementation
            (current_objectdef.objecttype in [odt_interfacecom,odt_class,odt_helper]) then
           include(current_structdef.objectoptions,oo_can_have_published);
 
-        { Objective-C objectdefs can be "formal definitions", in which case
+        { Objective-C/Java objectdefs can be "formal definitions", in which case
           the syntax is "type tc = objcclass external;" -> we have to parse
           its object options (external) already here, to make sure that such
           definitions are recognised as formal defs }
-        if objecttype in [odt_objcclass,odt_objcprotocol,odt_objccategory] then
+        if objecttype in [odt_objcclass,odt_objcprotocol,odt_objccategory,odt_javaclass,odt_interfacejava] then
           parse_object_options;
 
         { forward def? }
@@ -1178,7 +1217,7 @@ implementation
               include(current_objectdef.objectoptions,oo_is_classhelper);
 
             { parse list of options (abstract / sealed) }
-            if not(objecttype in [odt_objcclass,odt_objcprotocol,odt_objccategory]) then
+            if not(objecttype in [odt_objcclass,odt_objcprotocol,odt_objccategory,odt_javaclass,odt_interfacejava]) then
               parse_object_options;
 
             symtablestack.push(current_structdef.symtable);
@@ -1221,11 +1260,13 @@ implementation
         if (oo_has_vmt in current_structdef.objectoptions) and
            not(oo_is_forward in current_structdef.objectoptions) and
            not(oo_has_constructor in current_structdef.objectoptions) and
-           not is_objc_class_or_protocol(current_structdef) then
+           not is_objc_class_or_protocol(current_structdef) and
+           not is_java_class_or_interface(current_structdef) then
           Message1(parser_w_virtual_without_constructor,current_structdef.objrealname^);
 
         if is_interface(current_structdef) or
-           is_objcprotocol(current_structdef) then
+           is_objcprotocol(current_structdef) or
+           is_javainterface(current_structdef) then
           setinterfacemethodoptions
         else if is_objcclass(current_structdef) then
           setobjcclassmethodoptions;

compiler/pdecsub.pas

@@ -44,7 +44,9 @@ interface
         pd_cppobject,    { directive can be used with cppclass }
         pd_objcclass,    { directive can be used with objcclass }
         pd_objcprot,     { directive can be used with objcprotocol }
-        pd_nothelper     { directive can not be used with record/class helper declaration }
+        pd_nothelper,    { directive can not be used with record/class helper declaration }
+        pd_javaclass,    { directive can be used with Java class }
+        pd_intfjava      { directive can be used with Java interface }
       );
       tpdflags=set of tpdflag;
 
@@ -295,7 +297,9 @@ implementation
 
                 { Generate VMT variable for constructor/destructor }
                 if (pd.proctypeoption in [potype_constructor,potype_destructor]) and
-                   not(is_cppclass(tprocdef(pd).struct) or is_record(tprocdef(pd).struct)) then
+                   not(is_cppclass(tprocdef(pd).struct) or
+                       is_record(tprocdef(pd).struct) or
+                       is_javaclass(tprocdef(pd).struct)) then
                  begin
                    { can't use classrefdef as type because inheriting
                      will then always file because of a type mismatch }
@@ -2073,6 +2077,9 @@ begin
             hs:=ChangeFileExt(hs,target_info.sharedlibext);
           if Copy(hs,1,length(target_info.sharedlibprefix))<>target_info.sharedlibprefix then
             hs:=target_info.sharedlibprefix+hs;
+          { the JVM expects java/lang/Object rather than java.lang.Object }
+          if target_info.system=system_jvm_java32 then
+            Replace(hs,'.','/');
           import_dll:=stringdup(hs);
           include(procoptions,po_has_importdll);
           if (idtoken=_NAME) then
@@ -2379,7 +2386,7 @@ const
       mutexclpo     : []
     ),(
       idtok:_OVERRIDE;
-      pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_objcclass,pd_notrecord];
+      pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_objcclass,pd_javaclass,pd_notrecord];
       handler  : @pd_override;
       pocall   : pocall_none;
       pooption : [po_overridingmethod,po_virtualmethod];
@@ -2444,7 +2451,7 @@ const
       mutexclpo     : []
     ),(
       idtok:_STATIC;
-      pd_flags : [pd_interface,pd_implemen,pd_body,pd_object,pd_record,pd_notobjintf];
+      pd_flags : [pd_interface,pd_implemen,pd_body,pd_object,pd_record,pd_javaclass,pd_notobjintf];
       handler  : @pd_static;
       pocall   : pocall_none;
       pooption : [po_staticmethod];
@@ -2680,6 +2687,15 @@ const
            { check if method and directive not for record/class helper }
            if is_objectpascal_helper(tprocdef(pd).struct) and
              (pd_nothelper in proc_direcdata[p].pd_flags) then
+
+           { check if method and directive not for java class }
+           if is_javaclass(tprocdef(pd).struct) and
+             not(pd_javaclass in proc_direcdata[p].pd_flags) then
+            exit;
+
+           { check if method and directive not for java interface }
+           if is_javainterface(tprocdef(pd).struct) and
+             not(pd_intfjava in proc_direcdata[p].pd_flags) then
             exit;
 
          end;

compiler/pexpr.pas

@@ -367,6 +367,7 @@ implementation
               { Allow classrefdef, which is required for
                 Typeof(self) in static class methods }
               if not(is_objc_class_or_protocol(p1.resultdef)) and
+                 not(is_java_class_or_interface(p1.resultdef)) and
                  ((p1.resultdef.typ = objectdef) or
                   (assigned(current_procinfo) and
                    ((po_classmethod in current_procinfo.procdef.procoptions) or

compiler/symconst.pas

@@ -314,7 +314,9 @@ type
       (when calling a regular procedure using the above convention, it will
        simply not see the frame pointer parameter, and since the caller cleans
        up the stack will also remain balanced) }
-    po_delphi_nested_cc
+    po_delphi_nested_cc,
+    { Java method }
+    po_java
   );
   tprocoptions=set of tprocoption;
 

compiler/symdef.pas

@@ -760,6 +760,10 @@ interface
        objc_fastenumeration      : tobjectdef;
        objc_fastenumerationstate : trecorddef;
 
+       { Java base types }
+       { java.lang.Object }
+       java_jlobject             : tobjectdef;
+
     const
 {$ifdef i386}
        pbestrealtype : ^tdef = @s80floattype;
@@ -830,6 +834,10 @@ interface
     function is_class_or_object(def: tdef): boolean;
     function is_record(def: tdef): boolean;
 
+    function is_javaclass(def: tdef): boolean;
+    function is_javainterface(def: tdef): boolean;
+    function is_java_class_or_interface(def: tdef): boolean;
+
     procedure loadobjctypes;
     procedure maybeloadcocoatypes;
 
@@ -4516,7 +4524,7 @@ implementation
         if objecttype in [odt_interfacecorba,odt_interfacecom,odt_dispinterface] then
           prepareguid;
         { setup implemented interfaces }
-        if objecttype in [odt_class,odt_objcclass,odt_objcprotocol] then
+        if objecttype in [odt_class,odt_objcclass,odt_objcprotocol,odt_interfacejava] then
           ImplementedInterfaces:=TFPObjectList.Create(true)
         else
           ImplementedInterfaces:=nil;
@@ -4575,7 +4583,7 @@ implementation
            end;
 
          { load implemented interfaces }
-         if objecttype in [odt_class,odt_objcclass,odt_objcprotocol] then
+         if objecttype in [odt_class,odt_objcclass,odt_objcprotocol,odt_interfacejava] then
            begin
              ImplementedInterfaces:=TFPObjectList.Create(true);
              implintfcount:=ppufile.getlongint;
@@ -4613,6 +4621,10 @@ implementation
             (objecttype=odt_objcclass) and
             (objname^='PROTOCOL') then
            objc_protocoltype:=self;
+         if (childof=nil) and
+            (objecttype=odt_javaclass) and
+            (objname^='TOBJECT') then
+           java_jlobject:=self;
          writing_class_record_dbginfo:=false;
        end;
 
@@ -4955,7 +4967,7 @@ implementation
         { inherit options and status }
         objectoptions:=objectoptions+(c.objectoptions*inherited_objectoptions);
         { add the data of the anchestor class/object }
-        if (objecttype in [odt_class,odt_object,odt_objcclass]) then
+        if (objecttype in [odt_class,odt_object,odt_objcclass,odt_javaclass]) then
           begin
             tObjectSymtable(symtable).datasize:=tObjectSymtable(symtable).datasize+tObjectSymtable(c.symtable).datasize;
             { inherit recordalignment }
@@ -4986,7 +4998,7 @@ implementation
      var
        vs: tfieldvarsym;
      begin
-        if objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol] then
+        if objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol,odt_javaclass,odt_interfacejava] then
           exit;
         if (oo_has_vmt in objectoptions) then
           internalerror(12345)
@@ -5017,7 +5029,7 @@ implementation
 
    procedure tobjectdef.check_forwards;
      begin
-        if not(objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcprotocol]) then
+        if not(objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcprotocol,odt_interfacejava]) then
           inherited;
         if (oo_is_forward in objectoptions) then
           begin
@@ -5029,7 +5041,7 @@ implementation
 
 
    { true if prot implements d (or if they are equal) }
-   function is_related_protocol(prot: tobjectdef; d : tdef) : boolean;
+   function is_related_interface_multiple(prot: tobjectdef; d : tdef) : boolean;
      var
        i  : longint;
      begin
@@ -5041,7 +5053,7 @@ implementation
 
        for i:=0 to prot.ImplementedInterfaces.count-1 do
          begin
-           result:=is_related_protocol(TImplementedInterface(prot.ImplementedInterfaces[i]).intfdef,d);
+           result:=is_related_interface_multiple(TImplementedInterface(prot.ImplementedInterfaces[i]).intfdef,d);
            if result then
              exit;
          end;
@@ -5065,22 +5077,34 @@ implementation
             exit;
           end;
 
-        { Objective-C protocols can use multiple inheritance }
-        if (objecttype=odt_objcprotocol) then
+        { Objective-C protocols and Java interfaces can use multiple
+           inheritance }
+        if (objecttype in [odt_objcprotocol,odt_interfacejava]) then
           begin
-            is_related:=is_related_protocol(self,d);
+            is_related:=is_related_interface_multiple(self,d);
             exit
           end;
 
-        { formally declared Objective-C classes match Objective-C classes with
-          the same name }
-        if (objecttype=odt_objcclass) and
-           (tobjectdef(d).objecttype=odt_objcclass) and
+        { formally declared Objective-C and Java classes match Objective-C/Java
+          classes with the same name. In case of Java, the package must also
+          match}
+        if (objecttype in [odt_objcclass,odt_javaclass]) and
+           (tobjectdef(d).objecttype=objecttype) and
            ((oo_is_formal in objectoptions) or
             (oo_is_formal in tobjectdef(d).objectoptions)) and
            (objrealname^=tobjectdef(d).objrealname^) then
           begin
-            is_related:=true;
+            { check package name for Java }
+            if objecttype=odt_objcclass then
+              is_related:=true
+            else
+              begin
+                is_related:=
+                  assigned(import_lib)=assigned(tobjectdef(d).import_lib);
+                if is_related and
+                   assigned(import_lib) then
+                  is_related:=import_lib^=tobjectdef(d).import_lib^;
+              end;
             exit;
           end;
 
@@ -5120,7 +5144,7 @@ implementation
 
     function tobjectdef.size : asizeint;
       begin
-        if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol,odt_helper] then
+        if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol,odt_helper,odt_javaclass,odt_interfacejava] then
           result:=sizeof(pint)
         else
           result:=tObjectSymtable(symtable).datasize;
@@ -5129,7 +5153,7 @@ implementation
 
     function tobjectdef.alignment:shortint;
       begin
-        if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol,odt_helper] then
+        if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol,odt_helper,odt_javaclass,odt_interfacejava] then
           alignment:=sizeof(pint)
         else
           alignment:=tObjectSymtable(symtable).recordalignment;
@@ -5149,6 +5173,10 @@ implementation
           vmtmethodoffset:=0;
         odt_interfacecom,odt_interfacecorba,odt_dispinterface:
           vmtmethodoffset:=index*sizeof(pint);
+        odt_javaclass,
+        odt_interfacejava:
+          { invalid }
+          vmtmethodoffset:=-1;
         else
 {$ifdef WITHDMT}
           vmtmethodoffset:=(index+4)*sizeof(pint);
@@ -5182,7 +5210,9 @@ implementation
               needs_inittable:=tObjectSymtable(symtable).needs_init_final;
             odt_cppclass,
             odt_objcclass,
-            odt_objcprotocol:
+            odt_objcprotocol,
+            odt_javaclass,
+            odt_interfacejava:
               needs_inittable:=false;
             else
               internalerror(200108267);
@@ -5953,7 +5983,7 @@ implementation
         result:=
           assigned(def) and
           (def.typ=objectdef) and
-          (tobjectdef(def).objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol,odt_helper]);
+          (tobjectdef(def).objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol,odt_helper,odt_javaclass,odt_interfacejava]);
       end;
 
     function is_class_or_object(def: tdef): boolean;
@@ -5971,6 +6001,30 @@ implementation
           (def.typ=recorddef);
       end;
 
+    function is_javaclass(def: tdef): boolean;
+      begin
+        result:=
+          assigned(def) and
+          (def.typ=objectdef) and
+          (tobjectdef(def).objecttype=odt_javaclass);
+      end;
+
+    function is_javainterface(def: tdef): boolean;
+      begin
+        result:=
+          assigned(def) and
+          (def.typ=objectdef) and
+          (tobjectdef(def).objecttype=odt_interfacejava);
+      end;
+
+    function is_java_class_or_interface(def: tdef): boolean;
+      begin
+        result:=
+          assigned(def) and
+          (def.typ=objectdef) and
+          (tobjectdef(def).objecttype in [odt_javaclass,odt_interfacejava]);
+      end;
+
     procedure loadobjctypes;
       begin
         objc_metaclasstype:=tpointerdef(search_named_unit_globaltype('OBJC','POBJC_CLASS',true).typedef);

compiler/symtable.pas

@@ -252,7 +252,7 @@ interface
 
 {*** Object Helpers ***}
     function search_default_property(pd : tabstractrecorddef) : tpropertysym;
-    function find_real_objcclass_definition(pd: tobjectdef; erroronfailure: boolean): tobjectdef;
+    function find_real_class_definition(pd: tobjectdef; erroronfailure: boolean): tobjectdef;
 
 {*** Macro Helpers ***}
     {If called initially, the following procedures manipulate macros in }
@@ -2128,12 +2128,16 @@ implementation
       end;
 
 
-    function find_real_objcclass_definition(pd: tobjectdef; erroronfailure: boolean): tobjectdef;
+    function find_real_class_definition(pd: tobjectdef; erroronfailure: boolean): tobjectdef;
       var
         hashedid   : THashedIDString;
         stackitem  : psymtablestackitem;
         srsymtable : tsymtable;
         srsym      : tsym;
+        formalname,
+        foundname : shortstring;
+        formalnameptr,
+        foundnameptr: pshortstring;
       begin
         { not a formal definition -> return it }
         if not(oo_is_formal in pd.objectoptions) then
@@ -2147,20 +2151,45 @@ implementation
           begin
             srsymtable:=stackitem^.symtable;
             { ObjC classes can't appear in generics or as nested class
-              definitions }
-            if not(srsymtable.symtabletype in [recordsymtable,ObjectSymtable,parasymtable]) then
+              definitions. Java classes can. }
+            if not(srsymtable.symtabletype in [recordsymtable,parasymtable]) or
+               (is_java_class_or_interface(pd) and
+                (srsymtable.symtabletype=ObjectSymtable)) then
               begin
                 srsym:=tsym(srsymtable.FindWithHash(hashedid));
                 if assigned(srsym) and
                    (srsym.typ=typesym) and
-                   is_objcclass(ttypesym(srsym).typedef) and
+                   (ttypesym(srsym).typedef.typ=objectdef) and
+                   (tobjectdef(ttypesym(srsym).typedef).objecttype=pd.objecttype) and
                    not(oo_is_formal in tobjectdef(ttypesym(srsym).typedef).objectoptions) then
                   begin
                     { the external name for the formal and the real definition must match }
-                    if tobjectdef(ttypesym(srsym).typedef).objextname^<>pd.objextname^ then
+                    if assigned(tobjectdef(ttypesym(srsym).typedef).import_lib) or
+                       assigned(pd.import_lib) then
                       begin
-                        Message2(sym_e_external_class_name_mismatch1,pd.objextname^,pd.typename);
-                        MessagePos1(srsym.fileinfo,sym_e_external_class_name_mismatch2,tobjectdef(ttypesym(srsym).typedef).objextname^);
+                        if assigned(pd.import_lib) then
+                          formalname:=pd.import_lib^
+                        else
+                          formalname:='';
+                        formalname:=formalname+'.'+pd.objextname^;
+                        if assigned(tobjectdef(ttypesym(srsym).typedef).import_lib) then
+                          foundname:=tobjectdef(ttypesym(srsym).typedef).import_lib^+'.'
+                        else
+                          foundname:='';
+                        foundname:=foundname+tobjectdef(ttypesym(srsym).typedef).objextname^;
+
+                        formalnameptr:=@formalname;
+                        foundnameptr:=@foundname;
+                      end
+                    else
+                      begin
+                        formalnameptr:=pd.objextname;
+                        foundnameptr:=tobjectdef(ttypesym(srsym).typedef).objextname;
+                      end;
+                    if foundnameptr^<>formalnameptr^ then
+                      begin
+                        Message2(sym_e_external_class_name_mismatch1,formalnameptr^,pd.typename);
+                        MessagePos1(srsym.fileinfo,sym_e_external_class_name_mismatch2,foundnameptr^);
                       end;
                     result:=tobjectdef(ttypesym(srsym).typedef);
                     if assigned(current_procinfo) and
@@ -2175,7 +2204,7 @@ implementation
         { nothing found: optionally give an error and return the original
           (empty) one }
         if erroronfailure then
-          Message1(sym_e_objc_formal_class_not_resolved,pd.objrealname^);
+          Message1(sym_e_formal_class_not_resolved,pd.objrealname^);
         result:=pd;
       end;
 
@@ -2187,11 +2216,11 @@ implementation
         i        : longint;
       begin
         orgclass:=classh;
-        { in case this is a formal objcclass, first find the real definition }
+        { in case this is a formal class, first find the real definition }
         if assigned(classh) then
           begin
             if (oo_is_formal in classh.objectoptions) then
-              classh:=find_real_objcclass_definition(classh,true);
+              classh:=find_real_class_definition(classh,true);
             { The contextclassh is used for visibility. The classh must be equal to
               or be a parent of contextclassh. E.g. for inherited searches the classh is the
               parent or a class helper. }
@@ -2203,9 +2232,10 @@ implementation
           end;
         result:=false;
         hashedid.id:=s;
-        { an Objective-C protocol can inherit from multiple other protocols
-          -> uses ImplementedInterfaces instead }
-        if is_objcprotocol(classh) then
+        { an Objective-C  protocol or Java interface can inherit from multiple
+          other protocols/interfaces -> use ImplementedInterfaces instead }
+        if is_objcprotocol(classh) or
+           is_javainterface(classh) then
           begin
             srsymtable:=classh.symtable;
             srsym:=tsym(srsymtable.FindWithHash(hashedid));
@@ -2303,10 +2333,10 @@ implementation
         def : tdef;
         i   : longint;
       begin
-        { in case this is a formal objcclass, first find the real definition }
+        { in case this is a formal class, first find the real definition }
         if assigned(classh) and
            (oo_is_formal in classh.objectoptions) then
-          classh:=find_real_objcclass_definition(classh,true);
+          classh:=find_real_class_definition(classh,true);
         result:=false;
         def:=nil;
         while assigned(classh) do
@@ -2341,10 +2371,10 @@ implementation
         def : tdef;
         i   : longint;
       begin
-        { in case this is a formal objcclass, first find the real definition }
+        { in case this is a formal class, first find the real definition }
         if assigned(classh) and
            (oo_is_formal in classh.objectoptions) then
-          classh:=find_real_objcclass_definition(classh,true);
+          classh:=find_real_class_definition(classh,true);
         result:=false;
         def:=nil;
         while assigned(classh) do
@@ -2798,9 +2828,9 @@ implementation
         orgpd      : tabstractrecorddef;
         srsymtable : tsymtable;
       begin
-        { in case this is a formal objcclass, first find the real definition }
+        { in case this is a formal class, first find the real definition }
         if (oo_is_formal in pd.objectoptions) then
-          pd:=find_real_objcclass_definition(tobjectdef(pd),true);
+          pd:=find_real_class_definition(tobjectdef(pd),true);
         if search_objectpascal_helper(pd, pd, s, result, srsymtable) then
           exit;
         hashedid.id:=s;