-- Test conformance of a GENERIC_REAL_ARRAYS implementation to
-- Draft XX, <date>, of proposed standard (not complete, send Jon more tests)
--
-- 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.

generic
  type REAL is digits <>;
  type REAL_VECTOR is array(INTEGER range <>) of REAL;
  type REAL_MATRIX is array(INTEGER range <>, INTEGER range <>) of REAL;
  with function "+" (RIGHT : REAL_VECTOR) return REAL_VECTOR is <>;
  with function "-" (RIGHT : REAL_VECTOR) return REAL_VECTOR is <>;
  with function "abs" (RIGHT : REAL_VECTOR) return REAL_VECTOR is <>; 
  with function "+" (LEFT, RIGHT : REAL_VECTOR) return REAL_VECTOR is <>;
  with function "-" (LEFT, RIGHT : REAL_VECTOR) return REAL_VECTOR is <>;
  with function "*" (LEFT, RIGHT : REAL_VECTOR) return REAL_VECTOR is <>; 
  with function "/" (LEFT, RIGHT : REAL_VECTOR) return REAL_VECTOR is <>;
  with function "**" (LEFT  : REAL_VECTOR; 
                      RIGHT : INTEGER) return REAL_VECTOR is <>; 
  with function "*" (LEFT, RIGHT : REAL_VECTOR) return REAL is <>; 
  with function "*" (LEFT  : REAL;
                     RIGHT : REAL_VECTOR) return REAL_VECTOR is <>;
  with function "*" (LEFT  : REAL_VECTOR;
                     RIGHT : REAL) return REAL_VECTOR is <>;
  with function "/" (LEFT  : REAL_VECTOR;
                     RIGHT : REAL) return REAL_VECTOR is <>;
  with function UNIT_VECTOR (INDEX : INTEGER;
                             ORDER : POSITIVE;
                             FIRST : INTEGER := 1) return REAL_VECTOR is <>;  
  with function "+" (RIGHT : REAL_MATRIX) return REAL_MATRIX is <>;
  with function "-" (RIGHT : REAL_MATRIX) return REAL_MATRIX is <>;
  with function "abs" (RIGHT : REAL_MATRIX) return REAL_MATRIX is <>; 
  with function TRANSPOSE (X : REAL_MATRIX) return REAL_MATRIX is <>; 
  with function "+" (LEFT, RIGHT : REAL_MATRIX) return REAL_MATRIX is <>;
  with function "-" (LEFT, RIGHT : REAL_MATRIX) return REAL_MATRIX is <>;
  with function "*" (LEFT, RIGHT : REAL_MATRIX) return REAL_MATRIX is <>;
  with function "*" (LEFT, RIGHT : REAL_VECTOR) return REAL_MATRIX is <>; 
  with function "*" (LEFT  : REAL_VECTOR;
                     RIGHT : REAL_MATRIX) return REAL_VECTOR is <>;
  with function "*" (LEFT  : REAL_MATRIX;
                     RIGHT : REAL_VECTOR) return REAL_VECTOR is <>;
  with function "*" (LEFT  : REAL;
                     RIGHT : REAL_MATRIX) return REAL_MATRIX is <>;
  with function "*" (LEFT  : REAL_MATRIX;
                     RIGHT : REAL) return REAL_MATRIX is <>;
  with function "/" (LEFT  : REAL_MATRIX;
                     RIGHT : REAL) return REAL_MATRIX is <>;
  with function IDENTITY_MATRIX (ORDER : POSITIVE;
                                 FIRST_1, FIRST_2 : INTEGER := 1)
                                 return REAL_MATRIX is <>;
procedure TEST_GENERIC_REAL_ARRAYS;

with TEXT_IO;
with ARRAY_EXCEPTIONS;
procedure TEST_GENERIC_REAL_ARRAYS is

  ARRAY_INDEX_ERROR : exception renames ARRAY_EXCEPTIONS.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 : REAL;
                      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 : REAL_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 : REAL_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  REAL_ARRAYS  FAILED.");
    else
      TEXT_IO.PUT_LINE("     test of  REAL_ARRAYS  PASSED.");
    end if;
  end REPORT_RESULTS;

begin

  ZERO := 0;

-- SUBPROGRAMS for REAL_VECTOR TYPES --

  -- VECTOR arithmetic operations --

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

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("+ on REAL_VECTORs");
    V1 : REAL_VECTOR(3..5) := ( 3.0, -4.0, 7.0);
    V2 : REAL_VECTOR(6..8) := (-6.0,  7.0, 9.0);
    VB : REAL_VECTOR(2..5) := ( 1.0, 2.0, 3.0, 4.0); -- raise exception
    function REF  (V, W : REAL_VECTOR) return REAL_VECTOR is
      C : REAL_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 := "+"( RIGHT => V1, LEFT => V1 ); -- parameter name test at compilation time
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("- on REAL_VECTORs");
    V1 : REAL_VECTOR(3..5) := ( 3.0, -4.0, 7.0);
    V2 : REAL_VECTOR(6..8) := (-6.0,  7.0, 9.0);
    VB : REAL_VECTOR(2..5) := ( 1.0, 2.0, 3.0, 4.0); -- raise exception
    function REF  (V, W : REAL_VECTOR) return REAL_VECTOR is
     C : REAL_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 REAL_VECTORs");
    V1 : REAL_VECTOR(3..5) := ( 3.0, -4.0, 7.0);
    V2 : REAL_VECTOR(6..8) := (-6.0,  7.0, 9.0);
    VB : REAL_VECTOR(2..5) := ( 1.0, 2.0, 3.0, 4.0); -- raise exception
    function REF  (V, W : REAL_VECTOR) return REAL_VECTOR is
      C : REAL_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 REAL_VECTORs");
    V1 : REAL_VECTOR(3..5) := ( 3.0, -4.0, 8.0);
    V2 : REAL_VECTOR(6..8) := (-6.0,  4.0, 4.0);
    VB : REAL_VECTOR(2..5) := ( 1.0, 2.0, 3.0, 4.0); -- raise exception
    function REF  (V, W : REAL_VECTOR) return REAL_VECTOR is
      C : REAL_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 REAL_VECTORs");
    V1 : REAL_VECTOR(3..5) := ( 3.0, -4.0, 7.0);
    NN : INTEGER := 3;
    function REF (V : REAL_VECTOR; 
                  N : INTEGER) return REAL_VECTOR is
      C : REAL_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 REAL_VECTORs returning REAL");
    V1 : REAL_VECTOR(3..5) := ( 3.0, -4.0, 7.0);
    V2 : REAL_VECTOR(6..8) := (-6.0,  7.0, 9.0);
    VB : REAL_VECTOR(2..5) := ( 1.0, 2.0, 3.0, 4.0); -- raise exception
    XX : REAL;
    function REF  (V, W : REAL_VECTOR) return REAL is
      TEMP : REAL := 0.0;
    begin
      if V'LENGTH /= W'LENGTH then
        raise ARRAY_INDEX_ERROR ;
      end if ;
      for I in V'RANGE loop
        TEMP := TEMP + V(I) * W(I-V'FIRST+W'FIRST) ;
      end loop ;
      return TEMP;
    end REF;
  begin
    COMPARE( REF(V1,V2), V1*V2, TEST_MESSAGE );
    begin
      XX := V2 * VB;
      FAIL(TEST_MESSAGE&'E');
    exception
      when ARRAY_INDEX_ERROR =>
        PASS(TEST_MESSAGE&'E');
    end;
    XX := "*"( LEFT => V1, RIGHT => V1 ); -- parameter name test at compilation time
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;

  -- VECTOR scaling operations --

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("* scale RV on REAL_VECTOR");
    V1 : REAL_VECTOR(3..5) := ( 3.0, -4.0, 7.0);
    XX : REAL := 5.0;
    function REF  (X : REAL;
                   V : REAL_VECTOR) return REAL_VECTOR is
      C : REAL_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 VR on REAL_VECTOR");
    V1 : REAL_VECTOR(3..5) := ( 3.0, -4.0, 7.0);
    XX : REAL := 5.0;
    function REF (V : REAL_VECTOR;
                  X : REAL) return REAL_VECTOR is
      C : REAL_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 REAL_VECTOR");
    V1 : REAL_VECTOR(3..5) := ( 3.0, -4.0, 7.0);
    XX : REAL := 4.0;
    function REF (V : REAL_VECTOR;
                  X : REAL) return REAL_VECTOR is
      C : REAL_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 : REAL_VECTOR(3..5) := ( 0.0, 1.0, 0.0);
    VF : REAL_VECTOR(INTEGER'FIRST..INTEGER'FIRST+3) := (0.0,1.0,0.0,0.0);
    VL : REAL_VECTOR(INTEGER'LAST-1..INTEGER'LAST) := (0.0,1.0);
    function REF (INDEX : INTEGER;
                  ORDER : POSITIVE;
                  FIRST : INTEGER := 1 ) return REAL_VECTOR is
      C : REAL_VECTOR ( FIRST..FIRST+(ORDER-1)) ;
    begin
      if INDEX < FIRST or INDEX > FIRST+(ORDER-1) then
        raise ARRAY_INDEX_ERROR;
      end if;
      for I in C'RANGE loop
        C(I) := 0.0;
      end loop ;
      C(INDEX) := 1.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' );
    COMPARE( V1, UNIT_VECTOR(4,3,3), TEST_MESSAGE&'3' );
    begin
      COMPARE( VF, UNIT_VECTOR(INTEGER'FIRST+1,4,INTEGER'FIRST),
               TEST_MESSAGE&'F' );
    exception
      when others =>
        FAIL(TEST_MESSAGE&"L");
    end;
    begin
      COMPARE( VL, UNIT_VECTOR(INTEGER'LAST,2,INTEGER'LAST-1),
               TEST_MESSAGE&'L' );
    exception
      when others =>
        FAIL(TEST_MESSAGE&"L");
    end;
    begin
      V1 := UNIT_VECTOR(3,5,7);
      FAIL(TEST_MESSAGE&"E1");
    exception
      when ARRAY_INDEX_ERROR =>
        PASS(TEST_MESSAGE&"E1");
      when CONSTRAINT_ERROR =>
        FAIL(TEST_MESSAGE&"E1a");
      when others =>
        FAIL(TEST_MESSAGE&"E1b");
    end;
    begin
      V1 := UNIT_VECTOR(INTEGER'LAST-3,5,INTEGER'LAST-3);
      FAIL(TEST_MESSAGE&"E2");
    exception
      when CONSTRAINT_ERROR =>
        PASS(TEST_MESSAGE&"E2");
      when ARRAY_INDEX_ERROR =>
        FAIL(TEST_MESSAGE&"E2a");
      when others =>
        FAIL(TEST_MESSAGE&"E2b");
    end;
    begin
      V1 := UNIT_VECTOR(ZERO,ZERO,ZERO); -- can not have null unit vector
      FAIL(TEST_MESSAGE&"E3");
    exception
      when CONSTRAINT_ERROR =>
        PASS(TEST_MESSAGE&"E3");
      when ARRAY_INDEX_ERROR =>
        FAIL(TEST_MESSAGE&"E3a");
      when others =>
        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 REAL_MATRIX TYPES --

  -- MATRIX arithmetic operations --

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("unary + on REAL_MATRIX");
    A1 : REAL_MATRIX(3..4,-3..-1) := (( 3.0, -4.0, 7.0),(-2.0, 1.0, -6.0));
    function REF  (A : REAL_MATRIX) return REAL_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 REAL_MATRIX");
    A1 : REAL_MATRIX(3..4,-3..-1) := (( 3.0, -4.0, 7.0),(-2.0, 1.0, -6.0));
    function REF  (A : REAL_MATRIX) return REAL_MATRIX is
      C : REAL_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("abs on REAL_MATRIX");
    A1 : REAL_MATRIX(3..4,-3..-1) := (( 3.0, -4.0, 7.0),(-2.0, 1.0, -6.0));
    function REF  (A : REAL_MATRIX) return REAL_MATRIX is
      C : REAL_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) := abs A(I,J);
        end loop ;
      end loop ;
      return C ;
    end REF;
  begin
    COMPARE( REF(A1), abs A1, TEST_MESSAGE );
    A1 := "abs"( RIGHT => A1 ); -- parameter name test at compilation time
  exception
    when others =>
      FAIL(TEST_MESSAGE&"UE");
  end;

  declare
    TEST_MESSAGE : MSG_TYPE := MAKE_MSG("TRANSPOSE on REAL_MATRIX");
    A1 : REAL_MATRIX(3..4,-3..-1) := (( 3.0, -4.0, 7.0),(-2.0, 1.0, -6.0));
    A2 : REAL_MATRIX(6..8,-1..0);
    function REF  (A : REAL_MATRIX) return REAL_MATRIX is
      C : REAL_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 REAL_MATRIXs");
    A1 : REAL_MATRIX(3..4,-3..-1) := (( 3.0, -4.0, 7.0),(-2.0, 1.0,-6.0));
    A2 : REAL_MATRIX(6..7,-1..1) :=  ((-6.0,  7.0, 9.0),( 3.0,-2.0, 5.0));
    AB : REAL_MATRIX(2..3,4..5) := (( 1.0, 2.0),( 3.0, 4.0)); -- raise exception
    function REF  (A, B : REAL_MATRIX) return REAL_MATRIX is
      C : REAL_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 REAL_MATRIXs");
    A1 : REAL_MATRIX(3..4,-3..-1) := (( 3.0, -4.0, 7.0),(-2.0, 1.0,-6.0));
    A2 : REAL_MATRIX(6..7,-1..1) :=  ((-6.0,  7.0, 9.0),( 3.0,-2.0, 5.0));
    AB : REAL_MATRIX(2..3,4..5) := (( 1.0, 2.0),( 3.0, 4.0)); -- raise exception
    function REF  (A, B : REAL_MATRIX) return REAL_MATRIX is
        C : REAL_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 REAL_MATRIXs");
    A1 : REAL_MATRIX(3..4,-3..-1) := (( 3.0,-4.0, 7.0),(-2.0, 1.0,-6.0));
    A2 : REAL_MATRIX(6..8,-1..1) :=  ((-6.0, 7.0, 9.0),
                                      ( 3.0,-2.0, 5.0),
                                      ( 1.0,-6.0, 4.0));
    AB : REAL_MATRIX(2..3,4..5) := (( 1.0, 2.0),( 3.0, 4.0)); -- raise exception
    function REF  (A, B : REAL_MATRIX) return REAL_MATRIX is
        C : REAL_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 ;
          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 REAL_VECTOR, REAL_VECTOR");
    V1 : REAL_VECTOR(-1..1) :=  (-6.0, 7.0, 9.0);
    V2 : REAL_VECTOR(7..8) := (3.0, -4.0);
    VB : REAL_VECTOR(2..4) := (1.0, 2.0, 3.0); -- raise exception
    A1 : REAL_MATRIX(0..2,-1..0);
    function REF (V, W : REAL_VECTOR) return REAL_MATRIX is
      C : REAL_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 REAL_VECTOR, REAL_MATRIX");
    A1 : REAL_MATRIX(-3..-1,3..4) := (( 3.0,-4.0),( 7.0,-2.0),( 1.0,-6.0));
    V1 : REAL_VECTOR(-1..1) :=  (-6.0, 7.0, 9.0);
    VB : REAL_VECTOR(2..3) := (1.0, 2.0); -- raise exception
    V2 : REAL_VECTOR(7..8);
    function REF (V : REAL_VECTOR;
                  A : REAL_MATRIX) return REAL_VECTOR is
      CV : REAL_VECTOR ( A'RANGE(2)) ;
      SUM : REAL ;
    begin
      if A'LENGTH(1) /= V'LENGTH then
        raise ARRAY_INDEX_ERROR ;
      end if ;
      for J in A'RANGE(2) loop
        SUM := 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 REAL_MATRIX, REAL_VECTOR");
    A1 : REAL_MATRIX(3..4,-3..-1) := (( 3.0,-4.0, 7.0),(-2.0, 1.0,-6.0));
    V1 : REAL_VECTOR(-1..1) :=  (-6.0, 7.0, 9.0);
    VB : REAL_VECTOR(2..3) := (1.0, 2.0); -- raise exception
    V2 : REAL_VECTOR(7..8);
    function REF (A : REAL_MATRIX;
                  V : REAL_VECTOR) return REAL_VECTOR is
      CV : REAL_VECTOR ( A'RANGE(1)) ;
      SUM : REAL ;
    begin
      if A'LENGTH(2) /= V'LENGTH then
        raise ARRAY_INDEX_ERROR ;
      end if ;
      for I in A'RANGE(1) loop
        SUM := 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 RM on REAL_MATRIX");
    A1 : REAL_MATRIX(3..5,-1..0) := (( 3.0, -4.0),( 7.0, 1.0),( 6.0, -5.0));
    XX : REAL := 5.0;
    function REF (X : REAL;
                  A : REAL_MATRIX) return REAL_MATRIX is
      C : REAL_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 MR on REAL_MATRIX");
    A1 : REAL_MATRIX(3..5,-1..0) := (( 3.0, -4.0),( 7.0, 1.0),( 6.0, -5.0));
    XX : REAL := 5.0;
    function REF (A : REAL_MATRIX;
                  X : REAL) return REAL_MATRIX is
      C : REAL_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 REAL_MATRIX");
    A1 : REAL_MATRIX(3..5,-1..0) := (( 3.0, -4.0),( 7.0, 1.0),( 6.0, -5.0));
    XX : REAL := 4.0;
    function REF (A : REAL_MATRIX;
                  X : REAL) return REAL_MATRIX is
      C : REAL_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 : REAL_MATRIX(3..5,-1..1);
    function REF (ORDER : POSITIVE;
                  FIRST_1,FIRST_2 : INTEGER := 1)
                  return REAL_MATRIX is
      A : REAL_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 ;
        end loop ;
        A(I,I-A'FIRST(1)+A'FIRST(2)) := 1.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&"E1");
    exception
      when CONSTRAINT_ERROR =>
        PASS(TEST_MESSAGE&"E1");
      when ARRAY_INDEX_ERROR =>
        FAIL(TEST_MESSAGE&"E1a");
      when others =>
        FAIL(TEST_MESSAGE&"E1b");
    end;
    begin
      A1 := IDENTITY_MATRIX(3,INTEGER'LAST-1);
      FAIL(TEST_MESSAGE&"E2");
    exception
      when CONSTRAINT_ERROR =>
        PASS(TEST_MESSAGE&"E2");
      when ARRAY_INDEX_ERROR =>
        FAIL(TEST_MESSAGE&"E2a");
      when others =>
        FAIL(TEST_MESSAGE&"E2b");
    end;
    begin
      A1 := IDENTITY_MATRIX(ZERO,ZERO,ZERO); -- can not have null identity matrix
      FAIL(TEST_MESSAGE&"E3");
    exception
      when CONSTRAINT_ERROR =>
        PASS(TEST_MESSAGE&"E3");
      when ARRAY_INDEX_ERROR =>
        FAIL(TEST_MESSAGE&"E3a");
      when others =>
        FAIL(TEST_MESSAGE&"E3b");
    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_GENERIC_REAL_ARRAYS;