paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 04:29:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ added LOC_FLAGS and LOC_JUMP tests (still missing open array tests)

Browse Source
This commit is contained in:
carl 2001-06-30 00:48:37 +00:00
parent 40eb6ad985
commit 47ee141207
1 changed files with 50 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
tests/test/cg/tvec.pp
View File

@ -15,14 +15,9 @@
{ DEFINES: } { DEFINES: }
{****************************************************************} {****************************************************************}
{ REMARKS: } { REMARKS: }
{ Missing tests : LOC_JUMP, LOC_FLAGS } { Missing tests : openarray tests }
{ location }
{ openarray tests }
{ }
{ }
{ }
{****************************************************************} {****************************************************************}
program tvecn; program tvec;
{ things to test : } { things to test : }
@ -83,6 +78,7 @@ type
{ call multiply in calculating offset } { call multiply in calculating offset }
pbigoddarray = ^bigoddarray; pbigoddarray = ^bigoddarray;
bigoddarray = array[min_big_odd_array..max_big_odd_array] of toddelement; bigoddarray = array[min_big_odd_array..max_big_odd_array] of toddelement;
boolarray = array[boolean] of boolean;
var var
@ -93,7 +89,7 @@ var
globaloddarray : bigoddarray; globaloddarray : bigoddarray;
globalindex : longint; globalindex : longint;
globalansi : ansistring; globalansi : ansistring;
globalboolarray : boolarray;
{ this routine clears all arrays } { this routine clears all arrays }
{ without calling secondvecn() first } { without calling secondvecn() first }
@ -105,6 +101,7 @@ var
FillChar(globalbignegarray,sizeof(globalbignegarray),0); FillChar(globalbignegarray,sizeof(globalbignegarray),0);
FillChar(globalbigarray,sizeof(globalbigarray),0); FillChar(globalbigarray,sizeof(globalbigarray),0);
FillChar(globaloddarray,sizeof(globaloddarray),0); FillChar(globaloddarray,sizeof(globaloddarray),0);
FillChar(globalboolarray,sizeof(globalboolarray),0);
end; end;
@ -119,17 +116,32 @@ var
var var
i : longint; i : longint;
passed : boolean; passed : boolean;
b1: boolean;
b2: boolean;
p : pointer;
begin begin
passed := true; passed := true;
ClearGlobalArrays; ClearGlobalArrays;
Write('Testing subscriptn() global variables...'); Write('Testing subscriptn() global variables...');
{ RIGHT : LOC_JUMP }
{ RIGHT : LOC_JUMP ?????? }
{ (current) : LOC_MEM (symbol) } { (current) : LOC_MEM (symbol) }
b1 := true;
b2 := false;
globalboolarray[b1 or b2] := TRUE;
if globalboolarray[true] <> TRUE then
passed := false;
{ RIGHT : LOC_FLAGS?????? } { RIGHT : LOC_FLAGS }
{ (current) : LOC_MEM (symbol) } { (current) : LOC_MEM (symbol) }
{ IF ASSIGNED DOES NOT HAVE }
{ A RESULT IN FLAGS THIS WILL }
{ NOT WORK (LOC_FLAGS = OK) }
{ for FPC v1.0.x }
p:= nil;
globalboolarray[assigned(p)]:=true;
if globalboolarray[false] <> true then
passed := false;
@ -229,8 +241,11 @@ var
localbignegarray : pbignegarray; localbignegarray : pbignegarray;
localbigarray : pbigarray; localbigarray : pbigarray;
localindex : longint; localindex : longint;
localboolarray: boolarray;
i : longint; i : longint;
passed : boolean; passed : boolean;
b1, b2: boolean;
p : pointer;
begin begin
Write('Testing subscriptn() local variables...'); Write('Testing subscriptn() local variables...');
new(localsmallnegarray); new(localsmallnegarray);
@ -244,14 +259,26 @@ var
FillChar(localbignegarray^,sizeof(bignegarray),0); FillChar(localbignegarray^,sizeof(bignegarray),0);
FillChar(localbignegarray^,sizeof(bignegarray),0); FillChar(localbignegarray^,sizeof(bignegarray),0);
FillChar(localbigarray^,sizeof(bigarray),0); FillChar(localbigarray^,sizeof(bigarray),0);
FillChar(localboolarray, sizeof(localboolarray),0);
{ RIGHT : LOC_JUMP ?????? } { RIGHT : LOC_JUMP }
{ (current) : LOC_MEM (symbol) } { (current) : LOC_MEM (symbol) }
b1 := true;
b2 := true;
localboolarray[b1 and b2] := TRUE;
if localboolarray[true] <> TRUE then
passed := false;
{ RIGHT : LOC_FLAGS?????? } { RIGHT : LOC_FLAGS }
{ (current) : LOC_MEM (symbol) } { (current) : LOC_MEM (symbol) }
{ IF ASSIGNED DOES NOT HAVE }
{ A RESULT IN FLAGS THIS WILL }
{ NOT WORK (LOC_FLAGS = OK) }
{ for FPC v1.0.x }
p := nil;
localboolarray[assigned(p)]:=true;
if localboolarray[false] <> true then
passed := false;
{ RIGHT : LOC_REFERENCE } { RIGHT : LOC_REFERENCE }
{ (current) : LOC_MEM () } { (current) : LOC_MEM () }
@ -379,7 +406,10 @@ var
{ right right : index constant } { right right : index constant }
{ With -Or switch only } { With -Or switch only }
var
i: integer;
b1,b2: boolean;
p: pointer;
begin begin
globalansi := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'; globalansi := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
testarrayglobal; testarrayglobal;
@ -391,7 +421,10 @@ end.
{ {
$Log$ $Log$
Revision 1.1 2001-06-29 02:02:10 carl Revision 1.2 2001-06-30 00:48:37 carl
+ added LOC_FLAGS and LOC_JUMP tests (still missing open array tests)
Revision 1.1 2001/06/29 02:02:10 carl
+ add array indexing test suite (incomplete) + add array indexing test suite (incomplete)
} }