1-- CD2A24E.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 IF A SIZE CLAUSE AND AN ENUMERATION
27--     REPRESENTATION CLAUSE ARE GIVEN FOR AN ENUMERATION TYPE,
28--     AND THE SMALLEST SIZE APPROPRIATE FOR AN UNSIGNED REPRESENTATION
29--     IS SPECIFIED, THEN OPERATIONS ON THE TYPE ARE NOT AFFECTED.
30
31-- HISTORY:
32--     JET 08/19/87 CREATED ORIGINAL TEST.
33--     PWB 05/11/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
34--     WMC 03/27/92 ELIMINATED TEST REDUNDANCIES.
35
36WITH REPORT; USE REPORT;
37PROCEDURE CD2A24E IS
38
39     BASIC_SIZE : CONSTANT := 3;
40
41     TYPE CHECK_TYPE IS (ZERO, ONE, TWO);
42
43     FOR CHECK_TYPE USE (ZERO => 3, ONE => 4,
44                         TWO => 5);
45
46     FOR CHECK_TYPE'SIZE USE BASIC_SIZE;
47
48     C0 : CHECK_TYPE := ZERO;
49     C1 : CHECK_TYPE := ONE;
50     C2 : CHECK_TYPE := TWO;
51
52     TYPE ARRAY_TYPE IS ARRAY (0 .. 2) OF CHECK_TYPE;
53     CHARRAY : ARRAY_TYPE := (ZERO, ONE, TWO);
54
55     TYPE REC_TYPE IS RECORD
56          COMP0 : CHECK_TYPE := ZERO;
57          COMP1 : CHECK_TYPE := ONE;
58          COMP2 : CHECK_TYPE := TWO;
59     END RECORD;
60
61     CHREC : REC_TYPE;
62
63     FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS
64     BEGIN
65          IF EQUAL (3, 3) THEN
66               RETURN CH;
67          ELSE
68               RETURN ONE;
69          END IF;
70     END IDENT;
71
72     PROCEDURE PROC (CI0,  CI2  :        CHECK_TYPE;
73                     CIO1, CIO2 : IN OUT CHECK_TYPE;
74                     CO2        :    OUT CHECK_TYPE) IS
75     BEGIN
76          IF NOT ((CI0 <  IDENT (ONE))                          AND
77                  (IDENT (CI2)  > IDENT (CIO1))                 AND
78                  (CIO1 <= IDENT (ONE)) AND(IDENT (TWO) = CI2)) THEN
79               FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS " &
80                       "- 1");
81          END IF;
82
83          IF CHECK_TYPE'POS (CI0)  /= IDENT_INT (0) OR
84             CHECK_TYPE'POS (CIO1) /= IDENT_INT (1) OR
85             CHECK_TYPE'POS (CI2)  /= IDENT_INT (2) THEN
86               FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 1");
87          END IF;
88
89          IF CHECK_TYPE'SUCC (CI0)  /=  IDENT (CIO1) OR
90             CHECK_TYPE'SUCC (CIO1) /= IDENT (CI2)   THEN
91               FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 1");
92          END IF;
93
94          IF CHECK_TYPE'IMAGE (CI0)  /= IDENT_STR ("ZERO") OR
95             CHECK_TYPE'IMAGE (CIO1) /= IDENT_STR ("ONE")  OR
96             CHECK_TYPE'IMAGE (CI2)  /= IDENT_STR ("TWO")  THEN
97               FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 1");
98          END IF;
99
100
101          CO2 := TWO;
102
103     END PROC;
104
105BEGIN
106     TEST ("CD2A24E", "CHECK THAT IF A SIZE CLAUSE AND AN ENUMERATION " &
107                      "REPRESENTATION CLAUSE ARE GIVEN FOR AN " &
108                      "ENUMERATION TYPE, AND THE SMALLEST SIZE " &
109                      "APPROPRIATE FOR AN UNSIGNED REPRESENTATION " &
110                      "IS SPECIFIED, THEN OPERATIONS ON THE TYPE " &
111                      "ARE NOT AFFECTED");
112
113     PROC (ZERO, TWO, C1, C2, C2);
114
115     IF C1 /= ONE OR C2 /= TWO THEN
116          FAILED ("INCORRECT VALUE RETURNED BY PROCEDURE");
117     END IF;
118
119     IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
120          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
121     END IF;
122
123     IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
124          FAILED ("INCORRECT VALUE FOR C0'SIZE");
125     END IF;
126
127     IF NOT ((IDENT (C1) IN C1 .. C2)       AND
128             (C0 NOT IN IDENT (ONE) .. C2)) THEN
129          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 2");
130     END IF;
131
132     IF CHECK_TYPE'FIRST /= IDENT (ZERO) THEN
133          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'FIRST - 2");
134     END IF;
135
136     IF CHECK_TYPE'VAL (0) /= IDENT (C0) OR
137        CHECK_TYPE'VAL (1) /= IDENT (C1) OR
138        CHECK_TYPE'VAL (2) /= IDENT (C2) THEN
139          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 2");
140     END IF;
141
142     IF CHECK_TYPE'PRED (C1) /= IDENT (C0) OR
143        CHECK_TYPE'PRED (C2) /= IDENT (C1) THEN
144          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 2");
145     END IF;
146
147     IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (C0)  OR
148        CHECK_TYPE'VALUE ("ONE")  /=  IDENT (C1) OR
149        CHECK_TYPE'VALUE ("TWO")  /=  IDENT (C2) THEN
150          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 2");
151     END IF;
152
153     IF CHARRAY(1)'SIZE < IDENT_INT (BASIC_SIZE) THEN
154          FAILED ("INCORRECT VALUE FOR CHARRAY(1)'SIZE");
155     END IF;
156
157     IF NOT ((CHARRAY (0) <  IDENT (ONE))                 AND
158             (IDENT (CHARRAY (2))  > IDENT (CHARRAY (1))) AND
159             (CHARRAY (1) <= IDENT (ONE))                 AND
160             (IDENT (TWO) = CHARRAY (2)))                 THEN
161          FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 3");
162     END IF;
163
164     IF NOT ((IDENT (CHARRAY (1)) IN CHARRAY (1) .. CHARRAY (2)) AND
165             (CHARRAY (0) NOT IN IDENT (ONE) .. CHARRAY (2)))    THEN
166          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 3");
167     END IF;
168
169     IF CHECK_TYPE'POS (CHARRAY (0)) /= IDENT_INT (0) OR
170        CHECK_TYPE'POS (CHARRAY (1)) /= IDENT_INT (1) OR
171        CHECK_TYPE'POS (CHARRAY (2)) /= IDENT_INT (2) THEN
172          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 3");
173     END IF;
174
175     IF CHECK_TYPE'SUCC (CHARRAY (0)) /= IDENT (CHARRAY (1)) OR
176        CHECK_TYPE'SUCC (CHARRAY (1)) /= IDENT (CHARRAY (2)) THEN
177          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 3");
178     END IF;
179
180     IF CHECK_TYPE'IMAGE (CHARRAY (0)) /= IDENT_STR ("ZERO") OR
181        CHECK_TYPE'IMAGE (CHARRAY (1)) /= IDENT_STR ("ONE")  OR
182        CHECK_TYPE'IMAGE (CHARRAY (2)) /= IDENT_STR ("TWO")  THEN
183          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 3");
184     END IF;
185
186     IF CHREC.COMP2'SIZE < IDENT_INT (BASIC_SIZE) THEN
187          FAILED ("INCORRECT VALUE FOR CHREC.COMP2'SIZE");
188     END IF;
189
190     IF NOT ((CHREC.COMP0 <  IDENT (ONE))                 AND
191             (IDENT (CHREC.COMP2)  > IDENT (CHREC.COMP1)) AND
192             (CHREC.COMP1 <= IDENT (ONE))                 AND
193             (IDENT (TWO) = CHREC.COMP2))                 THEN
194          FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 4");
195     END IF;
196
197     IF NOT ((IDENT (CHREC.COMP1) IN CHREC.COMP1 .. CHREC.COMP2) AND
198             (CHREC.COMP0 NOT IN IDENT (ONE) .. CHREC.COMP2))    THEN
199          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 4");
200     END IF;
201
202     IF CHECK_TYPE'VAL (0) /= IDENT (CHREC.COMP0) OR
203        CHECK_TYPE'VAL (1) /= IDENT (CHREC.COMP1) OR
204        CHECK_TYPE'VAL (2) /= IDENT (CHREC.COMP2) THEN
205          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 4");
206     END IF;
207
208     IF CHECK_TYPE'PRED (CHREC.COMP1) /= IDENT (CHREC.COMP0) OR
209        CHECK_TYPE'PRED (CHREC.COMP2) /= IDENT (CHREC.COMP1) THEN
210          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 4");
211     END IF;
212
213     IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (CHREC.COMP0) OR
214        CHECK_TYPE'VALUE ("ONE")  /= IDENT (CHREC.COMP1) OR
215        CHECK_TYPE'VALUE ("TWO")  /= IDENT (CHREC.COMP2) THEN
216          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 4");
217     END IF;
218
219     RESULT;
220END CD2A24E;
221