* allow any kind of fields in Object Pascal classes that are passed to

    Objective-C methods or which are fields of Objective-C classes (since they
    are basically opaque to the Objective-C runtime) + fixed tobjc11 so it
    expects classes to be encoded as opaque types
  * give a proper error message when using illegal field/parameter types in
    Objective-C classes/methods instead of an internal error (only checked
    during rtti generation rather than during parsing, because during parsing
    some types may still be forwarddefs)
  * split objcutil in objcdef and objcutil, with objcdef depending only on
    the symtable so it can be used in symdef

git-svn-id: trunk@14838 -

.gitattributes

@@ -326,6 +326,7 @@ compiler/nopt.pas svneol=native#text/plain
 compiler/nset.pas svneol=native#text/plain
 compiler/nstate.pas svneol=native#text/plain
 compiler/nutils.pas svneol=native#text/plain
+compiler/objcdef.pas svneol=native#text/plain
 compiler/objcgutl.pas svneol=native#text/plain
 compiler/objcutil.pas svneol=native#text/plain
 compiler/ogbase.pas svneol=native#text/plain
@@ -9108,6 +9109,9 @@ tests/test/tobjc30a.pp svneol=native#text/plain
 tests/test/tobjc30b.pp svneol=native#text/plain
 tests/test/tobjc30c.pp svneol=native#text/plain
 tests/test/tobjc31.pp svneol=native#text/plain
+tests/test/tobjc32.pp svneol=native#text/plain
+tests/test/tobjc32a.pp svneol=native#text/plain
+tests/test/tobjc32b.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

compiler/ninl.pas

@@ -87,7 +87,7 @@ implementation
       symconst,symdef,symsym,symtable,paramgr,defutil,
       pass_1,
       ncal,ncon,ncnv,nadd,nld,nbas,nflw,nmem,nmat,nutils,
-      nobjc,objcutil,
+      nobjc,objcdef,
       cgbase,procinfo
       ;
 

compiler/objcdef.pas

@@ -0,0 +1,651 @@
+{
+    Copyright (c) 2010 by Jonas Maebe
+
+    This unit implements some Objective-C type helper routines (minimal
+    unit dependencies, usable in symdef).
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+
+{$i fpcdefs.inc}
+
+unit objcdef;
+
+interface
+
+    uses
+      node,
+      symtype;
+
+    { The internals of Objective-C's @encode() functionality: encode a
+      type into the internal format used by the run time. Returns false
+      if a type is not representable by the Objective-C run time, and in
+      that case also the failing definition.  }
+    function objctryencodetype(def: tdef; out encodedtype: ansistring; out founderror: tdef): boolean;
+
+    { Check whether a type can be used in an Objective-C method
+      signature or field declaration.  }
+    function objcchecktype(def: tdef; out founderror: tdef): boolean;
+
+    { add type info for def at the end of encodedstr. recordinfostate influences
+      whether a record-style type will be fully encoded, or just using its
+      type name. bpacked indicates whether a record/array is bitpacked.
+      On error, founderror contains the type that triggered the error. }
+    type
+      trecordinfostate = (ris_initial, ris_afterpointer, ris_dontprint);
+
+    function addencodedtype(def: tdef; recordinfostate: trecordinfostate; bpacked: boolean; var encodedstr: ansistring; out founderror: tdef): boolean;
+
+implementation
+
+  uses
+    globtype,
+    cutils,cclasses,
+    verbose,systems,
+    symtable,symconst,symsym,symdef,
+    defutil,paramgr;
+
+{******************************************************************
+                          Type encoding
+*******************************************************************}
+
+    function encoderecst(const recname: ansistring; recst: tabstractrecordsymtable; var encodedstr: ansistring; out founderror: tdef): boolean;
+      var
+        variantstarts: tfplist;
+        i, varindex: longint;
+        field,
+        firstfield: tfieldvarsym;
+        firstfieldvariant,
+        bpacked: boolean;
+      begin
+        result:=false;
+        bpacked:=recst.fieldalignment=bit_alignment;
+        { Is the first field already the start of a variant?  }
+        firstfield:=nil;
+        firstfieldvariant:=false;
+        for i:=0 to recst.symlist.count-1 do
+          begin
+            if (tsym(recst.symlist[i]).typ<>fieldvarsym) then
+              continue;
+            field:=tfieldvarsym(recst.symlist[i]);
+            if not assigned(firstfield) then
+              firstfield:=field
+            else if (vo_is_first_field in field.varoptions) then
+              begin
+                if (field.fieldoffset=firstfield.fieldoffset) then
+                  firstfieldvariant:=true;
+              end;
+          end;
+        variantstarts:=tfplist.create;
+        encodedstr:=encodedstr+'{'+recname+'=';
+        for i:=0 to recst.symlist.count-1 do
+          begin
+            if (tsym(recst.symlist[i]).typ<>fieldvarsym) then
+              continue;
+
+            field:=tfieldvarsym(recst.symlist[i]);
+            { start of a variant part? }
+            if ((field=firstfield) and
+                firstfieldvariant) or
+               ((field<>firstfield) and
+                (vo_is_first_field in field.varoptions)) then
+              begin
+                varindex:=variantstarts.count-1;
+                if (varindex=-1) or
+                   (tfieldvarsym(variantstarts[varindex]).fieldoffset<field.fieldoffset) then
+                  begin
+                    { new, more deeply nested variant }
+                    encodedstr:=encodedstr+'(?={?=';
+                    variantstarts.add(field);
+                  end
+                else
+                  begin
+                    { close existing nested variants if any }
+                    while (varindex>=0) and
+                          (tfieldvarsym(variantstarts[varindex]).fieldoffset>field.fieldoffset) do
+                      begin
+                        { close more deeply nested variants }
+                        encodedstr:=encodedstr+'})';
+                        dec(varindex);
+                      end;
+                    if (varindex<0) then
+                      internalerror(2009081805);
+                    if (tfieldvarsym(variantstarts[varindex]).fieldoffset<>field.fieldoffset) then
+                      internalerror(2009081804);
+
+                    { variant at the same level as a previous one }
+                    variantstarts.count:=varindex+1;
+                    { No need to add this field, it has the same offset as the
+                      previous one at this position.  }
+                    if tfieldvarsym(variantstarts[varindex]).fieldoffset<>field.fieldoffset then
+                      internalerror(2009081601);
+                    { close previous variant sub-part and start new one }
+                    encodedstr:=encodedstr+'}{?=';
+                  end
+              end;
+            if not addencodedtype(field.vardef,ris_afterpointer,bpacked,encodedstr,founderror) then
+              exit;
+          end;
+        for i:=0 to variantstarts.count-1 do
+          encodedstr:=encodedstr+'})';
+        variantstarts.free;
+        encodedstr:=encodedstr+'}';
+        result:=true
+      end;
+
+
+    function addencodedtype(def: tdef; recordinfostate: trecordinfostate; bpacked: boolean; var encodedstr: ansistring; out founderror: tdef): boolean;
+      var
+        recname: ansistring;
+        recdef: trecorddef;
+        objdef: tobjectdef;
+        len: aint;
+        c: char;
+        newstate: trecordinfostate;
+        addrpara: boolean;
+      begin
+        result:=true;
+        case def.typ of
+          stringdef :
+            begin
+              case tstringdef(def).stringtype of
+                st_shortstring:
+                  { include length byte }
+                  encodedstr:=encodedstr+'['+tostr(tstringdef(def).len+1)+'C]';
+                else
+                  { While we could handle refcounted Pascal strings correctly
+                    when such methods are called from Pascal code, things would
+                    completely break down if they were called from Objective-C
+                    code/reflection since the necessary refcount helper calls
+                    would be missing on the caller side (unless we'd
+                    automatically generate wrappers).  }
+                  result:=false;
+              end;
+            end;
+          enumdef,
+          orddef :
+            begin
+              if bpacked and
+                 not is_void(def) then
+                encodedstr:=encodedstr+'b'+tostr(def.packedbitsize)
+              else
+                begin
+                  if is_void(def) then
+                    c:='v'
+                  { in gcc, sizeof(_Bool) = sizeof(char) }
+                  else if is_boolean(def) and
+                          (def.size=1) then
+                    c:='B'
+                  else
+                    begin
+                      case def.size of
+                        1:
+                          c:='c';
+                        2:
+                          c:='s';
+                        4:
+                          c:='i';
+                        8:
+                          c:='q';
+                        else
+                          internalerror(2009081502);
+                      end;
+                      if not is_signed(def) then
+                        c:=upcase(c);
+                    end;
+                  encodedstr:=encodedstr+c;
+                end;
+            end;
+          pointerdef :
+            begin
+              if is_pchar(def) then
+                encodedstr:=encodedstr+'*'
+              else if (def=objc_idtype) then
+                encodedstr:=encodedstr+'@'
+              else if (def=objc_seltype) then
+                encodedstr:=encodedstr+':'
+              else if (def=objc_metaclasstype) then
+                encodedstr:=encodedstr+'#'
+              else
+                begin
+                  encodedstr:=encodedstr+'^';
+                  newstate:=recordinfostate;
+                  if (recordinfostate<ris_dontprint) then
+                    newstate:=succ(newstate);
+                  if not addencodedtype(tpointerdef(def).pointeddef,newstate,false,encodedstr,founderror) then
+                    begin
+                      result:=false;
+                      { report the exact (nested) error defintion }
+                      exit;
+                    end;
+                end;
+            end;
+          floatdef :
+            begin
+              case tfloatdef(def).floattype of
+                s32real:
+                  c:='f';
+                s64real:
+                  c:='d';
+                else
+                  begin
+                    c:='!';
+                    result:=false;
+                  end;
+              end;
+              encodedstr:=encodedstr+c;
+            end;
+          filedef :
+            result:=false;
+          recorddef :
+            begin
+              if assigned(def.typesym) then
+                recname:=def.typename
+              else
+                recname:='?';
+
+              if (recordinfostate<>ris_dontprint) then
+                begin
+                  if not encoderecst(recname,tabstractrecordsymtable(trecorddef(def).symtable),encodedstr,founderror) then
+                    begin
+                      result:=false;
+                      { report the exact (nested) error defintion }
+                      exit;
+                    end
+                end
+              else
+                encodedstr:=encodedstr+'{'+recname+'}'
+            end;
+          variantdef :
+            begin
+              recdef:=trecorddef(search_system_type('TVARDATA').typedef);
+              if (recordinfostate<>ris_dontprint) then
+                begin
+                  if not encoderecst(recdef.typename,tabstractrecordsymtable(recdef.symtable),encodedstr,founderror) then
+                    begin
+                      result:=false;
+                      { report the exact (nested) error defintion }
+                      exit;
+                    end
+                end
+              else
+                encodedstr:=encodedstr+'{'+recdef.typename+'}';
+            end;
+          classrefdef :
+            begin
+              encodedstr:=encodedstr+'^';
+              newstate:=recordinfostate;
+              if (recordinfostate<>ris_dontprint) then
+                newstate:=succ(newstate);
+              if is_objcclassref(def) then
+                begin
+                  objdef:=tobjectdef(tclassrefdef(def).pointeddef);
+                  if (newstate<>ris_dontprint) then
+                    { anonymous (objc)class definitions do not exist }
+                    begin
+                      if not encoderecst(objdef.objextname^,tabstractrecordsymtable(objdef.symtable),encodedstr,founderror) then
+                        { The fields of an Objective-C class should always be
+                          encodeable.  }
+                        internalerror(2009081702);
+                    end
+                  else
+                    encodedstr:=encodedstr+'{'+objdef.objextname^+'}'
+                end
+              { Object Pascal classrefdefs point to a vmt, not really useful
+                to completely write those here.  I'm not even sure what the
+                Objective-C run time uses this information for, since in C you
+                can have forward struct definitions so not all structs passed
+                to functions can be written out here either -> treat
+                classrefdefs the same as such forward-defined structs.  }
+              else
+                begin
+                  if assigned(def.typesym) then
+                    recname:=def.typename
+                  else
+                    recname:='?';
+                  encodedstr:=encodedstr+'{'+recname;
+                  if (newstate<>ris_dontprint) then
+                    encodedstr:=encodedstr+'=';
+                  encodedstr:=encodedstr+'}'
+                end;
+            end;
+          setdef :
+            begin
+              addrpara:=paramanager.push_addr_param(vs_value,def,pocall_cdecl);
+              if not addrpara then
+                { encode as an record, they are always passed by value in C.  }
+                encodedstr:=encodedstr+'{?=';
+              { Encode the set itself as an array. Without an encompassing
+                record, these are always passed by reference in C.  }
+              encodedstr:=encodedstr+'['+tostr(def.size)+'C]';
+              if not addrpara then
+                encodedstr:=encodedstr+'}';
+            end;
+          formaldef :
+            begin
+              encodedstr:=encodedstr+'^v';
+            end;
+          arraydef :
+            begin
+              if is_array_of_const(def) then
+                { do nothing, varargs are ignored in signatures }
+              else if is_special_array(def) then
+                result:=false
+              else
+                begin
+                  len:=tarraydef(def).highrange-tarraydef(def).lowrange+1;
+                  if is_packed_array(def) then
+                    begin
+                      { convert from bits to bytes for bitpacked arrays }
+                      len:=(len+7) div 8;
+                      { and encode as plain array of bytes }
+                      encodedstr:=encodedstr+'['+tostr(len)+'C]';
+                    end
+                  else
+                    begin
+                      encodedstr:=encodedstr+'['+tostr(len);
+                      { Embedded structured types in the array are printed
+                        in full regardless of the current recordinfostate.  }
+                      if not addencodedtype(tarraydef(def).elementdef,ris_initial,false,encodedstr,founderror) then
+                        begin
+                          result:=false;
+                          { report the exact (nested) error defintion }
+                          exit;
+                        end;
+                      encodedstr:=encodedstr+']';
+                    end;
+                end;
+            end;
+          procvardef :
+            encodedstr:=encodedstr+'^?';
+          objectdef :
+            case tobjectdef(def).objecttype of
+              odt_class,
+              odt_object,
+              odt_cppclass:
+                begin
+                  newstate:=recordinfostate;
+                  { implicit pointer for classes }
+                  if (tobjectdef(def).objecttype=odt_class) then
+                    begin
+                      encodedstr:=encodedstr+'^';
+                      { make all classes opaque, so even if they contain a
+                        reference-counted field there is no problem. Since a
+                        "dereferenced class" object does not exist, this should
+                        not cause problems }
+                      newstate:=ris_dontprint;
+                    end;
+                  if newstate<>ris_dontprint then
+                    begin
+                      if not encoderecst(def.typename,tabstractrecordsymtable(tobjectdef(def).symtable),encodedstr,founderror) then
+                        begin
+                          result:=false;
+                          { report the exact (nested) error defintion }
+                          exit;
+                        end
+                    end
+                  else
+                    encodedstr:=encodedstr+'{'+def.typename+'}'
+                end;
+              odt_interfacecom,
+              odt_interfacecom_property,
+              odt_interfacecom_function,
+              odt_dispinterface:
+                result:=false;
+              odt_interfacecorba:
+                encodedstr:=encodedstr+'^{'+def.typename+'=}';
+              { In Objective-C, the actual types of class instances are
+                NSObject* etc, and those are encoded as "@". In FPC, to keep
+                the similarity with Delphi-style Object Pascal, the type is
+                NSObject and the pointer is implicit. Objective-C's "NSObject"
+                has "class of NSObject" as equivalent here.  }
+              odt_objcclass,
+              odt_objcprotocol:
+                encodedstr:=encodedstr+'@';
+              else
+                internalerror(2009081509);
+            end;
+          undefineddef,
+          errordef :
+            result:=false;
+          procdef :
+            { must be done via objcencodemethod() }
+            internalerror(2009081511);
+        else
+          internalerror(2009150812);
+        end;
+        if not result then
+          founderror:=def;
+      end;
+
+
+    function objctryencodetype(def: tdef; out encodedtype: ansistring; out founderror: tdef): boolean;
+      begin
+        result:=addencodedtype(def,ris_initial,false,encodedtype,founderror);
+      end;
+
+
+{******************************************************************
+                    ObjC type validity checking
+*******************************************************************}
+
+    function objcdochecktype(def: tdef; recordinfostate: trecordinfostate; out founderror: tdef): boolean; forward;
+
+    function checkrecsttype(recst: tabstractrecordsymtable; recordinfostate: trecordinfostate; out founderror: tdef): boolean;
+      var
+        i: longint;
+        field: tfieldvarsym;
+        newstate: trecordinfostate;
+      begin
+        result:=false;
+        newstate:=recordinfostate;
+        { Although we never have to print the type info for nested
+          records, check them anyway in case we're not after a pointer
+          since if such records contain refcounted types then they
+          can cause just as much trouble as if they were a simple
+          refcounted field.  }
+        if (newstate=ris_afterpointer) then
+          newstate:=ris_dontprint;
+        for i:=0 to recst.symlist.count-1 do
+          begin
+            if (tsym(recst.symlist[i]).typ<>fieldvarsym) then
+              continue;
+
+            field:=tfieldvarsym(recst.symlist[i]);
+            if not objcdochecktype(field.vardef,newstate,founderror) then
+              exit;
+          end;
+        result:=true
+      end;
+
+
+    function objcdochecktype(def: tdef; recordinfostate: trecordinfostate; out founderror: tdef): boolean;
+      var
+        recdef: trecorddef;
+        objdef: tobjectdef;
+        newstate: trecordinfostate;
+      begin
+        result:=true;
+        case def.typ of
+          stringdef :
+            begin
+              case tstringdef(def).stringtype of
+                st_shortstring:
+                  ;
+                else
+                  { While we could handle refcounted Pascal strings correctly
+                    when such methods are called from Pascal code, things would
+                    completely break down if they were called from Objective-C
+                    code/reflection since the necessary refcount helper calls
+                    would be missing on the caller side (unless we'd
+                    automatically generate wrappers).  }
+                  result:=false;
+              end;
+            end;
+          enumdef,
+          orddef :
+            ;
+          pointerdef :
+            begin
+              newstate:=recordinfostate;
+              if (recordinfostate<ris_dontprint) then
+                newstate:=succ(newstate);
+              if not objcdochecktype(tpointerdef(def).pointeddef,newstate,founderror) then
+                begin
+                  result:=false;
+                  { report the exact (nested) error defintion }
+                  exit;
+                end;
+            end;
+          floatdef :
+            begin
+              case tfloatdef(def).floattype of
+                s32real,
+                s64real:
+                  ;
+                else
+                  result:=false;
+              end;
+            end;
+          filedef :
+            result:=false;
+          recorddef :
+            begin
+              if (recordinfostate<>ris_dontprint) then
+                begin
+                  if not checkrecsttype(tabstractrecordsymtable(trecorddef(def).symtable),recordinfostate,founderror) then
+                    begin
+                      result:=false;
+                      { report the exact (nested) error defintion }
+                      exit;
+                    end
+                end
+            end;
+          variantdef :
+            begin
+              recdef:=trecorddef(search_system_type('TVARDATA').typedef);
+              if (recordinfostate<>ris_dontprint) then
+                begin
+                  if not checkrecsttype(tabstractrecordsymtable(recdef.symtable),recordinfostate,founderror) then
+                    begin
+                      result:=false;
+                      { report the exact (nested) error defintion }
+                      exit;
+                    end
+                end;
+            end;
+          classrefdef:
+            begin
+              if is_objcclassref(def) then
+                begin
+                  objdef:=tobjectdef(tclassrefdef(def).pointeddef);
+                  newstate:=recordinfostate;
+                  if (recordinfostate<ris_dontprint) then
+                    newstate:=succ(newstate);
+                  if (newstate<>ris_dontprint) then
+                    begin
+                      if not checkrecsttype(tabstractrecordsymtable(objdef.symtable),recordinfostate,founderror) then
+                        begin
+                          result:=false;
+                          { report the exact (nested) error defintion }
+                          exit;
+                        end
+                    end
+                end
+            end;
+          setdef,
+          formaldef :
+            ;
+          arraydef :
+            begin
+              if is_array_of_const(def) then
+                { ok, varargs are ignored in signatures }
+              else if is_special_array(def) then
+                result:=false
+              else
+                begin
+                  if not is_packed_array(def) then
+                    begin
+                      if not objcdochecktype(tarraydef(def).elementdef,ris_initial,founderror) then
+                        begin
+                          result:=false;
+                          { report the exact (nested) error defintion }
+                          exit;
+                        end;
+                    end;
+                end;
+            end;
+          procvardef :
+            ;
+          objectdef :
+            case tobjectdef(def).objecttype of
+              odt_class,
+              odt_object,
+              odt_cppclass:
+                begin
+                  newstate:=recordinfostate;
+                  { implicit pointer for classes }
+                  if (tobjectdef(def).objecttype=odt_class) then
+                    begin
+                      { make all classes opaque, so even if they contain a
+                        reference-counted field there is no problem. Since a
+                        "dereferenced class" object does not exist, this should
+                        not cause problems }
+                      newstate:=ris_dontprint;
+                    end;
+                  if newstate<>ris_dontprint then
+                    begin
+                      if not checkrecsttype(tabstractrecordsymtable(tobjectdef(def).symtable),newstate,founderror) then
+                        begin
+                          result:=false;
+                          { report the exact (nested) error defintion }
+                          exit;
+                        end
+                    end
+                end;
+              odt_interfacecom,
+              odt_interfacecom_property,
+              odt_interfacecom_function,
+              odt_dispinterface:
+                result:=false;
+              odt_interfacecorba,
+              odt_objcclass,
+              odt_objcprotocol:
+                ;
+              else
+                internalerror(2009081709);
+            end;
+          undefineddef,
+          errordef :
+            result:=false;
+          procdef :
+            result:=false;
+        else
+          internalerror(2009170812);
+        end;
+        if not result then
+          founderror:=def;
+      end;
+
+
+    function objcchecktype(def: tdef; out founderror: tdef): boolean;
+      begin
+        result:=objcdochecktype(def,ris_initial,founderror);
+      end;
+
+
+end.

compiler/objcgutl.pas

@@ -45,7 +45,7 @@ implementation
     systems,
     aasmtai,
     cgbase,
-    objcutil,
+    objcdef,objcutil,
     symconst,symtype,symsym,symtable,
     verbose;
 
@@ -443,6 +443,13 @@ procedure tobjcrttiwriter.gen_objc_rtti_sections(list:TAsmList; st:TSymtable);
     for i:=0 to st.DefList.Count-1 do
       begin
         def:=tdef(st.DefList[i]);
+        { check whether all types used in Objective-C class/protocol/category
+          declarations can be used with the Objective-C run time (can only be
+          done now, because at parse-time some of these types can still be
+          forwarddefs) }
+        if is_objc_class_or_protocol(def) then
+          if not tobjectdef(def).check_objc_types then
+            continue;
         if is_objcclass(def) and
            not(oo_is_external in tobjectdef(def).objectoptions) then
           begin
@@ -519,7 +526,7 @@ procedure tobjcrttiwriter_fragile.gen_objc_ivars(list: TAsmList; objccls: tobjec
               inc(vcnt);
             end
           else
-            { must be caught during parsing }
+            { Should be caught during parsing }
             internalerror(2009090601);
         end;
     if vcnt=0 then

compiler/objcutil.pas

@@ -1,5 +1,5 @@
 {
-    Copyright (c) 2009 by Jonas Maebe
+    Copyright (c) 2009-2010 by Jonas Maebe
 
     This unit implements some Objective-C helper routines at the node tree
     level.
@@ -38,20 +38,10 @@ interface
       an inherited Objective-C method.  }
     function objcsuperclassnode(def: tdef): tnode;
 
-    { The internals of Objective-C's @encode() functionality: encode a
-      type into the internal format used by the run time. Returns false
-      if a type is not representable by the Objective-C run time, and in
-      that case also the failing definition.  }
-    function objctryencodetype(def: tdef; out encodedtype: ansistring; out founderror: tdef): boolean;
-
     { Encode a method's parameters and result type into the format used by the
       run time (for generating protocol and class rtti).  }
     function objcencodemethod(pd: tprocdef): ansistring;
 
-    { Check whether a type can be used in an Objective-C method
-      signature or field declaration.  }
-    function objcchecktype(def: tdef; out founderror: tdef): boolean;
-
     { Exports all assembler symbols related to the obj-c class }
     procedure exportobjcclass(def: tobjectdef);
 
@@ -63,6 +53,7 @@ implementation
       pass_1,
       verbose,systems,
       symtable,symconst,symsym,
+      objcdef,
       defutil,paramgr,
       nbas,nmem,ncal,nld,ncon,ncnv,
       export;
@@ -192,9 +183,6 @@ end;
                           Type encoding
 *******************************************************************}
 
-    type
-      trecordinfostate = (ris_initial, ris_afterpointer, ris_dontprint);
-
     function objcparasize(vs: tparavarsym): ptrint;
       begin
         result:=vs.paraloc[callerside].intsize;
@@ -206,381 +194,6 @@ end;
       end;
 
 
-    function addencodedtype(def: tdef; recordinfostate: trecordinfostate; bpacked: boolean; var encodedstr: ansistring; out founderror: tdef): boolean; forward;
-
-    function encoderecst(const recname: ansistring; recst: tabstractrecordsymtable; var encodedstr: ansistring; out founderror: tdef): boolean;
-      var
-        variantstarts: tfplist;
-        i, varindex: longint;
-        field,
-        firstfield: tfieldvarsym;
-        firstfieldvariant,
-        bpacked: boolean;
-      begin
-        result:=false;
-        bpacked:=recst.fieldalignment=bit_alignment;
-        { Is the first field already the start of a variant?  }
-        firstfield:=nil;
-        firstfieldvariant:=false;
-        for i:=0 to recst.symlist.count-1 do
-          begin
-            if (tsym(recst.symlist[i]).typ<>fieldvarsym) then
-              continue;
-            field:=tfieldvarsym(recst.symlist[i]);
-            if not assigned(firstfield) then
-              firstfield:=field
-            else if (vo_is_first_field in field.varoptions) then
-              begin
-                if (field.fieldoffset=firstfield.fieldoffset) then
-                  firstfieldvariant:=true;
-              end;
-          end;
-        variantstarts:=tfplist.create;
-        encodedstr:=encodedstr+'{'+recname+'=';
-        for i:=0 to recst.symlist.count-1 do
-          begin
-            if (tsym(recst.symlist[i]).typ<>fieldvarsym) then
-              continue;
-
-            field:=tfieldvarsym(recst.symlist[i]);
-            { start of a variant part? }
-            if ((field=firstfield) and
-                firstfieldvariant) or
-               ((field<>firstfield) and
-                (vo_is_first_field in field.varoptions)) then
-              begin
-                varindex:=variantstarts.count-1;
-                if (varindex=-1) or
-                   (tfieldvarsym(variantstarts[varindex]).fieldoffset<field.fieldoffset) then
-                  begin
-                    { new, more deeply nested variant }
-                    encodedstr:=encodedstr+'(?={?=';
-                    variantstarts.add(field);
-                  end
-                else
-                  begin
-                    { close existing nested variants if any }
-                    while (varindex>=0) and
-                          (tfieldvarsym(variantstarts[varindex]).fieldoffset>field.fieldoffset) do
-                      begin
-                        { close more deeply nested variants }
-                        encodedstr:=encodedstr+'})';
-                        dec(varindex);
-                      end;
-                    if (varindex<0) then
-                      internalerror(2009081805);
-                    if (tfieldvarsym(variantstarts[varindex]).fieldoffset<>field.fieldoffset) then
-                      internalerror(2009081804);
-
-                    { variant at the same level as a previous one }
-                    variantstarts.count:=varindex+1;
-                    { No need to add this field, it has the same offset as the
-                      previous one at this position.  }
-                    if tfieldvarsym(variantstarts[varindex]).fieldoffset<>field.fieldoffset then
-                      internalerror(2009081601);
-                    { close previous variant sub-part and start new one }
-                    encodedstr:=encodedstr+'}{?=';
-                  end
-              end;
-            if not addencodedtype(field.vardef,ris_afterpointer,bpacked,encodedstr,founderror) then
-              exit;
-          end;
-        for i:=0 to variantstarts.count-1 do
-          encodedstr:=encodedstr+'})';
-        variantstarts.free;
-        encodedstr:=encodedstr+'}';
-        result:=true
-      end;
-
-
-    function addencodedtype(def: tdef; recordinfostate: trecordinfostate; bpacked: boolean; var encodedstr: ansistring; out founderror: tdef): boolean;
-      var
-        recname: ansistring;
-        recdef: trecorddef;
-        objdef: tobjectdef;
-        len: aint;
-        c: char;
-        newstate: trecordinfostate;
-        addrpara: boolean;
-      begin
-        result:=true;
-        case def.typ of
-          stringdef :
-            begin
-              case tstringdef(def).stringtype of
-                st_shortstring:
-                  { include length byte }
-                  encodedstr:=encodedstr+'['+tostr(tstringdef(def).len+1)+'C]';
-                else
-                  { While we could handle refcounted Pascal strings correctly
-                    when such methods are called from Pascal code, things would
-                    completely break down if they were called from Objective-C
-                    code/reflection since the necessary refcount helper calls
-                    would be missing on the caller side (unless we'd
-                    automatically generate wrappers).  }
-                  result:=false;
-              end;
-            end;
-          enumdef,
-          orddef :
-            begin
-              if bpacked and
-                 not is_void(def) then
-                encodedstr:=encodedstr+'b'+tostr(def.packedbitsize)
-              else
-                begin
-                  if is_void(def) then
-                    c:='v'
-                  { in gcc, sizeof(_Bool) = sizeof(char) }
-                  else if is_boolean(def) and
-                          (def.size=1) then
-                    c:='B'
-                  else
-                    begin
-                      case def.size of
-                        1:
-                          c:='c';
-                        2:
-                          c:='s';
-                        4:
-                          c:='i';
-                        8:
-                          c:='q';
-                        else
-                          internalerror(2009081502);
-                      end;
-                      if not is_signed(def) then
-                        c:=upcase(c);
-                    end;
-                  encodedstr:=encodedstr+c;
-                end;
-            end;
-          pointerdef :
-            begin
-              if is_pchar(def) then
-                encodedstr:=encodedstr+'*'
-              else if (def=objc_idtype) then
-                encodedstr:=encodedstr+'@'
-              else if (def=objc_seltype) then
-                encodedstr:=encodedstr+':'
-              else if (def=objc_metaclasstype) then
-                encodedstr:=encodedstr+'#'
-              else
-                begin
-                  encodedstr:=encodedstr+'^';
-                  newstate:=recordinfostate;
-                  if (recordinfostate<ris_dontprint) then
-                    newstate:=succ(newstate);
-                  if not addencodedtype(tpointerdef(def).pointeddef,newstate,false,encodedstr,founderror) then
-                    begin
-                      result:=false;
-                      { report the exact (nested) error defintion }
-                      exit;
-                    end;
-                end;
-            end;
-          floatdef :
-            begin
-              case tfloatdef(def).floattype of
-                s32real:
-                  c:='f';
-                s64real:
-                  c:='d';
-                else
-                  begin
-                    c:='!';
-                    result:=false;
-                  end;
-              end;
-              encodedstr:=encodedstr+c;
-            end;
-          filedef :
-            result:=false;
-          recorddef :
-            begin
-              if assigned(def.typesym) then
-                recname:=def.typename
-              else
-                recname:='?';
-
-              if (recordinfostate<>ris_dontprint) then
-                begin
-                  if not encoderecst(recname,tabstractrecordsymtable(trecorddef(def).symtable),encodedstr,founderror) then
-                    begin
-                      result:=false;
-                      { report the exact (nested) error defintion }
-                      exit;
-                    end
-                end
-              else
-                encodedstr:=encodedstr+'{'+recname+'}'
-            end;
-          variantdef :
-            begin
-              recdef:=trecorddef(search_system_type('TVARDATA').typedef);
-              if (recordinfostate<>ris_dontprint) then
-                begin
-                  if not encoderecst(recdef.typename,tabstractrecordsymtable(recdef.symtable),encodedstr,founderror) then
-                    begin
-                      result:=false;
-                      { report the exact (nested) error defintion }
-                      exit;
-                    end
-                end
-              else
-                encodedstr:=encodedstr+'{'+recdef.typename+'}';
-            end;
-          classrefdef :
-            begin
-              encodedstr:=encodedstr+'^';
-              newstate:=recordinfostate;
-              if (recordinfostate<>ris_dontprint) then
-                newstate:=succ(newstate);
-              if is_objcclassref(def) then
-                begin
-                  objdef:=tobjectdef(tclassrefdef(def).pointeddef);
-                  if (newstate<>ris_dontprint) then
-                    { anonymous (objc)class definitions do not exist }
-                    begin
-                      if not encoderecst(objdef.objextname^,tabstractrecordsymtable(objdef.symtable),encodedstr,founderror) then
-                        { The fields of an Objective-C class should always be
-                          encodeable.  }
-                        internalerror(2009081702);
-                    end
-                  else
-                    encodedstr:=encodedstr+'{'+objdef.objextname^+'}'
-                end
-              { Object Pascal classrefdefs point to a vmt, not really useful
-                to completely write those here.  I'm not even sure what the
-                Objective-C run time uses this information for, since in C you
-                can have forward struct definitions so not all structs passed
-                to functions can be written out here either -> treat
-                classrefdefs the same as such forward-defined structs.  }
-              else
-                begin
-                  if assigned(def.typesym) then
-                    recname:=def.typename
-                  else
-                    recname:='?';
-                  encodedstr:=encodedstr+'{'+recname;
-                  if (newstate<>ris_dontprint) then
-                    encodedstr:=encodedstr+'=';
-                  encodedstr:=encodedstr+'}'
-                end;
-            end;
-          setdef :
-            begin
-              addrpara:=paramanager.push_addr_param(vs_value,def,pocall_cdecl);
-              if not addrpara then
-                { encode as an record, they are always passed by value in C.  }
-                encodedstr:=encodedstr+'{?=';
-              { Encode the set itself as an array. Without an encompassing
-                record, these are always passed by reference in C.  }
-              encodedstr:=encodedstr+'['+tostr(def.size)+'C]';
-              if not addrpara then
-                encodedstr:=encodedstr+'}';
-            end;
-          formaldef :
-            begin
-              encodedstr:=encodedstr+'^v';
-            end;
-          arraydef :
-            begin
-              if is_array_of_const(def) then
-                { do nothing, varargs are ignored in signatures }
-              else if is_special_array(def) then
-                result:=false
-              else
-                begin
-                  len:=tarraydef(def).highrange-tarraydef(def).lowrange+1;
-                  if is_packed_array(def) then
-                    begin
-                      { convert from bits to bytes for bitpacked arrays }
-                      len:=(len+7) div 8;
-                      { and encode as plain array of bytes }
-                      encodedstr:=encodedstr+'['+tostr(len)+'C]';
-                    end
-                  else
-                    begin
-                      encodedstr:=encodedstr+'['+tostr(len);
-                      { Embedded structured types in the array are printed
-                        in full regardless of the current recordinfostate.  }
-                      if not addencodedtype(tarraydef(def).elementdef,ris_initial,false,encodedstr,founderror) then
-                        begin
-                          result:=false;
-                          { report the exact (nested) error defintion }
-                          exit;
-                        end;
-                      encodedstr:=encodedstr+']';
-                    end;
-                end;
-            end;
-          procvardef :
-            encodedstr:=encodedstr+'^?';
-          objectdef :
-            case tobjectdef(def).objecttype of
-              odt_class,
-              odt_object,
-              odt_cppclass:
-                begin
-                  newstate:=recordinfostate;
-                  { implicit pointer for classes }
-                  if (tobjectdef(def).objecttype=odt_class) then
-                    begin
-                      encodedstr:=encodedstr+'^';
-                      if (recordinfostate<ris_dontprint) then
-                        newstate:=succ(newstate);
-                    end;
-                  if newstate<>ris_dontprint then
-                    begin
-                      if not encoderecst(def.typename,tabstractrecordsymtable(tobjectdef(def).symtable),encodedstr,founderror) then
-                        begin
-                          result:=false;
-                          { report the exact (nested) error defintion }
-                          exit;
-                        end
-                    end
-                  else
-                    encodedstr:=encodedstr+'{'+def.typename+'}'
-                end;
-              odt_interfacecom,
-              odt_interfacecom_property,
-              odt_interfacecom_function,
-              odt_dispinterface:
-                result:=false;
-              odt_interfacecorba:
-                encodedstr:=encodedstr+'^{'+def.typename+'=}';
-              { In Objective-C, the actual types of class instances are
-                NSObject* etc, and those are encoded as "@". In FPC, to keep
-                the similarity with Delphi-style Object Pascal, the type is
-                NSObject and the pointer is implicit. Objective-C's "NSObject"
-                has "class of NSObject" as equivalent here.  }
-              odt_objcclass,
-              odt_objcprotocol:
-                encodedstr:=encodedstr+'@';
-              else
-                internalerror(2009081509);
-            end;
-          undefineddef,
-          errordef :
-            result:=false;
-          procdef :
-            { must be done via objcencodemethod() }
-            internalerror(2009081511);
-        else
-          internalerror(2009150812);
-        end;
-        if not result then
-          founderror:=def;
-      end;
-
-
-    function objctryencodetype(def: tdef; out encodedtype: ansistring; out founderror: tdef): boolean;
-      begin
-        result:=addencodedtype(def,ris_initial,false,encodedtype,founderror);
-      end;
-
-
     function objcencodemethod(pd: tprocdef): ansistring;
       var
         parasize,
@@ -639,212 +252,6 @@ end;
       end;
 
 
-{******************************************************************
-                    ObjC type validity checking
-*******************************************************************}
-
-    function objcdochecktype(def: tdef; recordinfostate: trecordinfostate; out founderror: tdef): boolean; forward;
-
-    function checkrecsttype(recst: tabstractrecordsymtable; recordinfostate: trecordinfostate; out founderror: tdef): boolean;
-      var
-        i: longint;
-        field: tfieldvarsym;
-        newstate: trecordinfostate;
-      begin
-        result:=false;
-        newstate:=recordinfostate;
-        { Although we never have to print the type info for nested
-          records, check them anyway in case we're not after a pointer
-          since if such records contain refcounted types then they
-          can cause just as much trouble as if they were a simple
-          refcounted field.  }
-        if (newstate=ris_afterpointer) then
-          newstate:=ris_dontprint;
-        for i:=0 to recst.symlist.count-1 do
-          begin
-            if (tsym(recst.symlist[i]).typ<>fieldvarsym) then
-              continue;
-
-            field:=tfieldvarsym(recst.symlist[i]);
-            if not objcdochecktype(field.vardef,newstate,founderror) then
-              exit;
-          end;
-        result:=true
-      end;
-
-
-    function objcdochecktype(def: tdef; recordinfostate: trecordinfostate; out founderror: tdef): boolean;
-      var
-        recdef: trecorddef;
-        objdef: tobjectdef;
-        newstate: trecordinfostate;
-      begin
-        result:=true;
-        case def.typ of
-          stringdef :
-            begin
-              case tstringdef(def).stringtype of
-                st_shortstring:
-                  ;
-                else
-                  { While we could handle refcounted Pascal strings correctly
-                    when such methods are called from Pascal code, things would
-                    completely break down if they were called from Objective-C
-                    code/reflection since the necessary refcount helper calls
-                    would be missing on the caller side (unless we'd
-                    automatically generate wrappers).  }
-                  result:=false;
-              end;
-            end;
-          enumdef,
-          orddef :
-            ;
-          pointerdef :
-            begin
-              newstate:=recordinfostate;
-              if (recordinfostate<ris_dontprint) then
-                newstate:=succ(newstate);
-              if not objcdochecktype(tpointerdef(def).pointeddef,newstate,founderror) then
-                begin
-                  result:=false;
-                  { report the exact (nested) error defintion }
-                  exit;
-                end;
-            end;
-          floatdef :
-            begin
-              case tfloatdef(def).floattype of
-                s32real,
-                s64real:
-                  ;
-                else
-                  result:=false;
-              end;
-            end;
-          filedef :
-            result:=false;
-          recorddef :
-            begin
-              if (recordinfostate<>ris_dontprint) then
-                begin
-                  if not checkrecsttype(tabstractrecordsymtable(trecorddef(def).symtable),recordinfostate,founderror) then
-                    begin
-                      result:=false;
-                      { report the exact (nested) error defintion }
-                      exit;
-                    end
-                end
-            end;
-          variantdef :
-            begin
-              recdef:=trecorddef(search_system_type('TVARDATA').typedef);
-              if (recordinfostate<>ris_dontprint) then
-                begin
-                  if not checkrecsttype(tabstractrecordsymtable(recdef.symtable),recordinfostate,founderror) then
-                    begin
-                      result:=false;
-                      { report the exact (nested) error defintion }
-                      exit;
-                    end
-                end;
-            end;
-          classrefdef:
-            begin
-              if is_objcclassref(def) then
-                begin
-                  objdef:=tobjectdef(tclassrefdef(def).pointeddef);
-                  newstate:=recordinfostate;
-                  if (recordinfostate<ris_dontprint) then
-                    newstate:=succ(newstate);
-                  if (newstate<>ris_dontprint) then
-                    begin
-                      if not checkrecsttype(tabstractrecordsymtable(objdef.symtable),recordinfostate,founderror) then
-                        begin
-                          result:=false;
-                          { report the exact (nested) error defintion }
-                          exit;
-                        end
-                    end
-                end
-            end;
-          setdef,
-          formaldef :
-            ;
-          arraydef :
-            begin
-              if is_array_of_const(def) then
-                { ok, varargs are ignored in signatures }
-              else if is_special_array(def) then
-                result:=false
-              else
-                begin
-                  if not is_packed_array(def) then
-                    begin
-                      if not objcdochecktype(tarraydef(def).elementdef,ris_initial,founderror) then
-                        begin
-                          result:=false;
-                          { report the exact (nested) error defintion }
-                          exit;
-                        end;
-                    end;
-                end;
-            end;
-          procvardef :
-            ;
-          objectdef :
-            case tobjectdef(def).objecttype of
-              odt_class,
-              odt_object,
-              odt_cppclass:
-                begin
-                  newstate:=recordinfostate;
-                  { implicit pointer for classes }
-                  if (tobjectdef(def).objecttype=odt_class) then
-                    begin
-                      if (recordinfostate<ris_dontprint) then
-                        newstate:=succ(newstate);
-                    end;
-                  if newstate<>ris_dontprint then
-                    begin
-                      if not checkrecsttype(tabstractrecordsymtable(tobjectdef(def).symtable),newstate,founderror) then
-                        begin
-                          result:=false;
-                          { report the exact (nested) error defintion }
-                          exit;
-                        end
-                    end
-                end;
-              odt_interfacecom,
-              odt_interfacecom_property,
-              odt_interfacecom_function,
-              odt_dispinterface:
-                result:=false;
-              odt_interfacecorba,
-              odt_objcclass,
-              odt_objcprotocol:
-                ;
-              else
-                internalerror(2009081709);
-            end;
-          undefineddef,
-          errordef :
-            result:=false;
-          procdef :
-            result:=false;
-        else
-          internalerror(2009170812);
-        end;
-        if not result then
-          founderror:=def;
-      end;
-
-
-    function objcchecktype(def: tdef; out founderror: tdef): boolean;
-      begin
-        result:=objcdochecktype(def,ris_initial,founderror);
-      end;
-
-
 {******************************************************************
                     ObjC class exporting
 *******************************************************************}

compiler/symdef.pas

@@ -318,6 +318,7 @@ interface
           procedure make_all_methods_external;
           { ObjC }
           procedure finish_objc_data;
+          function check_objc_types: boolean;
           { C++ }
           procedure finish_cpp_data;
           function RttiName: string;
@@ -768,7 +769,7 @@ implementation
       { target }
       systems,aasmcpu,paramgr,
       { symtable }
-      symsym,symtable,symutil,defutil,
+      symsym,symtable,symutil,defutil,objcdef,
       { module }
       fmodule,
       { other }
@@ -4742,6 +4743,7 @@ implementation
       var
         def: tdef absolute data;
         pd: tprocdef absolute data;
+        founderrordef: tdef;
         i,
         paracount: longint;
       begin
@@ -4767,7 +4769,8 @@ implementation
               another type.  }
             if not(po_has_mangledname in pd.procoptions) then
               begin
-                { check whether the number of formal parameters is correct }
+                { check whether the number of formal parameters is correct,
+                  and whether they have valid Objective-C types }
                 paracount:=0;
                 for i:=1 to length(pd.messageinf.str^) do
                   if pd.messageinf.str^[i]=':' then
@@ -4821,6 +4824,56 @@ implementation
       end;
 
 
+    procedure verify_objc_vardef(data: tobject; arg: pointer);
+      var
+        sym: tabstractvarsym absolute data;
+        res: pboolean absolute arg;
+        founderrordef: tdef;
+      begin
+        if not(tsym(data).typ in [paravarsym,fieldvarsym]) then
+          exit;
+        if (sym.typ=paravarsym) and
+           ((vo_is_hidden_para in tparavarsym(sym).varoptions) or
+            is_array_of_const(tparavarsym(sym).vardef)) then
+          exit;
+        if not objcchecktype(sym.vardef,founderrordef) then
+          begin
+            MessagePos1(sym.fileinfo,type_e_objc_type_unsupported,founderrordef.typename);
+            res^:=false;
+          end;
+      end;
+
+
+    procedure verify_objc_procdef_paras(data: tobject; arg: pointer);
+      var
+        def: tdef absolute data;
+        res: pboolean absolute arg;
+        founderrordef: tdef;
+      begin
+        if (def.typ<>procdef) then
+          exit;
+        { check parameter types for validity }
+        tprocdef(def).paras.foreachcall(@verify_objc_vardef,arg);
+        { check the result type for validity }
+        if not objcchecktype(tprocdef(def).returndef,founderrordef) then
+          begin
+            MessagePos1(tprocdef(def).funcretsym.fileinfo,type_e_objc_type_unsupported,founderrordef.typename);
+            res^:=false;
+          end;
+      end;
+
+
+    function tobjectdef.check_objc_types: boolean;
+      begin
+        { done in separate step from finish_objc_data, because when
+          finish_objc_data is called, not all forwarddefs have been resolved
+          yet and we need to know all types here }
+        result:=true;
+        self.symtable.symlist.foreachcall(@verify_objc_vardef,@result);
+        self.symtable.deflist.foreachcall(@verify_objc_procdef_paras,@result);
+      end;
+
+
     procedure do_cpp_import_info(data: tobject; arg: pointer);
       var
         def: tdef absolute data;

tests/test/tobjc11.pp

@@ -109,7 +109,7 @@ type
 begin
   check('tra',objcencode(tra),'{tra=ii}');
   check('TStrippedVarRec',objcencode(TStrippedVarRec),'{TStrippedVarRec=c(?={?=i}{?=B}{?=C}{?=S}{?=^[256C]}{?=^v}{?=*}{?=^{TObject}}{?=^{TClass}}{?=^S}{?=^v}{?=^v}{?=^v}{?=^q}{?=^Q})}');
-  check('TObject',objcencode(TObject),'^{TObject=^v}');
+  check('TObject',objcencode(TObject),'^{TObject}');
   check('tnestedvarrec',objcencode(tnestedvarrec),'{tnestedvarrec=i^{tra}(?={?={tnestedvarrechelper1=(?={?=f}{?=d})}}{?={tnestedvarrechelper2=ic}}{?=i})}');
 end;
 

tests/test/tobjc32.pp

@@ -0,0 +1,15 @@
+{ %fail }
+
+{ %target=darwin }
+{ %cpu=powerpc,powerpc64,i386,x86_64,arm }
+
+{$mode objfpc}
+{$modeswitch objectivec1}
+
+type
+  tc = objcclass(NSObject)
+    s: ansistring;
+  end;
+
+begin
+end.

tests/test/tobjc32a.pp

@@ -0,0 +1,19 @@
+{ %fail }
+
+{ %target=darwin }
+{ %cpu=powerpc,powerpc64,i386,x86_64,arm }
+
+{$mode objfpc}
+{$modeswitch objectivec1}
+
+type
+  tc = objcclass(NSObject)
+    function test: ansistring; message 'test';
+  end;
+
+procedure tc.test: ansistring;
+  begin
+  end;
+
+begin
+end.

tests/test/tobjc32b.pp

@@ -0,0 +1,19 @@
+{ %fail }
+
+{ %target=darwin }
+{ %cpu=powerpc,powerpc64,i386,x86_64,arm }
+
+{$mode objfpc}
+{$modeswitch objectivec1}
+
+type
+  tc = objcclass(NSObject)
+    procedure test(s: ansistring); message 'test:';
+  end;
+
+procedure tc.test(s: ansistring);
+  begin
+  end;
+
+begin
+end.