|
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: 85888 (0x14f80)
Types: TextFile
Names: »SYSTEST.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\SYSTEST.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\SYSTEST.RTP«
└─⟦783187a02⟧ Bits:30010525 DVBS1.SW2114.src.2.6-3 RTP compiler source SW2104+SW2114 Disk#3 30/1-92 HHA
└─⟦this⟧ »OLDRTP\SYSTEST.RTP«
└─⟦ca921ce75⟧ Bits:30010528 DVBS1.SW2114.src.2.6-6 RTP Compiler Source SW2104+SW2114 Disk 3 92.02.03 HEJ HHA
└─⟦this⟧ »OLDRTP\SYSTEST.RTP«
(* ******RTP compiler test ****************)\r
\r
systestenv;\r
const ni=9;\r
procedure writename(var z: zone; inspect n: string); external;\r
.\r
\r
\r
\r
program systest;\r
\r
\r
\r
\r
\r
\r
TYPE\r
SubTypeDef = 1..4;\r
\r
\r
\r
\r
\r
var\r
ZoneVar : Zone;\r
a,c : integer;\r
b : boolean;\r
i : integer;\r
aword : word;\r
bword : word;\r
x,y :byte;\r
aw,bw,cw : word;\r
abyte,cbyte : byte;\r
w1,w2 : word;\r
byte1,byte2 : byte;\r
ab,bb : byte;\r
a1 : byte;\r
b1 : word;\r
achar,bchar,cchar : char;\r
d : integer;\r
int1,int2 : integer;\r
bool1,bool2 : boolean;\r
word1,word2 : word;\r
found : boolean;\r
dsub : 1..4;\r
dsubtype : subtypedef;\r
asub : 7..7;\r
bsub : -30..37;\r
a1sub : -1110..7;\r
a2sub : 0..7;\r
b1sub : -30..7;\r
aaa : 7..7;\r
ch : char;\r
chsubrange : 'a' .. 'c';\r
ainit,cinit : integer := 56;\r
binit : boolean := false;\r
xinit : byte := #HED;\r
yinit : word := #H003;\r
Test3Ok : boolean; (* is set to true if test of version 3 is ok *)\r
TestVerOK : boolean := true;\r
TestVer5Ok : Boolean;\r
OK : Boolean;\r
\r
shared\r
Test5OK,test4ok,test7ok : boolean := false;\r
TestVer5End,TestVer4End,testver7end : boolean := false;\r
\r
\r
Var \r
Process5,process7,Process4 : process;\r
createok :create_result;\r
Linkok : Link_Result;\r
UnLinkok : UnLink_Result;\r
(**********************************************************************)\r
\r
(****************** ROUTINES USED FOR TEST OF VERSION 3 ****************)\r
\r
(************************************************************************)\r
\r
\r
(**************************** TEST3BA *********************************)\r
(* procedures with VALUE param *)\r
PROCEDURE Test3BA;\r
var\r
a,b,c : integer; \r
\r
procedure p1( c : integer );\r
var i : integer := 13;\r
begin\r
a := c + 10;\r
c := c + i;\r
b := c - 20;\r
\r
end; \r
begin\r
WriteName(ZoneVar,"Test3BA");\r
Test3Ok := false;\r
c := 0;\r
a:= 11;\r
b := 5;\r
\r
p1(c);\r
PrintInteger(ZoneVar, c); (* 0 *)\r
IF c <> 0 THEN Exit;\r
PrintInteger(ZoneVar, b); (* -7 *)\r
IF b <> - 7 THEN Exit;\r
PrintInteger(ZoneVar, a); (* 10 *)\r
IF a <> 10 THEN Exit;\r
\r
Test3Ok := true;\r
end;\r
\r
\r
\r
\r
\r
\r
\r
(*********************** TEST3BB *************************************)\r
(* procedures with VAR - param *)\r
Procedure Test3BB;\r
var\r
b,c : integer;\r
procedure p1( var c : integer );\r
var i : integer;\r
begin\r
if c > 10 then c:= b - c - 1;\r
end;\r
begin\r
WriteName(ZoneVar,"Test3BB");\r
Test3Ok := false;\r
c := 0;\r
for a:= 1 to 20 do\r
begin\r
b:= a;\r
p1(b);\r
c:= c + b;\r
end;\r
PrintInteger(ZoneVar, c); (* 45 *)\r
IF c = 45 THEN Test3Ok := true;\r
end;\r
\r
\r
\r
\r
\r
(**************************** TEST3BC *****************************)\r
(* procedures with INSPECT param *)\r
Procedure test3BC;\r
var\r
a,b,c : integer; \r
\r
procedure p1(inspect c : integer );\r
var i : integer := 13;\r
begin\r
a := c + 10;\r
i := c + i;\r
b := i - 20;\r
\r
end; \r
begin\r
WriteName(ZoneVar,"Test3BC");\r
Test3Ok := false;\r
c := 0;\r
a:= 11;\r
b := 5;\r
\r
p1(c);\r
PrintInteger(ZoneVar, c); (* 0 *)\r
IF c <> 0 THEN Exit;\r
PrintInteger(ZoneVar, b); (* -7 *)\r
IF b <> - 7 THEN Exit;\r
PrintInteger(ZoneVar, a); (* 10 *)\r
IF a <> 10 THEN Exit;\r
\r
Test3Ok := True;\r
end;\r
\r
\r
\r
\r
\r
(**************************** TEST3BD *******************************)\r
(* procedures with more than one param *)\r
PROCEDURE test3BD;\r
var\r
Res : integer; \r
\r
procedure ProcFacInt( x : integer; Var R : integer );\r
begin\r
IF x = 0 THEN R := 1\r
ELSE\r
BEGIN\r
ProcFacInt(x - 1, R);\r
R := R * x;\r
END;\r
end; \r
\r
begin\r
WriteName(ZoneVar,"Test3BD");\r
TEST3OK := false;\r
\r
ProcFacInt(3,Res);\r
PrintInteger(ZoneVar, Res); (* 6 *)\r
IF Res <> 6 THEN Exit;\r
ProcFacInt(5,Res);\r
PrintInteger(ZoneVar, Res); (* 120 *)\r
IF Res =120 THEN Test3Ok := true;\r
end;\r
\r
\r
\r
\r
\r
\r
(******************************* TEST3BE *****************************) \r
(* procedures with more than one param *)\r
PROCEDURE test3BE;\r
var\r
I1,I2,ResInt : integer; \r
W4,W5,ResWord : Word;\r
B1,B2,B3,ResByte : Byte;\r
B4,B5,B6,ResBoolean : Boolean;\r
\r
procedure Procexp( Inspect x : integer; Var y : integer; z : integer;\r
Inspect w1 : Word; VAR w2 : Word; w3 : Word;\r
Inspect Byt1 : Byte; VAR Byt2 : Byte; Byt3 : Byte ;\r
Inspect B1 : Boolean; VAR B2 : Boolean; B3 : Boolean;\r
VAR RInt : integer; VAR RWord : Word; VAR RByte : Byte;\r
VAR RBool : Boolean );\r
begin\r
RInt := x + (y +( x - z * x));\r
RWord := w1 + (w2 + w3);\r
RByte := Byt1 + Byt2 + byt3;\r
RBool := B1 AND (B2 or B3 );\r
end; \r
\r
\r
begin\r
WriteName(ZoneVar,"Test3BE");\r
Test3Ok := false;\r
\r
I1 := 2;\r
I2 := 3;\r
W4 := #H003;\r
W5 := #H002;\r
B1 := #H01;\r
B2 := #H02;\r
B3 := #H03;\r
B4 := true;\r
B5 := false;\r
B6 := true;\r
ProcExp(I1,I2,I1 * 2,\r
W4,W5,#H001,\r
B1,B2,B3 + #H02,\r
B4,B5,B4 or B5 AND (b5 xor B6) and (B6 Or B5),\r
ResInt, ResWord, ResByte, ResBoolean);\r
PrintInteger(ZoneVar, ResInt); (* -1 *)\r
IF ResInt <> -1 THEN EXIT;\r
PrintWord(ZoneVar, ResWord); (* 6 *)\r
IF ResWord <> #H006 THEN Exit;\r
PrintByte(ZoneVar, ResByte); (* 8 *)\r
IF ResByte <> #H8 THEN EXIT;\r
PrintBoolean(ZoneVar, ResBoolean); (* True *)\r
IF ResBoolean = True THEN Test3Ok := true; \r
\r
\r
end;\r
\r
\r
\r
\r
\r
(******************************* TEST3BF *********************************)\r
(* procedures nested in more than one level *)\r
PROCEDURE test3BF;\r
var\r
Global : integer; \r
\r
procedure P1(VAR x : integer);\r
VAR\r
i : integer;\r
Procedure P2(Var y : integer);\r
BEGIN\r
y := i +( y + (x + Global));\r
END;\r
\r
BEGIN\r
i := Global + x + 4;\r
P2(i);\r
x := i + 4;\r
END;\r
\r
\r
PROCEDURE P11(Var x : integer);\r
VAR\r
i : integer;\r
BEGIN\r
i := Global + 4;\r
P1(i);\r
x := i + 3;\r
END;\r
\r
BEGIN\r
WriteName(ZoneVar,"Test3BF");\r
Test3Ok := false;\r
Global := 4;\r
P11(Global);\r
PrintInteger(ZoneVar, Global); (* 51 *)\r
IF Global = 51 THEN Test3Ok := true;\r
END;\r
\r
\r
\r
\r
\r
(**************************** TEST3BH ****************************)\r
(* forward procedures *)\r
PROCEDURE TEST3BH;\r
var\r
b,c : integer;\r
procedure p1( a : integer );\r
begin\r
b := a + 1;\r
end;\r
\r
procedure p2;\r
forward;\r
\r
procedure p3;\r
begin\r
b := b + 1;\r
p2;\r
end;\r
\r
procedure p5;\r
begin\r
b := b + 1;\r
p3;\r
end;\r
\r
procedure p6;\r
begin\r
b := b + 1;\r
p5;\r
end;\r
\r
procedure p8( a : integer );\r
begin\r
b := a + 1;\r
p6;\r
end;\r
\r
procedure p2;\r
begin\r
b := b + 1;\r
p1(b);\r
end;\r
\r
procedure p9;\r
var a : integer;\r
procedure pp1;\r
begin\r
b := b + 1;\r
end;\r
\r
procedure pp2;\r
begin\r
b := b + 1;\r
pp1;\r
end;\r
\r
procedure pp3;\r
begin\r
b := b + 1;\r
pp2;\r
end;\r
\r
procedure pp4; forward;\r
\r
procedure pp5;\r
begin\r
b := b + 1;\r
pp4;\r
end;\r
procedure pp6;\r
begin\r
b := b + 1;\r
pp5;\r
end;\r
\r
procedure pp4;\r
begin\r
b := b + 1;\r
pp3;\r
end;\r
\r
begin\r
b := b + 1;\r
pp6;\r
p8( b );\r
end;\r
\r
begin\r
WriteName(ZoneVar,"Test3BH");\r
b := 0;\r
p9;\r
PrintInteger(ZoneVar, b); (* 13 *)\r
IF b <> 13 THEN Test3OK := False\r
ELSE Test3OK := true;\r
end ;\r
\r
\r
\r
\r
(*************************** TEST3CA ********************************)\r
(* Function *)\r
Procedure test3ca;\r
var\r
Res : integer;\r
\r
FUNCTION FacInt( x : integer) : integer;\r
begin\r
IF x = 0 THEN FacInt := 1\r
ELSE\r
FacInt := FacInt(x - 1) * x;\r
end; \r
begin\r
WriteName(ZoneVar,"Test3CA");\r
Test3Ok := false;\r
Res := FacInt(3);\r
PrintInteger(ZoneVar, Res); (* 6*)\r
IF Res <> 6 THEN EXIT;\r
Res := FacInt(5);\r
PrintInteger(ZoneVar, Res); (* 120 *)\r
IF Res <> 120 THEN EXIT;\r
\r
Test3Ok := true;\r
end;\r
\r
\r
\r
\r
(******************************** TEST3CB *************************)\r
(* Function nested in more than one level \r
Function with side effect *)\r
PROCEDURE test3CB;\r
var\r
x, y, No : integer;\r
Bool1,Bool2 : Boolean; \r
\r
FUNCTION P1( x : Boolean) : Boolean;\r
VAR\r
i : integer;\r
FUNCTION P2 : Boolean;\r
BEGIN\r
P2 := x;\r
no := no + 1;\r
END;\r
\r
BEGIN\r
Bool1 := not Bool1;\r
P1 := P2;\r
END;\r
\r
\r
FUNCTION P11( xx : integer) : integer;\r
VAR\r
i : integer;\r
BEGIN\r
x := x + 1;\r
P11 := xx;\r
END;\r
\r
BEGIN\r
WriteName(ZoneVar,"Test3CB");\r
\r
Test3OK := false;\r
\r
x := 3;\r
y := x + (P11(3) + x);\r
PrintInteger(ZoneVar, y); (* 10 *)\r
IF y <> 10 THEN Exit;\r
\r
\r
\r
Bool1 := not (Bool1 xor Bool1) ; \r
PrintBoolean(ZoneVar, Bool1); (* true *)\r
IF Bool1 <> true THEN EXIT;\r
\r
No := 0;\r
Bool2 := Bool1 AND (P1(True) Xor Bool1) AND\r
( Bool1 XOR P1(True));\r
PrintBoolean(ZoneVar, Bool2); (* true*)\r
IF Bool2 <> true THEN EXIT;\r
\r
PrintBoolean(ZoneVar, Bool1); (* true *)\r
IF Bool1 <> True THEN Exit;\r
\r
PrintInteger(ZoneVar, No); (* 2 *)\r
IF No <> 2 THEN EXIT;\r
\r
No := 0;\r
Bool2 := (Bool1 And P1(false)) And (P1(False) or Bool1);\r
PrintInteger(ZoneVar, No); (* 1 *)\r
IF No = 1 THEN Test3Ok := true;\r
END;\r
\r
\r
\r
\r
\r
\r
(***************************** TEST3CC *************************)\r
(* Function and boolean expression *)\r
PROCEDURE test3cc;\r
var\r
Res : integer;\r
Bool : boolean;\r
\r
FUNCTION FacInt( x : integer) : integer;\r
begin\r
IF x = 0 THEN FacInt := 1\r
ELSE\r
FacInt := FacInt(x - 1) * x;\r
end; \r
begin\r
WriteName(ZoneVar,"Test3CC");\r
\r
Test3Ok := false;\r
\r
Bool := false;\r
bool := bool xor ((FacInt(3) = 6) and ((FacInt(4) = 24) or Bool));\r
PrintBoolean(ZoneVar, Bool); (* true *)\r
IF Bool <> true THEN EXIT;\r
Bool := bool and ( bool and (FacInt(1 + FacInt(FacInt(\r
FacInt(FacInt(0) + 1)))) = 6));\r
PrintBoolean(ZoneVar, Bool); (* true *)\r
IF Bool = True THEN Test3Ok := true;\r
end;\r
\r
\r
\r
\r
\r
\r
(****************************** TEST3CD ******************************)\r
(* function with more than one VALUE param *)\r
PROCEDURE test3cd;\r
var\r
a,b,c : integer; \r
\r
function addint( c : integer;d,e : integer; f, g : integer ) : integer;\r
begin\r
addint := c + d + e + f + g;\r
\r
end; \r
\r
function addintsubr( c : integer;d,e : 1..50; f, g : integer ) : 1.. 100;\r
begin\r
addintsubr := c + d + e + f + g;\r
\r
end; \r
begin\r
WriteName(ZoneVar,"Test3CD");\r
c := 0;\r
a:= 11;\r
b := 5;\r
\r
Test3Ok := false;\r
\r
a := addint(c,a,3,b,6);\r
PrintInteger(ZoneVar, a); (* 25 *)\r
IF a <> 25 THEN EXIT;\r
\r
a := addintsubr(c,30,b,3,6);\r
PrintInteger(ZoneVar, a); (* 44 *)\r
IF a = 44 THEN Test3OK := true;\r
\r
\r
end;\r
\r
\r
\r
\r
\r
\r
\r
(******************************* TEST3D ****************************) \r
PROCEDURE test3d;\r
(** Procedures and functions - mixed \r
and nested in more then one level **)\r
var\r
a: char := 'a';\r
z: char := 'z';\r
k: char := 'k';\r
charno: integer;\r
\r
procedure p(chp: char; var count: integer);\r
(* gives the no in alphabet of 'chp' if 'chp' is\r
in alphabet - otherwise -1 **)\r
var\r
\r
help: integer := 1;\r
\r
function char_eq(ch1,ch2: char): boolean;\r
begin\r
char_eq := ch1 = ch2;\r
end; (* char-eq *)\r
\r
begin (* p *)\r
count := -1;\r
for step := 'a' to 'z' do\r
if char_eq(chp,step) then\r
count := help\r
else help := help + 1;\r
end; (* p *)\r
\r
begin (** t3d **)\r
WriteName(ZoneVar,"Test3D");\r
Test3OK := false;\r
\r
p(a,charno);\r
PrintInteger(ZoneVar, charno); (* 1 *)\r
IF CharNo <> 1 THEN EXIT;\r
p(k,charno);\r
PrintInteger(ZoneVar, charno); (* 11 *)\r
IF CharNo <> 11 THEN EXIT;\r
p('f',charno);\r
PrintInteger(ZoneVar, charno); (* 6 *)\r
IF CharNo <> 6 THEN EXIT;\r
p(' ',charno);\r
PrintInteger(ZoneVar, charno); (* -1 *)\r
IF CharNo = -1 THEN Test3OK := true;\r
end; (* t3d *)\r
\r
\r
\r
\r
\r
(******************************** TEST3F *************************)\r
\r
\r
procedure p11(var b : boolean); external;\r
\r
Function mult(i : integer) : integer;\r
external;\r
\r
\r
\r
(** routines on level 0 *)\r
(* TEST3BA extended **)\r
PROCEDURE TEST3F; \r
\r
var\r
a,b,c : integer; \r
bb : boolean;\r
\r
procedure p1( c : integer );\r
var i : integer := 13;\r
begin\r
a := c + 10;\r
c := c + i;\r
b := c - 20;\r
\r
end; \r
\r
begin\r
WriteName(ZoneVar,"Test3F");\r
Test3OK := False;\r
\r
c := 0;\r
a:= 11;\r
b := 5;\r
\r
p1(c);\r
PrintInteger(ZoneVar, c); (* 0 *)\r
IF c <> 0 THEN EXIT;\r
PrintInteger(ZoneVar, b); (* -7 *)\r
IF b <> -7 THEN EXIT;\r
PrintInteger(ZoneVar, a); (* 10 *)\r
IF a <> 10 THEN EXIT;\r
\r
a := mult(a);\r
PrintInteger(ZoneVar, a); (* 100*)\r
IF a <> 100 THEN EXIT;\r
p11(bb);\r
PrintBoolean(ZoneVar, bb); (* true *)\r
IF BB = true THEN TEST3OK := True;\r
end;\r
\r
(************************** TEST3FA ************************)\r
(** recursive call of routines on level 0 *)\r
\r
\r
Function multbyadd(i : integer; j : integer) : integer;\r
external;\r
\r
\r
PROCEDURE Test3FA;\r
var\r
a,b : integer; \r
\r
\r
begin\r
WriteName(ZoneVar,"Test3FA");\r
a:= 11;\r
b := 5;\r
\r
a := multbyadd(a,b);\r
PrintInteger(ZoneVar, a); (* 55 *)\r
IF a = 55 THEN Test3Ok := true\r
ELSE Test3Ok := false;\r
\r
end;\r
\r
\r
\r
(* Openroutines with simpel types as parameter *)\r
PROCEDURE Test3GA;\r
type scalar = (a0, a1,a2,a3,a4,a5);\r
subr = 1..45;\r
\r
var\r
i, v_int: integer;\r
v_byte: byte;\r
v_wrd: word;\r
v_scalar : scalar;\r
v_subr : subr;\r
v_boolean : boolean;\r
v_char : char;\r
v_charSubr : 'a'..'f';\r
\r
\r
begin\r
WriteName(ZoneVar,"Test3GA");\r
Test3OK := false; \r
(****** ABS *****)\r
\r
v_int := -302;\r
i := abs(v_int);\r
PrintInteger(ZoneVar,i); (* 302 *)\r
IF i <> 302 THEN EXIT;\r
v_int := Abs(i);\r
PrintInteger(ZoneVar,v_int); (* 302 *)\r
IF v_Int <> 302 THEN EXIT;\r
\r
v_Subr := 10;\r
v_subr := abs(v_SubR);\r
PrintInteger(ZoneVar,v_subr); (* 10 *)\r
IF v_Subr <> 10 THEN EXIT; \r
i := abs( - 5);\r
PrintInteger(ZoneVar,i); (* 5 *)\r
IF i <> 5 THEN EXIT;\r
\r
(******** Byt ********)\r
v_int := 5 + 256;\r
v_Byte := Byt(v_int);\r
PrintByte(ZoneVar,v_Byte); (* 5 *)\r
IF v_Byte <> #H05 THEN EXIT;\r
v_subr := 3;\r
v_byte := byt(v_Subr);\r
PrintByte(ZoneVar,v_Byte); (* 3 *)\r
IF v_Byte <> #H03 THEN EXIT;\r
\r
v_byte := Byt(-1);\r
PrintByte(ZoneVar,v_Byte); (* FF *)\r
IF v_Byte <> #HFF THEN EXIT;\r
\r
\r
(******** CHR ********)\r
v_int := int(#H6d);\r
v_char := chr(v_int);\r
writechar(ZoneVar,v_char); (* 'm' *)\r
IF v_char <> 'm' THEN EXIT;\r
v_subr := int(#H21);\r
\r
v_char := chr(v_Subr);\r
writechar(ZoneVar,v_char); (*'!'*)\r
IF v_char <> '!' THEN EXIT;\r
\r
v_Char := chr(98);\r
writechar(ZoneVar,v_Char); (* 'b' *)\r
IF v_char <> 'b' THEN EXIT;\r
\r
(******* DEC ********)\r
v_Byte := #H0F;\r
dec(v_byte);\r
PrintByte(ZoneVar,v_byte); (* 0E *)\r
IF v_Byte <> #HE THEN EXIT;\r
\r
v_wrd := #H00C;\r
dec(v_wrd);\r
PrintWord(ZoneVar,v_wrd); (* 0B *)\r
IF v_wrd <> #H00B THEN EXIT;\r
\r
\r
\r
\r
\r
\r
(******* INC ********)\r
v_Byte := #H0F;\r
INC(v_byte);\r
PrintByte(ZoneVar,v_byte); (* 10 *)\r
IF v_Byte <> #H10 THEN EXIT;\r
\r
v_wrd := #H00C;\r
INC(v_wrd);\r
PrintWord(ZoneVar,v_wrd); (* 0D *)\r
IF v_wrd <> #HD THEN EXIT;\r
\r
\r
(***** INT *****)\r
v_byte := #h10;\r
v_wrd := #H003;\r
\r
i := int(v_byte);\r
PrintInteger(ZoneVar,i); (* 16 *)\r
IF i <> 16 THEN EXIT;\r
\r
i := int(v_wrd);\r
PrintInteger(ZoneVar,i); (* 3 *)\r
IF i <> 3 THEN EXIT;\r
\r
\r
\r
i := int(#D10);\r
PrintInteger(ZoneVar,i); (* 10 *)\r
IF i <> 10 THEN EXIT;\r
\r
i := int(#H0003);\r
PrintInteger(ZoneVar,i); (* 3 *)\r
IF i <> 3 THEN EXIT;\r
\r
\r
\r
\r
\r
(********ORD ***********)\r
v_Int := -1;\r
v_Subr := 34;\r
v_Boolean := true;\r
v_scalar := a1;\r
v_Char := 'b';\r
v_CharSubr := 'a';\r
i := ord(v_Int);\r
PrintInteger(ZoneVar,i); (* -1 *)\r
IF i <> -1 THEN EXIT;\r
i := ord(v_Subr);\r
PrintInteger(ZoneVar,i); (* 34 *)\r
IF i <> 34 THEN EXIT;\r
i := ord(v_Boolean);\r
PrintInteger(ZoneVar,i); (* 1 *)\r
IF i <> 1 THEN EXIT;\r
i := ord(v_Scalar);\r
PrintInteger(ZoneVar,i); (* 1 *)\r
IF i <> 1 THEN EXIT;\r
i := ord(v_Char);\r
PrintInteger(ZoneVar,i); (* 98 *)\r
IF i <> 98 THEN EXIT;\r
i := ord(v_CharSubr);\r
PrintInteger(ZoneVar,i); (* 97 *)\r
IF i <> 97 THEN EXIT;\r
\r
\r
i := ord(-1);\r
PrintInteger(ZoneVar,i); (* -1 *)\r
IF i <> -1 THEN EXIT;\r
i := ord(true);\r
PrintInteger(ZoneVar,i); (* 1 *)\r
IF i <> 1 THEN EXIT;\r
i := ord(a1);\r
PrintInteger(ZoneVar,i); (* 1 *)\r
IF i <> 1 THEN EXIT;\r
i := ord('b');\r
PrintInteger(ZoneVar,i); (* 98 *)\r
IF i <> 98 THEN EXIT;\r
\r
\r
\r
\r
(******** pred ***********)\r
v_Int := -1;\r
v_Subr := 34;\r
v_Boolean := true;\r
v_scalar := a1;\r
v_Char := 'b';\r
v_CharSubr := 'c';\r
i := Pred(v_Int);\r
PrintInteger(ZoneVar,i); (* -2 *)\r
IF i <> -2 THEN EXIT;\r
i := Pred(v_Subr);\r
PrintInteger(ZoneVar,i); (* 33 *)\r
IF i <> 33 THEN EXIT;\r
v_Boolean := Pred(v_Boolean);\r
PrintBoolean(ZoneVar,v_Boolean); (* False *)\r
IF v_boolean <> false then EXIT;\r
i := ord(Pred(v_Scalar));\r
PrintInteger(ZoneVar,i); (* 0 *)\r
IF i <> 0 THEN EXIT;\r
v_Char := Pred(v_Char);\r
WriteChar(ZoneVar,v_Char); (* 'a' *)\r
IF v_char <> 'a' THEN EXIT;\r
v_char := Pred(v_CharSubr);\r
Writechar(ZoneVar,v_char); (* 'b' *)\r
IF v_char <> 'b' THEN EXIT;\r
\r
\r
\r
i := Pred(0);\r
PrintInteger(ZoneVar,i); (* -1 *)\r
IF i <> -1 THEN EXIT;\r
v_Boolean := Pred(true);\r
PrintBoolean(ZoneVar,v_Boolean); (* False *)\r
IF v_boolean THEN EXIT;\r
i := ord(Pred(a1));\r
PrintInteger(ZoneVar,i); (* 0 *)\r
IF i <> 0 THEN EXIT;\r
v_Char := Pred('b');\r
Writechar(ZoneVar,v_char); (* 'a' *)\r
IF v_char <> 'a' THEN EXIT;\r
\r
\r
(******** SUCC ***********)\r
v_Int := -1;\r
v_Subr := 34;\r
v_Boolean := false;\r
v_scalar := a1;\r
v_Char := 'b';\r
v_CharSubr := 'c';\r
i := SUCC(v_Int);\r
PrintInteger(ZoneVar,i); (* 0 *)\r
IF i <> 0 THEN EXIT;\r
i := SUCC(v_Subr);\r
PrintInteger(ZoneVar,i); (* 35 *)\r
IF i <> 35 THEN EXIT;\r
v_Boolean := SUCC(v_Boolean);\r
PrintBoolean(ZoneVar,v_Boolean); (* true *)\r
IF v_boolean <> true THEN EXIT;\r
i := ord(SUCC(v_Scalar));\r
PrintInteger(ZoneVar,i); (* 2 *)\r
IF i <> 2 THEN EXIT;\r
v_Char := SUCC(v_Char);\r
WriteChar(ZoneVar,v_Char); (* 'c' *)\r
IF v_char <> 'c' THEN EXIT;\r
v_char := SUCC(v_CharSubr);\r
WriteChar(ZoneVar,v_Char); (* 'd' *)\r
IF v_Char <> 'd' THEN EXIT;\r
\r
\r
\r
i := SUCC(-1);\r
PrintInteger(ZoneVar,i); (* 0 *)\r
IF i <> 0 THEN EXIT;\r
v_Boolean := SUCC(false);\r
PrintBoolean(ZoneVar,v_Boolean); (* true *)\r
IF v_Boolean <> true THEN EXIT;\r
i := ord(SUCC(a1));\r
PrintInteger(ZoneVar,i); (* 2 *)\r
IF i <> 2 THEN EXIT;\r
v_Char := SUCC('b');\r
WriteChar(ZoneVar,v_Char); (* 'c' *)\r
IF v_char <> 'c' THEN EXIT;\r
\r
(******* WRD *********) \r
v_int := 5 + 256;\r
v_Wrd := wrd(v_int);\r
PrintWord(ZoneVar,v_Wrd); (* 105 *)\r
IF v_Wrd <> #H105 THEN EXIT;\r
v_subr := 3;\r
v_Wrd := wrd(v_Subr);\r
PrintWord(ZoneVar,v_Wrd); (* 3 *)\r
IF v_Wrd <> #H003 THEN EXIT;\r
\r
\r
v_Wrd := Wrd(256);\r
PrintWord(ZoneVar,v_Wrd); (* 0100 *)\r
IF v_Wrd <> #H100 THEN EXIT;\r
Test3OK := true;\r
\r
end;\r
\r
\r
\r
\r
\r
\r
(************************************************************* *)\r
(*************** TEST VERSION 4 ********************************)\r
(************************************************************* *)\r
\r
\r
Program TestVer4(Shared fin,OK : boolean); EXTERNAL;\r
\r
\r
\r
\r
\r
\r
\r
(*******************************************************************)\r
(*******************************************************************)\r
(****************** TEST VERSION 5 *********************************)\r
(*******************************************************************)\r
(*******************************************************************)\r
\r
\r
\r
\r
Program TestVer5(Shared fin,OK : boolean); EXTERNAL;\r
\r
\r
(*******************************************************************)\r
(*******************************************************************)\r
(****************** TEST VERSION 6 *********************************)\r
(*******************************************************************)\r
(*******************************************************************)\r
\r
\r
PROCEDURE TestVersion6;\r
\r
\r
VAR \r
TEST6OK : Boolean;\r
\r
\r
\r
(********************** TEST6A *******************)\r
(* var declaration: dynamic subrange *)\r
PROCEDURE TEST6A;\r
var high : integer;\r
procedure p;\r
var\r
d : 1..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,"Test6A");\r
high := 4;\r
p;\r
end;\r
\r
\r
(************************* TEST6AA **********************)\r
(* dynamic subrange type declare *)\r
PROCEDURE test6aa;\r
var high, low : integer;\r
procedure p;\r
type\r
t = low .. high;\r
var\r
d : t;\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,"Test6AA");\r
high := 1;\r
low := - 1;\r
p;\r
end;\r
\r
\r
\r
(**************************** TEST6AB ************************)\r
(* simple dynamic subrange expressions *)\r
PROCEDURE test6ab;\r
\r
var high , low : integer;\r
\r
\r
procedure P;\r
var\r
a,c : -1110 + low ..high := 7;\r
b : -30 + low..37 := - 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,"Test6AB");\r
high := 7;\r
low := 0;\r
p;\r
end;\r
\r
\r
(*************************** TEST6AC *********************)\r
(* simple dynamic Subrange expressions *)\r
PROCEDURE test6ac;\r
VAR\r
limit : integer := 7;\r
a : limit..limit;\r
b : integer;\r
begin\r
WriteName(ZoneVar,"Test6AC");\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
(************************** TEST6AD ************************)\r
(* simple integer and char Subrange expressions *)\r
PROCEDURE test6ad;\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
var\r
a : limit..abs(7);\r
ch : char;\r
chsubrange : ch1 .. ch2;\r
subscalar : a1 ..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,"Test6AD");\r
limit := 7;\r
ch1 := 'a';\r
ch2 := 'c';\r
varscalar := a2;\r
p;\r
end;\r
\r
\r
\r
(********************* TEST6B **********************)\r
(* for step *)\r
PROCEDURE test6b;\r
const\r
ni = 9;\r
var\r
d :integer;\r
begin\r
WriteName(ZoneVar,"Test6B");\r
d := 0;\r
for i := d to 10 do\r
d := d+1;\r
PrintInteger(ZoneVar, d); (* 11 *)\r
IF d <> 11 THEN TEST6OK := false\r
ELSE TEST6OK := true;\r
end;\r
\r
\r
(*************************** TEST6BA *********************)\r
(* for and exitloop and continueloop and exit *)\r
PROCEDURE test6ba;\r
const\r
ni = 9;\r
\r
var\r
a,b,c : integer;\r
step : integer; \r
step1 : 1..5;\r
\r
begin\r
WriteName(ZoneVar,"Test6BA");\r
step := -23;\r
step1 := 5;\r
a:= 0; b:= 100;c := 1000;\r
for i := a-1 to 3 * b DO (* -1 to 300 *) \r
begin\r
a:= a+1;\r
if a = b then\r
For i := 1 downto step do\r
begin\r
repeat\r
b := b - 1;\r
for jj := 1 to (- 1) + step - step do exit;\r
for i := step1 downto 1 do c := c + 1;\r
until true;\r
end;\r
\r
if a=1 then Continueloop;\r
if b = a then exit;\r
\r
end;\r
PrintInteger(ZoneVar, a); (* 302 *)\r
PrintInteger(ZoneVar, b) ; (* 75 *)\r
PrintInteger(ZoneVar, c); (* 1125 *)\r
IF (A <> 302) or (b <> 75) OR (c <> 1125) THEN TEST6OK := false\r
ELSE Test6OK := true;\r
\r
end;\r
\r
\r
(**************************** TEST6BB **************************)\r
(* for with scalartype and char *)\r
PROCEDURE test6bb;\r
const\r
ni = 9;\r
\r
type\r
scalar = (a0,a1,a2,a3,a4,a5,a6,a7,a8);\r
var\r
a : integer;\r
scalarvar : scalar;\r
ch :char;\r
\r
begin\r
WriteName(ZoneVar,"Test6BB");\r
Test6OK := false;\r
a := 0;\r
scalarvar := a1;\r
for i := scalarvar to a7 do a := a + 1;\r
PrintInteger(ZoneVar, a); (* 7 *)\r
IF a <> 7 THEN EXIT;\r
\r
ch := 'a';\r
a := 0;\r
For i := 'c' downto ch do\r
for j := ch to i do\r
for i := j to j do a := a + 1;\r
PrintInteger(ZoneVar, a); (* 6 *)\r
IF a = 6 THEN Test6OK := true;\r
\r
end;\r
\r
\r
\r
\r
(************************* TEST6C ******************************)\r
\r
PROCEDURE test6c;\r
(* familie type of subranges *)\r
\r
type t(n : integer) = n..11;\r
tt ( n : integer) = 1..(n + 22);\r
\r
\r
var\r
x : integer := 11;\r
xx : t(x);\r
yy : t(11) := 11;\r
zz : tt(x - yy);\r
\r
begin\r
WriteName(ZoneVar,"Test6C");\r
Test6OK := false;\r
xx := x;\r
yy := xx;\r
PrintInteger(ZoneVar, yy); (* 11 *)\r
IF yy <> 11 THEN EXIT;\r
PrintInteger(ZoneVar, xx); (* 11 *)\r
IF xx <> 11 THEN EXIT;\r
PrintInteger(ZoneVar, x); (* 11*)\r
IF x <> 11 THEN EXIT;\r
zz := yy;\r
zz := zz + xx;\r
PrintInteger(ZoneVar, zz); (* 22 *)\r
IF zz = 22 THEN Test6OK := true;\r
\r
END;\r
\r
\r
(*********************** TEST6CB ***************************)\r
\r
Procedure test6ca;\r
(* familietype and subranges *)\r
\r
var\r
bool : boolean := true;\r
bool1 : boolean := true;\r
bool2 : boolean := false;\r
procedure proclevel1;\r
type t(n,m : integer; s : boolean; ss : integer) = n + m .. ss;\r
tt ( n : integer) = t(n,3,bool,4);\r
ttt = tt(1);\r
\r
procedure proclevel2;\r
var\r
xx : t(1,3,bool1,4);\r
yy : t(1,3,bool,4);\r
y : tt(1);\r
z : ttt;\r
res,res1 : t(0,32,bool,32);\r
i : integer := 32;\r
\r
Function Add(Var R : t; var x : t; xxx : t(1,2,bool,xx);\r
yy : t; var y : t(1,3,bool1,xx);\r
var y1 : tt; y2: tt;\r
var z : ttt; z1 : tt(1)) : t(i,0,bool1,32);\r
begin\r
r := x + ( ( xxx + yy) + ( ( y + y1) + ( ( y2 + z) + z1)));\r
Add := x + xxx + yy + y + y1 + y2 + z + z1; \r
end; \r
\r
BEGIN\r
WriteName(ZoneVar,"Test6CA");\r
Test6OK := false;\r
xx := 4;\r
yy := xx;\r
y := yy;\r
z := y;\r
Printinteger(ZoneVar,xx); (* 4 *)\r
IF xx <> 4 THEN EXIT;\r
PrintInteger(ZoneVar, z); (* 4 *)\r
IF z <> 4 THEN EXIT;\r
Res := add(Res1,xx,xx,yy,yy,y,y,z,z);\r
PrintInteger(ZoneVar, Res); (* 32 *)\r
IF Res <> 32 THEN EXIT;\r
PrintInteger(ZoneVar, Res1); (* 32 *)\r
IF Res1 <> 32 THEN EXIT;\r
Test6Ok := true;\r
end;\r
BEGIN\r
ProcLevel2;\r
END;\r
\r
BEGIN\r
ProcLevel1;\r
END;\r
\r
\r
\r
\r
(****************************** TEST6CB ************************)\r
PROCEDURE test6cb;\r
(* TypeSelect on familie *)\r
\r
Type\r
T(n : integer; Bool : boolean) = (n = 4)..Bool;\r
\r
var a : array(1..1) of T(4,True);\r
i : integer;\r
b : boolean;\r
PROCEDURE p(x : T);\r
BEGIN\r
i := x!n; \r
b := x!Bool;\r
END;\r
\r
BEGIN\r
WriteName(ZoneVar,"Test6CB");\r
Test6OK := false; \r
\r
FOR j := 1 TO 1 DO\r
BEGIN\r
a(j) := a(j)!bool;\r
PrintBoolean(ZoneVar,a(j)); (* true *)\r
IF a(j) = false THEN EXIT;\r
PrintInteger(ZoneVar,a(j)!n); (* 4 *)\r
IF a(j)!n <> 4 THEN EXIT;\r
END;\r
\r
p(a(1));\r
PrintInteger(ZoneVar,i); (* 4 *);\r
IF i <> 4 THEN EXIT;\r
PrintBoolean(ZoneVar,b); (* true *)\r
IF b THEN Test6OK := true;\r
END;\r
\r
\r
\r
\r
\r
BEGIN\r
WriteName(ZoneVar,"TESTVERSION6");\r
\r
\r
TEST6a;\r
IF TEST6OK = false THEN GOTO ExitError;\r
\r
\r
\r
TEST6aa;\r
IF TEST6OK = false THEN GOTO ExitError;\r
\r
\r
\r
TEST6ab;\r
IF TEST6OK = false THEN GOTO ExitError;\r
\r
\r
\r
TEST6ac;\r
IF TEST6OK = false THEN GOTO ExitError;\r
\r
\r
\r
TEST6ad;\r
IF TEST6OK = false THEN GOTO ExitError;\r
\r
\r
\r
TEST6b;\r
IF TEST6OK = false THEN GOTO ExitError;\r
\r
\r
\r
TEST6ba;\r
IF TEST6OK = false THEN GOTO ExitError;\r
\r
\r
\r
TEST6bb;\r
IF TEST6OK = false THEN GOTO ExitError;\r
\r
\r
TEST6c;\r
IF TEST6OK = false THEN GOTO ExitError;\r
\r
\r
TEST6CA;\r
IF TEST6OK = false THEN GOTO ExitError;\r
\r
\r
TEST6cb;\r
IF TEST6OK = false THEN GOTO ExitError;\r
\r
\r
\r
exit;\r
EXITError:\r
testverok := false;\r
\r
\r
\r
End;\r
\r
\r
(* Procedure on file systest2 *)\r
PROCEDURE Test6Fam(VAR OK : Boolean;VAR z : zone); EXTERNAL;\r
\r
\r
\r
\r
(********************************************************************)\r
(********************* TEST VERSION 7 *******************************)\r
(********************************************************************)\r
\r
Program TestVer7(Shared fin,OK : boolean); EXTERNAL;\r
\r
\r
\r
\r
(********************************************************************)\r
(********************* TEST VERSION 8 *******************************)\r
(********************************************************************)\r
\r
\r
PROCEDURE TestVersion8;\r
\r
Var \r
Test8Ok : boolean;\r
\r
\r
\r
\r
(*********************** TEST8A *********************)\r
(* dynamic record with subtypes and dot-notation *)\r
PROCEDURE test8a;\r
const\r
ni = 9;\r
var high : integer:= 3;\r
high1 : integer := 11;\r
type\r
rec = 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;\r
begin\r
WriteName(ZoneVar,"Test8A");\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
(************************ TEST8C **********************)\r
PROCEDURE test8c;\r
(* array of records *)\r
var high : integer := 10;\r
type\r
ix_type = 0..high;\r
rectype = record\r
f1: ix_type;\r
f2: boolean;\r
end;\r
\r
\r
artype1 = array(ix_type) of rectype;\r
artype2 = array(11..high) of integer;\r
\r
dynrectype = record\r
dummy : artype2;\r
i : integer;\r
ar1 : artype1;\r
end;\r
\r
var\r
step: ix_type;\r
dynrec : dynrectype ;\r
\r
begin\r
WriteName(ZoneVar,"Test8C");\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
(************************** TEST8CA ***********************)\r
PROCEDURE test8ca;\r
(* array-type renamed to recordtype *)\r
Var \r
high : integer := 4;\r
type\r
rect = record\r
f1 : integer;\r
f2 : array(1..high) 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,"Test8CA");\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 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
(******************************** TEST8CC *******************)\r
\r
Procedure test8cc;\r
(* assignment and exchange on dynamic record types *)\r
var high : integer := 4;\r
type\r
ix_type = 0..high;\r
rectype = record\r
f2: boolean;\r
f3: array(ix_type) of 0..210;\r
f4 : integer;\r
f1: integer;\r
\r
\r
end;\r
\r
\r
\r
var\r
rec1,rec2: rectype;\r
\r
begin\r
WriteName(ZoneVar,"Test8CC");\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
(*********************** TEST8CD **********************)\r
PROCEDURE test8cd;\r
(* compare on dynamic array and record type *)\r
\r
var high : integer := 5;\r
type\r
indextype = 1.. high;\r
arr = array(indextype ) of indextype;\r
rec = record\r
i : integer;\r
i1 : arr;\r
i2 : boolean;\r
i3 : integer;\r
end;\r
\r
var\r
recorda,recordb : rec;\r
bool : boolean;\r
\r
\r
\r
procedure compare( var arec : rec; brec : rec);\r
\r
\r
\r
\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.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,"Test8CD");\r
TEST8OK := false; \r
\r
recorda.i := 5;\r
recorda.i2 := true;\r
recorda.i3 := -120;\r
$test(pass4=256)\r
$test(pass4=10)\r
for i:= 1 to high do recorda.i1(i) := i;\r
$test(pass4=512)\r
$test(pass4=0)\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
\r
\r
\r
\r
(**************************** TEST8IA ***********************)\r
PROCEDURE Test8ia;\r
(* familie type of records *)\r
\r
Type\r
SubType(x : 1..20) = -x..x;\r
T ( n : integer) = Array(1..n) Of record\r
j : subtype(n);\r
a : array(1..n) of integer;\r
i : integer;\r
end;\r
s (n,m : integer) = record\r
j : integer;\r
a : Array(n..m) of SubType(m);\r
i : subtype(m);\r
End;\r
\r
Var\r
x : integer :=5;\r
dyn1 : T(x);\r
\r
Begin\r
WriteName(ZoneVar,"Test8IA");\r
Test8OK := false;\r
For i := 1 TO x do \r
Begin\r
dyn1(i).i := i * 2;\r
dyn1(i).j := i ;\r
dyn1(i).a(i) := i;\r
end;\r
\r
For i := 1 To 5 Do PrintInteger(ZoneVar,dyn1(i).i); (* 2,4,6, .. 10 *)\r
For i := 1 To 5 Do PrintInteger(ZoneVar,dyn1(i).j); (* 1,2,3,4,5*)\r
For i := 1 To 5 Do PrintInteger(ZoneVar,dyn1(i).a(i)); (* 1,2,3,4,5*)\r
FOR i := 1 To 5 DO\r
BEGIN\r
IF dyn1(i).i <> (i * 2) THEN EXIT;\r
IF Dyn1(i).a(i) <> i THEN EXIT;\r
IF dyn1(i).j <> i THEN EXIT;\r
END;\r
\r
for iii := 1 to 5 do\r
With Dyn1(iii) As x : S(1,x) DO\r
begin \r
printinteger(ZoneVar,x.i); (* 2,4,6..10 *)\r
PrintInteger(ZoneVar,x.j); (*1,2.. 5*)\r
PrintInteger(ZoneVar,x.a(iii)); (* 1,2 .. 5 *)\r
IF x.i <> (iii * 2) THEN EXIT;\r
IF x.j <> iii THEN EXIT;\r
IF x.a(iii) <> iii THEN EXIT;\r
End;\r
\r
TEST8OK := true;\r
\r
End;\r
\r
\r
(****************************** TEST8IB ****************************)\r
PROCEDURE Test8ib;\r
(* familie of record *)\r
(* famile decl in context *)\r
type\r
FamilieArray(n : integer) = record\r
a : array(1..n) of integer;\r
i : integer;\r
End;\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.a(i) := 0;\r
y.a(i) := 1;\r
z.a(i) := 2;\r
L := x;\r
x := y;\r
L :=: y;\r
z :=: y;\r
i := L.a(5);\r
i1 := x.a(5);\r
\r
TypeSel := L!n + x!n + y!n + z!n;\r
\r
End;\r
\r
Begin\r
WriteName(ZoneVar,"Test8IB");\r
Test8OK := false;\r
x.a(i) := 5;\r
x.i := 11;\r
y.a(i) := 5;\r
z.a(i) := 5;\r
PrintInteger(ZoneVar,z.a(5)); (* 5 *)\r
IF z.a(5) <> 5 THEN EXIT;\r
ProcTest7ib(x,y,z);\r
\r
PrintInteger(ZoneVar,x.a(5)); (* 5 *)\r
IF x.a(5) <> 5 THEN EXIT;\r
PrintInteger(ZoneVar,i); (* 1 *)\r
IF i <> 1 THEN EXIT;\r
PrintInteger(ZoneVar,i1); (* 1 *)\r
IF i1 <> 1 THEN EXIT;\r
PrintInteger(ZoneVar,y.a(5)); (* 2 *)\r
IF y.a(5) <> 2 THEN EXIT;\r
PrintInteger(ZoneVar,z.a(5)); (* 0 *)\r
IF z.a(5) <> 0 THEN EXIT;\r
PrintInteger(ZoneVar,z.i); (* 11 *)\r
IF z.i = 11 THEN Test8OK := true;\r
End;\r
\r
\r
\r
\r
\r
\r
\r
\r
BEGIN\r
WriteName(ZoneVar,"TESTVERSION8");\r
\r
Test8a;\r
IF Test8OK <> true THEN GOTO EXITerror;\r
\r
Test8c;\r
IF Test8OK <> true THEN GOTO EXITerror;\r
\r
Test8ca;\r
IF Test8OK <> true THEN GOTO EXITerror;\r
\r
Test8cc;\r
IF Test8OK <> true THEN GOTO EXITerror;\r
\r
Test8cd;\r
IF Test8OK <> true THEN GOTO EXITerror;\r
\r
Test8ia;\r
IF Test8OK <> true THEN GOTO EXITerror;\r
\r
Test8ib;\r
IF Test8OK <> true THEN GOTO EXITerror;\r
\r
\r
Exit;\r
\r
ExitError:\r
TestVerOK := false;\r
\r
END;\r
\r
\r
\r
Procedure Test8Fam(Var OK : Boolean; VAR Z : Zone); EXTERNAL;\r
\r
\r
\r
Procedure Test8JA(Var OK : Boolean; VAR Z : Zone); EXTERNAL;\r
\r
\r
\r
Procedure Test8H(Var OK : Boolean; VAR Z : Zone); EXTERNAL;\r
\r
\r
\r
Procedure Test10A(Var OK : Boolean; VAR Z : Zone); EXTERNAL;\r
\r
(* Test of the option segment *)\r
\r
\r
const teststringseg = "from segment";\r
\r
$segment(seg)\r
Procedure testseg; forward;\r
Procedure TestSeg1(i,j : integer); forward;\r
procedure testseg2(s : string); forward;\r
procedure TestSegment;\r
BEGIN\r
Testseg;\r
TestSeg1(3,9);\r
TestSeg2(teststringseg);\r
END;\r
$Segment(Seg1)\r
procedure TestSeg;\r
BEGIN\r
TestSeg1(1,100);\r
TestSeg2(teststringseg);\r
END;\r
Procedure TestSeg1(i,j : integer); \r
begin\r
Printinteger(ZoneVar,i + j); (* 101 12 *)\r
End; \r
\r
procedure testseg2(s : string);\r
VAR\r
ss : String(14);\r
BEGIN\r
ss := s;\r
ss(14) := 'm';\r
WriteString(ZoneVar,ss);\r
PrintInteger(ZoneVar,ss!Length); (* 14 *)\r
END;\r
\r
\r
$segment(seg2)\r
\r
\r
begin (* Main program *)\r
\r
-- InitZone(zoneVar);\r
\r
\r
\r
\r
\r
\r
\r
\r
(*********** TEST1 *****************)\r
\r
WriteName(ZoneVar,"Test1");\r
(* var declare and simpel expresion *)\r
a:= 2;\r
c:=( (a + 2*ni)*4 - a*8 ) div 2 - 12*( a -1 );\r
PrintInteger(ZoneVar, c ); (* 20 *)\r
IF c<> 20 THEN Goto ExitError;\r
\r
b:= c > a;\r
PrintBoolean(ZoneVar, b); (* true *)\r
IF b <> true THEN goto ExitError;\r
\r
(* *********** TEST1A ****************)\r
(* procedure without params, procedurecall *)\r
WriteName(ZoneVar,"Test1A");\r
PrintInteger(ZoneVar, 0);\r
\r
\r
\r
(************** TEST1B *****************)\r
(* extern procedure, procedurecall *)\r
WriteName(ZoneVar,"Test1B");\r
PrintInteger(ZoneVar, ni);\r
\r
\r
\r
(**************** TEST1C ***********************)\r
(* external procedure with one parameter, var declare *)\r
WriteName(ZoneVar,"Test1C");\r
c := 1;\r
a := c + 3;\r
PrintInteger(ZoneVar, a); (* 4 *)\r
IF a <> 4 THEN Goto ExitError;\r
\r
\r
\r
(******************************* TEST1G ****************************)\r
(* simple boolean expressions *)\r
\r
WriteName(ZoneVar,"Test1G");\r
Bool1:= true;\r
PrintBoolean(ZoneVar, Bool1); (* true *)\r
IF Bool1 <> True THEN GOTO ExitError;\r
\r
Bool2:= false;\r
PrintBoolean(ZoneVar, Bool2); (* false *)\r
IF Bool2 <> false THEN GOTO ExitError;\r
\r
Bool2:= not Bool1;\r
PrintBoolean(ZoneVar, Bool2); (* false *)\r
IF Bool2 <> false THEN GOTO ExitError;\r
\r
Bool2 := Bool1 and Bool2;\r
PrintBoolean(ZoneVar, Bool2); (* false *)\r
IF Bool2 <> false THEN GOTO ExitError;\r
\r
Bool1 := Bool2 or Bool1;\r
PrintBoolean(ZoneVar, Bool1); (* true *)\r
IF Bool1 <> true THEN GOTO ExitError;\r
\r
Bool1 := Bool1 Xor Bool2;\r
PrintBoolean(ZoneVar, Bool1); (* true *)\r
IF Bool1 <> true THEN GOTO ExitError;\r
\r
PrintBoolean(ZoneVar, not (Bool2 or Bool1)); (* false *)\r
PrintBoolean(ZoneVar, not (Bool1 and Bool2)); (* true *)\r
PrintBoolean(ZoneVar, not (Bool2 xor Bool1)); (* false *)\r
\r
\r
\r
\r
(***************************** TEST1GA **************************)\r
(* simple boolean expressions *)\r
\r
\r
\r
\r
\r
WriteName(ZoneVar,"Test1GA");\r
Bool1:= true;\r
PrintBoolean(ZoneVar, Bool1); (* true *)\r
IF Bool1 <> true THEN GOTO ExitError;\r
\r
Bool2:= false;\r
PrintBoolean(ZoneVar, Bool2); (* false *)\r
IF Bool2 <> false THEN GOTO ExitError;\r
\r
Bool2:= (Bool1 AND ( Bool2 or ( Bool1 xor ( not Bool2 and ( Bool1 or Bool2)\r
xor Bool1))));\r
PrintBoolean(ZoneVar, Bool2); (* true *)\r
IF Bool2 <> true THEN GOTO ExitError;\r
\r
Bool2 := not Bool1;\r
PrintBoolean(ZoneVar, Bool2); (* false *)\r
IF Bool2 <> false THEN GOTO ExitError;\r
\r
Bool2 := ( Bool1 xor Bool2) xor ((Bool1 and Bool2) or ((Bool1 xor Bool2)\r
and (Bool1 And (Bool2 or Bool1))));\r
PrintBoolean(ZoneVar, Bool2); (* false *)\r
IF Bool2 <> false THEN GOTO ExitError;\r
\r
\r
\r
\r
\r
\r
\r
\r
\r
\r
\r
(************************ TEST1GB *******************************)\r
(* simple boolean expressions *)\r
WriteName(ZoneVar,"Test1GB");\r
Bool1:= true;\r
PrintBoolean(ZoneVar, Bool1); (* true *)\r
IF Bool1 <> true THEN GOTO ExitError;\r
\r
Bool2:= false;\r
PrintBoolean(ZoneVar, Bool2); (* false *)\r
IF Bool2 <> false THEN GOTO ExitError;\r
\r
Bool1 := Bool1 and (Bool2 xor Bool1);\r
PrintBoolean(ZoneVar, Bool1); (* true *)\r
IF Bool1 <> true THEN GOTO ExitError;\r
\r
Bool1 := not ((Bool2 xor Bool1) and (Bool2 xor false));\r
PrintBoolean(ZoneVar, Bool1); (* true *)\r
IF Bool1 <> true THEN GOTO ExitError;\r
\r
int1 := 5;\r
int2 := -4;\r
Bool1 := (int1 < int2) or Bool1;\r
PrintBoolean(ZoneVar, Bool1); (* true *)\r
IF Bool1 <> true THEN GOTO ExitError;\r
\r
Bool1 := (int1 < int2) xor Bool1;\r
PrintBoolean(ZoneVar, Bool1); (* true *)\r
IF Bool1 <> true THEN GOTO ExitError;\r
\r
\r
\r
\r
\r
(* ******************** TEST1H **********************)\r
(* simple integer expressions *)\r
WriteName(ZoneVar,"Test1H");\r
a:= 7;\r
PrintInteger(ZoneVar, a); (* 7 *)\r
IF a <> 7 THEN GOTO ExitError;\r
d:= - 30;\r
PrintInteger(ZoneVar, d); (* -30 *)\r
IF d <> -30 THEN GOTO ExitError;\r
d:= - d;\r
PrintInteger(ZoneVar, d); (* 30 *)\r
IF d <> 30 THEN GOTO ExitError;\r
d := a + d;\r
PrintInteger(ZoneVar, d); (* 37 *)\r
IF d <> 37 THEN GOTO ExitError;\r
a := a - d;\r
PrintInteger(ZoneVar, a); (* -30 *)\r
IF a <> -30 THEN GOTO ExitError;\r
a := a * d;\r
PrintInteger(ZoneVar, a); (* -1110 *)\r
IF a <> -1110 THEN GOTO ExitError;\r
a := a div d;\r
PrintInteger(ZoneVar, a); (* -30 *)\r
IF a <> -30 THEN GOTO ExitError;\r
a := d mod a;\r
PrintInteger(ZoneVar, a); (* 7 *)\r
IF a <> 7 THEN GOTO ExitError;\r
PrintInteger(ZoneVar, - (d - a)); (* -30 *)\r
PrintInteger(ZoneVar, - (a div d)); (* 0 *)\r
PrintInteger(ZoneVar, - (d * a)); (* -259 *)\r
\r
\r
\r
\r
\r
\r
(****************** TEST1HA ******************)\r
(* simple integer expressions *)\r
\r
\r
WriteName(ZoneVar,"Test1HA");\r
a:= 7;\r
PrintInteger(ZoneVar, a); (* 7 *)\r
IF a <> 7 THEN GOTO ExitError;\r
d:= - 30;\r
PrintInteger(ZoneVar, d); (* -30 *)\r
IF d <> -30 THEN GOTO ExitError;\r
d:= - d + (( d - 2) + (( a div 4) * d) mod a +( 4 + ( ( a*d) DIV (d div a)) +\r
3) );\r
PrintInteger(ZoneVar, d); (* 55 *)\r
IF d <> 55 THEN GOTO ExitError;\r
\r
d := d * a MOD (- a) + 4;\r
PrintInteger(ZoneVar, d); (* 4 *)\r
IF d <> 4 THEN GOTO ExitError;\r
\r
d := (30079 div d) * d + (30079 mod d);\r
PrintInteger(ZoneVar, d); (* 30079 *)\r
IF d <> 30079 THEN GOTO ExitError;\r
\r
\r
\r
\r
\r
\r
(***********************TEST1HB ****************************)\r
(* simple integer expressions *)\r
\r
WriteName(ZoneVar,"Test1HB");\r
a:= 7;\r
PrintInteger(ZoneVar, a); (* 7 *)\r
IF a <> 7 THEN GOTO ExitError;\r
d:= - 30;\r
PrintInteger(ZoneVar, d); (* -30 *)\r
IF d <> -30 THEN GOTO ExitError;\r
\r
d := a + (( a DIV d) + (( a MOD d) DIV (( A + 10) + ((23 + a) * (( a MOD d) MOD\r
(( a - 300) * ((d + a) - ((d - 230) mod ( a + d) ))))))));\r
PrintInteger(ZoneVar, d); (* 7 *)\r
IF d <> 7 THEN GOTO ExitError;\r
\r
\r
\r
\r
\r
\r
\r
\r
(********************** TEST1I ***************************)\r
(* simple word expressions *)\r
\r
WriteName(ZoneVar,"Test1I");\r
aword:= #h007;\r
PrintWord(ZoneVar, aword); (* 7 *)\r
IF aWord <> #H007 THEN GOTO ExitError;\r
\r
bword:= #D030;\r
PrintWord(ZoneVar, bword); (* 1E 30 *)\r
IF bWord <> #H01E THEN GOTO ExitError;\r
\r
bword := aword + bword;\r
PrintWord(ZoneVar, bword); (* 25 37 *)\r
IF bWord <> #H025 THEN GOTO ExitError;\r
\r
aword := aword - bword;\r
PrintWord(ZoneVar, aword); (* FFE2 -30 *)\r
IF aWord <> #HFFE2 THEN GOTO ExitError;\r
\r
aword := aword * bword;\r
PrintWord(ZoneVar, aword); (* FBAA *)\r
IF aWord <> #HFBAA THEN GOTO ExitError;\r
\r
aword := aword div bword;\r
PrintWord(ZoneVar, aword); (* 6CD *)\r
IF aWord <> #H6CD THEN GOTO ExitError;\r
\r
aword := bword mod aword;\r
PrintWord(ZoneVar, aword); (* 25 37 *)\r
IF aWord <> #H025 THEN GOTO ExitError;\r
\r
PrintWord(ZoneVar, (bword - aword)); (* 0 *)\r
\r
PrintWord(ZoneVar, (aword div bword)); (* 1 *)\r
PrintWord(ZoneVar, (bword * aword)); (* 559 *)\r
\r
\r
aword := #h010E;\r
\r
bword:= not aword;\r
PrintWord(ZoneVar, bword); (* FEF1 -271 *)\r
IF bWord <> #HFEF1 THEN GOTO ExitError;\r
\r
bword := (aword and bword) + #h003;\r
PrintWord(ZoneVar, bword); (* 3 *)\r
IF bWord <> #H003 THEN GOTO ExitError;\r
\r
aword := bword or aword;\r
PrintWord(ZoneVar, aword); (* 10F 271 *)\r
IF aWord <> #H10F THEN GOTO ExitError;\r
\r
aword := aword Xor bword;\r
PrintWord(ZoneVar, aword); (* 10C 268 *)\r
IF aWord <> #H10C THEN GOTO ExitError;\r
\r
PrintWord(ZoneVar, not (bword or aword)); (* 10F 271 *)\r
PrintWord(ZoneVar, not (aword and bword)); (* 0 0 *)\r
PrintWord(ZoneVar, not (bword xor aword)); (* 10F 271 *)\r
\r
\r
i := 1;\r
\r
bword := bword shift 2; \r
PrintWord(ZoneVar, bword); (* C 12 *)\r
IF bWord <> #H00C THEN GOTO ExitError;\r
\r
bword := #hFFFF;\r
bword := bword shift 16;\r
PrintWord(ZoneVar, bword); (* 0*)\r
IF bWord <> #H000 THEN GOTO ExitError;\r
\r
aword := aword shift i; \r
PrintWord(ZoneVar, aword); (* 218 *)\r
IF aWord <> #H00218 THEN GOTO ExitError;\r
\r
\r
\r
\r
\r
bword:= (aword AND ( bword or ( aword xor ( not bword and \r
( aword or bword) xor aword))));\r
PrintWord(ZoneVar, bword); (* 218 *)\r
IF bWord <> #H218 THEN GOTO ExitError;\r
\r
bword := not aword;\r
PrintWord(ZoneVar, bword); (* FDE7*)\r
IF bWord <> #HFDE7 THEN GOTO ExitError;\r
\r
bword := ( aword xor bword) xor ((aword and bword) or ((aword xor bword)\r
and (aword and (bword or aword))));\r
PrintWord(ZoneVar, bword); (* FDE7 *)\r
IF bWord <> #HFDE7 THEN GOTO ExitError;\r
\r
\r
\r
bword:= bword + (( bword - #h002) + (( aword div #H004) * bword) mod aword +( #h004 +\r
( ( aword*bword) DIV (bword div aword)) +#H003) );\r
PrintWord(ZoneVar, bword); (* FDB6 *)\r
IF bWord <> #HFDB6 THEN GOTO ExitError;\r
\r
bword := bword * aword MOD ( aword) ;\r
PrintWord(ZoneVar, bword); (* 0B8 *)\r
IF bWord <> #H0B8 THEN GOTO ExitError;\r
\r
bword := (#Hedc7 div bword) * bword + (#Hedc7 mod bword);\r
PrintWord(ZoneVar, bword); (* EDC7 *)\r
IF bWord <> #HEDC7 THEN GOTO ExitError;\r
\r
bword := (aword div (#H200 + bword)) xor\r
(bword and (#Hedc7 * (bword+ #H003)));\r
PrintWord(ZoneVar, bword); (* C806 *)\r
IF bWord <> #HC806 THEN GOTO ExitError;\r
\r
\r
\r
\r
\r
(* ************************ TEST1IA **************************)\r
(* word and byte expressions *)\r
WriteName(ZoneVar,"Test1IA");\r
aw:= #H007;\r
\r
PrintWord(ZoneVar, aw); (* 7 *)\r
IF aw <> #H007 THEN GOTO ExitError;\r
\r
bw:= #H030;\r
PrintWord(ZoneVar, bw); (*30 *)\r
IF bw <> #H0030 THEN GOTO ExitError;\r
\r
bw := aw + (( aw DIV bw) + (( aw MOD bw) DIV (( aw + #HE10) + ((#H223 + aw)\r
* (( aw MOD bw) MOD (((- aw) AND bw) or (((- bw) xor (- aw)) and\r
(( aw - #H300) * ((bw + aw) - ((bw - #H230) mod ( aw + bw) ))))))))));\r
PrintWord(ZoneVar, bw);(*7*)\r
IF bw <> #H007 THEN GOTO ExitError;\r
\r
\r
x:= #H07;\r
PrintByte(ZoneVar, x); (* 7 *)\r
IF x <> #H07 THEN GOTO ExitError;\r
\r
y:= #H30;\r
PrintByte(ZoneVar, y);(*30*)\r
IF y <> #H30 THEN GOTO ExitError;\r
y := x + (( x DIV y) + (( x MOD y) DIV (( x + #HE1) + ((#H23 + x)\r
* (( x MOD y) MOD (((- x) AND y) or (((- y) xor (- x)) and\r
(( x - #H40) * ((y + x) - ((y - #H23) mod ( x + y) ))))))))));\r
PrintByte(ZoneVar, y);(*7*)\r
IF y <> #H07 THEN GOTO ExitError;\r
\r
\r
\r
\r
\r
\r
(********************* TEST1J ***********************) \r
(* compare integer *)\r
\r
\r
WriteName(ZoneVar,"Test1J");\r
a := 3;\r
c := - 3;\r
b := a < c;\r
PrintBoolean(ZoneVar, b); (* false *)\r
IF b <> false THEN GOTO ExitError;\r
\r
b := a <= c;\r
PrintBoolean(ZoneVar, b); (*false *)\r
IF b <> false THEN GOTO ExitError;\r
\r
b := a > c;\r
PrintBoolean(ZoneVar, b); (*true *)\r
IF b <> true THEN GOTO ExitError;\r
\r
b := a >= c;\r
PrintBoolean(ZoneVar, b); (* true *)\r
IF b <> true THEN GOTO ExitError;\r
\r
b := a = c;\r
PrintBoolean(ZoneVar, b); (* false *)\r
IF b <> false THEN GOTO ExitError;\r
\r
b := a <> c;\r
PrintBoolean(ZoneVar, b); (* true *)\r
IF b <> true THEN GOTO ExitError;\r
\r
\r
\r
\r
\r
\r
\r
\r
(************************ TEST1JA *****************************)\r
(* compare word *)\r
WriteName(ZoneVar,"Test1JA");\r
aw := #H003;\r
cw := #HFFFF;\r
b := aw < cw;\r
PrintBoolean(ZoneVar, b); (* true *)\r
IF b <> true THEN GOTO ExitError;\r
\r
b := aw <= cw;\r
PrintBoolean(ZoneVar, b); (*true *)\r
IF b <> true THEN GOTO ExitError;\r
\r
b := aw > cw;\r
PrintBoolean(ZoneVar, b); (*false *)\r
IF b <> false THEN GOTO ExitError;\r
\r
b := aw >= cw;\r
PrintBoolean(ZoneVar, b); (* false *)\r
IF b <> false THEN GOTO ExitError;\r
\r
b := aw = cw;\r
PrintBoolean(ZoneVar, b); (* false *)\r
IF b <> false THEN GOTO ExitError;\r
\r
b := aw <> cw;\r
PrintBoolean(ZoneVar, b); (* true *)\r
IF b <> true THEN GOTO ExitError;\r
\r
\r
\r
\r
\r
\r
\r
\r
(************************** TEST1JB **************************)\r
(* compare byte *)\r
\r
WriteName(ZoneVar,"Test1JB");\r
abyte := #H00;\r
cbyte := abyte;\r
b := abyte < cbyte;\r
PrintBoolean(ZoneVar, b); (* false *)\r
IF b <> false THEN GOTO ExitError;\r
\r
b := abyte <= cbyte;\r
PrintBoolean(ZoneVar, b); (* true *)\r
IF b <> true THEN GOTO ExitError;\r
\r
b := abyte > cbyte;\r
PrintBoolean(ZoneVar, b); (* false *)\r
IF b <> false THEN GOTO ExitError;\r
\r
b := abyte >= cbyte;\r
PrintBoolean(ZoneVar, b); (* true *)\r
IF b <> true THEN GOTO ExitError;\r
\r
b := abyte = cbyte;\r
PrintBoolean(ZoneVar, b); (* true *)\r
IF b <> true THEN GOTO ExitError;\r
\r
b := abyte <> cbyte;\r
PrintBoolean(ZoneVar, b); (* false *)\r
IF b <> false THEN GOTO ExitError;\r
\r
\r
\r
\r
(************************** TEST1JC *****************************)\r
(* compare *)\r
WriteName(ZoneVar,"Test1JC");\r
b := true;\r
a := 3;\r
c := - 3;\r
w1 := #HFE00;\r
w2 := w1;\r
byte1 := #HFF;\r
Byte2 := #H0;\r
b := ((a < c) >= ((W1 > w2) >= (( byte1 > byte2) = ((w1 <> #HFFEE) <=\r
((a > 3) <= ((#H0 >= byte1) <> ((a = 3) < b) ))))));\r
PrintBoolean(ZoneVar, b); (* 1 *) \r
IF b <> true THEN GOTO ExitError;\r
\r
\r
(*************************** TEST1JD *************************)\r
(* compare with const *)\r
WriteName(ZoneVar,"Test1JD");\r
i := 0;\r
a := 4;\r
aw := #H004;\r
IF (4 < a ) AND ( #H004 < aw) THEN i := i + 10;\r
a := 2;\r
aw := #H002;\r
IF (4 < a ) AND ( #H004 < aw) THEN i := i + 100;\r
a := 5;\r
aw := #H005;\r
IF (4 < a ) AND ( #H004 < aw) THEN i := i + 1000;\r
PRintInteger(ZoneVar,i); (* 1000 *)\r
IF i <> 1000 THEN EXIT;\r
\r
i := 0;\r
a := 4;\r
aw := #H004;\r
IF (4 <= a ) AND ( #H004 <= aw) THEN i := i + 10;\r
a := 2;\r
aw := #H002;\r
IF (4 <= a ) AND ( #H004 <= aw) THEN i := i + 100;\r
a := 5;\r
aw := #H005;\r
IF (4 <= a ) AND ( #H004 <= aw) THEN i := i + 1000;\r
PRintInteger(ZoneVar,i); (* 1010 *)\r
IF i <> 1010 THEN EXIT;\r
i := 0;\r
a := 4;\r
aw := #H004;\r
IF (4 > a ) AND ( #H004 > aw) THEN i := i + 10;\r
a := 2;\r
aw := #H002;\r
IF (4 > a ) AND ( #H004 > aw) THEN i := i + 100;\r
a := 5;\r
aw := #H005;\r
IF (4 > a ) AND ( #H004 > aw) THEN i := i + 1000;\r
PRintInteger(ZoneVar,i); (* 100 *)\r
IF i <> 100 THEN EXIT;\r
\r
i := 0;\r
a := 4;\r
aw := #H004;\r
IF (4 >= a ) AND ( #H004 >= aw) THEN i := i + 10;\r
a := 2;\r
aw := #H002;\r
IF (4 >= a ) AND ( #H004 >= aw) THEN i := i + 100;\r
a := 5;\r
aw := #H005;\r
IF (4 >= a ) AND ( #H004 >= aw) THEN i := i + 1000;\r
PRintInteger(ZoneVar,i); (* 110 *)\r
IF i <> 110 THEN EXIT;\r
\r
i := 0;\r
a := 4;\r
aw := #H004;\r
IF (4 = a ) AND ( #H004 = aw) THEN i := i + 10;\r
a := 2;\r
aw := #H002;\r
IF (4 = a ) AND ( #H004 = aw) THEN i := i + 100;\r
a := 5;\r
aw := #H005;\r
IF (4 = a ) AND ( #H004 = aw) THEN i := i + 1000;\r
PRintInteger(ZoneVar,i); (* 10 *)\r
IF i <> 10 THEN EXIT;\r
\r
i := 0;\r
a := 4;\r
aw := #H004;\r
IF (4 <> a ) AND ( #H004 <> aw) THEN i := i + 10;\r
a := 2;\r
aw := #H002;\r
IF (4 <> a ) AND ( #H004 <> aw) THEN i := i + 100;\r
a := 5;\r
aw := #H005;\r
IF (4 <> a ) AND ( #H004 <> aw) THEN i := i + 1000;\r
PRintInteger(ZoneVar,i); (* 1100 *)\r
IF i <> 1100 THEN EXIT;\r
\r
\r
\r
(************************* TEST1K **************************)\r
(* simple byte expressions *)\r
WriteName(ZoneVar,"Test1K");\r
ab:= #H07;\r
PrintByte(ZoneVar, ab); (* 7 *)\r
IF ab <> #H7 THEN GOTO ExitError;\r
bb:= #D30;\r
PrintByte(ZoneVar, bb); (* 1E *)\r
IF bb <> #H1E THEN GOTO ExitError;\r
bb := ab + bb;\r
PrintByte(ZoneVar, bb); (* 25 37 *)\r
IF bb <> #H25 THEN GOTO ExitError;\r
ab := ab - bb;\r
PrintByte(ZoneVar, ab); (* E2 *)\r
IF ab <> #HE2 THEN GOTO ExitError;\r
ab := ab * bb;\r
PrintByte(ZoneVar, ab); (* AA *)\r
IF ab <> #HAA THEN GOTO ExitError;\r
ab := ab div bb;\r
PrintByte(ZoneVar, ab); (* 4 *)\r
IF ab <> #H4 THEN GOTO ExitError;\r
ab := bb mod ab;\r
PrintByte(ZoneVar, ab); (* 1 *)\r
IF ab <> #H1 THEN GOTO ExitError;\r
PrintByte(ZoneVar, (bb - ab)); (* 24 *)\r
PrintByte(ZoneVar, (ab div bb)); (* 0 *)\r
PrintByte(ZoneVar, (bb * ab)); (* 25 *)\r
\r
\r
ab := #h0E;\r
\r
bb := not ab;\r
PrintByte(ZoneVar, bb); (* F1 *)\r
IF bb <> #HF1 THEN GOTO ExitError;\r
bb := (ab and bb) + #h03;\r
PrintByte(ZoneVar, bb); (* 3 *)\r
IF bb <> #H3 THEN GOTO ExitError;\r
ab := bb or ab;\r
PrintByte(ZoneVar, ab); (* 0F *)\r
IF ab <> #H0F THEN GOTO ExitError;\r
ab := ab Xor bb;\r
PrintByte(ZoneVar, ab); (* 0C *)\r
IF ab <> #H0C THEN GOTO ExitError;\r
PrintByte(ZoneVar, not (bb or ab)); (* F0 *)\r
PrintByte(ZoneVar, not (ab and bb)); (* FF*)\r
PrintByte(ZoneVar, not (bb xor ab)); (* F0 *)\r
\r
i := 1;\r
\r
bb := bb shift (- 2);\r
PrintByte(ZoneVar, bb); (* 0 *)\r
IF bb <> #H0 THEN GOTO ExitError;\r
bb := #hFF;\r
bb := bb shift 5;\r
PrintByte(ZoneVar, bb); (* E0 *)\r
IF bb <> #HE0 THEN GOTO ExitError;\r
bb := bb shift 8;\r
PrintByte(ZoneVar, bb); (* 0*)\r
IF bb <> #H0 THEN GOTO ExitError;\r
\r
ab := ab shift i;\r
PrintByte(ZoneVar, ab); (* 18 *)\r
IF ab <> #H18 THEN GOTO ExitError;\r
\r
\r
\r
\r
bb:= (ab AND ( bb or ( ab xor ( not bb and ( ab or bb) xor ab))));\r
PrintByte(ZoneVar, bb); (* 18 *)\r
IF bb <> #H18 THEN GOTO ExitError;\r
bb := not ab;\r
PrintByte(ZoneVar, bb); (* E7 *)\r
IF bb <> #HE7 THEN GOTO ExitError;\r
bb := ( ab xor bb) xor ((ab and bb) or ((ab xor bb) and (ab and (bb or ab))));\r
PrintByte(ZoneVar, bb); (* E7 *)\r
IF bb <> #HE7 THEN GOTO ExitError;\r
\r
\r
bb:= bb + (( bb - #h02) + (( ab div #H04) * bb) mod ab +( #h04 +\r
( ( ab*bb) DIV (bb div ab)) +#H03) );\r
PrintByte(ZoneVar, bb); (* EF *)\r
IF bb <> #HEF THEN GOTO ExitError;\r
bb := bb * ab MOD ( ab) ;\r
PrintByte(ZoneVar, bb); (* 8 *)\r
IF bb <> #H8 THEN GOTO ExitError;\r
bb := (#Hc7 div bb) * bb + (#Hc7 mod bb);\r
PrintByte(ZoneVar, bb); (* C7 *)\r
IF bb <> #HC7 THEN GOTO ExitError;\r
bb := (ab div (#H20 + bb)) xor (bb and (#He7 * (bb+ #H3)));\r
PrintByte(ZoneVar, bb); (* 46 *)\r
IF bb <> #H46 THEN GOTO ExitError;\r
\r
\r
\r
\r
\r
(************************* TEST1L ***************************)\r
(* simple char expressions *)\r
WriteName(ZoneVar,"Test1L");\r
achar:= 'b';\r
\r
cchar:= 'B';\r
b := achar < cchar;\r
PrintBoolean(ZoneVar, b); (* false *)\r
IF b <> false THEN GOTO ExitError;\r
\r
b := achar <= cchar;\r
PrintBoolean(ZoneVar, b); (*false *)\r
IF b <> false THEN GOTO ExitError;\r
\r
b := achar > cchar;\r
PrintBoolean(ZoneVar, b); (*true *)\r
IF b <> true THEN GOTO ExitError;\r
\r
b := achar >= cchar;\r
PrintBoolean(ZoneVar, b); (* true *)\r
IF b <> true THEN GOTO ExitError;\r
\r
b := achar = cchar;\r
PrintBoolean(ZoneVar, b); (* false *)\r
IF b <> false THEN GOTO ExitError;\r
\r
b := achar <> cchar;\r
PrintBoolean(ZoneVar, b); (* true *)\r
IF b <> true THEN GOTO ExitError;\r
\r
\r
\r
\r
(********************* TEST1M ************************) \r
(* simple byte and word expressions *)\r
WriteName(ZoneVar,"Test1M");\r
a1:= #H07;\r
\r
b1:= #D030;\r
PrintWord(ZoneVar, b1); (* 1E *)\r
IF b1 <> #H01E THEN GOTO ExitError;\r
\r
b1 := a1 + b1;\r
PrintWord(ZoneVar, b1); (* 25 *)\r
IF b1 <> #H025 THEN GOTO ExitError;\r
\r
b1 := a1 - b1;\r
PrintWord(ZoneVar, b1); (* FFE2 *)\r
IF b1 <> #HFFE2 THEN GOTO ExitError;\r
\r
b1 := a1 * b1;\r
PrintWord(ZoneVar, b1); (* FF2E *)\r
IF b1 <> #HFF2E THEN GOTO ExitError;\r
\r
b1 := a1 div b1;\r
PrintWord(ZoneVar, b1); (* 0 *)\r
IF b1 <> #H000 THEN GOTO ExitError;\r
\r
b1 := b1 mod a1;\r
PrintWord(ZoneVar, b1); (* 0 *)\r
IF b1 <> #H000 THEN GOTO ExitError;\r
\r
PrintWord(ZoneVar, (b1 - a1)); (* FFF9 *)\r
PrintWord(ZoneVar, (a1 div (b1 + #H0001))); (* 7 *)\r
PrintWord(ZoneVar, (b1 * a1)); (* 0 *)\r
\r
\r
a1 := #h0E;\r
\r
b1:= not ( b1 + a1);\r
PrintWord(ZoneVar, b1); (* FFF1 *)\r
IF b1 <> #HFFF1 THEN GOTO ExitError;\r
\r
b1 := (a1 and b1) + #h03;\r
PrintWord(ZoneVar, b1); (* 3 *)\r
IF b1 <> #H003 THEN GOTO ExitError;\r
\r
b1 := b1 or a1;\r
PrintWord(ZoneVar, b1); (* F *)\r
IF b1 <> #H00F THEN GOTO ExitError;\r
\r
b1 := a1 Xor b1;\r
PrintWord(ZoneVar, b1); (* 1 *)\r
IF b1 <> #H001 THEN GOTO ExitError;\r
\r
PrintWord(ZoneVar, not (b1 or a1)); (* FFF0 *)\r
PrintWord(ZoneVar, not (a1 and b1)); (* FFFF *)\r
PrintWord(ZoneVar, not (b1 xor a1)); (* FFF0 *)\r
\r
i := -2;\r
\r
b1 := #H00F;\r
b1 := b1 shift 2;\r
PrintWord(ZoneVar, b1); (* 3C *)\r
IF b1 <> #H03C THEN GOTO ExitError;\r
\r
b1 := #h0FF;\r
b1 := b1 shift 16;\r
PrintWord(ZoneVar, b1); (* 0*)\r
IF b1 <> #H000 THEN GOTO ExitError;\r
\r
b1 := #H000F;\r
b1 := b1 shift i;\r
PrintWord(ZoneVar, b1); (* 3 *)\r
IF b1 <> #H003 THEN GOTO ExitError;\r
\r
\r
\r
\r
\r
b1:= (a1 AND ( b1 or ( a1 xor ( not b1 and ( a1 or b1) xor a1))));\r
PrintWord(ZoneVar, b1); (* E *)\r
IF b1 <> #H00E THEN GOTO ExitError;\r
\r
b1 := not ( b1 + a1);\r
PrintWord(ZoneVar, b1); (* FFE3 *)\r
IF b1 <> #HFFE3 THEN GOTO ExitError;\r
\r
b1 := ( a1 xor b1) xor ((a1 and b1) or ((a1 xor b1) and (a1 and (b1 or a1))));\r
PrintWord(ZoneVar, b1); (* FFE3 *)\r
IF b1 <> #HFFE3 THEN GOTO ExitError;\r
\r
\r
\r
b1:= b1 + (( b1 - #h02) + (( a1 div #H04) * b1) mod a1 +( #h04 +\r
( ( a1*b1) DIV (b1 div a1)) +#H03) );\r
PrintWord(ZoneVar, b1); (* FFE5 *)\r
IF b1 <> #HFFE5 THEN GOTO ExitError;\r
\r
b1 := b1 * a1 MOD ( a1) ;\r
PrintWord(ZoneVar, b1); (* 2 *)\r
IF b1 <> #H002 THEN GOTO ExitError;\r
\r
b1 := (#Hc7 div b1) * b1 + (#Hc7 mod b1);\r
PrintWord(ZoneVar, b1); (* C7 *)\r
IF b1 <> #H00C7 THEN GOTO ExitError;\r
\r
b1 := (a1 div (#H20 + b1)) xor (b1 and (#He7 * (b1+ #H3)));\r
PrintWord(ZoneVar, b1); (* 46 *)\r
IF b1 <> #H046 THEN GOTO ExitError;\r
\r
\r
(**************************************************************)\r
\r
(** TEST OF VERSION 2 **************)\r
\r
(***************************************************************)\r
\r
\r
\r
\r
\r
\r
\r
(* *********************** TEST2 ********************************)\r
(* if then else *)\r
WriteName(ZoneVar,"Test2");\r
a:= 2;\r
c:= a + ni;\r
b:= c > a;\r
if b then c:= c-a else c:= 0;\r
PrintInteger(ZoneVar, c ); (* 9 *)\r
IF c <> 9 THEN GOTO ExitError;\r
\r
\r
\r
\r
\r
(**************************** TEST2D ****************************)\r
(* for step *)\r
WriteName(ZoneVar,"Test2D");\r
d := 0;\r
for ii := 1 to 10 do\r
d := d+1;\r
PrintInteger(ZoneVar, d); (* 10 *)\r
IF d <> 10 THEN GOTO ExitError;\r
\r
\r
\r
\r
(************************* TEST2DA *********************************)\r
(* for and exitloop and continueloop and exit *)\r
WriteName(ZoneVar,"Test2DA");\r
a:= 0; d:= 100;c := 1000;\r
for i := -1 to 300 DO\r
begin\r
a:= a+1;\r
if a = d then\r
For i := 1 downto -23 do\r
begin\r
repeat\r
d := d - 1;\r
for jj := 1 to - 1 do exit;\r
for i := 5 downto 1 do c := c + 1;\r
until true;\r
end;\r
\r
if a=1 then Continueloop;\r
if d = a then exit;\r
\r
end;\r
PrintInteger(ZoneVar, a); (* 302 *)\r
IF a <> 302 THEN Goto ExitError;\r
PrintInteger(ZoneVar, d) ; (* 75 *)\r
IF d <> 75 THEN GOTO ExitError;\r
PrintInteger(ZoneVar, c); (* 1125 *)\r
IF c <> 1125 THEN GOTO ExitError;\r
\r
\r
\r
\r
\r
\r
(******************************* TEST2F ********************************)\r
(* var declaration: subrange *)\r
WriteName(ZoneVar,"Test2F");\r
dsub := 2;\r
PrintInteger(ZoneVar, dsub ); (* 2 *)\r
IF dsub <> 2 THEN GOTO ExitError;\r
\r
\r
\r
\r
\r
(***************************** TEST2FA ***********************************)\r
(* static subrange type declare *)\r
WriteName(ZoneVar,"Test2FA");\r
dsubtype := 2;\r
PrintInteger(ZoneVar, dsubtype ); (* 2 *)\r
IF dsubtype <> 2 THEN GOTO ExitError;\r
\r
\r
\r
\r
(****************************** TEST2FB ********************************) \r
(* simple subrange expressions *)\r
WriteName(ZoneVar,"Test2FB");\r
a1sub:= 7;\r
PrintInteger(ZoneVar, a1sub); (* 7 *)\r
IF a1sub <> 7 THEN GOTO ExitError;\r
bsub:= - 30;\r
PrintInteger(ZoneVar, bsub); (* -30 *)\r
IF bsub <> -30 THEN GOTO ExitError;\r
bsub:= - bsub;\r
PrintInteger(ZoneVar, bsub); (* 30 *)\r
IF bsub <> 30 THEN GOTO ExitError;\r
bsub := a1sub + bsub;\r
PrintInteger(ZoneVar, bsub); (* 37 *)\r
IF bsub <> 37 THEN GOTO ExitError;\r
a1sub := a1sub - bsub;\r
PrintInteger(ZoneVar, a1sub); (* -30 *)\r
IF a1sub <> -30 THEN GOTO ExitError;\r
a1sub := a1sub * bsub;\r
PrintInteger(ZoneVar, a1sub); (* -1110 *)\r
IF a1sub <> -1110 THEN GOTO ExitError;\r
a1sub := a1sub div bsub;\r
PrintInteger(ZoneVar, a1sub); (* -30 *)\r
IF a1sub <> -30 THEN GOTO ExitError;\r
a1sub := bsub mod a1sub;\r
PrintInteger(ZoneVar, a1sub); (* 7 *)\r
IF a1sub <> 7 THEN GOTO ExitError;\r
PrintInteger(ZoneVar, - (bsub - a1sub)); (* -30 *)\r
PrintInteger(ZoneVar, - (a1sub div bsub)); (* 0 *)\r
PrintInteger(ZoneVar, - (bsub * a1sub)); (* -259 *)\r
\r
\r
\r
\r
\r
\r
\r
(******************************* TEST2FC **************************)\r
(* simple Subrange expressions *)\r
WriteName(ZoneVar,"Test2FC");\r
asub:= 7;\r
PrintInteger(ZoneVar, asub); (* 7 *)\r
IF asub <> 7 THEN GOTO ExitError;\r
c:= - 30;\r
PrintInteger(ZoneVar, c); (* -30 *)\r
IF c <> -30 THEN GOTO ExitError;\r
c:= - c + (( c - 2) + (( asub div 4) * c) mod asub \r
+( 4 + ( ( asub*c) DIV (c div asub)) + 3) );\r
PrintInteger(ZoneVar, c); (* 55 *)\r
IF c <> 55 THEN GOTO ExitError;\r
c := c * asub MOD (- asub) + 4;\r
PrintInteger(ZoneVar, c); (* 4 *)\r
IF c <> 4 THEN GOTO ExitError;\r
asub := (30079 div c) * c + (30079 mod c) - 30072;\r
PrintInteger(ZoneVar, asub); (* 7 *)\r
IF asub <> 7 THEN GOTO ExitError;\r
\r
\r
\r
\r
(*********************** TEST2FD ********************************)\r
(* simple subrange expressions *)\r
WriteName(ZoneVar,"Test2FD");\r
a2sub:= 7;\r
PrintInteger(ZoneVar, a2sub); (* 7 *)\r
IF a2sub <> 7 THEN GOTO ExitError;\r
b1sub:= - 30;\r
PrintInteger(ZoneVar, b1sub); (* -30 *)\r
IF b1sub <> -30 THEN GOTO ExitError;\r
b1sub := a2sub + (( a2sub DIV b1sub) + (( a2sub MOD b1sub) DIV\r
(( a2sub + 10) + ((23 + a2sub) * (( a2sub MOD b1sub) MOD\r
(( a2sub - 300) * ((b1sub + a2sub) - \r
((b1sub - 230) mod ( a2sub + b1sub) ))))))));\r
PrintInteger(ZoneVar, b1sub); (* 7 *)\r
IF b1sub <> 7 THEN GOTO ExitError;\r
\r
\r
\r
\r
\r
(**************************** TEST2FE **********************)\r
\r
(* simple integer and char Subrange expressions *)\r
\r
WriteName(ZoneVar,"Test2FE");\r
aaa:= 7;\r
PrintInteger(ZoneVar, aaa); (* 7 *)\r
IF aaa <> 7 THEN GOTO ExitError;\r
chsubrange := 'a';\r
WriteChar(ZoneVar, chsubrange); (* H61 *)\r
IF chsubrange <> 'a' THEN GOTO ExitError;\r
ch := 'b';\r
WriteChar(ZoneVar, ch); (* H62 *)\r
IF Ch <> 'b' THEN GOTO ExitError;\r
IF chsubrange <= Ch THEN chsubrange := ch\r
ELSE chsubrange := 'c';\r
WriteChar(ZoneVar, chsubrange); (* H62 *)\r
IF Chsubrange <> 'b' THEN GOTO ExitError;\r
\r
\r
\r
\r
(***************************** TEST2G ***********************)\r
(* while *)\r
WriteName(ZoneVar,"Test2G");\r
a:= 0; c:= 100;\r
while a < 10 do\r
begin\r
a:= a+1;\r
c:= c + a*3;\r
end;\r
PrintInteger(ZoneVar, a); (* 10 *)\r
IF a <> 10 THEN GOTO ExitError;\r
\r
\r
\r
\r
\r
\r
(*************************** TEST2GA *********************************)\r
(* while and exitloop and continueloop*)\r
WriteName(ZoneVar,"Test2GA");\r
a:= 0; c:= 8;\r
while a < 10 do\r
begin\r
a:= a+1;\r
\r
While c = a do\r
begin\r
loop\r
if c < a then exit;\r
c := c - 1;\r
if c = 10 then exit;\r
if c <= a then exitloop;\r
endloop;\r
end;\r
if a=1 then Continueloop;\r
if c = a then exit;\r
end;\r
\r
PrintInteger(ZoneVar, c); (* 7 *)\r
IF c <> 7 THEN GOTO ExitError;\r
PrintInteger(ZoneVar, a); (* 10 *)\r
IF a <> 10 THEN GOTO ExitError;\r
\r
\r
(************************* TEST2H ***************************)\r
(* repeat *)\r
WriteName(ZoneVar,"Test2H");\r
a:= 0; c:= 100;\r
repeat\r
a:= a+1;\r
c:= c + a*3;\r
until a=10; \r
PrintInteger(ZoneVar, a); (*10*)\r
IF a <> 10 THEN GOTO ExitError;\r
\r
\r
\r
\r
\r
\r
\r
(************************** TEST2HA *************************)\r
(* repeat and exitloop and continueloop*)\r
WriteName(ZoneVar,"Test2HA");\r
a:= 0; c:= 6;\r
repeat\r
begin\r
a:= a+1;\r
\r
\r
While c = a do\r
begin\r
repeat\r
if c < a then exit;\r
c := c - 1;\r
if c = 10 then exit;\r
if c <= a then exitloop;\r
until a > 5;\r
end;\r
if a=1 then Continueloop;\r
if c = a then exit;\r
\r
end;\r
until a = 10;\r
PrintInteger(ZoneVar, c); (* 5 *)\r
IF c <> 5 THEN GOTO ExitError;\r
PrintInteger(ZoneVar, a); (* 10 *)\r
IF a <> 10 THEN GOTO ExitError;\r
\r
\r
\r
\r
\r
(************************* TEST2I ******************************)\r
(* loop *)\r
WriteName(ZoneVar,"Test2I");\r
a:= 0; c:= 100;\r
loop\r
a:= a+1;\r
c:= c + a*3;\r
if a=10 then exitloop;\r
endloop;\r
PrintInteger(ZoneVar, a); (* 10 *)\r
IF a <> 10 THEN GOTO ExitError;\r
\r
\r
\r
\r
\r
(**************************** TEST2IA *****************************)\r
(* loop and exitloop and continueloop *)\r
WriteName(ZoneVar,"Test2IA");\r
a:= 0; c:= 0;\r
loop\r
if a=10 then exitloop;\r
c := c+1;\r
if c=1 then Continueloop;\r
a := a+ 1;\r
endloop;\r
PrintInteger(ZoneVar, c); (* 11 *)\r
IF c <> 11 THEN GOTO ExitError;\r
PrintInteger(ZoneVar, a); (* 10 *)\r
IF a <> 10 THEN GOTO ExitError;\r
\r
\r
\r
(************************** TEST2IB ************************)\r
(* loop and exitloop and continueloop and exit *)\r
WriteName(ZoneVar,"Test2IB");\r
a:= 0; c:= 5;\r
loop\r
if a=10 then exitloop;\r
a:= a+1;\r
If c = a then\r
begin\r
loop\r
if c < a then exit;\r
c := c - 1;\r
if c = 10 then exit;\r
if c < a then exitloop;\r
endloop;\r
end;\r
if a=1 then Continueloop;\r
if c = a then exit;\r
endloop;\r
\r
PrintInteger(ZoneVar, c);(* 4 *)\r
IF c <> 4 THEN GOTO ExitError;\r
\r
PrintInteger(ZoneVar, a); (* 10 *)\r
IF a <> 10 THEN GOTO ExitError;\r
\r
\r
\r
\r
(****************************** TEST2J **************************)\r
(* loop, goto label *)\r
WriteName(ZoneVar,"Test2J");\r
a:= 0; c:= 100;\r
loop\r
\r
a:= a+1;\r
c:= c + a*3;\r
if a=10 then goto printres;\r
endloop;\r
printres:\r
PrintInteger(ZoneVar, a); (* 10 *)\r
IF a <> 10 THEN GOTO ExitError;\r
\r
\r
\r
\r
\r
\r
\r
\r
(***************************** TEST2L **************************)\r
(* if then else *)\r
WriteName(ZoneVar,"Test2L");\r
a:= 2;\r
c:= a + ni;\r
b:= c > a;\r
if b then c:= c-a else c:= 0;\r
PrintInteger(ZoneVar, c); (* 9 *)\r
IF c <> 9 THEN GOTO ExitError;\r
if c < a then c := a - 1;\r
PrintInteger(ZoneVar, c); (* 9 *)\r
IF c <> 9 THEN GOTO ExitError;\r
if not b then c := 100 else c := c + a;\r
PrintInteger(ZoneVar, c); (* 11 *)\r
IF c <> 11 THEN GOTO ExitError;\r
if b then c := c + 10;\r
PrintInteger(ZoneVar, c); (* 21 *)\r
IF c <> 21 THEN GOTO ExitError;\r
if a = 2 THEN\r
begin\r
if b then\r
begin\r
if a>c THEN\r
begin\r
c := c * 2;\r
end\r
ELSE\r
c := 25 - c;\r
END;\r
\r
\r
end;\r
PrintInteger(ZoneVar, c); (* 4 *)\r
IF c <> 4 THEN GOTO ExitError;\r
\r
\r
\r
\r
\r
(******************************* TEST2M *************************)\r
(* exchange *)\r
WriteName(ZoneVar,"Test2M");\r
int1 := 5;\r
int2 := 7;\r
int1 :=: int2;\r
PrintInteger(ZoneVar, int1); (* 7 *)\r
IF int1 <> 7 THEN GOTO ExitError;\r
PrintInteger(ZoneVar, int2); (* 5 *)\r
IF int2 <> 5 THEN GOTO ExitError;\r
bool1 := true;\r
bool2 := false;\r
bool1 :=: bool2;\r
PrintBoolean(ZoneVar, bool1); (* 0 *)\r
IF Bool1 <> false THEN GOTO ExitError;\r
\r
PrintBoolean(ZoneVar, bool2); (* 1 *)\r
IF bool2 <> true THEN GOTO ExitError;\r
word2 := #H211;\r
word1 := #H003;\r
word2 :=: word1;\r
PrintWord(ZoneVar, word1); (* H211 *)\r
IF word1 <> #H211 THEN GOTO ExitError;\r
PrintWord(ZoneVar, word2); (* H3 *)\r
IF Word2 <> #H003 THEN GOTO ExitError;\r
byte1 := #H1;\r
byte2 := #H2;\r
\r
byte1 :=: byte2;\r
PrintByte(ZoneVar, byte1); (* H2 *)\r
IF byte1 <> #H2 THEN GOTO ExitError;\r
\r
PrintByte(ZoneVar, byte2); (* H1 *)\r
IF byte2 <> #H1 THEN GOTO ExitError;\r
achar := 'A';\r
bchar := 'B';\r
achar :=: bchar;\r
if achar = 'B' Then PrintBoolean(ZoneVar, true); (* 1 *)\r
IF achar <> 'B' THEN GOTO EXitError;\r
\r
if bchar = 'A' Then PrintBoolean(ZoneVar, false); (* 0 *)\r
IF bchar <> 'A' THEN GOTO ExitError;\r
\r
\r
\r
(************************ TEST2N **********************************)\r
(* statements with complicated boolean expression *)\r
WriteName(ZoneVar,"Test2N");\r
a := 30;\r
d := - 90;\r
found := true;\r
\r
if (a < d) then c := 10\r
else c :=1000;\r
PrintInteger(ZoneVar, c); (* 1000 *)\r
IF c <> 1000 THEN GOTO ExitError;\r
\r
\r
\r
if NOT (a < d) then c := 10\r
else c :=1000;\r
PrintInteger(ZoneVar, c); (* 10 *)\r
IF c <> 10 THEN GOTO ExitError;\r
\r
\r
if ((a < d) and found) then c := 10\r
else c :=1000;\r
PrintInteger(ZoneVar, c); (* 1000 *)\r
IF c <> 1000 THEN GOTO ExitError;\r
\r
if( (not (a < d)) and found) then c := 10\r
else c :=1000;\r
PrintInteger(ZoneVar, c); (* 10 *)\r
IF c <> 10 THEN GOTO ExitError;\r
\r
if ((a < d) xor found) then c := 100\r
else c :=1000;\r
PrintInteger(ZoneVar, c); (* 100 *)\r
IF c <> 100 THEN GOTO ExitError;\r
\r
if not ((a < d) xor found) then c := 100\r
else c :=1000;\r
PrintInteger(ZoneVar, c); (* 1000 *)\r
IF c <> 1000 THEN GOTO ExitError;\r
\r
\r
a:= 0; d:= 100; found := true;\r
while ((a < 10) and found) do\r
begin\r
a:= a+1;\r
if a = 5 then found := false;\r
d:= d + a*3;\r
end;\r
PrintInteger(ZoneVar, a); (* 5 *)\r
IF a <> 5 THEN GOTO ExitError;\r
\r
a:= 0; d:= 100; found := false;\r
while ((a < 10) xor found) do\r
begin\r
a:= a+1;\r
if a = 4 then found := true;\r
end;\r
PrintInteger(ZoneVar, a); (* 4 *)\r
IF a <> 4 THEN GOTO ExitError;\r
\r
a:= 0; d:= 100; found := false;\r
while ( ((a < 10) xor found) and (a = 0 ))do\r
begin\r
a:= a+1;\r
if a = 4 then found := true;\r
end;\r
PrintInteger(ZoneVar, a); (* 1 *)\r
IF a <> 1 THEN GOTO ExitError;\r
\r
\r
\r
\r
\r
(**************************************************************)\r
\r
(** TEST OF VERSION 3 **************)\r
\r
(***************************************************************)\r
\r
\r
\r
\r
\r
(**************************** TEST3A ******************************)\r
(* var declare and initialize *)\r
WriteName(ZoneVar,"Test3A");\r
PrintInteger(ZoneVar, ainit); (* 56 *)\r
IF aInit <> 56 THEN GOTO ExitError;\r
PrintInteger(ZoneVar, cinit); (* 56 *)\r
IF cInit <> 56 THEN GOTO ExitError;\r
PrintBoolean(ZoneVar, binit); (* false *)\r
IF bInit <> false THEN GOTO ExitError;\r
PrintByte(ZoneVar, xinit); (* ED *)\r
IF xInit <> #HED THEN GOTO ExitError;\r
PrintWord(ZoneVar, yinit); (* 003 *)\r
IF yInit <> #H003 THEN GOTO ExitError;\r
\r
\r
TEST3BA;\r
IF Test3Ok = false THen GOTO ExitError;\r
\r
\r
TEST3BB;\r
IF Test3Ok = false THen GOTO ExitError;\r
\r
\r
TEST3BC;\r
IF Test3Ok = false THen GOTO ExitError;\r
\r
TEST3BD;\r
IF Test3OK = false THEN GOTO ExitError;\r
\r
TEST3BE;\r
IF Test3OK = false THEN GOTO ExitError;\r
\r
\r
TEST3BF;\r
IF Test3Ok = false THen GOTO ExitError;\r
\r
\r
TEST3BH;\r
IF Test3OK = false THEN GOTO ExitError;\r
\r
\r
TEST3CA;\r
IF Test3Ok = false THen GOTO ExitError;\r
\r
\r
TEST3CB;\r
IF Test3Ok = false THen GOTO ExitError;\r
\r
\r
TEST3CC;\r
IF Test3Ok = false THen GOTO ExitError;\r
\r
\r
TEST3CD;\r
IF Test3Ok = false THen GOTO ExitError;\r
\r
\r
TEST3D;\r
IF Test3OK = false THEN GOTO ExitError;\r
\r
\r
TEST3F;\r
IF Test3OK = false THEN GOTO ExitError;\r
\r
TEST3FA;\r
IF Test3OK = false THEN GOTO ExitError;\r
\r
\r
\r
TEST3GA;\r
IF Test3OK = false THEN GOTO ExitError;\r
\r
\r
(***************************** TEST VERSION 4 *************************)\r
\r
LinkOk := Link("TESTVER4",testver4);\r
PrintInteger(ZoneVar,ord(LinkOK));\r
IF LinkOK <> Link_OK THEN GOTO EXitError;\r
createok := Create("test4",TestVer4(TestVer4End,Test4OK),Process4,\r
2500,200);\r
PrintInteger(ZoneVar,ord(CreateOK));\r
IF CreateOK <> Create_OK THEN GOTO EXitError;\r
\r
\r
\r
\r
(* Test if Version 4 is ok *)\r
testverok := false;\r
while testverok = false do\r
begin\r
Region TestVer4End do testverok := testver4End;\r
delay(2);\r
END;\r
\r
Region test4OK do TestVerOk := Test4OK;\r
IF Not TestVerOK THEN GOTO EXITError;\r
\r
remove(process4);\r
unlinkok := unlink(TestVer4);\r
IF Unlinkok <> Unlink_ok THEN GOTO EXITError;\r
\r
\r
\r
\r
(***************************** TEST VERSION 5 *************************)\r
LinkOk := Link("TESTVER5",testver5);\r
PrintInteger(ZoneVar,ord(LinkOK));\r
IF LinkOK <> Link_OK THEN GOTO EXitError;\r
createok := Create("test5",TestVer5(TestVer5End,Test5OK),Process5,0,200);\r
PrintInteger(ZoneVar,ord(CreateOK));\r
IF CreateOK <> Create_OK THEN GOTO EXitError;\r
\r
\r
\r
\r
(* Test if Version 5 is ok *)\r
testver5ok := false;\r
while testver5ok = false do\r
begin\r
Region TestVer5End do testver5ok := testver5End;\r
delay(2);\r
END;\r
\r
Region test5OK do TestVer5OK := Test5OK;\r
IF Not TestVer5OK THEN GOTO EXITError;\r
\r
remove(process5);\r
unlinkok := unlink(TestVer5);\r
IF Unlinkok <> Unlink_ok THEN GOTO EXITError;\r
\r
\r
\r
(***************************** TEST VERSION 6 *************************)\r
TestVersion6;\r
\r
\r
(* Test famile subrange *)\r
TestVerOK := false;\r
Test6fam(TestVerOK,ZoneVar);\r
\r
IF testverOk = false THEN GOTO EXITError;\r
\r
\r
(***************************** TEST VERSION 7 *************************)\r
\r
LinkOk := Link("TESTVER7",testver7);\r
PrintInteger(ZoneVar,ord(LinkOK));\r
IF LinkOK <> Link_OK THEN GOTO EXitError;\r
createok := Create("test7",TestVer7(TestVer7End,Test7OK),Process7,\r
2500,130);\r
PrintInteger(ZoneVar,ord(CreateOK));\r
IF CreateOK <> Create_OK THEN GOTO EXitError;\r
\r
\r
\r
\r
(* Test if Version 7 is ok *)\r
testverok := false;\r
while testverok = false do\r
begin\r
Region TestVer7End do testverok := testver7End;\r
delay(2);\r
END;\r
\r
Region test7OK do TestVerOk := Test7OK;\r
IF Not TestVerOK THEN GOTO EXITError;\r
\r
remove(process7);\r
unlinkok := unlink(TestVer7);\r
IF Unlinkok <> Unlink_ok THEN GOTO EXITError;\r
\r
\r
\r
(***************************** TEST VERSION 8 *************************)\r
TestVersion8;\r
\r
IF testverOk = false THEN GOTO EXITError;\r
\r
\r
TestVerOK := false;\r
Test8Fam(TestVerOK,ZoneVar);\r
\r
IF testverOk = false THEN GOTO EXITError;\r
\r
TestVerOK := false;\r
Test8JA(TestVerOK,ZoneVar);\r
\r
IF testverOk = false THEN GOTO EXITError;\r
\r
TestVerOK := false;\r
Test8H(TestVerOK,ZoneVar);\r
\r
IF testverOk = false THEN GOTO EXITError;\r
\r
\r
(****************************** TEST VERSION 10 ******************)\r
Test10A(testverOK,ZoneVar);\r
IF TestverOK = false THEN GOTO ExitError;\r
\r
(* test option segment *)\r
WriteString(ZoneVar,"Test Segment");\r
TestSegment;\r
\r
\r
\r
Goto EndTest;\r
\r
ExitError:\r
\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, '*'); \r
WriteChar(ZoneVar, '*'); \r
WriteChar(ZoneVar, '*'); \r
WriteChar(ZoneVar, '*'); \r
\r
\r
\r
EXIT;\r
\r
\r
EndTest:\r
(* Test OK *)\r
WriteChar(ZoneVar, ' '); \r
WriteChar(ZoneVar, 'O'); \r
WriteChar(ZoneVar, 'K'); \r
WriteChar(ZoneVar, ' '); \r
WriteChar(ZoneVar, '*'); \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
«eof»