DataMuseum.dk

top - metrics - download

    Length: 6144 (0x1800)
    Types: TextFile
    Names: »timetestjob«

└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system
    └─⟦72244f0ef⟧ 
        └─⟦this⟧ »timetestjob« 

TextFile

job hj 4 200 time 11 0 area 10 size 100000
( mode list.yes
source = copy 25.1
timetestlst = set 1 disc1
timetestlst = indent source mark lc
liste = cross timetestlst
o errors
pascal80 alarmenv source
lookup pass6code
if ok.yes
  timetestbin = move pass6code
o c
timetestlst = copy liste errors
scope user timetestlst
finis
)
\f


(*     test of timeout module     *)
(*     ----------------------     *)

process tssupervisor (
opsem : sempointer;
var sem: !ts_pointer_vector );

type

modulref= 1..timeout_l;
table = array (modulref) of integer;

const

version = "vers  2.00 /";
ok= 1;
error= 2;
wrong = 3;
wrobj = 4;
wrix  = 5;
unknown= 6;
save= 3;       (*  readstatus  *)
long= 8*60*60;
my_ident = 10;
modules = timeout_l;
interval = table ( 7, 5, 3, (timeout_l-3)*** 10);
microadr = table ( 2, 256, 32, (timeout_l-3)*** 10 );
netc = 1;
ath = 2;
vch = 3;

var

i: integer;          (*  test case   *)
console: zone;             (*  for operator messages   *)
ans: integer;              (*  u2 in answers           *)
sav,                       (*  save message            *)
mes: reference;
modul: modulref;
tim,
msg : array (modulref) of reference;      (*  1 for each module  *)
u_pool: pool modules of updates;
t_pool: pool modules+1 of timers;
answer: semaphore;


procedure opmess ( text: alfa; int: integer);
(*  writes the text and the integer value on operator console  *)
begin
testout ( console, text, int )
end;

procedure delay ( n: integer );
begin
lock sav as buf: timers do buf.object:= n;
signal ( sav, sem(timeout_sem_no).s^);
wait ( sav, sem(tssup_sem_no).w^);
if sav^.u2 <> ok then opmess ('** save ans ', sav^.u2);
end;


(*-------------------- main program -------------------------*)

begin

testopen ( console, own.incname, opsem);
opmess ('test timer  ', 7160 );

(*----------------------- unknown ---------------------------*)

alloc ( sav, t_pool, sem(tssup_sem_no).s^);
sav^.u1:= 17;
sav^.u2:= 27;
sav^.u3:= 37;
sav^.u4:= 47;
signal ( sav, sem(timeout_sem_no).s^);
wait ( sav, sem(tssup_sem_no).w^);
if sav^.u2 <> unknown then opmess ('**not unknow', sav^.u2);

(*----------------------- save ----------------------------*)

opmess ( '  save      ', 1001);
sav^.u1:= save;
delay ( -4 );
opmess ('  save    - ', 4);
delay (  0 );
opmess ('  save      ', 0);
delay(  2 );
opmess ('  save      ', 2);

(*---------------------- book --------------------------*)


for modul:= 1 to timeout_l do
begin
alloc ( tim(modul),  t_pool, sem(tssup_sem_no).s^ );
alloc ( msg(modul), u_pool, answer);
msg(modul)^.u3:= my_ident;
opmess ('allock      ',modul);
timerbook ( msg(modul), tim(modul), -1, microadr(modul), sem(timeout_sem_no).s^, answer );
if modul < 6 then
opmess ('book        ', msg(modul)^.u2);
if msg(modul)^.u2 <> ok then opmess ('**bookerror ', msg(modul)^.u2);
end;
(*  now timeout will never happen ( negative ticks )   *)
opmess ('book ok     ', 1002);

(*--------------- time out -----------------------------*)

opmess ('timer fr vch', interval(vch));
timerupdate ( msg(vch), interval(vch), sem(timeout_sem_no).s^, answer );
if msg(vch)^.u3 <> my_ident then opmess ('**ident     ', msg(vch)^.u3);
(* now timeout may happen for vch          *)
wait ( mes, sem(tssup_sem_no).w^ );
if mes^.u3 <> tim_route then opmess ('**route     ', mes^.u3);
lock mes as buf: timers do
begin
opmess ('object      ', buf.object);
end;

(*----------------- book 0 -------------------*)

timerbook ( msg(vch), mes, 0, microadr(vch), sem(timeout_sem_no).s^, answer );
wait ( mes, sem(tssup_sem_no).w^);
ans:= msg(vch)^.u2;
lock mes as buf: timers do
begin
opmess ('timer atonce', ans);
opmess ('object      ', buf.object);
end;

(*-------------------- wrong index ------------------------*)

timerbook ( msg(vch), mes, long, microadr(vch), sem(timeout_sem_no).s^, answer );
opmess ('  test index', 1003);
             (*  index out of range     *)
lock msg(vch) as buf: updates do buf.index:= buf.index+777;
timerupdate ( msg(vch), long, sem(timeout_sem_no).s^, answer );
ans:= msg(vch)^.u2;
if ans <> wrix then opmess ('**not index ', ans);
lock msg(vch) as buf: updates do buf.index:= buf.index-777;
timerupdate ( msg(vch), long, sem(timeout_sem_no).s^, answer );
ans:= msg(vch)^.u2;
if ans <> ok then opmess ('**not ok    ', ans);
             (*  index not correct      *)
lock msg(vch) as buf: updates do buf.index:= buf.index-1;
timerupdate ( msg(vch), long, sem(timeout_sem_no).s^, answer );
ans:= msg(vch)^.u2;
if ans <> wrix then opmess ('**not error5', ans);
lock msg(vch) as buf: updates do buf.index:= buf.index+1;
timerupdate ( msg(vch), long, sem(timeout_sem_no).s^, answer );
ans:= msg(vch)^.u2;
if ans <> ok then opmess ('** not ok3  ', ans );

(*----------------- wrong object -------------------------*)

lock msg(vch) as buf: updates do buf.object:= 77;
opmess ('wrong object', 1004);
timerupdate ( msg(vch), long, sem(timeout_sem_no).s^, answer );
ans:= msg(vch)^.u2;
if ans <> wrobj then opmess ('**not error4', ans);
lock msg(vch) as buf: updates do buf.object:= microadr(vch);
timerupdate ( msg(vch), long, sem(timeout_sem_no).s^, answer );
ans:= msg(vch)^.u2;

if ans <> ok then opmess ('** not ok   ', ans);

(*--------------------- array full -------------------------*)

delay ( 4);
delay ( 1 );

timerupdate ( msg(ath), 0, sem(timeout_sem_no).s^, answer);       (*  release entry    *)
wait ( mes, sem(tssup_sem_no).w^ );
delay ( 2 );                      (*  now ok           *)




opmess ('  end test  ', 1005);


end .
▶EOF◀