freepascal.compiler/tests/test/tobjc11.pp

{ %target=darwin }
{ %cpu=powerpc,powerpc64,i386,x86_64,arm }

{ Written by Jonas Maebe in 2009, released into the public domain }

{$mode objfpc}
{$modeswitch objectivec1}
{$packenum 1}
{$packset 1}

procedure check(const name,a,b: string);
begin
  if (a<>b) then
    begin
      writeln('For ',name,' got: "',a,'", expected: "',b,'"');
      halt(1);
    end;
end;

procedure checksimpletypes;
type
  tenum = (ea,eb,ec);
  tprocedure = procedure;
var
  p: pointer;
begin
  check('char',objcencode(char),'C');
  check('widechar',objcencode(widechar),'S');
  check('void',objcencode(p^),'v');

  check('tenum',objcencode(tenum),'C');

  check('shortint',objcencode(shortint),'c');
  check('byte',objcencode(byte),'C');
  check('smallint',objcencode(smallint),'s');
  check('word',objcencode(word),'S');
  check('longint',objcencode(longint),'i');
  check('cardinal',objcencode(cardinal),'I');
  check('int64',objcencode(int64),'q');
  check('qword',objcencode(qword),'Q');
  check('shortstring',objcencode(shortstring),'[256C]');

  check('pointer',objcencode(pointer),'^v');
  
  check('single',objcencode(single),'f');
  check('double',objcencode(double),'d');
  
  check('tprocedure',objcencode(tprocedure),'^?');
  
  check('id',objcencode(id),'@');
  check('NSObject',objcencode(NSObject),'@');
  check('pobjc_class',objcencode(pobjc_class),'#');
  check('selector',objcencode(objcselector('alloc')),':');
end;


procedure checkarrays;
type
  ta = array[5..6] of byte;
  tb = array[1..10] of pointer;
  tc = array[0..3] of tb;
begin
  check('ta',objcencode(ta),'[2C]');
  check('tb',objcencode(tb),'[10^v]');
  check('tc',objcencode(tc),'[4[10^v]]');
end;


procedure checkrecords;
type
  tra=record
    a,b: longint;
  end;
  TStrippedVarRec = record
     case VType : shortint of
       vtInteger    : (VInteger: Longint);
       vtBoolean    : (VBoolean: Boolean);
       vtChar       : (VChar: Char);
       vtWideChar   : (VWideChar: WideChar);
       vtString     : (VString: PShortString);
       vtPointer    : (VPointer: Pointer);
       vtPChar      : (VPChar: PChar);
       vtObject     : (VObject: TObject);
       vtClass      : (VClass: TClass);
       vtPWideChar  : (VPWideChar: PWideChar);
       vtAnsiString : (VAnsiString: Pointer);
       vtInterface  : (VInterface: Pointer);
       vtWideString : (VWideString: Pointer);
       vtInt64      : (VInt64: PInt64);
       vtQWord      : (VQWord: PQWord);
   end;
 tnestedvarrechelper1 = record
   case byte of
     1: (f: single);
     2: (d: double);
 end;
 tnestedvarrechelper2 = record
   x: longint;
   y: shortint;
 end;
 tnestedvarrec = record
   a: longint;
   p: ^tra;
   case byte of
     1: (t: tnestedvarrechelper1);
     2: (t2: tnestedvarrechelper2);
     3: (bb: longint);
 end;
begin
  check('tra',objcencode(tra),'{tra=ii}');
  check('TStrippedVarRec',objcencode(TStrippedVarRec),'{TStrippedVarRec=c(?={?=i}{?=B}{?=C}{?=S}{?=^[256C]}{?=^v}{?=*}{?=^{TObject}}{?=^{TClass}}{?=^S}{?=^v}{?=^v}{?=^v}{?=^q}{?=^Q})}');
  check('TObject',objcencode(TObject),'^{TObject}');
  check('tnestedvarrec',objcencode(tnestedvarrec),'{tnestedvarrec=i^{tra}(?={?={tnestedvarrechelper1=(?={?=f}{?=d})}}{?={tnestedvarrechelper2=ic}}{?=i})}');
end;

procedure checksets;
type
  tset1 = set of 0..4;
  tset2 = set of 0..31;
  tset3 = set of 0..128;
begin
  check('tset1',objcencode(tset1),'{?=[1C]}');
  check('tset2',objcencode(tset2),'{?=[4C]}');
{$ifdef cpui386}
  { for some mysterious reason, sets are always passed by value for cdecl on
    i386 }
  check('tset3',objcencode(tset3),'{?=[17C]}');
{$else cpui386}
  check('tset3',objcencode(tset3),'[17C]');
{$endif cpui386}
end;



begin
  checksimpletypes;
  checkarrays;
  checkrecords;
  checksets;
end.