WITH REPORT; USE REPORT;
PROCEDURE C46044B IS
TYPE ARR1 IS ARRAY (INTEGER RANGE <>) OF INTEGER;
SUBTYPE CARR1A IS ARR1 (IDENT_INT (1) .. IDENT_INT (6));
C1A : CARR1A := (CARR1A'RANGE => 0);
SUBTYPE CARR1B IS ARR1 (IDENT_INT (2) .. IDENT_INT (5));
C1B : CARR1B := (CARR1B'RANGE => 0);
SUBTYPE CARR1N IS ARR1 (IDENT_INT (1) .. IDENT_INT (0));
C1N : CARR1N := (CARR1N'RANGE => 0);
TYPE ARR2 IS ARRAY (INTEGER RANGE <>, INTEGER RANGE <>) OF
INTEGER;
SUBTYPE CARR2A IS ARR2 (IDENT_INT (1) .. IDENT_INT (2),
IDENT_INT (1) .. IDENT_INT (2));
C2A : CARR2A := (CARR2A'RANGE (1) => (CARR2A'RANGE (2) => 0));
SUBTYPE CARR2B IS ARR2 (IDENT_INT (0) .. IDENT_INT (2),
IDENT_INT (0) .. IDENT_INT (2));
C2B : CARR2B := (CARR2B'RANGE (1) => (CARR2B'RANGE (2) => 0));
SUBTYPE CARR2N IS ARR2 (IDENT_INT (2) .. IDENT_INT (1),
IDENT_INT (1) .. IDENT_INT (2));
C2N : CARR2N := (CARR2N'RANGE (1) => (CARR2N'RANGE (2) => 0));
PROCEDURE CHECK1 (A : ARR1; STR : STRING) IS
BEGIN
FAILED ( "NO EXCEPTION RAISED - " & STR );
END CHECK1;
PROCEDURE CHECK2 (A : ARR2; STR : STRING) IS
BEGIN
FAILED ( "NO EXCEPTION RAISED - " & STR );
END CHECK2;
BEGIN
TEST ( "C46044B", "CHECK THAT CONSTRAINT ERROR IS RAISED FOR " &
"CONVERSION TO A CONSTRAINED ARRAY TYPE " &
"IF THE TARGET TYPE IS NON-NULL AND " &
"CORRESPONDING DIMENSIONS OF THE TARGET AND " &
"OPERAND DO NOT HAVE THE SAME LENGTH. " &
"ALSO, CHECK THAT CONSTRAINT_ERROR IS " &
"RAISED IF THE TARGET TYPE IS NULL AND " &
"THE OPERAND TYPE IS NON-NULL" );
BEGIN C1A := C1B;
CHECK1 (C1A, "(A)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ( "WRONG EXCEPTION RAISED - (A)" );
END;
BEGIN CHECK1 (CARR1A (C1B), "(B)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ( "WRONG EXCEPTION RAISED - (B)" );
END;
BEGIN C1B := C1A;
CHECK1 (C1B, "(C)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ( "WRONG EXCEPTION RAISED - (C)" );
END;
BEGIN CHECK1 (CARR1B (C1A), "(D)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ( "WRONG EXCEPTION RAISED - (D)" );
END;
BEGIN C1A := C1N;
CHECK1 (C1A, "(E)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ( "WRONG EXCEPTION RAISED - (E)" );
END;
BEGIN CHECK1 (CARR1A (C1N), "(F)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ( "WRONG EXCEPTION RAISED - (F)" );
END;
BEGIN C2A := C2B;
CHECK2 (C2A, "(G)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ( "WRONG EXCEPTION RAISED - (G)" );
END;
BEGIN CHECK2 (CARR2A (C2B), "(H)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ( "WRONG EXCEPTION RAISED - (H)" );
END;
BEGIN C2B := C2A;
CHECK2 (C2B, "(I)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ( "WRONG EXCEPTION RAISED - (I)" );
END;
BEGIN CHECK2 (CARR2A (C2B), "(J)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ( "WRONG EXCEPTION RAISED - (J)" );
END;
BEGIN C2A := C2N;
CHECK2 (C2A, "(K)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ( "WRONG EXCEPTION RAISED - (K)" );
END;
BEGIN CHECK2 (CARR2A (C2N), "(L)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ( "WRONG EXCEPTION RAISED - (L)" );
END;
BEGIN C1N := C1A;
CHECK1 (C1N, "(M)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ( "WRONG EXCEPTION RAISED - (M)" );
END;
BEGIN CHECK1 (CARR1N (C1A), "(N)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ( "WRONG EXCEPTION RAISED - (N)" );
END;
BEGIN C2N := C2A;
CHECK2 (C2N, "(O)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ( "WRONG EXCEPTION RAISED - (O)" );
END;
BEGIN CHECK2 (CARR2N (C2A), "(P)");
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ( "WRONG EXCEPTION RAISED - (P)" );
END;
RESULT;
END C46044B;