Browse Source

* allow "array of const" parameters again for objcclass/objcprotocol methods
after merge of r13618 from trunk
* also allow "varargs" for objclass/objcprotocol methods
* set the cdecl calling convention for objcclass/objcprotocol methods in
handle_calling_convention() rather than in a separate routine in
pdecobj (and do the same for cppclass methods)
* check that array of const parameters and varargs are only used with
external objc-methods (can only be done after the class is parsed,
because earlier on it's not known yet whether or not it is external)

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

Jonas Maebe 16 years ago
parent
commit
744d20d086
5 changed files with 56 additions and 12 deletions
  1. 1 0
      .gitattributes
  2. 0 5
      compiler/pdecobj.pas
  3. 19 3
      compiler/pdecsub.pas
  4. 21 4
      compiler/symdef.pas
  5. 15 0
      tests/test/tobjc13.pp

+ 1 - 0
.gitattributes

@@ -8220,6 +8220,7 @@ tests/test/tobjc1.pp svneol=native#text/plain
 tests/test/tobjc10.pp svneol=native#text/plain
 tests/test/tobjc10.pp svneol=native#text/plain
 tests/test/tobjc11.pp svneol=native#text/plain
 tests/test/tobjc11.pp svneol=native#text/plain
 tests/test/tobjc12.pp svneol=native#text/plain
 tests/test/tobjc12.pp svneol=native#text/plain
+tests/test/tobjc13.pp svneol=native#text/plain
 tests/test/tobjc2.pp svneol=native#text/plain
 tests/test/tobjc2.pp svneol=native#text/plain
 tests/test/tobjc3.pp svneol=native#text/plain
 tests/test/tobjc3.pp svneol=native#text/plain
 tests/test/tobjc4.pp svneol=native#text/plain
 tests/test/tobjc4.pp svneol=native#text/plain

+ 0 - 5
compiler/pdecobj.pas

@@ -430,10 +430,6 @@ implementation
         begin
         begin
           if is_objc_class_or_protocol(pd._class) then
           if is_objc_class_or_protocol(pd._class) then
             begin
             begin
-              { none of the explicit calling conventions should be allowed }
-              if (po_hascallingconvention in pd.procoptions) then
-                internalerror(2009032501);
-              pd.proccalloption:=pocall_cdecl;
               include(pd.procoptions,po_objc);
               include(pd.procoptions,po_objc);
             end;
             end;
         end;
         end;
@@ -443,7 +439,6 @@ implementation
         begin
         begin
            if is_cppclass(pd._class) then
            if is_cppclass(pd._class) then
             begin
             begin
-              pd.proccalloption:=pocall_cppdecl;
               pd.setmangledname(target_info.Cprefix+pd.cplusplusmangledname);
               pd.setmangledname(target_info.Cprefix+pd.cplusplusmangledname);
             end;
             end;
         end;
         end;

+ 19 - 3
compiler/pdecsub.pas

@@ -310,7 +310,8 @@ implementation
                  if is_open_string(vardef) then
                  if is_open_string(vardef) then
                     MessagePos(fileinfo,parser_w_cdecl_no_openstring);
                     MessagePos(fileinfo,parser_w_cdecl_no_openstring);
                  if not(po_external in pd.procoptions) and
                  if not(po_external in pd.procoptions) and
-                    (pd.typ<>procvardef) then
+                    (pd.typ<>procvardef) and
+                    not is_objc_class_or_protocol(tprocdef(pd)._class) then
                    if is_array_of_const(vardef) then
                    if is_array_of_const(vardef) then
                      MessagePos(fileinfo,parser_e_varargs_need_cdecl_and_external)
                      MessagePos(fileinfo,parser_e_varargs_need_cdecl_and_external)
                    else
                    else
@@ -2376,7 +2377,19 @@ const
     procedure handle_calling_convention(pd:tabstractprocdef);
     procedure handle_calling_convention(pd:tabstractprocdef);
       begin
       begin
         { set the default calling convention if none provided }
         { set the default calling convention if none provided }
-        if not(po_hascallingconvention in pd.procoptions) then
+        if (pd.typ=procdef) and
+           (is_objc_class_or_protocol(tprocdef(pd)._class) or
+            is_cppclass(tprocdef(pd)._class)) then
+          begin
+            { none of the explicit calling conventions should be allowed }
+            if (po_hascallingconvention in pd.procoptions) then
+              internalerror(2009032501);
+            if is_cppclass(tprocdef(pd)._class) then
+              pd.proccalloption:=pocall_cppdecl
+            else
+              pd.proccalloption:=pocall_cdecl;
+          end
+        else if not(po_hascallingconvention in pd.procoptions) then
           pd.proccalloption:=current_settings.defproccall
           pd.proccalloption:=current_settings.defproccall
         else
         else
           begin
           begin
@@ -2423,7 +2436,10 @@ const
               { if external is available, then cdecl must also be available,
               { if external is available, then cdecl must also be available,
                 procvars don't need external }
                 procvars don't need external }
               if not((po_external in pd.procoptions) or
               if not((po_external in pd.procoptions) or
-                     (pd.typ=procvardef)) and
+                     (pd.typ=procvardef) or
+                     { for objcclasses this is checked later, because the entire
+                       class may be external.  }
+                     is_objc_class_or_protocol(tprocdef(pd)._class)) and
                  not(pd.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_mwpascal]) then
                  not(pd.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_mwpascal]) then
                 Message(parser_e_varargs_need_cdecl_and_external);
                 Message(parser_e_varargs_need_cdecl_and_external);
             end
             end

+ 21 - 4
compiler/symdef.pas

@@ -4381,16 +4381,33 @@ implementation
     procedure check_and_finish_msg(data: tobject; arg: pointer);
     procedure check_and_finish_msg(data: tobject; arg: pointer);
       var
       var
         def: tdef absolute data;
         def: tdef absolute data;
+        pd: tprocdef absolute data;
+        i: longint;
       begin
       begin
-        if (def.typ = procdef) then
+        if (def.typ=procdef) then
           begin
           begin
             { we have to wait until now to set the mangled name because it
             { we have to wait until now to set the mangled name because it
               depends on the (possibly external) class name, which is defined
               depends on the (possibly external) class name, which is defined
               at the very end.  }
               at the very end.  }
-            if (po_msgstr in tprocdef(def).procoptions) then
-              tprocdef(def).setmangledname(tprocdef(def).objcmangledname)
+            if (po_msgstr in pd.procoptions) then
+              pd.setmangledname(pd.objcmangledname)
             else
             else
-              MessagePos(tprocdef(def).fileinfo,parser_e_objc_requires_msgstr)
+              MessagePos(pd.fileinfo,parser_e_objc_requires_msgstr);
+            if not(oo_is_external in pd._class.objectoptions) then
+              begin
+                if (po_varargs in pd.procoptions) then
+                  MessagePos(pd.fileinfo,parser_e_varargs_need_cdecl_and_external)
+                else
+                  begin
+                    { check for "array of const" parameters }
+                    for i:=0 to pd.parast.symlist.count-1 do
+                      begin
+                        if (tsym(pd.parast.symlist[i]).typ=paravarsym) and
+                           is_array_of_const(tparavarsym(pd.parast.symlist[i]).vardef) then
+                          MessagePos(pd.fileinfo,parser_e_varargs_need_cdecl_and_external);
+                      end;
+                  end;
+              end;
           end;
           end;
       end;
       end;
 
 

+ 15 - 0
tests/test/tobjc13.pp

@@ -0,0 +1,15 @@
+{ %target=darwin }
+{ %cpu=powerpc,i386 }
+{ %norun }
+
+{$mode objfpc}
+{$modeswitch objectivec1}
+
+type
+  ta = objcclass(NSObject)
+    procedure test(l: longint; a: array of const); message 'class';
+    procedure test2(l: longint); varargs; message 'class';
+  end; external name 'NSObject';
+
+begin
+end.