1-- C64103D.ADA 2 3-- Grant of Unlimited Rights 4-- 5-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, 6-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 7-- unlimited rights in the software and documentation contained herein. 8-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making 9-- this public release, the Government intends to confer upon all 10-- recipients unlimited rights equal to those held by the Government. 11-- These rights include rights to use, duplicate, release or disclose the 12-- released technical data and computer software in whole or in part, in 13-- any manner and for any purpose whatsoever, and to have or permit others 14-- to do so. 15-- 16-- DISCLAIMER 17-- 18-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR 19-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 20-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE 21-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 22-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A 23-- PARTICULAR PURPOSE OF SAID MATERIAL. 24--* 25-- CHECK THAT THE APPROPRIATE EXCEPTION IS RAISED FOR TYPE CONVERSIONS 26-- ON OUT ARRAY PARAMETERS. IN PARTICULAR: 27-- (A) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN THE ACTUAL 28-- COMPONENT'S CONSTRAINTS DIFFER FROM THE FORMAL COMPONENT'S 29-- CONSTRAINTS. 30-- (B) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN CONVERSION TO 31-- AN UNCONSTRAINED ARRAY TYPE CAUSES AN ACTUAL INDEX BOUND TO LIE 32-- OUTSIDE OF A FORMAL INDEX SUBTYPE. 33-- (C) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL FOR CONVERSION TO A 34-- CONSTRAINED ARRAY TYPE WHEN THE NUMBER OF COMPONENTS PER 35-- DIMENSION OF THE ACTUAL DIFFERS FROM THAT OF THE FORMAL. 36-- (D) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN CONVERSION TO AN 37-- UNCONSTRAINED ARRAY TYPE CAUSES AN ACTUAL INDEX BOUND TO LIE 38-- OUTSIDE OF THE BASE INDEX TYPE OF THE FORMAL. 39 40-- *** NOTE: This test has been modified since ACVC version 1.11 to -- 9X 41-- *** remove incompatibilities associated with the transition -- 9X 42-- *** to Ada 9X. -- 9X 43-- *** -- 9X 44 45-- CPP 07/19/84 46-- EG 10/29/85 FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO 47-- AI-00387. 48-- MRM 03/30/93 REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY 49-- PWN 01/31/95 REMOVED INCONSISTENCIES WITH ADA 9X. 50 51WITH SYSTEM; 52WITH REPORT; USE REPORT; 53PROCEDURE C64103D IS 54 55 BEGIN 56 TEST ("C64103D", "CHECK THAT APPROPRIATE EXCEPTION IS RAISED ON " & 57 "TYPE CONVERSIONS OF OUT ARRAY PARAMETERS"); 58 59 ----------------------------------------------- 60 61 DECLARE -- (A) 62 BEGIN -- (A) 63 64 DECLARE 65 TYPE SUBINT IS RANGE 0..8; 66 TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN; 67 A0 : ARRAY_TYPE (0..3) := (0..3 => TRUE); 68 69 PROCEDURE P2 (X : OUT ARRAY_TYPE) IS 70 BEGIN 71 NULL; 72 END P2; 73 BEGIN 74 P2 (ARRAY_TYPE (A0)); -- OK. 75 EXCEPTION 76 WHEN OTHERS => 77 FAILED ("EXCEPTION RAISED -P2 (A)"); 78 END; 79 80 END; -- (A) 81 82 ----------------------------------------------- 83 84 DECLARE -- (B) 85 86 TYPE SUBINT IS RANGE 0..8; 87 TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN; 88 TYPE AR1 IS ARRAY (INTEGER RANGE <>) OF BOOLEAN; 89 A1 : AR1 (-1..7) := (-1..7 => TRUE); 90 A2 : AR1 (1..9) := (1..9 => TRUE); 91 92 PROCEDURE P1 (X : OUT ARRAY_TYPE) IS 93 BEGIN 94 FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (B)"); 95 END P1; 96 97 BEGIN -- (B) 98 99 BEGIN 100 COMMENT ("CALL TO P1 (B) ON A1"); 101 P1 (ARRAY_TYPE (A1)); 102 EXCEPTION 103 WHEN CONSTRAINT_ERROR => 104 NULL; 105 WHEN OTHERS => 106 FAILED ("WRONG EXCEPTION RAISED -P1 (B)"); 107 END; 108 109 BEGIN 110 COMMENT ("CALL TO P1 (B) ON A2"); 111 P1 (ARRAY_TYPE (A2)); 112 EXCEPTION 113 WHEN CONSTRAINT_ERROR => 114 NULL; 115 WHEN OTHERS => 116 FAILED ("WRONG EXCEPTION RAISED -P1 (B)"); 117 END; 118 119 END; -- (B) 120 121 ----------------------------------------------- 122 123 DECLARE -- (C) 124 BEGIN -- (C) 125 126 DECLARE 127 TYPE INDEX1 IS RANGE 1..3; 128 TYPE INDEX2 IS RANGE 1..4; 129 TYPE AR_TYPE IS ARRAY (INDEX1, INDEX2) OF BOOLEAN; 130 A0 : AR_TYPE := (1..3 => (1..4 => FALSE)); 131 132 TYPE I1 IS RANGE 1..4; 133 TYPE I2 IS RANGE 1..3; 134 TYPE ARRAY_TYPE IS ARRAY (I1, I2) OF BOOLEAN; 135 136 PROCEDURE P1 (X : OUT ARRAY_TYPE) IS 137 BEGIN 138 FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (C)"); 139 END P1; 140 BEGIN 141 P1 (ARRAY_TYPE (A0)); 142 EXCEPTION 143 WHEN CONSTRAINT_ERROR => 144 NULL; 145 WHEN OTHERS => 146 FAILED ("WRONG EXCEPTION RAISED -P1 (C)"); 147 END; 148 149 END; -- (C) 150 151 ----------------------------------------------- 152 153 DECLARE -- (D) 154 BEGIN -- (D) 155 156 DECLARE 157 TYPE SM_INT IS RANGE 0..2; 158 TYPE LG_INT IS RANGE SYSTEM.MIN_INT..SYSTEM.MAX_INT; 159 TYPE AR_SMALL IS ARRAY (SM_INT RANGE <>) OF BOOLEAN; 160 TYPE AR_LARGE IS ARRAY (LG_INT RANGE <>) OF BOOLEAN; 161 A0 : AR_LARGE (SYSTEM.MAX_INT - 2..SYSTEM.MAX_INT) := 162 (SYSTEM.MAX_INT - 2..SYSTEM.MAX_INT => TRUE); 163 164 PROCEDURE P1 (X : OUT AR_SMALL) IS 165 BEGIN 166 FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (D)"); 167 END P1; 168 BEGIN 169 IF LG_INT (SM_INT'BASE'LAST) < LG_INT'BASE'LAST THEN 170 P1 (AR_SMALL (A0)); 171 ELSE 172 COMMENT ("NOT APPLICABLE -P1 (D)"); 173 END IF; 174 EXCEPTION 175 WHEN CONSTRAINT_ERROR => 176 COMMENT ("CONSTRAINT_ERROR RAISED - P1 (D)"); 177 WHEN OTHERS => 178 FAILED ("WRONG EXCEPTION RAISED - P1 (D)"); 179 END; 180 181 END; -- (D) 182 183 ----------------------------------------------- 184 185 RESULT; 186 187END C64103D; 188