ack/lang/pc/test/tstenc.p
1984-07-12 13:50:44 +00:00

66 lines
1.8 KiB
OpenEdge ABL

{
(c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
This product is part of the Amsterdam Compiler Kit.
Permission to use, sell, duplicate or disclose this software must be
obtained in writing. Requests for such permissions may be sent to
Dr. Andrew S. Tanenbaum
Wiskundig Seminarium
Vrije Universiteit
Postbox 7161
1007 MC Amsterdam
The Netherlands
}
program tstenc(output);
const trapno=150;
var level:integer;
beenhere:boolean;
e:integer;
procedure trap(erno:integer); extern;
procedure encaps(procedure p;procedure q(erno:integer)); extern;
procedure p1;
label 1;
var plevel:integer;
procedure p2;
var plevel:integer;
begin plevel:=3 ; trap(trapno) ;
writeln('executing unreachable code in p2') ; e:=e+1 ;
end;
procedure q2(no:integer);
var qlevel:integer;
begin qlevel:=-3 ;
if no<>trapno then
begin writeln('wrong trapno ',no,' in q2'); e:=e+1 end ;
if plevel<>2 then
begin writeln('wrong level ',plevel,' in q2'); e:=e+1 end ;
trap(trapno) ;
goto 1;
writeln('executing unreachable code in q2') ; e:=e+1 ;
end;
begin plevel:=2 ; encaps(p2,q2) ;
writeln('executing unreachable code in p1'); e:=e+1;
1: if plevel<>2 then
begin writeln('wrong level ', plevel, 'in p1') ; e:=e+1 end ;
beenhere:=true ;
end; { body of p1 }
procedure q1(no:integer);
var qlevel:integer;
begin qlevel:=-2 ;
if no<>trapno then
begin writeln('wrong trapno ',no,' in q1'); e:=e+1 end ;
if level<>1 then
begin writeln('wrong level ',level,' in q1'); e:=e+1 end ;
end;
begin
level:=1 ;
e:=0 ;
beenhere:=false ;
encaps(p1,q1);
if not beenhere then
begin writeln('illegaly skipped code in p1') ; e:=e+1 end;
if e=0 then writeln('encaps OK')
end.