diff --git a/.gitattributes b/.gitattributes index 537bc011c3..31fbe0df17 100644 --- a/.gitattributes +++ b/.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 diff --git a/compiler/nobjc.pas b/compiler/nobjc.pas index 4902977cc9..25262e198c 100644 --- a/compiler/nobjc.pas +++ b/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,12 +220,57 @@ function tobjcmessagesendnode.pass_1: tnode; result type, and on whether or not it's an inherited call. } + 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 + 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 - if not(cnf_inherited in tcallnode(left).callnodeflags) then - msgsendname:='OBJC_MSGSEND_STRET' - else - msgsendname:='OBJC_MSGSENDSUPER_STRET' + 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 @@ -234,23 +283,7 @@ function tobjcmessagesendnode.pass_1: tnode; else msgsendname:='OBJC_MSGSENDSUPER'; - newparas:=tcallparanode(tcallnode(left).left); - { Find the self and msgsel parameters. } - para:=newparas; - selfpara:=nil; - msgselpara:=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; - para:=tcallparanode(para.right); - end; - if not assigned(selfpara) then - internalerror(2009051801); - if not assigned(msgselpara) then - internalerror(2009051802); + { 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 diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas index d6220597f0..5f3f63a2b1 100644 --- a/compiler/pdecsub.pas +++ b/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 diff --git a/compiler/symconst.pas b/compiler/symconst.pas index 76f80137e2..9fa1a92e69 100644 --- a/compiler/symconst.pas +++ b/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; diff --git a/tests/test/tobjc20.pp b/tests/test/tobjc20.pp new file mode 100644 index 0000000000..2c4469e64b --- /dev/null +++ b/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.