lang/pc/test/tstgto.p

   1 program tstgto(output);
   2 type int=integer;
   3      pint=^integer;
   4 var ga0,ga1,ga2,ga3,ga4,ga5:int;
   5     gp0,gp1,gp2,gp3,gp4,gp5:pint;
   6
   7 procedure level0(a1,a2:int;p1,p2:pint);
   8 label 1;
   9 var a3,a4,a5:int;p3,p4,p5:pint;
  10
  11 procedure level1(a1,a2:int;p1,p2:pint);
  12 var a3,a4,a5:int;p3,p4,p5:pint;
  13
  14 procedure level2(a1,a2:int;p1,p2:pint);
  15 var a3,a4,a5:int;p3,p4,p5:pint;
  16 begin
  17   a1:= -5;a2:=a1;a3:=a2;a4:=a3;a5:=a4;
  18   a1:= -4;a2:=a1;a3:=a2;a4:=a3;
  19   a1:= -3;a2:=a1;a3:=a2;
  20   a1:= -2;a2:=a1;
  21   a1:=a5+a5;a1:= -1;
  22   p1:=gp0;p2:=p1;p3:=p2;p4:=p3;p5:=p4;
  23   p1:=gp1;p2:=p1;p3:=p2;p4:=p3;
  24   p1:=gp2;p2:=p1;p3:=p2;
  25   p1:=gp3;p2:=p1;
  26   p1:=p5;p1:=gp4;
  27   goto 1;
  28 end; { level 2 }
  29
  30 begin
  31   a1:=ga4;a2:=a1;a3:=a2;a4:=a3;a5:=a4;
  32   a1:=ga3;a2:=a1;a3:=a2;a4:=a3;
  33   a1:=ga2;a2:=a1;a3:=a2;
  34   a1:=ga1;a2:=a1;
  35   a1:=ga0;
  36   p1:=gp4;p2:=p1;p3:=p2;p4:=p3;p5:=p4;
  37   p1:=gp3;p2:=p1;p3:=p2;p4:=p3;
  38   p1:=gp2;p2:=p1;p3:=p2;
  39   p1:=gp1;p2:=p1;
  40   p1:=gp0;
  41   level2(a5,a4,p5,p4);
  42   writeln('Error, goto failed');
  43 end; { level 1 }
  44
  45 begin
  46   a1:=ga5;a2:=a1;a3:=a2;a4:=a3;a5:=a4;
  47   a1:=ga4;a2:=a1;a3:=a2;a4:=a3;
  48   a1:=ga3;a2:=a1;a3:=a2;
  49   a1:=ga2;a2:=a1;
  50   a1:=ga1;
  51   p1:=gp5;p2:=p1;p3:=p2;p4:=p3;p5:=p4;
  52   p1:=gp4;p2:=p1;p3:=p2;p4:=p3;
  53   p1:=gp3;p2:=p1;p3:=p2;
  54   p1:=gp2;p2:=p1;
  55   p1:=gp1;
  56   level1(a5,a4,p5,p4);
  57   writeln('Error, goto failed');
  58 1:
  59   if (a1 <> ga1) then writeln('level0:a1 has wrong value');
  60   if (a2 <> ga2) then writeln('level0:a2 has wrong value');
  61   if (a3 <> ga3) then writeln('level0:a3 has wrong value');
  62   if (a4 <> ga4) then writeln('level0:a4 has wrong value');
  63   if (a5 <> ga5) then writeln('level0:a5 has wrong value');
  64   if (p1 <> gp1) then writeln('level0:p1 has wrong value');
  65   if (p2 <> gp2) then writeln('level0:p2 has wrong value');
  66   if (p3 <> gp3) then writeln('level0:p3 has wrong value');
  67   if (p4 <> gp4) then writeln('level0:p4 has wrong value');
  68   if (p5 <> gp5) then writeln('level0:p5 has wrong value');
  69 end; { level 0 }
  70
  71 begin
  72   ga0:=0;ga1:=1;ga2:=2;ga3:=3;ga4:=4;ga5:=5;
  73   new(gp0);new(gp1);new(gp2);new(gp3);new(gp4);new(gp5);
  74   level0(ga5,ga4,gp5,gp4);
  75 end.