|
DataMuseum.dkPresents historical artifacts from the history of: DANOSI |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about DANOSI Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 61312 (0xef80)
Types: TextFile
Names: »SYSTEST2.RTP«
└─⟦289818552⟧ Bits:30010516 DVBS1.SW2114.src.2.7-3 SW2114 3/4 Real Time Pascal 2.7
└─⟦this⟧ »RTP\SYSTEST2.RTP«
└─⟦783187a02⟧ Bits:30010525 DVBS1.SW2114.src.2.6-3 RTP compiler source SW2104+SW2114 Disk#3 30/1-92 HHA
└─⟦this⟧ »RTP\SYSTEST2.RTP«
└─⟦ca921ce75⟧ Bits:30010528 DVBS1.SW2114.src.2.6-6 RTP Compiler Source SW2104+SW2114 Disk 3 92.02.03 HEJ HHA
└─⟦this⟧ »RTP\SYSTEST2.RTP«
└─⟦d5707feda⟧ Bits:30010512 DVBS1.SW2114.src.2.14-3 SW2114 REAL #3/4 TIME PASCAL SOURCE REL 2.14 92.09.01
└─⟦this⟧ »RTP\SYSTEST2.RTP«
\r
$listoff\r
(* This file contains routines that tests familie *)\r
(* The routines are called from systemtest *)\r
\r
systest2env;\r
const nul = ' ';\r
procedure writename(Var z : inoutZone; Inspect name : String); EXTERNAL;\r
.\r
(*******************************************************************)\r
(*******************************************************************)\r
(****************** TEST 6 FAMILIE *********************************)\r
(*******************************************************************)\r
(*******************************************************************)\r
\r
\r
PROCEDURE TEST6FAM(VAR OK : Boolean; VAR ZoneVAR : inoutZone);\r
\r
\r
VAR \r
TEST6OK : Boolean;\r
\r
\r
TYPE\r
DynSubr( n : integer) = 1..n;\r
\r
(********************** 6A *******************)\r
(* var declaration: dynamic subrange *)\r
PROCEDURE TestFam6A;\r
var high : integer;\r
procedure p;\r
var\r
d : DynSubr(High);\r
begin\r
d := 2;\r
PrintInteger(ZoneVar, d ); (* 2 *)\r
IF d = 2 THEN Test6OK := True\r
ELSE Test6OK := false;\r
end;\r
\r
begin\r
WriteName(ZoneVar,"TestFam6A");\r
high := 4;\r
p;\r
end;\r
\r
\r
(************************* 6AA **********************)\r
(* dynamic subrange type declare *)\r
PROCEDURE TestFam6aa;\r
var high, low : integer;\r
procedure p;\r
type\r
t(n : integer) = low .. high;\r
var\r
d : t(1);\r
begin\r
d := 1;\r
PrintInteger(ZoneVar, d ); (* 1 *)\r
IF d = 1 THEN Test6OK := True\r
ELSE Test6OK := false;\r
\r
end;\r
\r
\r
begin\r
WriteName(ZoneVar,"TestFam6AA");\r
high := 1;\r
low := - 1;\r
p;\r
end;\r
\r
\r
\r
(**************************** 6AB ************************)\r
(* simple dynamic subrange expressions *)\r
PROCEDURE TestFam6ab;\r
\r
var high , low : integer;\r
\r
TYPE\r
T1(l,h : integer) = -1110 + l..h;\r
T2(l : integer) = -30 + l..37; \r
\r
procedure P;\r
var\r
a,c : T1(low,high) := 7;\r
b : T2(Low) := - 30;\r
begin\r
TEST6OK := false;\r
PrintInteger(ZoneVar,a); (* 7 *)\r
IF a <> 7 THEN EXIT;\r
PrintInteger(ZoneVar,b); (* -30 *)\r
IF b <> - 30 THEN EXIT;\r
b:= - b;\r
PrintInteger(ZoneVar,b); (* 30 *)\r
IF b <> 30 THEN EXIT;\r
b := a + b;\r
PrintInteger(ZoneVar,b); (* 37 *)\r
IF b <> 37 THEN EXIT;\r
a := a - b;\r
PrintInteger(ZoneVar,a); (* -30 *)\r
IF a <> -30 THEN EXIT;\r
a := a * b;\r
PrintInteger(ZoneVar,a); (* -1110 *)\r
IF a <> -1110 THEN EXIT;\r
a := a div b;\r
PrintInteger(ZoneVar,a); (* -30 *)\r
IF a <> -30 THEN EXIT;\r
a := b mod a;\r
PrintInteger(ZoneVar,a); (* 7 *)\r
IF a <> 7 THEN EXIT;\r
PrintInteger(ZoneVar,- (b - a)); (* -30 *)\r
PrintInteger(ZoneVar,- (a div b)); (* 0 *)\r
PrintInteger(ZoneVar,- (b * a)); (* -259 *)\r
TEST6OK := true;\r
end;\r
\r
begin\r
WriteName(ZoneVar,"TestFam6AB");\r
high := 7;\r
low := 0;\r
p;\r
end;\r
\r
\r
(*************************** 6AC *********************)\r
(* simple dynamic Subrange expressions *)\r
PROCEDURE TestFam6ac;\r
Type T(x : integer) = x..x;\r
VAR\r
limit : integer := 7;\r
a : T(Limit);\r
b : integer;\r
begin\r
WriteName(ZoneVar,"TestFam6AC");\r
TEST6OK := false;\r
a:= 7;\r
PrintInteger(ZoneVar,a); (* 7 *)\r
IF a <> 7 THEN EXIT;\r
b:= - 30;\r
PrintInteger(ZoneVar,b); (* -30 *)\r
IF b <> -30 THEN EXIT;\r
b:= - b + (( b - 2) + (( a div 4) * b) mod a +( 4 + ( ( a*b) DIV (b div a)) +\r
3) );\r
PrintInteger(ZoneVar,b); (* 55 *)\r
IF b <> 55 THEN EXIT;\r
b := b * a MOD (- a) + 4;\r
PrintInteger(ZoneVar,b); (* 4 *)\r
IF b <> 4 THEN EXIT;\r
a := (30079 div b) * b + (30079 mod b) - 30072;\r
PrintInteger(ZoneVar,a); (* 7 *)\r
IF a = 7 THEN Test6OK := True;\r
end;\r
\r
\r
\r
\r
(************************** 6AD ************************)\r
(* simple integer and char Subrange expressions *)\r
PROCEDURE TestFam6ad;\r
\r
type\r
scalar = (a0,a1,a2,a3,a4);\r
var \r
limit : integer;\r
ch1,ch2 : char;\r
varscalar : scalar;\r
procedure p;\r
Type\r
T(n : integer) = n.. abs(7);\r
CharSubr(c1 : char; c2 : char) = c1..c2;\r
ScalarSubr(a : Scalar) = a1 .. a;\r
var\r
a : T(limit);\r
ch : char;\r
chsubrange : CharSubr(ch1,ch2);\r
subscalar : ScalarSubr(varscalar);\r
begin\r
TEST6OK := false;\r
a:= 7;\r
PrintInteger(ZoneVar,a); (* 7 *)\r
IF a <> 7 THEN EXIT;\r
chsubrange := 'a';\r
WriteChar(ZoneVar,chsubrange); (* H61 *)\r
IF chsubrange <> 'a' THEN EXIT;\r
ch := 'b';\r
WriteChar(ZoneVar,ch); (* H62 *)\r
IF ch <> 'b' THEN EXIT;\r
IF chsubrange <= Ch THEN chsubrange := ch\r
ELSE chsubrange := 'c';\r
WriteChar(ZoneVar,chsubrange); (* H62 *)\r
IF chSubrange <> 'b' THEN EXIT;\r
subscalar := a2;\r
PrintInteger(ZoneVar,ord(subscalar)); (* 2 *)\r
IF Subscalar = a2 THEN TEST6Ok := true;\r
end;\r
\r
begin\r
WriteName(ZoneVar,"TestFam6AD");\r
limit := 7;\r
ch1 := 'a';\r
ch2 := 'c';\r
varscalar := a2;\r
p;\r
end;\r
\r
\r
\r
\r
\r
\r
\r
\r
\r
\r
\r
BEGIN\r
WriteName(ZoneVar,"TESTFAM6");\r
\r
TestFam6a;\r
IF TEST6OK = false THEN GOTO ExitError;\r
\r
\r
\r
TestFam6aa;\r
IF TEST6OK = false THEN GOTO ExitError;\r
\r
\r
\r
TestFam6ab;\r
IF TEST6OK = false THEN GOTO ExitError;\r
\r
\r
\r
TestFam6ac;\r
IF TEST6OK = false THEN GOTO ExitError;\r
\r
\r
\r
TestFam6ad;\r
IF TEST6OK = false THEN GOTO ExitError;\r
\r
\r
\r
writeChar(ZoneVar,' ');\r
writeChar(ZoneVar,'O');\r
writeChar(ZoneVar,'K');\r
OK := true;\r
exit;\r
EXITError:\r
OK := false;\r
writeChar(ZoneVar,' ');\r
writeChar(ZoneVar,'N');\r
writeChar(ZoneVar,'O');\r
writeChar(ZoneVar,'T');\r
writeChar(ZoneVar,' ');\r
writeChar(ZoneVar,'O');\r
writeChar(ZoneVar,'K');\r
\r
\r
\r
End;\r
\r
(********************* TEST7FAM *************************)\r
(* Test Familie Type . Array and subrange type *)\r
\r
(********************************************************************)\r
(********************* TEST 7 Familie*******************************)\r
(********************************************************************)\r
\r
\r
PROCEDURE TEST7FAM(VAR OK : Boolean; VAR ZoneVar : inoutZone);\r
\r
Var \r
Test7Ok : boolean;\r
\r
\r
(********************* 7A **************************)\r
PROCEDURE Test7Fama;\r
(* subrange and 1-dim dynamic array type *)\r
(* simple element type *)\r
const\r
ni = 9;\r
var\r
low1,low,high,high2 : integer;\r
Procedure p;\r
type\r
t(low1 : integer) = Low1..4;\r
data = array( t(Low1) ) of integer;\r
data1(high2 : integer) = array(0..high2) of boolean;\r
data2(Low, High : integer) = array(Low..High) of integer;\r
\r
var\r
a,c : integer;\r
d : data;\r
d1: data1(High2);\r
d2: data2(Low,High);\r
\r
begin\r
Test7OK := false;\r
\r
a:= 2;\r
d(2):= a;\r
c:= d(a) + ni;\r
PrintInteger(ZoneVar, c ); (* 11 *)\r
IF c <> 11 THEN EXIT;\r
\r
for i := 0 to d(a) do\r
begin\r
d1(i) := d(2) + i = a;\r
end;\r
PrintBoolean(ZoneVar,d1(0)); (* true *)\r
PrintBoolean(ZoneVar,d1(1)); (* false *)\r
PrintBoolean(ZoneVar,d1(2)); (* false *)\r
IF (d1(0) <> true) OR d1(1) OR d1(2) THEN EXIT;\r
\r
d2(0) := 0;\r
for i := 1 to 10 do\r
begin\r
d2(i) := i;\r
d2(-i) := i;\r
d2(0) := (d2(d2(-i)) + d2(-i)) + d2(0);\r
end;\r
c := 9;\r
PrintInteger(ZoneVar,d2(d2(10) - d2(c) - 1)); (* 110 *)\r
IF d2(0) <> 110 THEN EXIT;\r
\r
PrintInteger(ZoneVar,d2(-7)); (* 7*)\r
IF d2(-7) = 7 THEN Test7OK := true;\r
\r
end; (* p *)\r
BEGIN\r
WriteName(ZoneVar,"Test7FamA");\r
low := -10;\r
high := 10;\r
high2 := 2;\r
low1 := 1;\r
\r
p;\r
end;\r
\r
\r
\r
\r
(****************************** 7AA *******************************)\r
PROCEDURE Test7Famaa;\r
(* subrange and 2-dim dynamic array type *)\r
const\r
ni = 9;\r
var\r
low : integer := 1;\r
high : integer := 34;\r
low1 : low .. high := 1;\r
procedure p(var low,high : integer; low1 : integer); \r
type\r
tt(low1 : integer) = low1..4;\r
t = tt(low1);\r
data(Low,High : integer) = array( 0..high ) of array(low..8) of integer;\r
\r
\r
var\r
a,c : integer;\r
d : data(Low,High);\r
d1: array(t,t) of boolean;\r
\r
procedure p(var a : integer);\r
begin\r
a:= 2;\r
d(2)(a):= a;\r
d(1,8) := 6;\r
d(a+1,8) := 16;\r
d(2,4*a) := - 3;\r
d(a)(3 + a) := d(a - 1)(a+3*a) + d(3)(a+3*a) + d(a)(a+3*a);\r
c:= d(a)(2) + ni;\r
PrintInteger(ZoneVar, c ); (* 11 *)\r
end;\r
Begin\r
Test7OK := false;\r
p(d(4,4));\r
If c <> 11 THEN EXIT;\r
a := 4;\r
d1(3,3) := d(a,a) = 2;\r
a := 3;\r
PrintBoolean(ZoneVar,d1(a,a)); (* true *)\r
IF d1(a,a) <> true THEN EXIT;\r
\r
PrintInteger(ZoneVar,d(2,5)); (* 19 *)\r
IF d(2,5) = 19 THEN Test7OK := true;\r
end;\r
\r
begin\r
WriteName(ZoneVar,"Test7FamAA");\r
p(low,high,low1);\r
end;\r
\r
\r
(*************************** 7AB ***************************)\r
PROCEDURE Test7Famab; \r
(* dynamic array with dimension > 2 *)\r
const\r
c = 100;\r
var low : integer := 90;\r
high : integer := 100;\r
type\r
$code\r
ttt(Low,High : integer) = Low..High;\r
tt(Low : integer) = ttt(Low,c);\r
t = tt(Low);\r
arr(Low : integer)\r
= array(low..100, t, t, 99..100) of array(low - 89..2) of t;\r
\r
var\r
a1: arr(Low);\r
$nocode\r
y1,y2 : integer;\r
x1, x100 : integer;\r
\r
begin\r
WriteName(ZoneVar,"Test7FamAB");\r
for i := 92 to high - 3 do\r
begin\r
a1(i, i, i, 100,1) := i;\r
end;\r
y1 := 92;\r
y2 := 93;\r
x1 := 1;\r
x100 := 100;\r
PrintInteger(ZoneVar,a1(y1, y1, y1,x100,x1)); (* 92*)\r
PrintInteger(ZoneVar,a1(93, y2, 93, 100,1)); (* 93 *) \r
PrintInteger(ZoneVar,a1(y2 + 1, 94, 94, x100,x1)); (* 94 *) \r
PrintInteger(ZoneVar,a1(95, 95, 95, 100,1)); (* 95 *)\r
PrintInteger(ZoneVar,a1(96, y2 + 3, 96, x100,1)); (* 96 *)\r
PrintInteger(ZoneVar,a1(97, 97, 97, x100,x1)); (* 97 *)\r
\r
IF (a1(y1,y1,y1,x100,x1) = 92) AND\r
(a1(93,y2,93,100,1) = 93) AND\r
(a1(y2 + 1, 94, 94, x100,x1) = 94 ) AND\r
(a1(95, 95, 95, 100,1) = 95 ) AND\r
(a1(96, y2 + 3, 96, x100,1) = 96 ) AND\r
(a1(97, 97, 97, x100,x1) = 97 ) THEN\r
TEST7OK := true\r
ELSE\r
TEST7OK := false;\r
end;\r
\r
\r
\r
(**************************** 7AD ************************)\r
PROCEDURE Test7Famad;\r
(* Integer ARRAY - expressions *)\r
Type\r
ArrType(l : integer) = Array(1..5,l..5) of integer;\r
\r
var\r
\r
limit : integer := 3;\r
a : array(0..2) of integer;\r
b : arrType(Limit);\r
i1,i3,i4 : integer;\r
\r
\r
begin\r
WriteName(ZoneVar,"Test7FamAD");\r
TEST7OK := false;\r
i1 := 1;\r
i3 := 3;\r
i4:= 4;\r
a(1):= 7;\r
PrintInteger(ZoneVar,a(i1)); (* 7 *)\r
IF a(i1) <> 7 THEN EXIT;\r
b(3,4):= - 30;\r
PrintInteger(ZoneVar,b(i3,i4)); (* -30 *)\r
IF b(i3,i4) <> -30 THEN EXIT;\r
b(i3,4) := a(i4 - i3) + (( (a(i1) + 60) DIV b(i3,i4)) +\r
(( (a(i1) + 30) MOD b(i3,i4) ) DIV (( a(i1) + 342 - 758)\r
+ ((23 + a(i4 - i3)) + (( a(i1) MOD b(i4 - i1,i1 + (i1 + (i1 + 1)) )) -\r
(( 303 + a(i4 -(i1 + ( i1 + i1)) ) - 300)\r
* ((b(i3,i4) + a(i1 + ( a(1) - a(i1)) )) + ((200 + (b(i3,i4) \r
- 230)) mod ( a(i1) + b(3,i4)) ))))))));\r
PrintInteger(ZoneVar,b(3,i4)); (* 2 *)\r
IF b(3,i4) = 2 THEN TEST7OK := True;\r
end;\r
\r
\r
\r
(***************************** 7AE ******************************)\r
\r
PROCEDURE Test7Famae;\r
(* ARRAY - byte expressions *)\r
Type\r
Arr1(l : integer) = array(l..3) of byte;\r
Arr2(l : integer) = Array(l..2) of Byte;\r
var\r
low : integer := -1;\r
limit : integer := 2;\r
a : arr1(limit);\r
b : arr2(Low);\r
i1,i2 : integer;\r
Type\r
Arr3(p1,p2,p3,p4 : integer) = Array(p1..p2) OF p3..p4;\r
VAR\r
ai : Arr3(1,2,low,2);\r
\r
\r
begin\r
WriteName(ZoneVar,"Test7FamAE");\r
TEST7OK := False;\r
b(-1) :=#d0;\r
a(2) := #H18;\r
\r
i1 := -1;\r
i2 := 2;\r
ai(1) := -1;\r
ai(2) := 2;\r
\r
b(ai(ai(2) - 1)):= (a(ai(1) + 3) AND ( b(i1) or ( a(i2) xor \r
( not b(ai(1)) and ( a(ai(2)) or b(ai(ai(ai(1) + 3) - 1)))\r
xor a(i2)))));\r
PrintByte(ZoneVar,b(i1)); (* 18 *)\r
IF b(i1) <> #H18 THEN EXIT;\r
b(ai(1)) := (not a(ai(1) + 3)) and #HFF;\r
PrintByte(ZoneVar,b(ai(ai(2) - 1))); (* E7 *)\r
IF b(ai(1)) <> #HE7 THEN EXIT;\r
b(-1) := ( a(2) xor b(ai(ai(2) - 1))) xor ((a(i2) and\r
b(ai(ai(2) - 1))) or ((a(ai(2)) xor b(i1)) \r
and (a(ai(1) + 3) and (b(i1) or a(i2)))));\r
PrintByte(ZoneVar,b(ai(1))); (* E7 *)\r
IF b(-1) <> #HE7 THEN EXIT; \r
(*\r
b(i1):= b(ai(ai(2) - 1)) + (( b(i1) - #h02) + (( a(ai(1) + 3) div #H04)\r
* b(ai(ai(2) - 1))) \r
mod a(ai(1) + 3) +( #h04 +\r
( ( a(2)*b(-1)) DIV (b(i1) div a(i2))) +#H03) );\r
*)\r
b(i1) := #HEF;\r
PrintByte(ZoneVar,b(i1)); (* EF *)\r
IF b(i1) <> #HEF THEN EXIT;\r
(*\r
b(ai(1)) := b(i1) * a(ai(2)) MOD ( a(ai(1) + 3)) ;\r
*)\r
b(ai(1)) := 8;\r
PrintByte(ZoneVar,b(i1)); (* 8 *)\r
IF b(i1) <> #H08 THEN EXIT;\r
b(ai(1)) := (#Hc7 div b(i1)) * b(i1) + (#Hc7 mod b(-1));\r
PrintByte(ZoneVar,b(i1)); (* C7 *)\r
IF b(i1) <> #Hc7 THEN EXIT;\r
(*\r
b(-1) := (a(i2) div (#H20 + b(i1))) xor (b(ai(1)) and (#He7 * (b(-1)+ #H3)));\r
*)\r
b(-1) := #H46;\r
PrintByte(ZoneVar,b(i1)); (* 46 *)\r
IF b(i1) = #H46 THEN Test7OK := true;\r
\r
end;\r
\r
\r
\r
(***************************** 7AG *************************) \r
PROCEDURE Test7Famag;\r
(* compare arrays in complicated expression *)\r
\r
\r
var low : integer := -1;\r
high : integer := 10;\r
low1 : integer := 1;\r
high1 : integer := 3;\r
type\r
ar(low : integer; high : integer; low1 : integer; high1 : integer) =\r
array(low..high) Of array(low1..high1) of record\r
i : integer;\r
j1 : integer;\r
b : boolean;\r
end;\r
\r
\r
var a1,a2 : ar(Low,High,Low1,High1);\r
i : integer; \r
b : boolean;\r
\r
function IncI : integer;\r
begin\r
i := 1 + i;\r
Inci := i;\r
end;\r
\r
BEGIN\r
WriteName(ZoneVar,"Test7FamAG");\r
for i := low to 10 do\r
for j := low1 to 3 do \r
with a1(i,j) do\r
begin\r
i := 23;\r
j1 := 46;\r
b := true;\r
end;\r
a2 := a1;\r
a2(5,1).i := 24;\r
\r
Test7OK := false;\r
\r
i := 4;\r
b := a1(i) = a2((i - i) + ( ( i-i) + ( (i-i) + ( (i-i) * (i + i) + i) )));\r
PrintBoolean(ZoneVar,b); (*true *) \r
IF b <> true THEN EXIT;\r
i := 5;\r
b := a1(i) = a2((i - i) + ( ( i-i) + ( (i-i) + ( (i-i) * (i + i) + i) )));\r
PrintBoolean(ZoneVar,b); (* false *)\r
IF b THEN EXIT;\r
\r
b := a1(i) = a2(incI);\r
PrintBoolean(ZoneVar,b); (* true *)\r
IF b = false THEN EXIT;\r
i := 4;\r
b := a1(i) = a2(Inci);\r
PrintBoolean(ZoneVar,b); (* false *)\r
IF b = false THEN Test7OK := true;\r
\r
\r
end;\r
\r
(****************************** 7C **************************)\r
PROCEDURE Test7Famc;\r
(* array of records *)\r
var high : integer;\r
\r
procedure p;\r
type\r
ix_type(high : integer) = 0..high;\r
rectype = record\r
f1: ix_type(high);\r
f2: boolean;\r
end;\r
\r
artype(High : integer) = array(ix_type(High)) of rectype;\r
\r
var\r
step: ix_type(high);\r
ar1: artype(high);\r
\r
begin\r
WriteName(ZoneVar,"Test7FamC");\r
for step := 0 to high do\r
begin\r
ar1(step).f1 := step;\r
ar1(step).f2 := true;\r
end;\r
\r
TEST7OK := false;\r
\r
for step := 0 to high do\r
with ar1(step) do\r
begin\r
PrintInteger(ZoneVar,f1); (* 0 , 1, ...,10 *)\r
IF f1 <> Step THEN EXIT;\r
PrintBoolean(ZoneVar,f2); (* 11 * true *)\r
IF f2 <> true THEN EXIT;\r
end;\r
\r
TEST7OK := true;\r
end;\r
\r
begin\r
high := 10;\r
p;\r
end;\r
\r
\r
(******************************* 7CC ************************)\r
PROCEDURE Test7Famcc;\r
(* assignment and exchange on records and dynamic array types *)\r
var high : integer := 10;\r
type\r
ix_type = 0..10;\r
rectype = record\r
f1: integer;\r
f2: boolean;\r
f3: array(ix_type) of 0..210;\r
\r
end;\r
\r
artype(high : integer) = array(0..high) of rectype;\r
\r
\r
var\r
ar1,ar2: artype(high);\r
\r
begin\r
WriteName(ZoneVar,"Test7FamCC");\r
Test7OK := false;\r
for step := 0 to 10 do\r
begin\r
ar1(step).f1 := step;\r
ar1(step).f2 := true;\r
with ar1(step) do for s := 0 to 10 do f3(s) := step + 100;\r
end;\r
\r
ar2 := ar1;\r
\r
for step := 0 to 10 do\r
with ar2(step) do\r
begin\r
PrintInteger(ZoneVar,f1); (* 0 , 1, ...,10 *)\r
IF f1 <> Step THEN EXIT;\r
PrintBoolean(ZoneVar,f2); (* 11 * true *)\r
IF f2 <> true THEN EXIT;\r
PrintInteger(ZoneVar,f3(1)); (* 100, 101, .....110 *)\r
IF (100 + step) <> f3(1) THEN EXIT;\r
end; \r
\r
\r
for step := 0 to 10 do\r
begin\r
ar1(step).f1 := step * 2;\r
ar1(step).f2 := false;\r
with ar1(step) do for s := 0 to 10 do f3(s) := step + 200;\r
end;\r
\r
\r
ar2 :=: ar1;\r
\r
for step := 0 to 10 do\r
with ar1(step) do\r
begin\r
PrintInteger(ZoneVar,f1); (* 0 , 1, ...,10 *)\r
IF f1 <> step THEN EXIT;\r
PrintBoolean(ZoneVar,f2); (* 11 * true *)\r
IF f2 <> true THEN EXIT;\r
PrintInteger(ZoneVar,f3(9)); (* 100, 101, .....110 *)\r
IF f3(9) <> (100 + step) THEN EXIT;\r
end; \r
\r
for step := 0 to 10 do\r
with ar2(step) do\r
begin\r
PrintInteger(ZoneVar,f1); (* 0 , 2, 4,...20*)\r
IF f1 <> (step * 2) THEN EXIT;\r
PrintBoolean(ZoneVar,f2); (* 11 * false*)\r
IF f2 THEN EXIT;\r
PrintInteger(ZoneVar,f3(1)); (* 200, 201, .....210 *)\r
IF f3(1) <> (200 + Step) THEN EXIT;\r
end; \r
\r
TEST7OK := true;\r
end;\r
\r
\r
\r
\r
(********************************* 7CD **************************)\r
PROCEDURE Test7Famcd;\r
(* compare on array and record type *)\r
var high : integer := 100;\r
\r
type\r
indextype = 1.. high;\r
arr(l,High : integer) = array(l..high ) of indextype;\r
rec = record\r
i : integer;\r
i2 : boolean;\r
i3 : integer;\r
end;\r
arr1(high : integer) = array(100..high) of Rec; \r
var\r
arraya,arrayb: arr(1,High);\r
recorda,recordb : arr1(High);\r
bool : boolean;\r
\r
\r
\r
procedure comparearraysandrecord(a : arr;b : arr;var avar: arr;var bvar :arr;\r
var arec : arr1(100); brec : arr1);\r
\r
\r
\r
\r
\r
\r
\r
procedure comparerecord(var r1 : arr1; var r2 : arr1);\r
begin\r
\r
bool := false;\r
IF r1 = r2 THEN\r
bool := true;\r
\r
PrintBoolean(ZoneVar,bool); (* true *)\r
IF Bool = false THEN EXIT;\r
brec(100).i := 11;\r
IF r1 <> brec THEN \r
bool := false;\r
\r
brec(100).i := 5;\r
PrintBoolean(ZoneVar,Bool); (* false *)\r
IF Bool THEN EXIT;\r
IF ((bool xor bool) xor (arec = brec)) THEN\r
bool := true;\r
\r
PrintBoolean(ZoneVar,bool); (* true *)\r
IF Bool THEN TEST7OK := true;\r
\r
end;\r
\r
\r
begin\r
\r
bool := false;\r
IF arrayb = avar THEN\r
bool := true;\r
\r
PrintBoolean(ZoneVar,bool); (* true *)\r
IF bool = false THEN EXIT;\r
b(11) := 10;\r
IF bvar <> b THEN\r
bool := false;\r
PrintBoolean(ZoneVar,Bool); (* false *)\r
IF Bool THEN EXIT;\r
\r
b(11) := 11;\r
IF (bool or bool) xor ((bool xor bool) xor (avar = bvar)) THEN\r
bool := true;\r
\r
PrintBoolean(ZoneVar,bool); (* true *)\r
IF Bool = false THEN EXIT;\r
\r
comparerecord(arec,brec);\r
\r
end;\r
\r
begin\r
WriteName(ZoneVar,"Test7FamCD");\r
Test7OK := false;\r
\r
\r
for i := 1 to 100 do arraya(i) := i;\r
arrayb := arraya;\r
\r
bool := false;\r
IF arrayb = arraya THEN\r
bool := true;\r
\r
PrintBoolean(ZoneVar,bool); (* true *)\r
IF Bool = false THEN EXIT;\r
arrayb(11) := 10;\r
IF arraya <> arrayb THEN\r
bool := false;\r
PrintBoolean(ZoneVar,Bool); (* false *)\r
IF Bool THEN EXIT; \r
arrayb(11) := 11;\r
IF (bool or bool) xor ((bool xor bool) xor (Arraya = Arrayb)) THEN\r
bool := true;\r
\r
PrintBoolean(ZoneVar,bool); (* true *)\r
IF Bool = false THEN EXIT;\r
\r
\r
recorda(100).i := 5;\r
recorda(100).i2 := true;\r
recorda(100).i3 := -120;\r
recordb := recorda;\r
\r
bool := false;\r
IF recordb = recorda THEN\r
bool := true;\r
\r
PrintBoolean(ZoneVar,bool); (* true *)\r
IF Bool = false THEN EXIT;\r
IF recorda <> recordb THEN ELSE\r
bool := false;\r
\r
PrintBoolean(ZoneVar,Bool); (* false *)\r
IF Bool THEN EXIT;\r
IF ((bool xor bool) xor (recorda = recordb)) THEN\r
bool := true;\r
\r
PrintBoolean(ZoneVar,bool); (* true *)\r
IF Bool = false THEN EXIT;\r
\r
comparearraysandrecord(arraya,arrayb,arraya,arrayb,recorda,recordb);\r
\r
end;\r
\r
\r
\r
\r
\r
\r
(**************************** 7HB *************************)\r
\r
(* dynamic arrays mixed with scalar type *)\r
PROCEDURE Test7Famhb;\r
\r
type\r
dag = (man, tir, ons, tor, fre, lqr, sqn);\r
var\r
high : dag := fre;\r
type\r
arbdag(high : dag) = man..high;\r
\r
tarbtid(high : dag) = array(arbdag(high)) of record\r
start,slut : 0..24;\r
end;\r
\r
VAR\r
ArbTid : TArbTid(High);\r
fritid : array(dag) of record\r
ialt: 0..24;\r
end;\r
\r
\r
\r
fri,arbejde : integer;\r
\r
begin\r
WriteName(ZoneVar,"Test7FamHB");\r
for i:= man to fre do\r
with arbtid(i) do begin\r
start := 8;\r
slut := 16;\r
end;\r
\r
arbtid(tir).start := 11;\r
arbtid(fre).slut := 19;\r
\r
for i:= man to sqn do\r
with fritid(i) do begin\r
if i <= fre then ialt := 24 - (arbtid(i).slut -\r
arbtid(i).start)\r
else ialt := 24;\r
end;\r
\r
\r
\r
\r
arbejde := 0;\r
for i := man to sqn do\r
begin\r
if i >= lqr THEN \r
else arbejde := arbejde + (Arbtid(i).slut - Arbtid(i).Start);\r
end;\r
\r
fri := 0; \r
for i := man to sqn do fri := fri + fritid(i).ialt;\r
\r
PrintInteger(ZoneVar,arbejde); (* 40 *)\r
PrintInteger(ZoneVar,fri); (* 128 *)\r
IF (Arbejde = 40) AND (Fri = 128) THEN Test7OK := True\r
ELSE Test7OK := false;\r
\r
\r
end;\r
\r
\r
\r
\r
BEGIN\r
WriteName(ZoneVar,"Test7Fam");\r
\r
Test7Fama;\r
IF Test7OK <> true THEN GOTO EXITError;\r
\r
\r
Test7Famaa;\r
IF Test7OK <> true THEN GOTO EXITError;\r
\r
Test7Famab;\r
IF Test7OK <> true THEN GOTO EXITError;\r
\r
Test7Famad;\r
IF Test7OK <> true THEN GOTO EXITError;\r
\r
Test7Famae;\r
IF Test7OK <> true THEN GOTO EXITError;\r
\r
Test7Famag;\r
IF Test7OK <> true THEN GOTO EXITError;\r
\r
Test7Famc;\r
IF Test7OK <> true THEN GOTO EXITError;\r
\r
Test7Famcc;\r
IF Test7OK <> true THEN GOTO EXITError;\r
\r
Test7Famcd;\r
IF Test7OK <> true THEN GOTO EXITError;\r
\r
Test7Famhb;\r
IF Test7OK <> true THEN GOTO EXITError;\r
\r
writechar(ZoneVar,' ');\r
writechar(ZoneVar,'O');\r
writechar(ZoneVar,'K');\r
writechar(ZoneVar,'7');\r
writechar(ZoneVar,' ');\r
OK := true;\r
Exit;\r
\r
ExitError:\r
OK := false;\r
writechar(ZoneVar,'N');\r
writechar(ZoneVar,'O');\r
writechar(ZoneVar,'T');\r
writechar(ZoneVar,' ');\r
writechar(ZoneVar,'O');\r
writechar(ZoneVar,'K');\r
writechar(ZoneVar,'7');\r
\r
END;\r
\r
\r
(**************************** TEST7L ***********************)\r
PROCEDURE TEST7L(VAR OK : boolean ; VAR ZoneVar : inoutZone);\r
type\r
strTab(length : integer; StrLength : integer) =\r
array(1..length) of string(strLength);\r
recordwithstring =\r
Record length : integer;\r
s : string(2);\r
end;\r
\r
VAR \r
str,str1 : string(10);\r
str12 : string(12) := "TEST STRINGS"; \r
str15 : String(15);\r
InitString : String(7) := "1";\r
InitString1 : String(3) := "123456789";\r
BB : Boolean;\r
arrayofstring : strtab(10,4);\r
strRec : recordwithstring;\r
i : integer;\r
HelpString : String(25);\r
HelpStringIndex : integer;\r
helpstr12 : string(12);\r
helpstr7 : string(7);\r
Function EqString(Inspect s1 : String; Inspect S2 : String) : boolean;\r
\r
Begin\r
eqString := true;\r
IF s1!Length = s2!Length THEN\r
BEGIN\r
for i := 1 TO s1!Length do IF s1(i) <> s2(i) THEN eqString := false;\r
end\r
else\r
eqString := false;\r
end;\r
\r
Procedure writeString(ss : String);\r
Begin\r
for i := 1 to ss!Length do writechar(ZoneVar,ss(i));\r
writechar(ZoneVar,' ');\r
End;\r
\r
begin\r
WriteName(ZoneVar,"Test7L");\r
OK := False;\r
WriteString(Str12); (* TEST STRINGS" *)\r
IF not eqString(Str12,"TEST STRINGS") THEN EXIT;\r
for i := 1 to 10 do str(i) := chr(ord('A') + i - 1);\r
WriteString(Str); (* ABCDEFGHIJ *)\r
IF not eqString(Str,"ABCDEFGHIJ") THEN EXIT;\r
IF "ABCDEFGHIJ" = "ABCDEFGHIJ" THEN bb := true\r
ELSE bb := false;\r
PrintBoolean(ZoneVar,bb);\r
if bb = false then exit;\r
str15 := Str12;\r
str1 := str12;\r
WriteString(str1); (* TEST STRIN *)\r
IF not eqString(Str1,"TEST STRIN") THEN EXIT;\r
\r
str12 := "maa ikke udskrives";\r
str12 := "";\r
writeString(Str12); (* *)\r
helpstr12 := string(12)(:12***nul:);\r
IF not eqString(Str12, helpstr12) THEN EXIT;\r
\r
\r
str12 := str;\r
WriteString(Str12); (* ABCDEFGHIJ *)\r
IF not eqString(Str12,"ABCDEFGHIJ"&" ") THEN EXIT;\r
\r
\r
WriteString(str15); (* TEST STRINGS *)\r
IF not eqString(Str15,"TEST STRINGS"&" " & " " &" ") THEN EXIT;\r
\r
IF str15 <> "TEST STRINGS " THEN BB := True\r
ELSE BB := false;\r
PrintBoolean(ZoneVar,BB); (* false *)\r
if BB = True THEN EXIT;\r
\r
bb := "TEST STRINGS"& " " & " " & " " & " " & " " = str15;\r
PrintBoolean(ZoneVar,BB); (* true *)\r
IF BB = false THEN EXIT;\r
str1 := "ABCD";\r
str12 := "abcdefghijlmnop";\r
str1 :=: str12;\r
WriteString(Str1); (* abcdefghij *)\r
IF not eqString(Str1,"abcdefghij") THEN EXIT;\r
\r
WriteString(str12); (* ABCD *)\r
helpstr12 := string(12) (:'A','B','C','D',8***nul:);\r
IF not eqString(Str12,helpStr12) THEN EXIT;\r
str12 :=: str1;\r
WriteString(Str12); (* abcdefghij *)\r
IF not eqString(Str12,"abcdefghij"&" " &" ") THEN EXIT;\r
\r
WriteString(str1); (* ABCD *)\r
IF not eqString(Str1,"ABCD"&" " &" " &" " &" " &" " &" ") THEN EXIT;\r
\r
bb := str1 <= "ABCD";\r
PrintBoolean(ZoneVar,bb); (* true *)\r
IF bb = false THEN EXIT;\r
bb := str1 <= "ABASSS";\r
PrintBoolean(ZoneVar,bb); (* false *)\r
IF bb THEN EXIT;\r
\r
bb := str1 < "ABCD";\r
PrintBoolean(ZoneVar,bb); (* false *)\r
IF bb THEN EXIT;\r
bb := str1 < "ABASSS";\r
PrintBoolean(ZoneVar,bb); (* false *)\r
IF bb THEN EXIT;\r
\r
bb := str1 >= "ABCD";\r
PrintBoolean(ZoneVar,bb); (* true *)\r
IF bb <> true THEN EXIT;\r
bb := str1 >= "ABASSS";\r
PrintBoolean(ZoneVar,bb); (* true *)\r
IF bb <> true THEN EXIT;\r
\r
bb := str1 > "ABCD";\r
PrintBoolean(ZoneVar,bb); (* false *)\r
IF bb <> false THEN EXIT;\r
bb := str1 > "ABASSS";\r
PrintBoolean(ZoneVar,bb); (* true *)\r
IF bb <> true THEN EXIT;\r
\r
i := 1;\r
while (str1 <= "EEEEE") OR ( "EEEEEE" = str1) do\r
begin\r
str1(i) :='E';\r
i := i + 1;\r
end; \r
\r
Writestring(Str1); (* EEEEEEE *)\r
IF not eqString(Str1,"EEEEEEE" & " " & " " & " ") THEN EXIT;\r
$IF target=rc3502\r
arrayofString(1) := "ABC1";\r
arrayofString(2) := "ABC22";\r
arrayofString(3) := str1;\r
arrayofString(4) := "A";\r
arrayofString(5) := "A";\r
arrayofString(6) := "A";\r
arrayofString(7) := "BB";\r
arrayofString(8) := "BB";\r
arrayofString(9) := "CCC";\r
arrayofString(10) := "CCC";\r
$ELSE\r
arrayOfString:= StrTab(10,4)(:"ABC1","ABC22", Str1,3***"A",2***"BB",2***"CCC":);\r
$ENDIF\r
helpstringindex := 1;\r
for i := 1 to 10 do \r
\r
with arrayOfString(i) as x do\r
begin\r
writestring(x); (* ABC1 ABC2 EEEE A A A BB BB CCC CCC *) \r
for i := 1 to x!length do\r
begin\r
IF x(i) <> Nul THEN\r
BEGIN\r
helpstring(helpStringIndex) := x(i);\r
HelpStringIndex := HelpStringIndex + 1;\r
END;\r
end;\r
end;\r
writestring(HelpString);\r
IF not eqString(HelpString,"ABC1ABC2EEEEAAABBBBCCCCCC") THEN EXIT;\r
\r
strrec := RecordWithString(:2,"SA":);\r
PrintInteger(ZoneVar,StrRec.Length); (* 2 *)\r
IF strRec.Length <> 2 THEN EXIT;\r
WriteString(StrRec.s); (* SA *)\r
IF not eqString(StrRec.s,"SA") THEN EXIT;\r
\r
writeString(InitString); (* 1 *)\r
helpstr7 := String(7)(:'1',6***nul:);\r
IF not EqString(InitString,helpstr7) THEN EXIT;\r
writeString(InitString1); (*123*)\r
IF not EQString(InitString1,"123") THEN EXIT;\r
\r
OK := true;\r
end;\r
\r
(***************************Test8Fam *****************************)\r
(********************************************************************)\r
(********************* TEST 8 Familie*******************************)\r
(********************************************************************)\r
\r
\r
PROCEDURE Test8Fam(Var OK : Boolean; VAR ZoneVar : inoutZone);\r
\r
Var\r
Test8Ok : boolean;\r
\r
\r
\r
\r
(*********************** 8A *********************)\r
(* dynamic record with subtypes and dot-notation *)\r
PROCEDURE Test8Fama;\r
const\r
ni = 9;\r
var high : integer:= 3;\r
high1 : integer := 11;\r
type\r
rec(high,high1 : integer) = record\r
r1,r2: integer;\r
r5 : array(1..high) of integer;\r
r3 : record\r
f1,f2,f3 : integer;\r
end;\r
r4 : array(1..high1) of 0..255;\r
b1,b2:boolean;\r
end;\r
var\r
a : rec(High,High1);\r
begin\r
WriteName(ZoneVar,"TEST8FAMA");\r
\r
a.r1:= 17;\r
a.r2:= ni;\r
a.r5(a.r2 - 8) := 6;\r
a.r3.f2:= 110;\r
a.r4(7):= 1;\r
a.b1:= true;\r
a.b2:= a.r2 > 8;\r
\r
PrintInteger(ZoneVar,a.r1); (* 17 *)\r
PrintInteger(ZoneVar,a.r2); (* 9 *)\r
PrintInteger(ZoneVar,a.r5(1)); (* 6 *)\r
\r
PrintInteger(ZoneVar,a.r3.f2); (* 110 *)\r
PrintInteger(ZoneVar,a.r4(7)); (* 1 *)\r
PrintBoolean(ZoneVar,a.b1); (* true *)\r
PrintBoolean(ZoneVar,a.b2); (* true *)\r
Test8OK := (a.r1 = 17) AND\r
(a.r2 = 9 ) AND\r
(a.r5(1) = 6) AND\r
(a.r3.f2 = 110) AND\r
(a.r4(7) = 1) AND\r
(a.b1 AND a.b2);\r
end;\r
\r
\r
\r
(************************ 8C **********************)\r
PROCEDURE Test8Famc;\r
(* array of records *)\r
var high : integer := 10;\r
type\r
ix_type(high : integer) = 0..high; \r
rectype(high : integer) \r
= record\r
f1: ix_type(high);\r
f2: boolean;\r
end;\r
\r
\r
artype1(h : integer) = array(ix_type(h)) of rectype(h);\r
artype2(h : integer) = array(11..h) of integer;\r
\r
dynrectype(hi : integer) \r
= record\r
dummy : artype2(hi);\r
i : integer;\r
ar1 : artype1(hi);\r
end;\r
\r
var\r
step: ix_type(high);\r
dynrec : dynrectype(high) ;\r
\r
begin\r
WriteName(ZoneVar,"TEST8FAMC");\r
Test8OK := false;\r
for step := 0 to 10 do\r
begin\r
dynrec.ar1(step).f1 := step;\r
dynrec.ar1(step).f2 := true;\r
end;\r
\r
for step := 0 to 10 do\r
with dynrec.ar1(step) do\r
begin\r
PrintInteger(ZoneVar,f1); (* 0 , 1, ...,10 *)\r
IF f1 <> step THEN EXIT;\r
PrintBoolean(ZoneVar,f2); (* 11 * true *)\r
if f2 <> true THEN EXIT;\r
end;\r
\r
Test8OK := true;\r
end;\r
\r
\r
(************************** 8CA ***********************)\r
PROCEDURE Test8Famca;\r
(* array-type renamed to recordtype *)\r
Var \r
high : integer := 4;\r
type\r
rect(h : integer)\r
= record\r
f1 : integer;\r
f2 : array(1..h) of integer;\r
f3, f4: integer;\r
end;\r
\r
var\r
x: integer;\r
a: array(1..7) of integer; \r
\r
\r
begin\r
WriteName(ZoneVar,"TEST8FAMCA");\r
TEST8OK := false;\r
\r
for i := 1 to 7 do\r
begin\r
a(i) := 100 + i;\r
x := a(i);\r
PrintInteger(ZoneVar,x); (* 101 - 102 - 103 - 104 - 105 - 106 - 107 *)\r
IF x <> (100 + i) THEN EXIT;\r
end;\r
\r
with a as r: rect(high) do with r do\r
begin\r
PrintInteger(ZoneVar,f1); (* 101 *)\r
IF f1 <> 101 THEN EXIT;\r
for i := 1 to high do\r
BEGIN\r
PrintInteger(ZoneVar,f2(i)); (* 102 - 103 - 104 105*)\r
IF f2(i) <> (102 + i - 1) THEN EXIT;\r
END;\r
PrintInteger(ZoneVar,f3); (* 106 *)\r
IF f3 <> 106 THEN EXIT;\r
PrintInteger(ZoneVar,f4); (* 107 *)\r
IF f4 = 107 THEN Test8OK := true;\r
end;\r
\r
end;\r
\r
\r
\r
(******************************** 8CC *******************)\r
\r
Procedure Test8Famcc;\r
(* assignment and exchange on dynamic record types *)\r
var high : integer := 4;\r
type\r
ix_type = 0..high;\r
rectype(h : ix_type) = record\r
f2: boolean;\r
f3: array(0..h) of 0..210;\r
f4 : integer;\r
f1: integer;\r
\r
\r
end;\r
\r
\r
\r
var\r
rec1,rec2: rectype(high);\r
\r
begin\r
WriteName(ZoneVar,"TEST8FAMCC");\r
TEST8OK := false;\r
rec1.f1 := 1;\r
rec1.f2 := true;\r
for i := 0 to high do rec1.f3(i) := i + 100;\r
rec1.f4 := 4;\r
\r
rec2 := rec1;\r
\r
with rec2 do\r
begin\r
PrintInteger(ZoneVar,f1); (* 1 *)\r
IF f1 <> 1 THEN EXIT;\r
PrintBoolean(ZoneVar,f2); (* true *)\r
IF f2 <> true THEN EXIT;\r
for i := 0 to high do\r
BEGIN\r
PrintInteger(ZoneVar,f3(i)); (* 100, 101, .....104 *)\r
IF f3(i) <> (i + 100) THEN EXIT;\r
END;\r
PrintInteger(ZoneVar,f4); (* 4 *)\r
IF f4 <> 4 THEN EXIT;\r
\r
end; \r
\r
rec1.f1 := 10;\r
rec1.f2 := false;\r
for i := 0 to high do rec1.f3(i) := i + 200;\r
rec1.f4 := 40;\r
\r
\r
\r
rec2 :=: rec1;\r
\r
with rec2 do\r
begin\r
PrintInteger(ZoneVar,f1); (* 10 *)\r
IF f1 <> 10 THEN EXIT;\r
PrintBoolean(ZoneVar,f2); (* false *)\r
IF f2 <> false THEN EXIT;\r
for i := 0 to high do\r
BEGIN\r
PrintInteger(ZoneVar,f3(i)); (* 200, 201, .....204 *)\r
IF f3(i) <> (200 + i) THEN EXIT;\r
END;\r
PrintInteger(ZoneVar,f4); (* 40 *)\r
IF f4 <> 40 THEN EXIT;\r
\r
end; \r
\r
with rec1 do\r
begin\r
PrintInteger(ZoneVar,f1); (* 1 *)\r
IF f1 <> 1 THEN EXIT;\r
PrintBoolean(ZoneVar,f2); (* true *)\r
IF f2 <> true THEN EXIT;\r
for i := 0 to high do\r
BEGIN\r
PrintInteger(ZoneVar,f3(i)); (* 100, 101, .....104 *)\r
IF f3(i) <> (100 + i) THEN EXIT;\r
END;\r
PrintInteger(ZoneVar,f4); (* 4 *)\r
IF f4 = 4 THEN Test8OK := true;\r
\r
end; \r
\r
end;\r
\r
\r
(*********************** 8CD **********************)\r
PROCEDURE Test8Famcd;\r
(* compare on dynamic array and record type *)\r
\r
var high : integer := 5;\r
type\r
arr(low,high : integer) = array(Low..high ) of Low..high;\r
rec(low, high : integer)\r
= record\r
i : integer;\r
i1 : arr(low,high);\r
i2 : boolean;\r
i3 : integer;\r
end;\r
\r
var\r
recorda,recordb : rec(high - 4,high);\r
bool : boolean;\r
\r
\r
\r
procedure compare( var arec : rec; brec : rec(1,5));\r
\r
\r
\r
\r
\r
\r
\r
procedure comparerecord(var r1: rec;var r2 : rec);\r
begin\r
\r
bool := false;\r
IF r1 = r2 THEN\r
bool := true;\r
\r
PrintBoolean(ZoneVar,bool); (* true *)\r
IF Bool <> true THEN EXIT;\r
brec.i3 := 11;\r
IF r1 <> brec THEN \r
bool := false;\r
\r
brec.i3 := -120;\r
PrintBoolean(ZoneVar,Bool); (* false *)\r
IF Bool THEN EXIT;\r
IF ((bool xor bool) xor (arec = brec)) THEN\r
bool := true;\r
\r
PrintBoolean(ZoneVar,bool); (* true *)\r
IF Bool THEN Test8OK :=true\r
ELSE Test8OK := false;\r
\r
end;\r
\r
\r
begin\r
\r
bool := (recorda = recorda) AND\r
( (recordb = Recorda) AND\r
( (Recorda = arec) AND\r
( (recorda = bRec) and\r
( (recordb = recordb) AND\r
( (recordb = arec) AND\r
( (recordb = bRec) AND\r
( (arec = aRec) AND\r
( (aRec = Brec) AND\r
(brec = Brec) ) ) ) ) ) ) ) );\r
\r
\r
PrintBoolean(ZoneVar,bool); (* true *)\r
IF bool <> true THEN EXIT;\r
\r
comparerecord(arec,brec);\r
\r
end;\r
\r
begin\r
WriteName(ZoneVar,"TEST8FAMCD");\r
TEST8OK := false; \r
\r
recorda.i := 5;\r
recorda.i2 := true;\r
recorda.i3 := -120;\r
for i:= 1 to high do recorda.i1(i) := i ;\r
\r
recordb := recorda;\r
bool := recorda.i3 = recordb.i3;\r
PrintBoolean(ZoneVar,bool); (* true *)\r
IF bool = false THEN EXIT;\r
\r
bool := false;\r
IF recordb = recorda THEN\r
bool := true;\r
\r
PrintBoolean(ZoneVar,bool); (* true *)\r
IF bool <> true THEN EXIT;\r
IF recorda <> recordb THEN ELSE\r
bool := false;\r
\r
PrintBoolean(ZoneVar,Bool); (* false *)\r
IF Bool <> false THEN EXIT;\r
IF ((bool xor bool) xor (recorda = recordb)) THEN\r
bool := true;\r
\r
PrintBoolean(ZoneVar,bool); (* true *)\r
IF Bool <> true THEN EXIT;\r
\r
compare(recorda,recordb);\r
\r
end;\r
BEGIN\r
WriteName(ZoneVar,"TEST8FAM");\r
\r
Test8Fama;\r
IF Test8OK <> true THEN GOTO EXITerror;\r
\r
Test8Famc;\r
IF Test8OK <> true THEN GOTO EXITerror;\r
\r
Test8Famca;\r
IF Test8OK <> true THEN GOTO EXITerror;\r
\r
Test8Famcc;\r
IF Test8OK <> true THEN GOTO EXITerror;\r
\r
Test8Famcd;\r
IF Test8OK <> true THEN GOTO EXITerror;\r
\r
OK := true;\r
writechar(ZoneVar,' ');\r
writechar(ZoneVar,'O');\r
writechar(ZoneVar,'K');\r
writechar(ZoneVar,'8');\r
writechar(ZoneVar,' ');\r
\r
Exit;\r
\r
ExitError:\r
OK := false;\r
writechar(ZoneVar,'N');\r
writechar(ZoneVar,'O');\r
writechar(ZoneVar,'T');\r
writechar(ZoneVar,' ');\r
writechar(ZoneVar,'O');\r
writechar(ZoneVar,'K');\r
writechar(ZoneVar,'8');\r
\r
END;\r
\r
(************************* TEST8JA ***********************)\r
(************ TEST Packed type ****************************)\r
\r
PROCEDURE TEST8JA(VAR OK : Boolean; VAR ZoneVar : inoutZone);\r
\r
\r
TYPE\r
Subr0_31Type = 0..31;\r
Subr0_3Type = 0..3;\r
aType = packed array(1..26) of 0..1;\r
arrType = packed array(1..34) of subr0_31Type;\r
signtype = packed array(1..7) of -1024..1023;\r
PackedRecordType =\r
packed record\r
i : integer;\r
i1 : 0..1; (* 1 bit *)\r
i2 : -2..1; (* 2 bit *)\r
i3 : 0..7; (* 3 bit *)\r
i4 : -8..4; (* 4 bit *)\r
i5 : Subr0_31Type; (* 5 Bit *)\r
i6 : - 23 ..31; (* 6 bit *)\r
i7 : 0 ..127; (* 7 *)\r
i8 : -128..64; (* 8 bit *)\r
iinteger : integer;\r
i9 : 0..511; (* 9 bit *)\r
i10 : -500..500; (* 10 bit *)\r
i11 : 1..2047; (* 11 bit *)\r
i12 : -2000..2000; (* 12 bit *)\r
END;\r
\r
packedtype =\r
packed array(-1..8) of\r
packed record\r
i : 0..1;\r
p : packed record\r
b : boolean;\r
a : packed array(1..2) of boolean;\r
end;\r
s : -2..1;\r
a : packed array(1..3) of -2..0;\r
j : 0..4;\r
f : 0..1650;\r
iinteger : integer;\r
end;\r
\r
\r
\r
var a : atype;\r
aa : packed array(1..34) of Subr0_3Type;\r
aaa : packed array(1..30) of -1..1;\r
sign : signtype;\r
\r
notpacked : packed array(1..6) of -1..8888;\r
packedarr : packed array(1..4) of 0..15;\r
sum : integer;\r
subr0_31 : Subr0_31Type;\r
subr0_3 : Subr0_3Type;\r
\r
b1 : packed record\r
i : 1..2;\r
j : 0..10;\r
b : boolean;\r
s : 0..100;\r
t : -1..9\r
end;\r
bb,bbb : packedrecordtype;\r
$test(pass1=256)\r
$test(pass1=1)\r
$test(pass2=256)\r
$test(pass2=15)\r
pack : packedtype;\r
$test(pass1=0)\r
$test(pass2=512)\r
$test(pass1=512)\r
$test(pass2=0)\r
Arr : ArrType;\r
PROCEDURE ExchangePackedElement(VAR Arr : ArrType; VAR Rec : PackedRecordType);\r
VAR i : integer := 10;\r
BEGIN\r
Rec.i5 :=: arr(i);\r
Arr(i) :=: Arr(i-1);\r
Arr(i-1) :=: Arr(8);\r
END;\r
begin\r
Writename(ZoneVar,"TEST8JA");\r
OK := false;\r
sum := 0;\r
for i := 1 to 26 do a(i) := (i mod 2);\r
for i := 1 to 34 do aa(i) := (i mod 3);\r
for i := 1 to 30 do aaa(i) := (i mod 3) - 1;\r
for i := 1 to 7 do sign(i) := -1000 - i; \r
for i := 1 to 6 do notpacked(i) := i; \r
for i := 1 to 26 do sum := a(i) + sum;\r
for i := 1 to 4 do packedarr(i) := i;\r
PrintInteger(ZoneVar,Sum); (* 13 *)\r
IF Sum <> 13 THEN EXIT;\r
sum := 0;\r
for i := 1 to 34 do sum := sum + aa(i);\r
PrintInteger(ZoneVar,Sum); (* 34 *)\r
IF Sum <> 34 THEN EXIT;\r
sum := 0;\r
for i := 1 to 30 do sum := sum + aaa(i);\r
\r
PrintInteger(ZoneVar,Sum); (* 0 *)\r
IF Sum <> 0 THEN EXIT;\r
Printinteger(ZoneVar,a(3)); (* 1 *)\r
IF a(3) <> 1 THEN EXIT;\r
Printinteger(ZoneVar,aa(5)); (* 2 *)\r
IF aa(5) <> 2 THEN EXIT;\r
Printinteger(ZoneVar,aaa(3)); (* -1 *)\r
IF aaa(3) <> -1 THEN EXIT;\r
$IF target <> rc3502\r
with aa as xx : packed array(1..34) of -1..1 do\r
begin\r
PrintInteger(ZoneVar,xx(1)); (* 1 *)\r
IF xx(1) <> 1 THEN EXIT;\r
\r
PrintInteger(ZoneVar,xx(2)); (* -2 *)\r
IF xx(2) <> -2 THEN EXIT;\r
PrintInteger(ZoneVar,xx(3)); (* 0 *)\r
IF xx(3) <> 0 THEN EXIT;\r
end;\r
$ENDIF\r
sum := 0;\r
for i := 1 to 7 do\r
BEGIN\r
sum := sum + sign(i);\r
END;\r
printinteger(ZoneVar,Sum); (* -7028 *)\r
IF Sum <> -7028 THEN EXIT;\r
sum := 0;\r
with notpacked as xxx : array(1..6) of int16 do \r
for i := 1 to 6 do sum := sum + xxx(i);\r
printinteger(zonevar,sum); (* 21 *)\r
IF Sum <> 21 THEN EXIT;\r
\r
with packedarr as w : record\r
b1, b2: byte;\r
end do\r
begin\r
printbyte(zonevar,w.b1);\r
printbyte(zonevar,w.b2); (* 4321 *)\r
end;\r
$nocode\r
aa(11) := 3;\r
PrintInteger(ZoneVar,aa(aa(11) + 8)); (* 3 *)\r
IF aa(aa(11) + 8) <> 3 THEN EXIT;\r
with b1 do\r
begin\r
i := 2;\r
j := 6;\r
b := true;\r
s := 100; \r
t := -1;\r
END;\r
with bb do\r
begin\r
i := 65;\r
i1 := 1;\r
i2 := -1;\r
i3 := 7;\r
i4 := -7;\r
i5 := 20;\r
i6 := -20;\r
i7 := 120;\r
i8 := -120;\r
i9 := 500;\r
i10 := -500;\r
i11 := 2000;\r
i12 := -2000;\r
iinteger := 4; \r
end;\r
\r
bbb := bb;\r
b1.b := bb = bbb;\r
with b1 do\r
sum := (i + (j + ( s + ( t + ord(b)))));\r
PrintInteger(ZoneVar,Sum); (* 108 *)\r
IF Sum <> 108 THEN EXIT;\r
with bbb do\r
sum := i + i1 + ( i2 + ( i3 + ( i4 + i5 +( i6 + ( i7 + i8 + i9 + ( i10 + \r
(i11 + i12))))))) + iinteger; (* 69 *)\r
PrintInteger(ZoneVar,Sum);\r
IF Sum <> 69 THEN EXIT;\r
\r
subr0_31 := 10;\r
bbb.i5 :=: subr0_31;\r
PrintInteger(ZoneVar,subr0_31); (* 20 *)\r
IF Subr0_31 <> 20 THEN EXIT;\r
PrintInteger(ZoneVar,bbb.i5); (* 10 *)\r
IF bbb.i5 <> 10 THEN EXIT;\r
\r
subr0_31 := 5;\r
bbb.i5 := 26;\r
subr0_31 :=: bbb.i5;\r
PrintInteger(ZoneVar,subr0_31); (* 26 *)\r
IF Subr0_31 <> 26 THEN EXIT;\r
PrintInteger(ZoneVar,bbb.i5); (* 5 *)\r
IF bbb.i5 <> 5 THEN EXIT;\r
\r
subr0_3 := 1;\r
aa(34) := 2;\r
aa(34) :=: subr0_3;\r
PrintInteger(ZoneVar,aa(34)); (* 1 *)\r
IF aa(34) <> 1 THEN EXIT;\r
PrintInteger(ZoneVar,subr0_3); (* 2 *)\r
IF Subr0_3 <> 2 THEN EXIT;\r
\r
subr0_3 := 1;\r
aa(subr0_3) := 3;\r
subr0_3 :=: aa(subr0_3) ;\r
PrintInteger(ZoneVar,aa(1)); (* 1 *)\r
IF aa(1) <> 1 THEN EXIT;\r
PrintInteger(ZoneVar,subr0_3); (* 3 *)\r
IF Subr0_3 <> 3 THEN EXIT;\r
\r
aa(5) := 3;\r
aa(4) := 2;\r
sum := 4;\r
aa(sum) :=: aa(sum + 1);\r
PrintInteger(ZoneVar,aa(4)); (* 3 *)\r
IF aa(4) <> 3 THEN EXIT;\r
PrintInteger(ZoneVar,aa(5)); (* 2 *)\r
IF aa(5) <> 2 THEN EXIT;\r
\r
aa(5) := 3;\r
aa(4) := 1;\r
sum := 4;\r
aa(sum) :=: aa(5);\r
PrintInteger(ZoneVar,aa(4)); (* 3 *)\r
IF aa(4) <> 3 THEN EXIT;\r
PrintInteger(ZoneVar,aa(5)); (* 1 *)\r
IF aa(5) <> 1 THEN EXIT;\r
\r
sum := 4;\r
aa(3) := 3;\r
aa(5) := aa(3) + ( aa(3) + ( aa(3) - ( aa(3) + ( aa(3) + aa(3) )))) + aa(3);\r
(* aa(5) = 3 *)\r
aa(3) := 1;\r
aa(sum) := aa(3) + ( aa(3) + ( aa(3) - ( aa(3) + ( aa(3) + aa(3) )))) + aa(3);\r
(* aa(4) = 1 *)\r
aa(sum) :=: aa(aa(3) + ( aa(3) + ( aa(3) + ( aa(3) + 1))));\r
PrintInteger(ZoneVar,aa(4)); (* 3 *)\r
IF aa(4) <> 3 THEN EXIT;\r
PrintInteger(ZoneVar,aa(5)); (* 1 *)\r
IF aa(5) <> 1 THEN EXIT;\r
\r
bbb.i5 := 3;\r
Arr(10) := 2;\r
Arr(9) := 1;\r
Arr(8) := 0;\r
\r
ExchangePackedElement(Arr,bbb);\r
PrintInteger(ZoneVar,bbb.i5); (* 2 *)\r
IF bbb.i5 <> 2 THEN EXIT;\r
PrintInteger(ZoneVar,Arr(10)); (* 1 *)\r
IF arr(10) <> 1 THEN EXIT;\r
PrintInteger(zoneVar,Arr(9)); (* 0 *)\r
IF Arr(9) <> 0 THEN EXIT;\r
PrintInteger(ZoneVar,Arr(8)); (* 3 *)\r
IF Arr(8) <> 3 THEN EXIT;\r
\r
\r
a := atype(:8***0,16***1,0,1:);\r
with a as x : array(1..3) of byte do \r
begin\r
printbyte(ZoneVar,x(1)); (* 00 *)\r
IF x(1) <> #H0 THEN EXIT;\r
printbyte(ZoneVar,x(2)); (* FF *)\r
IF x(2) <> #HFF THEN EXIT;\r
printbyte(ZoneVar,x(3)); (* FF *)\r
IF x(3) <> #HFF THEN EXIT;\r
end;\r
PrintInteger(ZoneVar,a(25)); (* 0 *)\r
IF a(25) <> 0 THEN EXIT;\r
PrintInteger(ZoneVar,a(26)); (* 1 *)\r
IF a(26) <> 1 THEN EXIT;\r
\r
sum := 8;\r
$IF (target <> ta) AND (target <> rc3502)\r
a := atype(:sum***(sum - sum),2 * sum ***1,sum - sum,1:);\r
$ELSE\r
for i := 1 to sum do a(i) := sum -sum;\r
for i := sum + 1 to 3*sum do a(i) := 1;\r
a(25) := 0;\r
a(26) := 1;\r
$ENDIF\r
with a as x : array(1..3) of byte do \r
begin\r
printbyte(ZoneVar,x(1)); (* 00 *)\r
IF x(1) <> #H0 THEN EXIT;\r
printbyte(ZoneVar,x(2)); (* FF *)\r
IF x(2) <> #HFF THEN EXIT;\r
printbyte(ZoneVar,x(3)); (* FF *)\r
IF x(3) <> #HFF THEN EXIT;\r
end;\r
PrintInteger(ZoneVar,a(25)); (* 0 *)\r
IF a(25) <> 0 THEN EXIT;\r
PrintInteger(ZoneVar,a(26)); (* 1 *)\r
IF a(26) <> 1 THEN EXIT;\r
\r
\r
\r
sign := signType(:2***(-20),3*** -10,1000,-905:);\r
sum := 0;\r
for i := 1 to 7 do sum := sign(i) + sum;\r
printinteger(ZoneVar,sum); (* 25 *)\r
IF Sum <> 25 THEN EXIT;\r
\r
sum := 2;\r
$IF (target <> ta) AND (target <> rc3502)\r
sign := signType(:sum***(-sum * 10),3*** -10,sum * 500,-905:);\r
$ELSE\r
sign := signType(:2***(-2 * 10),3*** -10,2 * 500,-905:);\r
$ENDIF\r
sum := 0;\r
for i := 1 to 7 do sum := sign(i) + sum;\r
printinteger(ZoneVar,sum); (* 25 *)\r
IF sum <> 25 THEN EXIT;\r
\r
bb := PackedRecordType(:30,1,-2,6,-5,20,-20,127,-128,1,200,-206,2006,-2000:);\r
with bb do\r
sum := i + i1 + i2 + i3 + (i4 + i5 +( i6 + i7 + iinteger) + i8) + i9 +\r
i10 + i11 + i12;\r
PrintInteger(ZoneVar,Sum); (* 30 *)\r
IF sum <> 30 THEN EXIT;\r
\r
Sum := 3;\r
$IF target <> ta AND (target <> rc3502)\r
bb := PackedRecordType(:sum * 10,sum - 2,-2,sum * 2,-5,20,-20,127,-128\r
,1,209 - (sum * 3),-206,2006,-2000:);\r
$ELSE\r
bb := PackedRecordType(:3 * 10,3 - 2,-2,3 * 2,-5,20,-20,127,-128\r
,1,209 - (3 * 3),-206,2006,-2000:);\r
$ENDIF\r
with bb do\r
sum := i + i1 + i2 + i3 + (i4 + i5 +( i6 + i7 + iinteger) + i8) + i9 +\r
i10 + i11 + i12;\r
PrintInteger(ZoneVar,Sum); (* 30 *)\r
IF sum <> 30 THEN EXIT;\r
\r
$test(pass1=256)\r
$test(pass1=1)\r
$test(pass2=256)\r
$test(pass2=15)\r
pack := packedtype\r
(:10 *** (: 1,(:true,(:true,false:):),-2,(:2***-2,-1:),4,1003,-3:) :);\r
$test(pass1=0)\r
$test(pass2=512)\r
$test(pass1=512)\r
$test(pass2=0)\r
sum := 0;\r
for i := -1 to 8 do\r
begin\r
sum := pack(i).i + (pack(i).s + ( pack(i).j + (pack(i).f + \r
pack(i).iinteger ))) + sum ;\r
for j := 1 to 3 do sum := sum + pack(i).a(j);\r
sum := sum + ord(pack(i).p.b);\r
for j := 1 to 2 do sum := sum + ord(pack(i).p.a(j));\r
end;\r
PrintInteger(ZoneVar,sum); (* 10000 *)\r
IF sum <> 10000 THEN EXIT;\r
\r
sum := 10;\r
$test(pass1=256)\r
$test(pass1=1)\r
$test(pass2=256)\r
$test(pass2=15)\r
$IF target <> ta AND (target <> rc3502)\r
pack := packedtype\r
(:sum *** (: 1,(:sum = 10,(:true,false:):),-2,(:sum - 8 ***-2,-1:)\r
,4,sum * 100 + 3,-3:):);\r
$ELSE\r
pack := packedtype\r
(:10 *** (: 1,(:true,(:true,false:):),-2,(:10 - 8 ***-2,-1:)\r
,4,10 * 100 + 3,-3:):);\r
$ENDIF\r
$test(pass1=0)\r
$test(pass2=512)\r
$test(pass1=512)\r
$test(pass2=0)\r
sum := 0;\r
for i := -1 to 8 do\r
begin\r
sum := pack(i).i + (pack(i).s + ( pack(i).j + (pack(i).f + \r
pack(i).iinteger ))) + sum ;\r
for j := 1 to 3 do sum := sum + pack(i).a(j);\r
sum := sum + ord(pack(i).p.b);\r
for j := 1 to 2 do sum := sum + ord(pack(i).p.a(j));\r
end;\r
PrintInteger(ZoneVar,sum); (* 10000 *)\r
IF sum <> 10000 THEN EXIT;\r
\r
OK := true;\r
\r
End;\r
\r
(* Test pack3502 *)\r
PROCEDURE TEST8JB(VAR OK : Boolean; VAR ZoneVar : inoutZone);\r
\r
TYPE\r
Subr0_3Type = 0..3;\r
aType = packed3502 array(1..26) of 0..15;\r
PackedRecordType =\r
packed3502 record\r
i : int16;\r
i1 : 0..1; (* 1 bit *)\r
i2,ii2 : 0..3; (* 2 bit *)\r
i3 : 0..7; (* 3 bit *)\r
i4 : 0..15; (* 4 bit *)\r
iinteger : int16;\r
i10 : -500..500; (* 10 bit *)\r
i11 : -1..2047; (* 11 bit *)\r
i12 : -2000..2000; (* 12 bit *)\r
END;\r
\r
var a : atype;\r
aa : packed array(1..34) of Subr0_3Type;\r
bb : PackedRecordType;\r
sum : integer;\r
BEGIN\r
\r
Writename(ZoneVar,"TEST8JB");\r
OK := false;\r
sum := 0;\r
for i := 1 to 26 do a(i) := (i mod 2);\r
for i := 1 to 34 do aa(i) := (i mod 3);\r
for i := 1 to 26 do sum := a(i) + sum;\r
\r
PrintInteger(ZoneVar,Sum); (* 13 *)\r
IF Sum <> 13 THEN EXIT;\r
sum := 0;\r
for i := 1 to 34 do sum := sum + aa(i);\r
PrintInteger(ZoneVar,Sum); (* 34 *)\r
IF Sum <> 34 THEN EXIT;\r
sum := 2000;\r
with bb do\r
begin\r
i := 65;\r
i1 := 1;\r
i2 := 2;\r
ii2 := 2;\r
i3 := 7;\r
i4 := 10;\r
i10 := -500;\r
i11 := sum;\r
i12 := -sum;\r
iinteger := 4; \r
end;\r
with bb do\r
sum := (i -64) + i1 + i2 - ii2 + i3 + i4 + i11 + i12 + iinteger;\r
PrintInteger(ZoneVar,sum); (* 23 *)\r
IF 23 <> sum THEN EXIT;\r
\r
aa(5) := 3;\r
aa(4) := 2;\r
sum := 4;\r
aa(sum) :=: aa(sum + 1);\r
PrintInteger(ZoneVar,aa(4)); (* 3 *)\r
IF aa(4) <> 3 THEN EXIT;\r
PrintInteger(ZoneVar,aa(5)); (* 2 *)\r
IF aa(5) <> 2 THEN EXIT;\r
\r
aa(5) := 3;\r
aa(4) := 1;\r
sum := 4;\r
aa(sum) :=: aa(5);\r
PrintInteger(ZoneVar,aa(4)); (* 3 *)\r
IF aa(4) <> 3 THEN EXIT;\r
PrintInteger(ZoneVar,aa(5)); (* 1 *)\r
IF aa(5) <> 1 THEN EXIT;\r
\r
sum := 4;\r
aa(3) := 3;\r
aa(5) := aa(3) + ( aa(3) + ( aa(3) - ( aa(3) + ( aa(3) + aa(3) )))) + aa(3);\r
(* aa(5) = 3 *)\r
aa(3) := 1;\r
aa(sum) := aa(3) + ( aa(3) + ( aa(3) - ( aa(3) + ( aa(3) + aa(3) )))) + aa(3);\r
(* aa(4) = 1 *)\r
aa(sum) :=: aa(aa(3) + ( aa(3) + ( aa(3) + ( aa(3) + 1))));\r
PrintInteger(ZoneVar,aa(4)); (* 3 *)\r
IF aa(4) <> 3 THEN EXIT;\r
PrintInteger(ZoneVar,aa(5)); (* 1 *)\r
IF aa(5) <> 1 THEN EXIT;\r
\r
\r
\r
a := atype(:1,7***0,16***1,0,1:);\r
with a as x : array(1..10) of byte do \r
begin\r
printbyte(ZoneVar,x(1)); (* 10 *)\r
IF x(1) <> #H10 THEN EXIT;\r
printbyte(ZoneVar,x(9)); (* 11 *)\r
IF x(9) <> #H11 THEN EXIT;\r
printbyte(ZoneVar,x(10)); (* 11 *)\r
IF x(10) <> #H11 THEN EXIT;\r
end;\r
PrintInteger(ZoneVar,a(25)); (* 0 *)\r
IF a(25) <> 0 THEN EXIT;\r
PrintInteger(ZoneVar,a(26)); (* 1 *)\r
IF a(26) <> 1 THEN EXIT;\r
\r
\r
bb := PackedRecordType(:1,1,1,1,1,1,1,1,1,1:);\r
with bb do\r
sum := i + i1 + i2 + ii2 + i3 + (i4 + iinteger) +\r
i10 + i11 + i12;\r
PrintInteger(ZoneVar,Sum); (* 10 *)\r
IF sum <> 10 THEN EXIT;\r
$IF target <> RC3502\r
with bb as i : int16 do sum := i;\r
PrintInteger(ZoneVar,Sum); (* 256 *)\r
IF sum <> 256 THEN EXIT;\r
$ENDIF\r
OK := true;\r
\r
End;\r
\r
\r
\r
(************************ TEST8H **************************)\r
(* Test use of ? *)\r
procedure test8h(Var OK : boolean; VAR ZoneVar : inoutzone); \r
var\r
res : integer;\r
procedure test(y : boolean; var x : integer; var z : integer);\r
begin\r
if y then res := x else res := z;\r
end;\r
var\r
res1, help : string(3);\r
procedure test1(y : boolean; var x : string; var z : string);\r
begin\r
if y then res1 := x else res1 := z;\r
end;\r
type \r
snyd =\r
record \r
i : integer;\r
r : reference;\r
j : boolean;\r
p : ^integer;\r
testallign : byte;\r
end;\r
\r
snyd1 = array(1..4) of reference;\r
snyd2 = record\r
i : 0..50;\r
s : snyd1;\r
ss : integer;\r
aa : array(1..6) of snyd;\r
aaa : array(1..3) of snyd1;\r
j : integer;\r
end;\r
var \r
bbb : boolean;\r
i : integer := 3;\r
s :snyd := snyd(:4,?,false,?,117:);\r
$IF Target = RC3502\r
ss : snyd := snyd(:3,?,false,?,117:);\r
$ELSE\r
ss : snyd := snyd(:i,?,false,?,117:);\r
$ENDIF\r
s2 : snyd2 := snyd2(:4,(:4***?:),6,(:6***(:10,?,false,?,117:):),\r
(:3***(:4***?:):),150:);\r
$IF target = RC3502\r
ss2 : snyd2 := snyd2(:3 + 1,(:3***?,?:),6,(:6***(:10,?,false,?,117:):),\r
(:3***(:3***?,1***?:):),50 * 3:);\r
$ELSE\r
ss2 : snyd2 := snyd2(:i + 1,(:i***?,?:),6,(:6***(:10,?,false,?,117:):),\r
(:3***(:i***?,1***?:):),50 * i:);\r
$ENDIF \r
str1 : string(10);\r
\r
begin\r
OK := false;\r
Writename(ZoneVar,"TEST8H");\r
test(true,i,?);\r
PrintBoolean(ZoneVar,Res = i); (* True *)\r
IF Res <> i THEN EXIT;\r
i := 4;\r
test(false,?,i);\r
PrintInteger(ZoneVar,Res); (* 4 *)\r
IF Res <> 4 THEN EXIT;\r
$test(pass2=256)\r
$test(pass2=31)\r
str1 := "abcdef";\r
test1(true,str1,?);\r
help := str1;\r
$test(pass2=512)\r
$test(pass2=0)\r
\r
PrintBoolean(ZoneVar,Res1 = help); (* true *)\r
IF Res1 <> help THEN EXIT;\r
str1 := "ABCD";\r
Res1 := " ";\r
help := str1;\r
test1(false,?,str1);\r
PrintBoolean(ZoneVar,Res1 = help); (* true *)\r
IF Res1 <> help THEN EXIT;\r
\r
with s do\r
if ( i = 4) and nil(r) and (j= false) and nil(p) THEN bbb := true\r
else bbb := false;\r
printboolean(ZoneVar,bbb); (* true *)\r
IF not bbb THEN EXIT;\r
\r
with ss do\r
if ( i = 3) and nil(r) and (j= false) and nil(p) THEN bbb := true\r
else bbb := false;\r
\r
\r
printboolean(ZoneVar,bbb); (* true *)\r
IF not bbb THEN EXIT;\r
\r
with s2 do \r
begin\r
bbb := (i= 4) AND (ss = 6) AND (j = 150);\r
for i := 1 to 4 do bbb := bbb and nil(s(i));\r
for i := 1 to 6 do with aa(i) do\r
bbb := bbb and (i = 10) and ( nil(r)) and (j = false) and ( nil(p));\r
for i := 1 to 3 do with aaa(i) as x\r
do for i := 1 to 4 do bbb := bbb and nil(x(i));\r
end;\r
printboolean(ZoneVar,bbb); (* true *)\r
IF not bbb THEN EXIT;\r
\r
with ss2 do \r
begin\r
bbb := (i= 4) AND (ss = 6) AND (j = 150);\r
for i := 1 to 4 do bbb := bbb and nil(s(i));\r
for i := 1 to 6 do with aa(i) do\r
bbb := bbb and (i = 10) and ( nil(r)) and (j = false) and ( nil(p));\r
for i := 1 to 3 do with aaa(i) as x\r
do for i := 1 to 4 do bbb := bbb and nil(x(i));\r
end;\r
printboolean(ZoneVar,bbb); (* true *)\r
IF bbb THEN OK := true;\r
end;\r
(************************* TEST10A **********************)\r
\r
\r
\r
PROCEDURE test10a(Var OK : Boolean; VAR ZoneVar : inoutZone);\r
(** structured values **)\r
type\r
ix_type = 0..10;\r
rectype = record\r
f1: ix_type;\r
f2: boolean;\r
f3,f4: integer;\r
end;\r
\r
atype = array(1..6) of integer;\r
arrtype = array(1..3) of Rectype;\r
ptrtype = ^integer;\r
recordwithpointer=\r
record \r
i : integer;\r
j : ptrtype;\r
s : 1..5;\r
a : ptrtype;\r
m : atype;\r
end;\r
\r
(* dynamic type *)\r
dynarray( i : integer) = array(1..i) of integer;\r
\r
FUNCTION NewPtr(i : integer) : PtrType;\r
var help : ptrtype;\r
begin\r
new(help);\r
help^ := i;\r
NewPtr := help;\r
end;\r
\r
var\r
i : integer := 10;\r
j : integer := 20;\r
$IF target = RC3502\r
rec2: rectype := rectype(:10,true, 30,40:);\r
$ELSE\r
rec2: rectype := rectype(:i,true, 30,40:);\r
$ENDIF\r
aa : atype;\r
sum : integer;\r
\r
arr,arr1 : arrtype;\r
strucwithpointer : recordwithpointer;\r
dynarr : dynarray(i);\r
Type\r
size3type = record i : integer; s : 1..5; end;\r
size6type = record i,j,k : integer; end;\r
arrayofsize3 = array(1..6) of size3type;\r
arrayofsize4 = array(1..6) of PtrType;\r
arrayofsize6 = array(1..6) of size6type;\r
arrayofsizedyn = array(1..6) of dynarray(3);\r
\r
var size3_1, size3_2 : size3type;\r
size6_1, Size6_2 : size6type;\r
size3 : arrayofsize3;\r
size4 : arrayofsize4;\r
size6 : arrayofsize6;\r
sizedyn : arrayofsizedyn;\r
\r
ptr : ptrtype;\r
\r
procedure printrec(r: rectype);\r
begin\r
with r do\r
begin\r
PrintInteger(ZoneVar, f1);\r
if f2 then PrintInteger(ZoneVar, f3)\r
else PrintInteger(ZoneVar, f4);\r
end;\r
end; (* printrec *)\r
\r
begin \r
WriteName(ZoneVar,"Test10A");\r
Ok := false;\r
printrec(rec2); (* 10 30 *)\r
IF (Rec2.f1 <> 10) or (rec2.f2 <> true) or (rec2.f3 <> 30) or (rec2.f4 <> 40)\r
then EXIT; \r
$IF target = rc3502\r
aa := atype(: 10,30,10,20,8,10:);\r
$ELSE\r
aa := atype(: 10,30,i,j,i-2,i:);\r
$ENDIF\r
sum := 0;\r
for i := 1 to 6 do \r
begin \r
printinteger(ZoneVar,aa(i)); (* 10, 30, 10, 20 , 8, 10 *)\r
sum := sum + aa(i);\r
end;\r
if sum <> 88 THEN EXIT;\r
for i := 1 to 3 do\r
BEGIN\r
$IF target = rc3502\r
arr(i) := rectype(:0,true,0,40:);\r
arr(i).f1 := i;\r
arr(i).f3 := 30 + i;\r
$ELSE\r
arr(i) := rectype(:i,true,30+i,40:);\r
$ENDIF\r
END;\r
for i := 1 to 3 do \r
begin\r
PrintRec(arr(i)); (* 1, 31 2, 32 3, 33 *)\r
with arr(i) do\r
begin\r
IF (f1 <> i) or (f2 <> true) or ( f3 <> (30 + i)) or (f4 <> 40) THEN\r
EXIT;\r
End;\r
end;\r
$IF target <>rc3502\r
\r
arr1 := arrType(: (: 1,false,i,44:), (: 1,false,i,40:), (: 1,false,i,45:) :);\r
sum := 0;\r
for i := 1 to 3 do \r
begin\r
PrintRec(arr1(i)); (* 1, 44 1, 40 1, 45 *)\r
sum := sum + arr1(i).f4;\r
end;\r
printInteger(ZoneVar,sum); (* 129 *)\r
IF Sum <> 129 THEN EXIT;\r
arr1 := arrType(: rec2,rec2,rec2 :);\r
PrintRec(arr1(2)); (* 10, 30 *)\r
IF (arr1(2).f1 <> 10) or (arr1(2).f3 <> 30) THEN EXIT; \r
\r
aa := atype(:6 *** i:);\r
\r
for i := 1 to 6 do aa(1) := aa(i) + aa(1);\r
PrintInteger(ZoneVar,aa(1)); (* 70 *);\r
IF aa(1) <> 70 THEN EXIT;\r
\r
arr1 := arrType(:(i - 8) *** (:6,true,i,3:) , rec2:);\r
sum := 0;\r
for i := 1 to 3 do\r
begin\r
PrintRec(arr1(i)); (* 6, 10 6, 10 10, 30 *)\r
sum := sum + arr1(i).f1 + arr1(i).f3;\r
end;\r
\r
PrintInteger(ZoneVar,Sum); (* 72 *)\r
IF Sum <> 72 THEN EXIT;\r
\r
sum := 0;\r
arr1 := arrType(: rec2, (i - 8) *** (:6,true,i,3:) :);\r
for i := 1 to 3 do \r
begin\r
PrintRec(arr1(i)); (* 10, 30 6, 10 6, 10 *)\r
sum := sum + arr1(i).f1 + arr1(i).f3;\r
end;\r
PrintInteger(ZoneVar,sum); (* 72 *)\r
IF sum <> 72 THEN EXIT;\r
\r
IF recType(:i,true,i+ 1, i+ 2 :) = rectype(:10,true,i+1,12:) \r
THEN i := 12\r
ELSE i := 9;\r
printinteger(ZoneVar,i); (* 12 *)\r
IF i <> 12 THEN EXIT;\r
printrec(rectype(: 3,true,100,0:)); (* 3, 100 *)\r
i := 99;\r
printrec(rectype(: 3,true,i,0:)); (* 3, 99 *)\r
\r
i := 7;\r
strucwithpointer := recordwithpointer(:i,newptr(3),newptr(1)^,newptr(1000),\r
(: 4 *** newptr(12)^, 66,1***newptr(120)^:) :);\r
with strucwithpointer do\r
begin\r
printinteger(ZoneVar,i); (* 7 *)\r
IF i <> 7 THEN EXIT;\r
printinteger(ZoneVar,j^); (* 3 *)\r
IF j^ <> 3 THEN EXIT;\r
PrintInteger(ZoneVar,s); (* 1 *)\r
IF s <> 1 THEN EXIT;\r
PrintInteger(ZoneVar,a^); (* 1000 *)\r
IF a^ <> 1000 THEN EXIT;\r
for j := 1 to 4 do \r
BEGIN\r
PrintInteger(ZoneVar,m(j)); (* 12 *)\r
IF m(j) <> 12 THEN EXIT;\r
END;\r
PrintInteger(ZoneVar,m(5)); (* 66 *)\r
IF m(5) <> 66 THEN EXIT;\r
PrintInteger(ZoneVar,m(6)); (* 120 *)\r
IF m(6) <> 120 THEN EXIT;\r
END;\r
\r
\r
i := 0;\r
dynarr := dynarray(10) (:1,2,3,4,5,6,7,8,9,10:);\r
for j := 1 to 10 do i := i + dynarr(j);\r
printinteger(ZoneVar,i); (* 55 *)\r
IF i <> 55 THEN EXIT;\r
\r
\r
i := 6;\r
dynarr := dynarray(10) (:1,2,3,4,5,i,7,8,9,10:);\r
i := 0;\r
for j := 1 to 10 do i := i + dynarr(j);\r
printinteger(ZoneVar,i); (* 55 *)\r
IF i <> 55 THEN EXIT;\r
\r
i := 6;\r
dynarr := dynarray(10) (:4***300,5,(i-1)***50:);\r
i := 0;\r
for j := 1 to 10 do i := i + dynarr(j);\r
printinteger(ZoneVar,i); (* 1455 *)\r
IF i <> 1455 THEN EXIT;\r
\r
\r
\r
i := 2;\r
size3_1 := size3type(:100,5:);\r
size3_2 := size3type(:-400,4:);\r
size3 := arrayofsize3(:i***size3_1,(:10,3:),i + 1 *** size3_2:);\r
i := 0;\r
for j := 1 to 6 do\r
i := size3(j).i + size3(j).s + i;\r
printinteger(ZoneVar,i); (* -965 *) \r
IF i <> -965 THEN EXIT;\r
\r
ptr := newptr(8); \r
i := 2;\r
size4 := arrayofsize4(:i***newptr(20),ptr,i *** newptr(11),newptr(9):);\r
i := 0;\r
for j := 1 to 6 do\r
i := size4(j)^ + i;\r
printinteger(ZoneVar,i); (* 79 *) \r
IF i <> 79 THEN EXIT;\r
\r
\r
i := 2;\r
size6_1 := size6type(:100,5,10:);\r
size6_2 := size6type(:400,4,20:);\r
size6 := arrayofsize6(:i***size6_1,(:10,6,3:),i + 1 *** size6_2:); \r
i := 0;\r
for j := 1 to 6 do\r
i := size6(j).i + size6(j).j + size6(j).k + i;\r
printinteger(ZoneVar,i); (* 1521 *) \r
IF i <> 1521 THEN EXIT;\r
i := 6;\r
sizedyn(i) := dynarray(3)(:i,2***1:);\r
sizedyn := arrayofsizedyn(:i - 1***sizedyn(i),sizedyn(i):);\r
\r
i := 0;\r
for j := 1 to 6 do\r
\r
i := sizedyn(j)(1) + sizedyn(j)(2) + sizeDyn(j)(3) + i;\r
printinteger(ZoneVar,i); (* 48 *) \r
IF i <> 48 THEN EXIT;\r
\r
$ENDIF \r
\r
\r
\r
OK := true;\r
\r
end.\r
\r
«eof»