The Unsorted BBS Collection/thegreatunsorted.tar/thegreatunsorted/programming/misc_programming/MATH/TGEF.A

Text File | 1990-11-01 | 7.7 KB | 383 lines

with generic_elementary_functions;
with text_io;  use text_io;
with fio;

procedure testelem is

   overflow_error: exception renames numeric_error;

   type real is digits 6;
   subtype long_real is float;
   package ele is new generic_elementary_functions( real);  use ele;

   x       : real;
   defy    : real :=  5.0;
   defx    : real :=  7.0;
   defbase : real := 10.0;

   procedure fput (r: in real) is
   begin
      fio.put(long_real(r), 2, 14, 3);
   end fput;

   procedure fget (r: out real) is
      lr: long_real;
   begin
      fio.get(lr);
      r := real(lr);
   end fget;

begin
   put_line("Interactive test of elementary_functions.");
   put("  defx is ");  fput(defx);     new_line;
   put("  defy is ");  fput(defy);     new_line;
   put("  base is ");  fput(defbase);  new_line;
   new_line;

   loop
      loop
     begin
        put("Enter x? ");
        fget(x);
        put("                    x = ");  fput(x);  new_line;
        exit;
     exception
        when data_error =>
          skip_line;
          put_line("data_error");
     end;
      end loop;

      begin
     put("              sqrt(x) = ");
     fput(sqrt(x));
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

      begin
     put("               log(x) = ");
     fput(log(x));
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

      begin
     put("         log(x, base) = ");
     fput(log(x, defbase));
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

      begin
     put("               exp(x) = ");
     fput(exp(x));
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

      begin
     put("            base ** x = ");
     fput(defbase ** x);
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

      begin
     put("    (1.0 / base) ** x = ");
     fput((1.0 / defbase) ** x);
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

      begin
     put("               sin(x) = ");
     fput(sin(x));
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

      begin
     put("         sin(x, base) = ");
     fput(sin(x, defbase));
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

      begin
     put("               cos(x) = ");
     fput(cos(x));
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

      begin
     put("         cos(x, base) = ");
     fput(cos(x, defbase));
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

      begin
     put("               tan(x) = ");
     fput(tan(x));
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

      begin
     put("         tan(x, base) = ");
     fput(tan(x, defbase));
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

      begin
     put("               cot(x) = ");
     fput(cot(x));
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

      begin
     put("         cot(x, base) = ");
     fput(cot(x, defbase));
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

      begin
     put("            arcsin(x) = ");
     fput(arcsin(x));
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

      begin
     put("      arcsin(x, base) = ");
     fput(arcsin(x, defbase));
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

      begin
     put("            arccos(x) = ");
     fput(arccos(x));
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

      begin
     put("      arccos(x, base) = ");
     fput(arccos(x, defbase));
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

      begin
     put("            arctan(x) = ");
     fput(arctan(x));
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

      begin
     put("arctan(x, defx, base) = ");
     fput(arctan(x, defx, defbase));
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

      begin
     put("            arccot(x) = ");
     fput(arccot(x));
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

      begin
     put("arccot(x, defy, base) = ");
     fput(arccot(x, defy, defbase));
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

      begin
     put("              sinh(x) = ");
     fput(sinh(x));
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

      begin
     put("              cosh(x) = ");
     fput(cosh(x));
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

      begin
     put("              tanh(x) = ");
     fput(tanh(x));
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

      begin
     put("              coth(x) = ");
     fput(coth(x));
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

      begin
     put("           arcsinh(x) = ");
     fput(arcsinh(x));
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

      begin
     put("           arccosh(x) = ");
     fput(arccosh(x));
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

      begin
     put("           arctanh(x) = ");
     fput(arctanh(x));
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

      begin
     put("           arccoth(x) = ");
     fput(arccoth(x));
      exception
     when overflow_error =>
        put("overflow");
     when argument_error =>
        put("argument_error");
      end;
      new_line;

   end loop;
end testelem;