1-- C32001B.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-- OBJECTIVE:
26--     CHECK THAT IN MULTIPLE OBJECT DECLARATIONS FOR ARRAY TYPES, THE
27--     SUBTYPE INDICATION AND THE INITIALIZATION EXPRESSIONS ARE
28--     EVALUATED ONCE FOR EACH NAMED OBJECT THAT IS DECLARED AND THE
29--     SUBTYPE INDICATION IS EVALUATED FIRST.  ALSO, CHECK THAT THE
30--     EVALUATIONS YIELD THE SAME RESULT AS A SEQUENCE OF SINGLE OBJECT
31--     DECLARATIONS.
32
33-- HISTORY:
34--     RJW 07/16/86  CREATED ORIGINAL TEST.
35--     BCB 08/18/87  CHANGED HEADER TO STANDARD HEADER FORMAT.  CHANGED
36--                   COMMENTS FOR S4 AND CS4 TO READ THAT THE BOUNDS ARE
37--                   1 .. 6 AND THE COMPONENT TYPE ARR IS 1 .. 5.
38
39WITH REPORT; USE REPORT;
40
41PROCEDURE C32001B IS
42
43     TYPE ARR IS ARRAY (NATURAL RANGE <>) OF INTEGER;
44
45     BUMP : ARRAY (1 .. 4) OF INTEGER := (0, 0, 0, 0);
46
47     FUNCTION F (I : INTEGER) RETURN INTEGER IS
48     BEGIN
49          BUMP (I) := BUMP (I) + 1;
50          RETURN BUMP (I);
51     END F;
52
53BEGIN
54     TEST ("C32001B", "CHECK THAT IN MULTIPLE OBJECT DECLARATIONS " &
55                      "FOR ARRAY TYPES, THE SUBTYPE INDICATION " &
56                      "AND THE INITIALIZATION EXPRESSIONS ARE " &
57                      "EVALUATED ONCE FOR EACH NAMED OBJECT THAT " &
58                      "IS DECLARED AND THE SUBTYPE INDICATION IS " &
59                      "EVALUATED FIRST.  ALSO, CHECK THAT THE " &
60                      "EVALUATIONS YIELD THE SAME RESULT AS A " &
61                      "SEQUENCE OF SINGLE OBJECT DECLARATIONS" );
62
63     DECLARE
64
65          S1, S2   : ARR (1 .. F (1)) := (OTHERS => F (1));
66          CS1, CS2 : CONSTANT ARR (1 .. F (2)) := (OTHERS => F (2));
67
68          PROCEDURE CHECK (A, B : ARR; STR1, STR2 : STRING) IS
69          BEGIN
70               IF A'LAST /= 1 THEN
71                    FAILED ( "INCORRECT UPPER BOUND FOR " & STR1 );
72               END IF;
73
74               IF A (1) /= 2 THEN
75                    FAILED ( "INCORRECT INITIAL VALUE FOR " & STR1 );
76               END IF;
77
78               IF B'LAST /= 3 THEN
79                    FAILED ( "INCORRECT UPPER BOUND FOR " & STR2 );
80               END IF;
81
82               BEGIN
83                    IF B (1 .. 3) = (4, 5, 6) THEN
84                         COMMENT ( STR2 & " WAS INITIALIZED TO " &
85                                   "(4, 5, 6)" );
86                    ELSIF B (1 .. 3) = (5, 4, 6) THEN
87                         COMMENT ( STR2 & " WAS INITIALIZED TO " &
88                                   "(5, 4, 6)" );
89                    ELSIF B (1 .. 3) = (4, 6, 5) THEN
90                         COMMENT ( STR2 & " WAS INITIALIZED TO " &
91                                   "(4, 6, 5)" );
92                    ELSIF B (1 .. 3) = (6, 4, 5) THEN
93                         COMMENT ( STR2 & " WAS INITIALIZED TO " &
94                                   "(6, 4, 5)" );
95                    ELSIF B (1 .. 3) = (6, 5, 4) THEN
96                         COMMENT ( STR2 & " WAS INITIALIZED TO " &
97                                   "(6, 5, 4)" );
98                    ELSIF B (1 .. 3) = (5, 6, 4) THEN
99                         COMMENT ( STR2 & " WAS INITIALIZED TO " &
100                                   "(5, 6, 4)" );
101                    ELSE
102                         FAILED ( STR2 & " HAS INCORRECT INITIAL " &
103                                  "VALUE" );
104                    END IF;
105               EXCEPTION
106                    WHEN CONSTRAINT_ERROR =>
107                         FAILED ( "CONSTRAINT_ERROR RAISED - " &
108                                   STR2 );
109                    WHEN OTHERS =>
110                         FAILED ( "EXCEPTION RAISED - " &
111                                   STR2 );
112               END;
113          END;
114
115     BEGIN
116          CHECK (S1, S2, "S1", "S2");
117          CHECK (CS1, CS2, "CS1", "CS2");
118     END;
119
120     DECLARE
121
122          S3, S4 : ARRAY (1 .. F (3)) OF ARR (1 .. F (3)) :=
123                   (OTHERS => (OTHERS => F (3)));
124
125          CS3, CS4 : CONSTANT ARRAY (1.. F (4)) OF
126                     ARR (1 .. F (4)) :=
127                     (OTHERS => (OTHERS => F (4)));
128     BEGIN
129          IF S3'LAST = 1 THEN
130               IF S3 (1)'LAST = 2 THEN
131                    COMMENT ( "S3 HAS BOUNDS 1 .. 1 AND " &
132                              "COMPONENT TYPE ARR (1 .. 2)" );
133                    IF S3 (1)(1 .. 2) = (3, 4) THEN
134                         COMMENT ( "S3 HAS INITIAL VALUES " &
135                                   "3 AND 4 - 1" );
136                    ELSIF S3 (1)(1 .. 2) = (4, 3) THEN
137                         COMMENT ( "S3 HAS INITIAL VALUES " &
138                                   "4 AND 3 - 1" );
139                    ELSE
140                         FAILED ( "S3 HAS WRONG INITIAL VALUES - 1" );
141                    END IF;
142               ELSE
143                    FAILED ( "S3 HAS WRONG COMPONENT TYPE - 1" );
144               END IF;
145          ELSIF S3'LAST = 2 THEN
146               IF S3 (1)'LAST = 1 THEN
147                    COMMENT ( "S3 HAS BOUNDS 1 .. 2 AND " &
148                              "COMPONENT TYPE ARR (1 .. 1)" );
149                    IF S3 (1) (1) = 3 AND S3 (2) (1) = 4 THEN
150                         COMMENT ( "S3 HAS INITIAL VALUES " &
151                                   "3 AND 4 - 2" );
152                    ELSIF S3 (1) (1) = 4 AND S3 (2) (1) = 3 THEN
153                         COMMENT ( "S3 HAS INITIAL VALUES " &
154                                   "4 AND 3 - 2" );
155                    ELSE
156                         FAILED ( "S3 HAS WRONG INITIAL VALUES - 2" );
157                    END IF;
158               ELSE
159                    FAILED ( "S3 HAS WRONG COMPONENT TYPE - 2" );
160               END IF;
161          ELSE
162               FAILED ( "S3 HAS INCORRECT BOUNDS" );
163          END IF;
164
165          IF S4'LAST = 5 THEN
166               IF S4 (1)'LAST = 6 THEN
167                    COMMENT ( "S4 HAS BOUNDS 1 .. 5 AND " &
168                              "COMPONENT TYPE ARR (1 .. 6)" );
169               ELSE
170                    FAILED ( "S4 HAS WRONG COMPONENT TYPE - 1" );
171               END IF;
172          ELSIF S4'LAST = 6 THEN
173               IF S4 (1)'FIRST = 1 AND S4 (1)'LAST = 5 THEN
174                    COMMENT ( "S4 HAS BOUNDS 1 .. 6 AND " &
175                              "COMPONENT TYPE ARR (1 .. 5)" );
176               ELSE
177                    FAILED ( "S4 HAS WRONG COMPONENT TYPE - 2" );
178               END IF;
179          ELSE
180               FAILED ( "S4 HAS INCORRECT BOUNDS" );
181          END IF;
182
183          IF BUMP (3) /= 36 THEN
184               FAILED ( "FUNCTION F NOT INVOKED CORRECT NUMBER OF " &
185                        "TIMES TO INITIALIZE S4" );
186          END IF;
187
188          IF CS3'FIRST = 1 AND CS3'LAST = 1 THEN
189               IF CS3 (1)'FIRST = 1 AND CS3 (1)'LAST = 2 THEN
190                    COMMENT ( "CS3 HAS BOUNDS 1 .. 1 AND " &
191                              "COMPONENT TYPE ARR (1 .. 2)" );
192                    IF CS3 (1)(1 .. 2) = (3, 4) THEN
193                         COMMENT ( "CS3 HAS INITIAL VALUES " &
194                                   "3 AND 4 - 1" );
195                    ELSIF CS3 (1)(1 .. 2) = (4, 3) THEN
196                         COMMENT ( "CS3 HAS INITIAL VALUES " &
197                                   "4 AND 3 - 1" );
198                    ELSE
199                         FAILED ( "CS3 HAS WRONG INITIAL VALUES - 1" );
200                    END IF;
201               ELSE
202                    FAILED ( "CS3 HAS WRONG COMPONENT TYPE - 1" );
203               END IF;
204          ELSIF CS3'FIRST = 1 AND CS3'LAST = 2 THEN
205               IF CS3 (1)'FIRST = 1 AND CS3 (1)'LAST = 1 THEN
206                    COMMENT ( "CS3 HAS BOUNDS 1 .. 2 AND " &
207                              "COMPONENT TYPE ARR (1 .. 1)" );
208                    IF CS3 (1) (1) = 3 AND CS3 (2) (1) = 4 THEN
209                         COMMENT ( "CS3 HAS INITIAL VALUES " &
210                                   "3 AND 4 - 2" );
211                    ELSIF CS3 (1) (1) = 4 AND CS3 (2) (1) = 3 THEN
212                         COMMENT ( "CS3 HAS INITIAL VALUES " &
213                                   "4 AND 3 - 2" );
214                    ELSE
215                         FAILED ( "CS3 HAS WRONG INITIAL VALUES - 2" );
216                    END IF;
217               ELSE
218                    FAILED ( "CS3 HAS WRONG COMPONENT TYPE - 2" );
219               END IF;
220          ELSE
221               FAILED ( "CS3 HAS INCORRECT BOUNDS" );
222          END IF;
223
224          IF CS4'FIRST = 1 AND CS4'LAST = 5 THEN
225               IF CS4 (1)'FIRST = 1 AND CS4 (1)'LAST = 6 THEN
226                    COMMENT ( "CS4 HAS BOUNDS 1 .. 5 AND " &
227                              "COMPONENT TYPE ARR (1 .. 6)" );
228               ELSE
229                    FAILED ( "CS4 HAS WRONG COMPONENT TYPE - 1" );
230               END IF;
231          ELSIF CS4'FIRST = 1 AND CS4'LAST = 6 THEN
232               IF CS4 (1)'FIRST = 1 AND CS4 (1)'LAST = 5 THEN
233                    COMMENT ( "CS4 HAS BOUNDS 1 .. 6 AND " &
234                              "COMPONENT TYPE ARR (1 .. 5)" );
235               ELSE
236                    FAILED ( "CS4 HAS WRONG COMPONENT TYPE - 2" );
237               END IF;
238          ELSE
239               FAILED ( "CS4 HAS INCORRECT BOUNDS" );
240          END IF;
241
242          IF BUMP (4) /= 36 THEN
243               FAILED ( "FUNCTION F NOT INVOKED CORRECT NUMBER OF " &
244                        "TIMES TO INITIALIZE CS4" );
245          END IF;
246     END;
247
248     RESULT;
249END C32001B;
250