home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / TPL60N14.ZIP / TESTPRGS.ZIP / PARANOIA.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-02-27  |  8.3 KB  |  252 lines
  1. {$a+,n-,x-,s-,i-,r-,b-,v-}
  2.  
  3.  
  4. (* Note: the statements "input: text;", "assign(input,'con:');",
  5.  *    and "reset(input);" appear below as comments; some version of
  6.  *    Pascal require you to activate one or more of these statements.
  7.  *
  8.  *  Some versions of TURBO Pascal (e.g. PC versions >= 4) require
  9.  *  splitting the following source into several "units".  The goo
  10.  *  between pairs of !! lines gives a way to do this.  If you have
  11.  *  this file on a UNIX system, you can simply pipe it through
  12.  *         sed /!!/d | /bin/sh
  13.  *  to create files mainvars.pas, unit1.pas, unit2.pas, and par.pas;
  14.  *  the first 3 are "units" needed in the fourth.  If using a UNIX
  15.  *  system is inconvenient, you can do the splitting by hand:
  16.  *  omit the lines that contain !! (that's what "sed /!!/d" does)
  17.  *  and put the lines between each "cat >..." and the following
  18.  *  "//GO.SYSIN DD" line into the file named on these lines.
  19.  *)
  20.  
  21.  
  22. program paranoia(input,output);
  23. uses mainvars, Unit1, Unit2;
  24.  
  25.    begin (*PARA*)
  26.    start;
  27.    mile2060;
  28.    mile70170;
  29.  
  30. {=============================================}
  31.    Milestone := 175;
  32. {=============================================}
  33.    writeln;
  34.    for Index := 1 to 3 do
  35.       begin
  36.       case Index of
  37.          1:
  38.             Z := UnderflowThreshold;
  39.          2:
  40.             Z := E0;
  41.          3:
  42.             Z := PseudoZero;
  43.          end;
  44.       if Z <> 0 then
  45.          begin
  46.          V9 := sqrt (Z);
  47.          Y := V9 * V9;
  48.          if (Y / (One - Radix * E9) < Z)
  49.                or (Y > (One + Radix * E9) * Z) then (* dgh: + E9 --> * E9 *)
  50.             begin
  51.             if V9 > U1 then
  52.                begin
  53.                NoErrors [SeriousDefect] := NoErrors [SeriousDefect] + 1;
  54.                write ('SERIOUS DEFECT:');
  55.                end
  56.             else
  57.                begin
  58.                NoErrors [Defect] := NoErrors [Defect] + 1;
  59.                write ('DEFECT:');
  60.                end;
  61.             writeln ('  Comparison alleges that what prints as Z = ', Z);
  62.             writeln ('is too far from sqrt(Z) ^ 2 = ', Y);
  63.             end;
  64.          end;
  65.       end;
  66.  
  67. {=============================================}
  68.    Milestone := 180;
  69. {=============================================}
  70.       for Index := 1 to 2 do
  71.          begin
  72.          if Index = 1 then
  73.             Z := V
  74.          else
  75.             Z := V0;
  76.          V9 := sqrt (Z);
  77.          X := (One - Radix * E9) * V9;
  78.          V9 := V9 * X;
  79.          if ((V9 < (One - Two * Radix * E9) * Z) or (V9 > Z)) then
  80.             begin
  81.             Y := V9;
  82.             if X < W then
  83.                begin
  84.                NoErrors [SeriousDefect] := NoErrors [SeriousDefect] + 1;
  85.                write ('SERIOUS ');
  86.                end
  87.             else
  88.                NoErrors [Defect] := NoErrors [Defect] + 1;
  89.             writeln ('DEFECT:  Comparison alleges that Z = ', Z);
  90.             writeln ('is too far from sqrt(Z) ^ 2 is: ', Y);
  91.             end;
  92.          end;
  93. {=============================================}
  94.    Milestone := 190;
  95. {=============================================}
  96.    Pause;
  97.    X := UnderflowThreshold * V;
  98.    Y := Radix * Radix;
  99.    if not ((X * Y >= One) and (X <= Y)) then
  100.       begin
  101.       if ((X * Y >= U1) and (X <= Y / U1)) then
  102.          begin
  103.          NoErrors [Flaw] := NoErrors [Flaw] + 1;
  104.          write ('FLAW:');
  105.          end
  106.       else
  107.          begin
  108.          NoErrors [Defect] := NoErrors [Defect] + 1;
  109.          write ('DEFECT: Badly');
  110.          end;
  111.       writeln (' unbalanced range; UnderflowThreshold * V = ');
  112.       writeln (X, ' is too far from 1 .');
  113.       end;
  114. {=============================================}
  115.    Milestone := 200;
  116. {=============================================}
  117. (*   for Index := 1 to 5 do
  118.       begin
  119.       X := F9;
  120.       case Index of
  121.          1:
  122.             begin { Dummy Body }
  123.             X := X;
  124.             end;
  125.          2:
  126.             X := One + U2;
  127.          3:
  128.             X := V;
  129.          4:
  130.             X := UnderflowThreshold;
  131.          5:
  132.             X := Radix;
  133.          end;
  134.       Y := X;
  135.       V9 := (Y / X - Half) - Half;
  136.       if V9 <> 0 then
  137.          begin
  138.          if (V9 = - U1) and (Index < 5) then
  139.             begin
  140.             NoErrors [Flaw] := NoErrors [Flaw] + 1;
  141.             write ('FLAW:');
  142.             end
  143.          else
  144.             begin
  145.             NoErrors [SeriousDefect] := NoErrors [SeriousDefect] + 1;
  146.             write ('SERIOUS DEFECT:');
  147.             end;
  148.          writeln ('  X / X differs from 1 when X = ', X);
  149.          writeln ('  instead, X / X - 1/2 - 1/2 = ', V9);
  150.          writeln;
  151.          end;
  152.       end;*)
  153. {=============================================}
  154.    Milestone := 210;
  155. {=============================================}
  156.    MyZero := 0;
  157.    writeln;
  158.    writeln ('What message and/or values does Division by Zero produce?')
  159.       ;
  160.    writeln ('This can interupt your program. You can ',
  161.          'skip this part if you wish.');
  162.    writeln ('Do you wish to compute 1 / 0? ');
  163.    readln (input);
  164.    read (input, ch);
  165.    if (ch = 'Y') or (ch = 'y') then
  166.       writeln ('Trying to compute 1 / 0 produces: ', One / MyZero)
  167.    else
  168.       writeln ('O.K.');
  169.    writeln ('Do you wish to compute 0 / 0?');
  170.    readln (input);
  171.    read (input, ch);
  172.    if (ch = 'Y') or (ch = 'y') then
  173.       writeln ('Trying to compute 0 / 0 produces: ', MyZero / MyZero)
  174.    else
  175.       writeln ('O.K.');
  176. {=============================================}
  177.    Milestone := 220;
  178. {=============================================}
  179.    Pause;
  180.    writeln;
  181.    if NoErrors[Failure] > 0 then begin
  182.       write ('The number of  FAILUREs  encountered =        ');
  183.       writeln (NoErrors [Failure]);
  184.       end;
  185.    if NoErrors[SeriousDefect] > 0 then begin
  186.       write ('The number of  SERIOUS DEFECTs  encountered = ');
  187.       writeln (NoErrors [SeriousDefect]);
  188.       end;
  189.    if NoErrors[Defect] > 0 then begin
  190.       write ('The number of  DEFECTs  encountered =         ');
  191.       writeln (NoErrors [Defect]);
  192.       end;
  193.    if NoErrors[Flaw] > 0 then begin
  194.       write ('The number of  FLAWs  encountered =           ');
  195.       writeln (NoErrors [Flaw]);
  196.       end;
  197.    if (NoErrors [Failure] + NoErrors [SeriousDefect] + NoErrors [Defect]
  198.          + NoErrors [Flaw]) > 0 then
  199.       begin
  200.       writeln;
  201.       if (NoErrors [Failure] + NoErrors [SeriousDefect] + NoErrors [
  202.             Defect] = 0) and (NoErrors [Flaw] > 0) then
  203.          begin
  204.          write ('The arithmetic diagnosed seems ');
  205.          writeln ('Satisfactory though flawed.');
  206.          end;
  207.       if (NoErrors [Failure] + NoErrors [SeriousDefect] = 0)
  208.             and ( NoErrors [Defect] > 0) then
  209.          begin
  210.          writeln ('The arithmetic diagnosed may be Acceptable');
  211.          writeln ('despite inconvenient Defects.');
  212.          end;
  213.          (* dgh: Defect --> SeriousDefect in next line *)
  214.       if (NoErrors [Failure] + NoErrors [SeriousDefect] > 0) then
  215.          begin
  216.          write ('The arithmetic diagnosed has ');
  217.          writeln ('unacceptable Serious Defects.');
  218.          end;
  219.       if (NoErrors [Failure] > 0) then
  220.          writeln ('Potentially fatal FAILURE may have spoiled this',
  221.                   ' program''s subsequent diagnoses.');
  222.       end
  223.    else
  224.       begin
  225.       writeln ('No failures, defects nor flaws have been discovered.');
  226.       if not ((RMult = Rounded) and (RDiv = Rounded)
  227.             and (RAddSub = Rounded) and (RSqrt = Rounded)) then
  228.          writeln ('The arithmetic diagnosed seems Satisfactory.')
  229.       else begin
  230.         if (StickyBit >= One)
  231.             and ((Radix - Two) * (Radix - Nine - One) = 0) then begin
  232.          write ('Rounding appears to conform to ');
  233.          write ('the proposed IEEE standard P');
  234.          if (Radix = Two)
  235.                and ((Precision - Four * Three * Two) * ( Precision -
  236.                TwentySeven - TwentySeven + One) = Zero) then
  237.             write ('754')
  238.          else
  239.             write ('854');
  240.          if IEEE then writeln('.')
  241.           else begin
  242.             writeln(',');
  243.             writeln ('except possibly for Double Rounding',
  244.                ' during Gradual Underflow.');
  245.             end;
  246.          end;
  247.         writeln ('The arithmetic diagnosed appears to be Excellent!')
  248.         end;
  249.       end;
  250.    writeln ('END OF TEST.');
  251.    end (* PARA *).
  252.