Mercurial > hg > CbC > CbC_gcc

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