mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-15 01:49:20 +02:00
* fixed passing var/out parameters to obj-c methods (test by Gorazd Krosl)
git-svn-id: branches/objc@13752 -
This commit is contained in:
parent
c1305f046e
commit
5fa268db01
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -8349,6 +8349,7 @@ tests/test/opt/twpo6.pp svneol=native#text/plain
|
|||||||
tests/test/opt/twpo7.pp svneol=native#text/plain
|
tests/test/opt/twpo7.pp svneol=native#text/plain
|
||||||
tests/test/opt/uwpo2.pp svneol=native#text/plain
|
tests/test/opt/uwpo2.pp svneol=native#text/plain
|
||||||
tests/test/packages/cocoaint/tobjcnh1.pp svneol=native#text/plain
|
tests/test/packages/cocoaint/tobjcnh1.pp svneol=native#text/plain
|
||||||
|
tests/test/packages/cocoaint/tvarpara.pp svneol=native#text/plain
|
||||||
tests/test/packages/fcl-base/tascii85.pp svneol=native#text/plain
|
tests/test/packages/fcl-base/tascii85.pp svneol=native#text/plain
|
||||||
tests/test/packages/fcl-base/tgettext1.pp svneol=native#text/plain
|
tests/test/packages/fcl-base/tgettext1.pp svneol=native#text/plain
|
||||||
tests/test/packages/fcl-db/assertions.pas svneol=native#text/plain
|
tests/test/packages/fcl-db/assertions.pas svneol=native#text/plain
|
||||||
|
@ -227,7 +227,9 @@ function tobjcmessagesendnode.pass_1: tnode;
|
|||||||
|
|
||||||
tempresult:=nil;
|
tempresult:=nil;
|
||||||
newparas:=tcallparanode(tcallnode(left).left);
|
newparas:=tcallparanode(tcallnode(left).left);
|
||||||
{ Find the self and msgsel parameters. }
|
{ Find the self and msgsel parameters, and if we have var/out parameters
|
||||||
|
that normally aren't passed by reference in C, add addrnodes
|
||||||
|
}
|
||||||
para:=newparas;
|
para:=newparas;
|
||||||
selfpara:=nil;
|
selfpara:=nil;
|
||||||
msgselpara:=nil;
|
msgselpara:=nil;
|
||||||
@ -243,7 +245,12 @@ function tobjcmessagesendnode.pass_1: tnode;
|
|||||||
begin
|
begin
|
||||||
prerespara:=prevpara;
|
prerespara:=prevpara;
|
||||||
respara:=para;
|
respara:=para;
|
||||||
end;
|
end
|
||||||
|
{ All parameters will be passed as varargs to objc_msg*, so make
|
||||||
|
sure that in case of var/out parameters, the address is passed. }
|
||||||
|
else if (para.parasym.varspez in [vs_var,vs_out]) and
|
||||||
|
not paramanager.push_addr_param(vs_value,para.parasym.vardef,pocall_cdecl) then
|
||||||
|
para.left:=caddrnode.create(para.left);
|
||||||
prevpara:=para;
|
prevpara:=para;
|
||||||
para:=tcallparanode(para.right);
|
para:=tcallparanode(para.right);
|
||||||
end;
|
end;
|
||||||
|
75
tests/test/packages/cocoaint/tvarpara.pp
Executable file
75
tests/test/packages/cocoaint/tvarpara.pp
Executable file
@ -0,0 +1,75 @@
|
|||||||
|
{ %target=darwin }
|
||||||
|
{ %cpu=powerpc,i386 }
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
{$modeswitch objectivec1}
|
||||||
|
program Start;
|
||||||
|
uses
|
||||||
|
ctypes,
|
||||||
|
CocoaAll;
|
||||||
|
|
||||||
|
type
|
||||||
|
unichar=word;
|
||||||
|
punichar = ^unichar;
|
||||||
|
MyObject = objcclass(NSObject)
|
||||||
|
procedure receiveByVar_length(var chars : unichar; length : culong); message 'receiveByVar:length:';
|
||||||
|
procedure receiveByPtr_length(chars : punichar; length : culong); message 'receiveByPtr:length:';
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
c: array[0..1] of unichar;
|
||||||
|
|
||||||
|
procedure MyObject.receiveByVar_length(var chars : unichar; length : culong);
|
||||||
|
begin
|
||||||
|
Writeln('MyObject.receiveByVar_length');
|
||||||
|
writeln('address of `chars`: 0x', HexStr(Pointer(@chars)));
|
||||||
|
Writeln;
|
||||||
|
if @chars<>@c[0] then
|
||||||
|
halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure MyObject.receiveByPtr_length(chars : punichar; length : culong);
|
||||||
|
begin
|
||||||
|
Writeln('MyObject.receiveByPtr_length');
|
||||||
|
writeln('address of `chars`: 0x', HexStr(Pointer(chars)));
|
||||||
|
Writeln;
|
||||||
|
if chars<>@c[0] then
|
||||||
|
halt(2);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure passByVar(var chars : unichar);
|
||||||
|
begin
|
||||||
|
Writeln('passByVar');
|
||||||
|
writeln('address of `chars`: 0x', HexStr(Pointer(@chars)));
|
||||||
|
Writeln;
|
||||||
|
if @chars<>@c[0] then
|
||||||
|
halt(3);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure passByPtr(chars : punichar);
|
||||||
|
begin
|
||||||
|
Writeln('passByPtr');
|
||||||
|
writeln('address of `chars`: 0x', HexStr(Pointer(chars)));
|
||||||
|
Writeln;
|
||||||
|
if chars<>@c[0] then
|
||||||
|
halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure MyVarTest;
|
||||||
|
var
|
||||||
|
o: MyObject;
|
||||||
|
begin
|
||||||
|
o := MyObject(MyObject.alloc).init;
|
||||||
|
o.receiveByVar_length(c[0], 1);
|
||||||
|
o.receiveByPtr_length(@c[0], 1);
|
||||||
|
passByVar(c[0]);
|
||||||
|
passByPtr(@c[0]);
|
||||||
|
o.release
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
begin
|
||||||
|
c[0]:=unichar(widechar('c'));
|
||||||
|
c[1]:=unichar(widechar(#0));
|
||||||
|
MyVarTest;
|
||||||
|
end.
|
Loading…
Reference in New Issue
Block a user