-- Test basic conformance of a GENERIC_COMPLEX_TYPES implementation to
-- Draft XX, <date>, of proposed standard
-- !!!! needs to be checked against ISO 8652:1995  !!!!
-- an improved version of the accuracy checker is planned, not ready yet
-- it will be "plug" compatible  Jon
--
-- Instructions: Just compile and execute. Last message should say  PASSED
--
-- Testing is usually on model numbers against exact values.
-- Modulus, "abs", Argument and Compose_from_polar may be inexact.
-- Non model and obnoxious numbers used where it must not matter.
--
-- The required formal parameter names are checked at compile time.
--
--Copyright (C) 1993 Free Software Foundation
--written by Jon Squire with assistance from many others
--
--This file is part of the numerics library. This library
--is free software; you can redistribute it and/or modify it under the
--terms of the GNU Library General Public License as published by the Free
--Software Foundation; either version 2 of the License, or (at your
--option) any later version.  This library is distributed in the hope
--that it will be useful, but WITHOUT ANY WARRANTY; without even the
--implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
--PURPOSE.  See the GNU Library General Public License for more details.
--You should have received a copy of the GNU Library General Public
--License along with this library; if not, write to the Free Software
--Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
--

with TEXT_IO; use TEXT_IO;
with CALENDAR;
with Ada.Numerics.GENERIC_COMPLEX_TYPES;
with Ada.Text_IO.COMPLEX_IO;
with Ada.Numerics; use  Ada.Numerics;
procedure TEST_GENERIC_COMPLEX_TYPES is

  -- implementers should test against all floating types
  subtype REAL is LONG_FLOAT;

  package COMPLEX_TYPES is new Ada.Numerics.GENERIC_COMPLEX_TYPES(REAL);
  use COMPLEX_TYPES;

  package REAL_IO is new FLOAT_IO(REAL);
  use REAL_IO;

  package CX_IO is new Ada.Text_IO.COMPLEX_IO(COMPLEX_TYPES);
  use CX_IO;

  Y : REAL;
  YY : COMPLEX;
  FAILED : BOOLEAN := FALSE;
  subtype MSG_TYPE is STRING(1..65);
  NOW : DURATION := CALENDAR.SECONDS(CALENDAR.CLOCK); -- to break optimization
  PI : constant := 3.14159_26535_89793_23846_26433_83279_50288_41971 ;

  function C(RE : REAL; IM : REAL) return COMPLEX renames
                                              COMPOSE_FROM_CARTESIAN;

  function MAKE_MSG ( MESSAGE : STRING ) return MSG_TYPE is
    STD_MSG : MSG_TYPE := (others => ' ');
  begin
    if MESSAGE'LENGTH > MSG_TYPE'LENGTH then
      TEXT_IO.PUT_LINE("//// message truncated");
      STD_MSG(MSG_TYPE'RANGE) := MESSAGE(MSG_TYPE'RANGE);
    else
      STD_MSG(MESSAGE'RANGE) := MESSAGE;
    end if;
    return STD_MSG;
  exception
    when others =>
      TEXT_IO.PUT_LINE("---- FAILED MAKE_MSG had an exception");
      FAILED := TRUE ;
      return STD_MSG;
  end MAKE_MSG;

  procedure PASS ( ERROR_MESSAGE : STRING ) is
  begin
    TEXT_IO.PUT_LINE("++++ PASSED " & ERROR_MESSAGE );
  end PASS;

  procedure FAIL ( ERROR_MESSAGE : STRING ) is
  begin
    TEXT_IO.PUT_LINE("---- FAILED " & ERROR_MESSAGE );
    FAILED := TRUE ;
  end FAIL;

  procedure MESSAGE ( ERROR_MESSAGE : STRING ) is
  begin
    TEXT_IO.PUT_LINE("            " & ERROR_MESSAGE );
  end MESSAGE;

  procedure COMPARE ( EXPECTED, MEASURED : REAL;
                      ERROR_MESSAGE : STRING;
                      TOLERANCE : REAL := 0.0 ) is
  begin
    if EXPECTED = MEASURED then
      PASS(ERROR_MESSAGE);
      if NOW = DURATION'LAST then
        PUT("     "); PUT(EXPECTED); PUT_LINE(" = expected");
        PUT("     "); PUT(MEASURED); PUT_LINE(" = measured");
        NEW_LINE;
      end if;
    elsif TOLERANCE = 0.0 then
      FAIL(ERROR_MESSAGE);
      -- add optional output here if desired ( five (5) leading spaces please ).
      PUT("     "); PUT(EXPECTED); PUT_LINE(" = expected");
      PUT("     "); PUT(MEASURED); PUT_LINE(" = measured");
      NEW_LINE;
    else -- must check tolerance
      if abs(EXPECTED-MEASURED) < abs(EXPECTED)*REAL'EPSILON*TOLERANCE then
        PASS(ERROR_MESSAGE);
        if NOW = DURATION'LAST then
          PUT("     "); PUT(EXPECTED); PUT_LINE(" = expected");
          PUT("     "); PUT(MEASURED); PUT_LINE(" = measured");
          NEW_LINE;
        end if;
      else
        FAIL(ERROR_MESSAGE);
        -- add optional output here if desired ( five (5) leading spaces please ).
        PUT("     "); PUT(EXPECTED); PUT_LINE(" = expected");
        PUT("     "); PUT(MEASURED); PUT_LINE(" = measured");
        NEW_LINE;
      end if;
    end if;
  exception
    when others =>
      TEXT_IO.PUT_LINE("---- FAILED COMPARE had an exception");
      FAILED := TRUE ;
  end COMPARE;

  procedure COMPARE ( EXPECTED, MEASURED : IMAGINARY;
                      ERROR_MESSAGE : STRING ) is
  begin
    if EXPECTED = MEASURED then
      PASS(ERROR_MESSAGE);
      if NOW = DURATION'LAST then
        PUT("     "); PUT(IM(EXPECTED)); PUT_LINE(" = expected");
        PUT("     "); PUT(IM(MEASURED)); PUT_LINE(" = measured");
        NEW_LINE;
      end if;
    else
      FAIL(ERROR_MESSAGE);
      -- add optional output here if desired ( five (5) leading spaces please ).
      PUT("     "); PUT(IM(EXPECTED)); PUT_LINE(" = expected");
      PUT("     "); PUT(IM(MEASURED)); PUT_LINE(" = measured");
      NEW_LINE;
    end if;
  exception
    when others =>
      TEXT_IO.PUT_LINE("---- FAILED COMPARE had an exception");
      FAILED := TRUE ;
  end COMPARE;

  procedure COMPARE ( EXPECTED, MEASURED : COMPLEX;
                      ERROR_MESSAGE : STRING;
                      TOLERANCE : REAL := 0.0 ) is
  begin
    if RE(EXPECTED) = RE(MEASURED) and IM(EXPECTED) = IM(MEASURED) then
      PASS(ERROR_MESSAGE);
      if NOW = DURATION'LAST then
        PUT("     "); PUT(EXPECTED); PUT_LINE(" = expected");
        PUT("     "); PUT(MEASURED); PUT_LINE(" = measured");
        NEW_LINE;
      end if;
    elsif TOLERANCE = 0.0 then
      FAIL(ERROR_MESSAGE);
      -- add optional output here if desired ( five (5) leading spaces please ).
      PUT("     "); PUT(EXPECTED); PUT_LINE(" = expected");
      PUT("     "); PUT(MEASURED); PUT_LINE(" = measured");
      NEW_LINE;
    else -- must check tolerance
      if abs(RE(EXPECTED)-RE(MEASURED)) < abs(RE(EXPECTED))*REAL'EPSILON*TOLERANCE and
         abs(IM(EXPECTED)-IM(MEASURED)) < abs(IM(EXPECTED))*REAL'EPSILON*TOLERANCE then
        PASS(ERROR_MESSAGE);
        if NOW = DURATION'LAST then
          PUT("     "); PUT(EXPECTED); PUT_LINE(" = expected");
          PUT("     "); PUT(MEASURED); PUT_LINE(" = measured");
          NEW_LINE;
        end if;
      else
        FAIL(ERROR_MESSAGE);
        -- add optional output here if desired ( five (5) leading spaces please ).
        PUT("     "); PUT(EXPECTED); PUT_LINE(" = expected");
        PUT("     "); PUT(MEASURED); PUT_LINE(" = measured");
        NEW_LINE;
      end if;
    end if;
  exception
    when others =>
      TEXT_IO.PUT_LINE("---- FAILED COMPARE had an exception");
      FAILED := TRUE ;
  end COMPARE;

  procedure COMPARE ( EXPECTED, MEASURED : BOOLEAN;
                      ERROR_MESSAGE : STRING ) is
  begin
    if EXPECTED = MEASURED then
      PASS(ERROR_MESSAGE);
      if NOW = DURATION'LAST then
        PUT("     "); PUT(BOOLEAN'IMAGE(EXPECTED)); PUT_LINE(" = expected");
        PUT("     "); PUT(BOOLEAN'IMAGE(MEASURED)); PUT_LINE(" = measured");
        NEW_LINE;
      end if;
    else
      FAIL(ERROR_MESSAGE);
      -- add optional output here if desired ( five (5) leading spaces please ).
      PUT("     "); PUT(BOOLEAN'IMAGE(EXPECTED)); PUT_LINE(" = expected");
      PUT("     "); PUT(BOOLEAN'IMAGE(MEASURED)); PUT_LINE(" = measured");
      NEW_LINE;
    end if;
  exception
    when others =>
      TEXT_IO.PUT_LINE("---- FAILED COMPARE had an exception");
      FAILED := TRUE ;
  end COMPARE;

  procedure REPORT_RESULTS is
  begin
    MESSAGE("");
    MESSAGE("***************************************************");
    MESSAGE("");
    if FAILED then
      MESSAGE("test of Generic Complex Types, part 1,  FAILED.");
    else
      MESSAGE("test of Generic Complex Types, part 1,  PASSED.");
    end if;
    MESSAGE("");
    MESSAGE("***************************************************");
    MESSAGE("");
  end REPORT_RESULTS;

begin -- start test

  MESSAGE("Test Generic Complex Types, part 1");

  MESSAGE("Types IMAGINARY and COMPLEX must be defined");
  MESSAGE("I and J must be defined");

  declare
    MSG : MSG_TYPE := MAKE_MSG("I and J are defined as 'i'");
    Z : COMPLEX := C(RE=>-2.0, IM=>3.0);
    I_IMAG : IMAGINARY := I; -- type compatibility
    J_IMAG : IMAGINARY := J;
    X : REAL := I_IMAG * J_IMAG; -- numeric value
  begin
    COMPARE( Z, -2.0+3.0*I, MSG );
    COMPARE( -1.0, X, MSG );
    COMPARE(  1.0, IM(I_IMAG), MSG );
    COMPARE(  1.0, IM(J_IMAG), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  MESSAGE("SUBPROGRAMS for COMPLEX TYPE");

  MESSAGE("selection, conversion and composition operations");

  declare
    MSG : MSG_TYPE := MAKE_MSG("RE(X:COMPLEX)return REAL");
  begin
    COMPARE( 4.0,  RE(X=>C(4.0,-3.1)), MSG );
    COMPARE( -3.0, RE(X=>C(-3.0, 4.1)), MSG );
    COMPARE( 0.0,  RE(X=>C(0.0, 0.1)), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("IM(X:COMPLEX)return REAL");
  begin
    COMPARE( 4.0,  IM(X=>C(-3.1, 4.0)), MSG );
    COMPARE( -3.0, IM(X=>C(4.1, -3.0)), MSG );
    COMPARE( 0.0,  IM(X=>C(0.1, 0.0)), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
   MSG : MSG_TYPE := MAKE_MSG("IM(X:IMAGINARY)return REAL");
  begin
    COMPARE( 4.0,  IM(X=>4.0*I), MSG );
    COMPARE( -3.0, IM(X=>-3.0*I), MSG );
    COMPARE( 0.0,  IM(X=>0.0*I), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("SET_RE(X:in out COMPLEX;RE:REAL)");
    X : COMPLEX := C(REAL'LAST, 3.0);
  begin
    SET_RE(X=>X, RE=>4.0);
    COMPARE( C(4.0,3.0), X, MSG );
    SET_RE(X=>X, RE=>-3.0);
    COMPARE( C(-3.0,3.0), X, MSG );
    SET_RE(X=>X, RE=>0.0);
    COMPARE( C(0.0,3.0), X, MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("SET_IM(X:in out COMPLEX;IM:REAL)");
    X : COMPLEX := C(-3.0, REAL'LAST);
  begin
    SET_IM(X=>X, IM=>4.0);
    COMPARE( C(-3.0,4.0), X, MSG );
    SET_IM(X=>X, IM=>-3.0);
    COMPARE( C(-3.0,-3.0), X, MSG );
    SET_IM(X=>X, IM=>0.0);
    COMPARE( C(-3.0,0.0), X, MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("SET_IM(X:in out IMAGINARY;IM:REAL)");
    X : IMAGINARY := REAL'LAST*I;
  begin
    SET_IM(X=>X, IM=>4.0);
    COMPARE( 4.0*I, X, MSG );
    SET_IM(X=>X, IM=>-3.0);
    COMPARE( -3.0*I, X, MSG );
    SET_IM(X=>X, IM=>0.0);
    COMPARE( 0.0*I, X, MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("COMPOSE_FROM_CARTESIAN(RE:REAL)return COMPLEX");
  begin
    COMPARE( C(4.0,0.0),  COMPOSE_FROM_CARTESIAN(RE=>4.0), MSG );
    COMPARE( C(-3.0,0.0),  COMPOSE_FROM_CARTESIAN(RE=>-3.0), MSG );
    COMPARE( C(0.0,0.0),  COMPOSE_FROM_CARTESIAN(RE=>0.0), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("COMPOSE_FROM_CARTESIAN(RE,IM:REAL)return COMPLEX");
  begin
    COMPARE( C(4.0,-3.0),  COMPOSE_FROM_CARTESIAN(RE=>4.0, IM=>-3.0), MSG );
    COMPARE( C(-3.0,4.0),  COMPOSE_FROM_CARTESIAN(RE=>-3.0, IM=>4.0), MSG );
    COMPARE( C(0.0,0.0),  COMPOSE_FROM_CARTESIAN(RE=>0.0, IM=>0.0), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("COMPOSE_FROM_CARTESIAN(IM:IMAGINARY)return COMPLEX");
  begin
    COMPARE( C(0.0,4.0),  COMPOSE_FROM_CARTESIAN(IM=>4.0*I), MSG );
    COMPARE( C(0.0,-3.0),  COMPOSE_FROM_CARTESIAN(IM=>-3.0*I), MSG );
    COMPARE( C(0.0,0.0),  COMPOSE_FROM_CARTESIAN(IM=>0.0*I), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("MODULUS(X:COMPLEX)return REAL");
  begin
    COMPARE( 5.0, MODULUS(X=>C(3.0,4.0)), MSG, 2.0 );
    COMPARE( 5.0, MODULUS(X=>C(-3.0,4.0)), MSG, 2.0 );
    COMPARE( 5.0, MODULUS(X=>C(3.0,-4.0)), MSG, 2.0 );
    COMPARE( 5.0, MODULUS(X=>C(-3.0,-4.0)), MSG, 2.0 );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("abs(RIGHT:COMPLEX)return REAL");
  begin
    COMPARE( 5.0, "abs"(RIGHT=>C(3.0,4.0)), MSG, 2.0 );
    COMPARE( 5.0, "abs"(RIGHT=>C(-3.0,4.0)), MSG, 2.0 );
    COMPARE( 5.0, "abs"(RIGHT=>C(3.0,-4.0)), MSG, 2.0 );
    COMPARE( 5.0, "abs"(RIGHT=>C(-3.0,-4.0)), MSG, 2.0 );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("ARGUMENT(X:COMPLEX)return REAL");
  begin
    COMPARE( 0.0, ARGUMENT(X=>C(0.0,0.0)), MSG );
    COMPARE( 0.0, ARGUMENT(X=>C(REAL'LAST,0.0)), MSG );
    COMPARE( Pi/2.0, ARGUMENT(X=>C(0.0,2.0)), MSG, 2.0 );
    COMPARE( -Pi/2.0, ARGUMENT(X=>C(0.0,-2.0)), MSG, 2.0 );
    COMPARE( Pi/4.0, ARGUMENT(X=>C(2.0,2.0)), MSG, 2.0 );
    COMPARE( -Pi/4.0, ARGUMENT(X=>C(2.0,-2.0)), MSG, 2.0 );
    COMPARE( 3.0*Pi/4.0, ARGUMENT(X=>C(-2.0,2.0)), MSG, 2.0 );
    COMPARE( -3.0*Pi/4.0, ARGUMENT(X=>C(-2.0,-2.0)), MSG, 2.0 );
    COMPARE( Pi, ARGUMENT(X=>C(-2.0,0.0)), MSG, 2.0 );
    COMPARE( -Pi, ARGUMENT(X=>C(-1.0,-REAL'EPSILON)), MSG, 2.0 );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("ARGUMENT(X:COMPLEX;CYCLE:REAL)return REAL");
  begin
    COMPARE( 0.0, ARGUMENT(X=>C(0.0,0.0),CYCLE=>0.1), MSG );
    COMPARE( 0.0, ARGUMENT(X=>C(REAL'LAST,0.0),CYCLE=>0.1), MSG );
    COMPARE( 1.0, ARGUMENT(X=>C(1.0,1.0),CYCLE=>8.0), MSG );
    COMPARE( 3.0, ARGUMENT(X=>C(-1.0,1.0),CYCLE=>8.0), MSG );
    COMPARE( -1.0, ARGUMENT(X=>C(1.0,-1.0),CYCLE=>8.0), MSG );
    COMPARE( -3.0, ARGUMENT(X=>C(-1.0,-1.0),CYCLE=>8.0), MSG );
    COMPARE( 2.0, ARGUMENT(X=>C(0.0,1.0),CYCLE=>8.0), MSG );
    COMPARE( -2.0, ARGUMENT(X=>C(0.0,-1.0),CYCLE=>8.0), MSG );
    COMPARE( 4.0, ARGUMENT(X=>C(-1.0,0.0),CYCLE=>8.0), MSG );
    begin
      Y := ARGUMENT(X=>C(0.0,0.0),CYCLE=>0.0);
      FAIL(MSG&"CZ");
    exception
      when ARGUMENT_ERROR =>
        PASS(MSG&"CZ");
      when CONSTRAINT_ERROR =>
        PASS(MSG&"CZ");
      when others =>
        FAIL(MSG&"CC");
    end;
    begin
      Y := ARGUMENT(X=>C(0.0,0.0),CYCLE=>-1.0);
      FAIL(MSG&"CN");
    exception
      when ARGUMENT_ERROR =>
        PASS(MSG&"CN");
      when CONSTRAINT_ERROR =>
        PASS(MSG&"CN");
      when others =>
        FAIL(MSG&"CM");
    end;
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("COMPOSE_FROM_POLAR(MODULUS,ARGUMENT:REAL)return COMPLEX");
  begin
    COMPARE( C(4.0,0.0), COMPOSE_FROM_POLAR(MODULUS=>4.0,ARGUMENT=>0.0), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("COMPOSE_FROM_POLAR(MODULUS,ARGUMENT,CYCLE:REAL)return COMPLEX");
  begin
    COMPARE( C(3.0,0.0), COMPOSE_FROM_POLAR(MODULUS=>3.0, ARGUMENT=>0.0, CYCLE=>8.0), MSG, 2.0 );
    COMPARE( C(3.0,0.0), COMPOSE_FROM_POLAR(MODULUS=>3.0, ARGUMENT=>8.0, CYCLE=>8.0), MSG, 2.0 );
    COMPARE( C(3.0,0.0), COMPOSE_FROM_POLAR(MODULUS=>3.0, ARGUMENT=>-8.0, CYCLE=>8.0), MSG, 2.0 );
    COMPARE( C(0.0,3.0), COMPOSE_FROM_POLAR(MODULUS=>3.0, ARGUMENT=>2.0, CYCLE=>8.0), MSG, 2.0 );
    COMPARE( C(0.0,3.0), COMPOSE_FROM_POLAR(MODULUS=>3.0, ARGUMENT=>-6.0, CYCLE=>8.0), MSG, 2.0 );
    COMPARE( C(0.0,-3.0), COMPOSE_FROM_POLAR(MODULUS=>3.0, ARGUMENT=>-2.0, CYCLE=>8.0), MSG, 2.0 );
    COMPARE( C(0.0,-3.0), COMPOSE_FROM_POLAR(MODULUS=>3.0, ARGUMENT=>6.0, CYCLE=>8.0), MSG, 2.0 );
    COMPARE( C(-3.0,0.0), COMPOSE_FROM_POLAR(MODULUS=>3.0, ARGUMENT=>4.0, CYCLE=>8.0), MSG, 2.0 );
    COMPARE( C(-3.0,0.0), COMPOSE_FROM_POLAR(MODULUS=>3.0, ARGUMENT=>-4.0, CYCLE=>8.0), MSG, 2.0 );
    begin
      YY := COMPOSE_FROM_POLAR(MODULUS=>0.0,ARGUMENT=>0.0,CYCLE=>0.0);
      FAIL(MSG&"CZ");
    exception
      when ARGUMENT_ERROR =>
        PASS(MSG&"CZ");
      when CONSTRAINT_ERROR =>
        PASS(MSG&"CZ");
      when others =>
        FAIL(MSG&"CC");
    end;
    begin
      YY := COMPOSE_FROM_POLAR(MODULUS=>0.0,ARGUMENT=>0.0,CYCLE=>-1.0);
      FAIL(MSG&"CN");
    exception
      when ARGUMENT_ERROR =>
        PASS(MSG&"CN");
      when CONSTRAINT_ERROR =>
        PASS(MSG&"CN");
      when others =>
        FAIL(MSG&"CM");
    end;
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("CONJUGATE(X:COMPLEX)return COMPLEX");
  begin
    COMPARE( C(3.0,0.0), CONJUGATE(X=>C(3.0,0.0)), MSG );
    COMPARE( C(3.0,4.0), CONJUGATE(X=>C(3.0,-4.0)), MSG );
    COMPARE( C(-3.0,-4.0), CONJUGATE(X=>C(-3.0,4.0)), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  MESSAGE("pure IMAGINARY arithmetic operations");

  declare
    MSG : MSG_TYPE := MAKE_MSG("<(LEFT,RIGHT:IMAGINARY)return BOOLEAN");
  begin
    COMPARE( FALSE, I<0.9*J, MSG );
    COMPARE( FALSE, I<J, MSG );
    COMPARE( TRUE, "<"(LEFT=>I,RIGHT=>1.1*J), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("<=(LEFT,RIGHT:IMAGINARY)return BOOLEAN");
  begin
    COMPARE( FALSE, I<=0.9*J, MSG );
    COMPARE( TRUE, I<=J, MSG );
    COMPARE( TRUE, "<="(LEFT=>I,RIGHT=>1.1*J), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG(">(LEFT,RIGHT:IMAGINARY)return BOOLEAN");
  begin
    COMPARE( TRUE, I>0.9*J, MSG );
    COMPARE( FALSE, I>J, MSG );
    COMPARE( FALSE, ">"(LEFT=>I,RIGHT=>1.1*J), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG(">=(LEFT,RIGHT:IMAGINARY)return BOOLEAN");
  begin
    COMPARE( TRUE, I>=0.9*J, MSG );
    COMPARE( TRUE, I>=J, MSG );
    COMPARE( FALSE, ">="(LEFT=>I,RIGHT=>1.1*J), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("+(RIGHT:IMAGINARY)return IMAGINARY");
  begin
    COMPARE( -3.0*I, +(-3.0*I), MSG );
    COMPARE( 2.0*I, "+"(RIGHT=>2.0*I), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("-(RIGHT:IMAGINARY)return IMAGINARY");
  begin
    COMPARE( -2.0*I, -(2.0*I), MSG );
    COMPARE( 3.0*I, "-"(RIGHT=>-3.0*I), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("+(LEFT,RIGHT:IMAGINARY)return IMAGINARY");
  begin
    COMPARE( I, (3.0*I)+(-2.0*I), MSG );
    COMPARE( -1.0*I, "+"(LEFT=>2.0*I,RIGHT=>-3.0*I), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("-(LEFT,RIGHT:IMAGINARY)return IMAGINARY");
  begin
    COMPARE( -2.0*I,  (3.0*I)-(5.0*I), MSG );
    COMPARE( 4.0*I,  "-"(LEFT=>5.0*I,RIGHT=>1.0*I), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("CONJUGATE(X:IMAGINARY)return IMAGINARY");
  begin
    COMPARE( 0.0*I,  CONJUGATE(X=>0.0*I), MSG );
    COMPARE( -3.0*I,  CONJUGATE(X=>3.0*I), MSG );
    COMPARE( 3.0*I,  CONJUGATE(X=>-3.0*I), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  MESSAGE("COMPLEX arithmetic operations");

  declare
    MSG : MSG_TYPE := MAKE_MSG("+(RIGHT:COMPLEX)return COMPLEX");
    V1 : COMPLEX := C(3.0, -4.0);
  begin
    COMPARE( C(3.0,-4.0), +V1, MSG );
    COMPARE( C(-3.0,4.0), "+"(RIGHT=>C(-3.0,4.0)), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("-(RIGHT:COMPLEX)return COMPLEX");
    V1 : COMPLEX := C(3.0,-4.0);
  begin
    COMPARE( C(-3.0, 4.0), -V1, MSG );
    COMPARE( C(-4.0, 3.0), "-"(RIGHT=>C(4.0,-3.0)), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("+(LEFT,RIGHT:COMPLEX)return COMPLEX");
    V1 : COMPLEX := C(3.0,4.0);
    V2 : COMPLEX := C(-1.0,2.0);
  begin
    COMPARE( C(2.0, 6.0), V1+V2, MSG );
    COMPARE( C(-2.0, -1.0), "+"(LEFT=>C(-3.0,4.0),RIGHT=>C(1.0,-5.0)), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("-(LEFT,RIGHT:COMPLEX)return COMPLEX");
    V1 : COMPLEX := C(4.0,-7.0);
    V2 : COMPLEX := C(6.0,3.0);
  begin
    COMPARE( C(-2.0, -10.0), V1-V2, MSG );
    COMPARE( C(-5.0, 1.0), "-"(LEFT=>C(-1.0,-2.0),RIGHT=>C(4.0,-3.0)), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("*(LEFT,RIGHT:COMPLEX)return COMPLEX");
    V1 : COMPLEX := C(3.0,4.0);
    V2 : COMPLEX := C(-2.0,3.0);
  begin
    COMPARE( C(-18.0, 1.0), V1*V2, MSG );
    COMPARE( C(10.0, 20.0), "*"(LEFT=>C(-2.0,4.0),RIGHT=>C(3.0,-4.0)), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("/(LEFT,RIGHT:COMPLEX)return COMPLEX");
    V1 : COMPLEX := C(-16.0,2.0);
    V2 : COMPLEX := C(-2.0,4.0);
  begin
    COMPARE( C(2.0,3.0), V1/V2, MSG );
    COMPARE( C(1.0,0.0), C(3.0,4.0)/C(3.0,4.0), MSG, 2.0);
    COMPARE( C(0.96,0.28), C(3.0,4.0)/C(4.0,3.0), MSG, 2.0);
    COMPARE( C(0.96,-0.28), C(4.0,3.0)/C(3.0,4.0), MSG, 2.0);
    COMPARE( C(1.0,0.0), C(4.0,3.0)/C(4.0,3.0), MSG, 2.0);
    COMPARE( C(-2.0,0.0), "/"(LEFT=>C(16.0,4.0),RIGHT=>C(-8.0,-2.0)),
             MSG, 2.0 );
    COMPARE( C(1.0, -2.0), C(5.0*REAL'SMALL,0.0)/C(REAL'SMALL,2.0*REAL'SMALL),
             MSG, 2.0);
    COMPARE( C(1.0, -2.0), C(5.0*(REAL'SAFE_LARGE/16.0),0.0)/
             C(REAL'SAFE_LARGE/16.0,(REAL'SAFE_LARGE/8.0)), MSG, 2.0);
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  MESSAGE("REAL/IMAGINARY arithmetic operations");

  declare
    MSG : MSG_TYPE := MAKE_MSG("*(LEFT,RIGHT:IMAGINARY)return REAL");
  begin
    COMPARE( 12.0, (-3.0*I)*(4.0*I), MSG );
    COMPARE( -8.0, "*"(LEFT=>2.0*I,RIGHT=>4.0*I), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("*(LEFT:IMAGINARY;RIGHT:REAL)return IMAGINARY");
  begin
    COMPARE( 12.0*I, (-3.0*I)*(-4.0), MSG );
    COMPARE( -8.0*I, "*"(LEFT=>-2.0*I,RIGHT=>4.0), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("*(LEFT:REAL;RIGHT:IMAGINARY)return IMAGINARY");
  begin
    COMPARE( 12.0*I, 3.0*(4.0*I), MSG );
    COMPARE( -8.0*I, "*"(LEFT=>-2.0,RIGHT=>4.0*I), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("/(LEFT,RIGHT:IMAGINARY)return REAL");
  begin
    COMPARE( 3.0, (6.0*I)/(2.0*I), MSG );
    COMPARE( 2.0, "/"(LEFT=>-4.0*I,RIGHT=>-2.0*I), MSG );
    COMPARE( 2.0, (6.0*REAL'SMALL*I)/(3.0*REAL'SMALL*I), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("/(LEFT:IMAGINARY;RIGHT:REAL)return IMAGINARY");
  begin
    COMPARE( 3.0*I, (6.0*I)/2.0, MSG );
    COMPARE( 2.0*I, "/"(LEFT=>-4.0*I,RIGHT=>-2.0), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("/(LEFT:REAL;RIGHT:IMAGINARY)return IMAGINARY");
  begin
    COMPARE( -3.0*I, 6.0/(2.0*I), MSG );
    COMPARE( -2.0*I, "/"(LEFT=>-4.0,RIGHT=>-2.0*I), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;


  MESSAGE("REAL/COMPLEX arithmetic operations");

  declare
    MSG : MSG_TYPE := MAKE_MSG("+(LEFT:REAL;RIGHT:COMPLEX)return COMPLEX");
  begin
    COMPARE( C(3.0,4.0), 2.0+C(1.0,4.0), MSG );
    COMPARE( C(-4.0,2.0), "+"(LEFT=>-3.0,RIGHT=>C(-1.0,2.0)), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("+(LEFT:COMPLEX;RIGHT:REAL)return COMPLEX");
  begin
    COMPARE( C(3.0,4.0), C(1.0,4.0)+2.0, MSG );
    COMPARE( C(-4.0,2.0), "+"(LEFT=>C(-1.0,2.0),RIGHT=>-3.0), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("-(LEFT:REAL;RIGHT:COMPLEX)return COMPLEX");
  begin
    COMPARE( C(1.0,-4.0), 2.0-C(1.0,4.0), MSG );
    COMPARE( C(-3.0,-2.0), "-"(LEFT=>-2.0,RIGHT=>C(1.0,2.0)), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("-(LEFT:COMPLEX;RIGHT:REAL)return COMPLEX");
  begin
    COMPARE( C(-1.0,4.0), C(1.0,4.0)-2.0, MSG );
    COMPARE( C(2.0,2.0), "-"(LEFT=>C(-1.0,2.0),RIGHT=>-3.0), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("*(LEFT:REAL;RIGHT:COMPLEX)return COMPLEX");
  begin
    COMPARE( C(2.0,8.0), 2.0*C(1.0,4.0), MSG );
    COMPARE( C(3.0,-6.0), "*"(LEFT=>-3.0,RIGHT=>C(-1.0,2.0)), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("*(LEFT:COMPLEX;RIGHT:REAL)return COMPLEX");
  begin
    COMPARE( C(2.0,8.0), C(1.0,4.0)*2.0, MSG );
    COMPARE( C(3.0,-6.0), "*"(LEFT=>C(-1.0,2.0),RIGHT=>-3.0), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("/(LEFT:REAL;RIGHT:COMPLEX)return COMPLEX");
  begin
    COMPARE( C(3.0,-4.0), 25.0/C(3.0,4.0), MSG, 2.0 );
    COMPARE( C(3.0,4.0), "/"(LEFT=>-25.0,RIGHT=>C(-3.0,4.0)), MSG, 2.0);
    COMPARE( C(1.0, -2.0), (5.0*REAL'SMALL)/C(REAL'SMALL,2.0*REAL'SMALL),
             MSG, 2.0);
    COMPARE( C(1.0, -2.0), (5.0*(REAL'SAFE_LARGE/16.0))/
             C(REAL'SAFE_LARGE/16.0,(REAL'SAFE_LARGE/8.0)), MSG, 2.0);
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("/(LEFT:COMPLEX;RIGHT:REAL)return COMPLEX");
  begin
    COMPARE( C(3.0,2.0), C(6.0,4.0)/2.0, MSG );
    COMPARE( C(2.0,-1.0), "/"(LEFT=>C(-6.0,3.0),RIGHT=>-3.0), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;


  MESSAGE("IMAGINARY/COMPLEX arithmetic operations");

  declare
    MSG : MSG_TYPE := MAKE_MSG("+(LEFT:IMAGINARY;RIGHT:COMPLEX)return COMPLEX");
  begin
    COMPARE( C(-2.0,-1.0), (3.0*I)+C(-2.0,-4.0), MSG );
    COMPARE( C(2.0,1.0), "+"(LEFT=>-3.0*I,RIGHT=>C(2.0,4.0)), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("+(LEFT:COMPLEX;RIGHT:IMAGINARY)return COMPLEX");
  begin
    COMPARE( C(-2.0,-1.0), C(-2.0,-4.0)+3.0*I, MSG );
    COMPARE( C(2.0,1.0), "+"(LEFT=>C(2.0,4.0),RIGHT=>-3.0*I), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("-(LEFT:IMAGINARY;RIGHT:COMPLEX)return COMPLEX");
  begin
    COMPARE( C(2.0,7.0), (3.0*I)-C(-2.0,-4.0), MSG );
    COMPARE( C(-2.0,-7.0), "-"(LEFT=>-3.0*I,RIGHT=>C(2.0,4.0)), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("-(LEFT:COMPLEX;RIGHT:IMAGINARY)return COMPLEX");
  begin
    COMPARE( C(-2.0,-7.0), C(-2.0,-4.0)-3.0*I, MSG );
    COMPARE( C(2.0,7.0), "-"(LEFT=>C(2.0,4.0),RIGHT=>-3.0*I), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("*(LEFT:IMAGINARY;RIGHT:COMPLEX)return COMPLEX");
  begin
    COMPARE( C(12.0,-6.0), (3.0*I)*C(-2.0,-4.0), MSG );
    COMPARE( C(12.0,-6.0), "*"(LEFT=>-3.0*I,RIGHT=>C(2.0,4.0)), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("*(LEFT:COMPLEX;RIGHT:IMAGINARY)return COMPLEX");
  begin
    COMPARE( C(12.0,-6.0), C(-2.0,-4.0)*(3.0*I), MSG );
    COMPARE( C(12.0,-6.0), "*"(LEFT=>C(2.0,4.0),RIGHT=>-3.0*I), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("/(LEFT:IMAGINARY;RIGHT:COMPLEX)return COMPLEX");
  begin
    COMPARE( C(-4.0,-3.0), (25.0*I)/C(-3.0,-4.0), MSG );
    COMPARE( C(3.0,-4.0), "/"(LEFT=>-25.0*I,RIGHT=>C(4.0,-3.0)), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("/(LEFT:COMPLEX;RIGHT:IMAGINARY)return COMPLEX");
  begin
    COMPARE( C(-2.0,3.0), C(-9.0,-6.0)/(3.0*I), MSG );
    COMPARE( C(-2.0,1.0), "/"(LEFT=>C(2.0,4.0),RIGHT=>-2.0*I), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;


  MESSAGE("Mixed REAL/IMAGINARY/COMPLEX");

  declare
    MSG : MSG_TYPE := MAKE_MSG("+(LEFT:REAL;RIGHT:IMAGINARY)return COMPLEX");
  begin
    COMPARE( C(3.0,2.0), 3.0+2.0*I, MSG );
    COMPARE( C(-3.0,2.0), "+"(LEFT=>-3.0,RIGHT=>2.0*I), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("+(LEFT:IMAGINARY;RIGHT:REAL)return COMPLEX");
  begin
    COMPARE( C(3.0,2.0), 2.0*I+3.0, MSG );
    COMPARE( C(2.0,-3.0), "+"(LEFT=>-3.0*I,RIGHT=>2.0), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("-(LEFT:REAL;RIGHT:IMAGINARY)return COMPLEX");
  begin
    COMPARE( C(0.0,-1.0), 0.0-I, MSG );
    COMPARE( C(3.0,-2.0), 3.0-2.0*I, MSG );
    COMPARE( C(-3.0,-2.0), "-"(LEFT=>-3.0,RIGHT=>2.0*I), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("-(LEFT:IMAGINARY;RIGHT:REAL)return COMPLEX");
  begin
    COMPARE( C(0.0,1.0), I-0.0, MSG );
    COMPARE( C(-3.0,5.0), (5.0*I)-3.0, MSG );
    COMPARE( C(-2.0,4.0), "-"(LEFT=>4.0*I,RIGHT=>2.0), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  MESSAGE("exponentiation for COMPLEX and IMAGINARY");

  declare
    MSG : MSG_TYPE := MAKE_MSG("**(LEFT:COMPLEX;RIGHT:INTEGER)return COMPLEX");
    V1 : COMPLEX := C(3.0,-2.0);
    NN : INTEGER := 3;
  begin
    COMPARE( C(-9.0,-46.0), V1**NN, MSG );
    COMPARE( C(-7.0,-24.0),"**"(LEFT=>C(-3.0,4.0),RIGHT=>2), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  declare
    MSG : MSG_TYPE := MAKE_MSG("**(LEFT:IMAGINARY;RIGHT:INTEGER)return COMPLEX");
    V1 : IMAGINARY := 3.0*I;
    NN : INTEGER := 3;
  begin
    COMPARE( C(0.0,-27.0), V1**NN, MSG );
    COMPARE( C(1.0,0.0), "**"(LEFT=>-2.0*I,RIGHT=>0), MSG );
    COMPARE( C(0.0,0.0), "**"(LEFT=>0.0*I,RIGHT=>1000), MSG );
    COMPARE( C(0.0,2.0), "**"(LEFT=>2.0*I,RIGHT=>1), MSG );
    COMPARE( C(-4.0,0.0), "**"(LEFT=>2.0*I,RIGHT=>2), MSG );
    COMPARE( C(0.0,-8.0), "**"(LEFT=>2.0*I,RIGHT=>3), MSG );
    COMPARE( C(16.0,0.0), "**"(LEFT=>2.0*I,RIGHT=>4), MSG );
    COMPARE( C(0.0,-2.0), "**"(LEFT=>-2.0*I,RIGHT=>1), MSG );
    COMPARE( C(-4.0,0.0), "**"(LEFT=>-2.0*I,RIGHT=>2), MSG );
    COMPARE( C(0.0,8.0), "**"(LEFT=>-2.0*I,RIGHT=>3), MSG );
    COMPARE( C(16.0,0.0), "**"(LEFT=>-2.0*I,RIGHT=>4), MSG );
    COMPARE( C(0.0,-0.5), "**"(LEFT=>2.0*I,RIGHT=>-1), MSG );
    COMPARE( C(-0.25,0.0), "**"(LEFT=>2.0*I,RIGHT=>-2), MSG );
    COMPARE( C(0.0,0.125), "**"(LEFT=>2.0*I,RIGHT=>-3), MSG );
    COMPARE( C(0.0625,0.0), "**"(LEFT=>2.0*I,RIGHT=>-4), MSG );
    COMPARE( C(0.0,0.5), "**"(LEFT=>-2.0*I,RIGHT=>-1), MSG );
    COMPARE( C(-0.25,0.0), "**"(LEFT=>-2.0*I,RIGHT=>-2), MSG );
    COMPARE( C(0.0,-0.125), "**"(LEFT=>-2.0*I,RIGHT=>-3), MSG );
    COMPARE( C(0.0625,0.0), "**"(LEFT=>-2.0*I,RIGHT=>-4), MSG );
    COMPARE( C(256.0,0.0), "**"(LEFT=>2.0*I,RIGHT=>8), MSG );
  exception
    when others =>
      FAIL(MSG&"UE");
  end;

  MESSAGE("end Test Generic Complex Types, part 1");

  REPORT_RESULTS;

end TEST_GENERIC_COMPLEX_TYPES;