1-- C95067A.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 A FORMAL PARAMETER OF MODE IN OR IN OUT CAN BE OF A
26-- LIMITED TYPE, INCLUDING A COMPOSITE LIMITED TYPE.
27
28-- JWC 6/20/85
29
30WITH REPORT; USE REPORT;
31PROCEDURE C95067A IS
32
33     PACKAGE PKG IS
34
35          TYPE ITYPE IS LIMITED PRIVATE;
36
37          TASK T1 IS
38
39               ENTRY LOOK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING);
40
41               ENTRY LOOK_INOUT_I (X : IN OUT ITYPE; V : INTEGER;
42                                   M : STRING);
43
44               ENTRY SET_I (X : IN OUT ITYPE; V : INTEGER);
45
46          END T1;
47
48          SUBTYPE INT_0_20 IS INTEGER RANGE 0 .. 20;
49          TYPE VRTYPE (C : INT_0_20 := 20) IS LIMITED PRIVATE;
50
51          TASK T2 IS
52
53               ENTRY LOOK_IN_VR (X : IN VRTYPE; C : INTEGER;
54                                 I : INTEGER; S : STRING; M : STRING);
55
56               ENTRY LOOK_INOUT_VR (X : IN OUT VRTYPE; C : INTEGER;
57                                    I : INTEGER; S : STRING;
58                                    M : STRING);
59
60               ENTRY SET_VR (X : IN OUT VRTYPE; C : INTEGER;
61                             I : INTEGER; S : STRING);
62
63          END T2;
64
65     PRIVATE
66
67          TYPE ITYPE IS NEW INTEGER RANGE 0 .. 99;
68
69          TYPE VRTYPE (C : INT_0_20 := 20) IS
70               RECORD
71                    I : INTEGER;
72                    S : STRING (1 .. C);
73               END RECORD;
74
75     END PKG;
76
77     USE PKG;
78
79     I1 : ITYPE;
80
81     TYPE ATYPE IS ARRAY (1 .. 3) OF ITYPE;
82
83     A1 : ATYPE;
84
85     VR1 : VRTYPE;
86
87     D : CONSTANT INT_0_20 := 10;
88
89     TYPE RTYPE IS
90          RECORD
91               J : ITYPE;
92               R : VRTYPE (D);
93          END RECORD;
94
95     R1 : RTYPE;
96
97     PACKAGE BODY PKG IS
98
99          TASK BODY T1 IS
100          BEGIN
101               LOOP
102                    SELECT
103                         ACCEPT LOOK_IN_I (X : IN ITYPE; V : INTEGER;
104                                           M : STRING) DO
105                              IF INTEGER (X) /= V THEN
106                                   FAILED ("WRONG SCALAR VALUE - " & M);
107                              END IF;
108                         END LOOK_IN_I;
109                    OR
110                         ACCEPT LOOK_INOUT_I (X : IN OUT ITYPE;
111                                              V : INTEGER;
112                                              M : STRING) DO
113                              IF INTEGER (X) /= V THEN
114                                   FAILED ("WRONG SCALAR VALUE - " & M);
115                              END IF;
116                         END LOOK_INOUT_I;
117                    OR
118                         ACCEPT SET_I (X : IN OUT ITYPE; V : INTEGER) DO
119                              X := ITYPE (IDENT_INT (V));
120                         END SET_I;
121                    OR
122                         TERMINATE;
123                    END SELECT;
124               END LOOP;
125          END T1;
126
127          TASK BODY T2 IS
128          BEGIN
129               LOOP
130                    SELECT
131                         ACCEPT LOOK_IN_VR (X : IN VRTYPE; C : INTEGER;
132                                            I : INTEGER; S : STRING;
133                                            M : STRING) DO
134                              IF (X.C /= C OR X.I /= I) OR ELSE
135                                 X.S /= S THEN
136                                   FAILED ("WRONG COMPOSITE VALUE - " &
137                                           M);
138                              END IF;
139                         END LOOK_IN_VR;
140                    OR
141                         ACCEPT LOOK_INOUT_VR (X : IN OUT VRTYPE;
142                                               C : INTEGER; I : INTEGER;
143                                               S : STRING;
144                                               M : STRING) DO
145                              IF (X.C /= C OR X.I /= I) OR ELSE
146                                 X.S /= S THEN
147                                   FAILED ("WRONG COMPOSITE VALUE - " &
148                                           M);
149                              END IF;
150                         END LOOK_INOUT_VR;
151                    OR
152                         ACCEPT SET_VR (X : IN OUT VRTYPE; C : INTEGER;
153                                        I : INTEGER; S : STRING) DO
154                              X := (IDENT_INT(C), IDENT_INT(I),
155                                    IDENT_STR(S));
156                         END SET_VR;
157                    OR
158                         TERMINATE;
159                    END SELECT;
160               END LOOP;
161          END T2;
162
163     BEGIN
164          I1 := ITYPE (IDENT_INT(2));
165
166          FOR I IN A1'RANGE LOOP
167               A1 (I) := ITYPE (3 + IDENT_INT(I));
168          END LOOP;
169
170          VR1 := (IDENT_INT(5), IDENT_INT(4), IDENT_STR("01234"));
171
172          R1.J := ITYPE (IDENT_INT(6));
173          R1.R := (IDENT_INT(D), IDENT_INT(19),
174                   IDENT_STR("ABCDEFGHIJ"));
175     END PKG;
176
177     TASK T3 IS
178          ENTRY CHECK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING);
179
180          ENTRY CHECK_INOUT_I (X : IN OUT ITYPE; OV : INTEGER;
181                               NV : INTEGER; M : STRING);
182
183          ENTRY CHECK_IN_A (X : IN ATYPE; V : INTEGER; M : STRING);
184
185          ENTRY CHECK_INOUT_A (X : IN OUT ATYPE; OV : INTEGER;
186                               NV : INTEGER; M : STRING);
187
188          ENTRY CHECK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
189                             S : STRING; M : STRING);
190
191          ENTRY CHECK_INOUT_VR (X : IN OUT VRTYPE;
192                               OC : INTEGER; OI : INTEGER; OS : STRING;
193                               NC : INTEGER; NI : INTEGER; NS : STRING;
194                               M : STRING);
195
196          ENTRY CHECK_IN_R (X : IN RTYPE; J : INTEGER; C : INTEGER;
197                            I : INTEGER; S : STRING; M : STRING);
198
199          ENTRY CHECK_INOUT_R (X : IN OUT RTYPE; OJ : INTEGER;
200                              OC : INTEGER; OI : INTEGER; OS : STRING;
201                              NJ : INTEGER;
202                              NC : INTEGER; NI : INTEGER; NS : STRING;
203                              M : STRING);
204     END T3;
205
206     TASK BODY T3 IS
207     BEGIN
208          ACCEPT CHECK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING) DO
209               T1.LOOK_IN_I (X, V, M);
210          END CHECK_IN_I;
211
212          ACCEPT CHECK_INOUT_I (X : IN OUT ITYPE; OV : INTEGER;
213                                NV : INTEGER; M : STRING) DO
214               T1.LOOK_INOUT_I (X, OV, M & " - A");
215               T1.SET_I (X, NV);
216               T1.LOOK_INOUT_I (X, NV, M & " - B");
217               T1.LOOK_IN_I (X, NV, M & " - C");
218          END CHECK_INOUT_I;
219
220          ACCEPT CHECK_IN_A (X : IN ATYPE; V : INTEGER; M : STRING) DO
221               FOR I IN X'RANGE LOOP
222                    T1.LOOK_IN_I (X(I), V+I, M & " -" &
223                                             INTEGER'IMAGE (I));
224               END LOOP;
225          END CHECK_IN_A;
226
227          ACCEPT CHECK_INOUT_A (X : IN OUT ATYPE; OV : INTEGER;
228                                NV : INTEGER; M : STRING) DO
229               FOR I IN X'RANGE LOOP
230                    T1.LOOK_INOUT_I (X(I), OV+I, M & " - A" &
231                                                 INTEGER'IMAGE (I));
232                    T1.SET_I (X(I), NV+I);
233                    T1.LOOK_INOUT_I (X(I), NV+I, M & " - B" &
234                                                 INTEGER'IMAGE (I));
235                    T1.LOOK_IN_I (X(I), NV+I, M & " - C" &
236                                              INTEGER'IMAGE (I));
237               END LOOP;
238          END CHECK_INOUT_A;
239
240          ACCEPT CHECK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
241                              S : STRING; M : STRING) DO
242               T2.LOOK_IN_VR (X, C, I, S, M);
243          END CHECK_IN_VR;
244
245          ACCEPT CHECK_INOUT_VR (X : IN OUT VRTYPE;
246                                 OC : INTEGER; OI : INTEGER;
247                                 OS : STRING;
248                                 NC : INTEGER; NI : INTEGER;
249                                 NS : STRING;
250                                 M : STRING) DO
251               T2.LOOK_INOUT_VR (X, OC, OI, OS, M & " - A");
252               T2.SET_VR (X, NC, NI, NS);
253               T2.LOOK_INOUT_VR (X, NC, NI, NS, M & " - B");
254               T2.LOOK_IN_VR (X, NC, NI, NS, M & " - C");
255          END CHECK_INOUT_VR;
256
257          ACCEPT CHECK_IN_R (X : IN RTYPE; J : INTEGER; C : INTEGER;
258                             I : INTEGER; S : STRING; M : STRING) DO
259               T1.LOOK_IN_I (X.J, J, M & " - A");
260               T2.LOOK_IN_VR (X.R, C, I, S, M & " - B");
261          END CHECK_IN_R;
262
263          ACCEPT CHECK_INOUT_R (X : IN OUT RTYPE; OJ : INTEGER;
264                                OC : INTEGER; OI : INTEGER; OS : STRING;
265                                NJ : INTEGER;
266                                NC : INTEGER; NI : INTEGER; NS : STRING;
267                                M : STRING) DO
268               T1.LOOK_INOUT_I (X.J, OJ, M & " - A");
269               T2.LOOK_INOUT_VR (X.R, OC, OI, OS, M & " - B");
270               T1.SET_I (X.J, NJ);
271               T2.SET_VR (X.R, NC, NI, NS);
272               T1.LOOK_INOUT_I (X.J, NJ, M & " - C");
273               T2.LOOK_INOUT_VR (X.R, NC, NI, NS, M & " - D");
274               T1.LOOK_IN_I (X.J, NJ, M & " - E");
275               T2.LOOK_IN_VR (X.R, NC, NI, NS, M & " - F");
276          END CHECK_INOUT_R;
277     END T3;
278
279BEGIN
280     TEST ("C95067A", "CHECK THAT LIMITED PRIVATE/COMPOSITE TYPES " &
281                      "CAN BE USED AS IN OR IN OUT FORMAL PARAMETERS");
282
283     T3.CHECK_IN_I (I1, 2, "IN I");
284
285     T3.CHECK_INOUT_I (I1, 2, 5, "INOUT I");
286
287     T3.CHECK_IN_A (A1, 3, "IN A");
288
289     T3.CHECK_INOUT_A (A1, 3, 17, "INOUT A");
290
291     T3.CHECK_IN_VR (VR1, 5, 4, "01234", "IN VR");
292
293     T3.CHECK_INOUT_VR (VR1, 5, 4, "01234", 10, 11, "9876543210",
294                        "INOUT VR");
295
296     T3.CHECK_IN_R (R1, 6, D, 19, "ABCDEFGHIJ", "IN R");
297
298     T3.CHECK_INOUT_R (R1, 6, D, 19, "ABCDEFGHIJ", 13, D, 5,
299                       "ZYXWVUTSRQ", "INOUT R");
300
301     RESULT;
302END C95067A;
303