home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Unsorted BBS Collection
/
thegreatunsorted.tar
/
thegreatunsorted
/
programming
/
misc_programming
/
MATH
/
TGEF.A
< prev
Wrap
Text File
|
1990-11-01
|
8KB
|
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;