with generic_primitive_functions;
with text_io;  use text_io;
procedure testprim is
-- 
   overflow_error: exception renames numeric_error;
   type real is digits 6;
   type long_real is digits 9;
   package primf is new generic_primitive_functions( real, integer);  use primf;
   package fio is new text_io.float_io( long_real);
   package iio is new text_io.integer_io( integer);  use iio;
   package eio is new text_io.enumeration_io( boolean);  use eio;
   x: real;
   scale1: constant integer := 9;
   scale2: constant integer := -2;
   
   procedure fput (r: in real) is
   begin
      fio.put( long_real( r), 2, long_real'digits + 3, 3);
   end fput;
   
   procedure fget (r: out real) is
      lr: long_real;
   begin
      fio.get( lr);
      r := real( lr);
   end fget;

begin
   put( "interactive test of primitive_functions");  new_line;
   put( "defaults for scale1 and scale2 are ");
   put( scale1);  put( scale2);  new_line;
   
   loop 
      put( "enter arg x");  new_line;
      fget( x);
      put( "x= ");  fput( x);  new_line;
      
      begin
      	 put( "exponent( x)= ");
	 put( exponent( x));
      exception
      	 when overflow_error =>
	    put( "overflow");
	 when constraint_error =>
	    put( "constraint_error");
      end;
      new_line;

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

      begin
      	 put( "scale( x, scale1)= ");
	 fput( scale( x, scale1));
      exception
      	 when overflow_error =>
	    put( "overflow");
	 when constraint_error =>
	    put( "constraint_error");
      end;
      new_line;

      begin
      	 put( "scale( x, scale2)= ");
	 fput( scale( x, scale2));
      exception
      	 when overflow_error =>
	    put( "overflow");
	 when constraint_error =>
	    put( "constraint_error");
      end;
      new_line;

      begin
      	 put( "odd( x)= ");
	 put( odd( x));
      exception
      	 when overflow_error =>
	    put( "overflow");
	 when constraint_error =>
	    put( "constraint_error");
      end;
      new_line;

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

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

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

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

   end loop;
end testprim;