|
111
|
1 -- C45282B.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 IN AND NOT IN ARE EVALUATED CORRECTLY FOR :
|
|
|
26 -- D) ACCESS TO RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITH
|
|
|
27 -- DISCRIMINANTS (WITH AND WITHOUT DEFAULT VALUES), WHERE THE
|
|
|
28 -- TYPE MARK DENOTES A CONSTRAINED AND UNCONSTRAINED TYPE;
|
|
|
29 -- E) ACCESS TO TASK TYPES.
|
|
|
30
|
|
|
31 -- TBN 8/8/86
|
|
|
32
|
|
|
33 WITH REPORT; USE REPORT;
|
|
|
34 PROCEDURE C45282B IS
|
|
|
35
|
|
|
36 SUBTYPE INT IS INTEGER RANGE 1 .. 5;
|
|
|
37
|
|
|
38 PACKAGE P IS
|
|
|
39 TYPE PRI_REC1 (D : INT) IS PRIVATE;
|
|
|
40 TYPE PRI_REC2 (D : INT := 2) IS PRIVATE;
|
|
|
41 FUNCTION INIT_PREC1 (A : INT; B : STRING) RETURN PRI_REC1;
|
|
|
42 FUNCTION INIT_PREC2 (A : INT; B : STRING) RETURN PRI_REC2;
|
|
|
43 TYPE LIM_REC1 (D : INT) IS LIMITED PRIVATE;
|
|
|
44 TYPE ACC_LIM1 IS ACCESS LIM_REC1;
|
|
|
45 SUBTYPE ACC_SUB_LIM1 IS ACC_LIM1 (2);
|
|
|
46 PROCEDURE ASSIGN_LIM1 (A : ACC_LIM1; B : INT; C : STRING);
|
|
|
47 TYPE LIM_REC2 (D : INT := 2) IS LIMITED PRIVATE;
|
|
|
48 TYPE ACC_LIM2 IS ACCESS LIM_REC2;
|
|
|
49 SUBTYPE ACC_SUB_LIM2 IS ACC_LIM2 (2);
|
|
|
50 PROCEDURE ASSIGN_LIM2 (A : ACC_LIM2; B : INT; C : STRING);
|
|
|
51 PRIVATE
|
|
|
52 TYPE PRI_REC1 (D : INT) IS
|
|
|
53 RECORD
|
|
|
54 STR : STRING (1 .. D);
|
|
|
55 END RECORD;
|
|
|
56 TYPE PRI_REC2 (D : INT := 2) IS
|
|
|
57 RECORD
|
|
|
58 STR : STRING (1 .. D);
|
|
|
59 END RECORD;
|
|
|
60 TYPE LIM_REC1 (D : INT) IS
|
|
|
61 RECORD
|
|
|
62 STR : STRING (1 .. D);
|
|
|
63 END RECORD;
|
|
|
64 TYPE LIM_REC2 (D : INT := 2) IS
|
|
|
65 RECORD
|
|
|
66 STR : STRING (1 .. D);
|
|
|
67 END RECORD;
|
|
|
68 END P;
|
|
|
69
|
|
|
70 USE P;
|
|
|
71
|
|
|
72 TYPE DIS_REC1 (D : INT) IS
|
|
|
73 RECORD
|
|
|
74 STR : STRING (1 .. D);
|
|
|
75 END RECORD;
|
|
|
76 TYPE DIS_REC2 (D : INT := 5) IS
|
|
|
77 RECORD
|
|
|
78 STR : STRING (D .. 8);
|
|
|
79 END RECORD;
|
|
|
80
|
|
|
81 TYPE ACC1_REC1 IS ACCESS DIS_REC1;
|
|
|
82 SUBTYPE ACC2_REC1 IS ACC1_REC1 (2);
|
|
|
83 TYPE ACC1_REC2 IS ACCESS DIS_REC2;
|
|
|
84 SUBTYPE ACC2_REC2 IS ACC1_REC2 (2);
|
|
|
85 REC1 : ACC1_REC1;
|
|
|
86 REC2 : ACC2_REC1;
|
|
|
87 REC3 : ACC1_REC2;
|
|
|
88 REC4 : ACC2_REC2;
|
|
|
89 TYPE ACC_PREC1 IS ACCESS PRI_REC1;
|
|
|
90 SUBTYPE ACC_SREC1 IS ACC_PREC1 (2);
|
|
|
91 REC5 : ACC_PREC1;
|
|
|
92 REC6 : ACC_SREC1;
|
|
|
93 TYPE ACC_PREC2 IS ACCESS PRI_REC2;
|
|
|
94 SUBTYPE ACC_SREC2 IS ACC_PREC2 (2);
|
|
|
95 REC7 : ACC_PREC2;
|
|
|
96 REC8 : ACC_SREC2;
|
|
|
97 REC9 : ACC_LIM1;
|
|
|
98 REC10 : ACC_SUB_LIM1;
|
|
|
99 REC11 : ACC_LIM2;
|
|
|
100 REC12 : ACC_SUB_LIM2;
|
|
|
101
|
|
|
102 TASK TYPE T IS
|
|
|
103 ENTRY E (X : INTEGER);
|
|
|
104 END T;
|
|
|
105
|
|
|
106 TASK BODY T IS
|
|
|
107 BEGIN
|
|
|
108 ACCEPT E (X : INTEGER) DO
|
|
|
109 IF X /= IDENT_INT(1) THEN
|
|
|
110 FAILED ("INCORRECT VALUE PASSED TO TASK");
|
|
|
111 END IF;
|
|
|
112 END E;
|
|
|
113 END T;
|
|
|
114
|
|
|
115 PACKAGE BODY P IS
|
|
|
116 FUNCTION INIT_PREC1 (A : INT; B : STRING) RETURN PRI_REC1 IS
|
|
|
117 REC : PRI_REC1 (A);
|
|
|
118 BEGIN
|
|
|
119 REC := (A, B);
|
|
|
120 RETURN (REC);
|
|
|
121 END INIT_PREC1;
|
|
|
122
|
|
|
123 FUNCTION INIT_PREC2 (A : INT; B : STRING) RETURN PRI_REC2 IS
|
|
|
124 REC : PRI_REC2;
|
|
|
125 BEGIN
|
|
|
126 REC := (A, B);
|
|
|
127 RETURN (REC);
|
|
|
128 END INIT_PREC2;
|
|
|
129
|
|
|
130 PROCEDURE ASSIGN_LIM1 (A : ACC_LIM1; B : INT; C : STRING) IS
|
|
|
131 BEGIN
|
|
|
132 A.ALL := (B, C);
|
|
|
133 END ASSIGN_LIM1;
|
|
|
134
|
|
|
135 PROCEDURE ASSIGN_LIM2 (A : ACC_LIM2; B : INT; C : STRING) IS
|
|
|
136 BEGIN
|
|
|
137 A.ALL := (B, C);
|
|
|
138 END ASSIGN_LIM2;
|
|
|
139 END P;
|
|
|
140
|
|
|
141 BEGIN
|
|
|
142
|
|
|
143 TEST ("C45282B", "CHECK THAT IN AND NOT IN ARE EVALUATED FOR " &
|
|
|
144 "ACCESS TYPES TO RECORD TYPES, PRIVATE TYPES, " &
|
|
|
145 "LIMITED PRIVATE TYPES WITH DISCRIMINANTS, AND " &
|
|
|
146 "TASK TYPES");
|
|
|
147
|
|
|
148 -- CASE D
|
|
|
149 ------------------------------------------------------------------------
|
|
|
150 IF REC1 NOT IN ACC1_REC1 THEN
|
|
|
151 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 1");
|
|
|
152 END IF;
|
|
|
153 IF REC1 IN ACC2_REC1 THEN
|
|
|
154 NULL;
|
|
|
155 ELSE
|
|
|
156 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 2");
|
|
|
157 END IF;
|
|
|
158 IF REC2 NOT IN ACC1_REC1 THEN
|
|
|
159 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 3");
|
|
|
160 END IF;
|
|
|
161 REC1 := NEW DIS_REC1'(5, "12345");
|
|
|
162 IF REC1 IN ACC1_REC1 THEN
|
|
|
163 NULL;
|
|
|
164 ELSE
|
|
|
165 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 4");
|
|
|
166 END IF;
|
|
|
167 IF REC1 IN ACC2_REC1 THEN
|
|
|
168 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 5");
|
|
|
169 END IF;
|
|
|
170 REC2 := NEW DIS_REC1'(2, "HI");
|
|
|
171 IF REC2 IN ACC1_REC1 THEN
|
|
|
172 NULL;
|
|
|
173 ELSE
|
|
|
174 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 6");
|
|
|
175 END IF;
|
|
|
176
|
|
|
177 ------------------------------------------------------------------------
|
|
|
178
|
|
|
179 IF REC3 IN ACC1_REC2 THEN
|
|
|
180 NULL;
|
|
|
181 ELSE
|
|
|
182 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 7");
|
|
|
183 END IF;
|
|
|
184 IF REC3 NOT IN ACC2_REC2 THEN
|
|
|
185 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 8");
|
|
|
186 END IF;
|
|
|
187 IF REC4 IN ACC1_REC2 THEN
|
|
|
188 NULL;
|
|
|
189 ELSE
|
|
|
190 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 9");
|
|
|
191 END IF;
|
|
|
192 REC3 := NEW DIS_REC2'(5, "5678");
|
|
|
193 IF REC3 IN ACC1_REC2 THEN
|
|
|
194 NULL;
|
|
|
195 ELSE
|
|
|
196 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 10");
|
|
|
197 END IF;
|
|
|
198 IF REC3 IN ACC2_REC2 THEN
|
|
|
199 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 11");
|
|
|
200 END IF;
|
|
|
201 REC4 := NEW DIS_REC2'(2, "2345678");
|
|
|
202 IF REC4 IN ACC1_REC2 THEN
|
|
|
203 NULL;
|
|
|
204 ELSE
|
|
|
205 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 12");
|
|
|
206 END IF;
|
|
|
207 IF REC4 NOT IN ACC2_REC2 THEN
|
|
|
208 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 13");
|
|
|
209 END IF;
|
|
|
210
|
|
|
211 ------------------------------------------------------------------------
|
|
|
212
|
|
|
213 IF REC5 NOT IN ACC_PREC1 THEN
|
|
|
214 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 14");
|
|
|
215 END IF;
|
|
|
216 IF REC5 NOT IN ACC_SREC1 THEN
|
|
|
217 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 15");
|
|
|
218 END IF;
|
|
|
219 IF REC6 NOT IN ACC_PREC1 THEN
|
|
|
220 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 16");
|
|
|
221 END IF;
|
|
|
222 REC5 := NEW PRI_REC1'(INIT_PREC1 (5, "12345"));
|
|
|
223 IF REC5 IN ACC_PREC1 THEN
|
|
|
224 NULL;
|
|
|
225 ELSE
|
|
|
226 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 17");
|
|
|
227 END IF;
|
|
|
228 IF REC5 IN ACC_SREC1 THEN
|
|
|
229 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 18");
|
|
|
230 END IF;
|
|
|
231 REC6 := NEW PRI_REC1'(INIT_PREC1 (2, "HI"));
|
|
|
232 IF REC6 IN ACC_PREC1 THEN
|
|
|
233 NULL;
|
|
|
234 ELSE
|
|
|
235 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 19");
|
|
|
236 END IF;
|
|
|
237
|
|
|
238 ------------------------------------------------------------------------
|
|
|
239
|
|
|
240 IF REC7 NOT IN ACC_PREC2 THEN
|
|
|
241 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 20");
|
|
|
242 END IF;
|
|
|
243 IF REC7 NOT IN ACC_SREC2 THEN
|
|
|
244 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 21");
|
|
|
245 END IF;
|
|
|
246 IF REC8 NOT IN ACC_PREC2 THEN
|
|
|
247 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 22");
|
|
|
248 END IF;
|
|
|
249 REC7 := NEW PRI_REC2'(INIT_PREC2 (5, "12345"));
|
|
|
250 IF REC7 IN ACC_PREC2 THEN
|
|
|
251 NULL;
|
|
|
252 ELSE
|
|
|
253 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 23");
|
|
|
254 END IF;
|
|
|
255 IF REC7 IN ACC_SREC2 THEN
|
|
|
256 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 24");
|
|
|
257 END IF;
|
|
|
258 REC8 := NEW PRI_REC2'(INIT_PREC2 (2, "HI"));
|
|
|
259 IF REC8 IN ACC_PREC2 THEN
|
|
|
260 NULL;
|
|
|
261 ELSE
|
|
|
262 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 25");
|
|
|
263 END IF;
|
|
|
264
|
|
|
265 ------------------------------------------------------------------------
|
|
|
266
|
|
|
267 IF REC9 NOT IN ACC_LIM1 THEN
|
|
|
268 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 26");
|
|
|
269 END IF;
|
|
|
270 IF REC9 NOT IN ACC_SUB_LIM1 THEN
|
|
|
271 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 27");
|
|
|
272 END IF;
|
|
|
273 IF REC10 NOT IN ACC_LIM1 THEN
|
|
|
274 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 28");
|
|
|
275 END IF;
|
|
|
276 REC9 := NEW LIM_REC1 (5);
|
|
|
277 ASSIGN_LIM1 (REC9, 5, "12345");
|
|
|
278 IF REC9 IN ACC_LIM1 THEN
|
|
|
279 NULL;
|
|
|
280 ELSE
|
|
|
281 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 29");
|
|
|
282 END IF;
|
|
|
283 IF REC9 IN ACC_SUB_LIM1 THEN
|
|
|
284 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 30");
|
|
|
285 END IF;
|
|
|
286 REC10 := NEW LIM_REC1 (2);
|
|
|
287 ASSIGN_LIM1 (REC10, 2, "12");
|
|
|
288 IF REC10 IN ACC_LIM1 THEN
|
|
|
289 NULL;
|
|
|
290 ELSE
|
|
|
291 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 31");
|
|
|
292 END IF;
|
|
|
293
|
|
|
294 ------------------------------------------------------------------------
|
|
|
295
|
|
|
296 IF REC11 NOT IN ACC_LIM2 THEN
|
|
|
297 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 32");
|
|
|
298 END IF;
|
|
|
299 IF REC11 NOT IN ACC_SUB_LIM2 THEN
|
|
|
300 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 33");
|
|
|
301 END IF;
|
|
|
302 IF REC12 NOT IN ACC_LIM2 THEN
|
|
|
303 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 34");
|
|
|
304 END IF;
|
|
|
305 REC11 := NEW LIM_REC2;
|
|
|
306 IF REC11 NOT IN ACC_SUB_LIM2 THEN
|
|
|
307 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 35");
|
|
|
308 END IF;
|
|
|
309 ASSIGN_LIM2 (REC11, 2, "12");
|
|
|
310 IF REC11 IN ACC_LIM2 THEN
|
|
|
311 NULL;
|
|
|
312 ELSE
|
|
|
313 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 36");
|
|
|
314 END IF;
|
|
|
315 IF REC11 IN ACC_SUB_LIM2 THEN
|
|
|
316 NULL;
|
|
|
317 ELSE
|
|
|
318 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 37");
|
|
|
319 END IF;
|
|
|
320 REC12 := NEW LIM_REC2;
|
|
|
321 ASSIGN_LIM2 (REC12, 2, "12");
|
|
|
322 IF REC12 IN ACC_LIM2 THEN
|
|
|
323 NULL;
|
|
|
324 ELSE
|
|
|
325 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 38");
|
|
|
326 END IF;
|
|
|
327
|
|
|
328 -- CASE E
|
|
|
329 ------------------------------------------------------------------------
|
|
|
330 DECLARE
|
|
|
331 TYPE ACC_TASK IS ACCESS T;
|
|
|
332 T1 : ACC_TASK;
|
|
|
333 BEGIN
|
|
|
334 IF T1 NOT IN ACC_TASK THEN
|
|
|
335 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 39");
|
|
|
336 END IF;
|
|
|
337 T1 := NEW T;
|
|
|
338 IF T1 IN ACC_TASK THEN
|
|
|
339 NULL;
|
|
|
340 ELSE
|
|
|
341 FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 38");
|
|
|
342 END IF;
|
|
|
343 T1.E (1);
|
|
|
344 END;
|
|
|
345
|
|
|
346 RESULT;
|
|
|
347 END C45282B;
|
