* fixed the parameter order of self/_cmd relative to the hidden function

    result parameter (cosmetic, since those parameter were not actually used)
  * fixed calling obj-c methods where the result is returned via a hidden
    parameter: since the hidden result remains hidden in the newly constructed
    objc_msgSendStret*() variant, it is inserted again by the new callnode
    -> remove the one inserted by the original callnode

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

.gitattributes

@@ -8528,6 +8528,7 @@ tests/test/tobjc17.pp svneol=native#text/plain
 tests/test/tobjc18.pp svneol=native#text/plain
 tests/test/tobjc19.pp svneol=native#text/plain
 tests/test/tobjc2.pp svneol=native#text/plain
+tests/test/tobjc20.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

compiler/nobjc.pas

@@ -203,7 +203,11 @@ function tobjcmessagesendnode.pass_1: tnode;
     objcsupertype: tdef;
     field: tfieldvarsym;
     selfpara,
-    msgselpara: tcallparanode;
+    msgselpara,
+    respara,
+
+    prerespara,
+    prevpara: tcallparanode;
   begin
     { pass1 of left has already run, see constructor }
 
@@ -216,41 +220,70 @@ function tobjcmessagesendnode.pass_1: tnode;
       result type, and on whether or not it's an inherited call.
     }
 
-    { record returned via implicit pointer }
-    if paramanager.ret_in_param(left.resultdef,tcallnode(left).procdefinition.proccalloption) then
-      if not(cnf_inherited in tcallnode(left).callnodeflags) then
-        msgsendname:='OBJC_MSGSEND_STRET'
-      else
-        msgsendname:='OBJC_MSGSENDSUPER_STRET'
-{$ifdef i386}
-    { special case for fpu results on i386 for non-inherited calls }
-    else if (left.resultdef.typ=floatdef) and
-            not(cnf_inherited in tcallnode(left).callnodeflags) then
-      msgsendname:='OBJC_MSGSEND_FPRET'
-{$endif}
-    { default }
-    else if not(cnf_inherited in tcallnode(left).callnodeflags) then
-      msgsendname:='OBJC_MSGSEND'
-    else
-      msgsendname:='OBJC_MSGSENDSUPER';
-
     newparas:=tcallparanode(tcallnode(left).left);
     { Find the self and msgsel parameters.  }
     para:=newparas;
     selfpara:=nil;
     msgselpara:=nil;
+    respara:=nil;
+    prevpara:=nil;
     while assigned(para) do
       begin
         if (vo_is_self in para.parasym.varoptions) then
           selfpara:=para
         else if (vo_is_msgsel in para.parasym.varoptions) then
-          msgselpara:=para;
+          msgselpara:=para
+        else if (vo_is_funcret in para.parasym.varoptions) then
+          begin
+            prerespara:=prevpara;
+            respara:=para;
+          end;
+        prevpara:=para;
         para:=tcallparanode(para.right);
       end;
     if not assigned(selfpara) then
       internalerror(2009051801);
     if not assigned(msgselpara) then
       internalerror(2009051802);
+
+    { record returned via implicit pointer }
+    if paramanager.ret_in_param(left.resultdef,tcallnode(left).procdefinition.proccalloption) then
+      begin
+        if not assigned(respara) then
+          internalerror(2009091101);
+        { Since the result parameter is also hidden in the routine we'll
+          call now, it will be inserted again by the callnode. So we have to
+          remove the old one, otherwise we'll have two result parameters.
+        }
+        if (tcallparanode(respara).left.nodetype<>nothingn) then
+          internalerror(2009091102);
+        if assigned(prerespara) then
+          tcallparanode(prerespara).right:=tcallparanode(respara).right
+        else
+          begin
+            tcallnode(left).left:=tcallparanode(respara).right;
+            newparas:=tcallparanode(tcallnode(left).left);
+          end;
+        tcallparanode(respara).right:=nil;
+        respara.free;
+        if not(cnf_inherited in tcallnode(left).callnodeflags) then
+          msgsendname:='OBJC_MSGSEND_STRET'
+        else
+          msgsendname:='OBJC_MSGSENDSUPER_STRET'
+      end
+{$ifdef i386}
+    { special case for fpu results on i386 for non-inherited calls }
+    else if (left.resultdef.typ=floatdef) and
+            not(cnf_inherited in tcallnode(left).callnodeflags) then
+      msgsendname:='OBJC_MSGSEND_FPRET'
+{$endif}
+    { default }
+    else if not(cnf_inherited in tcallnode(left).callnodeflags) then
+      msgsendname:='OBJC_MSGSEND'
+    else
+      msgsendname:='OBJC_MSGSENDSUPER';
+
+
     { Handle self }
     { 1) in case of sending a message to a superclass, self is a pointer to
          an objc_super record
@@ -323,7 +356,7 @@ function tobjcmessagesendnode.pass_1: tnode;
     selfpara.left.free;
     selfpara.left:=tcallnode(left).methodpointer;
     { replace selector parameter }
-    msgselpara.left.Free;
+    msgselpara.left.free;
     msgselpara.left:=
       cobjcselectornode.create(
        cstringconstnode.createstr(tprocdef(tcallnode(left).procdefinition).messageinf.str^)
@@ -334,6 +367,12 @@ function tobjcmessagesendnode.pass_1: tnode;
     tcallnode(left).methodpointer:=nil;
     { and now the call to the Objective-C rtl }
     result:=ccallnode.createinternresfromunit('OBJC1',msgsendname,newparas,left.resultdef);
+    { in case an explicit function result was specified, keep it }
+    tcallnode(result).funcretnode:=tcallnode(left).funcretnode;
+    tcallnode(left).funcretnode:=nil;
+    { keep variable paras }
+    tcallnode(result).varargsparas:=tcallnode(left).varargsparas;
+    tcallnode(left).varargsparas:=nil;
 
     if (cnf_inherited in tcallnode(left).callnodeflags) then
       begin

compiler/pdecsub.pas

@@ -165,9 +165,9 @@ implementation
            is_objc_class_or_protocol(tprocdef(pd)._class) then
           begin
             { insert Objective-C self and selector parameters }
-            vs:=tparavarsym.create('$_cmd',paranr_vmt,vs_value,objc_seltype,[vo_is_msgsel,vo_is_hidden_para]);
+            vs:=tparavarsym.create('$_cmd',paranr_objc_cmd,vs_value,objc_seltype,[vo_is_msgsel,vo_is_hidden_para]);
             pd.parast.insert(vs);
-            vs:=tparavarsym.create('$self',paranr_self,vs_value,objc_idtype,[vo_is_self,vo_is_hidden_para]);
+            vs:=tparavarsym.create('$self',paranr_objc_self,vs_value,objc_idtype,[vo_is_self,vo_is_hidden_para]);
             pd.parast.insert(vs);
           end
         else if (pd.typ=procvardef) and

compiler/symconst.pas

@@ -105,6 +105,11 @@ const
   paranr_self = 2;
   paranr_result = 3;
   paranr_vmt = 4;
+
+  { the implicit parameters for Objective-C methods need to come
+    after the hidden result parameter }
+  paranr_objc_self = 4;
+  paranr_objc_cmd = 5;
   { Required to support variations of syscalls on MorphOS }
   paranr_syscall_basesysv = 9;
   paranr_syscall_sysvbase = high(word)-4;

tests/test/tobjc20.pp

@@ -0,0 +1,75 @@
+{ %target=darwin }
+{ %cpu=powerpc,i386 }
+
+program project1;
+
+{$mode objfpc}{$H+}
+{$modeswitch objectivec1}
+type
+  tr = record
+    s: shortstring;
+  end;
+
+ MyObject = objcclass(NSObject)
+   fss: shortstring;
+   fsingle: single;
+   fdouble: double;
+
+   function getss: shortstring ; message 'getss';
+   function getsspara(l1,l2: longint): shortstring ; message 'getss:l1:';
+   function getsingle(l1,l2: longint): single; message 'getsingle:l1:';
+   function getdouble(l1,l2: longint): double; message 'getdouble:l1:';
+ end;
+
+function MyObject.getss: shortstring;
+begin
+  result:=fss;
+end;
+
+
+function MyObject.getsspara(l1,l2: longint): shortstring;
+begin
+  if (l1<>1) or
+     (l2<>2) then
+    halt(1);
+  result:=fss;
+end;
+
+
+function MyObject.getsingle(l1,l2: longint): single;
+begin
+  if (l1<>1) or
+     (l2<>2) then
+    halt(2);
+  result:=fsingle;
+end;
+
+
+function MyObject.getdouble(l1,l2: longint): double;
+begin
+  if (l1<>1) or
+     (l2<>2) then
+    halt(3);
+  result:=fdouble;
+end;
+
+var
+  m: MyObject;
+begin
+ m := MyObject.alloc;
+ m:=m.init;
+ m.fss:='hello!';
+ m.fsingle:=123.625;
+ m.fdouble:=9876.0625;
+
+ if m.getss<>'hello!' then
+   halt(4);
+ m.fss:='gij ook';
+ if m.getsspara(1,2)<>'gij ook' then
+   halt(5);
+ if m.getsingle(1,2)<>123.625 then
+   halt(6);
+ if m.getdouble(1,2)<>9876.0625 then
+   halt(7);
+ m.release;
+end.