1-- C37215H.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 THAT IF AN INDEX CONSTRAINT DEPENDS ON A DISCRIMINANT, 27-- THE DISCRIMINANT VALUE IS CHECKED FOR COMPATIBILITY WHEN THE 28-- RECORD TYPE IS: 29-- 30-- CASE D: CONSTRAINED BY DEFAULT AND THE COMPONENT IS 31-- PRESENT IN THE SUBTYPE. 32 33-- HISTORY: 34-- JBG 10/17/86 CREATED ORIGINAL TEST. 35-- RJW 10/13/87 CORRECTED VARIOUS CONSTRAINT ERRORS IN 'CASE D1'. 36-- VCL 03/30/88 CORRECTED VARIOUS CONSTRAINT ERRORS WITH TYPE 37-- DECLARATIONS THROUGHOUT THE TEST. ADDED SEQUENCE 38-- NUMBERS. 39 40WITH REPORT; USE REPORT; 41PROCEDURE C37215H IS 42 43 SUBTYPE SM IS INTEGER RANGE 1..10; 44 TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER; 45 46 SEQUENCE_NUMBER : INTEGER; 47BEGIN 48 TEST ("C37215H", "THE DISCRIMINANT VALUES OF AN INDEX " & 49 "CONSTRAINT ARE PROPERLY CHECK FOR " & 50 "COMPATIBILITY WHEN THE DISCRIMINANT IS " & 51 "DEFINED BY DEFAULT AND THE COMPONENT IS AND " & 52 "IS NOT PRESENT IN THE SUBTYPE"); 53 54-- CASE D1: COMPONENT IS PRESENT 55 56 SEQUENCE_NUMBER := 1; 57 DECLARE 58 TYPE CONS (D3 : INTEGER := IDENT_INT(0)) IS 59 RECORD 60 CASE D3 IS 61 WHEN -5..10 => 62 C1 : MY_ARR(D3..1); 63 WHEN OTHERS => 64 C2 : INTEGER := IDENT_INT(0); 65 END CASE; 66 END RECORD; 67 BEGIN 68 BEGIN 69 DECLARE 70 X : CONS; 71 BEGIN 72 FAILED ("INDEX CHECK NOT PERFORMED - 1"); 73 IF X /= (1, (1, 1)) THEN 74 COMMENT ("SHOULDN'T GET HERE"); 75 END IF; 76 END; 77 EXCEPTION 78 WHEN CONSTRAINT_ERROR => 79 NULL; 80 WHEN OTHERS => 81 FAILED ("UNEXPECTED EXCEPTION RAISED - 1"); 82 END; 83 84 BEGIN 85 DECLARE 86 SUBTYPE SCONS IS CONS; 87 BEGIN 88 DECLARE 89 X : SCONS; 90 BEGIN 91 FAILED ("INDEX CHECK NOT PERFORMED - 2"); 92 IF X /= (1, (1, 1)) THEN 93 COMMENT ("IRRELEVANT"); 94 END IF; 95 END; 96 EXCEPTION 97 WHEN CONSTRAINT_ERROR => 98 NULL; 99 WHEN OTHERS => 100 FAILED ("UNEXPECTED EXCEPTION RAISED - 2A"); 101 END; 102 EXCEPTION 103 WHEN OTHERS => 104 FAILED ("UNEXPECTED EXCEPTION RAISED - 2B"); 105 END; 106 107 BEGIN 108 DECLARE 109 TYPE ARR IS ARRAY (1..5) OF CONS; 110 BEGIN 111 DECLARE 112 X : ARR; 113 BEGIN 114 FAILED ("INDEX CHECK NOT PERFORMED - 3"); 115 IF X /= (1..5 => (1, (1, 1))) THEN 116 COMMENT ("IRRELEVANT"); 117 END IF; 118 END; 119 EXCEPTION 120 WHEN CONSTRAINT_ERROR => 121 NULL; 122 WHEN OTHERS => 123 FAILED ("UNEXPECTED EXCEPTION RAISED - 3A"); 124 END; 125 EXCEPTION 126 WHEN OTHERS => 127 FAILED ("UNEXPECTED EXCEPTION RAISED - 3B"); 128 END; 129 130 BEGIN 131 DECLARE 132 TYPE NREC IS 133 RECORD 134 C1 : CONS; 135 END RECORD; 136 BEGIN 137 DECLARE 138 X : NREC; 139 BEGIN 140 FAILED ("INDEX CHECK NOT PERFORMED - 4"); 141 IF X /= (C1 => (1, (1, 1))) THEN 142 COMMENT ("IRRELEVANT"); 143 END IF; 144 END; 145 EXCEPTION 146 WHEN CONSTRAINT_ERROR => 147 NULL; 148 WHEN OTHERS => 149 FAILED ("UNEXPECTED EXCEPTION RAISED - 4A"); 150 END; 151 EXCEPTION 152 WHEN OTHERS => 153 FAILED ("UNEXPECTED EXCEPTION RAISED - 4B"); 154 END; 155 156 BEGIN 157 DECLARE 158 TYPE NREC IS NEW CONS; 159 BEGIN 160 DECLARE 161 X : NREC; 162 BEGIN 163 FAILED ("INDEX CHECK NOT PERFORMED - 5"); 164 IF X /= (1, (1, 1)) THEN 165 COMMENT ("IRRELEVANT"); 166 END IF; 167 END; 168 EXCEPTION 169 WHEN CONSTRAINT_ERROR => 170 NULL; 171 WHEN OTHERS => 172 FAILED ("UNEXPECTED EXCEPTION RAISED - 5A"); 173 END; 174 EXCEPTION 175 WHEN OTHERS => 176 FAILED ("UNEXPECTED EXCEPTION RAISED - 5B"); 177 END; 178 179 BEGIN 180 DECLARE 181 TYPE ACC_CONS IS ACCESS CONS; 182 BEGIN 183 DECLARE 184 X : ACC_CONS; 185 BEGIN 186 X := NEW CONS; 187 FAILED ("INDEX CHECK NOT PERFORMED - 6"); 188 IF X.ALL /= (1, (1, 1)) THEN 189 COMMENT ("WRONG VALUE FOR X - 6"); 190 END IF; 191 EXCEPTION 192 WHEN CONSTRAINT_ERROR => 193 NULL; 194 WHEN OTHERS => 195 FAILED ("UNEXPECTED EXCEPTION RAISED " & 196 "- 6A"); 197 END; 198 EXCEPTION 199 WHEN OTHERS => 200 FAILED ("UNEXPECTED EXCEPTION RAISED - 6B"); 201 END; 202 EXCEPTION 203 WHEN OTHERS => 204 FAILED ("UNEXPECTED EXCEPTION RAISED - 6C"); 205 END; 206 END; 207 208-- CASE D2: COMPONENT IS ABSENT 209 210 SEQUENCE_NUMBER := 2; 211 DECLARE 212 TYPE CONS (D3 : INTEGER := IDENT_INT(11)) IS 213 RECORD 214 CASE D3 IS 215 WHEN -5..10 => 216 C1 : MY_ARR(IDENT_INT(2)..D3); 217 WHEN OTHERS => 218 C2 : INTEGER := IDENT_INT(5); 219 END CASE; 220 END RECORD; 221 BEGIN 222 BEGIN 223 DECLARE 224 X : CONS; 225 BEGIN 226 IF X /= (11, 5) THEN 227 COMMENT ("X VALUE IS INCORRECT - 11"); 228 END IF; 229 END; 230 EXCEPTION 231 WHEN CONSTRAINT_ERROR => 232 NULL; 233 WHEN OTHERS => 234 FAILED ("UNEXPECTED EXCEPTION RAISED - 11"); 235 END; 236 237 BEGIN 238 DECLARE 239 SUBTYPE SCONS IS CONS; 240 BEGIN 241 DECLARE 242 X : SCONS; 243 BEGIN 244 IF X /= (11, 5) THEN 245 FAILED ("X VALUE INCORRECT - 12"); 246 END IF; 247 END; 248 EXCEPTION 249 WHEN OTHERS => 250 FAILED ("UNEXPECTED EXCEPTION RAISED - 12A"); 251 END; 252 EXCEPTION 253 WHEN OTHERS => 254 FAILED ("UNEXPECTED EXCEPTION RAISED - 12B"); 255 END; 256 257 BEGIN 258 DECLARE 259 TYPE ARR IS ARRAY (1..5) OF CONS; 260 BEGIN 261 DECLARE 262 X : ARR; 263 BEGIN 264 IF X /= (1..5 => (11, 5)) THEN 265 FAILED ("X VALUE INCORRECT - 13"); 266 END IF; 267 END; 268 EXCEPTION 269 WHEN OTHERS => 270 FAILED ("UNEXPECTED EXCEPTION RAISED - 13A"); 271 END; 272 EXCEPTION 273 WHEN OTHERS => 274 FAILED ("UNEXPECTED EXCEPTION RAISED - 13B"); 275 END; 276 277 BEGIN 278 DECLARE 279 TYPE NREC IS 280 RECORD 281 C1 : CONS; 282 END RECORD; 283 BEGIN 284 DECLARE 285 X : NREC; 286 BEGIN 287 IF X /= (C1 => (11, 5)) THEN 288 FAILED ("X VALUE INCORRECT - 14"); 289 END IF; 290 END; 291 EXCEPTION 292 WHEN OTHERS => 293 FAILED ("UNEXPECTED EXCEPTION RAISED - 14A"); 294 END; 295 EXCEPTION 296 WHEN OTHERS => 297 FAILED ("UNEXPECTED EXCEPTION RAISED - 14B"); 298 END; 299 300 BEGIN 301 DECLARE 302 TYPE NREC IS NEW CONS; 303 BEGIN 304 DECLARE 305 X : NREC; 306 BEGIN 307 IF X /= (11, 5) THEN 308 FAILED ("X VALUE INCORRECT - 15"); 309 END IF; 310 END; 311 EXCEPTION 312 WHEN OTHERS => 313 FAILED ("UNEXPECTED EXCEPTION RAISED - 15A"); 314 END; 315 EXCEPTION 316 WHEN OTHERS => 317 FAILED ("UNEXPECTED EXCEPTION RAISED - 15B"); 318 END; 319 320 BEGIN 321 DECLARE 322 TYPE ACC_CONS IS ACCESS CONS; 323 X : ACC_CONS; 324 BEGIN 325 X := NEW CONS; 326 IF X.ALL /= (11, 5) THEN 327 FAILED ("X VALUE INCORRECT - 17"); 328 END IF; 329 EXCEPTION 330 WHEN OTHERS => 331 FAILED ("UNEXPECTED EXCEPTION RAISED - 17A"); 332 END; 333 EXCEPTION 334 WHEN OTHERS => 335 FAILED ("UNEXPECTED EXCEPTION RAISED - 17B"); 336 END; 337 END; 338 339 RESULT; 340EXCEPTION 341 WHEN OTHERS => 342 FAILED ("INDEX VALUES CHECKED TOO SOON - " & 343 INTEGER'IMAGE(SEQUENCE_NUMBER)); 344 RESULT; 345END C37215H; 346