Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cd/cd2a22e.ada @ 111:04ced10e8804

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