1-- C37003A.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 MULTIPLE COMPONENT DECLARATIONS ARE TREATED AS A SERIES
26-- OF SINGLE COMNENT DECLARATIONS, I.E., THE COMPONENTS ALL HAVE THE
27-- SAME TYPE AND ANY EXPRESSION USED IN CONSTRAINTS OR INITIALIZATIONS
28-- IS EVALUATED ONCE FOR EACH COMPONENT.
29
30-- DAT 3/30/81
31-- SPS 10/26/82
32-- JWC 10/23/85  RENAMED FROM C37013A-AB.ADA.
33--               ADDED TEST TO ENSURE THAT ANY EXPRESSION USED
34--               IN A CONSTRAINT IS EVALUATED ONCE FOR EACH
35--               COMPONENT.
36-- JRK 11/15/85  ADDED INITIALIZATION EVALUATION CHECKS.
37
38WITH REPORT; USE REPORT;
39
40PROCEDURE C37003A IS
41
42     X : INTEGER := 0;
43
44     FUNCTION F RETURN INTEGER IS
45     BEGIN
46          X := X + 1;
47          RETURN X;
48     END F;
49
50     PROCEDURE RESET IS
51     BEGIN
52          X := 0;
53     END RESET;
54
55BEGIN
56     TEST ("C37003A", "CHECK THAT MULTIPLE COMPONENT DECLARATIONS " &
57                      "ARE TREATED AS A SERIES OF SINGLE COMPONENT " &
58                      "DECLARATIONS");
59
60     DECLARE
61
62          TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
63
64          TYPE REC1 IS RECORD
65               A1, A2 : ARR (1 .. F) := (OTHERS => F);
66          END RECORD;
67
68          R1 : REC1 := (OTHERS => (OTHERS => 1));
69          Y : INTEGER := X;
70          R1A : REC1;
71
72     BEGIN
73
74          IF R1.A1 = R1.A2 THEN        -- TEST TO SEE IF THE COMPONENTS
75               NULL;                   -- ARE OF THE SAME TYPE.
76          END IF;
77
78          IF Y /= 2 THEN
79               FAILED ("CONSTRAINT EXPRESSION NOT EVALUATED TWICE " &
80                       "FOR ARRAYS");
81          END IF;
82
83          IF X /= 5 THEN
84               FAILED ("INITIALIZATION EXPRESSION NOT EVALUATED FOR " &
85                       "EACH ARRAY COMPONENT");
86          END IF;
87
88          RESET;
89
90     END;
91
92     DECLARE
93
94          TYPE REC2 IS RECORD
95               I1, I2 : INTEGER RANGE 1 .. F := F * IDENT_INT(0) + 1;
96          END RECORD;
97
98          R2 : REC2 := (OTHERS => 1);
99          Y : INTEGER := X;
100          R2A : REC2;
101
102     BEGIN
103
104          IF R2.I1 = R2.I2 THEN        -- TEST TO SEE IF THE COMPONENTS
105               NULL;                   -- ARE OF THE SAME TYPE.
106          END IF;
107
108          IF Y /= 2 THEN
109               FAILED ("CONSTRAINT EXPRESSION NOT EVALUATED TWICE " &
110                       "FOR SCALARS");
111          END IF;
112
113          IF X /= 4 THEN
114               FAILED ("INITIALIZATION EXPRESSION NOT EVALUATED FOR " &
115                       "EACH SCALAR COMPONENT");
116          END IF;
117
118          RESET;
119
120     END;
121
122     DECLARE
123
124          TYPE REC3X (DSC : INTEGER) IS RECORD
125               NULL;
126          END RECORD;
127
128          TYPE REC3Y IS RECORD
129               I : INTEGER;
130          END RECORD;
131
132          TYPE REC3 IS RECORD
133               RX1, RX2 : REC3X (F);
134               RY1, RY2 : REC3Y := (I => F);
135          END RECORD;
136
137          R3 : REC3 := ((DSC => 1), (DSC => 2), (I => 0), (I => 0));
138          Y : INTEGER := X;
139          R3A : REC3;
140
141     BEGIN
142
143          IF R3.RX1 = R3.RX2 THEN       -- TEST TO SEE IF THE COMPONENTS
144               NULL;                    -- ARE OF THE SAME TYPE.
145          END IF;
146
147          IF Y /= 2 THEN
148               FAILED ("CONSTRAINT EXPRESSION NOT EVALUATED TWICE " &
149                       "FOR RECORDS");
150          END IF;
151
152          IF X /= 4 THEN
153               FAILED ("INITIALIZATION EXPRESSION NOT EVALUATED " &
154                       "FOR EACH RECORD COMPONENT");
155          END IF;
156
157          RESET;
158
159     END;
160
161     DECLARE
162
163          TYPE REC4X (DSC : INTEGER) IS RECORD
164               NULL;
165          END RECORD;
166
167          TYPE ACR IS ACCESS REC4X;
168          TYPE ACI IS ACCESS INTEGER;
169
170          TYPE REC4 IS RECORD
171               AC1, AC2 : ACR (F);
172               AC3, AC4 : ACI := NEW INTEGER'(F);
173          END RECORD;
174
175          R4 : REC4 := (NULL, NULL, NULL, NULL);
176          Y : INTEGER := X;
177          R4A : REC4;
178
179     BEGIN
180
181          IF R4.AC1 = R4.AC2 THEN       -- TEST TO SEE IF THE COMPONENTS
182               NULL;                    -- ARE OF THE SAME TYPE.
183          END IF;
184
185          IF Y /= 2 THEN
186               FAILED ("CONSTRAINT EXPRESSION NOT EVALUATED TWICE " &
187                       "FOR ACCESS");
188          END IF;
189
190          IF X /= 4 THEN
191               FAILED ("INITIALIZATION EXPRESSION NOT EVALUATED " &
192                       "FOR EACH ACCESS COMPONENT");
193          END IF;
194
195     END;
196
197     RESULT;
198END C37003A;
199