1-- C46051A.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 ENUMERATION, RECORD, ACCESS, PRIVATE, AND TASK VALUES CAN 26-- BE CONVERTED IF THE OPERAND AND TARGET TYPES ARE RELATED BY 27-- DERIVATION. 28 29-- R.WILLIAMS 9/8/86 30 31WITH REPORT; USE REPORT; 32PROCEDURE C46051A IS 33 34BEGIN 35 TEST ( "C46051A", "CHECK THAT ENUMERATION, RECORD, ACCESS, " & 36 "PRIVATE, AND TASK VALUES CAN BE CONVERTED " & 37 "IF THE OPERAND AND TARGET TYPES ARE " & 38 "RELATED BY DERIVATION" ); 39 40 DECLARE 41 TYPE ENUM IS (A, AB, ABC, ABCD); 42 E : ENUM := ABC; 43 44 TYPE ENUM1 IS NEW ENUM; 45 E1 : ENUM1 := ENUM1'VAL (IDENT_INT (2)); 46 47 TYPE ENUM2 IS NEW ENUM; 48 E2 : ENUM2 := ABC; 49 50 TYPE NENUM1 IS NEW ENUM1; 51 NE : NENUM1 := NENUM1'VAL (IDENT_INT (2)); 52 BEGIN 53 IF ENUM (E) /= E THEN 54 FAILED ( "INCORRECT CONVERSION OF 'ENUM (E)'" ); 55 END IF; 56 57 IF ENUM (E1) /= E THEN 58 FAILED ( "INCORRECT CONVERSION OF 'ENUM (E1)'" ); 59 END IF; 60 61 IF ENUM1 (E2) /= E1 THEN 62 FAILED ( "INCORRECT CONVERSION OF 'ENUM1 (E2)'" ); 63 END IF; 64 65 IF ENUM2 (NE) /= E2 THEN 66 FAILED ( "INCORRECT CONVERSION OF 'ENUM2 (NE)'" ); 67 END IF; 68 69 IF NENUM1 (E) /= NE THEN 70 FAILED ( "INCORRECT CONVERSION OF 'NENUM (E)'" ); 71 END IF; 72 EXCEPTION 73 WHEN OTHERS => 74 FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " & 75 "ENUMERATION TYPES" ); 76 END; 77 78 DECLARE 79 TYPE REC IS 80 RECORD 81 NULL; 82 END RECORD; 83 84 R : REC; 85 86 TYPE REC1 IS NEW REC; 87 R1 : REC1; 88 89 TYPE REC2 IS NEW REC; 90 R2 : REC2; 91 92 TYPE NREC1 IS NEW REC1; 93 NR : NREC1; 94 BEGIN 95 IF REC (R) /= R THEN 96 FAILED ( "INCORRECT CONVERSION OF 'REC (R)'" ); 97 END IF; 98 99 IF REC (R1) /= R THEN 100 FAILED ( "INCORRECT CONVERSION OF 'REC (R1)'" ); 101 END IF; 102 103 IF REC1 (R2) /= R1 THEN 104 FAILED ( "INCORRECT CONVERSION OF 'REC1 (R2)'" ); 105 END IF; 106 107 IF REC2 (NR) /= R2 THEN 108 FAILED ( "INCORRECT CONVERSION OF 'REC2 (NR)'" ); 109 END IF; 110 111 IF NREC1 (R) /= NR THEN 112 FAILED ( "INCORRECT CONVERSION OF 'NREC (R)'" ); 113 END IF; 114 EXCEPTION 115 WHEN OTHERS => 116 FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " & 117 "RECORD TYPES" ); 118 END; 119 120 DECLARE 121 TYPE REC (D : INTEGER) IS 122 RECORD 123 NULL; 124 END RECORD; 125 126 SUBTYPE CREC IS REC (3); 127 R : CREC; 128 129 TYPE CREC1 IS NEW REC (3); 130 R1 : CREC1; 131 132 TYPE CREC2 IS NEW REC (3); 133 R2 : CREC2; 134 135 TYPE NCREC1 IS NEW CREC1; 136 NR : NCREC1; 137 BEGIN 138 IF CREC (R) /= R THEN 139 FAILED ( "INCORRECT CONVERSION OF 'CREC (R)'" ); 140 END IF; 141 142 IF CREC (R1) /= R THEN 143 FAILED ( "INCORRECT CONVERSION OF 'CREC (R1)'" ); 144 END IF; 145 146 IF CREC1 (R2) /= R1 THEN 147 FAILED ( "INCORRECT CONVERSION OF 'CREC1 (R2)'" ); 148 END IF; 149 150 IF CREC2 (NR) /= R2 THEN 151 FAILED ( "INCORRECT CONVERSION OF 'CREC2 (NR)'" ); 152 END IF; 153 154 IF NCREC1 (R) /= NR THEN 155 FAILED ( "INCORRECT CONVERSION OF 'NCREC (R)'" ); 156 END IF; 157 EXCEPTION 158 WHEN OTHERS => 159 FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " & 160 "RECORD TYPES WITH DISCRIMINANTS" ); 161 END; 162 163 DECLARE 164 TYPE REC IS 165 RECORD 166 NULL; 167 END RECORD; 168 169 TYPE ACCREC IS ACCESS REC; 170 AR : ACCREC; 171 172 TYPE ACCREC1 IS NEW ACCREC; 173 AR1 : ACCREC1; 174 175 TYPE ACCREC2 IS NEW ACCREC; 176 AR2 : ACCREC2; 177 178 TYPE NACCREC1 IS NEW ACCREC1; 179 NAR : NACCREC1; 180 181 FUNCTION F (A : ACCREC) RETURN INTEGER IS 182 BEGIN 183 RETURN IDENT_INT (0); 184 END F; 185 186 FUNCTION F (A : ACCREC1) RETURN INTEGER IS 187 BEGIN 188 RETURN IDENT_INT (1); 189 END F; 190 191 FUNCTION F (A : ACCREC2) RETURN INTEGER IS 192 BEGIN 193 RETURN IDENT_INT (2); 194 END F; 195 196 FUNCTION F (A : NACCREC1) RETURN INTEGER IS 197 BEGIN 198 RETURN IDENT_INT (3); 199 END F; 200 201 BEGIN 202 IF F (ACCREC (AR)) /= 0 THEN 203 FAILED ( "INCORRECT CONVERSION OF 'ACCREC (AR)'" ); 204 END IF; 205 206 IF F (ACCREC (AR1)) /= 0 THEN 207 FAILED ( "INCORRECT CONVERSION OF 'ACCREC (AR1)'" ); 208 END IF; 209 210 IF F (ACCREC1 (AR2)) /= 1 THEN 211 FAILED ( "INCORRECT CONVERSION OF 'ACCREC1 (AR2)'" ); 212 END IF; 213 214 IF F (ACCREC2 (NAR)) /= 2 THEN 215 FAILED ( "INCORRECT CONVERSION OF 'ACCREC2 (NAR)'" ); 216 END IF; 217 218 IF F (NACCREC1 (AR)) /= 3 THEN 219 FAILED ( "INCORRECT CONVERSION OF 'NACCREC (AR)'" ); 220 END IF; 221 EXCEPTION 222 WHEN OTHERS => 223 FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " & 224 "ACCESS TYPES" ); 225 END; 226 227 DECLARE 228 TYPE REC (D : INTEGER) IS 229 RECORD 230 NULL; 231 END RECORD; 232 233 TYPE ACCR IS ACCESS REC; 234 235 SUBTYPE CACCR IS ACCR (3); 236 AR : CACCR; 237 238 TYPE CACCR1 IS NEW ACCR (3); 239 AR1 : CACCR1; 240 241 TYPE CACCR2 IS NEW ACCR (3); 242 AR2 : CACCR2; 243 244 TYPE NCACCR1 IS NEW CACCR1; 245 NAR : NCACCR1; 246 247 FUNCTION F (A : CACCR) RETURN INTEGER IS 248 BEGIN 249 RETURN IDENT_INT (0); 250 END F; 251 252 FUNCTION F (A : CACCR1) RETURN INTEGER IS 253 BEGIN 254 RETURN IDENT_INT (1); 255 END F; 256 257 FUNCTION F (A : CACCR2) RETURN INTEGER IS 258 BEGIN 259 RETURN IDENT_INT (2); 260 END F; 261 262 FUNCTION F (A : NCACCR1) RETURN INTEGER IS 263 BEGIN 264 RETURN IDENT_INT (3); 265 END F; 266 267 BEGIN 268 IF F (CACCR (AR)) /= 0 THEN 269 FAILED ( "INCORRECT CONVERSION OF 'CACCR (AR)'" ); 270 END IF; 271 272 IF F (CACCR (AR1)) /= 0 THEN 273 FAILED ( "INCORRECT CONVERSION OF 'CACCR (AR1)'" ); 274 END IF; 275 276 IF F (CACCR1 (AR2)) /= 1 THEN 277 FAILED ( "INCORRECT CONVERSION OF 'CACCR1 (AR2)'" ); 278 END IF; 279 280 IF F (CACCR2 (NAR)) /= 2 THEN 281 FAILED ( "INCORRECT CONVERSION OF 'CACCR2 (NAR)'" ); 282 END IF; 283 284 IF F (NCACCR1 (AR)) /= 3 THEN 285 FAILED ( "INCORRECT CONVERSION OF 'NCACCR (AR)'" ); 286 END IF; 287 EXCEPTION 288 WHEN OTHERS => 289 FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " & 290 "CONSTRAINED ACCESS TYPES" ); 291 END; 292 293 DECLARE 294 PACKAGE PKG1 IS 295 TYPE PRIV IS PRIVATE; 296 PRIVATE 297 TYPE PRIV IS 298 RECORD 299 NULL; 300 END RECORD; 301 END PKG1; 302 303 USE PKG1; 304 305 PACKAGE PKG2 IS 306 R : PRIV; 307 308 TYPE PRIV1 IS NEW PRIV; 309 R1 : PRIV1; 310 311 TYPE PRIV2 IS NEW PRIV; 312 R2 : PRIV2; 313 END PKG2; 314 315 USE PKG2; 316 317 PACKAGE PKG3 IS 318 TYPE NPRIV1 IS NEW PRIV1; 319 NR : NPRIV1; 320 END PKG3; 321 322 USE PKG3; 323 BEGIN 324 IF PRIV (R) /= R THEN 325 FAILED ( "INCORRECT CONVERSION OF 'PRIV (R)'" ); 326 END IF; 327 328 IF PRIV (R1) /= R THEN 329 FAILED ( "INCORRECT CONVERSION OF 'PRIV (R1)'" ); 330 END IF; 331 332 IF PRIV1 (R2) /= R1 THEN 333 FAILED ( "INCORRECT CONVERSION OF 'PRIV1 (R2)'" ); 334 END IF; 335 336 IF PRIV2 (NR) /= R2 THEN 337 FAILED ( "INCORRECT CONVERSION OF 'PRIV2 (NR)'" ); 338 END IF; 339 340 IF NPRIV1 (R) /= NR THEN 341 FAILED ( "INCORRECT CONVERSION OF 'NPRIV (R)'" ); 342 END IF; 343 EXCEPTION 344 WHEN OTHERS => 345 FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " & 346 "PRIVATE TYPES" ); 347 END; 348 349 DECLARE 350 TASK TYPE TK; 351 T : TK; 352 353 TYPE TK1 IS NEW TK; 354 T1 : TK1; 355 356 TYPE TK2 IS NEW TK; 357 T2 : TK2; 358 359 TYPE NTK1 IS NEW TK1; 360 NT : NTK1; 361 362 TASK BODY TK IS 363 BEGIN 364 NULL; 365 END; 366 367 FUNCTION F (T : TK) RETURN INTEGER IS 368 BEGIN 369 RETURN IDENT_INT (0); 370 END F; 371 372 FUNCTION F (T : TK1) RETURN INTEGER IS 373 BEGIN 374 RETURN IDENT_INT (1); 375 END F; 376 377 FUNCTION F (T : TK2) RETURN INTEGER IS 378 BEGIN 379 RETURN IDENT_INT (2); 380 END F; 381 382 FUNCTION F (T : NTK1) RETURN INTEGER IS 383 BEGIN 384 RETURN IDENT_INT (3); 385 END F; 386 387 BEGIN 388 IF F (TK (T)) /= 0 THEN 389 FAILED ( "INCORRECT CONVERSION OF 'TK (T))'" ); 390 END IF; 391 392 IF F (TK (T1)) /= 0 THEN 393 FAILED ( "INCORRECT CONVERSION OF 'TK (T1))'" ); 394 END IF; 395 396 IF F (TK1 (T2)) /= 1 THEN 397 FAILED ( "INCORRECT CONVERSION OF 'TK1 (T2))'" ); 398 END IF; 399 400 IF F (TK2 (NT)) /= 2 THEN 401 FAILED ( "INCORRECT CONVERSION OF 'TK2 (NT))'" ); 402 END IF; 403 404 IF F (NTK1 (T)) /= 3 THEN 405 FAILED ( "INCORRECT CONVERSION OF 'NTK (T))'" ); 406 END IF; 407 EXCEPTION 408 WHEN OTHERS => 409 FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " & 410 "TASK TYPES" ); 411 END; 412 413 RESULT; 414END C46051A; 415