lang/pc/test/tstenc.p

   1 {
   2   (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
   3
   4            This product is part of the Amsterdam Compiler Kit.
   5
   6   Permission to use, sell, duplicate or disclose this software must be
   7   obtained in writing. Requests for such permissions may be sent to
   8
   9        Dr. Andrew S. Tanenbaum
  10        Wiskundig Seminarium
  11        Vrije Universiteit
  12        Postbox 7161
  13        1007 MC Amsterdam
  14        The Netherlands
  15
  16 }
  17 program tstenc(output);
  18 const   rcsversion='$Id: tstenc.p,v 2.2 1994/06/24 12:37:08 ceriel Exp $';
  19         trapno=150;
  20 var     level:integer;
  21         beenhere:boolean;
  22         e:integer;
  23 procedure trap(erno:integer); extern;
  24 procedure encaps(procedure p;procedure q(erno:integer)); extern;
  25 procedure p1;
  26     label   1;
  27     var     plevel:integer;
  28     procedure p2;
  29         var     plevel:integer;
  30         begin plevel:=3 ; trap(trapno) ;
  31           writeln('executing unreachable code in p2') ; e:=e+1 ;
  32         end;
  33    procedure q2(no:integer);
  34         var     qlevel:integer;
  35         begin qlevel:=-3 ;
  36           if no<>trapno then
  37             begin writeln('wrong trapno ',no,' in q2'); e:=e+1 end ;
  38           if plevel<>2 then
  39             begin writeln('wrong level ',plevel,' in q2'); e:=e+1 end ;
  40           trap(trapno) ;
  41           goto 1;
  42           writeln('executing unreachable code in q2') ; e:=e+1 ;
  43         end;
  44     begin plevel:=2 ;  encaps(p2,q2) ;
  45       writeln('executing unreachable code in p1'); e:=e+1;
  46 1:    if plevel<>2 then
  47         begin writeln('wrong level ', plevel, 'in p1') ; e:=e+1 end ;
  48       beenhere:=true ;
  49     end; { body of p1 }
  50 procedure q1(no:integer);
  51     var     qlevel:integer;
  52     begin qlevel:=-2 ;
  53       if no<>trapno then
  54         begin writeln('wrong trapno ',no,' in q1'); e:=e+1 end ;
  55       if level<>1 then
  56         begin writeln('wrong level ',level,' in q1'); e:=e+1 end ;
  57     end;
  58 begin
  59   level:=1 ;
  60   e:=0 ;
  61   beenhere:=false ;
  62   encaps(p1,q1);
  63   if not beenhere then
  64     begin writeln('illegaly skipped code in p1') ; e:=e+1 end;
  65   if e=0 then writeln('encaps OK')
  66 end.