|
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: 28350 (0x6ebe)
Types: TextFile
Names: »TESTVER7.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\TESTVER7.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\TESTVER7.RTP«
└─⟦783187a02⟧ Bits:30010525 DVBS1.SW2114.src.2.6-3 RTP compiler source SW2104+SW2114 Disk#3 30/1-92 HHA
└─⟦this⟧ »OLDRTP\TESTVER7.RTP«
└─⟦ca921ce75⟧ Bits:30010528 DVBS1.SW2114.src.2.6-6 RTP Compiler Source SW2104+SW2114 Disk 3 92.02.03 HEJ HHA
└─⟦this⟧ »OLDRTP\TESTVER7.RTP«
\r
(* ******RTP compiler test ****************)\r
(* ************* TEST VERSION 7 *************)\r
systemtest;\r
const\r
ni = 9;\r
\r
\r
procedure writeName( VAR z : Zone; INSPECT name : String); external;\r
\r
\r
.\r
\r
\r
\r
program TestVer7(Shared Finish,Test7ok : Boolean);\r
\r
\r
var\r
ZoneVar : Zone;\r
TestVerOK : boolean := true;\r
\r
shared\r
\r
\r
Test7jOK : Boolean;\r
Test7jEnd : Boolean;\r
Var \r
process7j : process;\r
createok :create_result;\r
Linkok : Link_Result;\r
UnLinkok : UnLink_Result;\r
\r
(********************************************************************)\r
(********************* TEST VERSION 7 *******************************)\r
(********************************************************************)\r
\r
\r
PROCEDURE TestVersion7;\r
\r
Var \r
Test7Ok : boolean;\r
\r
\r
\r
(********************* TEST7A **************************)\r
PROCEDURE test7a;\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..4;\r
data = array( t ) of integer;\r
data1 = array(0..high2) of boolean;\r
data2 = array(Low..High) of integer;\r
var\r
a,c : integer;\r
d : data;\r
d1: data1;\r
d2: data2;\r
\r
begin\r
WriteName(ZoneVar,"Test7A");\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
low := -10;\r
high := 10;\r
high2 := 2;\r
low1 := 1;\r
\r
p;\r
end;\r
\r
\r
\r
\r
(****************************** TEST7AA *******************************)\r
PROCEDURE test7aa;\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
t = low1..4;\r
data = array( 0..high ) of array(low..8) of integer;\r
\r
var\r
a,c : integer;\r
d : data;\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
$code\r
d(a)(3 + a) := d(a - 1)(a+3*a) + d(3)(a+3*a) + d(a)(a+3*a);\r
$nocode\r
c:= d(a)(2) + ni;\r
PrintInteger(ZoneVar, c ); (* 11 *)\r
end;\r
Begin\r
WriteName(ZoneVar,"Test7AA");\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
p(low,high,low1);\r
end;\r
\r
\r
(*************************** TEST7AB ***************************)\r
PROCEDURE test7ab; \r
(* dynamic array with dimension > 2 *)\r
const\r
c = 100;\r
\r
var low : integer := 90;\r
high : integer := 100;\r
type\r
t = low..c;\r
arr = array(low..100, t, t, 99..100) of array(low - 89..2) of t;\r
\r
var\r
a1: arr;\r
y1,y2 : integer;\r
x1, x100 : integer;\r
\r
begin\r
WriteName(ZoneVar,"Test7AB");\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
(**************************** TEST7AD ************************)\r
PROCEDURE test7ad;\r
(* Integer ARRAY - expressions *)\r
var\r
\r
limit : integer := 3;\r
a : array(0..2) of integer;\r
b : array(1..5,limit..5) of integer;\r
i1,i3,i4 : integer;\r
\r
\r
begin\r
WriteName(ZoneVar,"Test7AD");\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
*)\r
b(i3,4) := 2;\r
PrintInteger(ZoneVar, b(3,i4)); (* 2 *)\r
IF b(3,i4) = 2 THEN TEST7OK := True;\r
\r
end;\r
\r
\r
\r
(***************************** TEST7AE ******************************)\r
\r
PROCEDURE test7ae;\r
(* ARRAY - byte expressions *)\r
var\r
low : integer := -1;\r
limit : integer := 2;\r
a : array(limit..3) of byte;\r
b : array(low..2) of byte;\r
i1,i2 : integer;\r
ai : array(1..2) of low..2;\r
\r
\r
begin\r
WriteName(ZoneVar,"Test7AE");\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);\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
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(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
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 Test7OK := true;\r
\r
end;\r
\r
\r
\r
(***************************** TEST7AG *************************) \r
PROCEDURE test7ag;\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 = 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;\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,"Test7AG");\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 not b THEN Test7OK := true;\r
\r
\r
end;\r
\r
\r
(****************************** TEST7C **************************)\r
PROCEDURE test7c;\r
(* array of records *)\r
var high : integer;\r
\r
procedure p;\r
type\r
ix_type = 0..high;\r
rectype = record\r
f1: ix_type;\r
f2: boolean;\r
end;\r
\r
artype = array(ix_type) of rectype;\r
\r
var\r
step: ix_type;\r
ar1: artype;\r
\r
begin\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
WriteName(ZoneVar,"Test7C");\r
high := 10;\r
p;\r
end;\r
\r
\r
(******************************* TEST7CC ************************)\r
PROCEDURE test7cc;\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 = array(0..high) of rectype;\r
\r
\r
var\r
ar1,ar2: artype;\r
\r
begin\r
WriteName(ZoneVar,"Test7CC");\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
(********************************* TEST7CD **************************)\r
PROCEDURE test7cd;\r
(* compare on array and record type *)\r
var high : integer := 100;\r
\r
type\r
indextype = 1.. high;\r
arr = array(1..high ) of indextype;\r
rec = record\r
i : integer;\r
i2 : boolean;\r
i3 : integer;\r
end;\r
arr1 = array(100..high) of Rec; \r
var\r
arraya,arrayb: arr;\r
recorda,recordb : arr1;\r
bool : boolean;\r
\r
\r
\r
procedure comparearraysandrecord(a,b : arr; var avar, bvar :arr;\r
var arec : arr1; brec : arr1);\r
\r
\r
\r
\r
\r
\r
\r
procedure comparerecord(var r1, 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,"Test7CD");\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
(**************************** TEST7HB *************************)\r
\r
(* dynamic arrays mixed with scalar type *)\r
PROCEDURE test7hb;\r
\r
type\r
dag = (man, tir, ons, tor, fre, lqr, sqn);\r
var\r
high : dag := fre;\r
type\r
arbdag = man..high;\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;\r
\r
begin\r
WriteName(ZoneVar,"Test7HB");\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
(************************** TEST7IA ******************************)\r
PROCEDURE Test7ia;\r
(* familie type of arrays *)\r
Type\r
SubType(x : 1..20) = -x..x;\r
T ( n : integer) = Array(1..n) Of integer;\r
s (n,m : integer) = Array(n..m) of SubType(m);\r
Var\r
x : integer :=10;\r
dyn1 : T(x);\r
Dyn2 : T(10);\r
Begin\r
WriteName(ZoneVar,"Test7IA");\r
Test7OK := false;\r
For i := 1 TO x do dyn1(i) := i;\r
For i := 1 To 10 Do Dyn2(i) := i + Dyn1(i);\r
\r
Dyn1 :=: Dyn2;\r
\r
For i := 1 To 10 Do PrintInteger(ZoneVar,dyn1(i)); (* 2,4,6,8,10 .. 20 *)\r
For i := 1 To 10 Do PrintInteger(ZoneVar,dyn2(i)); (* 1,2,3,4,5,6, .. 10 *)\r
For i := 1 TO 10 DO IF dyn1(i) <> (i * 2) THEN EXIT;\r
For i := 1 TO 10 DO IF dyn2(i) <> i THEN EXIT;\r
\r
With Dyn2 As x : S(1,x) DO\r
For i := 1 TO 5 Do x(1) := x(1) + ( x(i * 2) - x( (i * 2) - 1));\r
PrintInteger(ZoneVar,dyn2(1)); (* 6 *)\r
IF dyn2(1) = 6 THEN Test7OK := true;\r
End;\r
\r
\r
\r
(*********************** TEST7IB ********************************)\r
PROCEDURE Test7ib;\r
(* familie of arrays *)\r
TYPE\r
FamilieArray(n : integer) = Array(2..n) Of 1..n;\r
\r
var\r
i,i1 : integer := 5;\r
x,y,z : FamilieArray(i);\r
typesel : integer;\r
\r
Procedure ProcTest7ib(x : FamilieArray; VAR y : FamilieArray;\r
var z : FamilieArray(5));\r
\r
Var\r
L : FamilieArray(i);\r
Begin\r
x(i) := 1;\r
y(i) := 2;\r
z(i) := 3;\r
L := x;\r
x := y;\r
y :=: z;\r
z :=: l;\r
i := L(5);\r
i1 := x(5);\r
\r
TypeSel := L!n + x!n + y!n + z!n;\r
\r
End;\r
\r
Begin\r
WriteName(ZoneVar,"Test7IB");\r
Test7OK := false;\r
x(i) := 5;\r
y(i) := 5;\r
z(i) := 5;\r
PrintInteger(ZoneVar,z(5)); (* 5 *)\r
IF z(5) <> 5 THEN EXIT;\r
ProcTest7ib(x,y,z);\r
\r
PrintInteger(ZoneVar,x(5)); (* 5 *)\r
IF x(5) <> 5 THEN EXIT;\r
PrintInteger(ZoneVar,i); (* 2 *)\r
IF i <> 2 THEN EXIT;\r
PrintInteger(ZoneVar,i1); (* 2 *)\r
IF i1 <> 2 THEN EXIT;\r
PrintInteger(ZoneVar,y(5)); (* 3 *)\r
IF y(5) <> 3 THEN EXIT;\r
PrintInteger(ZoneVar,z(5)); (* 1 *)\r
IF z(5) <> 1 THEN EXIT;\r
PrintInteger(ZoneVar,TypeSel); (* 20 *)\r
IF TypeSel = 20 THEN Test7OK := true;\r
End;\r
\r
\r
PROCEDURE test7ka;\r
(* size of dynamic size > maxint *)\r
(* renaming a big dynamic type with a smaller one *)\r
\r
var\r
high : integer := maxint;\r
high1 : integer := 2;\r
type\r
big_arr = array(-3..high) of 0..255;\r
small_arr = array(1..high1) of 0..255;\r
\r
var\r
ba: big_arr;\r
a1, a2: small_arr;\r
i : integer;\r
begin\r
WriteName(ZoneVar,"Test7KA");\r
Test7OK := 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
for i := -1 to maxint do ba(i) := 117;\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
\r
(** operations on small arrays **)\r
(*a1 := small_arr(:7, 9:);*)\r
a1(1) := 7; a1(2) := 9;\r
a2 := a1;\r
if not(a1 <> a2) then\r
printinteger(ZoneVar,a1(1)) (* 7 *)\r
else printinteger(ZoneVar,a2(2)); (* 9 *)\r
IF a2 <> a1 THEN EXIT;\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 Test7OK := true;\r
\r
\r
end;\r
\r
\r
\r
\r
BEGIN\r
WriteName(ZoneVar,"TESTVERSION7");\r
\r
\r
Test7a;\r
IF Test7OK <> true THEN GOTO EXITError;\r
\r
\r
Test7aa;\r
IF Test7OK <> true THEN GOTO EXITError;\r
\r
Test7ab;\r
IF Test7OK <> true THEN GOTO EXITError;\r
\r
Test7ad;\r
IF Test7OK <> true THEN GOTO EXITError;\r
\r
Test7ae;\r
IF Test7OK <> true THEN GOTO EXITError;\r
\r
Test7ag;\r
IF test7OK <> true THEN GOTO ExitError;\r
\r
Test7c;\r
IF Test7OK <> true THEN GOTO EXITError;\r
\r
Test7cc;\r
IF Test7OK <> true THEN GOTO EXITError;\r
\r
Test7cd;\r
IF Test7OK <> true THEN GOTO EXITError;\r
\r
Test7hb;\r
IF Test7OK <> true THEN GOTO EXITError;\r
\r
Test7ia;\r
IF Test7OK <> true THEN GOTO EXITError;\r
\r
Test7ib;\r
IF Test7OK <> true THEN GOTO EXITError;\r
\r
Test7KA;\r
IF Test7OK <> true THEN GOTO EXITError;\r
\r
TestVerOK := True;\r
\r
ExitError:\r
\r
END;\r
\r
\r
\r
\r
\r
\r
(************************ TEST7J *********************************)\r
\r
(* test lock statement and open routine call *)\r
PROGRAM test7j(Shared fin : boolean; Shared OK : Boolean);\r
\r
Var ZoneVar : Zone;\r
Ref : Reference;\r
po,po1 : Pool;\r
sum : integer;\r
Mail : MailBox;\r
No : integer;\r
i : integer := 10; \r
Refs : array(1..i) of reference;\r
Res1, Res2,Res3,Res4,Res5,Res6,Res7 : integer; \r
Bool : Boolean;\r
pro,pro1 : process;\r
procedure local1;\r
procedure local2;\r
\r
var\r
locref1,locref2 : reference;\r
begin\r
pro :=: pro1;\r
locref1 :=: ref;\r
locref1 :=: locref2;\r
locref2 :=: ref;\r
end;\r
\r
var \r
locref1,locref2 : reference;\r
begin\r
pro :=: pro1;\r
local2;\r
locref1 :=: ref;\r
locref1 :=: locref2;\r
locref2 :=: ref;\r
end;\r
\r
\r
begin (* Main program *)\r
\r
\r
WriteName(ZoneVar,"Test7J");\r
\r
No := AllocPool(Po,10,100,Mem_Private);\r
PrintInteger(ZoneVar,No); (* 10 *)\r
IF No <> 10 THEN GOTO Error;\r
GetBuf(Po,Mail,Ref);\r
local1;\r
Printinteger(ZoneVar,-127);\r
Lock ref to x do \r
For i := 1 TO 100 DO x(Offset(ref) + i - 1) := byt(i);\r
sum := 0;\r
Lockbuf ref to y do with y as yy : array(1..100) of 1..100 do\r
for i := 1 to 100 do\r
begin\r
printinteger(zonevar,yy(i)); (* 1,2 .. 100 *)\r
sum := sum + yy(i);\r
End;\r
IF Sum <> (101 * 50) THEN GOTO Error;\r
PutBuf(Ref);\r
\r
For i := 1 to i do GetBuf(po,Mail,Refs(i));\r
\r
\r
Ref :=: Refs(1);\r
SetOffset(Ref,5);\r
SetTop(Ref,12);\r
SetByteCount(ref,7);\r
Refs(1) :=: Ref; \r
\r
\r
Resetevent(refs(9));\r
\r
for i := 1 to 10 do\r
BEGIN\r
setu1(refs(i),(i - 1) * 4 + 1);\r
setu2(refs(i),(i - 1) * 4 + 2);\r
setu3(refs(i),(i - 1) * 4 + 3);\r
setu4(refs(i),(i - 1) * 4 + 4);\r
END;\r
\r
for i := 1 to i do \r
begin \r
for j := 0 to 1000 do \r
lockbuf refs(i) to yy do\r
begin\r
yy(j) := #h01;;\r
if j = 99 then exitloop;\r
end;\r
end;\r
\r
lock refs(1) to tt do for i := 5 to 11 do tt(i) := byt(i);\r
\r
Sum := 0;\r
lockbuf refs(1) to t do for i := 4 to 12 do\r
BEGIN\r
printinteger(zoneVar,int(t(i)));\r
(* 1,5,6,7,8,9,10,11,1 *)\r
Sum := Sum + int(t(i));\r
END;\r
IF Sum <> (1 + 5 + 6 + 7 + 8 + 9 + 10 + 11 + 1) THEN GOTO Error;\r
\r
$code \r
lockbuf refs(1) to tt do lock refs(1) to ttt do\r
BEGIN\r
PrintInteger(ZoneVar,tt!bufsize); (* 100 *)\r
Res1 := tt!BufSize;\r
PrintInteger(ZoneVar,bufsize(Refs(1))); (* 100 *)\r
Res2 := Bufsize(Refs(1));\r
PrintInteger(ZoneVar,offset(refs(1))); (* 5 *)\r
Res3 := offset(Refs(1));\r
PrintInteger(ZoneVar,ttt!offset); (* 5 *)\r
Res4 := ttt!offset;\r
PrintInteger(ZoneVar,ttt!top); (* 12 *)\r
Res5 := ttt!top;\r
PrintInteger(ZoneVar,top(Refs(1))); (* 12 *)\r
Res6 := top(Refs(1));\r
PrintInteger(ZoneVar,ByteCount(Refs(1))); (* 7 *)\r
Res7 := ByteCount(Refs(1));\r
end;\r
\r
IF ( Res1 <> 100) OR (Res2 <> 100) OR (Res3 <> 5) OR (Res4 <> 5) OR\r
( Res5 <> 12) OR (Res6 <> 12) OR (Res7 <> 7) THEN GOTO Error;\r
\r
\r
bool := hometest(po,Refs(10));\r
PrintBoolean(ZoneVar,Bool); (* true *)\r
IF Not Bool THEN GOTO Error;\r
\r
bool := hometest(po1,Refs(10));\r
PrintBoolean(ZoneVar,Bool); (* false *)\r
IF Bool THEN GOTO Error;\r
\r
PrintBoolean(ZoneVar,Not_Event = eventKind(refs(9))); (* true *)\r
\r
IF NOT ( Not_Event = eventKind(Refs(9))) THEN GOTO Error;\r
\r
Sum := 0;\r
for i := 1 To 10 do\r
BEGIN\r
printInteger(ZoneVar, u1(refs(i)));\r
printInteger(ZoneVar, u2(refs(i)));\r
printInteger(ZoneVar, u3(refs(i)));\r
printInteger(ZoneVar, u4(refs(i))); (* 1,2...40 *)\r
Sum := u1(Refs(i)) + u2(Refs(i)) + u3(Refs(i)) + u4(Refs(i)) + sum;\r
END;\r
IF Sum <> ( 41 * 20) THEN GOTO Error;\r
\r
\r
no := bufsize(refs(4)); \r
PrintInteger(ZoneVar, No); (* 100 *)\r
IF No <> 100 THEN GOTO Error;\r
\r
\r
For i := 1 to 8 do putbuf(refs(i));\r
\r
no := releasepool(po,10);\r
PrintInteger(zoneVar,No); (* 8 *)\r
IF No <> 8 THEN Goto Error;\r
for i := 9 to 10 do putbuf(refs(i));\r
\r
\r
no := releasepool(po,10);\r
PrintInteger(zoneVar,No); (* 2 *)\r
IF No <> 2 THEN GOTO Error;\r
\r
no := releasepool(po,5);\r
PrintInteger(zoneVar,No); (* 0 *)\r
IF No <> 0 THEN GOTO Error;\r
\r
region OK DO OK := true;\r
Error :\r
Region Fin DO Fin := true;\r
\r
\r
\r
end;\r
\r
\r
PROCEDURE TEST7FAM(VAR OK : Boolean; VAR z : Zone); EXTERNAL;\r
\r
\r
PROCEDURE TEST7L(VAR OK : BOOLEAN; VAR z : Zone); EXTERNAL;\r
\r
\r
\r
begin (* Main program *)\r
\r
\r
\r
\r
\r
\r
\r
(***************************** TEST VERSION 7 *************************)\r
TestVerOK := false;\r
TestVersion7;\r
\r
IF testverOk = false THEN GOTO EXITError;\r
\r
\r
region test7jok do test7jok := false;\r
region test7jend do test7jend := false;\r
createok := Create("test7j", Test7j(test7jend,test7jok),Process7j,0,130);\r
PrintInteger(ZoneVar,ord(CreateOK));\r
IF CreateOK <> Create_OK THEN GOTO EXitError;\r
\r
TestVerOK := false;\r
WHILE Not TestVerOK do \r
begin\r
REGION test7jEnd do TestVerOK := test7jEnd;\r
delay(1);\r
END;\r
(* test7j finish *)\r
REGION test7jOK do TestVerOK := test7jOK ;\r
IF TestVerOK = false THEN GOTO ExitError;\r
remove(process7j);\r
\r
TestVerOK := false;\r
Test7fam(TestVerOK,ZoneVar);\r
\r
IF testverOk = false THEN GOTO EXITError;\r
\r
\r
\r
TestVerOK := false;\r
Test7L(TestVerOK,ZoneVar);\r
\r
IF testverOk = false THEN GOTO EXITError;\r
\r
\r
\r
\r
Goto EndTest;\r
\r
ExitError:\r
region test7ok do test7ok := false;\r
region finish do finish := true;\r
(* TestNotOK *)\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
WriteChar(ZoneVar, ' '); \r
WriteChar(ZoneVar, '*'); \r
WriteChar(ZoneVar, '7'); \r
WriteChar(ZoneVar, '*'); \r
WriteChar(ZoneVar, '*'); \r
WriteChar(ZoneVar, '*'); \r
\r
\r
\r
EXIT;\r
\r
\r
EndTest:\r
(* Test OK *)\r
region test7ok do test7ok := true;\r
region finish do finish := true;\r
WriteChar(ZoneVar, ' '); \r
WriteChar(ZoneVar, 'O'); \r
WriteChar(ZoneVar, 'K'); \r
WriteChar(ZoneVar, ' '); \r
WriteChar(ZoneVar, '7'); \r
WriteChar(ZoneVar, '*'); \r
WriteChar(ZoneVar, '*'); \r
WriteChar(ZoneVar, '*'); \r
WriteChar(ZoneVar, '*'); \r
end.\r
\r
\r
\r
\r
\r
\r
\r
\r
\r
\r