1-- C43206A.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 BOUNDS OF A NULL ARRAY AGGREGATE ARE DETERMINED 26-- BY THE BOUNDS SPECIFIED BY THE CHOICES. IN PARTICULAR, CHECK 27-- THAT: 28 29-- A) THE UPPER BOUND IS NOT REQUIRED TO BE THE PREDECESSOR OF 30-- THE LOWER BOUND. 31 32-- B) NEITHER THE UPPER NOR THE LOWER BOUND NEED BELONG TO THE 33-- INDEX SUBTYPE FOR NULL RANGES. 34 35-- C) IF ONE CHOICE OF A MULTIDIMENSIONAL AGGREGATE IS NON-NULL 36-- BUT THE AGGREGATE IS A NULL ARRAY, CONSTRAINT_ERROR IS 37-- RAISED WHEN THE NON-NULL CHOICES DO NOT BELONG TO THE 38-- INDEX SUBTYPE. 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 44-- EG 02/02/84 45-- JBG 12/6/84 46-- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST. 47 48WITH REPORT; 49 50PROCEDURE C43206A IS 51 52 USE REPORT; 53 54BEGIN 55 56 TEST("C43206A", "CHECK THAT THE BOUNDS OF A NULL ARRAY ARE " & 57 "DETERMINED BY THE BOUNDS SPECIFIED BY THE " & 58 "CHOICES"); 59 60 DECLARE 61 62 SUBTYPE ST1 IS INTEGER RANGE 10 .. 15; 63 SUBTYPE ST2 IS INTEGER RANGE 1 .. 5; 64 65 TYPE T1 IS ARRAY (ST1 RANGE <>) OF INTEGER; 66 TYPE T2 IS ARRAY (ST2 RANGE <>, ST1 RANGE <>) OF INTEGER; 67 68 BEGIN 69 70CASE_A : BEGIN 71 72 CASE_A1 : DECLARE 73 74 PROCEDURE PROC1 (A : T1) IS 75 BEGIN 76 IF A'FIRST /= 12 OR A'LAST /= 10 THEN 77 FAILED ("CASE A1 : INCORRECT BOUNDS"); 78 END IF; 79 END PROC1; 80 81 BEGIN 82 83 PROC1((12 .. 10 => -2)); 84 85 EXCEPTION 86 87 WHEN OTHERS => 88 FAILED ("CASE A1 : EXCEPTION RAISED"); 89 90 END CASE_A1; 91 92 CASE_A2 : DECLARE 93 94 PROCEDURE PROC1 (A : STRING) IS 95 BEGIN 96 IF A'FIRST /= 5 OR A'LAST /= 2 THEN 97 FAILED ("CASE A2 : INCORRECT BOUNDS"); 98 END IF; 99 END PROC1; 100 101 BEGIN 102 103 PROC1 ((5 .. 2 => 'E')); 104 105 EXCEPTION 106 107 WHEN OTHERS => 108 FAILED ("CASE A2 : EXCEPTION RAISED"); 109 110 END CASE_A2; 111 112 END CASE_A; 113 114CASE_B : BEGIN 115 116 CASE_B1 : DECLARE 117 118 PROCEDURE PROC1 (A : T1; L, U : INTEGER) IS 119 BEGIN 120 IF A'FIRST /= L OR A'LAST /= U THEN 121 FAILED ("CASE B1 : INCORRECT BOUNDS"); 122 END IF; 123 END PROC1; 124 125 BEGIN 126 127 BEGIN 128 129 PROC1 ((5 .. INTEGER'FIRST => -2), 130 5, INTEGER'FIRST); 131 132 EXCEPTION 133 134 WHEN CONSTRAINT_ERROR => 135 FAILED ("CASE B1A : CONSTRAINT_ERROR " & 136 "RAISED FOR NULL RANGE"); 137 WHEN OTHERS => 138 FAILED ("CASE B1A : EXCEPTION RAISED"); 139 140 END; 141 142 BEGIN 143 144 PROC1 ((IDENT_INT(6) .. 3 => -2),6,3); 145 146 EXCEPTION 147 148 WHEN OTHERS => 149 FAILED ("CASE B1B : EXCEPTION RAISED"); 150 151 END; 152 153 END CASE_B1; 154 155 CASE_B2 : DECLARE 156 157 PROCEDURE PROC1 (A : STRING) IS 158 BEGIN 159 IF A'FIRST /= 1 OR 160 A'LAST /= INTEGER'FIRST THEN 161 FAILED ("CASE B2 : INCORRECT BOUNDS"); 162 END IF; 163 END PROC1; 164 165 BEGIN 166 167 PROC1 ((1 .. INTEGER'FIRST => ' ')); 168 169 EXCEPTION 170 171 WHEN OTHERS => 172 FAILED ("CASE B2 : EXCEPTION RAISED"); 173 174 END CASE_B2; 175 176 END CASE_B; 177 178CASE_C : BEGIN 179 180 CASE_C1 : DECLARE 181 182 PROCEDURE PROC1 (A : T2) IS 183 BEGIN 184 IF A'FIRST(1) /= 5 OR A'LAST(1) /= 3 OR 185 A'FIRST(2) /= INTEGER'LAST-1 OR 186 A'LAST(2) /= INTEGER'LAST THEN 187 FAILED ("CASE C1 : INCORRECT BOUNDS"); 188 END IF; 189 END PROC1; 190 191 BEGIN 192 193 PROC1 ((5 .. 3 => 194 (IDENT_INT(INTEGER'LAST-1) .. 195 IDENT_INT(INTEGER'LAST) => -2))); 196 FAILED ("CASE C1 : CONSTRAINT_ERROR NOT RAISED"); 197 198 EXCEPTION 199 200 WHEN CONSTRAINT_ERROR => 201 NULL; 202 203 WHEN OTHERS => 204 FAILED ("CASE C1 : EXCEPTION RAISED"); 205 206 END CASE_C1; 207 208 CASE_C2 : DECLARE 209 210 PROCEDURE PROC1 (A : T2) IS 211 BEGIN 212 IF A'FIRST(1) /= INTEGER'FIRST OR 213 A'LAST(1) /= INTEGER'FIRST+1 OR 214 A'FIRST(2) /= 14 OR A'LAST(2) /= 11 THEN 215 FAILED ("CASE C2 : INCORRECT BOUNDS"); 216 END IF; 217 END PROC1; 218 219 BEGIN 220 221 PROC1 ((IDENT_INT(INTEGER'FIRST) .. 222 IDENT_INT(INTEGER'FIRST+1) => 223 (14 .. IDENT_INT(11) => -2))); 224 FAILED ("CASE C2 : CONSTRAINT_ERROR NOT RAISED"); 225 226 EXCEPTION 227 228 WHEN CONSTRAINT_ERROR => 229 NULL; 230 231 WHEN OTHERS => 232 FAILED ("CASE C2 : EXCEPTION RAISED"); 233 234 END CASE_C2; 235 236 END CASE_C; 237 238 END; 239 240 RESULT; 241 242END C43206A; 243