WITH REPORT; USE REPORT;
PROCEDURE C64109K IS
BEGIN
TEST ("C64109K", "CHECK THAT SLICES OF ARRAYS WHICH ARE " &
"COMPONENTS OF RECORDS ARE PASSED CORRECTLY " &
"TO SUBPROGRAMS - ARRAYS WITH DIFFERENT BOUNDS " &
"PASSED TO UNCONSTRAINED FORMAL");
DECLARE
SUBTYPE SUBINT IS INTEGER RANGE 0..5;
TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;
TYPE RECORD_TYPE IS
RECORD
A : ARRAY_TYPE (IDENT_INT(0)..IDENT_INT(4));
B : ARRAY_TYPE (1..5);
END RECORD;
REC : RECORD_TYPE := (A => (0..4 => IDENT_BOOL(TRUE)),
B => (1..5 => IDENT_BOOL(FALSE)));
BOOL : BOOLEAN;
PROCEDURE P1 (ARR : ARRAY_TYPE; ARR2 : ARRAY_TYPE) IS
BEGIN
IF ARR /= (TRUE, TRUE, TRUE) THEN
FAILED ("IN PARAM NOT PASSED CORRECTLY");
END IF;
IF ARR'FIRST /= IDENT_INT(0) OR ARR'LAST /= 2 THEN
FAILED ("WRONG IN PARAMETER BOUNDS - 1");
END IF;
IF ARR2 /= (FALSE, FALSE, FALSE) THEN
FAILED ("IN PARAM NOT PASSED CORRECTLY - 2");
END IF;
IF ARR2'FIRST /= 1 OR ARR2'LAST /= IDENT_INT(3) THEN
FAILED ("WRONG IN PARAMETER BOUNDS - 2");
END IF;
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED IN PROCEDURE P1");
END P1;
FUNCTION F1 ( ARR : ARRAY_TYPE; ARR2 : ARRAY_TYPE)
RETURN BOOLEAN IS
BEGIN
IF ARR /= (TRUE, TRUE, TRUE) THEN
FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
END IF;
IF ARR'FIRST /= IDENT_INT(1) OR ARR'LAST /= 3 THEN
FAILED ("WRONG IN PARAMETER BOUNDS FOR FN - 1");
END IF;
IF ARR2 /= (FALSE, FALSE, FALSE) THEN
FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
END IF;
IF ARR2'FIRST /= 3 OR ARR2'LAST /= IDENT_INT(5) THEN
FAILED ("WRONG IN PARAMETER BOUNDS FOR FN - 2");
END IF;
RETURN TRUE;
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED IN FUNCTION F1");
END F1;
PROCEDURE P2 (ARR : IN OUT ARRAY_TYPE;
ARR2 : IN OUT ARRAY_TYPE) IS
BEGIN
IF ARR /= (TRUE, TRUE, TRUE) THEN
FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
END IF;
IF ARR'FIRST /= IDENT_INT(2) OR ARR'LAST /= 4 THEN
FAILED ("WRONG IN OUT PARAMETER BOUNDS - 1");
END IF;
IF ARR2 /= (FALSE, FALSE, FALSE) THEN
FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
END IF;
IF ARR2'FIRST /= 2 OR ARR2'LAST /= IDENT_INT(4) THEN
FAILED ("WRONG IN OUT PARAMETER BOUNDS - 2");
END IF;
ARR := (ARR'RANGE => FALSE);
ARR2 := (ARR2'RANGE => TRUE);
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED IN PROCEDURE P2");
END P2;
PROCEDURE P3 (ARR : OUT ARRAY_TYPE; ARR2 : OUT ARRAY_TYPE) IS
BEGIN
IF ARR'FIRST /= IDENT_INT(0) OR ARR'LAST /= 2 THEN
FAILED ("WRONG OUT PARAMETER BOUNDS - 1");
END IF;
IF ARR2'FIRST /= 1 OR ARR2'LAST /= IDENT_INT(3) THEN
FAILED ("WRONG OUT PARAMETER BOUNDS - 2");
END IF;
ARR := (ARR'RANGE => FALSE);
ARR2 := (ARR2'RANGE => TRUE);
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED IN PROCEDURE P3");
END P3;
BEGIN
BEGIN P1 (REC.A (0..2), REC.B (1..3));
IF REC.A /= (TRUE, TRUE, TRUE, TRUE, TRUE) THEN
FAILED ("IN PARAM CHANGED BY PROCEDURE");
END IF;
IF REC.B /= (FALSE, FALSE, FALSE, FALSE, FALSE) THEN
FAILED ("IN PARAM CHANGED BY PROCEDURE - 2");
END IF;
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED DURING CALL OF P1");
END;
BEGIN BOOL := F1 (REC.A (1..3), REC.B (3..5));
IF REC.A /= (TRUE, TRUE, TRUE, TRUE, TRUE) THEN
FAILED ("IN PARAM CHANGED BY FUNCTION");
END IF;
IF REC.B /= (FALSE, FALSE, FALSE, FALSE, FALSE) THEN
FAILED ("IN PARAM CHANGED BY FUNCTION - 2");
END IF;
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED DURING CALL OF F1");
END;
BEGIN P2 (REC.A (2..4), REC.B (2..4));
IF REC.A /= (TRUE, TRUE, FALSE, FALSE, FALSE) THEN
FAILED ("IN OUT PARAM RETURNED INCORRECTLY");
END IF;
IF REC.B /= (FALSE, TRUE, TRUE, TRUE, FALSE) THEN
FAILED ("IN OUT PARAM RETURNED INCORRECTLY - 2");
END IF;
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED DURING CALL OF P2");
END;
BEGIN P3 (REC.A (0..2), REC.B (1..3));
IF REC.A /= (FALSE, FALSE, FALSE, FALSE, FALSE) THEN
FAILED ("OUT PARAM RETURNED INCORRECTLY");
END IF;
IF REC.B /= (TRUE, TRUE, TRUE, TRUE, FALSE) THEN
FAILED ("OUT PARAM RETURNED INCORRECTLY - 2");
END IF;
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED DURING CALL OF P3");
END;
END;
RESULT;
END C64109K;