1-- C37213K.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-- OBJECTIVE: 26-- CHECK, FOR A GENERIC FORMAL TYPE - WHERE A DISCRIMINANT OR AN 27-- INDEX CONSTRAINT DEPENDS ON A RECORD DISCRIMINANT AND THE 28-- RECORD TYPE IS CONSTRAINED BY DEFAULT - USED TO DECLARE AN 29-- ARRAY OR RECORD COMPONENT, THAT THE NON-DISCRIMINANT EXPRESSIONS 30-- OF THE CONSTRAINT ARE CHECKED FOR COMPATIBILITY: 31-- 1) ONLY IN AN OBJECT DECLARATION, AND 32-- 2) ONLY IF THE DESCRIMINANT-DEPENDENT COMPONENT IS PRESENT 33-- IN THE SUBTYPE. 34 35-- HISTORY: 36-- VCL 10/23/88 CREATED ORIGINAL TEST BY SPLITTING FROM C37213J. 37-- VCL 03/30/88 MODIFIED THE TEST DISCRIPTION TO MORE ACCURATELY 38-- DESCRIBE THE OBJECTIVE; CHANGED THE FORMAL 39-- PARAMETERS TO THE GENERIC UNITS AND THE 40-- CORRESPONDING ACTUAL PARAMETERS; REORGANIZED THE 41-- TEST SO THAT ALL OPERATIONS ON A SPECIFIC TYPE 42-- ARE TOGETHER; REWROTE ONE OF THE GENERIC 43-- PACKAGES AS A GENERIC PROCEDURE TO BROADEN 44-- COVERAGE OF TEST. 45 46WITH REPORT; USE REPORT; 47PROCEDURE C37213K IS 48BEGIN 49 TEST ("C37213K", "THE NON-DISCRIMINANT VALUES OF A DISCRIMINANT " & 50 "OR AN INDEX CONSTRAINT THAT DEPEND ON A " & 51 "DISCRIMINANT ARE PROPERLY CHECKED WHEN THE " & 52 "RECORD TYPE IS CONSTRAINED BY DEFAULT AND " & 53 "USED AS THE ACTUAL PARAMETER TO A GENERIC " & 54 "FORMAL TYPE USED TO DECLARE AN ARRAY OR A " & 55 "RECORD COMPONENT"); 56 57 DECLARE 58 SUBTYPE SM IS INTEGER RANGE 1..10; 59 TYPE REC (D1, D2 : SM) IS 60 RECORD NULL; END RECORD; 61 TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER; 62 63 SEQUENCE_NUMBER : INTEGER; 64 65 GENERIC 66 TYPE CONS IS PRIVATE; 67 OBJ_XCP : BOOLEAN; 68 TAG : STRING; 69 PACKAGE ARRAY_COMP_CHK IS END ARRAY_COMP_CHK; 70 71 PACKAGE BODY ARRAY_COMP_CHK IS 72 BEGIN 73 DECLARE 74 TYPE ARR IS ARRAY (1..5) OF CONS; 75 BEGIN 76 DECLARE 77 X : ARR; 78 79 FUNCTION VALUE RETURN ARR IS 80 BEGIN 81 IF EQUAL (3,3) THEN 82 RETURN X; 83 ELSE 84 RETURN X; 85 END IF; 86 END VALUE; 87 BEGIN 88 IF OBJ_XCP THEN 89 FAILED ("NO CHECK DURING DECLARATION " & 90 "OF OBJECT OF TYPE ARR - " & TAG); 91 ELSIF X /= VALUE THEN 92 FAILED ("INCORRECT VALUE FOR OBJECT OF " & 93 "TYPE ARR - " & TAG); 94 END IF; 95 END; 96 EXCEPTION 97 WHEN CONSTRAINT_ERROR => 98 IF NOT OBJ_XCP THEN 99 FAILED ("IMPROPER CONSTRAINT CHECKED " & 100 "DURING DECLARATION OF OBJECT " & 101 "OF TYPE ARR - " & TAG); 102 END IF; 103 END; 104 EXCEPTION 105 WHEN CONSTRAINT_ERROR => 106 FAILED ("CONSTRAINT IMPROPERLY CHECKED " & 107 "DURING DECLARATION OF ARR - " & TAG); 108 END ARRAY_COMP_CHK; 109 110 GENERIC 111 TYPE CONS IS PRIVATE; 112 PROCEDURE REC_COMP_CHK (OBJ_XCP : BOOLEAN; 113 TAG : STRING); 114 115 PROCEDURE REC_COMP_CHK (OBJ_XCP : BOOLEAN; 116 TAG : STRING) IS 117 BEGIN 118 DECLARE 119 TYPE NREC IS 120 RECORD 121 C1 : CONS; 122 END RECORD; 123 BEGIN 124 DECLARE 125 X : NREC; 126 127 FUNCTION VALUE RETURN NREC IS 128 BEGIN 129 IF EQUAL (5, 5) THEN 130 RETURN X; 131 ELSE 132 RETURN X; 133 END IF; 134 END VALUE; 135 BEGIN 136 IF OBJ_XCP THEN 137 FAILED ("NO CHECK DURING DECLARATION " & 138 "OF OBJECT OF TYPE NREC - " & 139 TAG); 140 ELSIF X /= VALUE THEN 141 FAILED ("INCORRECT VALUE FOR OBJECT " & 142 "OF TYPE NREC - " & TAG); 143 END IF; 144 END; 145 EXCEPTION 146 WHEN CONSTRAINT_ERROR => 147 IF NOT OBJ_XCP THEN 148 FAILED ("IMPROPER CONSTRAINT CHECKED " & 149 "DURING DECLARATION OF OBJECT " & 150 "OF TYPE NREC - " & TAG); 151 END IF; 152 END; 153 EXCEPTION 154 WHEN CONSTRAINT_ERROR => 155 FAILED ("CONSTRAINT IMPROPERLY CHECKED " & 156 "DURING DECLARATION OF NREC - " & TAG); 157 END; 158 BEGIN 159 SEQUENCE_NUMBER := 1; 160 DECLARE 161 TYPE REC_DEF (D3 : INTEGER := 1) IS 162 RECORD 163 C1 : REC (D3, 0); 164 END RECORD; 165 166 PACKAGE PACK1 IS NEW ARRAY_COMP_CHK (REC_DEF, 167 OBJ_XCP => TRUE, 168 TAG => "PACK1"); 169 170 PROCEDURE PROC1 IS NEW REC_COMP_CHK (REC_DEF); 171 BEGIN 172 PROC1 (OBJ_XCP => TRUE, TAG => "PROC1"); 173 END; 174 175 SEQUENCE_NUMBER := 2; 176 DECLARE 177 TYPE ARR_DEF (D3 : INTEGER := IDENT_INT(1)) IS 178 RECORD 179 C1 : MY_ARR (0..D3); 180 END RECORD; 181 182 PACKAGE PACK2 IS NEW ARRAY_COMP_CHK (ARR_DEF, 183 OBJ_XCP => TRUE, 184 TAG => "PACK2"); 185 186 PROCEDURE PROC2 IS NEW REC_COMP_CHK (ARR_DEF); 187 BEGIN 188 PROC2 (OBJ_XCP => TRUE, TAG => "PROC2"); 189 END; 190 191 SEQUENCE_NUMBER := 3; 192 DECLARE 193 TYPE VAR_REC_DEF1 (D3 : INTEGER := 1) IS 194 RECORD 195 CASE D3 IS 196 WHEN -5..10 => 197 C1 : REC (D3, IDENT_INT(11)); 198 WHEN OTHERS => 199 C2 : INTEGER := IDENT_INT(5); 200 END CASE; 201 END RECORD; 202 203 PACKAGE PACK3 IS NEW ARRAY_COMP_CHK (VAR_REC_DEF1, 204 OBJ_XCP => TRUE, 205 TAG => "PACK3"); 206 207 PROCEDURE PROC3 IS NEW REC_COMP_CHK (VAR_REC_DEF1); 208 BEGIN 209 PROC3 (OBJ_XCP => TRUE, TAG => "PROC3"); 210 END; 211 212 SEQUENCE_NUMBER := 4; 213 DECLARE 214 TYPE VAR_REC_DEF6 (D3 : INTEGER := IDENT_INT(-6)) IS 215 RECORD 216 CASE D3 IS 217 WHEN -5..10 => 218 C1 : REC (D3, IDENT_INT(11)); 219 WHEN OTHERS => 220 C2 : INTEGER := IDENT_INT(5); 221 END CASE; 222 END RECORD; 223 224 PACKAGE PACK4 IS NEW ARRAY_COMP_CHK (VAR_REC_DEF6, 225 OBJ_XCP => FALSE, 226 TAG => "PACK4"); 227 228 PROCEDURE PROC4 IS NEW REC_COMP_CHK (VAR_REC_DEF6); 229 BEGIN 230 PROC4 (OBJ_XCP => FALSE, TAG => "PROC4"); 231 END; 232 233 SEQUENCE_NUMBER := 5; 234 DECLARE 235 TYPE VAR_REC_DEF11 (D3 : INTEGER := 11) IS 236 RECORD 237 CASE D3 IS 238 WHEN -5..10 => 239 C1 : REC (D3, IDENT_INT(11)); 240 WHEN OTHERS => 241 C2 : INTEGER := IDENT_INT(5); 242 END CASE; 243 END RECORD; 244 245 PACKAGE PACK5 IS NEW ARRAY_COMP_CHK (VAR_REC_DEF11, 246 OBJ_XCP => FALSE, 247 TAG => "PACK5"); 248 249 PROCEDURE PROC5 IS NEW REC_COMP_CHK (VAR_REC_DEF11); 250 BEGIN 251 PROC5 (OBJ_XCP => FALSE, TAG => "PROC5"); 252 END; 253 254 SEQUENCE_NUMBER := 6; 255 DECLARE 256 TYPE VAR_ARR_DEF1 (D3 : INTEGER := IDENT_INT(1)) IS 257 RECORD 258 CASE D3 IS 259 WHEN -5..10 => 260 C1 : MY_ARR(D3..IDENT_INT(11)); 261 WHEN OTHERS => 262 C2 : INTEGER := IDENT_INT(5); 263 END CASE; 264 END RECORD; 265 266 PACKAGE PACK6 IS NEW ARRAY_COMP_CHK (VAR_ARR_DEF1, 267 OBJ_XCP => TRUE, 268 TAG => "PACK6"); 269 270 PROCEDURE PROC6 IS NEW REC_COMP_CHK (VAR_ARR_DEF1); 271 BEGIN 272 PROC6 (OBJ_XCP => TRUE, TAG => "PROC6"); 273 END; 274 275 SEQUENCE_NUMBER := 7; 276 DECLARE 277 TYPE VAR_ARR_DEF6 (D3 : INTEGER := -6) IS 278 RECORD 279 CASE D3 IS 280 WHEN -5..10 => 281 C1 : MY_ARR(D3..IDENT_INT(11)); 282 WHEN OTHERS => 283 C2 : INTEGER := IDENT_INT(5); 284 END CASE; 285 END RECORD; 286 287 PACKAGE PACK7 IS NEW ARRAY_COMP_CHK (VAR_ARR_DEF6, 288 OBJ_XCP => FALSE, 289 TAG => "PACK7"); 290 291 PROCEDURE PROC7 IS NEW REC_COMP_CHK (VAR_ARR_DEF6); 292 BEGIN 293 PROC7 (OBJ_XCP => FALSE, TAG => "PROC7"); 294 END; 295 296 SEQUENCE_NUMBER := 8; 297 DECLARE 298 TYPE VAR_ARR_DEF11 (D3 : INTEGER := IDENT_INT(11)) IS 299 RECORD 300 CASE D3 IS 301 WHEN -5..10 => 302 C1 : MY_ARR(D3..IDENT_INT(11)); 303 WHEN OTHERS => 304 C2 : INTEGER := IDENT_INT(5); 305 END CASE; 306 END RECORD; 307 308 PACKAGE PACK8 IS NEW ARRAY_COMP_CHK (VAR_ARR_DEF11, 309 OBJ_XCP => FALSE, 310 TAG => "PACK8"); 311 312 PROCEDURE PROC8 IS NEW REC_COMP_CHK (VAR_ARR_DEF11); 313 BEGIN 314 PROC8 (OBJ_XCP => FALSE, TAG => "PROC8"); 315 END; 316 EXCEPTION 317 WHEN OTHERS => 318 FAILED ("UNEXPECTED EXCEPTION RAISED DURING " & 319 "DECLARATION / INSTANTIATION ELABORATION - " & 320 INTEGER'IMAGE (SEQUENCE_NUMBER)); 321 END; 322 323 RESULT; 324END C37213K; 325