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.
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.
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
36 -- JRK 11/15/85 ADDED INITIALIZATION EVALUATION CHECKS.
38 WITH REPORT
; USE REPORT
;
44 FUNCTION F
RETURN INTEGER IS
56 TEST
("C37003A", "CHECK THAT MULTIPLE COMPONENT DECLARATIONS " &
57 "ARE TREATED AS A SERIES OF SINGLE COMPONENT " &
62 TYPE ARR
IS ARRAY (INTEGER RANGE <>) OF INTEGER;
65 A1
, A2
: ARR
(1 .. F
) := (OTHERS => F
);
68 R1
: REC1
:= (OTHERS => (OTHERS => 1));
74 IF R1
.A1
= R1
.A2
THEN -- TEST TO SEE IF THE COMPONENTS
75 NULL; -- ARE OF THE SAME TYPE.
79 FAILED
("CONSTRAINT EXPRESSION NOT EVALUATED TWICE " &
84 FAILED
("INITIALIZATION EXPRESSION NOT EVALUATED FOR " &
85 "EACH ARRAY COMPONENT");
95 I1
, I2
: INTEGER RANGE 1 .. F
:= F
* IDENT_INT
(0) + 1;
98 R2
: REC2
:= (OTHERS => 1);
104 IF R2
.I1
= R2
.I2
THEN -- TEST TO SEE IF THE COMPONENTS
105 NULL; -- ARE OF THE SAME TYPE.
109 FAILED
("CONSTRAINT EXPRESSION NOT EVALUATED TWICE " &
114 FAILED
("INITIALIZATION EXPRESSION NOT EVALUATED FOR " &
115 "EACH SCALAR COMPONENT");
124 TYPE REC3X
(DSC
: INTEGER) IS RECORD
133 RX1
, RX2
: REC3X
(F
);
134 RY1
, RY2
: REC3Y
:= (I
=> F
);
137 R3
: REC3
:= ((DSC
=> 1), (DSC
=> 2), (I
=> 0), (I
=> 0));
143 IF R3
.RX1
= R3
.RX2
THEN -- TEST TO SEE IF THE COMPONENTS
144 NULL; -- ARE OF THE SAME TYPE.
148 FAILED
("CONSTRAINT EXPRESSION NOT EVALUATED TWICE " &
153 FAILED
("INITIALIZATION EXPRESSION NOT EVALUATED " &
154 "FOR EACH RECORD COMPONENT");
163 TYPE REC4X
(DSC
: INTEGER) IS RECORD
167 TYPE ACR
IS ACCESS REC4X
;
168 TYPE ACI
IS ACCESS INTEGER;
172 AC3
, AC4
: ACI
:= NEW INTEGER'(F);
175 R4 : REC4 := (NULL, NULL, NULL, NULL);
181 IF R4.AC1 = R4.AC2 THEN -- TEST TO SEE IF THE COMPONENTS
182 NULL; -- ARE OF THE SAME TYPE.
186 FAILED ("CONSTRAINT EXPRESSION NOT EVALUATED TWICE " &
191 FAILED ("INITIALIZATION EXPRESSION NOT EVALUATED " &
192 "FOR EACH ACCESS COMPONENT");