Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/c9/c95067a.ada @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
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
30 WITH REPORT; USE REPORT;
31 PROCEDURE 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
279 BEGIN
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;
302 END C95067A;