-- C64103C.ADA
|
-- C64103C.ADA
|
|
|
-- Grant of Unlimited Rights
|
-- Grant of Unlimited Rights
|
--
|
--
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
|
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
|
-- unlimited rights in the software and documentation contained herein.
|
-- unlimited rights in the software and documentation contained herein.
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- this public release, the Government intends to confer upon all
|
-- this public release, the Government intends to confer upon all
|
-- recipients unlimited rights equal to those held by the Government.
|
-- recipients unlimited rights equal to those held by the Government.
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- released technical data and computer software in whole or in part, in
|
-- released technical data and computer software in whole or in part, in
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- to do so.
|
-- to do so.
|
--
|
--
|
-- DISCLAIMER
|
-- DISCLAIMER
|
--
|
--
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
--*
|
--*
|
-- CHECK THAT THE APPROPRIATE EXCEPTION IS RAISED FOR TYPE CONVERSIONS
|
-- CHECK THAT THE APPROPRIATE EXCEPTION IS RAISED FOR TYPE CONVERSIONS
|
-- ON IN OUT ARRAY PARAMETERS. IN PARTICULAR:
|
-- ON IN OUT ARRAY PARAMETERS. IN PARTICULAR:
|
-- (A) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN THE ACTUAL
|
-- (A) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN THE ACTUAL
|
-- COMPONENT'S CONSTRAINTS DIFFER FROM THE FORMAL COMPONENT'S
|
-- COMPONENT'S CONSTRAINTS DIFFER FROM THE FORMAL COMPONENT'S
|
-- CONSTRAINTS.
|
-- CONSTRAINTS.
|
-- (B) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN CONVERSION TO
|
-- (B) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN CONVERSION TO
|
-- AN UNCONSTRAINED ARRAY TYPE CAUSES AN ACTUAL INDEX BOUND TO LIE
|
-- AN UNCONSTRAINED ARRAY TYPE CAUSES AN ACTUAL INDEX BOUND TO LIE
|
-- OUTSIDE OF A FORMAL INDEX SUBTYPE FOR A NON-NULL DIMENSION (SEE
|
-- OUTSIDE OF A FORMAL INDEX SUBTYPE FOR A NON-NULL DIMENSION (SEE
|
-- AI-00313 FOR MULTIDIMENSIONAL CASE)
|
-- AI-00313 FOR MULTIDIMENSIONAL CASE)
|
-- (C) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL FOR CONVERSION TO A
|
-- (C) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL FOR CONVERSION TO A
|
-- CONSTRAINED ARRAY TYPE WHEN THE NUMBER OF COMPONENTS PER
|
-- CONSTRAINED ARRAY TYPE WHEN THE NUMBER OF COMPONENTS PER
|
-- DIMENSION OF THE ACTUAL DIFFERS FROM THAT OF THE FORMAL.
|
-- DIMENSION OF THE ACTUAL DIFFERS FROM THAT OF THE FORMAL.
|
-- (D) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN CONVERSION TO AN
|
-- (D) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN CONVERSION TO AN
|
-- UNCONSTRAINED ARRAY TYPE CAUSES AN ACTUAL INDEX BOUND TO LIE
|
-- UNCONSTRAINED ARRAY TYPE CAUSES AN ACTUAL INDEX BOUND TO LIE
|
-- OUTSIDE OF THE BASE INDEX TYPE OF THE FORMAL.
|
-- OUTSIDE OF THE BASE INDEX TYPE OF THE FORMAL.
|
|
|
-- *** NOTE: This test has been modified since ACVC version 1.11 to -- 9X
|
-- *** NOTE: This test has been modified since ACVC version 1.11 to -- 9X
|
-- *** remove incompatibilities associated with the transition -- 9X
|
-- *** remove incompatibilities associated with the transition -- 9X
|
-- *** to Ada 9X. -- 9X
|
-- *** to Ada 9X. -- 9X
|
-- *** -- 9X
|
-- *** -- 9X
|
|
|
-- CPP 07/19/84
|
-- CPP 07/19/84
|
-- JBG 06/05/85
|
-- JBG 06/05/85
|
-- EG 10/29/85 FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
|
-- EG 10/29/85 FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
|
-- AI-00387.
|
-- AI-00387.
|
-- MRM 03/30/93 REMOVE NUMERIC_ERROR FOR 9X COMPATIBILITY
|
-- MRM 03/30/93 REMOVE NUMERIC_ERROR FOR 9X COMPATIBILITY
|
-- PWN 01/31/95 REMOVED INCONSISTENCIES WITH ADA 9X.
|
-- PWN 01/31/95 REMOVED INCONSISTENCIES WITH ADA 9X.
|
|
|
WITH SYSTEM;
|
WITH SYSTEM;
|
WITH REPORT; USE REPORT;
|
WITH REPORT; USE REPORT;
|
PROCEDURE C64103C IS
|
PROCEDURE C64103C IS
|
|
|
BEGIN
|
BEGIN
|
TEST ("C64103C", "CHECK THAT APPROPRIATE EXCEPTION IS RAISED ON " &
|
TEST ("C64103C", "CHECK THAT APPROPRIATE EXCEPTION IS RAISED ON " &
|
"TYPE CONVERSIONS OF IN OUT ARRAY PARAMETERS");
|
"TYPE CONVERSIONS OF IN OUT ARRAY PARAMETERS");
|
|
|
-----------------------------------------------
|
-----------------------------------------------
|
|
|
DECLARE -- (A)
|
DECLARE -- (A)
|
BEGIN -- (A)
|
BEGIN -- (A)
|
|
|
DECLARE
|
DECLARE
|
TYPE SUBINT IS RANGE 0..8;
|
TYPE SUBINT IS RANGE 0..8;
|
TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;
|
TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;
|
A0 : ARRAY_TYPE (0..3) := (0..3 => TRUE);
|
A0 : ARRAY_TYPE (0..3) := (0..3 => TRUE);
|
|
|
PROCEDURE P2 (X : IN OUT ARRAY_TYPE) IS
|
PROCEDURE P2 (X : IN OUT ARRAY_TYPE) IS
|
BEGIN
|
BEGIN
|
NULL;
|
NULL;
|
END P2;
|
END P2;
|
BEGIN
|
BEGIN
|
P2 (ARRAY_TYPE (A0)); -- OK.
|
P2 (ARRAY_TYPE (A0)); -- OK.
|
EXCEPTION
|
EXCEPTION
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("EXCEPTION RAISED -P2 (A)");
|
FAILED ("EXCEPTION RAISED -P2 (A)");
|
END;
|
END;
|
|
|
END; -- (A)
|
END; -- (A)
|
|
|
-----------------------------------------------
|
-----------------------------------------------
|
|
|
DECLARE -- (B1) NON-NULL ACTUAL PARAMETER
|
DECLARE -- (B1) NON-NULL ACTUAL PARAMETER
|
|
|
TYPE SUBINT IS RANGE 0..8;
|
TYPE SUBINT IS RANGE 0..8;
|
TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;
|
TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;
|
TYPE AR1 IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
|
TYPE AR1 IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
|
A1 : AR1 (-1..7) := (-1..7 => TRUE);
|
A1 : AR1 (-1..7) := (-1..7 => TRUE);
|
A2 : AR1 (1..9) := (1..9 => TRUE);
|
A2 : AR1 (1..9) := (1..9 => TRUE);
|
|
|
PROCEDURE P1 (X : IN OUT ARRAY_TYPE) IS
|
PROCEDURE P1 (X : IN OUT ARRAY_TYPE) IS
|
BEGIN
|
BEGIN
|
FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (B)");
|
FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (B)");
|
END P1;
|
END P1;
|
|
|
BEGIN -- (B1)
|
BEGIN -- (B1)
|
|
|
BEGIN
|
BEGIN
|
COMMENT ("CALL TO P1 (B1) ON A1");
|
COMMENT ("CALL TO P1 (B1) ON A1");
|
P1 (ARRAY_TYPE (A1));
|
P1 (ARRAY_TYPE (A1));
|
EXCEPTION
|
EXCEPTION
|
WHEN CONSTRAINT_ERROR =>
|
WHEN CONSTRAINT_ERROR =>
|
NULL;
|
NULL;
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("WRONG EXCEPTION RAISED -P1 (B1)");
|
FAILED ("WRONG EXCEPTION RAISED -P1 (B1)");
|
END;
|
END;
|
|
|
BEGIN
|
BEGIN
|
COMMENT ("CALL TO P1 (B1) ON A2");
|
COMMENT ("CALL TO P1 (B1) ON A2");
|
P1 (ARRAY_TYPE (A2));
|
P1 (ARRAY_TYPE (A2));
|
EXCEPTION
|
EXCEPTION
|
WHEN CONSTRAINT_ERROR =>
|
WHEN CONSTRAINT_ERROR =>
|
NULL;
|
NULL;
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("WRONG EXCEPTION RAISED -P1 (B1)");
|
FAILED ("WRONG EXCEPTION RAISED -P1 (B1)");
|
END;
|
END;
|
|
|
END; -- (B1)
|
END; -- (B1)
|
|
|
DECLARE -- (B2) NULL ACTUAL PARAMETER; MULTIDIMENSIONAL
|
DECLARE -- (B2) NULL ACTUAL PARAMETER; MULTIDIMENSIONAL
|
|
|
TYPE SUBINT IS RANGE 0..8;
|
TYPE SUBINT IS RANGE 0..8;
|
TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>,
|
TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>,
|
SUBINT RANGE <>) OF BOOLEAN;
|
SUBINT RANGE <>) OF BOOLEAN;
|
TYPE AR1 IS ARRAY (INTEGER RANGE <>,
|
TYPE AR1 IS ARRAY (INTEGER RANGE <>,
|
INTEGER RANGE <>)OF BOOLEAN;
|
INTEGER RANGE <>)OF BOOLEAN;
|
A1 : AR1 (IDENT_INT(-1)..7, 5..4) :=
|
A1 : AR1 (IDENT_INT(-1)..7, 5..4) :=
|
(OTHERS => (OTHERS => TRUE));
|
(OTHERS => (OTHERS => TRUE));
|
A2 : AR1 (5..4, 1..IDENT_INT(9)) :=
|
A2 : AR1 (5..4, 1..IDENT_INT(9)) :=
|
(OTHERS => (OTHERS => TRUE));
|
(OTHERS => (OTHERS => TRUE));
|
PROCEDURE P1 (X : IN OUT ARRAY_TYPE) IS
|
PROCEDURE P1 (X : IN OUT ARRAY_TYPE) IS
|
BEGIN
|
BEGIN
|
FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (B)");
|
FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (B)");
|
END P1;
|
END P1;
|
|
|
BEGIN -- (B2)
|
BEGIN -- (B2)
|
|
|
BEGIN
|
BEGIN
|
COMMENT ("CALL TO P1 (B2) ON A1");
|
COMMENT ("CALL TO P1 (B2) ON A1");
|
P1 (ARRAY_TYPE (A1));
|
P1 (ARRAY_TYPE (A1));
|
EXCEPTION
|
EXCEPTION
|
WHEN CONSTRAINT_ERROR =>
|
WHEN CONSTRAINT_ERROR =>
|
NULL;
|
NULL;
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("WRONG EXCEPTION RAISED -P1 (B2)");
|
FAILED ("WRONG EXCEPTION RAISED -P1 (B2)");
|
END;
|
END;
|
|
|
BEGIN
|
BEGIN
|
COMMENT ("CALL TO P1 (B2) ON A2");
|
COMMENT ("CALL TO P1 (B2) ON A2");
|
P1 (ARRAY_TYPE (A2));
|
P1 (ARRAY_TYPE (A2));
|
EXCEPTION
|
EXCEPTION
|
WHEN CONSTRAINT_ERROR =>
|
WHEN CONSTRAINT_ERROR =>
|
NULL;
|
NULL;
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("WRONG EXCEPTION RAISED -P1 (B2)");
|
FAILED ("WRONG EXCEPTION RAISED -P1 (B2)");
|
END;
|
END;
|
|
|
END; -- (B2)
|
END; -- (B2)
|
|
|
-----------------------------------------------
|
-----------------------------------------------
|
|
|
BEGIN -- (C)
|
BEGIN -- (C)
|
|
|
DECLARE
|
DECLARE
|
TYPE INDEX1 IS RANGE 1..3;
|
TYPE INDEX1 IS RANGE 1..3;
|
TYPE INDEX2 IS RANGE 1..4;
|
TYPE INDEX2 IS RANGE 1..4;
|
TYPE AR_TYPE IS ARRAY (INDEX1, INDEX2) OF BOOLEAN;
|
TYPE AR_TYPE IS ARRAY (INDEX1, INDEX2) OF BOOLEAN;
|
A0 : AR_TYPE := (1..3 => (1..4 => FALSE));
|
A0 : AR_TYPE := (1..3 => (1..4 => FALSE));
|
|
|
TYPE I1 IS RANGE 1..4;
|
TYPE I1 IS RANGE 1..4;
|
TYPE I2 IS RANGE 1..3;
|
TYPE I2 IS RANGE 1..3;
|
TYPE ARRAY_TYPE IS ARRAY (I1, I2) OF BOOLEAN;
|
TYPE ARRAY_TYPE IS ARRAY (I1, I2) OF BOOLEAN;
|
|
|
PROCEDURE P1 (X : IN OUT ARRAY_TYPE) IS
|
PROCEDURE P1 (X : IN OUT ARRAY_TYPE) IS
|
BEGIN
|
BEGIN
|
FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (C)");
|
FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (C)");
|
END P1;
|
END P1;
|
BEGIN
|
BEGIN
|
P1 (ARRAY_TYPE (A0));
|
P1 (ARRAY_TYPE (A0));
|
EXCEPTION
|
EXCEPTION
|
WHEN CONSTRAINT_ERROR =>
|
WHEN CONSTRAINT_ERROR =>
|
NULL;
|
NULL;
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("WRONG EXCEPTION RAISED -P1 (C)");
|
FAILED ("WRONG EXCEPTION RAISED -P1 (C)");
|
END;
|
END;
|
|
|
END; -- (C)
|
END; -- (C)
|
|
|
-----------------------------------------------
|
-----------------------------------------------
|
|
|
DECLARE -- (D)
|
DECLARE -- (D)
|
BEGIN -- (D)
|
BEGIN -- (D)
|
|
|
DECLARE
|
DECLARE
|
TYPE SM_INT IS RANGE 0..2;
|
TYPE SM_INT IS RANGE 0..2;
|
TYPE LG IS RANGE 0 .. SYSTEM.MAX_INT;
|
TYPE LG IS RANGE 0 .. SYSTEM.MAX_INT;
|
SUBTYPE LG_INT IS LG RANGE SYSTEM.MAX_INT - 3 ..
|
SUBTYPE LG_INT IS LG RANGE SYSTEM.MAX_INT - 3 ..
|
SYSTEM.MAX_INT;
|
SYSTEM.MAX_INT;
|
TYPE AR_SMALL IS ARRAY (SM_INT RANGE <>) OF BOOLEAN;
|
TYPE AR_SMALL IS ARRAY (SM_INT RANGE <>) OF BOOLEAN;
|
TYPE AR_LARGE IS ARRAY (LG_INT RANGE <>) OF BOOLEAN;
|
TYPE AR_LARGE IS ARRAY (LG_INT RANGE <>) OF BOOLEAN;
|
A0 : AR_LARGE (SYSTEM.MAX_INT - 2..SYSTEM.MAX_INT) :=
|
A0 : AR_LARGE (SYSTEM.MAX_INT - 2..SYSTEM.MAX_INT) :=
|
(SYSTEM.MAX_INT - 2..SYSTEM.MAX_INT => TRUE);
|
(SYSTEM.MAX_INT - 2..SYSTEM.MAX_INT => TRUE);
|
|
|
PROCEDURE P1 (X : IN OUT AR_SMALL) IS
|
PROCEDURE P1 (X : IN OUT AR_SMALL) IS
|
BEGIN
|
BEGIN
|
FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (D)");
|
FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (D)");
|
END P1;
|
END P1;
|
BEGIN
|
BEGIN
|
IF LG (SM_INT'BASE'LAST) < LG_INT'BASE'LAST THEN
|
IF LG (SM_INT'BASE'LAST) < LG_INT'BASE'LAST THEN
|
P1 (AR_SMALL (A0));
|
P1 (AR_SMALL (A0));
|
ELSE
|
ELSE
|
COMMENT ("NOT APPLICABLE -P1 (D)");
|
COMMENT ("NOT APPLICABLE -P1 (D)");
|
END IF;
|
END IF;
|
EXCEPTION
|
EXCEPTION
|
WHEN CONSTRAINT_ERROR =>
|
WHEN CONSTRAINT_ERROR =>
|
COMMENT ("CONSTRAINT_ERROR RAISED - P1 (D)");
|
COMMENT ("CONSTRAINT_ERROR RAISED - P1 (D)");
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("WRONG EXCEPTION RAISED - P1 (D)");
|
FAILED ("WRONG EXCEPTION RAISED - P1 (D)");
|
END;
|
END;
|
|
|
END; -- (D)
|
END; -- (D)
|
|
|
-----------------------------------------------
|
-----------------------------------------------
|
|
|
RESULT;
|
RESULT;
|
|
|
END C64103C;
|
END C64103C;
|
|
|