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
33WITH REPORT; USE REPORT;
34PROCEDURE 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
141BEGIN
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;
347END C45282B;
348