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