-- Test conformance of a LONG_COMPLEX_ARRAYS implementation to
-- Draft XX, <date> , of proposed standard
--
-- The testing is performed by comparison to a model. The model,
-- a primitive implementation that can be checked against the standard
-- by inspection, is used to generate the test results. Simple
-- compare procedures are used for scalars, vectors and matrices
-- to determine exact match of array elements and attributes.
-- The function name REF is used for the model reference function.
-- The required formal parameter names are checked at compile time.

with TEXT_IO;
with CALENDAR;
with LONG_COMPLEX_TYPES; use LONG_COMPLEX_TYPES;
with LONG_COMPLEX_ARRAYS; use LONG_COMPLEX_ARRAYS;

procedure TEST_LONG_COMPLEX_ARRAYS is

  ARRAY_INDEX_ERROR : exception renames LONG_COMPLEX_ARRAYS.ARRAY_INDEX_ERROR;

  FAILED : BOOLEAN := FALSE;
  subtype MSG_TYPE is STRING(1..50);
  ZERO : NATURAL;

  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(MESSAGE'FIRST..
                                         MESSAGE'FIRST+MSG_TYPE'LENGTH-1);
    else
      STD_MSG(MESSAGE'RANGE) := MESSAGE;
    end if;
    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 COMPARE ( EXPECTED, MEASURED : COMPLEX;
                      ERROR_MESSAGE : STRING ) is
  begin
    if EXPECTED = MEASURED then
      PASS(ERROR_MESSAGE);
    else
      FAIL(ERROR_MESSAGE);
      -- add optional output here if desired ( five (5) leading spaces please ).
    end if;
  end COMPARE;

  procedure COMPARE ( EXPECTED, MEASURED : COMPLEX_VECTOR;
                      ERROR_MESSAGE : STRING ) is
  begin
    if EXPECTED = MEASURED and then
       EXPECTED'FIRST = MEASURED'FIRST then
      PASS(ERROR_MESSAGE);
    else
      FAIL(ERROR_MESSAGE);
      -- add optional output here if desired ( five (5) leading spaces please ).
    end if;
  end COMPARE;

  procedure COMPARE ( EXPECTED, MEASURED : COMPLEX_MATRIX;
                      ERROR_MESSAGE : STRING ) is
  begin
    if EXPECTED = MEASURED and then
       EXPECTED'FIRST(1) = MEASURED'FIRST(1) and then
       EXPECTED'FIRST(2) = MEASURED'FIRST(2) then
      PASS(ERROR_MESSAGE);
    else
      FAIL(ERROR_MESSAGE);
      -- add optional output here if desired ( five (5) leading spaces please ).
    end if;
  end COMPARE;

  procedure REPORT_RESULTS is
  begin
    if FAILED then
      TEXT_IO.PUT_LINE("     test of  LONG_COMPLEX_ARRAYS  FAILED.");
    else
      TEXT_IO.PUT_LINE("     test of  LONG_COMPLEX_ARRAYS  PASSED.");
    end if;
  end REPORT_RESULTS;

begin

  ZERO := 0;

-- SUBPROGRAMS for COMPLEX_VECTOR TYPES --

  -- VECTOR arithmetic operations --

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("unary + on COMPLEX_VECTOR");
    V1 : COMPLEX_VECTOR(3..5) := ( (3.0,3.0), (4.0,-4.0), (7.0,-7.0));
    function REF  (V : COMPLEX_VECTOR) return COMPLEX_VECTOR is
    begin
      return V ;
    end REF;
  begin
    COMPARE( REF(V1), +V1, TEST_MESSAGE );
    V1 := "+"( RIGHT => V1 ); -- parameter name test at compilation time
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("unary - on COMPLEX_VECTOR");
    V1 : COMPLEX_VECTOR(3..5) := ( (3.0,3.0), (4.0,-4.0), (7.0,-7.0));
    function REF  (V : COMPLEX_VECTOR) return COMPLEX_VECTOR is
      C : COMPLEX_VECTOR ( V'RANGE ) ;
    begin
      for I in V'RANGE loop
        C(I) := -V(I);
      end loop ;
      return C ;
    end REF;
  begin
    COMPARE( REF(V1), -V1, TEST_MESSAGE );
    V1 := "-"( RIGHT => V1 ); -- parameter name test at compilation time
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("CONJUGATE on COMPLEX_VECTOR");
    V1 : COMPLEX_VECTOR(3..5) := ( (3.0,3.0), (4.0,-4.0), (7.0,-7.0));
    function REF  (V : COMPLEX_VECTOR) return COMPLEX_VECTOR is
      C : COMPLEX_VECTOR ( V'RANGE ) ;
    begin
      for I in V'RANGE loop
        C(I) := CONJUGATE( V(I));
      end loop ;
      return C ;
    end REF;
  begin
    COMPARE( REF(V1), CONJUGATE(V1), TEST_MESSAGE );
    V1 := CONJUGATE( X => V1 ); -- parameter name test at compilation time
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("+ on COMPLEX_VECTORs");
    V1 : COMPLEX_VECTOR(3..5) := ( (3.0,3.0), (4.0,-4.0), (7.0,-7.0));
    V2 : COMPLEX_VECTOR(6..8) := ((6.0,6.0),  (7.0,-7.0), (9.0,9.0));
    VB : COMPLEX_VECTOR(2..5) := ( (1.0,0.0), (2.0,-2.0), (3.0,3.0), (4.0,-4.0)); -- raise exception
    function REF  (V, W : COMPLEX_VECTOR) return COMPLEX_VECTOR is
      C : COMPLEX_VECTOR ( V'RANGE ) ;
    begin
      if V'LENGTH /= W'LENGTH then
        raise ARRAY_INDEX_ERROR ;
      end if ;
      for I in V'RANGE loop
        C(I) := V(I) + W(I-V'FIRST+W'FIRST) ;
      end loop ;
      return C ;
    end REF;
  begin
    COMPARE( REF(V1,V2), V1+V2, TEST_MESSAGE );
    begin
      V1 := V2 + VB;
      FAIL(TEST_MESSAGE&'E');
    exception
      when ARRAY_INDEX_ERROR =>
        PASS(TEST_MESSAGE&'E');
    end;
    V1 := "+"( LEFT => V1, RIGHT => V1 ); -- parameter name test at compilation time
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("- on COMPLEX_VECTORs");
    V1 : COMPLEX_VECTOR(3..5) := ( (3.0,3.0), (4.0,-4.0), (7.0,-7.0));
    V2 : COMPLEX_VECTOR(6..8) := ((6.0,6.0),  (7.0,-7.0), (9.0,9.0));
    VB : COMPLEX_VECTOR(2..5) := ( (1.0,0.0), (2.0,-2.0), (3.0,3.0), (4.0,-4.0)); -- raise exception
    function REF  (V, W : COMPLEX_VECTOR) return COMPLEX_VECTOR is
     C : COMPLEX_VECTOR ( V'RANGE ) ;
    begin
      if V'LENGTH /= W'LENGTH then
        raise ARRAY_INDEX_ERROR ;
      end if ;
      for I in V'RANGE loop
        C(I) := V(I) - W(I-V'FIRST+W'FIRST) ;
      end loop ;
      return C ;
    end REF;
  begin
    COMPARE( REF(V1,V2), V1-V2, TEST_MESSAGE );
    begin
      V1 := V2 - VB;
      FAIL(TEST_MESSAGE&'E');
    exception
      when ARRAY_INDEX_ERROR =>
        PASS(TEST_MESSAGE&'E');
    end;
    V1 := "-"( LEFT => V1, RIGHT => V1 ); -- parameter name test at compilation time
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("* on COMPLEX_VECTORs");
    V1 : COMPLEX_VECTOR(3..5) := ( (3.0,3.0), (4.0,-4.0), (7.0,-7.0));
    V2 : COMPLEX_VECTOR(6..8) := ((6.0,6.0),  (7.0,-7.0), (9.0,9.0));
    VB : COMPLEX_VECTOR(2..5) := ( (1.0,0.0), (2.0,-2.0), (3.0,3.0), (4.0,-4.0)); -- raise exception
    function REF  (V, W : COMPLEX_VECTOR) return COMPLEX_VECTOR is
      C : COMPLEX_VECTOR ( V'RANGE ) ;
    begin
      if V'LENGTH /= W'LENGTH then
        raise ARRAY_INDEX_ERROR ;
      end if ;
      for I in V'RANGE loop
        C(I) := V(I) * W(I-V'FIRST+W'FIRST) ;
      end loop ;
      return C ;
    end REF;
  begin
    COMPARE( REF(V1,V2), V1*V2, TEST_MESSAGE );
    begin
      V1 := V2 * VB;
      FAIL(TEST_MESSAGE&'E');
    exception
      when ARRAY_INDEX_ERROR =>
        PASS(TEST_MESSAGE&'E');
    end;
    V1 := "*"( LEFT => V1, RIGHT => V1 ); -- parameter name test at compilation time
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("/ on COMPLEX_VECTORs");
    V1 : COMPLEX_VECTOR(3..5) := ( (3.0,3.0), (4.0,-4.0), (8.0,0.0));
    V2 : COMPLEX_VECTOR(6..8) := ((6.0,6.0),  (4.0,-4.0), (4.0,-4.0));
    VB : COMPLEX_VECTOR(2..5) := ( (1.0,0.0), (2.0,-2.0), (3.0,3.0), (4.0,-4.0)); -- raise exception
    function REF  (V, W : COMPLEX_VECTOR) return COMPLEX_VECTOR is
      C : COMPLEX_VECTOR ( V'RANGE ) ;
    begin
      if V'LENGTH /= W'LENGTH then
        raise ARRAY_INDEX_ERROR ;
      end if ;
      for I in V'RANGE loop
        C(I) := V(I) / W(I-V'FIRST+W'FIRST) ;
        end loop ;
      return C ;
    end REF;
  begin
    COMPARE( REF(V1,V2), V1/V2, TEST_MESSAGE );
    begin
      V1 := V2 / VB;
      FAIL(TEST_MESSAGE&'E');
    exception
      when ARRAY_INDEX_ERROR =>
        PASS(TEST_MESSAGE&'E');
    end;
    V1 := "/"( LEFT => V1, RIGHT => V1 ); -- parameter name test at compilation time
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("** on COMPLEX_VECTORs");
    V1 : COMPLEX_VECTOR(3..5) := ( (3.0,3.0), (4.0,-4.0), (7.0,-7.0));
    NN : INTEGER := 3;
    function REF (V : COMPLEX_VECTOR; 
                  N : INTEGER) return COMPLEX_VECTOR is
      C : COMPLEX_VECTOR ( V'RANGE ) ;
    begin
      for I in V'RANGE loop
        C(I) := V(I) ** N;
      end loop ;
      return C ;
    end REF;
  begin
    COMPARE( REF(V1,NN), V1**NN, TEST_MESSAGE );
    V1 := "**"( LEFT => V1, RIGHT => NN ); -- parameter name test at compilation time
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("* on COMPLEX_VECTORs returning COMPLEX");
    V1 : COMPLEX_VECTOR(3..5) := ( (3.0,3.0), (4.0,-4.0), (7.0,-7.0));
    V2 : COMPLEX_VECTOR(6..8) := ((6.0,6.0),  (7.0,-7.0), (9.0,9.0));
    VB : COMPLEX_VECTOR(2..5) := ( (1.0,0.0), (2.0,-2.0), (3.0,3.0), (4.0,-4.0)); -- raise exception
    XX : COMPLEX;
    function REF  (V, W : COMPLEX_VECTOR) return COMPLEX is
      SUM : COMPLEX := (0.0,0.0) ;
    begin
      if V'LENGTH /= W'LENGTH then
        raise ARRAY_INDEX_ERROR ;
      end if ;
      for I in V'RANGE loop
        SUM := SUM +V(I) * W(I-V'FIRST+W'FIRST) ;
      end loop ;
      return SUM;
    end REF;
  begin
    COMPARE( REF(V1,V2), V1*V2, TEST_MESSAGE );
    begin
      XX := V2 * VB;
      FAIL(TEST_MESSAGE&'E');
      if CALENDAR.SECONDS(CALENDAR.CLOCK)=DURATION'LAST then
        TEXT_IO.PUT_LINE(INTEGER'IMAGE(INTEGER(RE(XX))));
        -- should never print, optimization breaker needed to use XX
      end if;
    exception
      when ARRAY_INDEX_ERROR =>
        PASS(TEST_MESSAGE&'E');
    end;
    XX := "*"( LEFT => V1, RIGHT => V1 ); -- parameter name test at compilation time
    if CALENDAR.SECONDS(CALENDAR.CLOCK)=DURATION'LAST then
      TEXT_IO.PUT_LINE(INTEGER'IMAGE(INTEGER(RE(XX))));
      -- should never print, optimization breaker needed to use XX
    end if;
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;

  -- VECTOR scaling operations --

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("* scale on COMPLEX_VECTOR");
    V1 : COMPLEX_VECTOR(3..5) := ( (3.0,3.0), (4.0,-4.0), (7.0,-7.0));
    XX : COMPLEX := (5.0,5.0);
    function REF  (X : COMPLEX;
                   V : COMPLEX_VECTOR) return COMPLEX_VECTOR is
      C : COMPLEX_VECTOR ( V'RANGE ) ;
    begin
      for I in V'RANGE loop
        C(I) := X * V(I);
      end loop ;
      return C ;
    end REF;
  begin
    COMPARE( REF(XX,V1), XX*V1, TEST_MESSAGE );
    V1 := "*"( XX, RIGHT => V1); -- parameter name test at compilation time
                                 -- only one can be tested, else ambiguous
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("* scale 2 on COMPLEX_VECTOR");
    V1 : COMPLEX_VECTOR(3..5) := ( (3.0,3.0), (4.0,-4.0), (7.0,-7.0));
    XX : COMPLEX := (5.0,5.0);
    function REF (V : COMPLEX_VECTOR;
                  X : COMPLEX) return COMPLEX_VECTOR is
      C : COMPLEX_VECTOR ( V'RANGE ) ;
    begin
      for I in V'RANGE loop
        C(I) := V(I) * X;
      end loop ;
      return C ;
    end REF;
  begin
    COMPARE( REF(V1,XX), V1*XX, TEST_MESSAGE );
    V1 := "*"( V1, RIGHT => XX ); -- parameter name test at compilation time
                              -- only one can be tested, else ambiguous
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("/ scale on COMPLEX_VECTOR");
    V1 : COMPLEX_VECTOR(3..5) := ( (3.0,3.0), (4.0,-4.0), (7.0,-7.0));
    XX : COMPLEX := (4.0,-4.0);
    function REF (V : COMPLEX_VECTOR;
                  X : COMPLEX) return COMPLEX_VECTOR is
      C : COMPLEX_VECTOR ( V'RANGE ) ;
    begin
      for I in V'RANGE loop
        C(I) := V(I) / X;
      end loop ;
      return C ;
    end REF;
  begin
    COMPARE( REF(V1,XX), V1/XX, TEST_MESSAGE );
    V1 := "/"( LEFT => V1, RIGHT => XX ); -- parameter name test at compilation time
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;

  -- other operations --

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("UNIT_VECTOR");
    V1 : COMPLEX_VECTOR(3..5) := ( (3.0,3.0), (4.0,-4.0), (7.0,-7.0));
    function REF (INDEX : INTEGER;
                  ORDER : NATURAL;
                  FIRST : INTEGER := 1 ) return COMPLEX_VECTOR is
      C : COMPLEX_VECTOR ( FIRST..FIRST+ORDER-1) ;
    begin
      if INDEX < FIRST or INDEX >= FIRST+ORDER then
        raise ARRAY_INDEX_ERROR;
      end if;
      for I in C'RANGE loop
        C(I) := (0.0,0.0);
      end loop ;
      C(INDEX) := (1.0,0.0);
      return C ;
    end REF;
  begin
    COMPARE( REF(9,5,7), UNIT_VECTOR(9,5,7), TEST_MESSAGE&'1' );
    COMPARE( REF(5,5), UNIT_VECTOR(5,5), TEST_MESSAGE&'2' );
    begin
      V1 := UNIT_VECTOR(ZERO,ZERO,ZERO); -- can not have null unit vector
      FAIL(TEST_MESSAGE&"E1");
    exception
      when CONSTRAINT_ERROR =>
        PASS(TEST_MESSAGE&"E1");
    end;
    begin
      V1 := UNIT_VECTOR(3,5,7);
      FAIL(TEST_MESSAGE&"E2");
    exception
      when ARRAY_INDEX_ERROR =>
        PASS(TEST_MESSAGE&"E2");
    end;
    begin
      V1 := UNIT_VECTOR(INTEGER'LAST-3,5,INTEGER'LAST-3);
      FAIL(TEST_MESSAGE&"E3a");
    exception
      when CONSTRAINT_ERROR =>
        PASS(TEST_MESSAGE&"E3");
      when ARRAY_INDEX_ERROR =>
        FAIL(TEST_MESSAGE&"E3b");
    end;
    V1 := UNIT_VECTOR( INDEX => -2, ORDER => 3, FIRST => -3 );
                               -- parameter name test at compilation time
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;


-- SUBPROGRAMS for COMPLEX_MATRIX TYPES --

  -- MATRIX arithmetic operations --

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("unary + on COMPLEX_MATRIX");
    A1 : COMPLEX_MATRIX(3..4,-3..-1) := (( (3.0,3.0), (4.0,-4.0),
                    (7.0,-7.0)),((2.0,-2.0), (1.0,0.0), (6.0,6.0)));
    function REF  (A : COMPLEX_MATRIX) return COMPLEX_MATRIX is
    begin
      return A ;
    end REF;
  begin
    COMPARE( REF(A1), +A1, TEST_MESSAGE );
    A1 := "+"( RIGHT => A1 ); -- parameter name test at compilation time
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("unary - on COMPLEX_MATRIX");
    A1 : COMPLEX_MATRIX(3..4,-3..-1) := (( (3.0,3.0), (4.0,-4.0), (7.0,-7.0)),((2.0,-2.0), (1.0,0.0), (6.0,6.0)));
    function REF  (A : COMPLEX_MATRIX) return COMPLEX_MATRIX is
      C : COMPLEX_MATRIX ( A'RANGE(1), A'RANGE(2)) ;
    begin
      for I in A'RANGE(1) loop
        for J in A'RANGE(2) loop
          C(I,J) := -A(I,J);
        end loop ;
      end loop ;
      return C ;
    end REF;
  begin
    COMPARE( REF(A1), -A1, TEST_MESSAGE );
    A1 := "-"( RIGHT => A1 ); -- parameter name test at compilation time
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("CONJUGATE on COMPLEX_MATRIX");
    A1 : COMPLEX_MATRIX(3..4,-3..-1) := (( (3.0,3.0), (4.0,-4.0), (7.0,-7.0)),((2.0,-2.0), (1.0,0.0), (6.0,6.0)));
    function REF  (A : COMPLEX_MATRIX) return COMPLEX_MATRIX is
      C : COMPLEX_MATRIX ( A'RANGE(1), A'RANGE(2)) ;
    begin
      for I in A'RANGE(1) loop
        for J in A'RANGE(2) loop
          C(I,J) := CONJUGATE(A(I,J));
        end loop ;
      end loop ;
      return C ;
    end REF;
  begin
    COMPARE( REF(A1), CONJUGATE(A1), TEST_MESSAGE );
    A1 := CONJUGATE( X => A1 ); -- parameter name test at compilation time
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("TRANSPOSE on COMPLEX_MATRIX");
    A1 : COMPLEX_MATRIX(3..4,-3..-1) := (( (3.0,3.0), (4.0,-4.0), (7.0,-7.0)),((2.0,-2.0), (1.0,0.0), (6.0,6.0)));
    A2 : COMPLEX_MATRIX(6..8,-1..0);
    function REF  (A : COMPLEX_MATRIX) return COMPLEX_MATRIX is
      C : COMPLEX_MATRIX ( A'RANGE(2), A'RANGE(1)) ;
    begin
      for I in A'RANGE(1) loop
        for J in A'RANGE(2) loop
          C(J,I) :=  A(I,J);
        end loop ;
      end loop ;
      return C ;
    end REF;
  begin
    COMPARE( REF(A1), TRANSPOSE(A1), TEST_MESSAGE );
    A2 := TRANSPOSE( X => A1 ); -- parameter name test at compilation time
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("+ on COMPLEX_MATRIXs");
    A1 : COMPLEX_MATRIX(3..4,-3..-1) := (( (3.0,3.0), (4.0,-4.0), (7.0,-7.0)),((2.0,-2.0), (1.0,0.0),(6.0,6.0)));
    A2 : COMPLEX_MATRIX(6..7,-1..1) :=  (((6.0,6.0),  (7.0,-7.0), (9.0,9.0)),( (3.0,3.0),(2.0,-2.0), (5.0,5.0)));
    AB : COMPLEX_MATRIX(2..3,4..5) := (( (1.0,0.0), (2.0,-2.0)),( (3.0,3.0), (4.0,-4.0))); -- raise exception
    function REF  (A, B : COMPLEX_MATRIX) return COMPLEX_MATRIX is
      C : COMPLEX_MATRIX ( A'RANGE(1), A'RANGE(2)) ;
    begin
      if A'LENGTH(1) /= B'LENGTH(1) or
         A'LENGTH(2) /= B'LENGTH(2) then
        raise ARRAY_INDEX_ERROR ;
      end if ;
      for I in A'RANGE(1) loop
        for J in A'RANGE(2) loop
          C(I,J) := A(I,J) + B(I-A'FIRST(1)+B'FIRST(1),
                               J-A'FIRST(2)+B'FIRST(2)) ;
        end loop ;
     end loop ;
      return C ;
    end REF;
  begin
    COMPARE( REF(A1,A2), A1+A2, TEST_MESSAGE );
    begin
      A1 := A2 + AB;
      FAIL(TEST_MESSAGE&'E');
    exception
      when ARRAY_INDEX_ERROR =>
        PASS(TEST_MESSAGE&'E');
    end;
    A1 := "+"( LEFT => A1, RIGHT => A1 ); -- parameter name test at compilation time
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("- on COMPLEX_MATRIXs");
    A1 : COMPLEX_MATRIX(3..4,-3..-1) := (( (3.0,3.0), (4.0,-4.0), (7.0,-7.0)),((2.0,-2.0), (1.0,0.0),(6.0,6.0)));
    A2 : COMPLEX_MATRIX(6..7,-1..1) :=  (((6.0,6.0),  (7.0,-7.0), (9.0,9.0)),( (3.0,3.0),(2.0,-2.0), (5.0,5.0)));
    AB : COMPLEX_MATRIX(2..3,4..5) := (( (1.0,0.0), (2.0,-2.0)),( (3.0,3.0), (4.0,-4.0))); -- raise exception
    function REF  (A, B : COMPLEX_MATRIX) return COMPLEX_MATRIX is
        C : COMPLEX_MATRIX ( A'RANGE(1), A'RANGE(2)) ;
    begin
      if A'LENGTH(1) /= B'LENGTH(1) or
         A'LENGTH(2) /= B'LENGTH(2) then
        raise ARRAY_INDEX_ERROR ;
      end if ;
      for I in A'RANGE(1) loop
        for J in A'RANGE(2) loop
          C(I,J) := A(I,J) - B(I-A'FIRST(1)+B'FIRST(1),
                               J-A'FIRST(2)+B'FIRST(2)) ;
        end loop ;
      end loop ;
      return C ;
    end REF;
  begin
    COMPARE( REF(A1,A2), A1-A2, TEST_MESSAGE );
    begin
      A1 := A2 - AB;
      FAIL(TEST_MESSAGE&'E');
    exception
      when ARRAY_INDEX_ERROR =>
        PASS(TEST_MESSAGE&'E');
    end;
    A1 := "-"( LEFT => A1, RIGHT => A1 ); -- parameter name test at compilation time
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("* on COMPLEX_MATRIXs");
    A1 : COMPLEX_MATRIX(3..4,-3..-1) := (( (3.0,3.0),(4.0,-4.0), (7.0,-7.0)),((2.0,-2.0), (1.0,0.0),(6.0,6.0)));
    A2 : COMPLEX_MATRIX(6..8,-1..1) :=  (((6.0,6.0), (7.0,-7.0), (9.0,9.0)),
                                      ( (3.0,3.0),(2.0,-2.0), (5.0,5.0)),
                                      ( (1.0,0.0),(6.0,6.0), (4.0,-4.0)));
    AB : COMPLEX_MATRIX(2..3,4..5) := (( (1.0,0.0), (2.0,-2.0)),( (3.0,3.0), (4.0,-4.0))); -- raise exception
    function REF  (A, B : COMPLEX_MATRIX) return COMPLEX_MATRIX is
        C : COMPLEX_MATRIX ( A'RANGE(1) , B'RANGE(2)) ;
    begin
      if A'LENGTH(2) /= B'LENGTH(1) then
        raise ARRAY_INDEX_ERROR ;
      end if ;
      for I in A'RANGE(1) loop
        for J in B'RANGE(2) loop
          C(I,J) := (0.0,0.0) ;
          for K in A'RANGE(2) loop
            C(I,J) := C(I,J) + A(I,K) * B(K-A'FIRST(2)+B'FIRST(1),J) ;
          end loop ;
        end loop ;
      end loop ;
      return C ;
    end REF;
  begin
    COMPARE( REF(A1,A2), A1*A2, TEST_MESSAGE );
    begin
      A1 := A2 * AB;
      FAIL(TEST_MESSAGE&'E');
    exception
      when ARRAY_INDEX_ERROR =>
        PASS(TEST_MESSAGE&'E');
    end;
    A1 := "*"( LEFT => A1, RIGHT => A2 ); -- parameter name test at compilation time
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("* on COMPLEX_VECTOR, COMPLEX_VECTOR");
    V1 : COMPLEX_VECTOR(-1..1) :=  ((6.0,6.0), (7.0,-7.0), (9.0,9.0));
    V2 : COMPLEX_VECTOR(7..8) := ((3.0,3.0), (4.0,-4.0));
    VB : COMPLEX_VECTOR(2..4) := ((1.0,0.0), (2.0,-2.0), (3.0,3.0)); -- raise exception
    A1 : COMPLEX_MATRIX(0..2,-1..0);
    function REF (V, W : COMPLEX_VECTOR) return COMPLEX_MATRIX is
      C : COMPLEX_MATRIX ( V'RANGE, W'RANGE) ;
    begin
      for I in V'RANGE loop
        for J in W'RANGE loop
          C(I,J) :=  V(I) * W(J);
        end loop ;
      end loop ;
      return C ;
    end REF;
  begin
    COMPARE( REF(V1,V2), V1*V2, TEST_MESSAGE );
    A1 := "*"( LEFT => V1, RIGHT => V2 ); -- parameter name test at compilation time
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("* on COMPLEX_VECTOR, COMPLEX_MATRIX");
    A1 : COMPLEX_MATRIX(-3..-1,3..4) := (( (3.0,3.0),(4.0,-4.0)),( (7.0,-7.0),(2.0,-2.0)),( (1.0,0.0),(6.0,6.0)));
    V1 : COMPLEX_VECTOR(-1..1) :=  ((6.0,6.0), (7.0,-7.0), (9.0,9.0));
    VB : COMPLEX_VECTOR(2..3) := ((1.0,0.0), (2.0,-2.0)); -- raise exception
    V2 : COMPLEX_VECTOR(7..8);
    function REF (V : COMPLEX_VECTOR;
                  A : COMPLEX_MATRIX) return COMPLEX_VECTOR is
      CV : COMPLEX_VECTOR ( A'RANGE(2)) ;
      SUM : COMPLEX ;
    begin
      if A'LENGTH(1) /= V'LENGTH then
        raise ARRAY_INDEX_ERROR ;
      end if ;
      for J in A'RANGE(2) loop
        SUM := (0.0,0.0) ;
        for I in A'RANGE(1) loop
          SUM := SUM + V(I-A'FIRST(1)+V'FIRST) * A(I,J) ;
        end loop ;
        CV(J) := SUM ;
      end loop ;
      return CV ;
    end REF;
  begin
    COMPARE( REF(V1,A1), V1*A1, TEST_MESSAGE );
    begin
      V2 := VB * A1;
      FAIL(TEST_MESSAGE&'E');
    exception
      when ARRAY_INDEX_ERROR =>
        PASS(TEST_MESSAGE&'E');
    end;
    V2 := "*"( V1, RIGHT => A1 ); -- parameter name test at compilation time
                                  -- only one can be tested, else ambiguous
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("* on COMPLEX_MATRIX, COMPLEX_VECTOR");
    A1 : COMPLEX_MATRIX(3..4,-3..-1) := (( (3.0,3.0),(4.0,-4.0), (7.0,-7.0)),((2.0,-2.0), (1.0,0.0),(6.0,6.0)));
    V1 : COMPLEX_VECTOR(-1..1) :=  ((6.0,6.0), (7.0,-7.0), (9.0,9.0));
    VB : COMPLEX_VECTOR(2..3) := ((1.0,0.0), (2.0,-2.0)); -- raise exception
    V2 : COMPLEX_VECTOR(7..8);
    function REF (A : COMPLEX_MATRIX;
                  V : COMPLEX_VECTOR) return COMPLEX_VECTOR is
      CV : COMPLEX_VECTOR( A'RANGE(1)) ;
      SUM : COMPLEX ;
    begin
      if A'LENGTH(2) /= V'LENGTH then
        raise ARRAY_INDEX_ERROR ;
      end if ;
      for I in A'RANGE(1) loop
        SUM := (0.0,0.0) ;
        for J in A'RANGE(2) loop
          SUM := SUM + V(J-A'FIRST(2)+V'FIRST) * A(I,J) ;
        end loop ;
        CV(I) := SUM ;
      end loop ;
      return CV ;
    end REF;
  begin
    COMPARE( REF(A1,V1), A1*V1, TEST_MESSAGE );
    begin
      V2 := A1 * VB;
      FAIL(TEST_MESSAGE&'E');
    exception
      when ARRAY_INDEX_ERROR =>
        PASS(TEST_MESSAGE&'E');
    end;
    V2 := "*"( A1, RIGHT => V1 ); -- parameter name test at compilation time
                                  -- only one can be tested, else ambiguous
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;

  -- MATRIX scaling operations --

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("* scale on COMPLEX_MATRIX");
    A1 : COMPLEX_MATRIX(3..5,-1..0) := (( (3.0,3.0), (4.0,-4.0)),( (7.0,-7.0), (1.0,0.0)),( (6.0,6.0), (5.0,5.0)));
    XX : COMPLEX := (5.0,5.0);
    function REF (X : COMPLEX;
                  A : COMPLEX_MATRIX) return COMPLEX_MATRIX is
      C : COMPLEX_MATRIX ( A'RANGE(1), A'RANGE(2)) ;
    begin
      for I in A'RANGE(1) loop
        for J in A'RANGE(2) loop
          C(I,J) := X * A(I,J);
        end loop ;
      end loop ;
      return C ;
    end REF;
  begin
    COMPARE( REF(XX,A1), XX*A1, TEST_MESSAGE );
    A1 := "*"( XX, RIGHT => A1); -- parameter name test at compilation time
                                 -- only one can be tested, else ambiguous
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("* scale 2 on COMPLEX_MATRIX");
    A1 : COMPLEX_MATRIX(3..5,-1..0) := (( (3.0,3.0), (4.0,-4.0)),( (7.0,-7.0), (1.0,0.0)),( (6.0,6.0), (5.0,5.0)));
    XX : COMPLEX := (5.0,5.0);
    function REF (A : COMPLEX_MATRIX;
                  X : COMPLEX) return COMPLEX_MATRIX is
      C : COMPLEX_MATRIX ( A'RANGE(1), A'RANGE(2)) ;
    begin
      for I in A'RANGE(1) loop
        for J in A'RANGE(2) loop
          C(I,J) := A(I,J)* X;
        end loop ;
      end loop ;
      return C ;
    end REF;
  begin
    COMPARE( REF(A1,XX), A1*XX, TEST_MESSAGE );
    A1 := "*"( A1, RIGHT => XX); -- parameter name test at compilation time
                                 -- only one can be tested, else ambiguous
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;


  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("/ scale on COMPLEX_MATRIX");
    A1 : COMPLEX_MATRIX(3..5,-1..0) := (( (3.0,3.0), (4.0,-4.0)),
                  ( (7.0,-7.0), (1.0,0.0)),( (6.0,6.0), (5.0,5.0)));
    XX : COMPLEX := (4.0,-4.0);
    function REF (A : COMPLEX_MATRIX;
                  X : COMPLEX) return COMPLEX_MATRIX is
      C : COMPLEX_MATRIX ( A'RANGE(1), A'RANGE(2)) ;
    begin
      for I in A'RANGE(1) loop
        for J in A'RANGE(2) loop
          C(I,J) := A(I,J) / X;
        end loop ;
      end loop ;
      return C ;
    end REF;
  begin
    COMPARE( REF(A1,XX), A1/XX, TEST_MESSAGE );
    A1 := "/"( LEFT => A1, RIGHT => XX); -- parameter name test at compilation time
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;


  -- other operations --

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("IDENTITY_MATRIX");
    A1 : COMPLEX_MATRIX(3..5,-1..1);
    function REF (ORDER : NATURAL;
                  FIRST_1,FIRST_2 : INTEGER := 1)
                  return COMPLEX_MATRIX is
      A : COMPLEX_MATRIX ( FIRST_1..FIRST_1+ORDER-1, FIRST_2..FIRST_2+ORDER-1) ;
    begin
      for I in A'RANGE(1) loop
        for J in A'RANGE(2) loop
          A(I,J) := (0.0,0.0) ;
        end loop ;
        A(I,I-A'FIRST(1)+A'FIRST(2)) := (1.0,0.0) ;
      end loop ;
      return A ;
    end REF;
  begin
    COMPARE( REF(9,5,-3), IDENTITY_MATRIX(9,5,-3), TEST_MESSAGE&'1' );
    COMPARE( REF(5,5), IDENTITY_MATRIX(5,5), TEST_MESSAGE&'2' );
    COMPARE( REF(6), IDENTITY_MATRIX(6), TEST_MESSAGE&'3' );
    begin
      A1 := IDENTITY_MATRIX(3,1,INTEGER'LAST-1);
      FAIL(TEST_MESSAGE&"E2");
    exception
      when CONSTRAINT_ERROR =>
        PASS(TEST_MESSAGE&"E2");
    end;
    begin
      A1 := IDENTITY_MATRIX(3,INTEGER'LAST-1);
      FAIL(TEST_MESSAGE&"E3a");
    exception
      when CONSTRAINT_ERROR =>
        PASS(TEST_MESSAGE&"E3");
    end;
    A1 := IDENTITY_MATRIX( ORDER => 3, FIRST_1 => -3 , FIRST_2 => -2 );
                               -- parameter name test at compilation time
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;

  REPORT_RESULTS;

end TEST_LONG_COMPLEX_ARRAYS;