-- TEST_GCEF_UTILITIES support package for TEST_GCEF_1 and
--                                         TEST_GENERIC_PRESCRIBED_*
-- enhancements: make array where no exceptions expected
-- include 1/2 sqrt(large)-e   1/2 log(large)-e
--  1/2 all round, 2 all round


with TEST_MATH_LT_CONSTANTS;  -- common to real tests also
generic
  type FLOAT_TYPE is digits <>;
  type COMPLEX_TYPE is private;

  with function RE (X : COMPLEX_TYPE) return FLOAT_TYPE is <>;
  with function IM (X : COMPLEX_TYPE) return FLOAT_TYPE is <>;
  with function COMPOSE_FROM_CARTESIAN
                             (RE, IM : FLOAT_TYPE) return COMPLEX_TYPE is <>;
 
package TEST_GCEF_UTILITIES is

  -- some attributes used in tests
  EPSILON : constant FLOAT_TYPE := FLOAT_TYPE'EPSILON;
  LARGE : constant FLOAT_TYPE := FLOAT_TYPE'SAFE_LARGE;
  M_LARGE : constant FLOAT_TYPE := -LARGE;
  SMALL : constant FLOAT_TYPE := FLOAT_TYPE'SAFE_SMALL;
  INV_EPSILON : constant FLOAT_TYPE := 1.0/FLOAT_TYPE'EPSILON;

  -- some values in tests
  ONE_PLUS  : FLOAT_TYPE := 1.0 + EPSILON ;
  ONE_MINUS : FLOAT_TYPE := 1.0 - EPSILON ;
  PI        : constant := 3.14159_26535_89793_23846_26433_83279_50288_41971 ;
  E         : constant := 2.71828_18284_59045_23536_02874_71352_66249_77572 ;
  HALF_PI   : constant := PI / 2.0 ;
  TWO_PI    : constant := 2.0 * PI ;

  -- COMPLEX_TYPE constants
  COMPLEX_ZERO : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(0.0,0.0);
  COMPLEX_ONE : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(1.0,0.0);
  COMPLEX_I : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(0.0,1.0);

  ONE_ONE : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(1.0,1.0);
  ONE_M_ONE : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(1.0,-1.0);
  M_ONE_ONE : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(-1.0,1.0);
  M_ONE_M_ONE : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(-1.0,-1.0);

  REAL_ONE_PLUS : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(1.0+EPSILON,0.0);
  IMAG_ONE_PLUS : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(0.0,1.0+EPSILON);
  REAL_ONE_MINUS : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(1.0-EPSILON,0.0);
  IMAG_ONE_MINUS : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(0.0,1.0-EPSILON);

  ONE_ONE_PLUS : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(1.0+EPSILON,1.0+EPSILON);
  ONE_M_ONE_PLUS : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(1.0+EPSILON,1.0-EPSILON);
  M_ONE_ONE_PLUS : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(1.0-EPSILON,1.0+EPSILON);
  M_ONE_M_ONE_PLUS : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(1.0-EPSILON,1.0-EPSILON);

  REAL_LARGE : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(LARGE,0.0);
  IMAG_LARGE : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(0.0,LARGE);
  REAL_M_LARGE : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(-LARGE,0.0);
  IMAG_M_LARGE : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(0.0,-LARGE);

  LARGE_LARGE : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(LARGE,LARGE);
  LARGE_M_LARGE : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(LARGE,-LARGE);
  M_LARGE_LARGE : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(-LARGE,LARGE);
  M_LARGE_M_LARGE : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(-LARGE,-LARGE);

  REAL_SMALL : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(SMALL,0.0);
  IMAG_SMALL : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(0.0,SMALL);
  REAL_M_SMALL : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(-SMALL,0.0);
  IMAG_M_SMALL : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(0.0,-SMALL);

  SMALL_SMALL : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(SMALL,SMALL);
  SMALL_M_SMALL : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(SMALL,-SMALL);
  M_SMALL_SMALL : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(-SMALL,SMALL);
  M_SMALL_M_SMALL : COMPLEX_TYPE := COMPOSE_FROM_CARTESIAN(-SMALL,-SMALL);

  package LT_CONSTANTS is new TEST_MATH_LT_CONSTANTS(FLOAT_TYPE);

  procedure INITIAL;
  procedure PASSED( MESSAGE : STRING := "";
                    VALUE : COMPLEX_TYPE := COMPLEX_ZERO);
  procedure FAILED( MESSAGE : STRING;
                    VALUE : COMPLEX_TYPE := COMPLEX_ZERO);
  function SAFE_INTERVAL( Y : COMPLEX_TYPE;
                  REAL_NAME, IMAG_NAME : LT_CONSTANTS.TYPE_LT) return BOOLEAN;
  procedure FINAL( TEST_NUMBER : INTEGER);
end TEST_GCEF_UTILITIES;

with TEXT_IO; use TEXT_IO;
with TEST_GCEF_VARIABLES; use TEST_GCEF_VARIABLES;
package body TEST_GCEF_UTILITIES is

  package FLOAT_TYPE_IO is new TEXT_IO.FLOAT_IO(FLOAT_TYPE);
  use FLOAT_TYPE_IO; -- only used if failure, only in CHECK

  procedure INITIAL is
  begin
    DEFAULT_AFT := FLOAT_TYPE'DIGITS + 1;
    PUT(EPSILON); PUT_LINE(" is EPSILON per FLOAT_TYPE'EPSILON");
    PUT(LARGE);   PUT_LINE(" is LARGE per FLOAT_TYPE'SAFE_LARGE");
    PUT(FLOAT_TYPE'BASE'LAST); PUT_LINE(" is FLOAT_TYPE'BASE'LAST");
    PUT(M_LARGE); PUT_LINE(" is -LARGE per -FLOAT_TYPE'BASE'SAFE_LARGE");
    PUT(FLOAT_TYPE'BASE'FIRST); PUT_LINE(" is FLOAT_TYPE'BASE'FIRST");
    PUT(SMALL);   PUT_LINE(" is SMALL per FLOAT_TYPE'BASE'SAFE_SMALL");
  end INITIAL;
 
  procedure PASSED( MESSAGE : STRING := "";
                    VALUE : COMPLEX_TYPE := COMPLEX_ZERO) is
  begin
    PUT_LINE("++++PASSED " & MESSAGE);
    PUT     ("           ");
    PUT(RE(VALUE));
    PUT(IM(VALUE));
    NEW_LINE;
  end PASSED;
 
  procedure FAILED( MESSAGE : STRING;
                    VALUE : COMPLEX_TYPE := COMPLEX_ZERO) is
  begin
    ANY_FAIL := TRUE;
    PUT_LINE("----FAILED " & MESSAGE);
    PUT     ("           ");
    PUT(RE(VALUE));
    PUT(IM(VALUE));
    NEW_LINE;
  end FAILED;

  function SAFE_INTERVAL( Y : COMPLEX_TYPE;
                 REAL_NAME, IMAG_NAME : LT_CONSTANTS.TYPE_LT) return BOOLEAN is
    REAL_LEAD, REAL_TRAIL, REAL_MACHINE : FLOAT_TYPE;
    IMAG_LEAD, IMAG_TRAIL, IMAG_MACHINE : FLOAT_TYPE;
  begin
    LT_CONSTANTS.FIND_LT(REAL_NAME, REAL_LEAD, REAL_TRAIL, REAL_MACHINE);
    LT_CONSTANTS.FIND_LT(IMAG_NAME, IMAG_LEAD, IMAG_TRAIL, IMAG_MACHINE);
          --(Y-LEAD) is an exact subtraction that reduces the number
          --         of significant bits by at least 5, TRAIL has the 5
          --         extra significant bits
    if abs((RE(Y)-REAL_LEAD)-REAL_TRAIL) < EPSILON and then
       abs((IM(Y)-IMAG_LEAD)-IMAG_TRAIL) < EPSILON then
      return TRUE;
    else
      return FALSE;
    end if;
  end SAFE_INTERVAL;

  procedure FINAL( TEST_NUMBER : INTEGER ) is
  begin
    NEW_LINE;
    PUT("Generic Complex Elementary Functions specification compliance" &
        " test, part" & INTEGER'IMAGE(TEST_NUMBER) & ", ");
    if ANY_FAIL then
      PUT_LINE("FAILED");
    else
      PUT_LINE("PASSED");
    end if;
    NEW_LINE;
  end FINAL;

  function "/" ( X : FLOAT_TYPE ;
                 Z : COMPLEX_TYPE ) return COMPLEX_TYPE is
    R : FLOAT_TYPE ;
  begin
    if abs RE(Z) > abs IM(Z) then
      R := 1.0 + (IM(Z)/RE(Z))*
                 (IM(Z)/RE(Z));
      return COMPOSE_FROM_CARTESIAN ( (X/RE(Z))/R ,
             - ((X/RE(Z))*(IM(Z)/RE(Z)))/R ) ;
    else
      R := (RE(Z)/IM(Z))*
           (RE(Z)/IM(Z)) + 1.0;
      return COMPOSE_FROM_CARTESIAN(
               ((X/IM(Z))*(RE(Z)/IM(Z)))/R ,
              - (X/IM(Z))/R ) ;
    end if;
  exception
    when CONSTRAINT_ERROR | NUMERIC_ERROR =>
      if abs RE(Z) > abs IM(Z) then
        R := 1.0 + (IM(Z)/RE(Z))*
                   (IM(Z)/RE(Z));
        return COMPOSE_FROM_CARTESIAN ( (X/R)/RE(Z) ,
              - ((X/R)/RE(Z))*(IM(Z)/RE(Z)) ) ;
      else
        R := (RE(Z)/IM(Z))*
             (RE(Z)/IM(Z)) + 1.0;
        return COMPOSE_FROM_CARTESIAN (
                 ((X/R)/IM(Z))*(RE(Z)/IM(Z)) ,
                - (X/R)/IM(Z) ) ;
      end if;
  end "/";

end TEST_GCEF_UTILITIES;

with TEST_GCEF_UTILITIES;
with COMPLEX_TYPES; use COMPLEX_TYPES;
package TEST_COMPLEX_UTILITIES is new TEST_GCEF_UTILITIES(FLOAT,COMPLEX);

with TEST_GCEF_UTILITIES;
with LONG_COMPLEX_TYPES; use LONG_COMPLEX_TYPES;
package TEST_LONG_COMPLEX_UTILITIES is new
                TEST_GCEF_UTILITIES(LONG_FLOAT,COMPLEX);