path: root/fpcsrc/tests/test/cg/tcalext5.pp

{ Tests passing of different records by value to C methods. 
 One type of these records has one field which is a simple array of bytes,
 the other consists of a few fields of atomic size.
 
 Note that it does not only test a single field of these records, but all
 by comparing the sum of the field values with the sum returned by the
 C function.
}
program calext3;
{$MODE DELPHI}

{ requires libgcc for the C functions }
{$ifdef FPUSOFT}
  {$define NO_FLOAT}
{$endif}

type
  int8_t = shortint;
  pint8_t = ^int8_t;
  int16_t = smallint;
  int32_t = longint;
  int64_t = int64;

var
  success : boolean;

{$packrecords c}

type
  struct_arr1 = record
    v : array[0..0] of int8_t;
  end;

  struct_arr2 = record
    v : array[0..1] of int8_t;
  end;

  struct_arr3 = record
    v : array[0..2] of int8_t;
  end;

  struct_arr4 = record
    v : array[0..3] of int8_t;
  end;

  struct_arr5 = record
    v : array[0..4] of int8_t;
  end;

  struct_arr6 = record
    v : array[0..5] of int8_t;
  end;

  struct_arr7 = record
    v : array[0..6] of int8_t;
  end;

  struct_arr8 = record
    v : array[0..7] of int8_t;
  end;

  struct_arr9 = record
    v : array[0..8] of int8_t;
  end;

  struct_arr10 = record
    v : array[0..9] of int8_t;
  end;

  struct_arr11 = record
    v : array[0..10] of int8_t;
  end;

  struct_arr15 = record
    v : array[0..14] of int8_t;
  end;

  struct_arr16 = record
    v : array[0..15] of int8_t;
  end;

  struct_arr17 = record
    v : array[0..16] of int8_t;
  end;


  struct_arr27 = record
    v : array[0..26] of int8_t;
  end;

  struct_arr31 = record
    v : array[0..30] of int8_t;
  end;

  struct_arr32 = record
    v : array[0..31] of int8_t;
  end;

  struct_arr33 = record
    v : array[0..32] of int8_t;
  end;


  struct1 = record
    v : int8_t;
  end;

  struct2 = record
    v : int16_t;
  end;

  struct3 = record
    v1 : int16_t;
    v2 : int8_t;
  end;

  struct4 = record
    v : int32_t;
  end;

  struct5 = record
    v1 : int32_t;
    v2 : int8_t;
  end;

  struct6 = record
    v1 : int32_t;
    v2 : int16_t;
  end;
  
  struct7 = record
    v1 : int32_t;
    v2 : int16_t;
    v3 : int8_t;
  end;

  struct8 = record
    v : int64_t
  end;

  struct9 = record
    v1 : int64_t;
    v2 : int8_t;
  end;

  struct10 = record
    v1 : int64_t;
    v2 : int16_t;
  end;

  struct11 = record
    v1 : int64_t;
    v2 : int16_t;
    v3 : int8_t;
  end;

  struct12 = record
    v1 : int64_t;
    v2 : int32_t;
  end;

  struct13 = record
    v1 : int64_t;
    v2 : int32_t;
    v3 : int8_t;
  end;

  struct14 = record
    v1 : int64_t;
    v2 : int32_t;
    v3 : int16_t;
  end;
  
  struct15 = record 
    v1 : int64_t;
    v2 : int32_t;
    v3 : int16_t;
    v4 : int8_t;
  end;

  struct16 = record
    v1 : int64_t;
    v2 : int64_t;
  end;

  struct31 = record
    v1 : int64_t;
    v2 : int64_t;
    v3 : int64_t;
    v4 : int32_t;
    v5 : int16_t;
    v6 : int8_t;
  end;

procedure fill(var mem; size : integer);
var
  i : Integer;
  p : pint8_t;
begin
  p := @mem;
  for i := 0 to size-1 do begin
    p^ := random(255)+1;
    inc(p);
  end;
end;

procedure verify(val1, val2 : int64_t; nr : Integer);
begin
  success := success and (val1 = val2);
  Write('Testing test ', nr , ', was ', val1, ', should be ', val2, '...');
  if (val1 = val2) then
    WriteLn('Success.')
  else
    WriteLn('Failed');
end;

function check1(s : struct1) : int64_t;
begin
  result := s.v;
end;

function check2(s : struct2) : int64_t;
begin
  result := s.v;
end;

function check3(s : struct3) : int64_t;
begin
  result := s.v1 + s.v2;
end;

function check4(s : struct4) : int64_t;
begin
  result := s.v;
end;

function check5(s : struct5) : int64_t;
begin
  result := s.v1 + s.v2;
end;

function check6(s : struct6) : int64_t;
begin
  result := s.v1 + s.v2;
end;

function check7(s : struct7) : int64_t;
begin
  result := s.v1 + s.v2 + s.v3;
end;

function check8(s : struct8) : int64_t;
begin
  result := s.v;
end;

function check9(s : struct9) : int64_t;
begin
  result := s.v1 + s.v2;
end;

function check10(s : struct10) : int64_t;
begin
  result := s.v1 + s.v2;
end;

function check11(s : struct11) : int64_t;
begin
  result := s.v1 + s.v2 + s.v3;
end;

function check12(s : struct12) : int64_t;
begin
  result := s.v1 + s.v2;
end;

function check13(s : struct13) : int64_t;
begin
  result := s.v1 + s.v2 + s.v3;
end;

function check14(s : struct14) : int64_t;
begin
  result := s.v1 + s.v2 + s.v3;
end;

function check15(s : struct15) : int64_t;
begin
  result := s.v1 + s.v2 + s.v3 + s.v4;
end;

function check16(s : struct16) : int64_t;
begin
  result := s.v1 + s.v2;
end;

function check31(s : struct31) : int64_t;
begin
  result := s.v1 + s.v2 + s.v3 + s.v4 + s.v5 + s.v6;
end;


function check_arr1(s : struct_arr1) : int64_t;
var
  i : int32_t;
begin
  result := 0;
  for i := low(s.v) to high(s.v) do
    inc(result, s.v[i]);
end;

function check_arr2(s : struct_arr2) : int64_t;
var
  i : int32_t;
begin
  result := 0;
  for i := low(s.v) to high(s.v) do
    inc(result, s.v[i]);
end;

function check_arr3(s : struct_arr3) : int64_t;
var
  i : int32_t;
begin
  result := 0;
  for i := low(s.v) to high(s.v) do
    inc(result, s.v[i]);
end;

function check_arr4(s : struct_arr4) : int64_t;
var
  i : int32_t;
begin
  result := 0;
  for i := low(s.v) to high(s.v) do
    inc(result, s.v[i]);
end;

function check_arr5(s : struct_arr5) : int64_t;
var
  i : int32_t;
begin
  result := 0;
  for i := low(s.v) to high(s.v) do
    inc(result, s.v[i]);
end;

function check_arr6(s : struct_arr6) : int64_t;
var
  i : int32_t;
begin
  result := 0;
  for i := low(s.v) to high(s.v) do
    inc(result, s.v[i]);
end;

function check_arr7(s : struct_arr7) : int64_t;
var
  i : int32_t;
begin
  result := 0;
  for i := low(s.v) to high(s.v) do
    inc(result, s.v[i]);
end;

function check_arr8(s : struct_arr8) : int64_t;
var
  i : int32_t;
begin
  result := 0;
  for i := low(s.v) to high(s.v) do
    inc(result, s.v[i]);
end;

function check_arr9(s : struct_arr9) : int64_t;
var
  i : int32_t;
begin
  result := 0;
  for i := low(s.v) to high(s.v) do
    inc(result, s.v[i]);
end;

function check_arr10(s : struct_arr10) : int64_t;
var
  i : int32_t;
begin
  result := 0;
  for i := low(s.v) to high(s.v) do
    inc(result, s.v[i]);
end;

function check_arr11(s : struct_arr11) : int64_t;
var
  i : int32_t;
begin
  result := 0;
  for i := low(s.v) to high(s.v) do
    inc(result, s.v[i]);
end;

function check_arr15(s : struct_arr15) : int64_t;
var
  i : int32_t;
begin
  result := 0;
  for i := low(s.v) to high(s.v) do
    inc(result, s.v[i]);
end;

function check_arr16(s : struct_arr16) : int64_t;
var
  i : int32_t;
begin
  result := 0;
  for i := low(s.v) to high(s.v) do
    inc(result, s.v[i]);
end;

function check_arr17(s : struct_arr17) : int64_t;
var
  i : int32_t;
begin
  result := 0;
  for i := low(s.v) to high(s.v) do
    inc(result, s.v[i]);
end;

function check_arr27(s : struct_arr27) : int64_t;
var
  i : int32_t;
begin
  result := 0;
  for i := low(s.v) to high(s.v) do
    inc(result, s.v[i]);
end;

function check_arr31(s : struct_arr31) : int64_t;
var
  i : int32_t;
begin
  result := 0;
  for i := low(s.v) to high(s.v) do
    inc(result, s.v[i]);
end;

function check_arr32(s : struct_arr32) : int64_t;
var
  i : int32_t;
begin
  result := 0;
  for i := low(s.v) to high(s.v) do
    inc(result, s.v[i]);
end;

function check_arr33(s : struct_arr33) : int64_t;
var
  i : int32_t;
begin
  result := 0;
  for i := low(s.v) to high(s.v) do
    inc(result, s.v[i]);
end;

{$L tcext5.o}
function pass1(s : struct1; b: byte) : int64_t; cdecl; external;
function pass2(s : struct2; b: byte) : int64_t; cdecl; external;
function pass3(s : struct3; b: byte) : int64_t; cdecl; external;
function pass4(s : struct4; b: byte) : int64_t; cdecl; external;
function pass5(s : struct5; b: byte) : int64_t; cdecl; external;
function pass6(s : struct6; b: byte) : int64_t; cdecl; external;
function pass7(s : struct7; b: byte) : int64_t; cdecl; external;
function pass8(s : struct8; b: byte) : int64_t; cdecl; external;
function pass9(s : struct9; b: byte) : int64_t; cdecl; external;
function pass10(s : struct10; b: byte) : int64_t; cdecl; external;
function pass11(s : struct11; b: byte) : int64_t; cdecl; external;
function pass12(s : struct12; b: byte) : int64_t; cdecl; external;
function pass13(s : struct13; b: byte) : int64_t; cdecl; external;
function pass14(s : struct14; b: byte) : int64_t; cdecl; external;
function pass15(s : struct15; b: byte) : int64_t; cdecl; external;
function pass31(s : struct31; b: byte) : int64_t; cdecl; external;
function pass311(s : struct31; s1: struct1; b: byte) : int64_t; cdecl; external;
function pass312(s : struct31; s2: struct2; b: byte) : int64_t; cdecl; external;
function pass313(s : struct31; s3: struct3; b: byte) : int64_t; cdecl; external;
function pass11db10db(s11: struct11; d1: double; b1: byte; s10: struct10; s2: double; b2: byte): int64_t; cdecl; external;


function pass_arr1(s : struct_arr1; b: byte) : int64_t; cdecl; external;
function pass_arr2(s : struct_arr2; b: byte) : int64_t; cdecl; external;
function pass_arr3(s : struct_arr3; b: byte) : int64_t; cdecl; external;
function pass_arr4(s : struct_arr4; b: byte) : int64_t; cdecl; external;
function pass_arr5(s : struct_arr5; b: byte) : int64_t; cdecl; external;
function pass_arr6(s : struct_arr6; b: byte) : int64_t; cdecl; external;
function pass_arr7(s : struct_arr7; b: byte) : int64_t; cdecl; external;
function pass_arr8(s : struct_arr8; b: byte) : int64_t; cdecl; external;
function pass_arr9(s : struct_arr9; b: byte) : int64_t; cdecl; external;
function pass_arr10(s : struct_arr10; b: byte) : int64_t; cdecl; external;
function pass_arr11(s : struct_arr11; b: byte) : int64_t; cdecl; external;
function pass_arr15(s : struct_arr15; b: byte) : int64_t; cdecl; external;
function pass_arr16(s : struct_arr16; b: byte) : int64_t; cdecl; external;
function pass_arr17(s : struct_arr17; b: byte) : int64_t; cdecl; external;

function pass_arr27(s : struct_arr27; b: byte) : int64_t; cdecl; external;

function pass_arr31(s : struct_arr31; b: byte) : int64_t; cdecl; external;
function pass_arr32(s : struct_arr32; b: byte) : int64_t; cdecl; external;
function pass_arr33(s : struct_arr33; b: byte) : int64_t; cdecl; external;

procedure dotest;
var
  sa1 : struct_arr1;
  sa2 : struct_arr2;
  sa3 : struct_arr3;
  sa4 : struct_arr4;
  sa5 : struct_arr5;
  sa6 : struct_arr6;
  sa7 : struct_arr7;
  sa8 : struct_arr8;
  sa9 : struct_arr9;
  sa10 : struct_arr10;
  sa11 : struct_arr11;
  sa15 : struct_arr15;
  sa16 : struct_arr16;
  sa17 : struct_arr17;
  sa27 : struct_arr27;
  sa31 : struct_arr31;
  sa32 : struct_arr32;
  sa33 : struct_arr33;
  
  s1 : struct1;
  s2 : struct2;
  s3 : struct3;
  s4 : struct4;
  s5 : struct5;
  s6 : struct6;
  s7 : struct7;
  s8 : struct8;
  s9 : struct9;
  s10 : struct10;
  s11 : struct11;
  s12 : struct12;
  s13 : struct13;
  s14 : struct14;
  s15 : struct15;
  s31 : struct31;
  
  c: cardinal;

begin
  randseed := 30;
  success := true;
  fill(s1, sizeof(s1));
  fill(s2, sizeof(s2));
  fill(s3, sizeof(s3));
  fill(s4, sizeof(s4));
  fill(s5, sizeof(s5));
  fill(s6, sizeof(s6));
  fill(s7, sizeof(s7));
  fill(s8, sizeof(s8));
  fill(s9, sizeof(s9));
  fill(s10, sizeof(s10));
  fill(s11, sizeof(s11));
  fill(s12, sizeof(s12));
  fill(s13, sizeof(s13));
  fill(s14, sizeof(s14));
  fill(s15, sizeof(s15));
  fill(s31, sizeof(s31));

  fill(sa1, sizeof(sa1));
  fill(sa2, sizeof(sa2));
  fill(sa3, sizeof(sa3));
  fill(sa4, sizeof(sa4));
  fill(sa5, sizeof(sa5));
  fill(sa6, sizeof(sa6));
  fill(sa7, sizeof(sa7));
  fill(sa8, sizeof(sa8));
  fill(sa9, sizeof(sa9));
  fill(sa10, sizeof(sa10));
  fill(sa11, sizeof(sa11));
  fill(sa15, sizeof(sa15));
  fill(sa16, sizeof(sa16));
  fill(sa17, sizeof(sa17));
  fill(sa27, sizeof(sa27));
  fill(sa31, sizeof(sa31));
  fill(sa32, sizeof(sa32));
  fill(sa33, sizeof(sa33));


  { check that the upper bits of the parameter are cleared when required }
  c:=$f070d001;
  verify(pass1(s1,c), check1(s1), 1);
  verify(pass2(s2,2), check2(s2), 2);
  verify(pass3(s3,3), check3(s3), 3);
  verify(pass4(s4,4), check4(s4), 4);
  verify(pass5(s5,5), check5(s5), 5);
  verify(pass6(s6,6), check6(s6), 6);
  verify(pass7(s7,7), check7(s7), 7);
  verify(pass8(s8,8), check8(s8), 8);
  verify(pass9(s9,9), check9(s9), 9);
  verify(pass10(s10,10), check10(s10), 10);
  verify(pass11(s11,11), check11(s11), 11);
  verify(pass12(s12,12), check12(s12), 12);
  verify(pass13(s13,13), check13(s13), 13);
  verify(pass14(s14,14), check14(s14), 14);
  verify(pass15(s15,15), check15(s15), 15);
  verify(pass31(s31,31), check31(s31), 31);
  { special cases for ppc/aix abi }
  verify(pass311(s31,s1,32), check1(s1), 32);
  verify(pass312(s31,s2,33), check2(s2), 33);
  verify(pass313(s31,s3,34), check3(s3), 34);
{$ifndef NO_FLOAT}
  verify(pass11db10db(s11,12345.678,35,s10,98745.453,36), check10(s10), 35);
{$endif}

  verify(pass_arr1(sa1,101), check_arr1(sa1), 101);
  verify(pass_arr2(sa2,102), check_arr2(sa2), 102);
  verify(pass_arr3(sa3,103), check_arr3(sa3), 103);
  verify(pass_arr4(sa4,104), check_arr4(sa4), 104);
  verify(pass_arr5(sa5,105), check_arr5(sa5), 105);
  verify(pass_arr6(sa6,106), check_arr6(sa6), 106);
  verify(pass_arr7(sa7,107), check_arr7(sa7), 107);
  verify(pass_arr8(sa8,108), check_arr8(sa8), 108);
  verify(pass_arr9(sa9,109), check_arr9(sa9), 109);
  verify(pass_arr10(sa10,110), check_arr10(sa10), 110);
  verify(pass_arr11(sa11,111), check_arr11(sa11), 111);
  verify(pass_arr15(sa15,115), check_arr15(sa15), 115);
  verify(pass_arr16(sa16,116), check_arr16(sa16), 116);
  verify(pass_arr17(sa17,117), check_arr17(sa17), 117);
  verify(pass_arr27(sa27,127), check_arr27(sa27), 127);

  verify(pass_arr31(sa31,131), check_arr31(sa31), 131);
  verify(pass_arr32(sa32,132), check_arr32(sa32), 132);
  verify(pass_arr33(sa33,133), check_arr33(sa33), 133);

  if (not success) then
    halt(1);
end;

begin
  dotest;
end.