From 9d8649a5db67e19b15785b8f7f660798e9aa107a Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Wed, 16 Aug 2006 21:37:31 +0000
Subject: [PATCH] + another packarray test which works
git-svn-id: trunk@4429 -
---
.gitattributes | 1 +
tests/test/tparray6.pp | 294 +++++++++++++++++++++++++++++++++++++++++
2 files changed, 295 insertions(+)
create mode 100644 tests/test/tparray6.pp
diff --git a/.gitattributes b/.gitattributes
index b2b62a38b7..7be142063f 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -6142,6 +6142,7 @@ tests/test/tparray2.pp svneol=native#text/plain
tests/test/tparray3.pp svneol=native#text/plain
tests/test/tparray4.pp svneol=native#text/plain
tests/test/tparray5.pp svneol=native#text/plain
+tests/test/tparray6.pp svneol=native#text/plain
tests/test/tpftch1.pp svneol=native#text/plain
tests/test/tprocext.pp svneol=native#text/plain
tests/test/tprocvar1.pp svneol=native#text/plain
diff --git a/tests/test/tparray6.pp b/tests/test/tparray6.pp
new file mode 100644
index 0000000000..2719f8bcd7
--- /dev/null
+++ b/tests/test/tparray6.pp
@@ -0,0 +1,294 @@
+{$mode macpas}
+
+{$r-}
+
+procedure error(l: longint);
+begin
+ writeln('error near ',l);
+ halt(1);
+end;
+
+procedure test8bit;
+type
+ ta = 0..1;
+ tb = packed array[0..999] of ta;
+ tc = array[0..124] of byte;
+const
+{$ifdef ENDIAN_BIG}
+ results: array[0..9] of ta = (1,0,1,0,1,0,1,0,1,0);
+{$else}
+ results: array[0..9] of ta = (0,1,0,1,0,1,0,1,0,1);
+{$endif}
+var
+ a: ta;
+ b: tb;
+ i: longint;
+begin
+ b[0] := results[0];
+ b[1] := results[1];
+ b[2] := results[2];
+ b[3] := results[3];
+ b[4] := results[4];
+ b[5] := results[5];
+ b[6] := results[6];
+ b[7] := results[7];
+ b[8] := results[8];
+ b[9] := results[9];
+ if (b[0] <> results[0]) then
+ error(1);
+ if (b[1] <> results[1]) then
+ error(2);
+ if (b[2] <> results[2]) then
+ error(3);
+ if (b[3] <> results[3]) then
+ error(4);
+ if (b[4] <> results[4]) then
+ error(5);
+// if (b[600] <> 1) then
+// error(6);
+ for i := low(results) to high(results) do
+ if b[i] <> results[i] then
+ error(7);
+// i := 500;
+// if (b[i] <> 1) then
+// error(8);
+end;
+
+
+procedure test8to16bit;
+type
+ ta = 0..7;
+ tb = packed array[0..1000] of ta;
+const
+{$ifdef ENDIAN_BIG}
+{ 010 110 100 101 101 001 011 010 010 11010010110100101101001011010 }
+
+ results: array[0..5] of ta = (2,6,4,5,5,1);
+{$else}
+{ (memory layout is different but equivalent with starting at end }
+{ 01011010010110100101101001011 010 010 110 100 101 101 001 011 010 }
+ results: array[0..5] of ta = (2,3,1,5,5,4);
+{$endif}
+var
+ a: ta;
+ b: tb;
+ i: longint;
+begin
+ b[0] := results[0];
+ b[1] := results[1];
+ b[2] := results[2];
+ b[3] := results[3];
+ b[4] := results[4];
+ b[5] := results[5];
+ if (b[0] <> results[0]) then
+ error(11);
+ if (b[1] <> results[1]) then
+ error(12);
+ if (b[2] <> results[2]) then
+ error(13);
+ if (b[3] <> results[3]) then
+ error(14);
+ if (b[4] <> results[4]) then
+ error(15);
+ if (b[5] <> results[5]) then
+ error(155);
+// if (b[600] <> 2) then
+// error(16);
+ for i := low(results) to high(results) do
+ if b[i] <> results[i] then
+ error(17);
+// i := 500;
+// if (b[i] <> 5) then
+// error(18);
+end;
+
+
+procedure test16bit;
+type
+ ta = 0..511;
+ tb = packed array[0..799] of ta;
+ tc = array[0..899] of byte;
+const
+{$ifdef ENDIAN_BIG}
+ { 010110100 111011001 011010011 101100101 101001110 110010110 100111011 001011010 0111011001011010011101100101101001110110 }
+ results: array[0..4] of ta = ($5A*2,$76 * 4 + 1,$69 * 2 + 1,$B2 * 2 + 1,$A7 * 2);
+{$else}
+ { algorithm: cut bit string in 16 bit chunks, byteswap, take 9 bits from right to left per chunck, continuing at the right of the next chunck if the previous one is used up }
+ { 001011010 100111011 110010110 101001110 101100101 011 0101101001110110010110100111011001011010011101100101101001110110 }
+
+ results: array[0..4] of ta = ($2D*2,$9D*2+1,$CB*2,$A7*2,$B2*2+1);
+{$endif}
+var
+ a: ta;
+ b: tb;
+ i: longint;
+begin
+ b[0] := results[0];
+ b[1] := results[1];
+ b[2] := results[2];
+ b[3] := results[3];
+ b[4] := results[4];
+ if (b[0] <> results[0]) then
+ error(21);
+ if (b[1] <> results[1]) then
+ error(22);
+ if (b[2] <> results[2]) then
+ error(23);
+ if (b[3] <> results[3]) then
+ error(24);
+ if (b[4] <> results[4]) then
+ error(25);
+// if (b[600] <> $76 * 2) then
+// error(26);
+ for i := low(results) to high(results) do
+ if b[i] <> results[i] then
+ error(27);
+// i := 500;
+// if (b[i] <> $A7 * 2) then
+// error(28);
+end;
+
+procedure test16to24bit;
+type
+ ta = 0..2047;
+ tb = packed array[0..799] of ta;
+ tc = array[0..1099] of byte;
+const
+{$ifdef ENDIAN_BIG}
+ results: array[0..4] of ta = ($5A * 8 + 3,$B2 * 8 + 6,$9D * 8 + 4,$B4 * 8 + 7,$65 * 8 + 5);
+{$else}
+ { %11001011010 01101001110 00111011001 01100101101 10110100111 011101100 0111011001011010 0111011001011010 0111011001011010 }
+ results: array[0..4] of ta = ($0000065A,$0000034E,$000001D9,$0000032D,$000005A7);
+{$endif}
+var
+ a: ta;
+ b: tb;
+ i: longint;
+begin
+ b[0] := results[0];
+ b[1] := results[1];
+ b[2] := results[2];
+ b[3] := results[3];
+ b[4] := results[4];
+ if (b[0] <> results[0]) then
+ error(31);
+ if (b[1] <> results[1]) then
+ error(32);
+ if (b[2] <> results[2]) then
+ error(33);
+ if (b[3] <> results[3]) then
+ error(34);
+ if (b[4] <> results[4]) then
+ error(35);
+// if (b[600] <> $76 * 8 + 2) then
+// error(36);
+ for i := low(results) to high(results) do
+ if b[i] <> results[i] then
+ error(37);
+// i := 500;
+// if (b[i] <> $65 * 8 + 5) then
+// error(38);
+end;
+
+
+procedure test32bit;
+type
+ ta = 0..(1 shl 19) - 1;
+ tb = packed array[0..799] of ta;
+ tc = array[0..1899] of byte;
+const
+{$ifdef ENDIAN_BIG}
+ results: array[0..4] of ta = ($5A76*8+2, $D3B2*8+6,$9D96*8+4,$ECB4*8+7,$65A7*8+3);
+{$else}
+ { 0100111011001011010 0110100111011001011 0010110100111011001 0110010110100111011 1110110010110100111 0 01110110010110100111011001011010 01110110010110100111011001011010 01110110010110100111011001011010 01110110010110100111011001011010 01110110010110100111011001011010 01110110010110100111011001011010}
+ results: array[0..4] of ta = ($0002765A,$00034ECB,$000169D9,$00032D3B,$000765A7);
+{$endif}
+var
+ a: ta;
+ b: tb;
+ i: longint;
+begin
+ b[0] := results[0];
+ b[1] := results[1];
+ b[2] := results[2];
+ b[3] := results[3];
+ b[4] := results[4];
+ if (b[0] <> results[0]) then
+ error(41);
+ if (b[1] <> results[1]) then
+ error(42);
+ if (b[2] <> results[2]) then
+ error(43);
+ if (b[3] <> results[3]) then
+ error(44);
+ if (b[4] <> results[4]) then
+ error(45);
+// if (b[600] <> $765A*8+3) then
+// error(46);
+ for i := low(results) to high(results) do
+ if b[i] <> results[i] then
+ error(47);
+// i := 500;
+// if (b[i] <> $65a7*8+3) then
+// error(48);
+end;
+
+{
+ write(hexstr(%1110110010110100111011001011010 ,8),',$');
+ write(hexstr(%1101100101101001110110010110100 ,8),',$');
+ write(hexstr(%1011001011010011101100101101001 ,8),',$');
+ write(hexstr(%0110010110100111011001011010011 ,8),',$');
+ writeln(hexstr(%1100101101001110110010110100111 ,8));
+}
+
+
+procedure test32to40bit;
+type
+ ta = 0..$7fffffff;
+ tb = packed array[0..799] of ta;
+ tc = array[0..3099] of byte;
+const
+{$ifdef ENDIAN_BIG}
+ results: array[0..4] of ta = ($5A765A7*8+3,$2D3B2D3*8+5,$969D969*8+6,$CB4ECB4*8+7,$65A765A*8+3);
+{$else}
+{
+1110110010110100111011001011010 1101100101101001110110010110100 1011001011010011101100101101001 0110010110100111011001011010011 1100101101001110110010110100111 1001011010011101100101101001110 011101
+}
+ results: array[0..4] of ta = ($765A765A,$6CB4ECB4,$5969D969,$32D3B2D3,$65A765A7);
+{$endif}
+var
+ a: ta;
+ b: tb;
+ i: longint;
+begin
+ b[0] := results[0];
+ b[1] := results[1];
+ b[2] := results[2];
+ b[3] := results[3];
+ b[4] := results[4];
+ if (b[0] <> results[0]) then
+ error(51);
+ if (b[1] <> results[1]) then
+ error(52);
+ if (b[2] <> results[2]) then
+ error(53);
+ if (b[3] <> results[3]) then
+ error(54);
+ if (b[4] <> results[4]) then
+ error(55);
+ for i := low(results) to high(results) do
+ if b[i] <> results[i] then
+ error(57);
+// i := 500;
+// if (b[i] <> $65A765A*8+3) then
+// error(58);
+end;
+
+begin
+ test8bit;
+ test8to16bit;
+ test16bit;
+ test16to24bit;
+ test32bit;
+ test32to40bit;
+end.