Edinburgh IMP77 Compiler - Version 8.4

    1  !* Program Name : ARRNAME
    2  
    3  !*   Title      :  XVIII  Integer Array Name Procedure Parameter Testing
    4  !*   Version    :  II
    5  !*   Date       :  24 August 1985
    6  !*   Description:  Checks that functions containg %integer %array %name     
    7  !*                 as parameters returns the correct values.               
    8  
    9  
   10  %begin
   11  
   12  %string(255) param    { Used to get input from CLI}
   13  
   14  %owninteger failures=0
   15  
   16  %ownintegerarray aa(1:10) = 1,2,3,4,5,6,7,8,9,10
   17  
   18  ! Three routines to chack the that the array is passed correctly
   19  %integerfn sigma(%integerarrayname a{(1:10)})
   20  %integer i,j=0
   21    j = j+a(i) %for i = 1,1,10
   22    %result = j
   23  %end
   24  
   25  %integerfn sigma2(%integerarrayname a{(1:10)})
   26  %integer i,j=0
   27    j = j+j+a(i) %for i = 1,1,10
   28    %result = j
   29  %end
   30  
   31  %integerfn sigma3(%integerarrayname a{(1:10)})
   32  %integer i,j=0
   33    j = j+j+j+a(i) %for i = 1,1,10
   34    %result = j
   35  %end
   36  
   37  ! Check that the values in the array can be changed
   38  %integerfn change(%integerarrayname a{(1:10)})
   39  %integer i,j=0
   40    a(i)=a(i)*2 %for i =1,1,10
   41    j=j+a(i) %for i= 3,1,9
   42    %result = j
   43  %end
   44  
   45  ! Check that the array is still changed when the
   46  ! previous function has finished.
   47  %integerfn Check(%integerarrayname a{(1:10)})
   48  %integer i,j=0
   49     %for i=1,1,10 %cycle
   50       j=j+1 %if a(i)=i*2
   51     %repeat
   52     %result = j
   53  %end
   54  
   55  ! routine that checks whether the above functions return the correct values
   56  !!%routine do(%integerfn f(%integerarrayname x{(1:10)}),
   57  !!            %integer res)
   58  
   59  %integer i, res
   60  
   61    %routine pass
   62      printstring(" Pass")
   63      New Line
   64    %end
   65    %routine fail
   66      printstring(" FAIL :")
   67      printstring(" Was expecting");write(res,1)
   68      printstring(" and got");write(i,1)
   69      New Line
   70      failures = failures+1
   71    %end
   72  
   73  !!  i = f(aa)
   74  !!  %if i = res %then pass %else fail
   75  !!%end
   76  
   77     ! Code to find out where the output is to be sent
   78     ! -----------------------------------------------
   79     ! Where the output goes to depends on the parameter after the
   80     ! name used to run the program.
   81     !                       Parameter   |   Result
   82     !                       ------------|-------------
   83     !                     No parameter  |  No output
   84     !                          "s"      |  The screen
   85     !                          "j"      |  "journal"
   86     !                     anything else |  file name entered
   87  
   88     ! NOTE THAT THIS CODE USES STRING COMPARISONS, WHICH MAY NOT HAVE BEEN
   89     ! TESTED YET. IF THE PROGRAM FAILS CHECK IT WAS NOT IN THIS PART.
   90  
   91     param=cliparam
   92     %if param = "" %then select output (2) %c
   93+    %else %if param="s" %or param="S" %then select output(1) %c
   94+    %else %if param="j" %or param="J" %then  %c
   95+       open output(2,"journal") %and select output (2) %c
   96+    %else open output(2,param) %and select output (2)
   97     
   98  
   99    New Line
  100    Print string ("Integer array names as parameters"); New Line
  101    Print string ("---------------------------------"); New Line
  102  
  103    !do(sigma,55)
  104    i = sigma(aa); res = 55
  105    %if i = res %then pass %else fail
  106  
  107    !do(sigma2,2036)
  108    i = sigma2(aa); res = 2036
  109    %if i = res %then pass %else fail
  110  
  111    !do(sigma3,44281)
  112    i = sigma3(aa); res = 44281
  113    %if i = res %then pass %else fail
  114  
  115    !do(change,84)
  116    i = change(aa); res = 84
  117    %if i = res %then pass %else fail
  118  
  119    !do(check,10)
  120    i = check(aa); res = 10
  121    %if i = res %then pass %else fail
  122  
  123  
  124  
  125  select output(1)
  126  write(failures,1);  printstring(" failure(s)");  newline
  127     
  128  %endofprogram

   73 Statements compiled