3 -- Grant of Unlimited Rights
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
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.
26 -- CHECK THAT WHEN THE FULL DECLARATION OF A DEFERRED CONSTANT IS
27 -- GIVEN AS A MULTIPLE DECLARATION, THE INITIALIZATION EXPRESSION
28 -- IS EVALUATED ONCE FOR EACH DEFERRED CONSTANT. (USE ENUMERATION,
29 -- INTEGER, FIXED POINT, FLOATING POINT, ARRAY, RECORD (INCLUDING
30 -- USE OF DEFAULT EXPRESSIONS FOR COMPONENTS), ACCESS, AND PRIVATE
31 -- TYPES AS FULL DECLARATION OF PRIVATE TYPE)
34 -- BCB 07/25/88 CREATED ORIGINAL TEST.
36 WITH REPORT
; USE REPORT
;
40 TYPE ARR_RAN
IS RANGE 1..2;
42 BUMP
: INTEGER := IDENT_INT
(0);
46 FUNCTION F1
RETURN DT
;
50 FUNCTION F2
RETURN FE
;
53 TYPE FLE
IS DIGITS <>;
54 FUNCTION F3
RETURN FLE
;
57 TYPE CA
IS ARRAY(ARR_RAN
) OF INTEGER;
58 FUNCTION F4
RETURN CA
;
61 TYPE GP
IS LIMITED PRIVATE;
62 FUNCTION F5
(V
: GP
) RETURN GP
;
65 TYPE GP1
IS LIMITED PRIVATE;
66 FUNCTION F6
(V1
: GP1
) RETURN GP1
;
69 TYPE AC
IS ACCESS INTEGER;
70 FUNCTION F7
RETURN AC
;
74 FUNCTION F8
(P1
: PP
) RETURN PP
;
76 FUNCTION F1
RETURN DT
IS
82 FUNCTION F2
RETURN FE
IS
88 FUNCTION F3
RETURN FLE
IS
94 FUNCTION F4
RETURN CA
IS
97 RETURN ((BUMP
,BUMP
-1));
100 FUNCTION F5
(V
: GP
) RETURN GP
IS
106 FUNCTION F6
(V1
: GP1
) RETURN GP1
IS
112 FUNCTION F7
RETURN AC
IS
116 VAR
:= NEW INTEGER'(BUMP);
120 FUNCTION F8 (P1 : PP) RETURN PP IS
130 TYPE SP IS RANGE 1 .. 100;
131 CONS : CONSTANT SP := 50;
138 TYPE ENUM IS PRIVATE;
141 TYPE CON_ARR IS PRIVATE;
143 TYPE REC1 IS PRIVATE;
145 TYPE PRIV IS PRIVATE;
149 FUNCTION GEN_EQUAL (Z1, Z2 : LP) RETURN BOOLEAN;
151 I1, I2, I3, I4 : CONSTANT INT;
152 E1, E2, E3, E4 : CONSTANT ENUM;
153 FI1, FI2, FI3, FI4 : CONSTANT FIX;
154 FL1, FL2, FL3, FL4 : CONSTANT FLT;
155 CA1, CA2, CA3, CA4 : CONSTANT CON_ARR;
156 R1, R2, R3, R4 : CONSTANT REC;
157 R1A, R2A, R3A, R4A : CONSTANT REC1;
158 A1, A2, A3, A4 : CONSTANT ACC;
159 PR1, PR2, PR3, PR4 : CONSTANT PRIV;
161 TYPE INT IS RANGE 1 .. 100;
163 TYPE ENUM IS (ONE,TWO,THREE,FOUR,FIVE,SIX,SEVEN,EIGHT,NINE);
165 TYPE FIX IS DELTA 2.0**(-1) RANGE -100.0 .. 100.0;
167 TYPE FLT IS DIGITS 5 RANGE -100.0 .. 100.0;
169 TYPE CON_ARR IS ARRAY(ARR_RAN) OF INTEGER;
178 COMP1 : INTEGER := 10;
179 COMP2 : INTEGER := 20;
180 COMP3 : BOOLEAN := FALSE;
183 TYPE ACC IS ACCESS INTEGER;
187 FUNCTION DDT IS NEW F1 (INT);
188 FUNCTION EDT IS NEW F1 (ENUM);
189 FUNCTION FDT IS NEW F2 (FIX);
190 FUNCTION FLDT IS NEW F3 (FLT);
191 FUNCTION CADT IS NEW F4 (CON_ARR);
192 FUNCTION RDT IS NEW F5 (REC);
193 FUNCTION R1DT IS NEW F6 (REC1);
194 FUNCTION ADT IS NEW F7 (ACC);
195 FUNCTION PDT IS NEW F8 (PRIV);
197 REC_OBJ : REC := (1,2,TRUE);
198 REC1_OBJ : REC1 := (3,4,FALSE);
200 I1, I2, I3, I4 : CONSTANT INT := DDT;
201 E1, E2, E3, E4 : CONSTANT ENUM := EDT;
202 FI1, FI2, FI3, FI4 : CONSTANT FIX := FDT;
203 FL1, FL2, FL3, FL4 : CONSTANT FLT := FLDT;
204 CA1, CA2, CA3, CA4 : CONSTANT CON_ARR := CADT;
205 R1, R2, R3, R4 : CONSTANT REC := RDT(REC_OBJ);
206 R1A, R2A, R3A, R4A : CONSTANT REC1 := R1DT(REC1_OBJ);
207 A1, A2, A3, A4 : CONSTANT ACC := ADT;
208 PR1, PR2, PR3, PR4 : CONSTANT PRIV := PDT(PRIV(CONS));
212 AVAR1 : ACC := NEW INTEGER'(29);
213 AVAR2
: ACC
:= NEW INTEGER'(30);
214 AVAR3 : ACC := NEW INTEGER'(31);
215 AVAR4
: ACC
:= NEW INTEGER'(32);
217 FUNCTION GEN_EQUAL (Z1, Z2 : LP) RETURN BOOLEAN IS
222 FUNCTION INT_EQUAL IS NEW GEN_EQUAL (INT);
223 FUNCTION ENUM_EQUAL IS NEW GEN_EQUAL (ENUM);
224 FUNCTION FIX_EQUAL IS NEW GEN_EQUAL (FIX);
225 FUNCTION FLT_EQUAL IS NEW GEN_EQUAL (FLT);
226 FUNCTION ARR_EQUAL IS NEW GEN_EQUAL (CON_ARR);
227 FUNCTION REC_EQUAL IS NEW GEN_EQUAL (REC);
228 FUNCTION REC1_EQUAL IS NEW GEN_EQUAL (REC1);
229 FUNCTION ACC_EQUAL IS NEW GEN_EQUAL (INTEGER);
230 FUNCTION PRIV_EQUAL IS NEW GEN_EQUAL (PRIV);
232 TEST ("C74302B", "CHECK THAT WHEN THE FULL DECLARATION OF " &
233 "A DEFERRED CONSTANT IS GIVEN AS A " &
234 "MULTIPLE DECLARATION, THE INITIALIZATION " &
235 "EXPRESSION IS EVALUATED ONCE FOR EACH " &
236 "DEFERRED CONSTANT");
238 IF NOT EQUAL(BUMP,36) THEN
239 FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
240 "DEFERRED CONSTANTS IN A MULIPLE DECLARATION");
243 IF NOT INT_EQUAL(I1,1) OR NOT INT_EQUAL(I2,2) OR
244 NOT INT_EQUAL(I3,3) OR NOT INT_EQUAL(I4,4) THEN
245 FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
246 "DEFERRED INTEGER CONSTANTS");
249 IF NOT ENUM_EQUAL(E1,SIX) OR NOT ENUM_EQUAL(E2,SEVEN) OR
250 NOT ENUM_EQUAL(E3,EIGHT) OR NOT ENUM_EQUAL(E4,NINE) THEN
251 FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
252 "DEFERRED ENUMERATION CONSTANTS");
255 IF NOT FIX_EQUAL(FI1,9.0) OR NOT FIX_EQUAL(FI2,10.0) OR
256 NOT FIX_EQUAL(FI3,11.0) OR NOT FIX_EQUAL(FI4,12.0) THEN
257 FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
258 "DEFERRED FIXED POINT CONSTANTS");
261 IF NOT FLT_EQUAL(FL1,13.0) OR NOT FLT_EQUAL(FL2,14.0) OR
262 NOT FLT_EQUAL(FL3,15.0) OR NOT FLT_EQUAL(FL4,16.0) THEN
263 FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
264 "DEFERRED FLOATING POINT CONSTANTS");
267 IF NOT ARR_EQUAL(CA1,(17,16)) OR NOT ARR_EQUAL(CA2,(18,17))
268 OR NOT ARR_EQUAL(CA3,(19,18)) OR NOT ARR_EQUAL(CA4,(20,19))
269 THEN FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
270 "DEFERRED ARRAY CONSTANTS");
273 IF NOT REC_EQUAL(R1,REC_OBJ) OR NOT REC_EQUAL(R2,REC_OBJ)
274 OR NOT REC_EQUAL(R3,REC_OBJ) OR NOT REC_EQUAL(R4,REC_OBJ)
275 THEN FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
276 "DEFERRED RECORD CONSTANTS");
279 IF NOT REC1_EQUAL(R1A,REC1_OBJ) OR NOT REC1_EQUAL(R2A,
280 REC1_OBJ) OR NOT REC1_EQUAL(R3A,REC1_OBJ) OR NOT
281 REC1_EQUAL(R4A,REC1_OBJ) THEN
282 FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
283 "DEFERRED RECORD CONSTANTS WITH DEFAULT " &
287 IF NOT ACC_EQUAL(A1.ALL,AVAR1.ALL) OR NOT ACC_EQUAL(A2.ALL,
288 AVAR2.ALL) OR NOT ACC_EQUAL(A3.ALL,AVAR3.ALL) OR NOT
289 ACC_EQUAL(A4.ALL,AVAR4.ALL) THEN
290 FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
291 "DEFERRED ACCESS CONSTANTS");
294 IF NOT PRIV_EQUAL(PR1,PRIV(CONS)) OR NOT PRIV_EQUAL(PR2,
295 PRIV(CONS)) OR NOT PRIV_EQUAL(PR3,PRIV(CONS)) OR NOT
296 PRIV_EQUAL(PR4,PRIV(CONS)) THEN
297 FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
298 "DEFERRED PRIVATE CONSTANTS");