--WARNING: start build process with FPC 2.2.4; won't work when

     starting with a previous 2.3.1 or compiler built from the objc branch
  + added basic objcprotocol support (only for external protocols
    currently)
     o use in type declaration: "type xp = objcprotocol ... end;"
     o when defining a root class that implements it:
       "type yc = objcclass(xp) ... end" (note: no support yet
       for something like "objcclass(id,xp)" or so)
     o when defining a non-root class that implements a protocol:
       "type zc = objcclass(nsobject,xp) ... end"
     o includes support for "required" and "optional" sections
     o no support yet for the objcprotocol(<protocol>) expression
       that enables getting a class instance representing the
       protocol (e.g., for use with "conformsToProtocol:")
     o message names have to specified in protocol declarations,
       but if an objcclass implements a protocol, the message names do
       not have to be repeated (but if they are, they have to match;
       the same goes when overriding inherited methods)
  + allow specifying the external name of Objective-C classes and
    protocols, since classes and protocols can have the same name
    (and you cannot use the same Pascal identifier in such caseq)
  + added NSObject protocol, and make the NSObject class use it
  + added missing NSObject class methods that have the same name
    as instance methods (added "class" name prefix to avoid clashes)
  * fixed several cases where the compiler did not treat Objective-C
    classes/protocols the same as Object Pascal classes/interfaces
    (a.o., forward declarations, alignment, regvars, several type
     conversions, ...)
  * allow "override" directive in objcclass declarations, and print
    a hint if it's forgotten in an external declaration (because it
    doesn't really matter there, and may make automated header
    conversion harder than necessary) and an error if will be used in
    a non-external declaration (because it is not possible to start
    a new vmt entry-tree in Objective-C, you can only override parent
    methods)
  * reject objcclasses/protocols as parameters to typeof()
  * don't try to test VMT validity of objcclasses/protocols

git-svn-id: branches/objc@13375 -

.gitattributes

@@ -8206,6 +8206,18 @@ tests/test/tobjc2.pp svneol=native#text/plain
 tests/test/tobjc3.pp svneol=native#text/plain
 tests/test/tobjc4.pp svneol=native#text/plain
 tests/test/tobjc4a.pp svneol=native#text/plain
+tests/test/tobjc5.pp svneol=native#text/plain
+tests/test/tobjc5a.pp svneol=native#text/plain
+tests/test/tobjc6.pp svneol=native#text/plain
+tests/test/tobjc7.pp svneol=native#text/plain
+tests/test/tobjc7a.pp svneol=native#text/plain
+tests/test/tobjc7b.pp svneol=native#text/plain
+tests/test/tobjc7c.pp svneol=native#text/plain
+tests/test/tobjc8.pp svneol=native#text/plain
+tests/test/tobjc8a.pp svneol=native#text/plain
+tests/test/tobjc9.pp svneol=native#text/plain
+tests/test/tobjc9a.pp svneol=native#text/plain
+tests/test/tobjc9b.pp svneol=native#text/plain
 tests/test/tobject1.pp svneol=native#text/plain
 tests/test/tobject2.pp svneol=native#text/plain
 tests/test/tobject3.pp svneol=native#text/plain

compiler/dbgdwarf.pas

@@ -3023,7 +3023,8 @@ implementation
                 current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(def_dwarf_class_struct_lab(def),0));
               doappend;
             end;
-          odt_objcclass:
+          odt_objcclass,
+          odt_objcprotocol:
             begin
               // Objective-C class: plain pointer for now
               append_entry(DW_TAG_pointer_type,false,[]);

compiler/defcmp.pas

@@ -277,7 +277,7 @@ implementation
                  objectdef:
                    begin
                      if (m_delphi in current_settings.modeswitches) and
-                        is_class_or_interface_or_dispinterface(def_from) and
+                        is_class_or_interface_or_dispinterface_or_objc(def_from) and
                         (cdo_explicit in cdoptions) then
                       begin
                         eq:=te_convert_l1;
@@ -1113,7 +1113,7 @@ implementation
                        can be assigned to void pointers, but it is less
                        preferred than assigning to a related objectdef }
                      if (
-                         is_class_or_interface_or_dispinterface(def_from) or
+                         is_class_or_interface_or_dispinterface_or_objc(def_from) or
                          (def_from.typ=classrefdef)
                         ) and
                         (tpointerdef(def_to).pointeddef.typ=orddef) and
@@ -1122,11 +1122,11 @@ implementation
                          doconv:=tc_equal;
                          eq:=te_convert_l2;
                        end
-                     else if is_objcclass(def_from) and
+                     else if is_objc_class_or_protocol(def_from) and
                              (def_to=objc_idtype) then
                        begin
                          doconv:=tc_equal;
-                         eq:=te_convert_l1;
+                         eq:=te_convert_l2;
                        end;
                    end;
                end;
@@ -1230,7 +1230,7 @@ implementation
                 end
                else
                { Class/interface specific }
-                if is_class_or_interface_or_dispinterface(def_to) then
+                if is_class_or_interface_or_dispinterface_or_objc(def_to) then
                  begin
                    { void pointer also for delphi mode }
                    if (m_delphi in current_settings.modeswitches) and
@@ -1247,9 +1247,19 @@ implementation
                        doconv:=tc_equal;
                        eq:=te_convert_l1;
                      end
-                   { classes can be assigned to interfaces }
-                   else if is_interface(def_to) and
-                           is_class(def_from) and
+                   { All Objective-C classes are compatible with ID }
+                   else if is_objcclass(def_to) and
+                           (def_from=objc_idtype) then
+                      begin
+                       doconv:=tc_equal;
+                       eq:=te_convert_l2;
+                     end
+                   { classes can be assigned to interfaces
+                     (same with objcclass and objcprotocol) }
+                   else if ((is_interface(def_to) and
+                             is_class(def_from)) or
+                            (is_objcprotocol(def_to) and
+                             is_objcclass(def_from))) and
                            assigned(tobjectdef(def_from).ImplementedInterfaces) then
                      begin
                         { we've to search in parent classes as well }
@@ -1258,7 +1268,11 @@ implementation
                           begin
                              if hobjdef.find_implemented_interface(tobjectdef(def_to))<>nil then
                                begin
-                                  doconv:=tc_class_2_intf;
+                                  if is_interface(def_to) then
+                                    doconv:=tc_class_2_intf
+                                  else
+                                    { for Objective-C, we don't have to do anything special }
+                                    doconv:=tc_equal;
                                   { don't prefer this over objectdef->objectdef }
                                   eq:=te_convert_l2;
                                   break;
@@ -1288,14 +1302,7 @@ implementation
                        doconv:=tc_int_2_int;
                        eq:=te_convert_l1;
                      end;
-                 end
-                else if is_objcclass(def_to) and
-                        (def_from=objc_idtype) then
-                  begin
-                    { All Objective-C classes are compatible with ID }
-                    doconv:=tc_equal;
-                    eq:=te_convert_l1;
-                  end;
+                 end;
              end;
 
            classrefdef :
@@ -1693,8 +1700,8 @@ implementation
           (equal_defs(parentretdef,childretdef)) or
           ((parentretdef.typ=objectdef) and
            (childretdef.typ=objectdef) and
-           is_class_or_interface(parentretdef) and
-           is_class_or_interface(childretdef) and
+           is_class_or_interface_or_objc(parentretdef) and
+           is_class_or_interface_or_objc(childretdef) and
            (tobjectdef(childretdef).is_related(tobjectdef(parentretdef))))
       end;
 

compiler/defutil.pas

@@ -970,7 +970,7 @@ implementation
             end;
           objectdef :
             begin
-              if is_class_or_interface(def) then
+              if is_class_or_interface_or_objc(def) then
                 result := OS_ADDR
               else
                 result:=int_cgsize(def.size);

compiler/htypechk.pas

@@ -218,7 +218,7 @@ implementation
             pointerdef :
               begin
                 if ((rd.typ in [orddef,enumdef,pointerdef,classrefdef,procvardef]) or
-                    is_class_or_interface(rd)) then
+                    is_class_or_interface_or_objc(rd)) then
                  begin
                    allowed:=false;
                    exit;
@@ -280,7 +280,7 @@ implementation
               begin
                 { <> and = are defined for classes }
                 if (treetyp in [equaln,unequaln]) and
-                   is_class_or_interface(ld) then
+                   is_class_or_interface_or_objc(ld) then
                  begin
                    allowed:=false;
                    exit;
@@ -842,7 +842,7 @@ implementation
                end;
              subscriptn :
                begin
-                 if is_class_or_interface(tunarynode(p).left.resultdef) then
+                 if is_class_or_interface_or_objc(tunarynode(p).left.resultdef) then
                    newstate := vs_read;
                  p:=tunarynode(p).left;
                end;
@@ -996,7 +996,7 @@ implementation
                  pointerdef :
                    gotpointer:=true;
                  objectdef :
-                   gotclass:=is_class_or_interface(hp.resultdef);
+                   gotclass:=is_class_or_interface_or_objc(hp.resultdef);
                  recorddef :
                    gotrecord:=true;
                  classrefdef :
@@ -1113,7 +1113,7 @@ implementation
                    pointerdef :
                      gotpointer:=true;
                    objectdef :
-                     gotclass:=is_class_or_interface(hp.resultdef);
+                     gotclass:=is_class_or_interface_or_objc(hp.resultdef);
                    classrefdef :
                      gotclass:=true;
                    arraydef :
@@ -1210,7 +1210,7 @@ implementation
                  { a class/interface access is an implicit }
                  { dereferencing                           }
                  hp:=tsubscriptnode(hp).left;
-                 if is_class_or_interface(hp.resultdef) then
+                 if is_class_or_interface_or_objc(hp.resultdef) then
                    gotderef:=true;
                end;
              muln,
@@ -1299,7 +1299,7 @@ implementation
                    pointerdef :
                      gotpointer:=true;
                    objectdef :
-                     gotclass:=is_class_or_interface(hp.resultdef);
+                     gotclass:=is_class_or_interface_or_objc(hp.resultdef);
                    recorddef, { handle record like class it needs a subscription }
                    classrefdef :
                      gotclass:=true;

compiler/msg/errore.msg

@@ -366,7 +366,7 @@ scan_w_multiple_main_name_overrides=02086_W_Overriding name of "main" procedure
 #
 # Parser
 #
-# 03256 is the last used one
+# 03261 is the last used one
 #
 % \section{Parser messages}
 % This section lists all parser messages. The parser takes care of the
@@ -911,12 +911,12 @@ parser_e_no_con_des_in_interfaces=03171_E_Con- and destructors aren't allowed in
 % Constructor and destructor declarations aren't allowed in interfaces.
 % In the most cases method \var{QueryInterface} of \var{IUnknown} can
 % be used to create a new interface.
-parser_e_no_access_specifier_in_interfaces=03172_E_Access specifiers can't be used in INTERFACES
+parser_e_no_access_specifier_in_interfaces=03172_E_Access specifiers can't be used in INTERFACEs and OBJCPROTOCOLs
 % The access specifiers \var{public}, \var{private}, \var{protected} and
-% \var{published} can't be used in interfaces because all methods
-% of an interface must be public.
-parser_e_no_vars_in_interfaces=03173_E_An interface can't contain fields
-% Declarations of fields aren't allowed in interfaces. An interface
+% \var{published} can't be used in interfaces and Objective-C protocols because all methods
+% of an interface/protocol must be public.
+parser_e_no_vars_in_interfaces=03173_E_An interface or Objective-C protocol cannot contain fields
+% Declarations of fields are not allowed in interfaces and Objective-C protocols. An interface/protocol
 % can contain only methods and properties with method read/write specifiers.
 parser_e_no_local_proc_external=03174_E_Can't declare local procedure as EXTERNAL
 % Declaring local procedures as external is not possible. Local procedures
@@ -1203,12 +1203,30 @@ parser_h_no_objc_parent=03256_H_Defining a new Objective-C root class. To derive
 % root classes in Objective-C. For example, in the Cocoa framework both NSObject and NSProxy are root classes.
 % Therefore, you have to explicitly define a parent class (such as NSObject) if you want to derive your
 % Objective-C class from it.
+parser_e_no_objc_published=03257_E_Objective-C classes cannot have published sections.
+% In Object Pascal, ``published'' determines whether or not RTTI is generated. Since the Objective-C runtime always needs
+% RTTI for everything, this specified does not make sense for Objective-C classes.
+parser_f_need_objc=03258_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=03259_E_Inherited methods can only be overridden in Objective-C, add ``override''.
+parser_h_should_use_override_objc=03260_H_Inherited methods can only be overridden in Objective-C, add ``override''.
+% It is not possible to ``reintroduce'' methods in Objective-C 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 ``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 ``override''-style keyword (since it's the default and only behaviour in that language),
+% which makes it hard for automated header conversion tools to include it everywhere.
+parser_e_objc_message_name_changed=03261_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
+% giving them a different message name breaks the ``override'' semantics.
 % \end{description}
 
 #
 # Type Checking
 #
-# 04087 is the last used one
+# 04088 is the last used one
 #
 % \section{Type checking errors}
 % This section lists all errors that can occur when type checking is
@@ -1506,6 +1524,8 @@ type_e_no_type_info=04087_E_No type info available for this type
 % Type information is not generated for some types, such as enumerations with gaps
 % in their value range (this includes enumerations whose lower bound is different
 % from zero).
+type_e_protocol_type_expected=04088_E_Objective-C protocol type expected, but got "$1"
+% The compiler expected a protocol type name, but found something else.
 % \end{description}
 #
 # Symtable

compiler/msgidx.inc

@@ -344,6 +344,11 @@ const
   parser_e_message_string_too_long=03254;
   parser_e_objc_message_name_too_long=03255;
   parser_h_no_objc_parent=03256;
+  parser_e_no_objc_published=03257;
+  parser_f_need_objc=03258;
+  parser_e_must_use_override_objc=03259;
+  parser_h_should_use_override_objc=03260;
+  parser_e_objc_message_name_changed=03261;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -422,6 +427,7 @@ const
   type_e_expected_objc_method_but_got=04085;
   type_e_expected_objc_method=04086;
   type_e_no_type_info=04087;
+  type_e_protocol_type_expected=04088;
   sym_e_id_not_found=05000;
   sym_f_internal_error_in_symtablestack=05001;
   sym_e_duplicate_id=05002;
@@ -794,9 +800,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 51955;
+  MsgTxtSize = 52451;
 
   MsgIdxMax : array[1..20] of longint=(
-    24,87,257,88,65,51,108,22,202,62,
+    24,87,262,89,65,51,108,22,202,62,
     47,20,1,1,1,1,1,1,1,1
   );

compiler/nadd.pas

@@ -1560,18 +1560,18 @@ implementation
           end
 
          { class or interface equation }
-         else if is_class_or_interface(rd) or is_class_or_interface(ld) then
+         else if is_class_or_interface_or_objc(rd) or is_class_or_interface_or_objc(ld) then
           begin
             if (nodetype in [equaln,unequaln]) then
               begin
-                if is_class_or_interface(rd) and is_class_or_interface(ld) then
+                if is_class_or_interface_or_objc(rd) and is_class_or_interface_or_objc(ld) then
                  begin
                    if tobjectdef(rd).is_related(tobjectdef(ld)) then
                     inserttypeconv(right,left.resultdef)
                    else
                     inserttypeconv(left,right.resultdef);
                  end
-                else if is_class_or_interface(rd) then
+                else if is_class_or_interface_or_objc(rd) then
                   inserttypeconv(left,right.resultdef)
                 else
                   inserttypeconv(right,left.resultdef);
@@ -1595,7 +1595,7 @@ implementation
           end
 
          { allows comperasion with nil pointer }
-         else if is_class_or_interface(rd) or (rd.typ=classrefdef) then
+         else if is_class_or_interface_or_objc(rd) or (rd.typ=classrefdef) then
           begin
             if (nodetype in [equaln,unequaln]) then
               inserttypeconv(left,right.resultdef)
@@ -1603,7 +1603,7 @@ implementation
               CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
           end
 
-         else if is_class_or_interface(ld) or (ld.typ=classrefdef) then
+         else if is_class_or_interface_or_objc(ld) or (ld.typ=classrefdef) then
           begin
             if (nodetype in [equaln,unequaln]) then
               inserttypeconv(right,left.resultdef)
@@ -2671,7 +2671,7 @@ implementation
                 expectloc:=LOC_FLAGS;
            end
 
-         else if is_class_or_interface(ld) then
+         else if is_class_or_interface_or_objc(ld) then
             begin
               expectloc:=LOC_FLAGS;
             end

compiler/ncgmem.pas

@@ -273,9 +273,8 @@ implementation
          if codegenerror then
            exit;
          paraloc1.init;
-         { classes and interfaces must be dereferenced implicit }
-         if is_class_or_interface(left.resultdef) or
-            is_objcclass(left.resultdef) then
+         { classes and interfaces must be dereferenced implicitly }
+         if is_class_or_interface_or_objc(left.resultdef) then
            begin
              { the contents of a class are aligned to a sizeof(pointer) }
              location_reset_ref(location,LOC_REFERENCE,def_cgsize(resultdef),sizeof(pint));

compiler/ncgutil.pas

@@ -2867,7 +2867,8 @@ implementation
 
         { test validity of VMT }
         if not(is_interface(objdef)) and
-           not(is_cppclass(objdef)) then
+           not(is_cppclass(objdef)) and
+           not(is_objc_class_or_protocol(objdef)) then
            cg.g_maybe_testvmt(list,vmtreg,objdef);
       end;
 

compiler/ncnv.pas

@@ -1793,8 +1793,8 @@ implementation
                        make_not_regable(left,[ra_addr_regable]);
 
                      { class/interface to class/interface, with checkobject support }
-                     if is_class_or_interface(resultdef) and
-                        is_class_or_interface(left.resultdef) then
+                     if is_class_or_interface_or_objc(resultdef) and
+                        is_class_or_interface_or_objc(left.resultdef) then
                        begin
                          { check if the types are related }
                          if not(nf_internal in flags) and
@@ -1815,7 +1815,9 @@ implementation
                            end;
 
                          { Add runtime check? }
-                         if (cs_check_object in current_settings.localswitches) and
+                         if not is_objc_class_or_protocol(resultdef) and
+                            not is_objc_class_or_protocol(left.resultdef) and
+                            (cs_check_object in current_settings.localswitches) and
                             not(nf_internal in flags) then
                            begin
                              { we can translate the typeconvnode to 'as' when
@@ -1866,7 +1868,7 @@ implementation
                                    { however, there are some exceptions }
                                    (not(resultdef.typ in [arraydef,recorddef,setdef,stringdef,
                                                           filedef,variantdef,objectdef]) or
-                                   is_class_or_interface(resultdef) or
+                                   is_class_or_interface_or_objc(resultdef) or
                                    { the softfloat code generates casts <const. float> to record }
                                    (nf_internal in flags)
                                  ))

compiler/nmem.pas

@@ -629,8 +629,8 @@ implementation
          if codegenerror then
           exit;
 
-         { classes must be dereferenced implicit }
-         if is_class_or_interface(left.resultdef) then
+         { classes must be dereferenced implicitly }
+         if is_class_or_interface_or_objc(left.resultdef) then
            expectloc:=LOC_REFERENCE
          else
            begin

compiler/nobj.pas

@@ -39,6 +39,7 @@ interface
         _Class : tobjectdef;
         function  is_new_vmt_entry(pd:tprocdef):boolean;
         procedure add_new_vmt_entry(pd:tprocdef);
+        function  check_msg_str(vmtpd, pd: tprocdef):boolean;
         function  intf_search_procdef_by_name(proc: tprocdef;const name: string): tprocdef;
         procedure intf_get_procdefs(ImplIntf:TImplementedInterface;IntfDef:TObjectDef);
         procedure intf_get_procdefs_recursive(ImplIntf:TImplementedInterface;IntfDef:TObjectDef);
@@ -47,7 +48,8 @@ interface
       public
         constructor create(c:tobjectdef);
         destructor  destroy;override;
-        procedure generate_vmt;
+        procedure  generate_vmt;
+        procedure  build_interface_mappings;
       end;
 
     type
@@ -179,9 +181,49 @@ implementation
       end;
 
 
+      function TVMTBuilder.check_msg_str(vmtpd, pd: tprocdef): boolean;
+        begin
+          result:=true;
+          if not(is_objc_class_or_protocol(_class)) then
+            begin
+              { the only requirement for normal methods is that both either
+                have a message string or not (the value is irrelevant) }
+              if ((pd.procoptions * [po_msgstr]) <> (vmtpd.procoptions * [po_msgstr])) then
+                begin
+                  MessagePos1(pd.fileinfo,parser_e_header_dont_match_forward,pd.fullprocname(false));
+                  tprocsym(vmtpd.procsym).write_parameter_lists(pd);
+                  result:=false;
+                end
+            end
+          else
+            begin
+              { the compiler should have ensured that the protocol or parent
+                class method has a message name specified }
+              if not(po_msgstr in vmtpd.procoptions) then
+                internalerror(2009070601);
+              if not(po_msgstr in pd.procoptions) then
+                begin
+                  { copy the protocol's/parent class' message name to the one in
+                    the class if none has been specified there }
+                  include(pd.procoptions,po_msgstr);
+                  pd.messageinf.str:=stringdup(vmtpd.messageinf.str^);
+                end
+              else
+                begin
+                  { if both have a message name, make sure they are equal }
+                  if (vmtpd.messageinf.str^<>pd.messageinf.str^) then
+                    begin
+                      MessagePos2(pd.fileinfo,parser_e_objc_message_name_changed,vmtpd.messageinf.str^,pd.messageinf.str^);
+                      result:=false;
+                    end;
+                end;
+            end;
+        end;
+
+
     function TVMTBuilder.is_new_vmt_entry(pd:tprocdef):boolean;
       const
-        po_comp = [po_classmethod,po_virtualmethod,po_staticmethod,po_interrupt,po_iocheck,po_msgstr,po_msgint,
+        po_comp = [po_classmethod,po_virtualmethod,po_staticmethod,po_interrupt,po_iocheck,po_msgint,
                    po_exports,po_varargs,po_explicitparaloc,po_nostackframe];
       var
         i : longint;
@@ -233,7 +275,7 @@ implementation
                (
                 not(po_virtualmethod in pd.procoptions) or
                 { new one has not override }
-                (is_class_or_interface(_class) and not(po_overridingmethod in pd.procoptions))
+                (is_class_or_interface_or_objc(_class) and not(po_overridingmethod in pd.procoptions))
                ) then
               begin
                 if (
@@ -242,7 +284,31 @@ implementation
                    ) then
                   begin
                     if not(po_reintroduce in pd.procoptions) then
-                      MessagePos1(pd.fileinfo,parser_w_should_use_override,pd.fullprocname(false));
+                      if not(is_objc_class_or_protocol(_class)) then
+                        MessagePos1(pd.fileinfo,parser_w_should_use_override,pd.fullprocname(false))
+                      else
+                        begin
+                          { In Objective-C, you cannot create a new VMT entry to
+                            start a new inheritance tree. We therefore give an
+                            error when the class is implemented in Pascal, to
+                            avoid confusion due to things working differently
+                            with Object Pascal classes.
+
+                            In case of external classes, we only give a hint,
+                            because requiring override everywhere may make
+                            automated header translation tools too complex.  }
+                          if not(oo_is_external in _class.objectoptions) then
+                            MessagePos1(pd.fileinfo,parser_e_must_use_override_objc,pd.fullprocname(false))
+                          { there may be a lot of these in auto-translated
+                            heaeders, so only calculate the fullprocname if
+                            the hint will be shown  }
+                          else if CheckVerbosity(V_Hint) then
+                            MessagePos1(pd.fileinfo,parser_h_should_use_override_objc,pd.fullprocname(false));
+                          { no new entry, but copy the message name if any from
+                            the procdef in the parent class }
+                          check_msg_str(vmtpd,pd);
+                          exit;
+                        end;
                     { disable/hide old VMT entry }
                     vmtentry^.visibility:=vis_hidden;
                   end;
@@ -275,6 +341,8 @@ implementation
                          tprocsym(vmtpd.procsym).write_parameter_lists(pd);
                        end;
 
+                    check_msg_str(vmtpd,pd);
+
                     { Give a note if the new visibility is lower. For a higher
                       visibility update the vmt info }
                     if vmtentry^.visibility>pd.visibility then
@@ -301,10 +369,12 @@ implementation
                      begin
                        if not(po_reintroduce in pd.procoptions) then
                          begin
-                           if not is_object(_class) then
+                           if not is_object(_class) and
+                              not is_objc_class_or_protocol(_class) then
                              MessagePos1(pd.fileinfo,parser_w_should_use_override,pd.fullprocname(false))
                            else
-                             { objects don't allow starting a new virtual tree }
+                             { objects don't allow starting a new virtual tree
+                               and neither does Objective-C }
                              MessagePos1(pd.fileinfo,parser_e_header_dont_match_forward,vmtpd.fullprocname(false));
                          end;
                        { disable/hide old VMT entry }
@@ -320,7 +390,7 @@ implementation
 
     function TVMTBuilder.intf_search_procdef_by_name(proc: tprocdef;const name: string): tprocdef;
       const
-        po_comp = [po_classmethod,po_staticmethod,po_interrupt,po_iocheck,po_msgstr,po_msgint,
+        po_comp = [po_classmethod,po_staticmethod,po_interrupt,po_iocheck,po_msgint,
                    po_exports,po_varargs,po_explicitparaloc,po_nostackframe];
       var
         implprocdef : Tprocdef;
@@ -346,7 +416,8 @@ implementation
                        (compare_defs(proc.returndef,implprocdef.returndef,nothingn)>=te_equal) and
                        (proc.proccalloption=implprocdef.proccalloption) and
                        (proc.proctypeoption=implprocdef.proctypeoption) and
-                       ((proc.procoptions*po_comp)=((implprocdef.procoptions+[po_virtualmethod])*po_comp)) then
+                       ((proc.procoptions*po_comp)=((implprocdef.procoptions+[po_virtualmethod])*po_comp)) and
+                       check_msg_str(proc,implprocdef) then
                       begin
                         result:=implprocdef;
                         exit;
@@ -386,9 +457,32 @@ implementation
                   implprocdef:=intf_search_procdef_by_name(tprocdef(def),tprocdef(def).procsym.name);
                 { Add procdef to the implemented interface }
                 if assigned(implprocdef) then
-                  ImplIntf.AddImplProc(implprocdef)
+                  begin
+                    if (implprocdef._class.objecttype<>odt_objcclass) then
+                      ImplIntf.AddImplProc(implprocdef)
+                    else
+                      begin
+                        { If no message name has been specified for the method
+                          in the objcclass, copy it from the protocol
+                          definition.  }
+                        if not(po_msgstr in tprocdef(def).procoptions) then
+                          begin
+                            include(tprocdef(def).procoptions,po_msgstr);
+                            implprocdef.messageinf.str:=stringdup(tprocdef(def).messageinf.str^);
+                          end
+                        else
+                          begin
+                            { If a message name has been specified in the
+                              objcclass, it has to match the message name in the
+                              protocol definition.  }
+                            if (implprocdef.messageinf.str^<>tprocdef(def).messageinf.str^) then
+                              MessagePos2(implprocdef.fileinfo,parser_e_objc_message_name_changed,tprocdef(def).messageinf.str^,implprocdef.messageinf.str^);
+                          end;
+                      end;
+                  end
                 else
-                  if ImplIntf.IType=etStandard then
+                  if (ImplIntf.IType=etStandard) and
+                     not(tprocdef(def).optional) then
                     Message1(sym_e_no_matching_implementation_found,tprocdef(def).fullprocname(false));
               end;
           end;
@@ -545,7 +639,6 @@ implementation
       var
         i : longint;
         def : tdef;
-        ImplIntf : TImplementedInterface;
         old_current_objectdef : tobjectdef;
       begin
         old_current_objectdef:=current_objectdef;
@@ -574,7 +667,25 @@ implementation
                   add_new_vmt_entry(tprocdef(def));
               end;
           end;
+        build_interface_mappings;
+        if assigned(_class.ImplementedInterfaces) and
+           not(is_objc_class_or_protocol(_class)) then
+          begin
+            { Optimize interface tables to reuse wrappers }
+            intf_optimize_vtbls;
+            { Allocate interface tables }
+            intf_allocate_vtbls;
+          end;
 
+        current_objectdef:=old_current_objectdef;
+      end;
+
+
+    procedure TVMTBuilder.build_interface_mappings;
+      var
+        ImplIntf : TImplementedInterface;
+        i: longint;
+      begin
         { Find Procdefs implementing the interfaces }
         if assigned(_class.ImplementedInterfaces) then
           begin
@@ -584,13 +695,7 @@ implementation
                 ImplIntf:=TImplementedInterface(_class.ImplementedInterfaces[i]);
                 intf_get_procdefs_recursive(ImplIntf,ImplIntf.IntfDef);
               end;
-            { Optimize interface tables to reuse wrappers }
-            intf_optimize_vtbls;
-            { Allocate interface tables }
-            intf_allocate_vtbls;
           end;
-
-        current_objectdef:=old_current_objectdef;
       end;
 
 

compiler/nutils.pas

@@ -658,7 +658,7 @@ implementation
                 end;
               subscriptn:
                 begin
-                  if is_class_or_interface(tunarynode(p).left.resultdef) then
+                  if is_class_or_interface_or_objc(tunarynode(p).left.resultdef) then
                     inc(result);
                   if (result = NODE_COMPLEXITY_INF) then
                     exit;

compiler/pdecl.pas

@@ -278,19 +278,30 @@ implementation
 
     procedure types_dec;
 
-      procedure finish_objc_class(od: tobjectdef);
+      procedure get_objc_class_or_protocol_external_status(od: tobjectdef);
         begin
           { Objective-C classes can be external -> all messages inside are
             external (defined at the class level instead of per method, so
             that you cannot define some methods as external and some not)
           }
-          if (token = _ID) and
-             (idtoken = _EXTERNAL) then
+          if (token=_ID) and
+             (idtoken=_EXTERNAL) then
             begin
               consume(_EXTERNAL);
+              if (token=_ID) and
+                 (idtoken=_NAME) then
+                begin
+                  consume(_NAME);
+                  od.objextname:=stringdup(get_stringconst);
+                end
+              else
+                od.objextname:=stringdup(od.objrealname^);
               consume(_SEMICOLON);
               od.make_all_methods_external;
-            end;
+              include(od.objectoptions,oo_is_external);
+            end
+          else { or also allow "public name 'x'"? }
+            od.objextname:=stringdup(od.objrealname^);
         end;
 
 
@@ -380,7 +391,7 @@ implementation
                      (token=_DISPINTERFACE) or
                      (token=_OBJCCLASS)) and
                     (assigned(ttypesym(sym).typedef)) and
-                    is_class_or_interface_or_dispinterface(ttypesym(sym).typedef) and
+                    is_class_or_interface_or_dispinterface_or_objc(ttypesym(sym).typedef) and
                     (oo_is_forward in tobjectdef(ttypesym(sym).typedef).objectoptions) then
                   begin
                     case token of
@@ -395,6 +406,8 @@ implementation
                         objecttype:=odt_dispinterface;
                       _OBJCCLASS :
                         objecttype:=odt_objcclass;
+                      _OBJCPROTOCOL :
+                        objecttype:=odt_objcprotocol;
                       else
                         internalerror(200811072);
                     end;
@@ -432,7 +445,7 @@ implementation
                       hdef:=tstoreddef(hdef).getcopy;
 
                       { fix name, it is used e.g. for tables }
-                      if is_class_or_interface_or_dispinterface(hdef) then
+                      if is_class_or_interface_or_dispinterface_or_objc(hdef) then
                         with tobjectdef(hdef) do
                           begin
                             stringdispose(objname);
@@ -489,21 +502,33 @@ implementation
                   end;
                 objectdef :
                   begin
+                    try_consume_hintdirective(newtype.symoptions);
+                    consume(_SEMICOLON);
+
+                    { we have to know whether the class or protocol is
+                      external before the vmt is built, because some errors/
+                      hints depend on this  }
+                    if is_objc_class_or_protocol(hdef) then
+                      get_objc_class_or_protocol_external_status(tobjectdef(hdef));
+
                     { Build VMT indexes, skip for type renaming and forward classes }
                     if (hdef.typesym=newtype) and
                        not(oo_is_forward in tobjectdef(hdef).objectoptions) and
-                       not(df_generic in hdef.defoptions) and
-                       not is_objcclass(hdef) then
+                       not(df_generic in hdef.defoptions) then
                       begin
                         vmtbuilder:=TVMTBuilder.Create(tobjectdef(hdef));
                         vmtbuilder.generate_vmt;
                         vmtbuilder.free;
                       end;
-                    try_consume_hintdirective(newtype.symoptions);
-                    consume(_SEMICOLON);
 
-                    if is_objcclass(hdef) then
-                      finish_objc_class(tobjectdef(hdef));
+                    { In case of an objcclass, verify that all methods have a message
+                      name set. We only check this now, because message names can be set
+                      during the protocol (interface) mapping. At the same time, set the
+                      mangled names.
+                    }
+                    if is_objc_class_or_protocol(hdef) then
+                      tobjectdef(hdef).check_and_finish_messages;
+
                   end;
                 recorddef :
                   begin

compiler/pdecobj.pas

@@ -160,6 +160,23 @@ implementation
       end;
 
 
+    procedure setobjcclassmethodoptions;
+      var
+        i   : longint;
+        def : tdef;
+      begin
+        for i:=0 to current_objectdef.symtable.DefList.count-1 do
+          begin
+            def:=tdef(current_objectdef.symtable.DefList[i]);
+            if assigned(def) and
+               (def.typ=procdef) then
+              begin
+                include(tprocdef(def).procoptions,po_virtualmethod);
+              end;
+          end;
+      end;
+
+
     procedure handleImplementedInterface(intfdef : tobjectdef);
       begin
         if not is_interface(intfdef) then
@@ -180,7 +197,23 @@ implementation
       end;
 
 
-    procedure readImplementedInterfaces;
+    procedure handleImplementedProtocol(intfdef : tobjectdef);
+      begin
+        if not is_objcprotocol(intfdef) then
+          begin
+             Message1(type_e_protocol_type_expected,intfdef.typename);
+             exit;
+          end;
+        if current_objectdef.find_implemented_interface(intfdef)<>nil then
+          Message1(sym_e_duplicate_id,intfdef.objname^)
+        else
+          begin
+            current_objectdef.ImplementedInterfaces.Add(TImplementedInterface.Create(intfdef));
+          end;
+      end;
+
+
+    procedure readImplementedInterfacesAndProtocols(intf: boolean);
       var
         hdef : tdef;
       begin
@@ -189,10 +222,16 @@ implementation
              id_type(hdef,false);
              if (hdef.typ<>objectdef) then
                begin
-                  Message1(type_e_interface_type_expected,hdef.typename);
+                  if intf then
+                    Message1(type_e_interface_type_expected,hdef.typename)
+                  else
+                    Message1(type_e_protocol_type_expected,hdef.typename);
                   continue;
                end;
-             handleImplementedInterface(tobjectdef(hdef));
+             if intf then
+               handleImplementedInterface(tobjectdef(hdef))
+             else
+               handleImplementedProtocol(tobjectdef(hdef));
           end;
       end;
 
@@ -274,6 +313,18 @@ implementation
                        Message(parser_e_mix_of_classes_and_objects);
                    odt_objcclass:
                      if not(is_objcclass(childof)) then
+                       begin
+                         if is_objcprotocol(childof) then
+                           begin
+                             intfchildof:=childof;
+                             childof:=nil;
+                             CGMessage(parser_h_no_objc_parent);
+                           end
+                         else
+                           Message(parser_e_mix_of_classes_and_objects);
+                       end;
+                   odt_objcprotocol:
+                     if not(is_objcprotocol(childof)) then
                        Message(parser_e_mix_of_classes_and_objects);
                    odt_object:
                      if not(is_object(childof)) then
@@ -325,11 +376,14 @@ implementation
 
         if hasparentdefined then
           begin
-            if current_objectdef.objecttype=odt_class then
+            if current_objectdef.objecttype in [odt_class,odt_objcclass] then
               begin
                 if assigned(intfchildof) then
-                  handleImplementedInterface(intfchildof);
-                readImplementedInterfaces;
+                  if current_objectdef.objecttype=odt_class then
+                    handleImplementedInterface(intfchildof)
+                  else
+                    handleImplementedProtocol(intfchildof);
+                readImplementedInterfacesAndProtocols(current_objectdef.objecttype=odt_class);
               end;
             consume(_RKLAMMER);
           end;
@@ -374,14 +428,12 @@ implementation
 
       procedure chkobjc(pd: tprocdef);
         begin
-          if is_objcclass(pd._class) then
+          if is_objc_class_or_protocol(pd._class) then
             begin
               { none of the explicit calling conventions should be allowed }
               if (po_hascallingconvention in pd.procoptions) then
                 internalerror(2009032501);
               pd.proccalloption:=pocall_cdecl;
-              if not(po_msgstr in pd.procoptions) then
-                Message(parser_e_objc_requires_msgstr);
               include(pd.procoptions,po_objc);
             end;
         end;
@@ -450,11 +502,19 @@ implementation
               end;
             _ID :
               begin
-                case idtoken of
+                if is_objcprotocol(current_objectdef) and
+                   ((idtoken=_REQUIRED) or
+                    (idtoken=_OPTIONAL)) then
+                  begin
+                    current_objectdef.symtable.currentlyoptional:=(idtoken=_OPTIONAL);
+                    consume(idtoken)
+                  end
+                else case idtoken of
                   _PRIVATE :
                     begin
-                      if is_interface(current_objectdef) then
-                         Message(parser_e_no_access_specifier_in_interfaces);
+                      if is_interface(current_objectdef) or
+                         is_objcprotocol(current_objectdef) then
+                        Message(parser_e_no_access_specifier_in_interfaces);
                        consume(_PRIVATE);
                        current_objectdef.symtable.currentvisibility:=vis_private;
                        include(current_objectdef.objectoptions,oo_has_private);
@@ -462,7 +522,8 @@ implementation
                      end;
                    _PROTECTED :
                      begin
-                       if is_interface(current_objectdef) then
+                       if is_interface(current_objectdef) or
+                          is_objcprotocol(current_objectdef) then
                          Message(parser_e_no_access_specifier_in_interfaces);
                        consume(_PROTECTED);
                        current_objectdef.symtable.currentvisibility:=vis_protected;
@@ -471,7 +532,8 @@ implementation
                      end;
                    _PUBLIC :
                      begin
-                       if is_interface(current_objectdef) then
+                       if is_interface(current_objectdef) or
+                          is_objcprotocol(current_objectdef) then
                          Message(parser_e_no_access_specifier_in_interfaces);
                        consume(_PUBLIC);
                        current_objectdef.symtable.currentvisibility:=vis_public;
@@ -482,15 +544,21 @@ implementation
                        { we've to check for a pushlished section in non-  }
                        { publishable classes later, if a real declaration }
                        { this is the way, delphi does it                  }
-                       if is_interface(current_objectdef) then
+                       if is_interface(current_objectdef) or
+                          is_objcprotocol(current_objectdef) then
                          Message(parser_e_no_access_specifier_in_interfaces);
+                       { Objective-C classes do not support "published",
+                         as basically everything is published.  }
+                       if is_objc_class_or_protocol(current_objectdef) then
+                         Message(parser_e_no_objc_published);
                        consume(_PUBLISHED);
                        current_objectdef.symtable.currentvisibility:=vis_published;
                        fields_allowed:=true;
                      end;
                    _STRICT :
                      begin
-                       if is_interface(current_objectdef) then
+                       if is_interface(current_objectdef) or
+                          is_objcprotocol(current_objectdef) then
                           Message(parser_e_no_access_specifier_in_interfaces);
                         consume(_STRICT);
                         if token=_ID then
@@ -520,7 +588,8 @@ implementation
                       begin
                         if object_member_blocktype=bt_general then
                           begin
-                            if is_interface(current_objectdef) then
+                            if is_interface(current_objectdef) or
+                               is_objcprotocol(current_objectdef) then
                               Message(parser_e_no_vars_in_interfaces);
 
                             if (current_objectdef.symtable.currentvisibility=vis_published) and
@@ -601,7 +670,7 @@ implementation
                   Message(parser_e_no_con_des_in_interfaces);
 
                 { Objective-C does not know the concept of a constructor }
-                if is_objcclass(current_objectdef) then
+                if is_objc_class_or_protocol(current_objectdef) then
                   Message(parser_e_objc_no_constructor_destructor);
 
                 oldparse_only:=parse_only;
@@ -639,7 +708,7 @@ implementation
                   Message(parser_w_destructor_should_be_public);
 
                 { Objective-C does not know the concept of a destructor }
-                if is_objcclass(current_objectdef) then
+                if is_objc_class_or_protocol(current_objectdef) then
                   Message(parser_e_objc_no_constructor_destructor);
 
                 oldparse_only:=parse_only;
@@ -727,6 +796,14 @@ implementation
                       class_tobject:=current_objectdef;
                 end;
               end;
+            if (current_module.modulename^='OBJCBASE') then
+              begin
+                case current_objectdef.objecttype of
+                  odt_objcclass:
+                    if (current_objectdef.objname^='Protocol') then
+                      objc_protocoltype:=current_objectdef;
+                end;
+              end;
           end;
 
         { set published flag in $M+ mode, it can also be inherited and will
@@ -772,8 +849,11 @@ implementation
            not(oo_has_constructor in current_objectdef.objectoptions) then
           Message1(parser_w_virtual_without_constructor,current_objectdef.objrealname^);
 
-        if is_interface(current_objectdef) then
-          setinterfacemethodoptions;
+        if is_interface(current_objectdef) or
+           is_objcprotocol(current_objectdef) then
+          setinterfacemethodoptions
+        else if is_objcclass(current_objectdef) then
+          setobjcclassmethodoptions;
 
         { return defined objectdef }
         result:=current_objectdef;

compiler/pdecsub.pas

@@ -40,7 +40,8 @@ interface
         pd_notprocvar,   { directive can not be used procvar declaration }
         pd_dispinterface,{ directive can be used with dispinterface methods }
         pd_cppobject,    { directive can be used with cppclass }
-        pd_objcclass     { directive can be used with objcclass }
+        pd_objcclass,    { directive can be used with objcclass }
+        pd_objcprot      { directive can be used with objcprotocol }
       );
       tpdflags=set of tpdflag;
 
@@ -160,7 +161,7 @@ implementation
         vsp      : tvarspez;
       begin
         if (pd.typ=procdef) and
-           is_objcclass(tprocdef(pd)._class) then
+           is_objc_class_or_protocol(tprocdef(pd)._class) then
           begin
             { insert Objective-C self and selector parameters }
             vs:=tparavarsym.create('$msgsel',paranr_vmt,vs_value,objc_seltype,[vo_is_msgsel,vo_is_hidden_para]);
@@ -883,6 +884,7 @@ implementation
         { symbol options that need to be kept per procdef }
         pd.fileinfo:=procstartfilepos;
         pd.visibility:=symtablestack.top.currentvisibility;
+        pd.optional:=symtablestack.top.currentlyoptional;
 
         { parse parameters }
         if token=_LKLAMMER then
@@ -932,6 +934,7 @@ implementation
            if is_interface(aclass) then
              Message(parser_e_no_static_method_in_interfaces)
            else
+             { class methods are also allowed for Objective-C protocols }
              isclassmethod:=true;
          end;
         case token of
@@ -1329,7 +1332,7 @@ procedure pd_override(pd:tabstractprocdef);
 begin
   if pd.typ<>procdef then
     internalerror(2003042611);
-  if not(is_class_or_interface(tprocdef(pd)._class)) then
+  if not(is_class_or_interface_or_objc(tprocdef(pd)._class)) then
     Message(parser_e_no_object_override);
 end;
 
@@ -1348,10 +1351,10 @@ begin
   if pd.typ<>procdef then
     internalerror(2003042613);
   if not is_class(tprocdef(pd)._class) and
-     not is_objcclass(tprocdef(pd)._class) then
+     not is_objc_class_or_protocol(tprocdef(pd)._class) then
     Message(parser_e_msg_only_for_classes);
   { check parameter type }
-  if not is_objcclass(tprocdef(pd)._class) then
+  if not is_objc_class_or_protocol(tprocdef(pd)._class) then
     begin
       paracnt:=0;
       pd.parast.SymList.ForEachCall(@check_msg_para,@paracnt);
@@ -1365,11 +1368,6 @@ begin
       if (tstringconstnode(pt).len>255) then
         Message(parser_e_message_string_too_long);
       tprocdef(pd).messageinf.str:=stringdup(tstringconstnode(pt).value_str);
-      { the message string is the last part we need to set the mangled name
-        for an Objective-C message
-      }
-      if is_objcclass(tprocdef(pd)._class) then
-        tprocdef(pd).setmangledname(tprocdef(pd).objcmangledname);
     end
   else
    if is_constintnode(pt) and
@@ -1855,7 +1853,7 @@ const
       mutexclpo     : [po_external,po_exports]
     ),(
       idtok:_MESSAGE;
-      pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_objcclass];
+      pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_objcclass, pd_objcprot];
       handler  : @pd_message;
       pocall   : pocall_none;
       pooption : []; { can be po_msgstr or po_msgint }
@@ -1900,7 +1898,7 @@ const
       mutexclpo     : []
     ),(
       idtok:_OVERRIDE;
-      pd_flags : [pd_interface,pd_object,pd_notobjintf];
+      pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_objcclass];
       handler  : @pd_override;
       pocall   : pocall_none;
       pooption : [po_overridingmethod,po_virtualmethod];
@@ -2013,7 +2011,7 @@ const
       mutexclpo     : [po_assembler,po_external,po_virtualmethod]
     ),(
       idtok:_VARARGS;
-      pd_flags : [pd_interface,pd_implemen,pd_procvar,pd_objcclass];
+      pd_flags : [pd_interface,pd_implemen,pd_procvar,pd_objcclass, pd_objcprot];
       handler  : nil;
       pocall   : pocall_none;
       pooption : [po_varargs];
@@ -2110,7 +2108,7 @@ const
          begin
             { parsing a procvar type the name can be any
               next variable !! }
-            if ((pdflags * [pd_procvar,pd_object,pd_objcclass])=[]) and
+            if ((pdflags * [pd_procvar,pd_object,pd_objcclass,pd_objcprot])=[]) and
                not(idtoken=_PROPERTY) then
               Message1(parser_w_unknown_proc_directive_ignored,name);
             exit;
@@ -2178,6 +2176,12 @@ const
            if is_objcclass(tprocdef(pd)._class) and
              not(pd_objcclass in proc_direcdata[p].pd_flags) then
             exit;
+
+           { check if method and directive not for objcprotocol }
+           if is_objcprotocol(tprocdef(pd)._class) and
+             not(pd_objcprot in proc_direcdata[p].pd_flags) then
+            exit;
+
          end;
 
         { consume directive, and turn flag on }

compiler/pexpr.pas

@@ -370,11 +370,12 @@ implementation
                 ttypenode(p1).allowed:=true;
               { Allow classrefdef, which is required for
                 Typeof(self) in static class methods }
-              if (p1.resultdef.typ = objectdef) or
-                 (assigned(current_procinfo) and
-                  ((po_classmethod in current_procinfo.procdef.procoptions) or
-                   (po_staticmethod in current_procinfo.procdef.procoptions)) and
-                  (p1.resultdef.typ=classrefdef)) then
+              if not(is_objc_class_or_protocol(p1.resultdef)) and
+                 ((p1.resultdef.typ = objectdef) or
+                  (assigned(current_procinfo) and
+                   ((po_classmethod in current_procinfo.procdef.procoptions) or
+                    (po_staticmethod in current_procinfo.procdef.procoptions)) and
+                   (p1.resultdef.typ=classrefdef))) then
                statement_syssym:=geninlinenode(in_typeof_x,false,p1)
               else
                begin
@@ -488,7 +489,7 @@ implementation
                    procvardef,
                    classrefdef : ;
                    objectdef :
-                     if not is_class_or_interface(p1.resultdef) then
+                     if not is_class_or_interface_or_objc(p1.resultdef) then
                        begin
                          Message(parser_e_illegal_parameter_list);
                          err:=true;

compiler/pstatmnt.pas

@@ -536,7 +536,7 @@ implementation
                     typecheckpass(p);
                   end;
                 { classes and interfaces have implicit dereferencing }
-                hasimplicitderef:=is_class_or_interface(p.resultdef) or
+                hasimplicitderef:=is_class_or_interface_or_objc(p.resultdef) or
                                   (p.resultdef.typ = classrefdef);
                 if hasimplicitderef then
                   hdef:=p.resultdef

compiler/ptconst.pas

@@ -1223,7 +1223,7 @@ implementation
             end;
 
           { only allow nil for class and interface }
-          if is_class_or_interface(def) then
+          if is_class_or_interface_or_objc(def) then
             begin
               n:=comp_expr(true);
               if n.nodetype<>niln then

compiler/ptype.pas

@@ -302,7 +302,7 @@ implementation
             { Reparse the original type definition }
             if not err then
               begin
-                { Firsta new typesym so we can reuse this specialization and
+                { First a new typesym so we can reuse this specialization and
                   references to this specialization can be handled }
                 srsym:=ttypesym.create(specializename,generrordef);
                 specializest.insert(srsym);
@@ -357,7 +357,7 @@ implementation
             (current_objectdef.objname^=pattern) and
             (
              (testcurobject=2) or
-             is_class_or_interface(current_objectdef)
+             is_class_or_interface_or_objc(current_objectdef)
             )then
            begin
              consume(_ID);
@@ -542,7 +542,7 @@ implementation
               (current_objectdef.objname^=pattern) and
               (
                (testcurobject=2) or
-               is_class_or_interface(current_objectdef)
+               is_class_or_interface_or_objc(current_objectdef)
               )then
              begin
                consume(_ID);
@@ -989,6 +989,9 @@ implementation
               end;
             _OBJCCLASS :
               begin
+                if not(m_objectivec1 in current_settings.modeswitches) then
+                  Message(parser_f_need_objc);
+
                 consume(token);
                 def:=object_dec(odt_objcclass,name,genericdef,genericlist,nil);
               end;
@@ -1004,6 +1007,14 @@ implementation
                 else {it_interfacecorba}
                   def:=object_dec(odt_interfacecorba,name,genericdef,genericlist,nil);
               end;
+            _OBJCPROTOCOL :
+               begin
+                if not(m_objectivec1 in current_settings.modeswitches) then
+                  Message(parser_f_need_objc);
+
+                consume(token);
+                def:=object_dec(odt_objcprotocol,name,genericdef,genericlist,nil);
+               end;
             _OBJECT :
               begin
                 consume(token);
@@ -1105,7 +1116,7 @@ implementation
             if (
                 assigned(def.typesym) and
                 (st.symtabletype=globalsymtable) and
-                not is_objcclass(def)
+                not is_objc_class_or_protocol(def)
                ) or
                def.needs_inittable or
                (ds_init_table_used in def.defstates) then
@@ -1114,7 +1125,7 @@ implementation
             if (
                 assigned(def.typesym) and
                 (st.symtabletype=globalsymtable) and
-                not is_objcclass(def)
+                not is_objc_class_or_protocol(def)
                ) or
                (ds_rtti_table_used in def.defstates) then
               RTTIWriter.write_rtti(def,fullrtti);

compiler/symbase.pas

@@ -96,6 +96,7 @@ interface
           moduleid  : longint;
           refcount  : smallint;
           currentvisibility : tvisibility;
+          currentlyoptional : boolean;
           { level of symtable, used for nested procedures }
           symtablelevel : byte;
           symtabletype  : TSymtabletype;
@@ -222,6 +223,7 @@ implementation
          SymList:=TFPHashObjectList.Create(true);
          refcount:=1;
          currentvisibility:=vis_public;
+         currentlyoptional:=false;
       end;
 
 

compiler/symconst.pas

@@ -290,7 +290,8 @@ type
     odt_interfacecorba,
     odt_cppclass,
     odt_dispinterface,
-    odt_objcclass
+    odt_objcclass,
+    odt_objcprotocol
   );
 
   { Variations in interfaces implementation }
@@ -317,7 +318,9 @@ type
     oo_has_msgint,
     oo_can_have_published,{ the class has rtti, i.e. you can publish properties }
     oo_has_default_property,
-    oo_has_valid_guid
+    oo_has_valid_guid,
+    oo_is_external,       { the class is externally implemented (objcclass, cppclass) }
+    oo_is_anonymous       { the class is only formally defined in this module (objcclass x = class; external;) }
   );
   tobjectoptions=set of tobjectoption;
 

compiler/symdef.pas

@@ -241,7 +241,9 @@ interface
           childofderef   : tderef;
 
           objname,
-          objrealname    : pshortstring;
+          objrealname,
+          { for Objective-C: protocols and classes can have the same name there }
+          objextname     : pshortstring;
           objectoptions  : tobjectoptions;
           { to be able to have a variable vmt position }
           { and no vmt field for objects without virtuals }
@@ -301,7 +303,9 @@ interface
           procedure register_maybe_created_object_type;
           procedure register_created_classref_type;
           procedure register_vmt_call(index:longint);
+          { ObjC }
           procedure make_all_methods_external;
+          procedure check_and_finish_messages;
        end;
 
        tclassrefdef = class(tabstractpointerdef)
@@ -488,7 +492,9 @@ interface
           { true if the procedure is declared in the interface }
           interfacedef : boolean;
           { true if the procedure has a forward declaration }
-          hasforward : boolean;
+          hasforward,
+          { true if the procedure is an optional method in an Objective-C protocol }
+          optional : boolean;
           { import info }
           import_dll,
           import_name : pshortstring;
@@ -669,6 +675,8 @@ interface
        objc_superclasstype,
        objc_idtype,
        objc_seltype         : tpointerdef;
+       { base type of @protocol(protocolname) Objective-C statements }
+       objc_protocoltype    : tobjectdef;
 
     const
 {$ifdef i386}
@@ -720,9 +728,13 @@ interface
     function is_cppclass(def: tdef): boolean;
     function is_objcclass(def: tdef): boolean;
     function is_objcclassref(def: tdef): boolean;
+    function is_objcprotocol(def: tdef): boolean;
+    function is_objc_class_or_protocol(def: tdef): boolean;
     function is_class_or_interface(def: tdef): boolean;
+    function is_class_or_interface_or_objc(def: tdef): boolean;
     function is_class_or_interface_or_object(def: tdef): boolean;
     function is_class_or_interface_or_dispinterface(def: tdef): boolean;
+    function is_class_or_interface_or_dispinterface_or_objc(def: tdef): boolean;
 
     procedure loadobjctypes;
 
@@ -1118,7 +1130,7 @@ implementation
           procvardef :
             is_intregable:=not(po_methodpointer in tprocvardef(self).procoptions);
           objectdef:
-            is_intregable:=(is_class(self) or is_interface(self)) and not needs_inittable;
+            is_intregable:=(is_class_or_interface_or_objc(self)) and not needs_inittable;
           setdef:
             is_intregable:=is_smallset(self);
           recorddef:
@@ -2937,6 +2949,7 @@ implementation
          forwarddef:=true;
          interfacedef:=false;
          hasforward:=false;
+         optional:=false;
          _class := nil;
          import_dll:=nil;
          import_name:=nil;
@@ -2965,6 +2978,7 @@ implementation
          ppufile.getposinfo(fileinfo);
          visibility:=tvisibility(ppufile.getbyte);
          ppufile.getsmallset(symoptions);
+         optional:=boolean(ppufile.getbyte);
 {$ifdef powerpc}
          { library symbol for AmigaOS/MorphOS }
          ppufile.getderef(libsymderef);
@@ -3102,6 +3116,7 @@ implementation
          ppufile.putposinfo(fileinfo);
          ppufile.putbyte(byte(visibility));
          ppufile.putsmallset(symoptions);
+         ppufile.putbyte(byte(optional));
 {$ifdef powerpc}
          { library symbol for AmigaOS/MorphOS }
          ppufile.putderef(libsymderef);
@@ -3516,7 +3531,7 @@ implementation
         if not (po_msgstr in procoptions) then
           internalerror(2009030901);
         { we may very well need longer strings to handle these... }
-        if ((255-length(tobjectdef(procsym.owner.defowner).objrealname^)
+        if ((255-length(tobjectdef(procsym.owner.defowner).objextname^)
              -length('+[ ]')-length(messageinf.str^)) < 0) then
           Message1(parser_e_objc_message_name_too_long,messageinf.str^);
         if not(po_classmethod in procoptions) then
@@ -3711,7 +3726,7 @@ implementation
         if objecttype in [odt_interfacecorba,odt_interfacecom,odt_dispinterface] then
           prepareguid;
         { setup implemented interfaces }
-        if objecttype in [odt_class,odt_interfacecorba] then
+        if objecttype in [odt_class,odt_interfacecorba,odt_objcclass] then
           ImplementedInterfaces:=TFPObjectList.Create(true)
         else
           ImplementedInterfaces:=nil;
@@ -3731,6 +3746,10 @@ implementation
          objecttype:=tobjecttyp(ppufile.getbyte);
          objrealname:=stringdup(ppufile.getstring);
          objname:=stringdup(upper(objrealname^));
+         objextname:=stringdup(ppufile.getstring);
+         { only used for external Objective-C classes/protocols }
+         if (objextname^='') then
+           stringdispose(objextname);
          symtable:=tObjectSymtable.create(self,objrealname^,0);
          tObjectSymtable(symtable).datasize:=ppufile.getaint;
          tObjectSymtable(symtable).fieldalignment:=ppufile.getbyte;
@@ -3761,7 +3780,7 @@ implementation
            end;
 
          { load implemented interfaces }
-         if objecttype in [odt_class,odt_interfacecorba] then
+         if objecttype in [odt_class,odt_interfacecorba,odt_objcclass] then
            begin
              ImplementedInterfaces:=TFPObjectList.Create(true);
              implintfcount:=ppufile.getlongint;
@@ -3792,6 +3811,10 @@ implementation
             (objecttype=odt_interfacecom) and
             (objname^='IUNKNOWN') then
            interface_iunknown:=self;
+         if (childof=nil) and
+            (objecttype=odt_objcclass) and
+            (objname^='PROTOCOL') then
+           objc_protocoltype:=self;
          writing_class_record_dbginfo:=false;
        end;
 
@@ -3805,6 +3828,7 @@ implementation
            end;
          stringdispose(objname);
          stringdispose(objrealname);
+         stringdispose(objextname);
          stringdispose(iidstr);
          if assigned(ImplementedInterfaces) then
            begin
@@ -3843,6 +3867,8 @@ implementation
           tobjectdef(result).objname:=stringdup(objname^);
         if assigned(objrealname) then
           tobjectdef(result).objrealname:=stringdup(objrealname^);
+        if assigned(objextname) then
+          tobjectdef(result).objextname:=stringdup(objextname^);
         tobjectdef(result).objectoptions:=objectoptions;
         include(tobjectdef(result).defoptions,df_copied_def);
         tobjectdef(result).vmt_offset:=vmt_offset;
@@ -3875,6 +3901,10 @@ implementation
          inherited ppuwrite(ppufile);
          ppufile.putbyte(byte(objecttype));
          ppufile.putstring(objrealname^);
+         if assigned(objextname) then
+           ppufile.putstring(objextname^)
+         else
+           ppufile.putstring('');
          ppufile.putaint(tObjectSymtable(symtable).datasize);
          ppufile.putbyte(tObjectSymtable(symtable).fieldalignment);
          ppufile.putbyte(tObjectSymtable(symtable).recordalignment);
@@ -4113,7 +4143,7 @@ implementation
 
    procedure tobjectdef.check_forwards;
      begin
-        if not(objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface]) then
+        if not(objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcprotocol]) then
           tstoredsymtable(symtable).check_forwards;
         if (oo_is_forward in objectoptions) then
           begin
@@ -4179,7 +4209,7 @@ implementation
 
     function tobjectdef.size : aint;
       begin
-        if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass] then
+        if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol] then
           result:=sizeof(pint)
         else
           result:=tObjectSymtable(symtable).datasize;
@@ -4188,7 +4218,7 @@ implementation
 
     function tobjectdef.alignment:shortint;
       begin
-        if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass] then
+        if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol] then
           alignment:=sizeof(pint)
         else
           alignment:=tObjectSymtable(symtable).recordalignment;
@@ -4202,7 +4232,8 @@ implementation
         odt_class:
           { the +2*sizeof(pint) is size and -size }
           vmtmethodoffset:=(index+10)*sizeof(pint)+2*sizeof(pint);
-        odt_objcclass:
+        odt_objcclass,
+        odt_objcprotocol:
           vmtmethodoffset:=0;
         odt_interfacecom,odt_interfacecorba:
           vmtmethodoffset:=index*sizeof(pint);
@@ -4237,7 +4268,8 @@ implementation
             odt_object:
               needs_inittable:=tObjectSymtable(symtable).needs_init_final;
             odt_cppclass,
-            odt_objcclass:
+            odt_objcclass,
+            odt_objcprotocol:
               needs_inittable:=false;
             else
               internalerror(200108267);
@@ -4346,6 +4378,29 @@ implementation
       end;
 
 
+    procedure check_and_finish_msg(data: tobject; arg: pointer);
+      var
+        def: tdef absolute data;
+      begin
+        if (def.typ = procdef) then
+          begin
+            { we have to wait until now to set the mangled name because it
+              depends on the (possibly external) class name, which is defined
+              at the very end.  }
+            if (po_msgstr in tprocdef(def).procoptions) then
+              tprocdef(def).setmangledname(tprocdef(def).objcmangledname)
+            else
+              MessagePos(tprocdef(def).fileinfo,parser_e_objc_requires_msgstr)
+          end;
+      end;
+
+
+    procedure tobjectdef.check_and_finish_messages;
+      begin
+        self.symtable.DefList.foreachcall(@check_and_finish_msg,nil);
+      end;
+
+
 {****************************************************************************
                              TImplementedInterface
 ****************************************************************************}
@@ -4644,6 +4699,24 @@ implementation
       end;
 
 
+    function is_objcprotocol(def: tdef): boolean;
+      begin
+        result:=
+          assigned(def) and
+          (def.typ=objectdef) and
+          (tobjectdef(def).objecttype=odt_objcprotocol);
+      end;
+
+
+    function is_objc_class_or_protocol(def: tdef): boolean;
+      begin
+         result:=
+           assigned(def) and
+           (def.typ=objectdef) and
+           (tobjectdef(def).objecttype in [odt_objcclass,odt_objcprotocol]);
+      end;
+
+
     function is_class_or_interface(def: tdef): boolean;
       begin
         result:=
@@ -4653,6 +4726,15 @@ implementation
       end;
 
 
+    function is_class_or_interface_or_objc(def: tdef): boolean;
+      begin
+        result:=
+          assigned(def) and
+          (def.typ=objectdef) and
+          (tobjectdef(def).objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_objcclass,odt_objcprotocol]);
+      end;
+
+
     function is_class_or_interface_or_object(def: tdef): boolean;
       begin
         result:=
@@ -4671,6 +4753,15 @@ implementation
       end;
 
 
+    function is_class_or_interface_or_dispinterface_or_objc(def: tdef): boolean;
+      begin
+        result:=
+          assigned(def) and
+          (def.typ=objectdef) and
+          (tobjectdef(def).objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol]);
+      end;
+
+
     procedure loadobjctypes;
       begin
         objc_metaclasstype:=tpointerdef(search_named_unit_globaltype('OBJC1','POBJC_CLASS').typedef);

compiler/symtable.pas

@@ -195,7 +195,7 @@ interface
     function  searchsym(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
     function  searchsym_type(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
     function  searchsym_in_module(pm:pointer;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
-    function searchsym_in_named_module(const unitname, symname: TIDString; out srsym: tsym; out srsymtable: tsymtable): boolean;
+    function  searchsym_in_named_module(const unitname, symname: TIDString; out srsym: tsym; out srsymtable: tsymtable): boolean;
     function  searchsym_in_class(classh,contextclassh:tobjectdef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
     function  searchsym_in_class_by_msgint(classh:tobjectdef;msgid:longint;out srdef : tdef;out srsym:tsym;out srsymtable:TSymtable):boolean;
     function  searchsym_in_class_by_msgstr(classh:tobjectdef;const s:string;out srsym:tsym;out srsymtable:TSymtable):boolean;

compiler/tokens.pas

@@ -205,12 +205,14 @@ type
     _LOCATION,
     _MWPASCAL,
     _OPERATOR,
+    _OPTIONAL,
     _OVERLOAD,
     _OVERRIDE,
     _PLATFORM,
     _PROPERTY,
     _READONLY,
     _REGISTER,
+    _REQUIRED,
     _REQUIRES,
     _RESIDENT,
     _SAFECALL,
@@ -244,6 +246,7 @@ type
     _EXPERIMENTAL,
     _FINALIZATION,
     _NOSTACKFRAME,
+    _OBJCPROTOCOL,
     _WEAKEXTERNAL,
     _DISPINTERFACE,
     _UNIMPLEMENTED,
@@ -458,12 +461,14 @@ const
       (str:'LOCATION'      ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'MWPASCAL'      ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'OPERATOR'      ;special:false;keyword:m_fpc;op:NOTOKEN),
+      (str:'OPTIONAL'      ;special:false;keyword:m_none;op:NOTOKEN), { optional methods in an Objective-C protocol }
       (str:'OVERLOAD'      ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'OVERRIDE'      ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'PLATFORM'      ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'PROPERTY'      ;special:false;keyword:m_property;op:NOTOKEN),
       (str:'READONLY'      ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'REGISTER'      ;special:false;keyword:m_none;op:NOTOKEN),
+      (str:'REQUIRED'      ;special:false;keyword:m_none;op:NOTOKEN), { required methods in an Objective-C protocol }
       (str:'REQUIRES'      ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'RESIDENT'      ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'SAFECALL'      ;special:false;keyword:m_none;op:NOTOKEN),
@@ -497,6 +502,7 @@ const
       (str:'EXPERIMENTAL'  ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'FINALIZATION'  ;special:false;keyword:m_initfinal;op:NOTOKEN),
       (str:'NOSTACKFRAME'  ;special:false;keyword:m_none;op:NOTOKEN),
+      (str:'OBJCPROTOCOL'  ;special:false;keyword:m_objectivec1;op:NOTOKEN), { Objective-C protocol }
       (str:'WEAKEXTERNAL'  ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'DISPINTERFACE' ;special:false;keyword:m_class;op:NOTOKEN),
       (str:'UNIMPLEMENTED' ;special:false;keyword:m_all;op:NOTOKEN),

rtl/inc/objc1.pp

@@ -44,6 +44,7 @@ type
     _class: pobjc_class;
   end;
   id = ^objc_object;
+  pobjc_object = id;
 
   _fpc_objc_sel_type = record
   end;

rtl/inc/objcbase.pp

@@ -33,15 +33,15 @@ type
   NSCoder = objcclass; external;
 }
 
-  NSObject = objcclass
-   strict protected
-    isa: pobjc_class;
-   public
-    { NSObject protocol }
+  Protocol = objcclass
+  end; external;
+
+  NSObjectProtocol = objcprotocol
     function isEqual_(obj: id): boolean; message 'isEqual:';
     function hash: cuint; message 'hash';
-// implemented as class method instead?
-//     function superclass: pobjc_class;
+
+    function superclass: pobjc_class; message 'superclass';
+    function _class: pobjc_class; message 'class';
     { "self" is both a hidden parameter to each method, and a method of
       NSObject and thereby of each subclass as well
     }
@@ -56,8 +56,7 @@ type
 
     function isKindOfClass_(aClass: pobjc_class): boolean; message 'isKindOfClass:';
     function isMemberOfClass_(aClass: pobjc_class): boolean; message 'isMemberOfClass:';
-// implemented as class method instead?
-//     function conformsToProtocol(aProtocol: pobjc_protocal): boolean;
+    function conformsToProtocol_(aProtocol: Protocol): boolean; message 'conformsToProtocol:';
 
     function respondsToSelector_(aSelector: SEL): boolean; message 'respondsToSelector:';
 
@@ -66,8 +65,51 @@ type
     function autorelease: id; message 'autorelease';
     function retainCount: cint; message 'retainCount';
 
-// implemented as class method instead?
-//     function description: NSString;
+     function description: {NSString} id; message 'description';
+  end; external name 'NSObject';
+
+
+  NSObject = objcclass(NSObjectProtocol)
+   strict protected
+    isa: pobjc_class;
+   public
+    { NSObjectProtocol -- the message names are copied from the protocol
+      definition by the compiler, but you can still repeat them if you want }
+    function isEqual_(obj: id): boolean;
+    function hash: cuint;
+
+    function superclass: pobjc_class;
+    function _class: pobjc_class;
+    { "self" is both a hidden parameter to each method, and a method of
+      NSObject and thereby of each subclass as well
+    }
+    function self: id;
+    function zone: id; { NSZone }
+
+    function performSelector_(aSelector: SEL): id;
+    function performSelector_withObject_(aSelector: SEL; obj: id): id;
+    function performSelector_withObject_withObject(aSelector: SEL; obj1, obj2: id): id;
+
+    function isProxy: boolean;
+
+    function isKindOfClass_(aClass: pobjc_class): boolean;
+    function isMemberOfClass_(aClass: pobjc_class): boolean;
+    function conformsToProtocol_(aProtocol: Protocol): boolean;
+
+    function respondsToSelector_(aSelector: SEL): boolean;
+
+    function retain: id;
+    procedure release; { oneway }
+    function autorelease: id;
+    function retainCount: cint;
+
+    function description: {NSString} id;
+
+    { NSObject class }
+    { "class" prefix to method name to avoid name collision with NSObjectProtocol }
+    class function classIsEqual_(obj: id): boolean; message 'isEqual:';
+    { "class" prefix to method name to avoid name collision with NSObjectProtocol }
+    class function classHash: cuint; message 'hash';
 
     { NSObject methods }
 
@@ -80,6 +122,7 @@ type
     class function allocWithZone_(_zone: id {NSZone}): id; message 'allocWithZone:';
     class function alloc: id; message 'alloc';
     procedure dealloc; message 'dealloc';
+
     { if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_4 }
     procedure finalize; message 'finalize';
     { endif }
@@ -90,11 +133,14 @@ type
     class function copyWithZone_(_zone: id {NSZone}): id; message 'copyWithZone:';
     class function mutableCopyWithZone_(_zone: id {NSZone}): id; message 'mutableCopyWithZone:';
 
-    class function superclass: pobjc_class; message 'superclass';
-    class function _class: pobjc_class; message 'class';
+    { "class" prefix to method name to avoid name collision with NSObjectProtocol }
+    class function classSuperclass: pobjc_class; message 'superclass';
+    { "class" prefix to method name to avoid name collision with NSObjectProtocol }
+    class function classClass: pobjc_class; message 'class';
     class procedure poseAsClass_(aClass: pobjc_class); message 'poseAsClass:';
     class function instancesRespondToSelector_(aSelector: SEL): boolean; message 'instancesRespondToSelector:';
-    class function conformsToProtocol_(aProtocol: pobjc_protocal): boolean; message 'conformsToProtocol:';
+    { "class" prefix to method name to avoid name collision with NSObjectProtocol }
+    class function classConformsToProtocol_(aProtocol: Protocol): boolean; message 'conformsToProtocol:';
     function methodForSelector_(aSelector: SEL): IMP; message 'methodForSelector:';
     class function instanceMethodForSelector_(aSelector: SEL): IMP; message 'instanceMethodForSelector:';
     class function version: cint; message 'version';
@@ -103,7 +149,7 @@ type
     procedure forwardInvocation_(anInvocation: id {NSInvocation}); message 'forwardInvocation:';
     function methodSignatureForSelector_(aSelector: SEL): id {NSMethodSignature}; message 'methodSignatureForSelector:';
 
-    class function description: id {NSString}; message 'description';
+    class function classDescription: id {NSString}; message 'description';
 
     function classForCoder: pobjc_class; message 'classForCoder';
     function replacementObjectForCoder_(aCoder: id {NSCoder}): id; message 'replacementObjectForCoder:';

tests/test/tobjc3.pp

@@ -11,5 +11,16 @@ type
   ta = objcclass
   end; external;
 
+var
+  a: ta;
+  b: nsobject;
+  c: id;
 begin
+  { avoid hints about unused types/variables/units }
+  a:=nil;
+  if (a<>nil) then
+    exit;
+  c:=nil;
+  b:=c;
+  b.isEqual_(b);
 end.

tests/test/tobjc4.pp

@@ -7,7 +7,7 @@
 type
   ta = objcclass
     { no constructors in Objective-C }
-    constructor create;
+    constructor create; message 'create';
   end; external;
 
 begin

tests/test/tobjc4a.pp

@@ -7,7 +7,7 @@
 type
   ta = objcclass
     { no destructors in Objective-C }
-    destructor done;
+    destructor done; message 'done';
   end; external;
 
 begin

tests/test/tobjc5.pp

@@ -0,0 +1,14 @@
+{ %fail }
+{ %target=darwin }
+{ %cpu=powerpc,i386 }
+
+{$modeswitch objectivec1}
+
+type
+  ta = objcclass
+    { needs message name specification }
+    procedure test; 
+  end; external;
+
+begin
+end.

tests/test/tobjc5a.pp

@@ -0,0 +1,14 @@
+{ %fail }
+{ %target=darwin }
+{ %cpu=powerpc,i386 }
+
+{$modeswitch objectivec1}
+
+type
+  ta = objcprotocol
+    { needs message name specification }
+    procedure test; 
+  end; external;
+
+begin
+end.

tests/test/tobjc6.pp

@@ -0,0 +1,14 @@
+{ %target=darwin }
+{ %cpu=powerpc,i386 }
+
+{$mode objfpc}
+{$modeswitch objectivec1}
+
+type
+  ta = objcclass;
+
+  ta = objcclass
+  end;
+
+begin
+end.

tests/test/tobjc7.pp

@@ -0,0 +1,23 @@
+{ %target=darwin }
+{ %cpu=powerpc,i386 }
+{ %norun }
+{ %recompile }
+
+{$mode objfpc}
+{$modeswitch objectivec1}
+
+uses
+  uobjc7;
+
+type
+  tobjcclass = objcclass(tobjcprot)
+    procedure isrequired;
+    procedure alsorequired;
+{ fake external name to avoid linking errors once we
+  add external references in all cases to ensure that
+  all necessary libraries are linked, like gcc does }
+  end; external name 'NSObject'; 
+
+
+begin
+end.

tests/test/tobjc7a.pp

@@ -0,0 +1,22 @@
+{ %target=darwin }
+{ %cpu=powerpc,i386 }
+{ %fail }
+
+
+{$mode objfpc}
+{$modeswitch objectivec1}
+
+uses
+  uobjc7;
+
+type
+  tobjcclass = objcclass(tobjcprot)
+    procedure alsorequired;
+{ fake external name to avoid linking errors once we
+  add external references in all cases to ensure that
+  all necessary libraries are linked, like gcc does }
+  end; external name 'NSObject'; 
+
+
+begin
+end.

tests/test/tobjc7b.pp

@@ -0,0 +1,21 @@
+{ %target=darwin }
+{ %cpu=powerpc,i386 }
+{ %fail }
+
+{$mode objfpc}
+{$modeswitch objectivec1}
+
+uses
+  uobjc7;
+
+type
+  tobjcclass = objcclass(tobjcprot)
+    procedure isrequired;
+{ fake external name to avoid linking errors once we
+  add external references in all cases to ensure that
+  all necessary libraries are linked, like gcc does }
+  end; external name 'NSObject'; 
+
+
+begin
+end.

tests/test/tobjc7c.pp

@@ -0,0 +1,23 @@
+{ %target=darwin }
+{ %cpu=powerpc,i386 }
+{ %norun }
+
+{$mode objfpc}
+{$modeswitch objectivec1}
+
+uses
+  uobjc7;
+
+type
+  tobjcclass = objcclass(tobjcprot)
+    procedure isrequired;
+    procedure isoptional;
+    procedure alsorequired;
+{ fake external name to avoid linking errors once we
+  add external references in all cases to ensure that
+  all necessary libraries are linked, like gcc does }
+  end; external name 'NSObject'; 
+
+
+begin
+end.

tests/test/tobjc8.pp

@@ -0,0 +1,24 @@
+{ %target=darwin }
+{ %cpu=powerpc,i386 }
+{ %opt=-vh -Seh }
+{ %fail }
+
+{$mode objfpc}
+{$modeswitch objectivec1}
+
+uses
+  ctypes;
+
+type
+  TMyTestClass = objcclass(NSObject)
+    { should give a hint because of a missing 'override' }
+    function hash: cuint;
+  end; external name 'NSZone';
+
+var
+  a: id;
+begin
+  { avoid warnings/hints about unused types/variables }
+  a:=TMyTestClass.alloc;
+  tmytestclass(a).Retain;
+end.

tests/test/tobjc8a.pp

@@ -0,0 +1,24 @@
+{ %target=darwin }
+{ %cpu=powerpc,i386 }
+{ %opt=-vh -Seh }
+{ %norun }
+
+{$mode objfpc}
+{$modeswitch objectivec1}
+
+uses
+  ctypes;
+
+type
+  TMyTestClass = objcclass(NSObject)
+    { should not give a hint, since we have 'override' }
+    function hash: cuint; override;
+  end; external name 'NSZone';
+
+var
+  a: id;
+begin
+  { avoid warnings/hints about unused types/variables }
+  a:=TMyTestClass.alloc;
+  tmytestclass(a).Retain;
+end.

tests/test/tobjc9.pp

@@ -0,0 +1,16 @@
+{ %target=darwin }
+{ %cpu=powerpc,i386 }
+{ %norun }
+
+{$mode objfpc}
+{$modeswitch objectivec1}
+
+uses
+  ctypes;
+
+var
+  a: NSObjectProtocol;
+  b: NSObject;
+begin
+  a:=b;
+end.

tests/test/tobjc9a.pp

@@ -0,0 +1,16 @@
+{ %target=darwin }
+{ %cpu=powerpc,i386 }
+{ %fail }
+
+{$mode objfpc}
+{$modeswitch objectivec1}
+
+uses
+  ctypes;
+
+var
+  a: NSObjectProtocol;
+  b: NSObject;
+begin
+  b:=a;
+end.

tests/test/tobjc9b.pp

@@ -0,0 +1,16 @@
+{ %target=darwin }
+{ %cpu=powerpc,i386 }
+{ %norun }
+
+{$mode objfpc}
+{$modeswitch objectivec1}
+
+uses
+  ctypes;
+
+var
+  a: NSObjectProtocol;
+  b: NSObject;
+begin
+  a:=b;
+end.