pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

updated test for small records

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@758 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz
2009-04-03 05:54:00 +00:00
parent 1ca6ded0d7
commit a271d2f11f
1 changed files with 30 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

29
bindings/objc/objcrtltest.pas
View File

@ -23,6 +23,13 @@ uses
{.$linkframework AppKit} {.$linkframework AppKit}
{.$linkframework Foundation} {.$linkframework Foundation}
type
PSmallRecord = ^TSmallRecord;
TSmallRecord = packed record
a,b,c: byte;
//d: byte;
end;
const const
newClassName = 'NSMyObject'; newClassName = 'NSMyObject';
overrideMethod = 'init'; overrideMethod = 'init';
@ -40,6 +47,9 @@ const
newMethod4 = 'getFloat'; newMethod4 = 'getFloat';
newMethod4Enc = 'f@:'; newMethod4Enc = 'f@:';
newMethod5 = 'getSmallRecord';
newMethod5Enc = '{TSmallRecord=ccc}@:';
function imp_init(self: id; _cmd: SEL): id; cdecl; function imp_init(self: id; _cmd: SEL): id; cdecl;
var var
@ -69,6 +79,14 @@ begin
Result := 3.125; Result := 3.125;
end; end;
procedure imp_getSmallRec(Result: PSmallRecord; seld: id; _cmd: SEL); cdecl;
begin
Result^.a := 121;
Result^.b := 68;
Result^.c := 22;
//Result.d := 5;
end;
procedure RegisterSubclass(NewClassName: PChar); procedure RegisterSubclass(NewClassName: PChar);
var var
@ -81,12 +99,15 @@ begin
class_addMethod(cl, selector(newMethod2), @imp_newMethod2, newMethod2Enc) and class_addMethod(cl, selector(newMethod2), @imp_newMethod2, newMethod2Enc) and
class_addMethod(cl, selector(newMethod3), @imp_newMethod3, newMethod3Enc) and class_addMethod(cl, selector(newMethod3), @imp_newMethod3, newMethod3Enc) and
class_addMethod(cl, selector(newMethod4), @imp_newMethod4, newMethod4Enc); class_addMethod(cl, selector(newMethod4), @imp_newMethod4, newMethod4Enc);
class_addMethod(cl, selector(newMethod5), @imp_getSmallRec, newMethod5Enc);
if not b then writeln('failed to add/override some method(s)'); if not b then writeln('failed to add/override some method(s)');
objc_registerClassPair(cl); objc_registerClassPair(cl);
end; end;
var var
obj : id; obj : id;
stret : TSmallRecord;
buf : array [0..255] of byte;
begin begin
// if InitializeObjcRtl20(DefaultObjCLibName) then // should be used of OSX 10.5 and iPhoneOS // if InitializeObjcRtl20(DefaultObjCLibName) then // should be used of OSX 10.5 and iPhoneOS
@ -109,8 +130,16 @@ begin
writeln('get double = ', objc_msgSend_fpret(obj, selector(newMethod3), [])); writeln('get double = ', objc_msgSend_fpret(obj, selector(newMethod3), []));
writeln('get float = ', objc_msgSend_fpret(obj, selector(newMethod4), [])); writeln('get float = ', objc_msgSend_fpret(obj, selector(newMethod4), []));
writeln('sizeof(TSmallRecord) = ', sizeof(TSmallRecord));
objc_msgSend_stret(@stret, obj, selector(newMethod5), []);
writeln('stret.a = ', stret.a);
writeln('stret.b = ', stret.b);
writeln('stret.c = ', stret.c);
release( obj ); release( obj );
writeln('test successfully complete'); writeln('test successfully complete');
end. end.