home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / open / pascom.lzh / FACILIS.ZIP / TEST.PAS < prev    next >
Pascal/Delphi Source File  |  1985-03-05  |  14KB  |  646 lines
  1. program test(input,output);
  2.  
  3.  
  4. {    Pascal Compiler Test Program
  5.      Version 1.1
  6.  
  7.      Written by John R. Naleszkiewicz
  8.      Date: October 19, 1984
  9.    Update: January 15, 1985   }
  10.  
  11. const
  12.      start = 10;
  13.      finish = 50;
  14.  
  15. type
  16.      rec = record
  17.              f1 : integer;
  18.              f2 : real;
  19.              f3 : boolean;
  20.              f4 : array[1 .. 3] of char;
  21.            end;
  22.  
  23. var
  24.     fail : boolean;
  25.      i,j : integer;
  26.      x,y : real;
  27.      b,f : boolean;
  28.      c,h : char;
  29.      ain : array[0 .. 10] of integer;
  30.      arl : array[start .. finish] of real;
  31.      abl : array[-5 .. 5] of boolean;
  32.      ach : array[1 .. 25] of char;
  33.  
  34.      alist,blist : rec;
  35.  
  36.  
  37. procedure ptest1;
  38. var
  39.   i : integer;
  40.   x : real;
  41.   begin
  42.     writeln('called');
  43.     i := -10;
  44.     x := -15.0
  45.   end; { ptest1 }
  46.  
  47. procedure ptest2(i : integer; x : real; var j : integer; var y : real);
  48.   begin
  49.     writeln('called');
  50.     if i<>10 then
  51.       writeln('    Call by value integer passed incorrectly (P)');
  52.     if x<>10.0 then
  53.       writeln('    Call by value real passed incorrectly (P)');
  54.     if j<>25 then
  55.       writeln('    Call by reference integer passed incorrectly (P)');
  56.     if y<>25.0 then
  57.       writeln('    Call by reference real passed incorrectly (P)');
  58.     j := j - 1;
  59.     y := y - 1.0
  60.   end; { ptest2 }
  61.  
  62. procedure ptest3(i : integer);
  63.   begin
  64.     write(i:1);
  65.     if i>0 then
  66.       ptest3(i-1)
  67.   end; { ptest3 }
  68.  
  69. function ftest1(k : integer; z : real): integer;
  70.   begin
  71.     writeln('called');
  72.     if k<>0 then
  73.       writeln('    Call by reference integer passed incorrectly (F)');
  74.     if z<>75.0 then
  75.       writeln('    Call by reference real passed incorrectly (F)');
  76.     ftest1 := 100
  77.   end; { ftest1 }
  78.  
  79. function ftest2(m : integer): integer;
  80.   begin
  81.     if m>0 then
  82.       ftest2 := ftest2(m-1) + 2
  83.     else
  84.       ftest2 := 0;
  85.     write(m:1)
  86.   end; { ftest2 }
  87.  
  88.  
  89. begin  { main program }
  90.   writeln;
  91.   writeln('Pascal Compiler Test Program -- Version 1.1');
  92.   writeln;
  93.  
  94.   fail := false;
  95.   writeln('If statement and logical tests (P=pass, F=fail)');
  96.   write('  Simple logical test (PP):');
  97.   if true then
  98.     write('P')
  99.   else
  100.     write('F');
  101.   if false then
  102.     writeln('F')
  103.   else
  104.     writeln('P');
  105.   write('  Logical NOT test (PP):');
  106.   if not true then
  107.     write('F')
  108.   else
  109.     write('P');
  110.   if not false then
  111.     writeln('P')
  112.   else
  113.     writeln('F');
  114.   write('  Logical AND test (PPP):');
  115.   if true and true then
  116.     write('P')
  117.   else
  118.     write('F');
  119.   if true and false then
  120.     write('F')
  121.   else
  122.     write('P');
  123.   if false and false then
  124.     writeln('F')
  125.   else
  126.     writeln('P');
  127.   write('  Logical OR test (PPP):');
  128.   if true or true then
  129.     write('P')
  130.   else
  131.     write('F');
  132.   if true or false then
  133.     write('P')
  134.   else
  135.     write('F');
  136.   if false or false then
  137.     writeln('F')
  138.   else
  139.     writeln('P');
  140.   write('  Logical comparison tests = <> < > <= >= (PPPPPPPP):');
  141.   if 10 = 10 then
  142.     write('P')
  143.   else
  144.     write('F');
  145.   if 10 <> 1 then
  146.     write('P')
  147.   else
  148.     write('F');
  149.   if 1 < 10 then
  150.     write('P')
  151.   else
  152.     write('F');
  153.   if 10 > 1 then
  154.     write('P')
  155.   else
  156.     write('F');
  157.   if 10 <= 10 then
  158.     write('P')
  159.   else
  160.     write('F');
  161.   if 1 <= 10 then
  162.     write('P')
  163.   else
  164.     write('F');
  165.   if 10 >= 10 then
  166.     write('P')
  167.   else
  168.     write('F');
  169.   if 10 >= 1 then
  170.     writeln('P')
  171.   else
  172.     writeln('F');
  173.  
  174.   writeln;
  175.   write('Enter "C" <return> to continue');
  176.   read(c);
  177.   writeln;
  178.   writeln;
  179.  
  180.   writeln('Variable assignment tests');
  181.   writeln('  Simple variable assignment tests');
  182.   i := 10;
  183.   writeln('  Integer stored:    10, contents: ',i:3);
  184.   j := i;
  185.   if j<>10 then
  186.     begin
  187.       write('    Integer assignment test failed, ');
  188.       writeln(j,' instead of 10');
  189.       fail := true
  190.     end;
  191.  
  192.   j := -i;
  193.   writeln('  Integer stored:   -10, contents: ',j:3);
  194.   if j<>-10 then
  195.     begin
  196.       write('    Integer negation test failed, ');
  197.       writeln(j,' instead of -10');
  198.       fail := true
  199.     end;
  200.  
  201.   x := 10.0;
  202.   writeln('  Real stored:  1.0000E+01, contents:',x);
  203.   y := x;
  204.   if y<>10.0 then
  205.     begin
  206.       write('    Floating point assignment failed, ');
  207.       writeln(y,' instead of 1.0000E+01');
  208.       fail := true
  209.     end;
  210.  
  211.   y := -x;
  212.   writeln('  Real stored: -1.0000E+01, contents:',y);
  213.   if y<>-10.0 then
  214.     begin
  215.       write('    Floating point negation failed, ');
  216.       writeln(y,' instead of -1.0000E+01');
  217.       fail := true
  218.     end;
  219.  
  220.   b := true;
  221.   f := b;
  222.   if not f then
  223.     begin
  224.       write('    Boolean assignment (true) failed, ');
  225.       writeln('false instead of true');
  226.       fail := true
  227.     end;
  228.  
  229.   b := false;
  230.   f := b;
  231.   if f then
  232.     begin
  233.       write('    Boolean assignment (false) failed, ');
  234.       writeln('true instead of false');
  235.       fail := true
  236.     end;
  237.  
  238.   c := 'x';
  239.   h := c;
  240.   if h<>'x' then
  241.     begin
  242.       write('    Character assignment failed, ');
  243.       writeln('result of "',h,'" instead of "x"');
  244.       fail := true
  245.     end;
  246.  
  247.  
  248.   writeln('  Array assignment tests');
  249.   ain[0] := 25;
  250.   ain[5] := ain[0];
  251.   if ain[5]<>25 then
  252.     begin
  253.       write('    Integer array assignment failed, ');
  254.       writeln(ain[5],' instead of 25');
  255.       fail := true
  256.     end;
  257.  
  258.   arl[25] := 1000.0;
  259.   arl[45] := arl[25];
  260.   if arl[45]<>1000.0 then
  261.     begin
  262.       write('    Floating point array assignment failed, ');
  263.       writeln(arl[45],' instead of 1.0000E+03');
  264.       fail := true
  265.     end;
  266.  
  267.   abl[-3] := true;
  268.   abl[3]  := abl[-3];
  269.   if not abl[3] then
  270.     begin
  271.       write('    Boolean array assignment (true) failed, ');
  272.       writeln('false instead of true');
  273.       fail := true
  274.     end;
  275.  
  276.   abl[0] := false;
  277.   abl[5] := abl[0];
  278.   if abl[5] then
  279.     begin
  280.       write('    Boolean array assignment (false) failed, ');
  281.       writeln('true instead of false');
  282.       fail := true
  283.     end;
  284.  
  285.   ach[10] := 'a';
  286.   ach[23] := ach[10];
  287.   if ach[23]<>'a' then
  288.     begin
  289.       write('    Character array assignment failed, ');
  290.       writeln('result of "',ach[23],'" instead of "a"');
  291.       fail := true
  292.     end;
  293.  
  294.  
  295.   writeln('  Record field assignment tests');
  296.   alist.f1 := 99;
  297.   alist.f2 := 12.5;
  298.   alist.f3 := true;
  299.   alist.f4[1] := 'a';
  300.   alist.f4[2] := 'b';
  301.   alist.f4[3] := alist.f4[1];
  302.   blist := alist;
  303.   if blist.f1<>99 then
  304.     begin
  305.       write('    Integer field assignment failed, ');
  306.       writeln(blist.f1,' instead of 99');
  307.       fail := true
  308.     end;
  309.  
  310.   if blist.f2<>12.5 then
  311.     begin
  312.       write('    Real field assignment failed, ');
  313.       writeln(blist.f2,' instead of 1.2500E+01');
  314.       fail := true
  315.     end;
  316.  
  317.   if not blist.f3 then
  318.     begin
  319.       write('    Boolean field assignment failed, ');
  320.       writeln('false instead of true');
  321.       fail := true
  322.     end;
  323.  
  324.   if blist.f4[3]<>'a' then
  325.     begin
  326.       write('    Character array field assignment failed, ');
  327.       writeln('result of "',blist.f4[3],'" instead of "a"');
  328.       fail := true
  329.     end;
  330.  
  331.  
  332.   writeln('Builtin function tests');
  333.   i := 3;
  334.   if not odd(i) then
  335.     begin
  336.       write('  Function odd(x) failed, ');
  337.       writeln(i,' was found to be even');
  338.       fail := true
  339.     end;
  340.  
  341.   i := 4;
  342.   if odd(i) then
  343.     begin
  344.       write('  Function odd(x) failed, ');
  345.       writeln(i,' was found to be odd');
  346.       fail := true
  347.     end;
  348.  
  349.   x := 1.77;
  350.   i := round(x);
  351.   j := trunc(x);
  352.   if i<>2 then
  353.     begin
  354.       write('  Function round(x) failed, ');
  355.       writeln(i,' instead of 2');
  356.       fail := true
  357.     end;
  358.   if j<>1 then
  359.     begin
  360.       write('  Function trunc(x) failed, ');
  361.       writeln(i,' instead of 1');
  362.       fail := true
  363.     end;
  364.  
  365.   i := -25;
  366.   j := abs(i);
  367.   if j <> 25 then
  368.     begin
  369.       write('  Function abs(integer) failed, ');
  370.       writeln(j,' instead of 25');
  371.       fail := true
  372.     end;
  373.  
  374.   i := 99;
  375.   j := abs(i);
  376.   if j <> 99 then
  377.     begin
  378.       write('  Function abs(integer) failed, ');
  379.       writeln(j,' instead of 99');
  380.       fail := true
  381.     end;
  382.  
  383.   x := -12.5;
  384.   y := abs(x);
  385.   if y <> 12.5 then
  386.     begin
  387.       write('  Function abs(real) failed, ');
  388.       writeln(y,' instead of 1.2500E+01');
  389.       fail := true
  390.     end;
  391.  
  392.   x := 112.5;
  393.   y := abs(x);
  394.   if y <> 112.5 then
  395.     begin
  396.       write('  Function abs(real) failed, ');
  397.       writeln(y,' instead of 1.1250E+02');
  398.       fail := true
  399.     end;
  400.  
  401.   i := 7;
  402.   j := sqr(i);
  403.   if j <> 49 then
  404.     begin
  405.       write('  Function sqr(integer) failed, ');
  406.       writeln(j,' instead of 49');
  407.       fail := true
  408.     end;
  409.  
  410.   x := 5.0;
  411.   y := sqr(x);
  412.   if y <> 25.0 then
  413.     begin
  414.       write('  Function sqr(real) failed, ');
  415.       writeln(y,' instead of 2.5000E+01');
  416.       fail := true
  417.     end;
  418.  
  419.   x := 729.0;
  420.   y := sqrt(x);
  421.   if y <> 27.0 then
  422.     begin
  423.       write('  Function sqrt(x) failed, ');
  424.       writeln(y,' instead of 2.7000E+01');
  425.       fail := true
  426.     end;
  427.  
  428.   x := exp(1.0);
  429.   y := ln(x);
  430.   if y<>1.0 then
  431.     begin
  432.       write('  Function exp(x) or ln(x) failed, ');
  433.       writeln(y,' instead of 1.0000E+00');
  434.       fail := true
  435.     end;
  436.  
  437.  
  438.   writeln('Arithmetic tests');
  439.   writeln('  Integer arithmetic tests');
  440.   i := 5 + 5;
  441.   j := i + 10;
  442.   j := j + i;
  443.   if j<>30 then
  444.     begin
  445.       write('    Addition failed, ');
  446.       writeln(j,' instead of 30');
  447.       fail := true
  448.     end;
  449.  
  450.   i := 20 - 8;
  451.   j := i - 10;
  452.   j := i - j;
  453.   if j<>10 then
  454.     begin
  455.       write('    Subtraction failed, ');
  456.       writeln(j,' instead of 10');
  457.       fail := true
  458.     end;
  459.  
  460.   i := 2 * 3;
  461.   j := i * 4;
  462.   j := j * i;
  463.   if j<>144 then
  464.     begin
  465.       write('    Multiplication failed, ');
  466.       writeln(j,' instead of 144');
  467.       fail := true
  468.     end;
  469.  
  470.   i := 100 div 5;
  471.   j := i div 10;
  472.   j := i div j;
  473.   if j<>10 then
  474.     begin
  475.       write('    Division failed, ');
  476.       writeln(j,' instead of 10');
  477.       fail := true
  478.     end;
  479.  
  480.   i := 102 mod 15;
  481.   j := i mod 7;
  482.   j := i mod j;
  483.   if j<>2 then
  484.     begin
  485.       write('    MOD failed, ');
  486.       writeln(j,' instead of 2');
  487.       fail := true
  488.     end;
  489.  
  490.   i := 10;
  491.   j := i + 7;
  492.   j := (j - i) * (i - 2 * j);
  493.   if j<>-168 then
  494.     begin
  495.       write('    Hierarchy failed, ');
  496.       writeln(j,' instead of -168');
  497.       fail := true
  498.     end;
  499.  
  500.   writeln('  Floating point arithmetic tests');
  501.   x := 1.0 / 3.0;
  502.   x := x * 3.0;
  503.   y := 1.0 - x;
  504.   if y=0.0 then
  505.     i := 99
  506.   else
  507.     i := round(-ln(y) / ln(10.0));
  508.   writeln('    Internal accuracy (digits): ',i:2);
  509.   x := 2.0 + 3.0;
  510.   y := x + 10.2;
  511.   y := y + x;
  512.   if y<>20.2 then
  513.     begin
  514.       write('    Addition failed, ');
  515.       writeln(y,' instead of 2.0200E+01');
  516.       fail := true
  517.     end;
  518.  
  519.   x := 20.0 - 8.7;
  520.   y := x - 10.3;
  521.   y := x - y;
  522.   if y<>10.3 then
  523.     begin
  524.       write('    Subtraction failed, ');
  525.       writeln(y,' instead of 1.0300E+01');
  526.       fail := true
  527.     end;
  528.  
  529.   x := 2.0 * 3.0;
  530.   y := x * 4.0;
  531.   y := y * x;
  532.   if y<>144.0 then
  533.     begin
  534.       write('    Multiplication failed, ');
  535.       writeln(y,' instead of 1.4400E+02');
  536.       fail := true
  537.     end;
  538.  
  539.   x := 100.0 / 5.0;
  540.   y := x / 10.0;
  541.   y := x / y;
  542.   if y<>10.0 then
  543.     begin
  544.       write('    Division failed, ');
  545.       writeln(y,' instead of 1.0000E+01');
  546.       fail := true
  547.     end;
  548.  
  549.   x := 10.0;
  550.   y := x + 7.0;
  551.   y := (y - x) * (x - 2.0 * y);
  552.   if y<>-168.0 then
  553.     begin
  554.       write('    Hierarchy failed, ');
  555.       writeln(y,' instead of -1.6800E+02');
  556.       fail := true
  557.     end;
  558.  
  559.  
  560.   writeln;
  561.   write('Enter "C" <return> to continue');
  562.   read(c);
  563.   writeln;
  564.   writeln;
  565.  
  566.   writeln('Procedure and function testing');
  567.   writeln('  Procedure call tests');
  568.   i := 0;
  569.   x := 10.0;
  570.   write('    Procedure 1 ');
  571.   ptest1;
  572.   if i<>0 then
  573.     begin
  574.       writeln('    Integer local variables damaging globals');
  575.       fail := true
  576.     end;
  577.   if x<>10.0 then
  578.     begin
  579.       writeln('    Real local variables damaging globals');
  580.       fail := true
  581.     end;
  582.  
  583.   j := 25;
  584.   y := 25.0;
  585.   write('    Procedure 2 ');
  586.   ptest2(10,10.0,j,y);
  587.   if j<>24 then
  588.     begin
  589.       writeln('    Call by reference integer not returned correctly');
  590.       fail := true
  591.     end;
  592.   if y<>24.0 then
  593.     begin
  594.       writeln('    Call by reference real not returned correctly');
  595.       fail := true
  596.     end;
  597.  
  598.   writeln('    Recursive procedure test (5..0)');
  599.   write('      ');
  600.   i := 5;
  601.   ptest3(i);
  602.   writeln;
  603.   if i<>5 then
  604.     begin
  605.       writeln('    Call by value in recursive test failed');
  606.       fail := true
  607.     end;
  608.  
  609.   writeln('  Function call tests');
  610.   i := 0;
  611.   x := 75.0;
  612.   write('    Function 1 ');
  613.   i := ftest1(i,x);
  614.   if i<>100 then
  615.     begin
  616.       writeln('    Function not returning correct value');
  617.       fail := true
  618.     end;
  619.  
  620.   writeln('    Recursive function  test (0..5)');
  621.   write('      ');
  622.   i := 5;
  623.   j := ftest2(i);
  624.   writeln;
  625.   if i<>5 then
  626.     begin
  627.       writeln('      Call by value in recursive function test failed');
  628.       fail := true
  629.     end;
  630.   if j<>10 then
  631.     begin
  632.       writeln('      Function not returning correct value during recursion');
  633.       fail := true
  634.     end;
  635.  
  636.  
  637.   writeln;
  638.   writeln('Testing complete');
  639.   if fail then
  640.     writeln('Errors Found')
  641.   else
  642.     writeln('No Errors Found')
  643.  
  644. end.
  645.  
  646.   writeln