Mercurial > hg > CbC > CbC_gcc

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