Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cd/cd2a22a.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 -- CD2A22A.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 SPECIFICATION INDICATING THE SMALLEST SIZE
28 -- APPROPRIATE FOR A SIGNED 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 -- RJW 07/28/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 CD2A22A IS
39
40 BASIC_SIZE : CONSTANT := 3;
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 NOT ((CI0 < IDENT (ONE)) AND
75 (IDENT (CI2) > IDENT (CIO1)) AND
76 (CIO1 <= IDENT (ONE)) AND(IDENT (TWO) = CI2)) THEN
77 FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS " &
78 "- 1");
79 END IF;
80
81 IF CHECK_TYPE'POS (CI0) /= IDENT_INT (0) OR
82 CHECK_TYPE'POS (CIO1) /= IDENT_INT (1) OR
83 CHECK_TYPE'POS (CI2) /= IDENT_INT (2) THEN
84 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 1");
85 END IF;
86
87 IF CHECK_TYPE'SUCC (CI0) /= IDENT (CIO1) OR
88 CHECK_TYPE'SUCC (CIO1) /= IDENT (CI2) THEN
89 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 1");
90 END IF;
91
92 IF CHECK_TYPE'IMAGE (CI0) /= IDENT_STR ("ZERO") OR
93 CHECK_TYPE'IMAGE (CIO1) /= IDENT_STR ("ONE") OR
94 CHECK_TYPE'IMAGE (CI2) /= IDENT_STR ("TWO") THEN
95 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 1");
96 END IF;
97
98 CO2 := TWO;
99
100 END PROC;
101
102 BEGIN
103 TEST ("CD2A22A", "CHECK THAT IF A SIZE SPECIFICATION " &
104 "INDICATING THE SMALLEST SIZE APPROPRIATE " &
105 "FOR A SIGNED REPRESENTATION IS GIVEN " &
106 "FOR AN ENUMERATION TYPE, THEN OPERATIONS " &
107 "ON VALUES OF SUCH A TYPE ARE NOT AFFECTED " &
108 "BY THE REPRESENTATION CLAUSE");
109
110 PROC (ZERO, TWO, C1, C2, C2);
111
112 IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
113 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
114 END IF;
115
116 IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
117 FAILED ("INCORRECT VALUE FOR C0'SIZE");
118 END IF;
119
120 IF NOT ((IDENT (C1) IN C1 .. C2) AND
121 (C0 NOT IN IDENT (ONE) .. C2)) THEN
122 FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 2");
123 END IF;
124
125 IF CHECK_TYPE'FIRST /= IDENT (ZERO) THEN
126 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'FIRST - 2");
127 END IF;
128
129 IF CHECK_TYPE'VAL (0) /= IDENT (C0) OR
130 CHECK_TYPE'VAL (1) /= IDENT (C1) OR
131 CHECK_TYPE'VAL (2) /= IDENT (C2) THEN
132 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 2");
133 END IF;
134
135 IF CHECK_TYPE'PRED (C1) /= IDENT (C0) OR
136 CHECK_TYPE'PRED (C2) /= IDENT (C1) THEN
137 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 2");
138 END IF;
139
140 IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (C0) OR
141 CHECK_TYPE'VALUE ("ONE") /= IDENT (C1) OR
142 CHECK_TYPE'VALUE ("TWO") /= IDENT (C2) THEN
143 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 2");
144 END IF;
145
146 IF CHARRAY (1)'SIZE < IDENT_INT (BASIC_SIZE) THEN
147 FAILED ("INCORRECT VALUE FOR CHARRAY (1)'SIZE");
148 END IF;
149
150 IF NOT ((CHARRAY (0) < IDENT (ONE)) AND
151 (IDENT (CHARRAY (2)) > IDENT (CHARRAY (1))) AND
152 (CHARRAY (1) <= IDENT (ONE)) AND
153 (IDENT (TWO) = CHARRAY (2))) THEN
154 FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 3");
155 END IF;
156
157 IF NOT ((IDENT (CHARRAY (1)) IN CHARRAY (1) .. CHARRAY (2)) AND
158 (CHARRAY (0) NOT IN IDENT (ONE) .. CHARRAY (2))) THEN
159 FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 3");
160 END IF;
161
162 IF CHECK_TYPE'POS (CHARRAY (0)) /= IDENT_INT (0) OR
163 CHECK_TYPE'POS (CHARRAY (1)) /= IDENT_INT (1) OR
164 CHECK_TYPE'POS (CHARRAY (2)) /= IDENT_INT (2) THEN
165 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 3");
166 END IF;
167
168 IF CHECK_TYPE'SUCC (CHARRAY (0)) /= IDENT (CHARRAY (1)) OR
169 CHECK_TYPE'SUCC (CHARRAY (1)) /= IDENT (CHARRAY (2)) THEN
170 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 3");
171 END IF;
172
173 IF CHECK_TYPE'IMAGE (CHARRAY (0)) /= IDENT_STR ("ZERO") OR
174 CHECK_TYPE'IMAGE (CHARRAY (1)) /= IDENT_STR ("ONE") OR
175 CHECK_TYPE'IMAGE (CHARRAY (2)) /= IDENT_STR ("TWO") THEN
176 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 3");
177 END IF;
178
179 IF CHREC.COMP1'SIZE < IDENT_INT (BASIC_SIZE) THEN
180 FAILED ("INCORRECT VALUE FOR CHREC.COMP1'SIZE");
181 END IF;
182
183 IF NOT ((CHREC.COMP0 < IDENT (ONE)) AND
184 (IDENT (CHREC.COMP2) > IDENT (CHREC.COMP1)) AND
185 (CHREC.COMP1 <= IDENT (ONE)) AND
186 (IDENT (TWO) = CHREC.COMP2)) THEN
187 FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 4");
188 END IF;
189
190 IF NOT ((IDENT (CHREC.COMP1) IN CHREC.COMP1 .. CHREC.COMP2) AND
191 (CHREC.COMP0 NOT IN IDENT (ONE) .. CHREC.COMP2)) THEN
192 FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 4");
193 END IF;
194
195 IF CHECK_TYPE'VAL (0) /= IDENT (CHREC.COMP0) OR
196 CHECK_TYPE'VAL (1) /= IDENT (CHREC.COMP1) OR
197 CHECK_TYPE'VAL (2) /= IDENT (CHREC.COMP2) THEN
198 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 4");
199 END IF;
200
201 IF CHECK_TYPE'PRED (CHREC.COMP1) /= IDENT (CHREC.COMP0) OR
202 CHECK_TYPE'PRED (CHREC.COMP2) /= IDENT (CHREC.COMP1) THEN
203 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 4");
204 END IF;
205
206 IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (CHREC.COMP0) OR
207 CHECK_TYPE'VALUE ("ONE") /= IDENT (CHREC.COMP1) OR
208 CHECK_TYPE'VALUE ("TWO") /= IDENT (CHREC.COMP2) THEN
209 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 4");
210 END IF;
211
212 RESULT;
213 END CD2A22A;