1-- C37211C.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 CONSTRAINT_ERROR IS RAISED BY A DISCRIMINANT CONSTRAINT 26-- IF A VALUE SPECIFIED FOR A DISCRIMINANT DOES NOT LIE IN THE RANGE 27-- OF THE DISCRIMINANT. THIS TEST CONTAINS CHECKS FOR SUBTYPE 28-- INDICATIONS WHERE THE TYPE MARK DENOTES A PRIVATE OR LIMITED 29-- PRIVATE TYPE, THE DISCRIMINANT CONSTRAINT OCCURS BEFORE THE FULL 30-- DECLARATION OF THE TYPE, AND THERE ARE NO COMPONENTS OF THE TYPE 31-- DEPENDENT ON THE DISCRIMINANT. 32 33-- R.WILLIAMS 8/28/86 34-- EDS 7/14/98 AVOID OPTIMIZATION 35 36WITH REPORT; USE REPORT; 37PROCEDURE C37211C IS 38 39 GLOBAL : BOOLEAN; 40 41 SUBTYPE LIES IS BOOLEAN RANGE FALSE .. FALSE; 42 43 FUNCTION SWITCH (B : BOOLEAN) RETURN BOOLEAN IS 44 BEGIN 45 GLOBAL := B; 46 RETURN B; 47 END SWITCH; 48 49BEGIN 50 TEST ( "C37211C", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " & 51 "A DISCRIMINANT CONSTRAINT IF A VALUE " & 52 "SPECIFIED FOR A DISCRIMINANT DOES NOT LIE " & 53 "IN THE RANGE OF THE DISCRIMINANT WHERE THE " & 54 "TYPE MARK DENOTES A PRIVATE OR LIMITED " & 55 "PRIVATE TYPE, AND THE DISCRIMINANT " & 56 "CONSTRAINT OCCURS BEFORE THE FULL " & 57 "DECLARATION OF THE TYPE" ); 58 59 BEGIN 60 DECLARE 61 62 B1 : BOOLEAN := SWITCH (TRUE); 63 64 PACKAGE PP IS 65 TYPE PRIV1 (D : LIES) IS PRIVATE; 66 SUBTYPE SUBPRIV IS PRIV1 (IDENT_BOOL (TRUE)); 67 68 B2 : BOOLEAN := SWITCH (FALSE); 69 70 PRIVATE 71 TYPE PRIV1 (D : LIES) IS 72 RECORD 73 NULL; 74 END RECORD; 75 END PP; 76 77 USE PP; 78 BEGIN 79 DECLARE 80 SP : SUBPRIV; 81 BEGIN 82 FAILED ( "NO EXCEPTION RAISED AT THE " & 83 "ELABORATION OF SUBTYPE SUBPRIV " & BOOLEAN'IMAGE(SP.D)); 84 END; 85 EXCEPTION 86 WHEN OTHERS => 87 FAILED ( "EXCEPTION RAISED AT DECLARATION OF " & 88 "OBJECT SP" ); 89 END; 90 91 EXCEPTION 92 WHEN CONSTRAINT_ERROR => 93 IF GLOBAL THEN 94 NULL; 95 ELSE 96 FAILED ( "EXCEPTION RAISED AT ELABORATION OF " & 97 "FULL TYPE PRIV1 NOT SUBTYPE SUBPRIV" ); 98 END IF; 99 WHEN OTHERS => 100 FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " & 101 "SUBTYPE SUBPRIV" ); 102 END; 103 104 BEGIN 105 DECLARE 106 107 B1 : BOOLEAN := SWITCH (TRUE); 108 109 PACKAGE PL IS 110 TYPE LIM1 (D : LIES) IS LIMITED PRIVATE; 111 SUBTYPE SUBLIM IS LIM1 (IDENT_BOOL (TRUE)); 112 113 B2 : BOOLEAN := SWITCH (FALSE); 114 115 PRIVATE 116 TYPE LIM1 (D : LIES) IS 117 RECORD 118 NULL; 119 END RECORD; 120 END PL; 121 122 USE PL; 123 BEGIN 124 DECLARE 125 SL : SUBLIM; 126 BEGIN 127 FAILED ( "NO EXCEPTION RAISED AT THE " & 128 "ELABORATION OF SUBTYPE SUBLIM " & BOOLEAN'IMAGE(SL.D)); 129 END; 130 EXCEPTION 131 WHEN OTHERS => 132 FAILED ( "EXCEPTION RAISED AT DECLARATION OF " & 133 "OBJECT SL" ); 134 END; 135 136 EXCEPTION 137 WHEN CONSTRAINT_ERROR => 138 IF GLOBAL THEN 139 NULL; 140 ELSE 141 FAILED ( "EXCEPTION RAISED AT ELABORATION OF " & 142 "FULL TYPE LIM1 NOT SUBTYPE SUBLIM" ); 143 END IF; 144 WHEN OTHERS => 145 FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " & 146 "SUBTYPE SUBLIM" ); 147 END; 148 149 BEGIN 150 DECLARE 151 B1 : BOOLEAN := SWITCH (TRUE); 152 153 PACKAGE PP IS 154 TYPE PRIV2 (D : LIES) IS PRIVATE; 155 TYPE PARR IS ARRAY (1 .. 5) OF 156 PRIV2 (IDENT_BOOL (TRUE)); 157 158 B2 : BOOLEAN := SWITCH (FALSE); 159 160 PRIVATE 161 TYPE PRIV2 (D : LIES) IS 162 RECORD 163 NULL; 164 END RECORD; 165 END PP; 166 167 USE PP; 168 BEGIN 169 DECLARE 170 PAR : PARR; 171 BEGIN 172 FAILED ( "NO EXCEPTION RAISED AT THE " & 173 "ELABORATION OF TYPE PARR " & BOOLEAN'IMAGE(PAR(1).D)); 174 END; 175 EXCEPTION 176 WHEN OTHERS => 177 FAILED ( "EXCEPTION RAISED AT DECLARATION OF " & 178 "OBJECT PAR" ); 179 END; 180 181 EXCEPTION 182 WHEN CONSTRAINT_ERROR => 183 IF GLOBAL THEN 184 NULL; 185 ELSE 186 FAILED ( "EXCEPTION RAISED AT ELABORATION OF " & 187 "FULL TYPE PRIV2 NOT TYPE PARR" ); 188 END IF; 189 WHEN OTHERS => 190 FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " & 191 "TYPE PARR" ); 192 END; 193 194 BEGIN 195 DECLARE 196 B1 : BOOLEAN := SWITCH (TRUE); 197 198 PACKAGE PL IS 199 TYPE LIM2 (D : LIES) IS LIMITED PRIVATE; 200 TYPE LARR IS ARRAY (1 .. 5) OF 201 LIM2 (IDENT_BOOL (TRUE)); 202 203 B2 : BOOLEAN := SWITCH (FALSE); 204 205 PRIVATE 206 TYPE LIM2 (D : LIES) IS 207 RECORD 208 NULL; 209 END RECORD; 210 END PL; 211 212 USE PL; 213 BEGIN 214 DECLARE 215 LAR : LARR; 216 BEGIN 217 FAILED ( "NO EXCEPTION RAISED AT THE " & 218 "ELABORATION OF TYPE LARR " & BOOLEAN'IMAGE(LAR(1).D)); 219 END; 220 EXCEPTION 221 WHEN OTHERS => 222 FAILED ( "EXCEPTION RAISED AT DECLARATION OF " & 223 "OBJECT LAR" ); 224 END; 225 226 EXCEPTION 227 WHEN CONSTRAINT_ERROR => 228 IF GLOBAL THEN 229 NULL; 230 ELSE 231 FAILED ( "EXCEPTION RAISED AT ELABORATION OF " & 232 "FULL TYPE LIM2 NOT TYPE LARR" ); 233 END IF; 234 WHEN OTHERS => 235 FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " & 236 "TYPE LARR" ); 237 END; 238 239 BEGIN 240 DECLARE 241 B1 : BOOLEAN := SWITCH (TRUE); 242 243 PACKAGE PP IS 244 TYPE PRIV3 (D : LIES) IS PRIVATE; 245 246 TYPE PRIV4 IS 247 RECORD 248 X : PRIV3 (IDENT_BOOL (TRUE)); 249 END RECORD; 250 251 B2 : BOOLEAN := SWITCH (FALSE); 252 253 PRIVATE 254 TYPE PRIV3 (D : LIES) IS 255 RECORD 256 NULL; 257 END RECORD; 258 END PP; 259 260 USE PP; 261 BEGIN 262 DECLARE 263 P4 : PRIV4; 264 BEGIN 265 FAILED ( "NO EXCEPTION RAISED AT THE " & 266 "ELABORATION OF TYPE PRIV4 " & BOOLEAN'IMAGE(P4.X.D)); 267 END; 268 EXCEPTION 269 WHEN OTHERS => 270 FAILED ( "EXCEPTION RAISED AT DECLARATION OF " & 271 "OBJECT P4" ); 272 END; 273 274 EXCEPTION 275 WHEN CONSTRAINT_ERROR => 276 IF GLOBAL THEN 277 NULL; 278 ELSE 279 FAILED ( "EXCEPTION RAISED AT ELABORATION OF " & 280 "FULL TYPE PRIV3 NOT TYPE PRIV4" ); 281 END IF; 282 WHEN OTHERS => 283 FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " & 284 "TYPE PRIV4" ); 285 END; 286 287 BEGIN 288 DECLARE 289 B1 : BOOLEAN := SWITCH (TRUE); 290 291 PACKAGE PL IS 292 TYPE LIM3 (D : LIES) IS LIMITED PRIVATE; 293 294 TYPE LIM4 IS 295 RECORD 296 X : LIM3 (IDENT_BOOL (TRUE)); 297 END RECORD; 298 299 B2 : BOOLEAN := SWITCH (FALSE); 300 301 PRIVATE 302 TYPE LIM3 (D : LIES) IS 303 RECORD 304 NULL; 305 END RECORD; 306 END PL; 307 308 USE PL; 309 BEGIN 310 DECLARE 311 L4 : LIM4; 312 BEGIN 313 FAILED ( "NO EXCEPTION RAISED AT THE " & 314 "ELABORATION OF TYPE LIM4 " & BOOLEAN'IMAGE(L4.X.D)); 315 END; 316 EXCEPTION 317 WHEN OTHERS => 318 FAILED ( "EXCEPTION RAISED AT DECLARATION OF " & 319 "OBJECT L4" ); 320 END; 321 322 EXCEPTION 323 WHEN CONSTRAINT_ERROR => 324 IF GLOBAL THEN 325 NULL; 326 ELSE 327 FAILED ( "EXCEPTION RAISED AT ELABORATION OF " & 328 "FULL TYPE LIM3 NOT TYPE LIM4" ); 329 END IF; 330 WHEN OTHERS => 331 FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " & 332 "TYPE LIM4" ); 333 END; 334 335 BEGIN 336 DECLARE 337 B1 : BOOLEAN := SWITCH (TRUE); 338 339 PACKAGE PP IS 340 TYPE PRIV5 (D : LIES) IS PRIVATE; 341 TYPE ACCPRIV IS ACCESS PRIV5 (IDENT_BOOL (TRUE)); 342 343 B2 : BOOLEAN := SWITCH (FALSE); 344 345 PRIVATE 346 TYPE PRIV5 (D : LIES) IS 347 RECORD 348 NULL; 349 END RECORD; 350 END PP; 351 352 USE PP; 353 354 BEGIN 355 DECLARE 356 ACP : ACCPRIV; 357 BEGIN 358 FAILED ( "NO EXCEPTION RAISED AT THE " & 359 "ELABORATION OF TYPE ACCPRIV " & BOOLEAN'IMAGE(ACP.D)); 360 END; 361 EXCEPTION 362 WHEN OTHERS => 363 FAILED ( "EXCEPTION RAISED AT DECLARATION OF " & 364 "OBJECT ACP" ); 365 END; 366 367 EXCEPTION 368 WHEN CONSTRAINT_ERROR => 369 IF GLOBAL THEN 370 NULL; 371 ELSE 372 FAILED ( "EXCEPTION RAISED AT ELABORATION OF " & 373 "FULL TYPE PRIV5 NOT TYPE ACCPRIV" ); 374 END IF; 375 WHEN OTHERS => 376 FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " & 377 "TYPE ACCPRIV" ); 378 END; 379 380 BEGIN 381 DECLARE 382 B1 : BOOLEAN := SWITCH (TRUE); 383 384 PACKAGE PL IS 385 TYPE LIM5 (D : LIES) IS LIMITED PRIVATE; 386 TYPE ACCLIM IS ACCESS LIM5 (IDENT_BOOL (TRUE)); 387 388 B2 : BOOLEAN := SWITCH (FALSE); 389 390 PRIVATE 391 TYPE LIM5 (D : LIES) IS 392 RECORD 393 NULL; 394 END RECORD; 395 END PL; 396 397 USE PL; 398 399 BEGIN 400 DECLARE 401 ACL : ACCLIM; 402 BEGIN 403 FAILED ( "NO EXCEPTION RAISED AT THE " & 404 "ELABORATION OF TYPE ACCLIM " & BOOLEAN'IMAGE(ACL.D)); 405 END; 406 EXCEPTION 407 WHEN OTHERS => 408 FAILED ( "EXCEPTION RAISED AT DECLARATION OF " & 409 "OBJECT ACL" ); 410 END; 411 412 EXCEPTION 413 WHEN CONSTRAINT_ERROR => 414 IF GLOBAL THEN 415 NULL; 416 ELSE 417 FAILED ( "EXCEPTION RAISED AT ELABORATION OF " & 418 "FULL TYPE LIM5 NOT TYPE ACCLIM" ); 419 END IF; 420 WHEN OTHERS => 421 FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " & 422 "TYPE ACCLIM" ); 423 END; 424 425 RESULT; 426END C37211C; 427