|
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: 39940 (0x9c04)
Types: TextFile
Names: »TESTVER4.RTP«
└─⟦316f7fc78⟧ Bits:30010522 DVBS1.SW2114.src.2.7-4 SW2114 4/4 Real Time Pascal 2.7 til old rtp 92.06.10
└─⟦this⟧ »OLDRTP\TESTVER4.RTP«
└─⟦3651f6bb8⟧ Bits:30010514 DVBS1.SW2114.src.2.14-4 SW2114 REAL #4/4 TIME PASCAL SOURCE REL 2.14 92.09.01
└─⟦this⟧ »OLDRTP\TESTVER4.RTP«
└─⟦783187a02⟧ Bits:30010525 DVBS1.SW2114.src.2.6-3 RTP compiler source SW2104+SW2114 Disk#3 30/1-92 HHA
└─⟦this⟧ »OLDRTP\TESTVER4.RTP«
└─⟦ca921ce75⟧ Bits:30010528 DVBS1.SW2114.src.2.6-6 RTP Compiler Source SW2104+SW2114 Disk 3 92.02.03 HEJ HHA
└─⟦this⟧ »OLDRTP\TESTVER4.RTP«
\r
\r
\r
(* ****** RTP compiler test ****************)\r
(* Test version 4 **)\r
\r
\r
(* Impl. external routines used by SYSTEMTEST *)\r
systemtest;\r
const\r
ni = 9;\r
\r
procedure writename(Var z : Zone ; Inspect name : string); External;\r
.\r
\r
\r
(************************************************************* *)\r
(*************** TEST VERSION 4 ********************************)\r
(************************************************************* *)\r
PROGRAM TestVer4(SHARED Test4End,TestVerOK : Boolean);\r
\r
\r
const\r
ccc = 100;\r
\r
\r
\r
\r
TYPE\r
SubTypeDef = 1..4;\r
\r
\r
\r
\r
ttt = 90..ccc;\r
arr = array(80..120, ttt, 95..100) of array(1..2) of ttt;\r
\r
\r
t = 1..4;\r
data = array( t ) of integer;\r
data1 = array(0..2) of boolean;\r
data2 = array(-10..10) of integer;\r
\r
\r
farve = ( rod, gul, blaa, gron, violet, sort );\r
\r
rec = record\r
r1,r2: integer;\r
b1,b2:boolean;\r
end;\r
\r
ix_type = 0..10;\r
rectype = record\r
f1: ix_type;\r
f2: boolean;\r
end;\r
\r
artype = array(ix_type) of rectype;\r
\r
rect = record\r
f1, f2, f3, f4: integer;\r
end;\r
\r
ddddata = array( 0..34 ) of array(1..8) of integer;\r
\r
\r
var\r
a,c : integer;\r
d : data;\r
d1: data1;\r
d2: data2;\r
\r
\r
b : integer;\r
f : farve;\r
\r
arec : rec;\r
\r
ar1: artype;\r
\r
x: integer;\r
aarray: array(t) of integer; (* 8 bytes *)\r
\r
aaa : array(0..2) of integer;\r
bbb : array(1..5,3..5) of integer;\r
i1,i3,i4 : integer;\r
\r
dddd : ddddata;\r
dddd1: array(t,t) of boolean;\r
\r
Test4Ok : Boolean;\r
ZoneVar : Zone;\r
\r
\r
\r
Procedure PrintFarve( aa : Farve);\r
begin\r
with aa as x : byte do PrintByte(ZoneVar, x);\r
end;\r
\r
(*********************** PROCEDURE USED BY TEST4AA ***********************)\r
\r
procedure p(var a : integer);\r
begin\r
a:= 2;\r
dddd(2)(a):= a;\r
dddd(1,8) := 6;\r
dddd(a+1,8) := 16;\r
dddd(2,4*a) := -3;\r
dddd(a)(3 + a) := dddd(a-1)(a+3*a) + dddd(3)(a+3*a) + dddd(a)(a+3*a);\r
c := dddd(a)(2) + ni;\r
PrintInteger(ZoneVar, c); (* 11 *)\r
END;\r
\r
\r
\r
\r
\r
(********************************** TEST4AB ****************************)\r
\r
\r
(* array vith dimension > 2 *)\r
PROCEDURE TEST4AB;\r
var\r
a1: arr;\r
y1,y2 : integer;\r
x1, x100 : integer;\r
\r
begin\r
WriteName(ZoneVar,"Test4AB");\r
for i := 92 to ccc - 3 do\r
begin\r
a1(i , i, 100,1) := i;\r
end;\r
Test4OK := false;\r
y1 := 92;\r
y2 := 93;\r
x1 := 1;\r
x100 := 100;\r
PrintInteger(ZoneVar, a1(y1, y1,x100,x1)); (* 92*)\r
IF a1(y1,y1,100,1) <> 92 THEN EXIT;\r
PrintInteger(ZoneVar, a1(93, y2, 100,1)); (* 93 *) \r
IF a1(93,93,100,1) <> 93 THEN EXIT;\r
PrintInteger(ZoneVar, a1(y2 + 1, 94, x100,x1)); (* 94 *) \r
IF a1(y1 + 2,y1 + 2,100,1) <> 94 THEN EXIT;\r
PrintInteger(ZoneVar, a1(95, 95, 100,1)); (* 95 *)\r
IF a1(y1+3,y1+3,100,1) <> 95 THEN EXIT;\r
PrintInteger(ZoneVar, a1(96, y2 + 3, x100,1)); (* 96 *)\r
IF a1(96,96,100,1) <> 96 THEN EXIT;\r
PrintInteger(ZoneVar, a1(97, 97, x100,x1)); (* 97 *)\r
IF a1(97,97,100,1) = 97 THEN Test4Ok := true;\r
\r
end;\r
\r
\r
\r
\r
(********************************* TEST4AC ***************************)\r
PROCEDURE test4ac ;\r
\r
(* Assignment, Exchange, =/<> involving total arrays *)\r
type\r
ix_type = 0..10;\r
artype = array(ix_type) of integer;\r
\r
var\r
ar1: artype;\r
ar2: artype := (:11***20:);\r
boo: boolean;\r
sum : integer;\r
\r
procedure printarray(a: artype);\r
begin\r
sum := 0;\r
for i := 0 to 10 do\r
begin\r
printinteger(ZoneVar,a(i));\r
sum := sum + a(i);\r
end;\r
end;\r
\r
begin\r
WriteName(ZoneVar,"Test4AC");\r
Test4OK := false; \r
\r
ar1 := artype(:3***5,4***6,4***7:);\r
\r
printarray(ar1); (* se ovenfor *)\r
IF Sum <> ((3 * 5) + (4 * 6) + (4 * 7)) THEN EXIT;\r
\r
(** exchange **)\r
ar1 :=: ar2;\r
printarray(ar1); (* 11 gange 20 *)\r
IF Sum <> 220 THEN EXIT;\r
\r
(* assignment *)\r
\r
ar2 := ArType(:2***0,3***2,3,4,5,3***0:);\r
\r
printarray(ar2); (* 0-0-2-2-2-3-4-5-0-0-0 *)\r
IF Sum <> ((2 * 0) + (3 * 2) + 3 + 4 + 5 ) THEN EXIT;\r
\r
ar2 := ar1;\r
printarray(ar2); (* 11 gange 20 *)\r
IF Sum <> 220 THEN EXIT;\r
\r
boo := ar1 = ar2;\r
printboolean(ZoneVar, boo); (* true *)\r
IF boo <> true THEN EXIT;\r
\r
boo := ar1 <> ar2;\r
\r
printboolean(ZoneVar, boo); (* false *)\r
IF boo = false THEN Test4OK := true;\r
\r
end;\r
\r
\r
\r
(*********************************** TEST4AE *******************************)\r
(* ARRAY - byte expressions *)\r
PROCEDURE test4ae;\r
var\r
a : array(2..3) of byte;\r
b : array(-1..2) of byte;\r
i1,i2 : integer;\r
ai : array(1..2) of -1..2;\r
\r
\r
begin\r
WriteName(ZoneVar,"Test4AE");\r
Test4OK := 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);\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(ai(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
PrintByte(ZoneVar, b(i1)); (* EF *)\r
IF b(i1) <> #HEF THEN EXIT;\r
b(ai(1)) := b(i1) * a(ai(2)) MOD ( a(ai(1) + 3)) ;\r
PrintByte(ZoneVar, b(i1)); (* 8 *)\r
IF b(ai(1)) <> #H8 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
b(-1) := (a(i2) div (#H20 + b(i1))) xor (b(ai(1)) and (#He7 * (b(-1)+ #H3)));\r
PrintByte(ZoneVar, b(i1)); (* 46 *)\r
IF b(i1) = #H46 THEN Test4Ok := true;\r
\r
end;\r
\r
\r
\r
\r
\r
\r
\r
(******************************* TEST4AF ****************************)\r
(* Integer ARRAY - expressions with inspect paramenter*)\r
PROCEDURE TEST4AF;\r
var\r
a : array(0..2) of integer;\r
b : array(1..5,3..5) of integer;\r
i1,i3,i4 : integer;\r
\r
\r
PROCEDURE testinspect(inspect i1 : integer;var i3 : integer; inspect \r
i4 : integer);\r
begin\r
i3 := 3;\r
a(1):= 7;\r
PrintInteger(ZoneVar,a(i1)); (* 7 *)\r
IF a(i1) <> 7 THEN EXIT;\r
b(3,4):= - 30;\r
\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
*)\r
b(3,i4) := 2;\r
PrintInteger(ZoneVar,b(3,i4)); (* 2 *)\r
IF b(3,i4) = 2 THEN Test4OK := true;\r
\r
end;\r
\r
begin\r
WriteName(ZoneVar,"Test4AF");\r
Test4OK := false;\r
i1 := 1;\r
i4 := 4;\r
testinspect(i1 ,i3, i4);\r
end;\r
\r
\r
\r
\r
(****************************** TEST4AG ****************************)\r
\r
PROCEDURE test4ag;\r
(* compare arrays in complicated expression *)\r
\r
\r
type\r
ar = array(-1..10) Of array(1..3) of record\r
i : integer;\r
j1 : integer;\r
b : boolean;\r
End;\r
\r
var a1,a2 : ar;\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,"Test4AG");\r
Test4OK := false;\r
for i := -1 to 10 do\r
for j := 1 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
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 not b THEN Test4OK := true;\r
\r
\r
\r
end;\r
\r
\r
\r
\r
\r
(************************************** TEST4BA **********************)\r
\r
(* record with subtypes and dot-notation *)\r
PROCEDURE test4ba;\r
type\r
rec = record\r
r1,r2: integer;\r
r3 : record\r
f1,f2,f3 : integer;\r
end;\r
r4 : array(1..11) of 0..255;\r
b1,b2:boolean;\r
end;\r
var\r
a : rec;\r
begin\r
WriteName(ZoneVar,"Test4BA");\r
Test4Ok := false;\r
a.r1:= 17;\r
a.r2:= ni;\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
IF a.r1 <> 17 THEN Exit;\r
PrintInteger(ZoneVar, a.r2); (* 9 *)\r
IF a.r2 <> 9 THEN Exit;\r
PrintInteger(ZoneVar, a.r3.f2); (* 110 *)\r
IF a.r3.f2 <> 110 THEN Exit;\r
PrintInteger(ZoneVar, a.r4(7)); (* 1 *)\r
IF a.r4(7) <> 1 THEN Exit;\r
PrintBoolean(ZoneVar, a.b1); (* true *)\r
IF a.b1 <> true THEN Exit;\r
PrintBoolean(ZoneVar, a.b2); (* true *)\r
IF a.b2 = true THEN Test4Ok := true;\r
end;\r
\r
\r
\r
\r
(****************************** TEST4BB *************************)\r
\r
(* record with subtypes - with-notation *)\r
PROCEDURE test4bb;\r
type\r
rec = record\r
r1,r2: integer;\r
r3 : record\r
f1,f2,f3 : integer;\r
end;\r
r4 : array(1..11) of 1..200;\r
b1,b2:boolean;\r
end;\r
var\r
a : rec;\r
begin\r
WriteName(ZoneVar,"Test4BB");\r
Test4Ok := false;\r
with a do\r
begin\r
r1:= 17;\r
r2:= ni;\r
r3.f2:= 110;\r
r4(7):= 1;\r
b1:= true;\r
b2:= r2 > 8;\r
\r
PrintInteger(ZoneVar, r1); (* 17 *)\r
IF r1 <> 17 THEN EXIT;\r
PrintInteger(ZoneVar, r2); (* 9 *)\r
IF r2 <> 9 THEN EXIT;\r
PrintInteger(ZoneVar, r3.f2); (* 110 *)\r
IF r3.f2 <> 110 THEN EXIT;\r
PrintInteger(ZoneVar, r4(7)); (* 1 *)\r
IF r4(7) <> 1 THEN EXIT;\r
PrintBoolean(ZoneVar, b1); (* true *)\r
IF b1 <> true THEN Exit;\r
PrintBoolean(ZoneVar, b2); (* true *)\r
IF b2 THEN Test4OK := True;\r
\r
end;\r
end;\r
\r
(******************************* TEST4CB **********************)\r
PROCEDURE test4cb;\r
(* Assignment, exchange, <>/= between recordtypes *)\r
(* With on a constant **)\r
\r
type\r
ix_type = -7..10;\r
rectype = record\r
f1: ix_type;\r
f2: boolean;\r
f3,f4: integer;\r
end;\r
var\r
rec1: rectype;\r
rec2: rectype := (:5,true, 30,40:);\r
rec3: rectype := rectype(:4, false, 50, 60:);\r
i : integer;\r
const\r
rec4 = rectype(:1, true, -1, -2:);\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,"Test4CB");\r
Test4OK := false;\r
rec1 := rectype(:3, false, 10, 20:);\r
printrec(rec1); (* 3 20 *)\r
IF Rec1 <> rectype(:3,false,10,20:) THEN EXIT;\r
printrec(rec2); (* 5 30 *)\r
IF rec2 <> rectype(:5,true,30,40:) THEN EXIT;\r
\r
rec1 :=: rec2;\r
printrec(rec1); (* 5 30 *)\r
IF rec1 <> recType(:5,true,30,40:) THEN EXIT;\r
if not (rec1 <> rec2) then\r
begin\r
printboolean(ZoneVar,false);\r
EXIT;\r
end\r
else\r
printboolean(ZoneVar,true); (* true *)\r
\r
rec1 := rec4;\r
printrec(rec1); (** 1 -1 **)\r
IF rec1 <> rectype(:1,true,-1,-2:) THEN EXIT;\r
\r
rec3.f2 := rec1 = rec2; (* false *)\r
printrec(rec3); (* 4 60 *)\r
IF rec3 <> recType(:4,false,50,60:) THEN EXIT;\r
\r
(* with paa constant *)\r
with rec4 as y do\r
begin\r
printrec(y); (* 1 -1 *)\r
IF y <> RecType(:1,true,-1,-2:) THEN EXIT;\r
end;\r
\r
i := rec4.f1;\r
printinteger(zonevar,i); (* 1 *)\r
IF i <> 1 THEN EXIT;\r
i := rec4.f3;\r
printinteger(zonevar,i); (* - 1 *)\r
IF i = -1 THEN Test4OK := true;\r
end;\r
\r
\r
(*********************************** TEST4CC *********************)\r
\r
\r
(* assignment and exchange on records and array types *)\r
PROCEDURE TEST4CC;\r
\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 = array(ix_type) of rectype;\r
\r
\r
var\r
ar1,ar2: artype;\r
\r
begin\r
WriteName(ZoneVar,"Test4CC");\r
Test4OK := 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 f3(1) <> 100 + Step 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 <> false THEN EXIT;\r
PrintInteger(ZoneVar, f3(1)); (* 200, 201, .....210 *)\r
IF f3(1) <> 200 + Step THEN Exit;\r
end; \r
\r
TEST4ok := true;\r
end;\r
\r
\r
\r
(*********************************** TEST4CD ***************)\r
(* compare on array and record type *)\r
PROCEDURE Test4cd; \r
type\r
indextype = 1.. 100;\r
arr = array(1..100 ) of indextype;\r
rec = record\r
i : integer;\r
i2 : boolean;\r
i3 : integer;\r
end;\r
\r
var\r
arraya,arrayb: arr;\r
recorda,recordb : rec;\r
bool : boolean;\r
TestOK : Boolean;\r
\r
\r
procedure comparearraysandrecord(a,b : arr; var avar, bvar :arr;\r
var arec : rec; brec : rec);\r
\r
\r
\r
var testlokalok : boolean; \r
\r
\r
\r
procedure comparerecord(var r1, 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.i := 11;\r
IF r1 <> brec THEN \r
bool := false;\r
\r
brec.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 <> True THEN EXIT;\r
\r
TestLokalOk := True;\r
end;\r
\r
\r
begin\r
\r
TestOk := false;\r
bool := false;\r
IF arrayb = avar THEN\r
bool := true;\r
\r
PrintBoolean(ZoneVar, bool); (* true *)\r
IF bool <> true THEN EXIT;\r
b(11) := 10;\r
IF avar <> 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 not bool THEN EXIT;\r
\r
TESTlokalOk := false;\r
comparerecord(arec,brec);\r
TestOk := TestlokalOk; \r
end;\r
\r
begin\r
WriteName(ZoneVar,"Test4CD");\r
Test4Ok := false;\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 <> true 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
\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 <> true THEN EXIT;\r
\r
\r
recorda.i := 5;\r
recorda.i2 := true;\r
recorda.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 <> true 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 <> true THEN EXIT;\r
\r
TestOK := false;\r
\r
comparearraysandrecord(arraya,arrayb,arraya,arrayb,recorda,recordb);\r
Test4Ok := TestOk; \r
\r
end;\r
\r
\r
(***************************** TEST4D *************************)\r
PROCEDURE test4d;\r
(** structured constants of record-type **)\r
(* recordtype as parameter *)\r
\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
var\r
rec1: rectype;\r
rec2: rectype := (:5,true, 30,40:);\r
rec3: rectype := rectype(:4, false, 50, 60:);\r
\r
const\r
rec4 = rectype(:1, true, -1, -2:);\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 (*t4d*)\r
WriteName(ZoneVar,"Test4D");\r
\r
rec1 := rectype(:3, false, 10, 20:);\r
\r
printrec(rec1); (* 3 20 *)\r
printrec(rec2); (* 5 30 *)\r
printrec(rec3); (* 4 60 *)\r
\r
printrec(rec4); (* 1 -1 *)\r
IF (Rec1.f1 = 3) AND\r
(Rec1.f4 = 20) AND\r
(Rec1.f2 = false) AND\r
(Rec2.f1 = 5) AND\r
(Rec2.f3 = 30) AND\r
(Rec2.f2 ) AND\r
(Rec3.f1 = 4) AND\r
(Rec3.f4 = 60) AND\r
(Rec3.f2 = false) AND\r
(Rec4.f1 = 1) AND\r
(Rec4.f3 = -1) AND\r
(Rec4.f2 ) AND\r
(rec1 = rectype(:3,false,10,20:) ) AND\r
(Rec2 = rectype(:5,true,30,40:) ) AND\r
(rec3 = rectype(:4,false,50,60:) ) AND\r
(rec4 = rectype(:1,true,-1,-2:)) THEN Test4OK := true\r
ELSE Test4Ok := false; \r
\r
end;\r
\r
\r
(**************************** TEST4DA ***************************)\r
PROCEDURE test4da;\r
(* reference to an element in struc const *)\r
type\r
arr = array(1..3) of integer;\r
const\r
arr1 = arr(:10,20,30:);\r
\r
begin \r
WriteName(ZoneVar,"Test4DA");\r
\r
printinteger(zonevar,arr1(1)); (*10*)\r
printinteger(zonevar,arr1(2)); (*20*)\r
printinteger(zonevar,arr1(3)); (*30*)\r
IF ( ( arr1(1) = 10) AND\r
( arr1(2) = 20) AND\r
( arr1(3) = 30) ) THEN Test4OK := true\r
ELSE Test4OK := false;\r
end;\r
\r
\r
(************************ TEST4E ******************************)\r
PROCEDURE test4e;\r
(** structured constants of array-type **)\r
(* '***' - notation *)\r
type\r
ix_type = 0..10;\r
artype = array(ix_type) of integer;\r
bigarray = array(1..5000) of integer;\r
var\r
\r
ar1: artype;\r
ar2: artype := (:11***100:);\r
ar3: artype := artype(:11***3:);\r
big : bigarray;\r
sum : integer := 0;\r
begin\r
WriteName(ZoneVar,"Test4E");\r
Test4OK := false;\r
ar1 := artype(:3***5,4***6,4***7:);\r
for step := 0 to 10 do\r
begin\r
PrintInteger(ZoneVar,ar1(step)); (* 5 5 5 6 6 6 6 7 7 7 7 *)\r
sum := sum + ar1(step);\r
end;\r
IF Sum <> (3*5 + 4*6 + 4*7) THEN EXIT;\r
\r
for step := 0 to 10 do\r
BEGIN\r
PrintInteger(ZoneVar,ar2(step)); (* 11 gange 100 *)\r
IF ar2(step) <> 100 THEN EXIT;\r
END;\r
\r
\r
for step := 0 to 10 do\r
BEGIN\r
PrintInteger(ZoneVar,ar3(step)); (* 11 gange 3 *)\r
IF ar3(step) <> 3 THEN EXIT;\r
end;\r
big := bigarray(:5000***2:);\r
sum := 0;\r
for i := 1 To 5000 do sum := sum + big(i);\r
printinteger(zoneVar,sum); (* 10000 *)\r
IF Sum = 10000 THEN Test4OK := true;\r
end;\r
\r
\r
(*************************** TEST4F ******************)\r
PROCEDURE test4f;\r
(* structured constant with array of records *)\r
(* and with 2 - dim arrays **)\r
type\r
ix_type = 0..10;\r
rectype = record\r
f1: ix_type;\r
f2: boolean;\r
end;\r
\r
artype = array(ix_type) of rectype;\r
var\r
step: ix_type;\r
ar1: artype := (:(:7,true:),10***(:1,false:):);\r
ar2: array(1..2) of artype := (: (:11***(:5,false:):),(:11***(:1, true :):) :);\r
begin\r
WriteName(ZoneVar,"Test4F");\r
Test4OK := false;\r
for step := 0 to 10 do\r
with ar1(step) do\r
begin\r
PrintInteger(ZoneVar,f1); (* 7 , 10 * 1 *)\r
IF Step= 0 THEN\r
BEGIN\r
IF f1 <> 7 THEN EXIT;\r
END\r
ELSE\r
IF f1<> 1 THEN EXIT;\r
printBoolean(ZoneVar,f2); (* true , 10 * false *)\r
IF Step= 0 THEN\r
BEGIN\r
IF f2 <> true THEN EXIT;\r
END\r
ELSE\r
IF f2 <> false THEN EXIT;\r
end;\r
\r
for step := 1 to 2 do\r
with ar2(step,step) do\r
begin\r
PrintInteger(ZoneVar,f1); (* 5 , 1 *)\r
printBoolean(ZoneVar,f2); (* false , true *)\r
end;\r
IF (ar2(1,1).f1 = 5) AND\r
(ar2(1,1).f2 = false) AND\r
(ar2(2,2).f1 = 1) AND\r
(ar2(2,2).f2 ) THEN Test4OK := true;\r
\r
end;\r
\r
(*************************** TEST4GB **************************)\r
PROCEDURE test4gb;\r
(* case med OTHERWISE with more than two integer label*)\r
(* and with function as case-variable *)\r
var a,b : integer;\r
\r
function fct(x: integer): integer;\r
begin\r
fct := x;\r
end; (* fct *)\r
\r
begin\r
WriteName(ZoneVar,"Test4GB");\r
a := 0;\r
for i:= -2 to 7 do\r
case fct(i) of\r
-1: a:= a + 1 + fct(i) + 50;\r
0: a := a - 10;\r
3: a := a + 5;\r
6: a:= a + i\r
otherwise a:= a + i + 1\r
end; (* case *)\r
PrintInteger(ZoneVar, a); (* 74 *)\r
IF A <> 74 THEN Test4OK := False\r
ELSE Test4OK := true;\r
end;\r
\r
\r
\r
\r
\r
(****************************** TEST4I *************************)\r
(* WITH on simpel type *)\r
(* renaming in WITH *)\r
(* retyping in WITH *)\r
PROCEDURE TEST4I;\r
var\r
Res, Res1 : integer;\r
resword : word;\r
PROCEDURE Snyd( x : integer);\r
VAR\r
LocalInt : integer;\r
LocalWord : Word;\r
begin\r
with x as y : word\r
do\r
begin\r
y := y - #H1;\r
LocalWord := y;\r
with y as xx : integer do LocalInt := xx + 2;\r
end;\r
Res := LocalInt;\r
ResWord := LocalWord;\r
Res1 := x;\r
end; \r
begin\r
WriteName(ZoneVar,"Test4I");\r
Test4OK := false;\r
Res := 0;\r
with res as x do x := 5;\r
PrintInteger(ZoneVar, res); (* 5 *)\r
IF Res <> 5 THEN Exit;\r
\r
\r
ResWord := #HFFFF;\r
with ResWord as x : 0..255 do x := 1;\r
PrintWord(ZoneVar, ResWord); (* HFF01 *)\r
IF ResWord <> #HFF01 THEN EXIT;\r
\r
\r
Snyd(0);\r
PrintInteger(ZoneVar, Res); (* 1 *)\r
IF Res <> 1 THEN EXIT;\r
PrintInteger(ZoneVar, Res1); (* - 1 *)\r
IF Res1 <> -1 THEN EXIT;\r
PrintWord(ZoneVar, ResWord); (* FFFF *)\r
IF ResWord = #HFFFF THEN Test4OK := true;\r
\r
end;\r
\r
\r
\r
\r
(*************************** TEST4HA ********************************) \r
(* subrange of scalar types and scalar type as step variabel\r
and scalar user in with stat and scalar as paramenter and case with \r
scalar labels *)\r
\r
PROCEDURE TEST4HA;\r
type\r
dag = (man, tir, ons, tor, fre, lqr, sqn);\r
arbdag = man..fre;\r
weekend = lqr..sqn;\r
langweekend = fre..sqn;\r
var\r
f,f1,f2 : farve;\r
fridag : weekend;\r
d : dag;\r
lys :rod..gul;\r
mork : blaa..sort;\r
noday,noworkday,nofriday : integer;\r
procedure addfarve(var a : farve; b : farve);\r
begin\r
with a as k : 0..5 do\r
with b as kk : 0..5 do k := kk + k;\r
end;\r
\r
\r
procedure printdag(dd : dag);\r
procedure writetreechar(ch1,ch2,ch3 : char);\r
begin\r
WriteChar(ZoneVar, ch1);\r
WriteChar(ZoneVar, ch2);\r
WriteChar(ZoneVar, ch3);\r
WriteChar(ZoneVar, cr);\r
WriteChar(ZoneVar, lf);\r
end;\r
begin\r
case dd of\r
man : \r
writetreechar('m','a','n');\r
tir : writetreechar('t','i','r');\r
tor : writetreechar('t','o','r');\r
ons : writetreechar('o','n','s');\r
Fre : writetreechar('f','r','e');\r
lqr : writetreechar('l','q','r');\r
sqn : writetreechar('S','q','n')\r
end;\r
end;\r
begin\r
WriteName(ZoneVar,"Test4HA");\r
Test4Ok := false;\r
f:= blaa;\r
lys :=rod;\r
mork := f;\r
printfarve(mork); (* 2 *)\r
IF mork <> blaa THEN Exit;\r
printfarve(lys); (* 0 *)\r
IF Lys <> rod THEN EXIT;\r
if mork = f THEN d := tor\r
else d := tir;\r
printdag(d); (* tor *)\r
IF d <> tor THEN EXIT;\r
fridag := sqn;\r
printdag(fridag); (* sqn *)\r
IF Fridag <> sqn THEN EXIT;\r
\r
\r
\r
with mork as fff : dag do\r
begin\r
d := fff;\r
printdag(d); (* ons *)\r
IF ons <> d THEN EXIT;\r
mork := sort;\r
IF d = ons THEN fridag := fff;\r
printdag(fridag); (* lqr *)\r
IF fridag <> lqr THEN EXIT;\r
END;\r
\r
noday := 0;\r
noworkday := 0;\r
nofriday := 0;\r
for i := man to sqn do \r
begin\r
if ((i >= man) and (i <= Sqn)) THEN noday := noday + 1;\r
if i < lqr then noworkday := noworkday + 1\r
else nofriday := nofriday + 1;\r
end;\r
\r
PrintInteger(ZoneVar, noday); (* 7*)\r
IF NoDay <> 7 THEN EXIT;\r
PrintInteger(ZoneVar, noworkday); (* 5 *)\r
IF NoWorkDay <> 5 THEN EXIT;\r
PrintInteger(ZoneVar, nofriday); (* 2 *)\r
IF NoFriDay <> 2 THEN EXIT;\r
\r
f1 := lys;\r
addfarve(f1,gul);\r
printfarve(f1); (* 1 *)\r
IF F1 <> gul THEN EXIT;\r
lys := f1;\r
addfarve(f,lys);\r
printfarve(f); (* 3 *)\r
IF f = gron THEN Test4OK := true;\r
\r
\r
end;\r
\r
\r
\r
\r
(********************** TEST4HB *******************)\r
(* arrays mixed with scalar type *)\r
PROCEDURE test4hb;\r
type\r
dag = (man, tir, ons, tor, fre, lqr, sqn);\r
arbdag = man..fre;\r
var\r
arbtid : array(arbdag) of record\r
start,slut : 0..24;\r
end;\r
fritid : array(dag) of record\r
ialt: 0..24;\r
end;\r
\r
\r
\r
fri,arbejde : integer := 0;\r
\r
begin\r
WriteName(ZoneVar,"Test4HB");\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
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
\r
for i := man to sqn do fri := fri + fritid(i).ialt;\r
\r
Test4OK := false;\r
PrintInteger(ZoneVar,arbejde); (* 40 *)\r
IF arbejde <> 40 THEN EXIT;\r
PrintInteger(ZoneVar,fri); (* 128 *)\r
IF Fri = 128 THEN Test4OK := true;\r
\r
\r
end;\r
\r
\r
\r
\r
\r
\r
\r
(*************************** TEST4JA *******************************)\r
PROCEDURE test4ja;\r
(* test array with index type boolean, char and scalar *)\r
\r
\r
type scalar = (a1,a2,a3,a4,a5,a6);\r
\r
var\r
ar1 : array(char) of integer;\r
ar2 : array(boolean) of integer;\r
ar3 : array(scalar) of integer;\r
sum : integer := 0;\r
\r
begin\r
WriteName(ZoneVar,"Test4JA");\r
Test4OK := false;\r
for i := false to true do ar2(i) := 500 + ord(i);\r
\r
for i := a1 to a6 do ar3(i) := 1000 + ord(i);\r
for i := chr(0) TO chr(255) do ar1(i) := ord(i);\r
\r
\r
for i := false to true do sum := sum + ar2(i);\r
PrintInteger(ZoneVar,sum); (* 1001 *)\r
IF sum <> 1001 THEN EXIT;\r
\r
sum := 0;\r
for i := a1 to a6 do sum := sum + ar3(i);\r
PrintInteger(ZoneVar,sum); (* 6015*)\r
IF sum <> 6015 THEN EXIT;\r
\r
PrintInteger(ZoneVar,ar1(chr(100))); (* 100 *)\r
IF ar1(chr(100)) <> 100 THEN EXIT;\r
PrintInteger(ZoneVar,ar1('0')); (* 48 *)\r
IF ar1('0') = 48 THEN Test4OK := true;\r
end;\r
\r
\r
(*********************** TEST4KA *****************************)\r
Procedure test4ka;\r
(* type of size > maxint *)\r
(* renaming a big type with a smaller one *)\r
(* operations on small arrays (2 bytes) **)\r
type\r
big_arr = array(-3..maxint) of 0..255;\r
small_arr = array(1..2) of 0..255;\r
\r
var\r
ba: big_arr;\r
a1, a2: small_arr;\r
i : integer;\r
begin\r
WriteName(ZoneVar,"Test4KA");\r
Test4OK := false;\r
i := -3;\r
ba(i) := 7;\r
printinteger(ZoneVar,ba(-3)); (* 7 *)\r
IF ba(-3) <> 7 THEN EXIT;\r
ba(-2) := 5;\r
\r
with ba as sa: small_arr do\r
begin\r
printinteger(ZoneVar,sa(1)); (* 7 *)\r
IF sa(1) <> 7 THEN EXIT;\r
printinteger(ZoneVar,sa(2)); (* 5 *) \r
IF sa(2) <> 5 THEN EXIT;\r
end;\r
\r
(** operations on small arrays **)\r
a1 := small_arr(:7, 9:);\r
a2 := a1;\r
if not(a1 <> a2) then\r
printinteger(ZoneVar,a1(1)) (* 7 *)\r
else \r
begin\r
printinteger(ZoneVar,a2(2)); (* 9 *)\r
EXIT;\r
END;\r
\r
a1(1) := a2(1) + a2(2);\r
\r
a1 :=: a2;\r
printinteger(ZoneVar,a2(1)); (* 16 *)\r
IF a2(1) <> 16 THEN EXIT;\r
printinteger(ZoneVar,a2(2)); (* 9 *)\r
IF a2(2) = 9 THEN Test4OK := true;\r
\r
\r
end;\r
\r
\r
\r
\r
\r
BEGIN\r
WriteName(ZoneVar,"TESTVERSION4");\r
\r
(******************************* TEST4A *****************************)\r
(* subrange and 1-dim array type *)\r
(* simple element type *)\r
WriteName(ZoneVar,"Test4A");\r
a:= 2;\r
d(2):= a;\r
c:= d(a) + ni;\r
PrintInteger(ZoneVar, c ); (* 11 *)\r
IF c <> 11 THEN GOTO ExitError;\r
\r
for i := 0 to 2 do\r
begin\r
d1(i) := d(2) + i = a;\r
end;\r
PrintBoolean(ZoneVar, d1(0)); (* true *)\r
IF d1(0) <> true THEN GOTO ExitError;\r
PrintBoolean(ZoneVar, d1(1)); (* false *)\r
IF d1(1) <> False THEN GOTO ExitError;\r
PrintBoolean(ZoneVar, d1(2)); (* false *)\r
IF d1(2) <> false THEN GOTO ExitError;\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
\r
PrintInteger(ZoneVar, d2(d2(10) - d2(c) - 1)); (* 110 *)\r
IF 110 <> (d2(d2(10) - d2(c) - 1)) THEN GOTO ExitError;\r
PrintInteger(ZoneVar, d2(-7)); (* 7*)\r
IF d2(-7) <> 7 THEN GOTO ExitError;\r
\r
\r
\r
(************************* TEST4AA ***********************************)\r
(* subrange and 2-dim array type *)\r
\r
WriteName(ZoneVar,"Test4AA");\r
p(dddd(4,4));\r
IF c <> 11 THEN GOTO ExitError;\r
a := 4;\r
dddd1(3,3) := dddd(a,a) = 2;\r
a := 3;\r
PrintBoolean(ZoneVar, dddd1(a,a)); (* true *)\r
IF not dddd1(a,a) THEN Goto ExitError;\r
\r
PrintInteger(ZoneVar, dddd(2,5)); (* 19 *)\r
IF dddd(2,5) <> 19 THEN GOTO ExitError;\r
\r
\r
\r
\r
\r
(************************* TEST4AB ************************)\r
TEST4AB;\r
IF Test4OK = false THEN GOTO ExitError;\r
\r
\r
\r
(************************* TEST4AC ************************)\r
TEST4AC;\r
IF Test4OK = false THEN GOTO ExitError;\r
\r
\r
(***************************** TEST4AD **********************************)\r
(* Integer ARRAY - expressions *)\r
WriteName(ZoneVar,"Test4AD");\r
i1 := 1;\r
i3 := 3;\r
i4:= 4;\r
aaa(1):= 7;\r
PrintInteger(ZoneVar, aaa(i1)); (* 7 *)\r
IF aaa(i1) <> 7 THEN GOTO ExitError;\r
bbb(3,4):= - 30;\r
PrintInteger(ZoneVar, bbb(i3,i4)); (* -30 *)\r
IF bbb(i3,i4) <> -30 THEN GOTO ExitError;\r
(*\r
bbb(i3,4) := aaa(i4 - i3) + (( (aaa(i1) + 60) DIV bbb(i3,i4)) +\r
(( (aaa(i1) + 30) MOD bbb(i3,i4) ) DIV (( aaa(i1) + 342 - 758)\r
+ ((23 + aaa(i4 - i3)) + (( aaa(i1) MOD bbb(i4 - i1,i1 + (i1 + (i1 + 1)) )) -\r
(( 303 + aaa(i4 -(i1 + ( i1 + i1)) ) - 300)\r
* ((bbb(i3,i4) + aaa(i1 + ( aaa(1) - aaa(i1)) )) + ((200 + (bbb(i3,i4) \r
- 230)) mod ( aaa(i1) + bbb(3,i4)) ))))))));\r
*)\r
bbb(3,i4) := 2;\r
PrintInteger(ZoneVar, bbb(3,i4)); (* 2 *) \r
IF bbb(3,i4) <> 2 THEN Goto ExitError;\r
\r
\r
(*************************** TEST4AE *********************)\r
TEST4AE;\r
IF Not Test4OK THEN GOTO ExitError;\r
\r
\r
\r
(*************************** TEST4AF *********************)\r
TEST4AF;\r
IF Not Test4OK THEN GOTO ExitError;\r
\r
\r
\r
(*************************** TEST4AG *********************)\r
TEST4AG;\r
IF Not Test4OK THEN GOTO ExitError;\r
\r
\r
\r
(************************** TEST4B **************************)\r
(* record type with two simpel field types *)\r
WriteName(ZoneVar,"Test4B");\r
arec.r1:= 17;\r
arec.r2:= ni;\r
arec.b1:= true;\r
arec.b2:= arec.r2 > 8;\r
\r
PrintInteger(ZoneVar, arec.r1); (* 17 *)\r
IF arec.r1 <> 17 THEN GOTO ExitError;\r
PrintInteger(ZoneVar, arec.r2); (* 9 *)\r
IF arec.r2 <> 9 THEN GOTO ExitError;\r
PrintBoolean(ZoneVar, arec.b1); (* true *)\r
IF arec.b1 <> true THEN GOTO ExitError;\r
PrintBoolean(ZoneVar, arec.b2); (* true *)\r
IF arec.b2 <> true THEN GOTO ExitError;\r
\r
\r
\r
\r
\r
(*******************************TEST4BA **********************)\r
TEST4BA;\r
IF TEST4OK = false THEN GOTO ExitError;\r
\r
\r
\r
(******************************** TEST4BB *********************)\r
TEST4BB;\r
IF Test4Ok = false THEN GOTO ExitError;\r
\r
\r
\r
\r
(***************************** TEST4C ************************)\r
(* array of records *)\r
WriteName(ZoneVar,"Test4C");\r
for step := 0 to 10 do\r
begin\r
ar1(step).f1 := step;\r
ar1(step).f2 := true;\r
end;\r
\r
Test4Ok := true;\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 test4Ok := false;\r
PrintBoolean(ZoneVar, f2); (* 11 * true *)\r
If f2 <> true THEN test4Ok := false;\r
end;\r
\r
IF Not Test4Ok THEN Goto ExitError;\r
\r
\r
\r
(******************************* TEST4CA *******************************)\r
(* array-type renamed to recordtype *)\r
WriteName(ZoneVar,"Test4CA");\r
\r
TEST4Ok := True;\r
for i := 1 to 4 do\r
begin\r
aarray(i) := 100 + i;\r
x := aarray(i);\r
PrintInteger(ZoneVar, x); (* 101 - 102 - 103 - 104 *)\r
IF x <> (100 + i) THEN Test4Ok := False; \r
end;\r
\r
IF not Test4Ok THEN GOTO ExitError;\r
\r
with aarray as r: rect do with r do\r
begin\r
PrintInteger(ZoneVar, f1); (* 101 *)\r
IF F1 <> 101 THEN Test4Ok := false;\r
PrintInteger(ZoneVar, f2); (* 102 *)\r
IF F2 <> 102 THEN Test4Ok := false;\r
PrintInteger(ZoneVar, f3); (* 103 *)\r
IF F3 <> 103 THEN Test4Ok := false;\r
PrintInteger(ZoneVar, f4); (* 104 *)\r
IF F4 <> 104 THEN Test4Ok := false;\r
end;\r
\r
IF Test4Ok <> true THEN Goto ExitError;\r
\r
\r
\r
\r
(************************ TEST4CB ***************************)\r
TEST4CB;\r
IF Test4OK <> True THEN Goto Exiterror;\r
\r
\r
\r
(************************ TEST4CC ***************************)\r
TEST4CC;\r
IF Test4OK <> True THEN Goto Exiterror;\r
\r
\r
\r
\r
\r
\r
(************************* TEST4CD ****************************)\r
Test4cd;\r
IF Test4Ok <> true THEN Goto ExitError;\r
\r
\r
\r
\r
\r
(************************ TEST4D ***************************)\r
TEST4D;\r
IF Test4OK <> True THEN Goto Exiterror;\r
\r
\r
\r
(************************ TEST4DA ***************************)\r
TEST4DA;\r
IF Test4OK <> True THEN Goto Exiterror;\r
\r
\r
\r
(************************ TEST4E ***************************)\r
TEST4E;\r
IF Test4OK <> True THEN Goto Exiterror;\r
\r
\r
\r
(************************ TEST4F ***************************)\r
TEST4F;\r
IF Test4OK <> True THEN Goto Exiterror;\r
\r
\r
\r
\r
(************************* TEST4G ********************************)\r
(* case uden OTHERWISE *);\r
WriteName(ZoneVar,"Test4G");\r
for i:= 1 to 2 do\r
case i of\r
1: a:= ni;\r
2: a:= a + i\r
end; (* case *)\r
\r
PrintInteger(ZoneVar, a); (* 11 *)\r
IF a <> 11 THEN GOTO ExitError;\r
b:= a mod 3;\r
PrintInteger(ZoneVar, b ); (* 2 *)\r
IF b <> 2 THEN GOTO ExitError;\r
\r
\r
\r
\r
\r
(**************************** TEST4GA *********************************)\r
(* case med OTHERWISE *)\r
WriteName(ZoneVar,"Test4GA");\r
for i:= 1 to 4 do\r
case i of\r
1: a:= ni;\r
2: a:= a + i\r
otherwise a:= a + 3*i\r
end; (* case *)\r
PrintInteger(ZoneVar, a); (* 32 *)\r
IF a <> 32 THEN GOTO ExitError;\r
b:= a mod 3;\r
PrintInteger(ZoneVar, b ); (* 2 *)\r
IF b <> 2 THEN GOTO ExitError;\r
\r
\r
\r
\r
\r
\r
\r
(************************** TEST4GB ********************************)\r
(* case med OTHERWISE with more than two integer label*)\r
Test4gb;\r
IF Test4Ok = false THEN GOTO ExitError;\r
\r
\r
(**************************** TEST4GC ************************************)\r
(* Nested case *)\r
WriteName(ZoneVar,"Test4GC");\r
a := 0;\r
b := 5;\r
for i:= -2 to 7 do\r
case i of\r
-1: ;\r
0: if b = 4 THEN a := a - 10;\r
3: case i of\r
3 : a := a + 5\r
end;\r
6: if b= 4 then else a:= a + i\r
otherwise a:= a + i\r
end; (* case *)\r
PrintInteger(ZoneVar, a); (* 28 *)\r
IF a <> 28 THEN GOTO ExitError;\r
\r
\r
\r
(**************************** TEST4GD ******************************)\r
(* Nested case and labellist*)\r
WriteName(ZoneVar,"Test4GD");\r
a := 0;\r
for i:= -4 to 10 do\r
case i of\r
-1..1: ;\r
9,-3: case i of\r
9..20,-3 : case i of \r
9 : if i = 9 then a := a + 5;\r
- 3..1 :\r
end\r
end;\r
6,4: case i of \r
4: a := a + i\r
otherwise a := a + 2\r
end\r
otherwise case i of \r
5 : a:= a + i;\r
10 : if i = 10 then a := a * i\r
otherwise a := a - i\r
end\r
end; (* case *)\r
PrintInteger(ZoneVar, a); (* 20 *)\r
IF a <> 20 THEN GOTO ExitError;\r
\r
\r
\r
\r
\r
\r
(******************************* TEST4I *******************************)\r
\r
\r
\r
TEST4I;\r
IF Test4Ok = false THEN Goto ExitError;\r
\r
\r
\r
(****************************** TEST4H **********************************)\r
(* scalar types *)\r
WriteName(ZoneVar,"Test4H");\r
f:= blaa;\r
printfarve(f); (* 2 *)\r
IF f <> Blaa THEN GOTO ExitError;\r
\r
\r
\r
(******************************* TEST4HA *****************************)\r
Test4HA;\r
IF NOT Test4OK THEN GOTO ExitError;\r
\r
\r
\r
\r
(*************************** TEST4HB *********************)\r
TEST4HB;\r
IF Not Test4OK THEN GOTO ExitError;\r
\r
\r
\r
(*************************** TEST4JA *********************)\r
TEST4JA;\r
IF Not Test4OK THEN GOTO ExitError;\r
\r
\r
\r
\r
(************************ TEST4KA ***************************)\r
TEST4KA;\r
IF Test4OK <> True THEN Goto Exiterror;\r
\r
\r
region testverok do\r
TestVerOK := true;\r
region test4end do\r
Test4End := true;\r
\r
\r
EXIT;\r
\r
ExitError:\r
\r
region testverok do\r
TestverOK := false; \r
\r
region test4end do\r
Test4End := true;\r
\r
\r
end.\r
\r
\r