1-- C34011B.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 A DERIVED TYPE DECLARATION IS NOT CONSIDERED EXACTLY 27-- EQUIVALENT TO AN ANONYMOUS DECLARATION OF THE DERIVED TYPE 28-- FOLLOWED BY A SUBTYPE DECLARATION OF THE DERIVED SUBTYPE. IN 29-- PARTICULAR, CHECK THAT CONSTRAINT_ERROR CAN BE RAISED WHEN THE 30-- SUBTYPE INDICATION OF THE DERIVED TYPE DECLARATION IS ELABORATED 31-- (EVEN THOUGH THE CONSTRAINT WOULD SATISFY THE DERIVED (BASE) 32-- TYPE). 33 34-- HISTORY: 35-- JRK 09/04/87 CREATED ORIGINAL TEST. 36-- EDS 07/29/98 AVOID OPTIMIZATION 37 38WITH REPORT; USE REPORT; 39 40PROCEDURE C34011B IS 41 42 SUBTYPE BOOL IS BOOLEAN RANGE FALSE .. FALSE; 43 44 SUBTYPE FLT IS FLOAT RANGE -10.0 .. 10.0; 45 46 SUBTYPE DUR IS DURATION RANGE 0.0 .. 10.0; 47 48 SUBTYPE INT IS INTEGER RANGE 0 .. 10; 49 50 TYPE ARR IS ARRAY (INT RANGE <>) OF INTEGER; 51 52 TYPE REC (D : INT := 0) IS 53 RECORD 54 I : INTEGER; 55 END RECORD; 56 57 PACKAGE PT IS 58 TYPE PRIV (D : POSITIVE := 1) IS PRIVATE; 59 PRIVATE 60 TYPE PRIV (D : POSITIVE := 1) IS 61 RECORD 62 I : INTEGER; 63 END RECORD; 64 END PT; 65 66 USE PT; 67 68 TYPE ACC_ARR IS ACCESS ARR; 69 70 TYPE ACC_REC IS ACCESS REC; 71 72BEGIN 73 TEST ("C34011B", "CHECK THAT CONSTRAINT_ERROR CAN BE RAISED " & 74 "WHEN THE SUBTYPE INDICATION OF A DERIVED TYPE " & 75 "DECLARATION IS ELABORATED"); 76 77 BEGIN 78 DECLARE 79 TYPE T IS NEW BOOL RANGE FALSE .. BOOL(IDENT_BOOL(TRUE)); 80 81 BEGIN 82 DECLARE 83 -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION 84 T1 : T := T(IDENT_BOOL(TRUE)); 85 BEGIN 86 FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE"); 87 EXCEPTION 88 WHEN OTHERS => 89 FAILED ("DID NOT RAISE CONSTRAINT_ERROR" & 90 " AT PROPER PLACE - BOOL " & 91 T'IMAGE(T1) ); --USE T1); 92 END; 93 94 FAILED ("EXCEPTION NOT RAISED - BOOL"); 95 96 EXCEPTION 97 WHEN OTHERS => 98 FAILED ("WRONG HANDLER ENTERED - BOOL"); 99 END; 100 101 EXCEPTION 102 WHEN CONSTRAINT_ERROR => 103 NULL; 104 WHEN OTHERS => 105 FAILED ("WRONG EXCEPTION RAISED - BOOL"); 106 END; 107 108 BEGIN 109 DECLARE 110 TYPE T IS NEW POSITIVE RANGE IDENT_INT (0) .. 10; 111 112 BEGIN 113 DECLARE 114 -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION 115 T1 : T := T(IDENT_INT(1)); 116 BEGIN 117 FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE"); 118 EXCEPTION 119 WHEN OTHERS => 120 FAILED ("DID NOT RAISE CONSTRAINT_ERROR - POSITIVE " & 121 T'IMAGE(T1)); --USE T1 122 END; 123 FAILED ("EXCEPTION NOT RAISED - POSITIVE" ); 124 EXCEPTION 125 WHEN OTHERS => 126 FAILED ("WRONG HANDLER ENTERED - POSITIVE"); 127 END; 128 129 EXCEPTION 130 WHEN CONSTRAINT_ERROR => 131 NULL; 132 WHEN OTHERS => 133 FAILED ("WRONG EXCEPTION RAISED - POSITIVE"); 134 END; 135 136 BEGIN 137 DECLARE 138 TYPE T IS NEW FLT RANGE 0.0 .. FLT(IDENT_INT(20)); 139 140 BEGIN 141 DECLARE 142 -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION 143 T1 : T := T(IDENT_INT(0)); 144 BEGIN 145 FAILED ("DID NOT RAISE CONSTRAINT_ERROR" & 146 " AT PROPER PLACE " & 147 T'IMAGE(T1) ); --USE T1 148 149 EXCEPTION 150 WHEN OTHERS => 151 FAILED ("DID NOT RAISE CONSTRAINT_ERROR" & 152 " AT PROPER PLACE "); 153 END; 154 FAILED ("EXCEPTION NOT RAISED - FLT" ); 155 EXCEPTION 156 WHEN OTHERS => 157 FAILED ("WRONG HANDLER ENTERED - FLT"); 158 END; 159 160 EXCEPTION 161 WHEN CONSTRAINT_ERROR => 162 NULL; 163 WHEN OTHERS => 164 FAILED ("WRONG EXCEPTION RAISED - FLT"); 165 END; 166 167 BEGIN 168 DECLARE 169 TYPE T IS NEW DUR RANGE DUR(IDENT_INT(-1)) .. 5.0; 170 171 172 BEGIN 173 DECLARE 174 -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION 175 T1 : T := T(IDENT_INT(2)); 176 BEGIN 177 FAILED ("DID NOT RAISE CONSTRAINT_ERROR" & 178 " AT PROPER PLACE " & 179 T'IMAGE(T1) ); -- USE T1 180 EXCEPTION 181 WHEN OTHERS => 182 FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE"); 183 END; 184 FAILED ("EXCEPTION NOT RAISED - DUR " ); 185 EXCEPTION 186 WHEN OTHERS => 187 FAILED ("WRONG HANDLER ENTERED - DUR"); 188 END; 189 190 EXCEPTION 191 WHEN CONSTRAINT_ERROR => 192 NULL; 193 WHEN OTHERS => 194 FAILED ("WRONG EXCEPTION RAISED - DUR"); 195 END; 196 197 BEGIN 198 DECLARE 199 TYPE T IS NEW ARR (IDENT_INT (-1) .. 10); 200 201 BEGIN 202 DECLARE 203 -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION 204 T1 : T := (OTHERS => IDENT_INT(3)); 205 BEGIN 206 FAILED ("DID NOT RAISE CONSTRAINT_ERROR " & 207 "AT PROPER PLACE " & 208 INTEGER'IMAGE(T1(1)) ); --USE T1 209 EXCEPTION 210 WHEN OTHERS => 211 FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE"); 212 END; 213 FAILED ("EXCEPTION NOT RAISED - ARR " ); 214 EXCEPTION 215 WHEN OTHERS => 216 FAILED ("WRONG HANDLER ENTERED - ARR"); 217 END; 218 219 EXCEPTION 220 WHEN CONSTRAINT_ERROR => 221 NULL; 222 WHEN OTHERS => 223 FAILED ("WRONG EXCEPTION RAISED - ARR"); 224 END; 225 226 BEGIN 227 DECLARE 228 TYPE T IS NEW REC (IDENT_INT (11)); 229 230 BEGIN 231 DECLARE 232 -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION 233 T1 : T; 234 BEGIN 235 FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE"); 236 EXCEPTION 237 WHEN OTHERS => 238 FAILED ("DID NOT RAISE CONSTRAINT_ERROR " & 239 "AT PROPER PLACE " & 240 INTEGER'IMAGE(T1.D) ); --USE T1 241 END; 242 FAILED ("EXCEPTION NOT RAISED - REC " ); 243 EXCEPTION 244 WHEN OTHERS => 245 FAILED ("WRONG HANDLER ENTERED - REC"); 246 END; 247 248 EXCEPTION 249 WHEN CONSTRAINT_ERROR => 250 NULL; 251 WHEN OTHERS => 252 FAILED ("WRONG EXCEPTION RAISED - REC"); 253 END; 254 255 BEGIN 256 DECLARE 257 TYPE T IS NEW PRIV (IDENT_INT (0)); --RAISES C_E 258 259 BEGIN 260 DECLARE 261 -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION 262 T1 : T; 263 BEGIN 264 FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE"); 265 EXCEPTION 266 WHEN OTHERS => 267 FAILED ("DID NOT RAISE CONSTRAINT_ERROR " & 268 "AT PROPER PLACE " & 269 INTEGER'IMAGE(T1.D) ); --USE T1 270 END; 271 FAILED ("EXCEPTION NOT RAISED - PRIV " ); 272 EXCEPTION 273 WHEN OTHERS => 274 FAILED ("WRONG HANDLER ENTERED - PRIV"); 275 END; 276 277 EXCEPTION 278 WHEN CONSTRAINT_ERROR => 279 NULL; 280 WHEN OTHERS => 281 FAILED ("WRONG EXCEPTION RAISED - PRIV"); 282 END; 283 284 BEGIN 285 DECLARE 286 TYPE T IS NEW ACC_ARR (0 .. IDENT_INT (11)); --RAISES C_E 287 288 BEGIN 289 DECLARE 290 -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION 291 T1 : T; 292 BEGIN 293 FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE"); 294 EXCEPTION 295 WHEN OTHERS => 296 FAILED ("DID NOT RAISE CONSTRAINT_ERROR " & 297 "AT PROPER PLACE " & 298 INTEGER'IMAGE(T1(1)) ); --USE T1 299 END; 300 FAILED ("EXCEPTION NOT RAISED - ACC_ARR " ); 301 EXCEPTION 302 WHEN OTHERS => 303 FAILED ("WRONG HANDLER ENTERED - ACC_ARR"); 304 END; 305 306 EXCEPTION 307 WHEN CONSTRAINT_ERROR => 308 NULL; 309 WHEN OTHERS => 310 FAILED ("WRONG EXCEPTION RAISED - ACC_ARR"); 311 END; 312 313 BEGIN 314 DECLARE 315 TYPE T IS NEW ACC_REC (IDENT_INT (-1)); --RAISES C_E 316 317 BEGIN 318 DECLARE 319 -- DEFINE AN OBJECT OF TYPE T AND USE IT TO AVOID OPTIMIZATION 320 T1 : T; 321 BEGIN 322 FAILED ("DID NOT RAISE CONSTRAINT_ERROR AT PROPER PLACE"); 323 EXCEPTION 324 WHEN OTHERS => 325 FAILED ("DID NOT RAISE CONSTRAINT_ERROR " & 326 "AT PROPER PLACE " & 327 INTEGER'IMAGE(T1.D) ); --USE T1 328 END; 329 FAILED ("EXCEPTION NOT RAISED - ACC_REC " ); 330 EXCEPTION 331 WHEN OTHERS => 332 FAILED ("WRONG HANDLER ENTERED - ACC_REC"); 333 END; 334 335 EXCEPTION 336 WHEN CONSTRAINT_ERROR => 337 NULL; 338 WHEN OTHERS => 339 FAILED ("WRONG EXCEPTION RAISED - ACC_REC"); 340 END; 341 342 RESULT; 343END C34011B; 344