+ Java interface support, mostly the same as Objective-C protocols

    (generalised some error messages that were specific to protocols
     so they can also be used for Java interfaces)
  o note, Java interface support requires a fix to Jasmin 2.4:
    http://sourceforge.net/tracker/?func=detail&aid=2897170&group_id=100746&atid=628212

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

compiler/agjasmin.pas

@@ -388,7 +388,10 @@ implementation
 
     procedure TJasminAssembler.WriteExtraHeader(obj: tobjectdef);
       var
+        superclass,
+        intf: tobjectdef;
         n: string;
+        i: longint;
       begin
         { JVM 1.5+ }
         AsmWriteLn('.bytecode 49.0');
@@ -399,6 +402,8 @@ implementation
         else
           n:=InputFileName;
         AsmWriteLn('.source '+ExtractFileName(n));
+
+        { class/interface name }
         if not assigned(obj) then
           begin
             { fake class type for unit -> name=unitname and
@@ -408,13 +413,41 @@ implementation
           end
         else
           begin
-            AsmWriteLn('.class '+obj.objextname^);
-            if assigned(obj.childof) then
+            case obj.objecttype of
+              odt_javaclass:
+                begin
+                  AsmWriteLn('.class '+obj.objextname^);
+                  superclass:=obj.childof;
+                end;
+              odt_interfacejava:
+                begin
+                  AsmWriteLn('.interface abstract '+obj.objextname^);
+                  { interfaces must always specify Java.lang.object as
+                    superclass }
+                  superclass:=java_jlobject;
+                end
+              else
+                internalerror(2011010906);
+            end;
+            { superclass }
+            if assigned(superclass) then
               begin
                 AsmWrite('.super ');
-                if assigned(obj.childof.import_lib) then
-                  AsmWrite(obj.childof.import_lib^+'/');
-                AsmWriteln(obj.childof.objextname^);
+                if assigned(superclass.import_lib) then
+                  AsmWrite(superclass.import_lib^+'/');
+                AsmWriteln(superclass.objextname^);
+              end;
+            { implemented interfaces }
+            if assigned(obj.ImplementedInterfaces) then
+              begin
+                for i:=0 to obj.ImplementedInterfaces.count-1 do
+                  begin
+                    intf:=TImplementedInterface(obj.ImplementedInterfaces[i]).IntfDef;
+                    AsmWrite('.implements ');
+                    if assigned(intf.import_lib) then
+                      AsmWrite(intf.import_lib^+'/');
+                    AsmWriteln(intf.objextname^);
+                  end;
               end;
           end;
         AsmLn;
@@ -492,6 +525,17 @@ implementation
 
     procedure TJasminAssembler.WriteProcDef(pd: tprocdef);
       begin
+        { abstract method? }
+        if is_javainterface(tdef(pd.owner.defowner)) or
+           (po_abstractmethod in pd.procoptions) then
+          begin
+            AsmWrite('.method ');
+            AsmWriteln(pd.mangledname(true));
+            AsmWriteln('.end method');
+            AsmLn;
+            exit;
+          end;
+
         WriteTree(pd.exprasmlist);
       end;
 

compiler/msg/errore.msg

@@ -1254,16 +1254,16 @@ parser_e_no_objc_published=03271_E_Objective-C classes cannot have published sec
 parser_f_need_objc=03272_F_This module requires an Objective-C mode switch to be compiled
 % This error indicates the use of Objective-C language features without an Objective-C mode switch
 % active. Enable one via the -M command line switch, or the {\$modeswitch x} directive.
-parser_e_must_use_override_objc=03273_E_Inherited methods can only be overridden in Objective-C, add "override" (inherited method defined in $1)
-parser_h_should_use_override_objc=03274_H_Inherited methods can only be overridden in Objective-C, add "override" (inherited method defined in $1).
-% It is not possible to \var{reintroduce} methods in Objective-C like in Object Pascal. Methods with the same
+parser_e_must_use_override=03273_E_Inherited methods can only be overridden in Objective-C and Java, add "override" (inherited method defined in $1)
+parser_h_should_use_override=03274_H_Inherited methods can only be overridden in Objective-C and Java, add "override" (inherited method defined in $1).
+% It is not possible to \var{reintroduce} methods in Objective-C or Java like in Object Pascal. Methods with the same
 % name always map to the same virtual method entry. In order to make this clear in the source code,
 % the compiler always requires the \var{override} directive to be specified when implementing overriding
-% Objective-C methods in Pascal. If the implementation is external, this rule is relaxed because Objective-C
-% does not have any \var{override}-style keyword (since it's the default and only behaviour in that language),
+% Objective-C or Java methods in Pascal. If the implementation is external, this rule is relaxed because Objective-C and Java
+% do not have any \var{override}-style keyword (since it's the default and only behaviour in these languages),
 % which makes it hard for automated header conversion tools to include it everywhere.
 % The type in which the inherited method is defined is explicitly mentioned, because this may either
-% be an objcclass or an objccategory.
+% be an objcclass or an objccategory in case of Objective-C.
 parser_e_objc_message_name_changed=03275_E_Message name "$1" in inherited class is different from message name "$2" in current 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
@@ -1350,9 +1350,9 @@ parser_f_no_generic_inside_generic=03297_F_Declaration of generic class inside a
 % (guarded by internal error 200511173 in tscannerfile.startrecordtokens).
 % Since generics are implemented by recording tokens, it is not possible to
 % have declaration of generic class inside another generic class.
-parser_e_forward_protocol_declaration_must_be_resolved=03298_E_Forward declaration of objcprotocol "$1" must be resolved before an objcclass can conform to it
-% An objcprotocol must be fully defined before classes can conform to it.
-% This error occurs in the following situation:
+parser_e_forward_intf_declaration_must_be_resolved=03298_E_Forward declaration "$1" must be resolved before a class can conform to or implement it
+% An Objective-C protocol or Java Interface must be fully defined before classes can conform to it.
+% This error occurs in the following situation (example for Objective-C, but the same goes for Java interfaces):
 % \begin{verbatim}
 %  Type MyProtocol = objcprotoocl;
 %       ChildClass = Class(NSObject,MyProtocol)

compiler/msgidx.inc

@@ -364,8 +364,8 @@ const
   parser_h_no_objc_parent=03270;
   parser_e_no_objc_published=03271;
   parser_f_need_objc=03272;
-  parser_e_must_use_override_objc=03273;
-  parser_h_should_use_override_objc=03274;
+  parser_e_must_use_override=03273;
+  parser_h_should_use_override=03274;
   parser_e_objc_message_name_changed=03275;
   parser_e_unique_unsupported=03276;
   parser_e_no_category_as_types=03277;
@@ -389,7 +389,7 @@ const
   parser_e_objc_missing_enumeration_defs=03295;
   parser_e_no_procvarnested_const=03296;
   parser_f_no_generic_inside_generic=03297;
-  parser_e_forward_protocol_declaration_must_be_resolved=03298;
+  parser_e_forward_intf_declaration_must_be_resolved=03298;
   parser_e_no_record_published=03299;
   parser_e_no_destructor_in_records=03300;
   parser_e_class_methods_only_static_in_records=03301;
@@ -900,7 +900,7 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 60995;
+  MsgTxtSize = 61005;
 
   MsgIdxMax : array[1..20] of longint=(
     26,89,314,103,85,54,111,23,202,63,

compiler/nobj.pas

@@ -281,11 +281,13 @@ implementation
               not(po_virtualmethod in pd.procoptions) or
               (
                { new one does not have reintroduce in case of an objccategory }
-               (is_objccategory(_class) and not(po_reintroduce in pd.procoptions)) or
-               { new one does not have override in case of objpas/objc class/helper/intf/proto }
-               (
-                (is_class_or_interface_or_objc(_class) or is_objectpascal_helper(_class)) and
-                not is_objccategory(_class) and not(po_overridingmethod in pd.procoptions)
+               (is_objccategory(_class) and
+                 not(po_reintroduce in pd.procoptions)) or
+               { new one does not have override in case of objpas/objc/java class/intf/proto }
+               ((is_class_or_interface_or_objc(_class) or is_objectpascal_helper(_class)) and
+                not is_objccategory(_class) and
+                not is_java_class_or_interface(_class) and
+                not(po_overridingmethod in pd.procoptions)
                )
               )
              ) then
@@ -296,7 +298,8 @@ implementation
                  ) then
                 begin
                   if not(po_reintroduce in pd.procoptions) then
-                    if not(is_objc_class_or_protocol(_class)) then
+                    if not(is_objc_class_or_protocol(_class)) and
+                       not(is_java_class_or_interface(_class)) then
                       MessagePos1(pd.fileinfo,parser_w_should_use_override,pd.fullprocname(false))
                     else
                       begin
@@ -308,10 +311,12 @@ implementation
 
                           In case of external classes, we only give a hint,
                           because requiring override everywhere may make
-                          automated header translation tools too complex.  }
+                          automated header translation tools too complex.
+
+                          The same goes for Java. }
                         if not(oo_is_external in _class.objectoptions) then
                           if not is_objccategory(_class) then
-                            MessagePos1(pd.fileinfo,parser_e_must_use_override_objc,FullTypeName(tdef(vmtpd.owner.defowner),nil))
+                            MessagePos1(pd.fileinfo,parser_e_must_use_override,FullTypeName(tdef(vmtpd.owner.defowner),nil))
                           else
                             MessagePos1(pd.fileinfo,parser_e_must_use_reintroduce_objc,FullTypeName(tdef(vmtpd.owner.defowner),nil))
                         { there may be a lot of these in auto-translated
@@ -319,7 +324,7 @@ implementation
                           the hint will be shown  }
                         else if CheckVerbosity(V_Hint) then
                           if not is_objccategory(_class) then
-                            MessagePos1(pd.fileinfo,parser_h_should_use_override_objc,FullTypeName(tdef(vmtpd.owner.defowner),nil))
+                            MessagePos1(pd.fileinfo,parser_h_should_use_override,FullTypeName(tdef(vmtpd.owner.defowner),nil))
                           else
                             MessagePos1(pd.fileinfo,parser_h_should_use_reintroduce_objc,FullTypeName(tdef(vmtpd.owner.defowner),nil));
                         { no new entry, but copy the message name if any from
@@ -397,11 +402,12 @@ implementation
                      if not(po_reintroduce in pd.procoptions) then
                        begin
                          if not is_object(_class) and
-                            not is_objc_class_or_protocol(_class) then
+                            not is_objc_class_or_protocol(_class) and
+                            not is_java_class_or_interface(_class) then
                            MessagePos1(pd.fileinfo,parser_w_should_use_override,pd.fullprocname(false))
                          else
                            { objects don't allow starting a new virtual tree
-                             and neither does Objective-C }
+                             and neither do Objective-C or Java }
                            MessagePos1(pd.fileinfo,parser_e_header_dont_match_forward,vmtpd.fullprocname(false));
                        end;
                      { disable/hide old VMT entry }
@@ -771,7 +777,8 @@ implementation
           end;
         build_interface_mappings;
         if assigned(_class.ImplementedInterfaces) and
-           not(is_objc_class_or_protocol(_class)) then
+           not(is_objc_class_or_protocol(_class)) and
+           not(is_java_class_or_interface(_class)) then
           begin
             { Optimize interface tables to reuse wrappers }
             intf_optimize_vtbls;
@@ -788,9 +795,11 @@ implementation
         ImplIntf : TImplementedInterface;
         i: longint;
       begin
-        { Find Procdefs implementing the interfaces }
+        { Find Procdefs implementing the interfaces (both Objective-C protocols
+          and Java interfaces can have multiple parent interfaces, but in that
+          case obviously no implementations are required) }
         if assigned(_class.ImplementedInterfaces) and
-           (_class.objecttype<>odt_objcprotocol) then
+           not(_class.objecttype in [odt_objcprotocol,odt_interfacejava]) then
           begin
             { Collect implementor functions into the tImplementedInterface.procdefs }
             case _class.objecttype of
@@ -802,11 +811,13 @@ implementation
                       intf_get_procdefs_recursive(ImplIntf,ImplIntf.IntfDef)
                     end;
                 end;
-              odt_objcclass:
+              odt_objcclass,
+              odt_javaclass:
                 begin
                   { Object Pascal interfaces are afterwards optimized via the
                     intf_optimize_vtbls() method, but we can't do this for
-                    protocols -> check for duplicates here already. }
+                    protocols/Java interfaces -> check for duplicates here
+                    already. }
                   handledprotocols:=tfpobjectlist.create(false);
                   for i:=0 to _class.ImplementedInterfaces.count-1 do
                     begin

compiler/pdecobj.pas

@@ -280,17 +280,31 @@ implementation
       end;
 
 
-    procedure handleImplementedProtocol(intfdef : tobjectdef);
+    procedure handleImplementedProtocolOrJavaIntf(intfdef : tobjectdef);
       begin
         intfdef:=find_real_class_definition(intfdef,false);
-        if not is_objcprotocol(intfdef) then
-          begin
-             Message1(type_e_protocol_type_expected,intfdef.typename);
-             exit;
-          end;
+        case current_objectdef.objecttype of
+          odt_objcclass,
+          odt_objccategory,
+          odt_objcprotocol:
+            if not is_objcprotocol(intfdef) then
+              begin
+                 Message1(type_e_protocol_type_expected,intfdef.typename);
+                 exit;
+              end;
+          odt_javaclass,
+          odt_interfacejava:
+            if not is_javainterface(intfdef) then
+              begin
+                Message1(type_e_interface_type_expected,intfdef.typename);
+                exit
+              end;
+          else
+            internalerror(2011010807);
+        end;
         if ([oo_is_forward,oo_is_formal] * intfdef.objectoptions <> []) then
           begin
-             Message1(parser_e_forward_protocol_declaration_must_be_resolved,intfdef.objrealname^);
+             Message1(parser_e_forward_intf_declaration_must_be_resolved,intfdef.objrealname^);
              exit;
           end;
         if current_objectdef.find_implemented_interface(intfdef)<>nil then
@@ -321,7 +335,7 @@ implementation
              if intf then
                handleImplementedInterface(tobjectdef(hdef))
              else
-               handleImplementedProtocol(tobjectdef(hdef));
+               handleImplementedProtocolOrJavaIntf(tobjectdef(hdef));
           end;
       end;
 
@@ -425,7 +439,8 @@ implementation
                 Message(parser_e_abstract_and_sealed_conflict);
             end;
           odt_cppclass,
-          odt_javaclass:
+          odt_javaclass,
+          odt_interfacejava:
             get_cpp_or_java_class_external_status(current_objectdef);
           odt_objcclass,odt_objcprotocol,odt_objccategory:
             get_objc_class_or_protocol_external_status(current_objectdef);
@@ -598,7 +613,7 @@ implementation
                   if current_objectdef.objecttype=odt_class then
                     handleImplementedInterface(intfchildof)
                   else
-                    handleImplementedProtocol(intfchildof);
+                    handleImplementedProtocolOrJavaIntf(intfchildof);
                 readImplementedInterfacesAndProtocols(current_objectdef.objecttype=odt_class);
               end;
             consume(_RKLAMMER);

compiler/symdef.pas

@@ -4213,7 +4213,6 @@ implementation
         { see tprocdef.jvmmangledname for description of the format }
         if fordefinition then
           begin
-            { definition: visibility/static }
             case visibility of
               vis_hidden,
               vis_strictprivate:
@@ -4230,6 +4229,8 @@ implementation
             if (procsym.owner.symtabletype in [globalsymtable,staticsymtable,localsymtable]) or
                (po_staticmethod in procoptions) then
               tmpresult:=tmpresult+'static ';
+            if is_javainterface(tdef(owner.defowner)) then
+              tmpresult:=tmpresult+'abstract ';
           end
         else
           begin
@@ -4528,7 +4529,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,odt_interfacejava] then
+        if objecttype in [odt_class,odt_objcclass,odt_objcprotocol,odt_javaclass,odt_interfacejava] then
           ImplementedInterfaces:=TFPObjectList.Create(true)
         else
           ImplementedInterfaces:=nil;
@@ -5068,8 +5069,12 @@ implementation
    function tobjectdef.is_related(d : tdef) : boolean;
      var
         hp : tobjectdef;
+        realself: tobjectdef;
      begin
-        if self=d then
+        if (d.typ=objectdef) then
+          d:=find_real_class_definition(tobjectdef(d),false);
+        realself:=find_real_class_definition(self,false);
+        if realself=d then
           begin
             is_related:=true;
             exit;
@@ -5085,7 +5090,7 @@ implementation
            inheritance }
         if (objecttype in [odt_objcprotocol,odt_interfacejava]) then
           begin
-            is_related:=is_related_interface_multiple(self,d);
+            is_related:=is_related_interface_multiple(realself,d);
             exit
           end;
 
@@ -5112,7 +5117,7 @@ implementation
             exit;
           end;
 
-        hp:=childof;
+        hp:=realself.childof;
         while assigned(hp) do
           begin
              if hp=d then