|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 30720 (0x7800)
Types: TextFile
Names: »testjobs4«
└─⟦2c55ea56f⟧ Bits:30001844 SW-save af projekt 1000, Alarm-system
└─⟦6b41451d2⟧
└─⟦this⟧ »testjobs4«
; testjobs4
%
(***********************
* erip test 1 *
* test statements *
***********************)
process test_p;
type rec=record c,a,b: integer end;
label l,1;
var i,a,b: integer;
bo: boolean;
ref,ref1: reference;
r,r1: rec;
ar: array (1..2) of rec;
sem: semaphore;
po,po1: ^rec;
type
struc_type= record
x: integer;
y: record
x: integer;
y: record
x: integer;
y: integer;
end;
end;
end;
var struc: struc_type;
xx: ^ array (1..10) of ^ struc_type;
sha,shb: shadow;
ax: array (1..10) of
record
a: char;
b: record
a,b: integer;
c: 0..10;
end;
c: array (1..5) of integer;
end;
procedure p1;
begin i:=0 end;
procedure p2(a: integer; r1: rec; var r2: rec);
begin
with r1 do a:=0;
with r2 do a:=0;
end;
process p(a,b: integer; c: char; var s: semaphore); external;
begin
p1;
p2(a,r,r);
(*
create(a, p(1,2,'a',sem));
link(p);
*)
a:=0;
case a of
4,5: i:=0;
6..8: i:=0;
otherwise i:=0
end;
case b of
6+8: ;
end;
for i:=0 to 10 do a:=0;
for i:=10 downto 0 do a:=0;
l: if bo then goto l;
1: if bo then goto l else goto 1;
repeat bo:=true until bo;
while bo do bo:=true;
with po^ do a:=0;
with xx^(5)^.y do y.y:=0;
with struc.y do x:=0;
with struc,y,y,r do
begin
y:=0;
a:=0;
end;
i:=ax(a).c(b);
with ax(i) do begin
a:='a';
c(b.b):=5;
with b do b:=0;
end;
with r do a:=0;
with ar(1) do a:=0;
lock ref as x:array (1..16) of integer do x(1) := 0;
lock ref as x:rec do x.a:=0;
lock ref as x:rec do
with x do a:=0;
channel ref do i:=0;
ref:=:ref1;
sha:=:shb;
(*$4 1 0*) (*$4 2 0*) (*$4 3 0*)
(*$5 1 0*) (*$5 2 0*) (*$5 3 0*)
end.
%
\f
(**********************
* erip test 2 *
* test declararions *
**********************)
process test_p;
const c = 9;
type
sc = (aa,bb,cc,dd,ee,ff,gg,hh);
su=0..15;
ar = array (1..3) of integer;
arp = packed array (1..10) of sc;
re=record
a,b,c: integer;
d: char;
e: ar;
f: integer;
end;
r1 = record a: reference; b: char end;
raa = array (1..3) of r1;
px = re;
const c_ar = ar(3***10);
c_re = re(1,2,3,'a',c_ar,5);
cr1a = r1(?,1); cr1b = r1(?,2); cr1c = r1(?,3);
caa = raa(cr1a, cr1b, cr1c);
type re1 = packed record
a,b: sc;
d : record a,b: integer; end;
e: array (1..10) of integer;
f,g: su;
end;
var
s1: set of 0..15;
s2: set of 0..255;
s3: set of 0..2047;
p: pool 10;
p1:pool 11 of re;
f: !re;
po1,po: ^re;
pra: packed record
a,b,c,d: 0..15;
e: integer;
f: re;
g,h,i,j: 0..255;
k,l,m: 0..31;
n: boolean;
o,p,q: 0..31;
r: 0..2;
end;
a1: packed array (0..4) of 0..4;
a2: packed array (0..4) of 0..30;
a3: packed array (0..4) of 0..31;
a4: packed array (0..4) of 0..32;
va: sc;
vb: su;
vc: ar;
vd: arp;
ve: re;
vf: px;
vg: re1;
reff: reference;
sha: shadow;
se: semaphore;
ch: char;
i,j: integer;
b: boolean;
vraa: raa:=caa;
begin
ch:=caa(3).b;
va:=va;
vb:=vb;
vc(1):=vc(3);
vd(4):=cc;
po:=po1;
ch:=po^.d;
b:=true;
i:=99;
(*
alloc(reff,p1,se);
*)
vf.b:=ve.f;
with ve do begin
a:=0;
b:=0;
c:=0;
d:=0;
e:=c_ar;
f:=0;
end;
ve:=c_re;
with vg do begin
b:=dd;
a:=a;
d.a:=0;
with d do b:=0;
e(5):=0;
g:=f;
end;
if c in s1 then ;
if c in s2 then;
if c in s3 then;
ve:=f;
vb:=a3(3);
vb:=a4(4);
vb:=a1(1);
vb:=a2(2);
with pra do begin
a:=c;
b:=c;
d:=c;
e:=c;
f:=ve;
g:=c;
h:=1;
i:=2;
j:=3;
k:=4;
l:=5;
m:=6;
n:=true;
o:=7;
p:=8;
q:=9;
r:=1;
end;
(*$4 1 0*)
(*$4 2 0*) (*$4 3 0*)
(*$5 1 0*) (*$5 2 0*) (*$5 3 0*)
end.
%
\f
(***********************
* erip test 3 *
* test constant expr *
***********************)
process test_c;
const
a=32767;
b=32768;
c=-32768;
x=32769;
d=-10000;
var
s : -32768..32767;
t: -32768..32768;
i: integer :=b;
j: integer :=a;
k: integer :=c;
type txt=array (1..13) of char;
txt1=array (1..14) of char;
procedure pip(a,b,c: integer);
begin end;
procedure popp(t: txt);
begin end;
var ttt: txt; ttt1: txt1;
const
t1 = 'det er en text';
t2 = 'en text';
type st = array (1..3) of integer;
var st_var: st;
const
c1=st(1,2,3);
c2=st(3,2,1);
c3=st(1,2,3);
begin
pip(c,b,a);
i:=a+i;
i:=b+i;
i:=c+i;
i:=10000+22767;
i:=10000+22768;
i:=10000+22769;
i:=10000+c;
i:=d+c;
i:=d-22767;
i:=d-22768;
i:=d-22769;
i:=10923*3;
i:=4681*7;
i:=4096*8;
i:=-(4096*8);
i:=(-3)*(-7);
i:=(-2)*8;
i:=8*(-2);
i:=16 div 5;
i:=16 mod 5;
if (1<>2) or (1=1) then;
if (2<=1) or (2>=1) then;
if (1<2) or (1>2) then;
if (1=2) or (1<>1) then;
if (1<=2) and (1>=2) then;
if (2<1) and (2>1) then;
if true and true then;
if false and false then;
if c1=c3 then ;
if c1=c2 then ;
if c1<>c2 then ;
if c1<>c3 then ;
if t1='det er en text' then;
if t2='en anden text' then;
if t1<>'det er en text' then;
if t2<>'en anden text' then;
if t2<>'en test' then;
if t1<>'en mmmmmmmmmmeget lang text' then;
ttt:=t1;
ttt:=t2;
ttt:='123456789012';
ttt:='1234567890123';
ttt:='12345678901234';
ttt:=ttt;
popp(t1);
popp(t2);
popp(ttt);
popp('1234567890123');
popp('123456789012');
popp('12345678901234');
st_var:=st(a,b,c);
case i of
a:;
b:;
c:;
c..0:;
0..b:;
end;
i:=#b1111111111111111;
i:=#b11111111111111111;
i:=#o177777;
i:=#o277777;
i:=#hffff;
i:=#h1ffff;
i:=#b1001;
i:=#b12;
i:=#o777;
i:=#o678;
i:=#h10f;
i:=# hh;
s:=i;
t:=i;
(*$4 1 0*) (*$4 2 0*) (*$4 3 0*)
(*$5 1 0*) (*$5 2 0*) (*$5 3 0*)
end.
%
\f
(**********************
* erip test 4 *
* test struc const *
**********************)
process test_struc;
type
p = array (1..6) of 0..255;
q = array (1..3) of integer;
r = record
a,b: integer;
c,d: 0..255;
e: boolean;
end;
s = array (1..2) of r;
t = record
a: integer;
b: q;
c,d: r;
end;
u = packed array (1..6) of 0..15;
v = packed array (1..10) of boolean;
w = packed record
a,b,c: 0..15;
d: integer;
e,f: 0..255;
end;
sb = packed array (1..10) of boolean;
sa = array (1..3) of sb;
const
a=p(1,2,?,600,5,7);
b=p(6***99);
c=p(7,3***8,-9,99);
d=q(1,?,3);
e=r(800,?,600,7,true);
f=s(?,e);
g=t(99,d,?,e);
h=u(1,30,2***7,?,6);
i=v(true,8***false,true);
j=w(1,?,30,99,77,99);
da=q(1,1,1,1);
db=q(1,1);
dc=q(1,3***1);
dd=v(9***false,true,true);
de=v(false,10***true);
df=v(8***false);
s1 = (.7,15,16,31,32,517..613,1023,2000,600.);
s2 = (.0,15.);
s3 = (.15,31,47,63.);
s4 = (.39.);
s5 = (..);
sc = sa( sb(10***false), sb(10***true), sb(true,8***false,true));
txt = 'det er en tekst ';
var
v1: char := 'a';
v2: integer :=99;
v3: q :=d;
v4: set of 0..15 := s2;
v5: set of 0..63 := s1;
v6: set of 0..255 := (.15.);
v7: p; v8: r; v9: s; v10: t; v11: u; v12: v; v13: w; v14: sa;
begin
v7:=a; v7:=b; v7:=c;
v3:=d; v8:=e; v9:=f; v10:=g; v11:=h;
v12:=i; v13:=j; v14:=sc;
v3:=da; v3:=db; v3:=dc;
v12:=dd; v12:=de; v12:=df;
v6:=s1; v6:=s2; v6:=s3; v6:=s4; v6:=s5;
(*$4 1 0*) (*$4 2 0*) (*$4 3 0*)
(*$5 1 0*) (*$5 2 0*) (*$5 3 0*)
end.
%
\f
(********************************************
* erip test 5 *
* test record and array type declarations *
********************************************)
process test_4;
type
a=array (1..9) of char;
b=array (1..5) of integer;
c=array (1..4) of ^a;
d=array (1..4) of record a,b: integer; c: char end;
e=packed array (1..5) of 0..255;
f=packed array (1..5) of 0..63;
g=packed array (1..5) of 0..31;
h=packed array (1..5) of 0..15;
i=packed array (1..10) of record a,b: integer end;
j=packed array (1..3,4..6) of 0..15;
k=array (1..1) of char;
l=array (1..10) of -3..6;
m=packed array (1..3) of reference;
n=array (1..32,1..2048) of char;
a1 = packed array (1..8) of 0..15;
a2 = packed array (1..9) of 0..15;
a3 = packed array (1..10) of 0..15;
a4 = packed array (1..11) of 0..15;
a5 = packed array (0..7) of boolean;
o=set of -1..10;
p=pool 0;
q=packed record
a: 0..16383; aa: 0..1; ab: 10..16383;
b: integer;
c: char;
d,e: record a,b,c: 0..31 end;
f,g: 0..255;
h: -10..10;
i,j,k: 0..31;
l: boolean;
m,n,o: 0..31;
p: (sa,sb,sc);
end;
r=record
a: integer;
b: reference;
c: record a: integer; c: char; end;
d: reference;
end;
s=record c: char end;
t=packed record
a,b,c,d: 0..255;
end;
r1 = packed record
a,b,c : 0..15;
d,e : 0..31;
f: 0..4095;
g: integer;
end;
r2 = packed record a,b : 0..7 end;
r3 = packed record
a : integer;
b,c : 0..255;
d,e,f : 0..63;
end;
var
aa: a; bb:b; cc:c; dd:d; ee:e; ff:f; gg:g;
hh:h; ii:i; jj:j; kk:k; ll:l; mm:m; nn:n; oo:o;
qq:q; rr:r; ss:s; tt:t;
x: integer; ch:char; po: ^a; ref: reference; bo: boolean;
vr1 : r1 := r1(1,2,3,20,21,1599,6000);
vr2 : r2 := r2(1,7);
vr3 : r3 := r3(8000,251,252,61,62,63);
begin
ch:=aa(x); x:=bb(x); po:=cc(3); ch:=dd(3).c;
x:=ff(x);
x:=gg(x); x:=hh(x); x:=ii(x).b; x:=jj(x,2);
ch:=kk(x); x:=ll(x); ref:=:mm(x); ch:=nn(2,x);
x:=qq.a; x:=qq.aa; x:=qq.ab; x:=qq.b; ch:=qq.c;
x:=qq.d.c; x:=qq.e.c; x:=qq.f; x:=qq.g; x:=qq.h;
x:=qq.i; x:=qq.j; x:=qq.k; bo:=qq.l;
x:=qq.m; x:=qq.n; x:=qq.o;
with qq do p:=sc;
x:=rr.a; ref:=:rr.b; ch:=rr.c.c;
ref:=:rr.d; ch:=ss.c;
x:=tt.a; x:=tt.b; x:=tt.c; x:=tt.d;
(*$4 1 0*) (*$4 2 0*) (*$4 3 0*)
(*$5 1 0*) (*$5 2 0*) (*$5 3 0*)
end.
%
(***************************************
* erip test 6 *
* test constant as actual parameters *
***************************************)
process test_6;
type rec=record a,b: integer; c: char end;
const r=rec(7,8,'a');
s=(.15,255.);
var i: char; j: integer; k: rec; l: set of 0..63;
procedure p(c: char; i: integer; j: rec; s: set of 0..63);
var s1: set of 0..15;
begin
s1:=s;
end;
begin
p('a',25,r,(.15,127.));
p(i,j,k,l);
p('b',99,k,s);
(*$4 1 0*) (*$4 2 0*) (*$4 3 0*)
(*$5 1 0*) (*$5 2 0*) (*$5 3 0*)
end.
%
\f
(***************************
* erip test 7 *
* test allocating limits *
***************************)
process test_7;
type
rec=record a,b,c,d: integer end;
a1=array (1..8192) of rec;
a2=array (1..8190) of rec;
a3=array (0..8192) of rec;
d=record
a: a2;
b,c: rec;
end;
e=record
a: a2;
aa: rec;
b: integer;
c: integer;
d: integer;
e,f,g: char;
end;
procedure p(z,x: integer);
var h: a2;
begin end;
var h: array (1..8187) of rec;;
i: rec;
j,k,l: char;
begin
(*$4 1 0*) (*$4 2 0*) (*$4 3 0*)
end.
%
\f
(********************************
* erip test 8 *
* test process create and div *
********************************)
process test_8;
type sem_type = array (1..19) of semaphore;
info_type=record a,b: integer; c: char end;
var
sem: sem_type;
info: info_type;
b: boolean;
ans: semaphore;
function dbcreate (p1,p2: processrec; i: integer) : info_type; external;
process job1(no: integer);
type fam_type=record f: alfa; son: integer; end;
var p,q: integer; nav: alfa; ff: fam_type;
function fam(a,b: integer): fam_type;
var x,y: integer; q: fam_type;
begin
fam:=q;
fam.son:=x;
end;
var q1: integer;
process snot(var s: semaphore);
var x,y: integer;
begin
x:=y;
end;
var q2: integer;
begin
q1:=0;
q2:=0;
nav:=fam(1,2).f;
ff:=fam(p,q);
end;
process driv(var ans: semaphore);
type tail=array (1..10) of integer;
var p,q: integer; r: tail; n: alfa;
function look(n: alfa): tail;
var i,j: integer; q: tail;
begin
look:=q;
look(10):=25+j;
end;
begin
p:=look('123456789012')(q);
r:=look(n);
end;
procedure exception(i: integer);
begin
create(99,driv(ans));
end;
begin
b :=
boot (
job1 (
ord ( boot (
driv (ans),
succ ( ord ( boot (
driv (ans), 1, 2
))),
3
))
),
ord ( boot (job1 (4), 5, 6)),
7
);
info.c := chr ( 1 + dbcreate (job1(1),
job1(2), 99).b);
(*$4 1 0*) (*$4 2 0*) (*$4 3 0*)
(*$5 1 0*) (*$5 1 0*) (*$5 2 0*)
end.
%
\f
(***********************
* erip test 9 *
* test function call *
***********************)
process test_9;
type
by = 0..10;
bx = (xa,xb,xc,xd,xe);
ar = array (1..3) of integer;
rec=record a,b: integer; c: char end;
po = ^rec;
se = set of 0..127;
const c1 = rec(2,3,'a');
var k: integer;
function fa(a:by; b,c: integer; d: po): by; forward;
var l: integer;
function fb(a: bx; b:ar; c: rec): integer; forward;
var m: integer;
function fc(a: boolean; b: char; c: se): po; forward;
var n: integer;
function fd: ar; forward;
var o: integer;
function fe: rec; forward;
var p: integer;
function ff: se; forward;
var q: integer;
function fg(var a,b,c,d: by; e,f,g,h: integer): bx; forward;
var pp: po; rr: rec;
procedure pa(a,b,c: integer); forward;
var r: integer;
vbx: bx;
vby: by;
function fa(a: by; b,c:integer; d:po):by;
var y: integer; z: po; x: rec;
begin
y:=a;
y:=b+c;
z:=d;
y:=1+2+fb(xc,ar(3,4,5),c1);
fa:=7;
end;
function fb(a: bx; b:ar; c: rec): integer;
var x: bx;
begin
x:=a;
fb:=b(3)+c.a+fd(2);
end;
function fc: po;
var x: boolean; y: char; z:po; i: integer;
begin
x:=a or (3 in c);
y:=b;
y:=chr(i);
r:=fa(3,i,i,z);
fc:=z;
end;
function fd: ar;
var y: se;
begin
fd:=ar(5,4,3);
y:=ff;
end;
function fe: rec;
var i: integer;
begin
fe:=c1;
i:=0;
end;
function ff: se;
var a,b,c: integer;
begin
ff:=(.a+b,b-c,a*c.);
end;
function fg(var a,b,c,d: by; e,f,g,h: integer): bx;
var x: integer;
begin
a:=e+x;
b:=f;
c:=g;
d:=h;
fg:=xd;
end;
procedure pa;
begin end;
var xx: boolean;
begin
pp:=fc(true,'a',(.1.));
rr:=fe;
xx:=r in ff;
vbx:=fg(vby,vby,vby,vby,1,2,3,4);
k:=l;
m:=n;
o:=p;
q:=r;
vbx:=succ(vbx);
vbx:=pred(vbx);
k:=ord(vbx);
(*$4 1 0*) (*$4 2 0*) (*$4 3 0*)
(*$5 1 0*) (*$5 2 0*) (*$5 3 0*)
end.
%
\f
(**************************
* erip test 10 *
* test const area limit *
**************************)
process test10;
type a = array (1..497) of integer;
const c = a(497***7);
begin
(*$4 1 0*) (*$4 2 0*) (*$4 3 0*)
end.
%
\f
(*********************
* erip test 11 *
* test block niv *
*********************)
process test_11;
type ar = array (1..2) of char;
var i: integer; j0: ar:='ab'; p,q: char;
procedure a1;
var i: integer; j1: ar:='cd'; p,q,r: char;
procedure a2(a: integer);
var i: integer; j2: ar:='ef'; p,q,r,s: char;
procedure a3(a,b: integer);
var i: integer; j3: ar:='gh'; p,q,r,s,t: char;
begin
i:=a+b;
j0:='zz';
j1:='xx';
j2:='vv';
j3:='dd';
a3(1,2);
a2(1);
a1;
end;
begin
i:=a;
a2(1);
a1;
j2:='nn';
j1:='bb';
j0:='hh';
end;
begin
i:=0;
j1:='jj';
j0:='kk';
a1;
end;
begin
i:=0;
j0:='tt';
a1;
(*$4 1 0*) (*$4 2 0*) (*$4 3 0*)
(*$5 1 0*) (*$5 2 0*) (*$5 3 0*)
end.
%
\f
(******************
* erip test 12 *
* test set expr *
******************)
process test_12;
type smallset = set of 3..8;
type smallarr = array (0..3) of smallset;
type largeset = set of 0..40;
type largearr = array (0..4) of largeset;
type set_0_16 = set of 0..16;
const s1 = (.4,7.);
const s2 = (..);
const s3 = (.4,5,6,3.);
const l1 = (.4,16.);
const l2 = (.4,32.);
const sm_c = smallarr (s1, s2, s3, (.8..5.));
const la_c = largearr (s1, s3, l1, l2, (..));
const c = (..); c1 = (.66.);
var
i: integer;
p,q: set of 0..30;
s: set of 0..15;
t: set of 0..100;
u: set of 0..500;
x: smallarr;
y: largearr;
begin
s:=t*u*(.0.);
t:=s+u+(.277.);
u:=s-t-c1;
s:=(.i+10,i+3..i+6,i.);
if s>=t then;
if t<=(.0.) then;
if s<>t then;
if u=s then;
if s>=(..) then;
if (..)<=u then;
if (.8.)<=t then;
if u=c then;
x:=sm_c; y:=la_c;
u:=s1; u:=s2; u:=s3; u:=l1; u:=l2;
(*$4 1 0*) (*$4 2 0*) (*$4 3 0*)
(*$5 1 0*) (*$5 2 0*) (*$5 3 0*)
end.
%
\f
(****************************************
* erip test 13 *
* test integer and boolean aritmetic *
****************************************)
process test_13;
type
a1=array (1..10) of integer;
a2=array (1..5,1..5,1..5) of integer;
a3=packed array (1..10) of 0..15;
a4=packed array (0..15) of boolean;
var
i: integer;
b: boolean;
j: 0..15;
r: packed record
a: integer;
b: boolean;
c,d: 0..15;
end;
var
ar: a1;
aq: a2;
at: a3;
au: a4;
const c1=a1(99,8***1,99);
begin
i:=-i+i-i*i div i mod i;
j:=j+j-j div j mod j;
i:=i+5;
i:=5+j;
b:=not b or b and b;
au(j):=not au(j) or au(j) and au(j);
with r do begin
c:=c+c-c div c mod c;
b:=not b or b and b;
end;
ar(j):=ar(i) + ar(i) - ar(i) * ar(i) div ar(i) mod ar(i);
at(j):=at(i) + at(i) - at(i) * at(i) div ar(i) mod ar(i);
i:=5 + ( 6 + ( 7 + i ));
i:=5+(6+(7+ar(5+(6+(7+i)))));
i:=aq(1+(2+i),3+(4+i),5+(6*i));
if (ar<>c1) or (c1=ar) then;
(*$4 1 0*) (*$4 2 0*) (*$4 3 0*)
(*$5 1 0*) (*$5 2 0*) (*$5 3 0*)
end.
%
\f
(**********************
* erip test 14 *
* test code lines *
**********************)
prefix testprogramm;
procedure pip;
beginbody 1789:
code linie 1
code linie 2
code linie 3
endbody;
.
%
\f
(**********************
* erip test 15 *
* test initialize *
**********************)
process test_15;
type
rec = record a,b: integer; c: char end;
arr = array (1..3) of integer;
var
a: integer := 99;
b: 0..10 :=5;
c: rec := rec ( 1,2, 'a' );
d: arr := arr ( 1,2,3 );
e: set of 0..10 := (..);
f: set of 0..127 := (.15.);
p: pool 1 of array (1..10) of integer;
po: ^integer;
se: semaphore;
re: reference;
sh: shadow;
r1: record
p: pool 2*10 of record a,b: integer; c: char end;
po: ^ rec;
se: semaphore;
re: reference;
sh: shadow;
r: record
po: ^ rec;
se: semaphore;
p: pool -(-3) of integer;
p1: pool 3+(3+(5+(6+7))) of integer;
end;
a: array (1..10) of shadow;
end;
a1: array (1..10) of ^rec;
a2: array (1..10) of pool 1 of char;
a3: array (1..10) of semaphore;
a4: array (1..10) of reference;
a5: array (1..10) of shadow;
a6: array (1..10) of
array (1..19) of shadow;
a7: array (1..10) of record
p: pool 10 of boolean;
s: semaphore;
end;
a8: array (1..10,1..10) of pool 10 of record a,b,c: integer; end;
begin
(*$4 1 0*) (*$4 2 0*) (*$4 3 0*)
(*$5 1 0*) (*$5 2 0*) (*$5 3 0*)
end.
%
\f
(**************************
* erip test 16 *
* variable addressing *
**************************)
process test_16;
type
rec = record a,b: integer; c: char; end;
s015 = 0..15;
ar_type = array (1..7) of s015;
par_type = packed array (1..7) of s015;
const
c1 = 77;
c2 = rec(4,5,'a');
c3 = (.31.);
c4 = ar_type(1,2,3,4,5,6,7);
c5 = par_type(7,6,5,4,3,2,1);
var
ra: array (1..5) of rec;
ref: reference;
i,j: integer;
r: rec;
s: set of 0..10;
su: s015;
p1,p2: ^rec;
rp: packed record
a: integer;
b,c,d: s015;
end;
b: s015;
ap: packed array (1..10) of s015;
function fy(a: integer; var b: integer): rec;
var c: integer;
begin
b:=a+c;
fy:=c2;
end;
function f(var a: integer; var b:rec; c: char;
d: integer; e: rec): integer;
var i: integer; j: char;
begin
c:=a+d;
j:=c;
i:=e.b + b.b;
f:=99;
end;
begin
i:=2 + j;
su:= rp.c + su + i + c1 + c2.b + ap(j) +
c4(3) +
f(i,r,'a',3,c2) + p1^.b + fy(11,i).b;
p1:=p2;
r:=c2;
s:=c3;
s:=s;
r:=r;
ap(i):=su;
with ra(i) do a:=c2.b + c4(3) + b;
lock ref as t: integer do t:=8*i+t;
lock ref as t: rec do t.a:=t.b;
for i:=1 to 25 do i:=i;
for ra(i).b := 3 downto -50 do i:=0;
i := c5 (3); (* det går galt * erip glemmer 'packed' *)
(*$4 1 0*) (*$4 2 0*) (*$4 3 0*)
(*$5 1 0*) (*$5 2 0*) (*$5 3 0*)
end.
%
\f
(**************************
* erip test 17 *
* test odd temp alloc *
**************************)
process test_17;
type rec = record a,b: integer; c: char end;
const c = rec(1,2,'a');
var r: rec; t: char;
function f(a,b: rec): rec;
begin f:=r end;
function g(a: integer): char;
begin
g:='a';
end;
begin
r:=f( f(c,c), f(c,c) );
t:=g(1);
(*$4 1 0*) (*$4 2 0*) (*$4 3 0*)
(*$5 1 0*) (*$5 2 0*) (*$5 3 0*)
end.
%
\f
(***************************
* erip test 18 *
* test parameter types *
***************************)
process test_18;
type rec = record i: integer; s: semaphore end;
arr = array (1..10) of reference;
p = ^ integer;
re = record a,b: integer; c: char end;
ar = array (1..11) of char;
process pp(var s: semaphore; var t: record s: semaphore end); external;
procedure pc( var a: reference;
var b: shadow;
var c: arr;
var d: pool 1;
var e: p;
var f: re;
var g: ar;
var h: integer;
i: integer;
j: boolean;
k: p;
l: re;
m: ar); external;
begin
(*$4 1 0*) (*$4 2 0*) (*$4 3 0*)
end.
%
\f
(**********************************************
* erip test 19 *
* test internal and external process decl. *
**********************************************)
process test_19(var s: semaphore; i,j: integer);
process pap(var p: semaphore; a,b: char); external;
procedure pip(x,y,z: integer);
var b: boolean;
begin
while b do b:=true;
end;
process pop(a: char; var b: semaphore; c: integer);
var k: 0..10;
begin
repeat k:=0; until k<>1;
end;
var i: integer :=0;
begin
for i:=0 to 10 do i:=0;
(*$4 1 0*) (*$4 2 0*) (*$4 3 0*)
(*$5 1 0*) (*$5 2 0*) (*$5 3 0*)
end.
%
\f
(***********************************
* erip test 20 *
* format of prefixed procedure *
***********************************)
prefix test_20;
procedure pip(var i: integer; j,k: boolean);
var x,y: integer;
begin
repeat x:=y until x<>0
end;
.
%
\f
(******************
* erip test 21 *
* struc const *
******************)
process test_20;
type
s = 0..4;
i = 0..10;
x = array (i) of s;
y = array (s) of x;
const
c = y(
x(1,0,2,8***0),
x(1,0,9***1),
3 ***
x(6***4,0,4***4) );
var v: s;
begin
v:=c(1,3);
(*$4 1 0*) (*$4 2 0*) (*$4 3 0*)
(*$5 1 0*) (*$5 2 0*) (*$5 3 0*)
end.
%
\f
(*******************
* erip test 22 *
* error field *
*******************)
process test_22;
type
t=packed array (0..7) of boolean;
r=record
a: integer;
b: t;
c: integer;
end;
s=packed record
a: integer;
b,c,d: 0..15;
e: boolean;
end;
var x: t; y: r;
p:s;
z: boolean; i: integer;
begin
x:=y.b;
x(6):=true;
z:=y.b(3);
i:=p.b;
y.b:=x;
(*$4 1 0*) (*$4 2 0*) (*$4 3 0*)
(*$5 1 0*) (*$5 2 0*) (*$5 3 0*)
end.
%
\f
(********************
* test 23 *
* test export *
********************)
process test_23(var sem: semaphore; var qq:integer);
const
sc = (.100.);
text = '0123456789abcdefg';
cc = 10;
var
rec : record
a: integer;
b: record
a: integer;
b: array (1..7) of char;
c: char;
end;
c: char;
end;
rec_p: packed record a,b: 0..10 end;
ii: integer;
t: array (1..14) of char;
export
a = value cc;
c = size cc;
d = size text;
e = size rec;
g = size ii;
f = size rec;
h = size sem;
i = size rec.b;
j = size rec.b.b;
m = disp rec.c;
n = disp rec.b.b;
p = address ii;
p1= offset ii;
q = address sem;
q1= offset sem;
r = address qq;
r1= offset qq;
t = address rec.c;
t1= offset rec.c;
u = address rec.b.c;
u1= offset rec.b.c;
abcdefghijklmnopqrst = offset rec_p;
function pip(a,b: integer): integer;
export
fb = offset a;
fc = address b;
begin
pip:=0;
end;
begin
(*$5 1 1*) (*$5 2 0*) (*$5 8 1*)
end.
%
\f
(**********************
* ep test 24 *
* search external *
**********************)
process test_24;
procedure pip(i,j: boolean); external;
procedure object1(i: integer); external;
procedure object; external;
procedure abcd(i,j: integer); external;
(*
procedure ii;
procedure abcd(x,y: boolean); external;
procedure abc(i: integer); external;
begin
end;
*)
begin
pip(true,false);
object;
object1(10);
abcd(3,4);
(*$5 4 1*)
(*$4 1 0*) (*$4 2 0*) (*$4 3 0*)
(*$5 1 0*) (*$5 2 0*) (*$5 3 0*)
end.
%
\f
(********************
* ep test 25 *
* test string *
********************)
process test_25;
type s = 0..10; t = array (s) of char;
t1 = array (1..5) of char;
const sp = ' ';
cs = (.15.);
tx = 'abdkkkk'; ty = '..............................';
procedure pip(a:t);
begin end;
var txt: t; su:s; i:integer; b:boolean; se: set of s;
txt1: t1;
begin
su:=i;
se:=cs;
b:=' ' = ' ';
b:=' ' = ' ';
b:=' ' = ' ';
b:=txt = 'det er en text ';
b:=txt = 'en text';
if 'text' = txt then;
if 'en .............. text' = txt then;
txt:=tx;
txt:=ty;
pip(tx);
pip(ty);
txt1:=tx;
txt1:=ty;
txt:=' ';
txt:='en lang text ...............';
txt(i):=' ';
pip(' ');
pip(' ');
pip(' ');
(*$4 1 0*) (*$5 1 0*) (*$5 2 0*) (*$5 3 0*) (*$4 10 1*)
end.
%
\f
(**************************
* test ep 26 *
* test z80 enviroment *
**************************)
(*$1 1 1*)
(*$5 4 0*) (*$5 7 1*) (*$5 10 1*) (*$5 1 1*) (*$5 2 1*)
process test_26;
var
i: integer; reff: reference; po: pool 1;
sem: semaphore; sh: shadow; b: boolean;
p: ^ integer; sp: sempointer; ch: integer;
by: byte; c: activation;
process pip(var sem: semaphore; var i: integer); external
;
begin
i:=abs(i);
alloc(reff,po,sem);
break(sh,i);
i:=create(pip(sem,i),sh,10000);
b:=empty(reff);
link('proc',pip);
b:=locked(sem);
b:=nil(reff);
b:=open(sem);
b:=openpool(po);
b:=ownertest(po,reff);
b:=passive(sem);
pop(reff,reff);
push(reff,reff);
sp:=ref(sem);
release(reff);
remove(sh);
reservech(reff,ch);
return(reff);
sensesem(reff,sem);
signal(reff,sem);
start(sh,i);
stop(sh);
unlink(pip);
wait(reff,sem);
waiti;
waits(reff,sem);
waitd(by);
c:=waitis(reff,sem);
c:=waitid(by);
c:=waitsd(reff,sem,by);
c:=waitisd(reff,sem,by);
by:=inbyte(by);
inbyteblock(reff,i,i,by);
outbyte(by,by);
outbyteblock(reff,i,i,by);
zenable;
zreti;
by:=remdelay;
interrupt(1);
printchar('a');
end.
%
\f
(**************************
* test 27 ep *
* test export include *
**************************)
process test27;
const c1=-10; c2=10; c3=255; c4=99;
c5=98; c6=32767;
var p,q: integer;
export
MELKOR = value c1;
FINWE = value c2;
ELWE = value c3;
INGWE = value c4;
FINARFIN = value c5;
ELBERETH = value c6;
GALADRIEL = address p;
CELEBORN = address q;
procedure ptestp; external;
begin
ptestp;
(*$5 1 1*) (*$5 2 0*)
(*$5 4 1*)
end.
%
\f
(******************************
* ep test 28 *
* test array, record decl *
******************************)
process test_28;
type
a1 = array (1..7) of record a,b: integer end;
a2 = packed array (1..7) of record a,b: integer end;
a3 = array (1..7) of record a,b:integer; c:char end;
a4 = packed array (1..7) of 0..31;
a5 = packed array (1..7) of 0..63;
a6 = array (1..7) of record p:^integer; c: char end;
a7 = array (-1..10) of integer;
a8 = array (1..1) of char;
r1 = record a:reference; b:char end;
r2 = record
a: char;
b: r1;
c: char;
d: integer
end;
r3 = record
a: ^integer; b:char;
c: r1; d:char;
e: semaphore; f: char;
g: shadow; h:char;
i:pool 1; j:char;
k: array (1..10) of reference
end;
r4 = packed record
a: -1..1;
b: 0..10;
c: r1;
d,e: 0..10
end;
r5 = packed record
a: 0..2047;
b: 0..31;
c,d,e,f: 0..255;
g: boolean;
h,i,j,k,l,m:0..31;
n: 0..3
end;
r6 = record a,b: integer; c: char end;
r7 = record c:char end;
procedure pip(a:char; b: r6; c:r7);
begin end;
begin
(*$4 1 0*) (*$4 2 0*) (*$4 3 0*)
end.
%
\f
(******************
* ep test 29 *
* test div *
******************)
process test_29;
type
rec = record a: integer; b: char; end;
ar = array (1..5) of rec;
const
cr = rec(1,'a');
var v : ar := ar(5 *** cr);
type
t1 = packed record i: 0..1; id: 0..32767 end;
t2 = packed record a,b,c,d,e,f: 0..1 end;
t3 = packed record a: 0..63; b: 0..3 end;
t4 = packed record
a: t1;
b: t1;
c: 0..255;
d: t2;
e: t3;
f: set of 0..15;
g: packed array (1..15) of 0..15;
h: integer
end;
type r1 = record a:reference; b: 0..10 end;
a1 = array (1..3) of r1;
const c1=r1(?,3);
var v1 : a1 := a1(3***c1);
x,y : packed record a,b,c:0..1 end;
type s_t = set of 0..31;
r2 = record
a : integer;
b : alfa;
c : s_t
end;
a2 = array (1..3) of r2;
var v2,v3 : a2 := a2( r2(1,'ab',(.15.)), r2(2,'cd',(.15,31.)),
r2(3,'cd',(.15,31,63.)));
rf : reference;
begin
if x=y then;
if v2=v3 then;
lock rf as h : record a,b,c:integer end do;
(*$4 1 0*) (*$4 2 0*) (*$4 3 0*)
end.
%
\f
(*******************
* ep test 30 *
* test *
*******************)
process test;
type r1 = record a,b,c: 0..100 end;
a1 = array (1..2) of r1;
a2 = array (1..3) of a1;
var v : a2 := a2 (
a1( r1( 1,2,3 ), r1( 4,5,6 ) ),
a1( r1( 7,8,9 ), r1( 10,11,12) ),
a1( r1( 13,14,15), r1( 16,17,18 ) )
);
begin
(*$4 1 0*) (*$4 6 0*) (*$4 10 1*)
end.
%
▶EOF◀