1-- C32001A.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 MULTIPLE OBJECT DECLARATIONS FOR SCALAR TYPES, THE
26-- SUBTYPE INDICATION AND THE INITIALIZATION EXPRESSIONS ARE EVALUATED
27-- ONCE FOR EACH NAMED OBJECT THAT IS DECLARED AND THE SUBTYPE
28-- INDICATION IS EVALUATED FIRST.  ALSO, CHECK THAT THE EVALUATIONS
29-- YIELD THE SAME RESULT AS A SEQUENCE OF SINGLE OBJECT DECLARATIONS.
30
31-- RJW 7/16/86
32
33WITH REPORT; USE REPORT;
34
35PROCEDURE C32001A IS
36
37     BUMP : ARRAY (1 .. 8) OF INTEGER := (OTHERS => 0);
38
39     FUNCTION F (I : INTEGER) RETURN INTEGER IS
40     BEGIN
41          BUMP (I) := BUMP (I) + 1;
42          RETURN BUMP (I);
43     END F;
44
45BEGIN
46     TEST ("C32001A", "CHECK THAT IN MULTIPLE OBJECT DECLARATION " &
47                      "FOR SCALAR TYPES, THE SUBTYPE INDICATION " &
48                      "AND THE INITIALIZATION EXPRESSIONS ARE " &
49                      "EVALUATED ONCE FOR EACH NAMED OBJECT THAT " &
50                      "IS DECLARED AND THE SUBTYPE INDICATION IS " &
51                      "EVALUATED FIRST.  ALSO, CHECK THAT THE " &
52                      "EVALUATIONS YIELD THE SAME RESULT AS A " &
53                      "SEQUENCE OF SINGLE OBJECT DECLARATIONS" );
54
55     DECLARE
56
57          TYPE DAY IS (MON, TUES, WED, THURS, FRI);
58          D1, D2   : DAY
59                     RANGE MON .. DAY'VAL (F (1)) :=
60                     DAY'VAL (F (1) - 1);
61          CD1, CD2 : CONSTANT DAY
62                     RANGE MON .. DAY'VAL (F (2)) :=
63                     DAY'VAL (F (2) - 1);
64
65          I1, I2   : INTEGER RANGE 0 .. F (3) :=
66                     F (3) - 1;
67          CI1, CI2 : CONSTANT INTEGER RANGE 0 .. F (4)
68                     := F (4) - 1;
69
70          TYPE FLT IS DIGITS 3 RANGE -5.0 .. 5.0;
71          FL1, FL2   : FLT RANGE 0.0 .. FLT (F (5)) :=
72                       FLT (F (5) - 1);
73          CFL1, CFL2 : CONSTANT FLT
74                       RANGE 0.0 .. FLT (F (6)) :=
75                       FLT (F (6) - 1);
76
77          TYPE FIX IS DELTA 1.0 RANGE -5.0 .. 5.0;
78          FI1, FI2   : FIX RANGE 0.0 .. FIX (F (7)) :=
79                       FIX (F (7) - 1);
80          CFI1, CFI2 : CONSTANT FIX
81                       RANGE 0.0 .. FIX (F (8)) :=
82                       FIX (F (8) - 1);
83
84     BEGIN
85          IF D1 /= TUES THEN
86               FAILED ( "D1 NOT INITIALIZED TO CORRECT VALUE" );
87          END IF;
88
89          IF D2 /= THURS THEN
90               FAILED ( "D2 NOT INITIALIZED TO CORRECT VALUE" );
91          END IF;
92
93          IF CD1 /= TUES THEN
94               FAILED ( "CD1 NOT INITIALIZED TO CORRECT VALUE" );
95          END IF;
96
97          IF CD2 /= THURS THEN
98               FAILED ( "CD2 NOT INITIALIZED TO CORRECT VALUE" );
99          END IF;
100
101          IF I1 /= 1 THEN
102               FAILED ( "I1 NOT INITIALIZED TO CORRECT VALUE" );
103          END IF;
104
105          IF I2 /= 3 THEN
106               FAILED ( "I2 NOT INITIALIZED TO CORRECT VALUE" );
107          END IF;
108
109          IF CI1 /= 1 THEN
110               FAILED ( "CI1 NOT INITIALIZED TO CORRECT VALUE" );
111          END IF;
112
113          IF CI2 /= 3 THEN
114               FAILED ( "CI2 NOT INITIALIZED TO CORRECT VALUE" );
115          END IF;
116
117          IF FL1 /= 1.0 THEN
118               FAILED ( "FL1 NOT INITIALIZED TO CORRECT VALUE" );
119          END IF;
120
121          IF FL2 /= 3.0 THEN
122               FAILED ( "FL2 NOT INITIALIZED TO CORRECT VALUE" );
123          END IF;
124
125          IF CFL1 /= 1.0 THEN
126               FAILED ( "CFL1 NOT INITIALIZED TO CORRECT VALUE" );
127          END IF;
128
129          IF CFL2 /= 3.0 THEN
130               FAILED ( "CFL2 NOT INITIALIZED TO CORRECT VALUE" );
131          END IF;
132
133          IF FI1 /= 1.0 THEN
134               FAILED ( "FI1 NOT INITIALIZED TO CORRECT VALUE" );
135          END IF;
136
137          IF FI2 /= 3.0 THEN
138               FAILED ( "FI2 NOT INITIALIZED TO CORRECT VALUE" );
139          END IF;
140
141          IF CFI1 /= 1.0 THEN
142               FAILED ( "CFI1 NOT INITIALIZED TO CORRECT VALUE" );
143          END IF;
144
145          IF CFI2 /= 3.0 THEN
146               FAILED ( "CFI2 NOT INITIALIZED TO CORRECT VALUE" );
147          END IF;
148
149     END;
150
151     RESULT;
152END C32001A;
153