| -- C64201C.ADA |
| |
| -- Grant of Unlimited Rights |
| -- |
| -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, |
| -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained |
| -- unlimited rights in the software and documentation contained herein. |
| -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making |
| -- this public release, the Government intends to confer upon all |
| -- recipients unlimited rights equal to those held by the Government. |
| -- These rights include rights to use, duplicate, release or disclose the |
| -- released technical data and computer software in whole or in part, in |
| -- any manner and for any purpose whatsoever, and to have or permit others |
| -- to do so. |
| -- |
| -- DISCLAIMER |
| -- |
| -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR |
| -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED |
| -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE |
| -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE |
| -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A |
| -- PARTICULAR PURPOSE OF SAID MATERIAL. |
| --* |
| -- CHECK THAT INITIALIZATION OF IN PARAMETERS OF A COMPOSITE |
| -- TYPE HAVING AT LEAST ONE COMPONENT (INCLUDING COMPONENTS |
| -- OF COMPONENTS) OF A TASK TYPE IS PERMITTED. |
| -- (SEE ALSO 7.4.4/T2 FOR TESTS OF LIMITED PRIVATE TYPES.) |
| |
| -- CVP 5/14/81 |
| -- ABW 7/1/82 |
| -- BHS 7/9/84 |
| |
| WITH REPORT; |
| USE REPORT; |
| PROCEDURE C64201C IS |
| |
| |
| GLOBAL : INTEGER := 10; |
| |
| |
| TASK TYPE T IS |
| ENTRY E (X : IN OUT INTEGER); |
| END; |
| |
| TYPE REC_T IS |
| RECORD |
| TT : T; |
| BB : BOOLEAN := TRUE; |
| END RECORD; |
| |
| TYPE REC_REC_T IS |
| RECORD |
| RR : REC_T; |
| END RECORD; |
| |
| TYPE ARR_T IS ARRAY (1 .. 2) OF T; |
| |
| TYPE ARR_REC_T IS ARRAY (1 .. 2) OF REC_T; |
| |
| RT1, RT2 : REC_T; |
| RRT1, RRT2 : REC_REC_T; |
| AT1, AT2 : ARR_T; |
| ART1, ART2 : ARR_REC_T; |
| |
| |
| TASK BODY T IS |
| BEGIN |
| ACCEPT E (X : IN OUT INTEGER) DO |
| X := X - 1; |
| END E; |
| ACCEPT E (X : IN OUT INTEGER) DO |
| X := X + 1; |
| END E; |
| END T; |
| |
| |
| PROCEDURE PROC1A (P1X : REC_T := RT1) IS |
| BEGIN |
| IF P1X.BB THEN -- EXPECT RT2 PASSED. |
| FAILED( "RECORD OF TASK NOT PASSED, DEFAULT EMPLOYED" ); |
| END IF; |
| END PROC1A; |
| |
| PROCEDURE PROC1B (P1X : REC_T := RT1) IS |
| BEGIN |
| IF NOT P1X.BB THEN -- EXPECT DEFAULT USED. |
| FAILED( "DEFAULT RECORD OF TASK NOT EMPLOYED" ); |
| END IF; |
| END PROC1B; |
| |
| |
| PROCEDURE PROC2A (P2X : REC_REC_T := RRT1) IS |
| BEGIN |
| IF P2X.RR.BB THEN -- EXPECT RRT2 PASSED. |
| FAILED( "RECORD OF RECORD OF TASK NOT PASSED, " & |
| "DEFAULT EMPLOYED" ); |
| END IF; |
| END PROC2A; |
| |
| PROCEDURE PROC2B (P2X : REC_REC_T := RRT1) IS |
| BEGIN |
| IF NOT P2X.RR.BB THEN -- EXPECT DEFAULT USED. |
| FAILED( "DEFAULT RECORD OF RECORD OF TASK " & |
| "NOT EMPLOYED" ); |
| END IF; |
| END PROC2B; |
| |
| |
| PROCEDURE PROC3 (P3X : ARR_T := AT1) IS |
| BEGIN |
| P3X(1).E (X => GLOBAL); -- CALL TO AT2(1).E, |
| -- GLOBAL => GLOBAL - 1. |
| END PROC3; |
| |
| PROCEDURE PROC4 (P4X : ARR_T := AT1) IS |
| BEGIN |
| P4X(1).E (X => GLOBAL); -- CALL TO DEFAULT AT1(1).E, |
| -- GLOBAL => GLOBAL - 1. |
| IF GLOBAL /= IDENT_INT(8) THEN |
| FAILED( "ARRAY OF TASKS NOT PASSED " & |
| "CORRECTLY IN PROC3" ); |
| END IF; |
| END PROC4; |
| |
| PROCEDURE PROC5 (P5X : ARR_REC_T := ART1) IS |
| BEGIN |
| P5X(1).TT.E (X => GLOBAL); -- CALL TO ART2(1).TT.E, |
| -- GLOBAL => GLOBAL - 1. |
| END PROC5; |
| |
| PROCEDURE PROC6 (P6X : ARR_REC_T := ART1) IS |
| BEGIN |
| P6X(1).TT.E (X => GLOBAL); -- CALL DEFAULT ART1(1).TT.E, |
| -- GLOBAL => GLOBAL - 1. |
| IF GLOBAL /= IDENT_INT(8) THEN |
| FAILED( "ARRAY OF RECORDS OF TASKS NOT " & |
| "PASSED IN PROC5" ); |
| END IF; |
| END PROC6; |
| |
| PROCEDURE TERM (TSK : T; NUM : CHARACTER) IS |
| BEGIN |
| IF NOT TSK'TERMINATED THEN |
| ABORT TSK; |
| COMMENT ("ABORTING TASK " & NUM); |
| END IF; |
| END TERM; |
| |
| |
| BEGIN |
| |
| TEST( "C64201C" , "CHECK THAT INITIALIZATION OF IN " & |
| "PARAMETERS OF A COMPOSITE TYPE " & |
| "IS PERMITTED" ); |
| |
| RT2.BB := FALSE; |
| RRT2.RR.BB := FALSE; |
| |
| PROC1A(RT2); -- NO ENTRY CALL |
| PROC1B; -- NO ENTRY CALL |
| PROC2A(RRT2); -- NO ENTRY CALL |
| PROC2B; -- NO ENTRY CALL |
| |
| PROC3(AT2); -- CALL AT2(1).E |
| IF GLOBAL /= 9 THEN |
| FAILED ("INCORRECT GLOBAL VALUE AFTER PROC3"); |
| ELSE |
| PROC4; -- CALL AT1(1).E |
| END IF; |
| |
| GLOBAL := 10; |
| PROC5(ART2); -- CALL ART2(1).TT.E |
| IF GLOBAL /= 9 THEN |
| FAILED ("INCORRECT GLOBAL VALUE AFTER PROC5"); |
| ELSE |
| PROC6; -- CALL ART1(1).TT.E |
| END IF; |
| |
| -- MAKE SURE ALL TASKS TERMINATED |
| TERM (RT1.TT, '1'); |
| TERM (RT2.TT, '2'); |
| TERM (RRT1.RR.TT, '3'); |
| TERM (RRT2.RR.TT, '4'); |
| TERM (AT1(1), '5'); |
| TERM (AT2(1), '6'); |
| TERM (AT1(2), '7'); |
| TERM (AT2(2), '8'); |
| TERM (ART1(1).TT, '9'); |
| TERM (ART2(1).TT, 'A'); |
| TERM (ART1(2).TT, 'B'); |
| TERM (ART2(2).TT, 'C'); |
| |
| RESULT; |
| |
| END C64201C; |