mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-19 02:49:18 +02:00
+ add array indexing test suite (incomplete)
This commit is contained in:
carl
parent
ca32cfe088
commit
56f270b870
398
tests/test/cg/tvec.pp
Normal file
398
tests/test/cg/tvec.pp
Normal file
@ -0,0 +1,398 @@
|
||||
{****************************************************************}
|
||||
{ CODE GENERATOR TEST PROGRAM }
|
||||
{****************************************************************}
|
||||
{ NODE TESTED : secondvecn() }
|
||||
{****************************************************************}
|
||||
{ PRE-REQUISITES: secondload() }
|
||||
{ secondassign() }
|
||||
{ secondfor() }
|
||||
{ secondderef() }
|
||||
{ Free Pascal compiler }
|
||||
{ secondnew() }
|
||||
{ seconddispose() }
|
||||
{ secondinline() length() }
|
||||
{****************************************************************}
|
||||
{ DEFINES: }
|
||||
{****************************************************************}
|
||||
{ REMARKS: }
|
||||
{ Missing tests : LOC_JUMP, LOC_FLAGS }
|
||||
{ location }
|
||||
{ openarray tests }
|
||||
{ }
|
||||
{ }
|
||||
{ }
|
||||
{****************************************************************}
|
||||
program tvecn;
|
||||
|
||||
|
||||
{ things to test : }
|
||||
{ array/record offset with index = 0 }
|
||||
{ array/record offset with index < MAX_CPU_DISP }
|
||||
{ non-aligned word/dword access to record field }
|
||||
{ ansistring }
|
||||
{ LOC_REFERENCE, LOC_REGISTER }
|
||||
{ string }
|
||||
{ right (index value) }
|
||||
{ LOC_REGISTER }
|
||||
{ LOC_FLAGS }
|
||||
{ LOC_JUMP }
|
||||
{ LOC_REFERENCE, LOC_MEM }
|
||||
const
|
||||
min_small_neg_array = -127;
|
||||
max_small_neg_array = 255;
|
||||
|
||||
min_small_array = 0;
|
||||
max_small_array = 255;
|
||||
|
||||
min_big_neg_array = -100000;
|
||||
max_big_neg_array = 100000;
|
||||
|
||||
min_big_array = 0;
|
||||
max_big_array = 524288;
|
||||
|
||||
min_big_odd_array = 0;
|
||||
max_big_odd_array = 255;
|
||||
|
||||
alphabet_size = ord('Z')-ord('A')+1;
|
||||
alphabet : array[1..alphabet_size] of char =
|
||||
(
|
||||
'A','B','C','D','E','F','G','H','I',
|
||||
'J','K','L','M','N','O','P','Q','R',
|
||||
'S','T','U','V','W','X','Y','Z');
|
||||
|
||||
type
|
||||
{ alignment requirements are checked }
|
||||
{ in tsubscript.pp not here }
|
||||
{ so all elements are byte for easy }
|
||||
{ testing. }
|
||||
toddelement = packed record
|
||||
_b0 : array[1..65537] of byte;
|
||||
_b1 : byte;
|
||||
_b2 : byte;
|
||||
end;
|
||||
|
||||
psmallnegarray = ^smallnegarray;
|
||||
smallnegarray = array[min_small_neg_array..max_small_neg_array] of word;
|
||||
psmallarray = ^smallarray;
|
||||
smallarray = array[min_small_array..max_small_array] of word;
|
||||
pbignegarray = ^bignegarray;
|
||||
bignegarray = array[min_big_neg_array..max_big_neg_array] of word;
|
||||
pbigarray = ^bigarray;
|
||||
bigarray = array[min_big_array..max_big_array] of word;
|
||||
{ in the case of odd addresses }
|
||||
{ call multiply in calculating offset }
|
||||
pbigoddarray = ^bigoddarray;
|
||||
bigoddarray = array[min_big_odd_array..max_big_odd_array] of toddelement;
|
||||
|
||||
|
||||
var
|
||||
globalsmallnegarray : smallnegarray;
|
||||
globalsmallarray : smallarray;
|
||||
globalbignegarray : bignegarray;
|
||||
globalbigarray : bigarray;
|
||||
globaloddarray : bigoddarray;
|
||||
globalindex : longint;
|
||||
globalansi : ansistring;
|
||||
|
||||
|
||||
{ this routine clears all arrays }
|
||||
{ without calling secondvecn() first }
|
||||
procedure clearglobalarrays;
|
||||
begin
|
||||
FillChar(globalsmallnegarray,sizeof(globalsmallnegarray),0);
|
||||
FillChar(globalsmallarray,sizeof(globalsmallarray),0);
|
||||
FillChar(globalbignegarray,sizeof(globalbignegarray),0);
|
||||
FillChar(globalbignegarray,sizeof(globalbignegarray),0);
|
||||
FillChar(globalbigarray,sizeof(globalbigarray),0);
|
||||
FillChar(globaloddarray,sizeof(globaloddarray),0);
|
||||
end;
|
||||
|
||||
|
||||
{ left: array definition }
|
||||
{ right : index constant }
|
||||
{ NOT OPEN ARRAY }
|
||||
{ (current): LOC_MEM, LOC_REFERENCE (symbol) }
|
||||
{ (current): LOC_REFERENCE (with index register) }
|
||||
{ (current): LOC_REFERENCE (without index register) }
|
||||
{ (current): LOC_REFERENCE (without base register) }
|
||||
procedure testarrayglobal;
|
||||
var
|
||||
i : longint;
|
||||
passed : boolean;
|
||||
begin
|
||||
passed := true;
|
||||
ClearGlobalArrays;
|
||||
Write('Testing subscriptn() global variables...');
|
||||
|
||||
|
||||
{ RIGHT : LOC_JUMP ?????? }
|
||||
{ (current) : LOC_MEM (symbol) }
|
||||
|
||||
{ RIGHT : LOC_FLAGS?????? }
|
||||
{ (current) : LOC_MEM (symbol) }
|
||||
|
||||
|
||||
|
||||
{ RIGHT : LOC_REFERENCE }
|
||||
{ (current) : LOC_MEM (symbol) }
|
||||
globalindex := max_big_array;
|
||||
globalbigarray[globalindex] := $F0F0;
|
||||
if globalbigarray[globalindex] <> $F0F0 then
|
||||
passed := false;
|
||||
|
||||
{ RIGHT : ordconstn }
|
||||
{ (current) : LOC_MEM (symbol) }
|
||||
{ index 1 : 1 }
|
||||
globalbigarray[max_big_array] := $FF;
|
||||
if globalbigarray[max_big_array] <> $FF then
|
||||
passed := false;
|
||||
|
||||
{ RIGHT : LOC_REGISTER }
|
||||
{ (current) : LOC_MEM (symbol) }
|
||||
for i:=min_small_neg_array to max_small_neg_array do
|
||||
begin
|
||||
globalsmallnegarray[i] := word(i);
|
||||
end;
|
||||
{ now compare if the values are correct }
|
||||
for i:=min_small_neg_array to max_small_neg_array do
|
||||
begin
|
||||
if globalsmallnegarray[i] <> word(i) then
|
||||
passed := false;
|
||||
end;
|
||||
|
||||
for i:=min_small_array to max_small_array do
|
||||
begin
|
||||
globalsmallarray[i] := i;
|
||||
end;
|
||||
{ now compare if the values are correct }
|
||||
for i:=min_small_array to max_small_array do
|
||||
begin
|
||||
if globalsmallarray[i] <> i then
|
||||
passed := false;
|
||||
end;
|
||||
|
||||
for i:=min_big_neg_array to max_big_neg_array do
|
||||
begin
|
||||
globalbignegarray[i] := word(i);
|
||||
end;
|
||||
{ now compare if the values are correct }
|
||||
for i:=min_big_neg_array to max_big_neg_array do
|
||||
begin
|
||||
if globalbignegarray[i] <> word(i) then
|
||||
passed := false;
|
||||
end;
|
||||
|
||||
|
||||
for i:=min_big_array to max_big_array do
|
||||
begin
|
||||
globalbigarray[i] := word(i);
|
||||
end;
|
||||
{ now compare if the values are correct }
|
||||
for i:=min_big_array to max_big_array do
|
||||
begin
|
||||
if globalbigarray[i] <> word(i) then
|
||||
passed := false;
|
||||
end;
|
||||
|
||||
|
||||
for i:=min_big_odd_array to max_big_odd_array do
|
||||
begin
|
||||
globaloddarray[i]._b1 := byte(i);
|
||||
end;
|
||||
|
||||
{ now compare if the values are correct }
|
||||
for i:=min_big_odd_array to max_big_odd_array do
|
||||
begin
|
||||
if globaloddarray[i]._b1 <> byte(i) then
|
||||
passed := false;
|
||||
end;
|
||||
|
||||
|
||||
if passed then
|
||||
WriteLn('Success.')
|
||||
else
|
||||
WriteLn('Failure.');
|
||||
end;
|
||||
|
||||
|
||||
{ left: array definition }
|
||||
{ right : index constant }
|
||||
{ OPEN ARRAY }
|
||||
{ (current): LOC_MEM, LOC_REFERENCE (symbol) }
|
||||
{ (current): LOC_REFERENCE (with index register) }
|
||||
{ (current): LOC_REFERENCE (without index register) }
|
||||
{ (current): LOC_REFERENCE (without base register) }
|
||||
procedure testarraylocal;
|
||||
var
|
||||
localsmallnegarray : psmallnegarray;
|
||||
localsmallarray : psmallarray;
|
||||
localbignegarray : pbignegarray;
|
||||
localbigarray : pbigarray;
|
||||
localindex : longint;
|
||||
i : longint;
|
||||
passed : boolean;
|
||||
begin
|
||||
Write('Testing subscriptn() local variables...');
|
||||
new(localsmallnegarray);
|
||||
new(localsmallarray);
|
||||
new(localbignegarray);
|
||||
new(localbigarray);
|
||||
|
||||
passed := true;
|
||||
FillChar(localsmallnegarray^,sizeof(smallnegarray),0);
|
||||
FillChar(localsmallarray^,sizeof(smallarray),0);
|
||||
FillChar(localbignegarray^,sizeof(bignegarray),0);
|
||||
FillChar(localbignegarray^,sizeof(bignegarray),0);
|
||||
FillChar(localbigarray^,sizeof(bigarray),0);
|
||||
|
||||
{ RIGHT : LOC_JUMP ?????? }
|
||||
{ (current) : LOC_MEM (symbol) }
|
||||
|
||||
{ RIGHT : LOC_FLAGS?????? }
|
||||
{ (current) : LOC_MEM (symbol) }
|
||||
|
||||
|
||||
|
||||
{ RIGHT : LOC_REFERENCE }
|
||||
{ (current) : LOC_MEM () }
|
||||
localindex := max_big_array;
|
||||
localbigarray^[localindex] := $F0F0;
|
||||
if localbigarray^[localindex] <> $F0F0 then
|
||||
passed := false;
|
||||
|
||||
{ RIGHT : ordconstn }
|
||||
{ (current) : LOC_MEM () }
|
||||
{ index 1 : 1 }
|
||||
localbigarray^[max_big_array] := $FF;
|
||||
if localbigarray^[max_big_array] <> $FF then
|
||||
passed := false;
|
||||
|
||||
{ RIGHT : LOC_REGISTER }
|
||||
{ (current) : LOC_MEM () }
|
||||
for i:=min_small_neg_array to max_small_neg_array do
|
||||
begin
|
||||
localsmallnegarray^[i] := word(i);
|
||||
end;
|
||||
{ now compare if the values are correct }
|
||||
for i:=min_small_neg_array to max_small_neg_array do
|
||||
begin
|
||||
if localsmallnegarray^[i] <> word(i) then
|
||||
passed := false;
|
||||
end;
|
||||
|
||||
for i:=min_small_array to max_small_array do
|
||||
begin
|
||||
localsmallarray^[i] := i;
|
||||
end;
|
||||
{ now compare if the values are correct }
|
||||
for i:=min_small_array to max_small_array do
|
||||
begin
|
||||
if localsmallarray^[i] <> i then
|
||||
passed := false;
|
||||
end;
|
||||
|
||||
for i:=min_big_neg_array to max_big_neg_array do
|
||||
begin
|
||||
localbignegarray^[i] := word(i);
|
||||
end;
|
||||
{ now compare if the values are correct }
|
||||
for i:=min_big_neg_array to max_big_neg_array do
|
||||
begin
|
||||
if localbignegarray^[i] <> word(i) then
|
||||
passed := false;
|
||||
end;
|
||||
|
||||
|
||||
for i:=min_big_array to max_big_array do
|
||||
begin
|
||||
localbigarray^[i] := word(i);
|
||||
end;
|
||||
{ now compare if the values are correct }
|
||||
for i:=min_big_array to max_big_array do
|
||||
begin
|
||||
if localbigarray^[i] <> word(i) then
|
||||
passed := false;
|
||||
end;
|
||||
|
||||
if passed then
|
||||
WriteLn('Success.')
|
||||
else
|
||||
WriteLn('Failure.');
|
||||
|
||||
|
||||
|
||||
dispose(localbigarray);
|
||||
dispose(localbignegarray);
|
||||
dispose(localsmallarray);
|
||||
dispose(localsmallnegarray);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
{ (current): LOC_MEM, LOC_REFERENCE (symbol) }
|
||||
{ (current): LOC_REFERENCE (with index register) }
|
||||
{ (current): LOC_REFERENCE (without index register) }
|
||||
{ (current): LOC_REFERENCE (without base register) }
|
||||
procedure testansistring;
|
||||
|
||||
var
|
||||
localansi : ansistring;
|
||||
passed : boolean;
|
||||
i : longint;
|
||||
begin
|
||||
Write('Testing subscriptn() ansistring()...');
|
||||
passed := true;
|
||||
localansi := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
|
||||
{ RIGHT : LOC_REFERENCE }
|
||||
{ (current) : LOC_REFERENCE () }
|
||||
for i:=1 to length(localansi) do
|
||||
begin
|
||||
if localansi[i]<>alphabet[i] then
|
||||
passed := false;
|
||||
end;
|
||||
|
||||
{ RIGHT : LOC_REFERENCE
|
||||
(current) : LOC_REGISTER ()
|
||||
for i:=0 to length(localansi) do
|
||||
begin
|
||||
if ansistring(getansistr)[i]<>alphabet[i] then
|
||||
passed := false;
|
||||
end;
|
||||
}
|
||||
if passed then
|
||||
WriteLn('Success.')
|
||||
else
|
||||
WriteLn('Failure.');
|
||||
end;
|
||||
|
||||
|
||||
{ left: array definition }
|
||||
{ right : + operator }
|
||||
{ right right : index constant }
|
||||
{ With -Or switch only }
|
||||
|
||||
|
||||
{ left: array definition }
|
||||
{ right : - operator }
|
||||
{ right right : index constant }
|
||||
{ With -Or switch only }
|
||||
|
||||
|
||||
begin
|
||||
globalansi := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
|
||||
testarrayglobal;
|
||||
testarraylocal;
|
||||
testansistring;
|
||||
end.
|
||||
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2001-06-29 02:02:10 carl
|
||||
+ add array indexing test suite (incomplete)
|
||||
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user