home *** CD-ROM | disk | FTP | other *** search
/ ftp.ee.pdx.edu / 2014.02.ftp.ee.pdx.edu.tar / ftp.ee.pdx.edu / pub / users / Harry / compilers / p11 / tst / local.pcat < prev    next >
Text File  |  2006-03-05  |  4KB  |  118 lines
  1. (* This program tests access to locals, formals, and non-locals. *)
  2.  
  3. program is
  4.  
  5.   var x1: integer := 100;
  6.       x2: integer := 200;
  7.       x3: integer := 300;
  8.       a: integer := 1000;
  9.       b: integer := 1100;
  10.       d: integer := 1200;
  11.  
  12.   procedure foo1 (b,c: integer) is
  13.     var x2: integer := 400;
  14.         y1: integer := 500;
  15.         y2: integer := 600;
  16.  
  17.     procedure foo2 (c,d: integer) is
  18.       var x3: integer := 700;
  19.           y2: integer := 800;
  20.           z1: integer := 900;
  21.  
  22.       begin (*foo2*)
  23.         x1 := x1 + 1;
  24.         x2 := x2 + 1;
  25.         x3 := x3 + 1;
  26.         y1 := y1 + 1;
  27.         y2 := y2 + 1;
  28.         z1 := z1 + 1;
  29.         a  := a + 1;
  30.         b  := b + 1;
  31.         c  := c + 1;
  32.         d  := d + 1;
  33.  
  34.         write ("=== foo2 ===");
  35.  
  36.         write ("x1 = ", x1);
  37.         if (x1 <> 103) then write ("*****  Error: should be 103  *****"); end;
  38.         write ("x2 = ", x2);
  39.         if (x2 <> 402) then write ("*****  Error: should be 402  *****"); end;
  40.         write ("x3 = ", x3);
  41.         if (x3 <> 701) then write ("*****  Error: should be 701  *****"); end;
  42.         write ("y1 = ", y1);
  43.         if (y1 <> 502) then write ("*****  Error: should be 502  *****"); end;
  44.         write ("y2 = ", y2);
  45.         if (y2 <> 801) then write ("*****  Error: should be 801  *****"); end;
  46.         write ("z1 = ", z1);
  47.         if (z1 <> 901) then write ("*****  Error: should be 901  *****"); end;
  48.         write ("a  = ", a);
  49.         if (a  <> 1003) then write ("*****  Error: should be 1003  *****"); end;
  50.         write ("b  = ", b);
  51.         if (b  <> 1302) then write ("*****  Error: should be 1302  *****"); end;
  52.         write ("c  = ", c);
  53.         if (c  <> 1501) then write ("*****  Error: should be 1501  *****"); end;
  54.         write ("d  = ", d);
  55.         if (d  <> 1601) then write ("*****  Error: should be 1601  *****"); end;
  56.         return;
  57.       end;
  58.  
  59.     begin (*foo1*)
  60.       x1 := x1 + 1;
  61.       x2 := x2 + 1;
  62.       x3 := x3 + 1;
  63.       y1 := y1 + 1;
  64.       y2 := y2 + 1;
  65.       a  := a + 1;
  66.       b  := b + 1;
  67.       c  := c + 1;
  68.       d  := d + 1;
  69.  
  70.       foo2 (1500,1600);
  71.  
  72.       write ("=== foo1 ===");
  73.       write ("x1 = ", x1);
  74.       if (x1 <> 103) then write ("*****  Error: should be 103  *****"); end;
  75.       write ("x2 = ", x2);
  76.       if (x2 <> 402) then write ("*****  Error: should be 402  *****"); end;
  77.       write ("x3 = ", x3);
  78.       if (x3 <> 302) then write ("*****  Error: should be 302  *****"); end;
  79.       write ("y1 = ", y1);
  80.       if (y1 <> 502) then write ("*****  Error: should be 502  *****"); end;
  81.       write ("y2 = ", y2);
  82.       if (y2 <> 601) then write ("*****  Error: should be 601  *****"); end;
  83.       write ("a  = ", a);
  84.       if (a  <> 1003) then write ("*****  Error: should be 1003  *****"); end;
  85.       write ("b  = ", b);
  86.       if (b  <> 1302) then write ("*****  Error: should be 1302  *****"); end;
  87.       write ("c  = ", c);
  88.       if (c  <> 1401) then write ("*****  Error: should be 1401  *****"); end;
  89.       write ("d  = ", d);
  90.       if (d  <> 1202) then write ("*****  Error: should be 1202  *****"); end;
  91.       return;
  92.     end;
  93.  
  94.   begin  (*main*)
  95.     x1 := x1 + 1;
  96.     x2 := x2 + 1;
  97.     x3 := x3 + 1;
  98.     a := a + 1;
  99.     b := b + 1;
  100.     d := d + 1;
  101.  
  102.     foo1 (1300,1400);
  103.  
  104.     write ("=== main ===");
  105.     write ("x1 = ", x1);
  106.     if (x1 <> 103) then write ("*****  Error: should be 103  *****"); end;
  107.     write ("x2 = ", x2);
  108.     if (x2 <> 201) then write ("*****  Error: should be 201  *****"); end;
  109.     write ("x3 = ", x3);
  110.     if (x3 <> 302) then write ("*****  Error: should be 302  *****"); end;
  111.     write ("a  = ", a);
  112.     if (a  <> 1003) then write ("*****  Error: should be 1003  *****"); end;
  113.     write ("b  = ", b);
  114.     if (b  <> 1101) then write ("*****  Error: should be 1101  *****"); end;
  115.     write ("d  = ", d);
  116.     if (d  <> 1202) then write ("*****  Error: should be 1202  *****"); end;
  117.   end;
  118.