mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-12-04 04:17:53 +01:00
* 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 -
This commit is contained in:
parent
a36f888a17
commit
6fcd29c190
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
75
tests/test/tobjc20.pp
Normal file
75
tests/test/tobjc20.pp
Normal file
@ -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.
|
||||
Loading…
Reference in New Issue
Block a user