1-- C85005A.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 VARIABLE CREATED BY AN OBJECT DECLARATION CAN BE 27-- RENAMED AND HAS THE CORRECT VALUE, AND THAT THE NEW NAME CAN 28-- BE USED IN AN ASSIGNMENT STATEMENT AND PASSED ON AS AN ACTUAL 29-- SUBPROGRAM OR ENTRY 'IN OUT' OR 'OUT' PARAMETER, AND AS AN 30-- ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT WHEN THE VALUE OF 31-- THE RENAMED VARIABLE IS CHANGED, THE NEW VALUE IS REFLECTED 32-- BY THE VALUE OF THE NEW NAME. 33 34-- HISTORY: 35-- JET 03/15/88 CREATED ORIGINAL TEST. 36 37WITH REPORT; USE REPORT; 38PROCEDURE C85005A IS 39 40 TYPE ARRAY1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER; 41 TYPE RECORD1 (D : INTEGER) IS 42 RECORD 43 FIELD1 : INTEGER := 1; 44 END RECORD; 45 TYPE POINTER1 IS ACCESS INTEGER; 46 47 PACKAGE PACK1 IS 48 K1 : INTEGER := 0; 49 TYPE PRIVY IS PRIVATE; 50 ZERO : CONSTANT PRIVY; 51 ONE : CONSTANT PRIVY; 52 TWO : CONSTANT PRIVY; 53 THREE : CONSTANT PRIVY; 54 FOUR : CONSTANT PRIVY; 55 FIVE : CONSTANT PRIVY; 56 FUNCTION IDENT (I : PRIVY) RETURN PRIVY; 57 FUNCTION NEXT (I : PRIVY) RETURN PRIVY; 58 PRIVATE 59 TYPE PRIVY IS RANGE 0..127; 60 ZERO : CONSTANT PRIVY := 0; 61 ONE : CONSTANT PRIVY := 1; 62 TWO : CONSTANT PRIVY := 2; 63 THREE : CONSTANT PRIVY := 3; 64 FOUR : CONSTANT PRIVY := 4; 65 FIVE : CONSTANT PRIVY := 5; 66 END PACK1; 67 68 TASK TYPE TASK1 IS 69 ENTRY ASSIGN (J : IN INTEGER); 70 ENTRY VALU (J : OUT INTEGER); 71 ENTRY NEXT; 72 ENTRY STOP; 73 END TASK1; 74 75 TASK TYPE TASK2 IS 76 ENTRY ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1; 77 TR1 : OUT RECORD1; TP1 : IN OUT POINTER1; 78 TV1 : IN OUT PACK1.PRIVY; TT1 : IN OUT TASK1; 79 TK1 : IN OUT INTEGER); 80 END TASK2; 81 82 I1 : INTEGER := 0; 83 A1 : ARRAY1(1..3) := (OTHERS => 0); 84 R1 : RECORD1(1) := (D => 1, FIELD1 => 0); 85 P1 : POINTER1 := NEW INTEGER'(0); 86 V1 : PACK1.PRIVY := PACK1.ZERO; 87 T1 : TASK1; 88 89 XI1 : INTEGER RENAMES I1; 90 XA1 : ARRAY1 RENAMES A1; 91 XR1 : RECORD1 RENAMES R1; 92 XP1 : POINTER1 RENAMES P1; 93 XV1 : PACK1.PRIVY RENAMES V1; 94 XT1 : TASK1 RENAMES T1; 95 XK1 : INTEGER RENAMES PACK1.K1; 96 97 I : INTEGER; 98 CHK_TASK : TASK2; 99 100 GENERIC 101 GI1 : IN OUT INTEGER; 102 GA1 : IN OUT ARRAY1; 103 GR1 : IN OUT RECORD1; 104 GP1 : IN OUT POINTER1; 105 GV1 : IN OUT PACK1.PRIVY; 106 GT1 : IN OUT TASK1; 107 GK1 : IN OUT INTEGER; 108 PACKAGE GENERIC1 IS 109 END GENERIC1; 110 111 FUNCTION IDENT (P : POINTER1) RETURN POINTER1 IS 112 BEGIN 113 IF EQUAL (3,3) THEN 114 RETURN P; 115 ELSE 116 RETURN NULL; 117 END IF; 118 END IDENT; 119 120 PROCEDURE PROC1 (PI1 : IN OUT INTEGER; PA1 : IN OUT ARRAY1; 121 PR1 : IN OUT RECORD1; PP1 : OUT POINTER1; 122 PV1 : OUT PACK1.PRIVY; PT1 : IN OUT TASK1; 123 PK1 : OUT INTEGER) IS 124 125 BEGIN 126 PI1 := PI1 + 1; 127 PA1 := (PA1(1)+1, PA1(2)+1, PA1(3)+1); 128 PR1 := (D => 1, FIELD1 => PR1.FIELD1 + 1); 129 PP1 := NEW INTEGER'(P1.ALL + 1); 130 PV1 := PACK1.NEXT(V1); 131 PT1.NEXT; 132 PK1 := PACK1.K1 + 1; 133 END PROC1; 134 135 PACKAGE BODY PACK1 IS 136 FUNCTION IDENT (I : PRIVY) RETURN PRIVY IS 137 BEGIN 138 IF EQUAL(3,3) THEN 139 RETURN I; 140 ELSE 141 RETURN PRIVY'(0); 142 END IF; 143 END IDENT; 144 145 FUNCTION NEXT (I : PRIVY) RETURN PRIVY IS 146 BEGIN 147 RETURN I+1; 148 END NEXT; 149 END PACK1; 150 151 PACKAGE BODY GENERIC1 IS 152 BEGIN 153 GI1 := GI1 + 1; 154 GA1 := (GA1(1)+1, GA1(2)+1, GA1(3)+1); 155 GR1 := (D => 1, FIELD1 => GR1.FIELD1+1); 156 GP1 := NEW INTEGER'(GP1.ALL + 1); 157 GV1 := PACK1.NEXT(GV1); 158 GT1.NEXT; 159 GK1 := GK1 + 1; 160 END GENERIC1; 161 162 TASK BODY TASK1 IS 163 TASK_VALUE : INTEGER := 0; 164 ACCEPTING_ENTRIES : BOOLEAN := TRUE; 165 BEGIN 166 WHILE ACCEPTING_ENTRIES LOOP 167 SELECT 168 ACCEPT ASSIGN (J : IN INTEGER) DO 169 TASK_VALUE := J; 170 END ASSIGN; 171 OR 172 ACCEPT VALU (J : OUT INTEGER) DO 173 J := TASK_VALUE; 174 END VALU; 175 OR 176 ACCEPT NEXT DO 177 TASK_VALUE := TASK_VALUE + 1; 178 END NEXT; 179 OR 180 ACCEPT STOP DO 181 ACCEPTING_ENTRIES := FALSE; 182 END STOP; 183 END SELECT; 184 END LOOP; 185 END TASK1; 186 187 TASK BODY TASK2 IS 188 BEGIN 189 ACCEPT ENTRY1 (TI1 : OUT INTEGER; TA1 : OUT ARRAY1; 190 TR1 : OUT RECORD1; TP1 : IN OUT POINTER1; 191 TV1 : IN OUT PACK1.PRIVY; TT1 : IN OUT TASK1; 192 TK1 : IN OUT INTEGER) DO 193 194 TI1 := I1 + 1; 195 TA1 := (A1(1)+1, A1(2)+1, A1(3)+1); 196 TR1 := (D => 1, FIELD1 => R1.FIELD1 + 1); 197 TP1 := NEW INTEGER'(TP1.ALL + 1); 198 TV1 := PACK1.NEXT(TV1); 199 TT1.NEXT; 200 TK1 := TK1 + 1; 201 END ENTRY1; 202 END TASK2; 203 204BEGIN 205 TEST ("C85005A", "CHECK THAT A VARIABLE CREATED BY AN OBJECT " & 206 "DECLARATION CAN BE RENAMED AND HAS THE " & 207 "CORRECT VALUE, AND THAT THE NEW NAME CAN " & 208 "BE USED IN AN ASSIGNMENT STATEMENT " & 209 "AND PASSED ON AS AN ACTUAL SUBPROGRAM OR " & 210 "ENTRY 'IN OUT' OR 'OUT' PARAMETER, AND AS AN " & 211 "ACTUAL GENERIC 'IN OUT' PARAMETER, AND THAT " & 212 "WHEN THE VALUE OF THE RENAMED VARIABLE IS " & 213 "CHANGED, THE NEW VALUE IS REFLECTED BY THE " & 214 "VALUE OF THE NEW NAME"); 215 216 DECLARE 217 PACKAGE GENPACK1 IS NEW 218 GENERIC1 (XI1, XA1, XR1, XP1, XV1, XT1, XK1); 219 BEGIN 220 NULL; 221 END; 222 223 IF XI1 /= IDENT_INT(1) THEN 224 FAILED ("INCORRECT VALUE OF XI1 (1)"); 225 END IF; 226 227 IF XA1 /= (IDENT_INT(1),IDENT_INT(1),IDENT_INT(1)) THEN 228 FAILED ("INCORRECT VALUE OF XA1 (1)"); 229 END IF; 230 231 IF XR1 /= (D => 1, FIELD1 => IDENT_INT(1)) THEN 232 FAILED ("INCORRECT VALUE OF XR1 (1)"); 233 END IF; 234 235 IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(1) THEN 236 FAILED ("INCORRECT VALUE OF XP1 (1)"); 237 END IF; 238 239 IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.ONE)) THEN 240 FAILED ("INCORRECT VALUE OF XV1 (1)"); 241 END IF; 242 243 XT1.VALU(I); 244 IF I /= IDENT_INT(1) THEN 245 FAILED ("INCORRECT RETURN VALUE OF XT1.VALU (1)"); 246 END IF; 247 248 IF XK1 /= IDENT_INT(1) THEN 249 FAILED ("INCORRECT VALUE OF XK1 (1)"); 250 END IF; 251 252 PROC1(XI1, XA1, XR1, XP1, XV1, XT1, XK1); 253 254 IF XI1 /= IDENT_INT(2) THEN 255 FAILED ("INCORRECT VALUE OF XI1 (2)"); 256 END IF; 257 258 IF XA1 /= (IDENT_INT(2),IDENT_INT(2),IDENT_INT(2)) THEN 259 FAILED ("INCORRECT VALUE OF XA1 (2)"); 260 END IF; 261 262 IF XR1 /= (D => 1, FIELD1 => IDENT_INT(2)) THEN 263 FAILED ("INCORRECT VALUE OF XR1 (2)"); 264 END IF; 265 266 IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(2) THEN 267 FAILED ("INCORRECT VALUE OF XP1 (2)"); 268 END IF; 269 270 IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.TWO)) THEN 271 FAILED ("INCORRECT VALUE OF XV1 (2)"); 272 END IF; 273 274 XT1.VALU(I); 275 IF I /= IDENT_INT(2) THEN 276 FAILED ("INCORRECT RETURN VALUE FROM XT1.VALU (2)"); 277 END IF; 278 279 IF XK1 /= IDENT_INT(2) THEN 280 FAILED ("INCORRECT VALUE OF XK1 (2)"); 281 END IF; 282 283 CHK_TASK.ENTRY1(XI1, XA1, XR1, XP1, XV1, XT1, XK1); 284 285 IF XI1 /= IDENT_INT(3) THEN 286 FAILED ("INCORRECT VALUE OF XI1 (3)"); 287 END IF; 288 289 IF XA1 /= (IDENT_INT(3),IDENT_INT(3),IDENT_INT(3)) THEN 290 FAILED ("INCORRECT VALUE OF XA1 (3)"); 291 END IF; 292 293 IF XR1 /= (D => 1, FIELD1 => IDENT_INT(3)) THEN 294 FAILED ("INCORRECT VALUE OF XR1 (3)"); 295 END IF; 296 297 IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(3) THEN 298 FAILED ("INCORRECT VALUE OF XP1 (3)"); 299 END IF; 300 301 IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.THREE)) THEN 302 FAILED ("INCORRECT VALUE OF XV1 (3)"); 303 END IF; 304 305 XT1.VALU(I); 306 IF I /= IDENT_INT(3) THEN 307 FAILED ("INCORRECT RETURN VALUE OF XT1.VALU (3)"); 308 END IF; 309 310 IF XK1 /= IDENT_INT(3) THEN 311 FAILED ("INCORRECT VALUE OF XK1 (3)"); 312 END IF; 313 314 XI1 := XI1 + 1; 315 XA1 := (XA1(1)+1, XA1(2)+1, XA1(3)+1); 316 XR1 := (D => 1, FIELD1 => XR1.FIELD1 + 1); 317 XP1 := NEW INTEGER'(XP1.ALL + 1); 318 XV1 := PACK1.NEXT(XV1); 319 XT1.NEXT; 320 XK1 := XK1 + 1; 321 322 IF XI1 /= IDENT_INT(4) THEN 323 FAILED ("INCORRECT VALUE OF XI1 (4)"); 324 END IF; 325 326 IF XA1 /= (IDENT_INT(4),IDENT_INT(4),IDENT_INT(4)) THEN 327 FAILED ("INCORRECT VALUE OF XA1 (4)"); 328 END IF; 329 330 IF XR1 /= (D => 1, FIELD1 => IDENT_INT(4)) THEN 331 FAILED ("INCORRECT VALUE OF XR1 (4)"); 332 END IF; 333 334 IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(4) THEN 335 FAILED ("INCORRECT VALUE OF XP1 (4)"); 336 END IF; 337 338 IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.FOUR)) THEN 339 FAILED ("INCORRECT VALUE OF XV1 (4)"); 340 END IF; 341 342 XT1.VALU(I); 343 IF I /= IDENT_INT(4) THEN 344 FAILED ("INCORRECT RETURN VALUE OF XT1.VALU (4)"); 345 END IF; 346 347 IF XK1 /= IDENT_INT(4) THEN 348 FAILED ("INCORRECT VALUE OF XK1 (4)"); 349 END IF; 350 351 I1 := I1 + 1; 352 A1 := (A1(1)+1, A1(2)+1, A1(3)+1); 353 R1 := (D => 1, FIELD1 => R1.FIELD1 + 1); 354 P1 := NEW INTEGER'(P1.ALL + 1); 355 V1 := PACK1.NEXT(V1); 356 T1.NEXT; 357 PACK1.K1 := PACK1.K1 + 1; 358 359 IF XI1 /= IDENT_INT(5) THEN 360 FAILED ("INCORRECT VALUE OF XI1 (5)"); 361 END IF; 362 363 IF XA1 /= (IDENT_INT(5),IDENT_INT(5),IDENT_INT(5)) THEN 364 FAILED ("INCORRECT VALUE OF XA1 (5)"); 365 END IF; 366 367 IF XR1 /= (D => 1, FIELD1 => IDENT_INT(5)) THEN 368 FAILED ("INCORRECT VALUE OF XR1 (5)"); 369 END IF; 370 371 IF XP1 /= IDENT(P1) OR XP1.ALL /= IDENT_INT(5) THEN 372 FAILED ("INCORRECT VALUE OF XP1 (5)"); 373 END IF; 374 375 IF PACK1."/=" (XV1, PACK1.IDENT(PACK1.FIVE)) THEN 376 FAILED ("INCORRECT VALUE OF XV1 (5)"); 377 END IF; 378 379 XT1.VALU(I); 380 IF I /= IDENT_INT(5) THEN 381 FAILED ("INCORRECT RETURN VALUE OF XT1.VALU (5)"); 382 END IF; 383 384 IF XK1 /= IDENT_INT(5) THEN 385 FAILED ("INCORRECT VALUE OF XK1 (5)"); 386 END IF; 387 388 T1.STOP; 389 390 RESULT; 391END C85005A; 392