1-- C64103C.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 IN 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 FOR A NON-NULL DIMENSION (SEE 33-- AI-00313 FOR MULTIDIMENSIONAL CASE) 34-- (C) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL FOR CONVERSION TO A 35-- CONSTRAINED ARRAY TYPE WHEN THE NUMBER OF COMPONENTS PER 36-- DIMENSION OF THE ACTUAL DIFFERS FROM THAT OF THE FORMAL. 37-- (D) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN CONVERSION TO AN 38-- UNCONSTRAINED ARRAY TYPE CAUSES AN ACTUAL INDEX BOUND TO LIE 39-- OUTSIDE OF THE BASE INDEX TYPE OF THE FORMAL. 40 41-- *** NOTE: This test has been modified since ACVC version 1.11 to -- 9X 42-- *** remove incompatibilities associated with the transition -- 9X 43-- *** to Ada 9X. -- 9X 44-- *** -- 9X 45 46-- CPP 07/19/84 47-- JBG 06/05/85 48-- EG 10/29/85 FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO 49-- AI-00387. 50-- MRM 03/30/93 REMOVE NUMERIC_ERROR FOR 9X COMPATIBILITY 51-- PWN 01/31/95 REMOVED INCONSISTENCIES WITH ADA 9X. 52 53WITH SYSTEM; 54WITH REPORT; USE REPORT; 55PROCEDURE C64103C IS 56 57 BEGIN 58 TEST ("C64103C", "CHECK THAT APPROPRIATE EXCEPTION IS RAISED ON " & 59 "TYPE CONVERSIONS OF IN OUT ARRAY PARAMETERS"); 60 61 ----------------------------------------------- 62 63 DECLARE -- (A) 64 BEGIN -- (A) 65 66 DECLARE 67 TYPE SUBINT IS RANGE 0..8; 68 TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN; 69 A0 : ARRAY_TYPE (0..3) := (0..3 => TRUE); 70 71 PROCEDURE P2 (X : IN OUT ARRAY_TYPE) IS 72 BEGIN 73 NULL; 74 END P2; 75 BEGIN 76 P2 (ARRAY_TYPE (A0)); -- OK. 77 EXCEPTION 78 WHEN OTHERS => 79 FAILED ("EXCEPTION RAISED -P2 (A)"); 80 END; 81 82 END; -- (A) 83 84 ----------------------------------------------- 85 86 DECLARE -- (B1) NON-NULL ACTUAL PARAMETER 87 88 TYPE SUBINT IS RANGE 0..8; 89 TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN; 90 TYPE AR1 IS ARRAY (INTEGER RANGE <>) OF BOOLEAN; 91 A1 : AR1 (-1..7) := (-1..7 => TRUE); 92 A2 : AR1 (1..9) := (1..9 => TRUE); 93 94 PROCEDURE P1 (X : IN OUT ARRAY_TYPE) IS 95 BEGIN 96 FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (B)"); 97 END P1; 98 99 BEGIN -- (B1) 100 101 BEGIN 102 COMMENT ("CALL TO P1 (B1) ON A1"); 103 P1 (ARRAY_TYPE (A1)); 104 EXCEPTION 105 WHEN CONSTRAINT_ERROR => 106 NULL; 107 WHEN OTHERS => 108 FAILED ("WRONG EXCEPTION RAISED -P1 (B1)"); 109 END; 110 111 BEGIN 112 COMMENT ("CALL TO P1 (B1) ON A2"); 113 P1 (ARRAY_TYPE (A2)); 114 EXCEPTION 115 WHEN CONSTRAINT_ERROR => 116 NULL; 117 WHEN OTHERS => 118 FAILED ("WRONG EXCEPTION RAISED -P1 (B1)"); 119 END; 120 121 END; -- (B1) 122 123 DECLARE -- (B2) NULL ACTUAL PARAMETER; MULTIDIMENSIONAL 124 125 TYPE SUBINT IS RANGE 0..8; 126 TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>, 127 SUBINT RANGE <>) OF BOOLEAN; 128 TYPE AR1 IS ARRAY (INTEGER RANGE <>, 129 INTEGER RANGE <>)OF BOOLEAN; 130 A1 : AR1 (IDENT_INT(-1)..7, 5..4) := 131 (OTHERS => (OTHERS => TRUE)); 132 A2 : AR1 (5..4, 1..IDENT_INT(9)) := 133 (OTHERS => (OTHERS => TRUE)); 134 PROCEDURE P1 (X : IN OUT ARRAY_TYPE) IS 135 BEGIN 136 FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (B)"); 137 END P1; 138 139 BEGIN -- (B2) 140 141 BEGIN 142 COMMENT ("CALL TO P1 (B2) ON A1"); 143 P1 (ARRAY_TYPE (A1)); 144 EXCEPTION 145 WHEN CONSTRAINT_ERROR => 146 NULL; 147 WHEN OTHERS => 148 FAILED ("WRONG EXCEPTION RAISED -P1 (B2)"); 149 END; 150 151 BEGIN 152 COMMENT ("CALL TO P1 (B2) ON A2"); 153 P1 (ARRAY_TYPE (A2)); 154 EXCEPTION 155 WHEN CONSTRAINT_ERROR => 156 NULL; 157 WHEN OTHERS => 158 FAILED ("WRONG EXCEPTION RAISED -P1 (B2)"); 159 END; 160 161 END; -- (B2) 162 163 ----------------------------------------------- 164 165 BEGIN -- (C) 166 167 DECLARE 168 TYPE INDEX1 IS RANGE 1..3; 169 TYPE INDEX2 IS RANGE 1..4; 170 TYPE AR_TYPE IS ARRAY (INDEX1, INDEX2) OF BOOLEAN; 171 A0 : AR_TYPE := (1..3 => (1..4 => FALSE)); 172 173 TYPE I1 IS RANGE 1..4; 174 TYPE I2 IS RANGE 1..3; 175 TYPE ARRAY_TYPE IS ARRAY (I1, I2) OF BOOLEAN; 176 177 PROCEDURE P1 (X : IN OUT ARRAY_TYPE) IS 178 BEGIN 179 FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (C)"); 180 END P1; 181 BEGIN 182 P1 (ARRAY_TYPE (A0)); 183 EXCEPTION 184 WHEN CONSTRAINT_ERROR => 185 NULL; 186 WHEN OTHERS => 187 FAILED ("WRONG EXCEPTION RAISED -P1 (C)"); 188 END; 189 190 END; -- (C) 191 192 ----------------------------------------------- 193 194 DECLARE -- (D) 195 BEGIN -- (D) 196 197 DECLARE 198 TYPE SM_INT IS RANGE 0..2; 199 TYPE LG IS RANGE 0 .. SYSTEM.MAX_INT; 200 SUBTYPE LG_INT IS LG RANGE SYSTEM.MAX_INT - 3 .. 201 SYSTEM.MAX_INT; 202 TYPE AR_SMALL IS ARRAY (SM_INT RANGE <>) OF BOOLEAN; 203 TYPE AR_LARGE IS ARRAY (LG_INT RANGE <>) OF BOOLEAN; 204 A0 : AR_LARGE (SYSTEM.MAX_INT - 2..SYSTEM.MAX_INT) := 205 (SYSTEM.MAX_INT - 2..SYSTEM.MAX_INT => TRUE); 206 207 PROCEDURE P1 (X : IN OUT AR_SMALL) IS 208 BEGIN 209 FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (D)"); 210 END P1; 211 BEGIN 212 IF LG (SM_INT'BASE'LAST) < LG_INT'BASE'LAST THEN 213 P1 (AR_SMALL (A0)); 214 ELSE 215 COMMENT ("NOT APPLICABLE -P1 (D)"); 216 END IF; 217 EXCEPTION 218 WHEN CONSTRAINT_ERROR => 219 COMMENT ("CONSTRAINT_ERROR RAISED - P1 (D)"); 220 WHEN OTHERS => 221 FAILED ("WRONG EXCEPTION RAISED - P1 (D)"); 222 END; 223 224 END; -- (D) 225 226 ----------------------------------------------- 227 228 RESULT; 229 230END C64103C; 231