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