1-- C38005A.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 ALL (UNINITIALIZED) ACCESS OBJECTS ARE INITIALIZED
26-- TO NULL BY DEFAULT. VARIABLES, ARRAYS, RECORDS, ARRAYS OF RECORDS,
27-- ARRAYS OF ARRAYS, RECORDS WITH ARRAYS AND RECORD COMPONENTS
28-- ARE ALL CHECKED.
29-- FUNCTION RESULTS (I.E. RETURNED FROM IMPLICIT FUNCTION RETURN)
30-- ARE NOT CHECKED.
31
32-- DAT 3/6/81
33-- VKG 1/5/83
34-- SPS 2/17/83
35
36WITH REPORT; USE REPORT;
37
38PROCEDURE C38005A IS
39
40     TYPE REC;
41     TYPE ACC_REC IS ACCESS REC;
42     TYPE VECTOR IS ARRAY ( NATURAL RANGE <> ) OF ACC_REC;
43     TYPE REC IS RECORD
44          VECT : VECTOR (3 .. 5);
45     END RECORD;
46
47     TYPE ACC_VECT IS ACCESS VECTOR;
48     TYPE ARR_REC IS ARRAY (1 .. 2) OF REC;
49     TYPE REC2;
50     TYPE ACC_REC2 IS ACCESS REC2;
51     TYPE REC2 IS RECORD
52          C1 : ACC_REC;
53          C2 : ACC_VECT;
54          C3 : ARR_REC;
55          C4 : REC;
56          C5 : ACC_REC2;
57     END RECORD;
58
59     N_REC      : REC;
60     N_ACC_REC  : ACC_REC;
61     N_VEC      : VECTOR (3 .. IDENT_INT (5));
62     N_ACC_VECT : ACC_VECT;
63     N_ARR_REC  : ARR_REC;
64     N_REC2     : REC2;
65     N_ACC_REC2 : ACC_REC2;
66     N_ARR      : ARRAY (1..2) OF VECTOR (1..2);
67     Q : REC2 :=
68                (C1 => NEW REC,
69                 C2 => NEW VECTOR'(NEW REC, NEW REC'(N_REC)),
70                 C3 => (1 | 2 => (VECT=>(3|4=> NEW REC,
71                                         5=>N_ACC_REC)
72                                 )),
73                 C4 => N_REC2.C4,
74                 C5 => NEW REC2'(N_REC2));
75
76BEGIN
77     TEST ("C38005A", "DEFAULT VALUE FOR ACCESS OBJECTS IS NULL");
78
79     IF N_REC /= REC'(VECT => (3..5 => NULL))
80     THEN
81          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 1");
82     END IF;
83
84     IF N_ACC_REC /= NULL
85     THEN
86          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 2");
87     END IF;
88
89     IF N_VEC /= N_REC.VECT
90     THEN
91          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 3");
92     END IF;
93
94     IF N_ARR /= ((NULL, NULL), (NULL, NULL))
95     THEN
96          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 4");
97     END IF;
98
99     IF N_ACC_VECT /= NULL
100     THEN
101          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 5");
102     END IF;
103
104     IF N_ARR_REC /= (N_REC, N_REC)
105     THEN
106          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 6");
107     END IF;
108
109     IF N_REC2 /= (NULL, NULL, N_ARR_REC, N_REC, NULL)
110     THEN
111          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 7");
112     END IF;
113
114     IF N_ACC_REC2 /= NULL
115     THEN
116          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 8");
117     END IF;
118
119     IF Q /= (Q.C1, Q.C2, (Q.C3(1), Q.C3(2)), N_REC, Q.C5)
120     THEN
121          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 9");
122     END IF;
123
124     IF Q.C1.ALL /= N_REC
125     THEN
126          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 10");
127     END IF;
128
129     IF Q.C2.ALL(0).ALL /= N_REC
130     THEN
131          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 11");
132     END IF;
133
134     IF Q.C2(1).VECT /= N_VEC
135     THEN
136          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 12");
137     END IF;
138
139     IF Q.C3(2).VECT /= (3 => Q.C3(2).VECT(3),
140                         4 => Q.C3(2).VECT(4),
141                         5=>NULL)
142     THEN
143          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 13");
144     END IF;
145
146     IF Q.C3(2).VECT(3).ALL /= N_REC
147     THEN
148          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 14");
149     END IF;
150
151     IF Q.C5.ALL /= N_REC2
152     THEN
153          FAILED ("INCORRECT ACCESS TYPE INITIALIZATION - 15");
154     END IF;
155
156     DECLARE
157          PROCEDURE T (R : OUT REC2) IS
158          BEGIN
159               NULL;
160          END T;
161     BEGIN
162          N_REC2 := Q;
163          T(Q);
164          IF Q /= N_REC2 THEN
165               FAILED ("INCORRECT OUT PARM INIT 2");
166          END IF;
167     END;
168
169     RESULT;
170END C38005A;
171