3 -- Grant of Unlimited Rights
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
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.
25 -- CHECK THAT INITIALIZATION OF IN PARAMETERS OF A COMPOSITE
26 -- TYPE HAVING AT LEAST ONE COMPONENT (INCLUDING COMPONENTS
27 -- OF COMPONENTS) OF A TASK TYPE IS PERMITTED.
28 -- (SEE ALSO 7.4.4/T2 FOR TESTS OF LIMITED PRIVATE TYPES.)
39 GLOBAL
: INTEGER := 10;
43 ENTRY E
(X
: IN OUT INTEGER);
57 TYPE ARR_T
IS ARRAY (1 .. 2) OF T
;
59 TYPE ARR_REC_T
IS ARRAY (1 .. 2) OF REC_T
;
62 RRT1
, RRT2
: REC_REC_T
;
64 ART1
, ART2
: ARR_REC_T
;
69 ACCEPT E
(X
: IN OUT INTEGER) DO
72 ACCEPT E
(X
: IN OUT INTEGER) DO
78 PROCEDURE PROC1A
(P1X
: REC_T
:= RT1
) IS
80 IF P1X
.BB
THEN -- EXPECT RT2 PASSED.
81 FAILED
( "RECORD OF TASK NOT PASSED, DEFAULT EMPLOYED" );
85 PROCEDURE PROC1B
(P1X
: REC_T
:= RT1
) IS
87 IF NOT P1X
.BB
THEN -- EXPECT DEFAULT USED.
88 FAILED
( "DEFAULT RECORD OF TASK NOT EMPLOYED" );
93 PROCEDURE PROC2A
(P2X
: REC_REC_T
:= RRT1
) IS
95 IF P2X
.RR
.BB
THEN -- EXPECT RRT2 PASSED.
96 FAILED
( "RECORD OF RECORD OF TASK NOT PASSED, " &
101 PROCEDURE PROC2B
(P2X
: REC_REC_T
:= RRT1
) IS
103 IF NOT P2X
.RR
.BB
THEN -- EXPECT DEFAULT USED.
104 FAILED
( "DEFAULT RECORD OF RECORD OF TASK " &
110 PROCEDURE PROC3
(P3X
: ARR_T
:= AT1
) IS
112 P3X
(1).E
(X
=> GLOBAL
); -- CALL TO AT2(1).E,
113 -- GLOBAL => GLOBAL - 1.
116 PROCEDURE PROC4
(P4X
: ARR_T
:= AT1
) IS
118 P4X
(1).E
(X
=> GLOBAL
); -- CALL TO DEFAULT AT1(1).E,
119 -- GLOBAL => GLOBAL - 1.
120 IF GLOBAL
/= IDENT_INT
(8) THEN
121 FAILED
( "ARRAY OF TASKS NOT PASSED " &
122 "CORRECTLY IN PROC3" );
126 PROCEDURE PROC5
(P5X
: ARR_REC_T
:= ART1
) IS
128 P5X
(1).TT
.E
(X
=> GLOBAL
); -- CALL TO ART2(1).TT.E,
129 -- GLOBAL => GLOBAL - 1.
132 PROCEDURE PROC6
(P6X
: ARR_REC_T
:= ART1
) IS
134 P6X
(1).TT
.E
(X
=> GLOBAL
); -- CALL DEFAULT ART1(1).TT.E,
135 -- GLOBAL => GLOBAL - 1.
136 IF GLOBAL
/= IDENT_INT
(8) THEN
137 FAILED
( "ARRAY OF RECORDS OF TASKS NOT " &
142 PROCEDURE TERM
(TSK
: T
; NUM
: CHARACTER) IS
144 IF NOT TSK
'TERMINATED THEN
146 COMMENT
("ABORTING TASK " & NUM
);
153 TEST
( "C64201C" , "CHECK THAT INITIALIZATION OF IN " &
154 "PARAMETERS OF A COMPOSITE TYPE " &
160 PROC1A
(RT2
); -- NO ENTRY CALL
161 PROC1B
; -- NO ENTRY CALL
162 PROC2A
(RRT2
); -- NO ENTRY CALL
163 PROC2B
; -- NO ENTRY CALL
165 PROC3
(AT2
); -- CALL AT2(1).E
167 FAILED
("INCORRECT GLOBAL VALUE AFTER PROC3");
169 PROC4
; -- CALL AT1(1).E
173 PROC5
(ART2
); -- CALL ART2(1).TT.E
175 FAILED
("INCORRECT GLOBAL VALUE AFTER PROC5");
177 PROC6
; -- CALL ART1(1).TT.E
180 -- MAKE SURE ALL TASKS TERMINATED
183 TERM
(RRT1
.RR
.TT
, '3');
184 TERM
(RRT2
.RR
.TT
, '4');
189 TERM
(ART1
(1).TT
, '9');
190 TERM
(ART2
(1).TT
, 'A');
191 TERM
(ART1
(2).TT
, 'B');
192 TERM
(ART2
(2).TT
, 'C');