fpc/tests/test/tparray13.pp

{$mode macpas}

{$r-}

{$ifdef unix}
uses
  baseunix,unix;
{$endif}

procedure error(l: longint);
begin
  writeln('error near ',l);
  halt(1);
end;


procedure test8bit;
type
  ta = 0..1;
const
  b: packed array[0..9] of ta = (1,0,1,1,1,0,1,1,1,0);
  results: array[0..9] of ta = (1,0,1,1,1,0,1,1,1,0);
var
  i: longint;
begin
  if (sizeof(b)<>2) then
   error(1);
  for i := low(results) to high(results) do
    if b[i] <> results[i] then
      error(7);
end;


procedure test8to16bit;
type
  ta = 0..7;
const
  b: packed array[0..5] of ta = (2,4,1,7,5,1);
  results: array[0..5] of ta = (2,4,1,7,5,1);
var
  i: longint;
begin
  if (sizeof(b)<>3) then
    error(16);
  for i := low(results) to high(results) do
    if b[i] <> results[i] then
      error(17);
end;


procedure test16bit;
type
  ta = 0..511;
const
  b: packed array[0..4] of ta = (356,39,485,100,500);
  results: array[0..4] of ta = (356,39,485,100,500);
var
  i: longint;
begin
  if (sizeof(b)<>6) then
    error(26);
  for i := low(results) to high(results) do
    if b[i] <> results[i] then
      error(27);
end;


procedure test16to24bit;
type
  ta = 0..2047;
const
  b: packed array[0..4] of ta = (1000,67,853,512,759);
  results: array[0..4] of ta = (1000,67,853,512,759);
var
  i: longint;
begin
  if (sizeof(b)<>7) then
    error(36);
  for i := low(results) to high(results) do
    if b[i] <> results[i] then
      error(37);
end;


procedure test32bit;
type
  ta = 0..(1 shl 19) - 1;
const
  b: packed array[0..4] of ta = ($0002F687,$00032222,$000178EE,$000057970,$0007E1D2);
  results: array[0..4] of ta = ($0002F687,$00032222,$000178EE,$000057970,$0007E1D2);
var
  i: longint;
begin
  if (sizeof(b)<>12) then
    error(46);
  for i := low(results) to high(results) do
    if b[i] <> results[i] then
      error(47);
end;


procedure test32bit2;
type
  ta = 0..(1 shl 24) - 1;
  taa = packed array[0..3*32-1] of ta;
  paa = ^taa;
const
  b: packed array[0..3*32-1] of ta = (
$17E546,$6D0CA6,$BC9CCD,$34E268,$F2C58F,$492C7D,$DBDC0F,$375B2C,$8DCC08,$96FE74,
$EF0AAD,$8BBB1A,$DF4554,$B75B0C,$728566,$81059B,$8D51F1,$88EF21,$CFF51E,$29BAAC,
$C52266,$53315E,$A558E9,$093C36,$1357E7,$95CD2E,$173011,$770CB1,$85F746,$7601FE,
$F5CD6A,$4E77B1,$F99073,$7520DB,$3F86DF,$2E5B82,$3282B8,$3A9FCD,$831B0B,$2DC3E6,
$38426E,$22CA1A,$E4FE56,$1B562F,$9A7757,$33BE8B,$013A7A,$7A0A4D,$7BC0B0,$48BFFB,
$62FA6C,$B3D806,$BFD49E,$3B5AB0,$696A18,$CADC48,$458E79,$834F63,$97D7A5,$5C92CB,
$E8E260,$D95895,$3D2DF0,$7257F7,$33D25C,$389DD8,$21107B,$002344,$655E49,$FBA7EF,
$D91F7E,$F694A2,$60F469,$160183,$275CAD,$1B8D0B,$41512E,$4184DE,$4319A9,$C93977,
$D8D40A,$6EBEA5,$C137B8,$82BED4,$67DAC6,$142013,$614C0E,$38867C,$BE1CDD,$6A40E5,
$518787,$219852,$48BD56,$827F40,$3CC0A6,$E79AF6
  );

  results: array[0..3*32-1] of ta = (
$17E546,$6D0CA6,$BC9CCD,$34E268,$F2C58F,$492C7D,$DBDC0F,$375B2C,$8DCC08,$96FE74,
$EF0AAD,$8BBB1A,$DF4554,$B75B0C,$728566,$81059B,$8D51F1,$88EF21,$CFF51E,$29BAAC,
$C52266,$53315E,$A558E9,$093C36,$1357E7,$95CD2E,$173011,$770CB1,$85F746,$7601FE,
$F5CD6A,$4E77B1,$F99073,$7520DB,$3F86DF,$2E5B82,$3282B8,$3A9FCD,$831B0B,$2DC3E6,
$38426E,$22CA1A,$E4FE56,$1B562F,$9A7757,$33BE8B,$013A7A,$7A0A4D,$7BC0B0,$48BFFB,
$62FA6C,$B3D806,$BFD49E,$3B5AB0,$696A18,$CADC48,$458E79,$834F63,$97D7A5,$5C92CB,
$E8E260,$D95895,$3D2DF0,$7257F7,$33D25C,$389DD8,$21107B,$002344,$655E49,$FBA7EF,
$D91F7E,$F694A2,$60F469,$160183,$275CAD,$1B8D0B,$41512E,$4184DE,$4319A9,$C93977,
$D8D40A,$6EBEA5,$C137B8,$82BED4,$67DAC6,$142013,$614C0E,$38867C,$BE1CDD,$6A40E5,
$518787,$219852,$48BD56,$827F40,$3CC0A6,$E79AF6
);
var
  i: longint;
{$ifdef unix}
  p,p2,p3: pbyte;
  bp: paa;
  mapsize: ptruint;
  first: boolean;
{$endif}
begin
  if (sizeof(b)<>3*length(results)) then
    error(48);
{$ifdef unix}
  { check for reading past end of array }
  mapsize:=4096;
  { look for a place where we can map one page and are certain that there's
    no valid page right behind it
  }
  for i:=1 to 18 do
    begin
      p:=fpmmap(nil,mapsize*3,PROT_READ or PROT_WRITE,MAP_PRIVATE or MAP_ANONYMOUS,-1,0);
      if (p<>pointer(-1)) then
        begin
          fpmunmap(p,mapsize*3);
          p2:=fpmmap(p,mapsize,PROT_READ or PROT_WRITE,MAP_PRIVATE or MAP_ANONYMOUS,-1,0);
          if (p2=p) then
            break;
          p2:=pointer(-1);
        end;
    end;
  if (p2 = pointer(-1)) then
    { didn't find a suitable mapping }
    exit;
  move(b,pbyte(ptruint(p)+mapsize-sizeof(b))^,sizeof(b));
  bp := paa(ptruint(p)+mapsize-sizeof(b));
  for i := low(results) to high(results) do
    if bp^[i] <> results[i] then
      begin
        writeln(i);
        error(49);
      end;
  fpmunmap(p,mapsize);
{$else}
  for i := low(results) to high(results) do
    if b[i] <> results[i] then
      begin
        writeln(i);
        error(49);
      end;
{$endif}
end;


procedure test32to40bit;
type
  ta = 0..$7fffffff;
const
  b: packed array[0..4] of ta = ($71567851,$56789ABD,$50F11178,$39D68DDC,$6C7A5A7);
  results: array[0..4] of ta = ($71567851,$56789ABD,$50F11178,$39D68DDC,$6C7A5A7);
var
  i: longint;
begin
  if (sizeof(b)<>20) then
    error(56);
  for i := low(results) to high(results) do
    if b[i] <> results[i] then
      error(57);
end;

begin
  test8bit;
  test8to16bit;
  test16bit;
  test16to24bit;
  test32bit;
  test32bit2;
  test32to40bit;
end.