Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/ada/acats/tests/cd/cd2a32a.ada @ 111:04ced10e8804
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 -- CD2A32A.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 -- INTEGER TYPE, THEN OPERATIONS ON VALUES OF SUCH A TYPE | |
28 -- WITH THE SMALLEST APPROPRIATE SIGNED SIZE ARE NOT | |
29 -- AFFECTED BY THE REPRESENTATION CLAUSE. | |
30 | |
31 -- HISTORY: | |
32 -- JET 08/12/87 CREATED ORIGINAL TEST. | |
33 -- DHH 04/10/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED | |
34 -- SIZE CLAUSE VALUE TO 7, CHANGED OPERATOR ON 'SIZE | |
35 -- CHECKS AND ADDED REPRESENTAION CLAUSE CHECK. | |
36 -- RJW 03/28/90 REMOVED ERRONEOUS REFERENCES TO LENGTH_CHECK. | |
37 -- JRL 03/27/92 ELIMINATED REDUNDANT TESTING. | |
38 | |
39 WITH REPORT; USE REPORT; | |
40 WITH LENGTH_CHECK; -- CONTAINS A CALL TO 'FAILED'. | |
41 PROCEDURE CD2A32A IS | |
42 | |
43 BASIC_SIZE : CONSTANT := 7; | |
44 | |
45 TYPE INT IS RANGE -63 .. 63; | |
46 | |
47 FOR INT'SIZE USE BASIC_SIZE; | |
48 | |
49 I1 : INT := -63; | |
50 I2 : INT := 0; | |
51 I3 : INT := 63; | |
52 | |
53 TYPE ARRAY_TYPE IS ARRAY (INTEGER RANGE -1 .. 1) OF INT; | |
54 PRAGMA PACK (ARRAY_TYPE); | |
55 INTARRAY : ARRAY_TYPE := (-63, 0, 63); | |
56 | |
57 TYPE REC_TYPE IS RECORD | |
58 COMPN : INT := -63; | |
59 COMPZ : INT := 0; | |
60 COMPP : INT := 63; | |
61 END RECORD; | |
62 PRAGMA PACK (REC_TYPE); | |
63 | |
64 IREC : REC_TYPE; | |
65 | |
66 FUNCTION IDENT (I : INT) RETURN INT IS | |
67 BEGIN | |
68 IF EQUAL (0,0) THEN | |
69 RETURN I; | |
70 ELSE | |
71 RETURN 0; | |
72 END IF; | |
73 END IDENT; | |
74 | |
75 PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (INT); | |
76 | |
77 | |
78 PROCEDURE PROC (PIN, PIP : INT; | |
79 PIOZ, PIOP : IN OUT INT; | |
80 POP : OUT INT) IS | |
81 | |
82 BEGIN | |
83 IF PIN'SIZE < IDENT_INT (BASIC_SIZE) THEN | |
84 FAILED ("INCORRECT VALUE FOR PIN'SIZE"); | |
85 END IF; | |
86 | |
87 FOR P1 IN IDENT (PIN) .. IDENT (PIOP) LOOP | |
88 IF NOT (P1 IN PIN .. PIP) OR | |
89 (P1 NOT IN IDENT(-63) .. IDENT(63)) THEN | |
90 FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " & | |
91 "OPERATORS - 1"); | |
92 END IF; | |
93 END LOOP; | |
94 | |
95 IF NOT ((+PIP = PIOP) AND | |
96 (-PIN = PIP) AND | |
97 (ABS PIN = PIOP)) THEN | |
98 FAILED ("INCORRECT RESULTS FOR UNARY ARITHMETIC " & | |
99 "OPERATORS - 1"); | |
100 END IF; | |
101 | |
102 IF INT'VAL (-63) /= IDENT (PIN) OR | |
103 INT'VAL (0) /= IDENT (PIOZ) OR | |
104 INT'VAL (63) /= IDENT (PIOP) THEN | |
105 FAILED ("INCORRECT VALUE FOR INT'VAL - 1"); | |
106 END IF; | |
107 | |
108 IF INT'PRED (PIOZ) /= IDENT (-1) OR | |
109 INT'PRED (PIP) /= IDENT (62) THEN | |
110 FAILED ("INCORRECT VALUE FOR INT'PRED - 1"); | |
111 END IF; | |
112 | |
113 IF INT'VALUE ("-63") /= IDENT (PIN) OR | |
114 INT'VALUE ("0") /= IDENT (PIOZ) OR | |
115 INT'VALUE ("63") /= IDENT (PIOP) THEN | |
116 FAILED ("INCORRECT VALUE FOR INT'VALUE - 1"); | |
117 END IF; | |
118 | |
119 POP := 63; | |
120 | |
121 END PROC; | |
122 | |
123 BEGIN | |
124 TEST ("CD2A32A", "CHECK THAT WHEN A SIZE SPECIFICATION IS " & | |
125 "GIVEN FOR AN INTEGER TYPE, THEN " & | |
126 "OPERATIONS ON VALUES OF SUCH A TYPE WITH " & | |
127 "THE SMALLEST APPROPRIATE SIGNED SIZE ARE " & | |
128 "NOT AFFECTED BY THE REPRESENTATION CLAUSE"); | |
129 | |
130 CHECK_1 (I1, 7, "INT"); | |
131 | |
132 PROC (-63, 63, I2, I3, I3); | |
133 | |
134 IF INT'SIZE /= IDENT_INT (BASIC_SIZE) THEN | |
135 FAILED ("INCORRECT VALUE FOR INT'SIZE"); | |
136 END IF; | |
137 | |
138 IF I1'SIZE < IDENT_INT (BASIC_SIZE) THEN | |
139 FAILED ("INCORRECT VALUE FOR I1'SIZE"); | |
140 END IF; | |
141 | |
142 IF NOT ((I1 < IDENT (0)) AND | |
143 (IDENT (I3) > IDENT (I2)) AND | |
144 (I2 <= IDENT (0)) AND | |
145 (IDENT (63) = I3)) THEN | |
146 FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 2"); | |
147 END IF; | |
148 | |
149 IF NOT (((I1 + I3) = I2) AND | |
150 ((I2 - I3) = I1) AND | |
151 ((I3 * I2) = I2) AND | |
152 ((I2 / I1) = I2) AND | |
153 ((I1 ** 1) = I1) AND | |
154 ((I1 REM 10) = IDENT (-3)) AND | |
155 ((I3 MOD 10) = IDENT (3))) THEN | |
156 FAILED ("INCORRECT RESULTS FOR BINARY ARITHMETIC " & | |
157 "OPERATORS - 2"); | |
158 END IF; | |
159 | |
160 IF INT'FIRST /= IDENT (-63) THEN | |
161 FAILED ("INCORRECT VALUE FOR INT'FIRST - 2"); | |
162 END IF; | |
163 | |
164 IF INT'POS (I1) /= IDENT_INT (-63) OR | |
165 INT'POS (I2) /= IDENT_INT ( 0) OR | |
166 INT'POS (I3) /= IDENT_INT ( 63) THEN | |
167 FAILED ("INCORRECT VALUE FOR INT'POS - 2"); | |
168 END IF; | |
169 | |
170 IF INT'SUCC (I1) /= IDENT (-62) OR | |
171 INT'SUCC (I2) /= IDENT (1) THEN | |
172 FAILED ("INCORRECT VALUE FOR INT'SUCC - 2"); | |
173 END IF; | |
174 | |
175 IF INT'IMAGE (I1) /= IDENT_STR ("-63") OR | |
176 INT'IMAGE (I2) /= IDENT_STR (" 0") OR | |
177 INT'IMAGE (I3) /= IDENT_STR (" 63") THEN | |
178 FAILED ("INCORRECT VALUE FOR INT'IMAGE - 2"); | |
179 END IF; | |
180 | |
181 IF INTARRAY(0)'SIZE < IDENT_INT (BASIC_SIZE) THEN | |
182 FAILED ("INCORRECT VALUE FOR INTARRAY(0)'SIZE"); | |
183 END IF; | |
184 | |
185 IF NOT ((INTARRAY(-1) < IDENT (0)) AND | |
186 (IDENT (INTARRAY (1)) > IDENT (INTARRAY(0))) AND | |
187 (INTARRAY(0) <= IDENT (0)) AND | |
188 (IDENT (63) = INTARRAY (1))) THEN | |
189 FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 3"); | |
190 END IF; | |
191 | |
192 FOR I IN IDENT (INTARRAY(-1)) .. IDENT (INTARRAY(1)) LOOP | |
193 IF NOT (I IN INTARRAY(-1) .. INTARRAY(1)) OR | |
194 (I NOT IN IDENT(-63) .. IDENT(63)) THEN | |
195 FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " & | |
196 "OPERATORS - 3"); | |
197 END IF; | |
198 END LOOP; | |
199 | |
200 IF NOT ((+INTARRAY(-1) = INTARRAY(-1)) AND | |
201 (-INTARRAY( 1) = INTARRAY(-1)) AND | |
202 (ABS INTARRAY(-1) = INTARRAY(1))) THEN | |
203 FAILED ("INCORRECT RESULTS FOR UNARY ARITHMETIC " & | |
204 "OPERATORS - 3"); | |
205 END IF; | |
206 | |
207 IF INT'VAL (-63) /= IDENT (INTARRAY (-1)) OR | |
208 INT'VAL ( 0) /= IDENT (INTARRAY ( 0)) OR | |
209 INT'VAL ( 63) /= IDENT (INTARRAY ( 1)) THEN | |
210 FAILED ("INCORRECT VALUE FOR INT'VAL - 3"); | |
211 END IF; | |
212 | |
213 IF INT'PRED (INTARRAY (0)) /= IDENT (-1) OR | |
214 INT'PRED (INTARRAY (1)) /= IDENT (62) THEN | |
215 FAILED ("INCORRECT VALUE FOR INT'PRED - 3"); | |
216 END IF; | |
217 | |
218 IF INT'VALUE ("-63") /= IDENT (INTARRAY (-1)) OR | |
219 INT'VALUE ("0") /= IDENT (INTARRAY ( 0)) OR | |
220 INT'VALUE ("63") /= IDENT (INTARRAY ( 1)) THEN | |
221 FAILED ("INCORRECT VALUE FOR INT'VALUE - 3"); | |
222 END IF; | |
223 | |
224 IF IREC.COMPP'SIZE < IDENT_INT (BASIC_SIZE) THEN | |
225 FAILED ("INCORRECT VALUE FOR IREC.COMPP'SIZE"); | |
226 END IF; | |
227 | |
228 IF NOT ((IREC.COMPN < IDENT (0)) AND | |
229 (IDENT (IREC.COMPP) > IDENT (IREC.COMPZ)) AND | |
230 (IREC.COMPZ <= IDENT (0)) AND | |
231 (IDENT (63) = IREC.COMPP)) THEN | |
232 FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 4"); | |
233 END IF; | |
234 | |
235 FOR I IN IDENT (IREC.COMPN) .. IDENT (IREC.COMPP) LOOP | |
236 IF NOT (I IN IREC.COMPN .. IREC.COMPP) OR | |
237 (I NOT IN IDENT(-63) .. IDENT(63)) THEN | |
238 FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " & | |
239 "OPERATORS - 4"); | |
240 END IF; | |
241 END LOOP; | |
242 | |
243 IF NOT (((IREC.COMPN + IREC.COMPP) = IREC.COMPZ) AND | |
244 ((IREC.COMPZ - IREC.COMPP) = IREC.COMPN) AND | |
245 ((IREC.COMPP * IREC.COMPZ) = IREC.COMPZ) AND | |
246 ((IREC.COMPZ / IREC.COMPN) = IREC.COMPZ) AND | |
247 ((IREC.COMPN ** 1) = IREC.COMPN) AND | |
248 ((IREC.COMPN REM 10) = IDENT (-3)) AND | |
249 ((IREC.COMPP MOD 10) = IDENT ( 3))) THEN | |
250 FAILED ("INCORRECT RESULTS FOR BINARY ARITHMETIC " & | |
251 "OPERATORS - 4"); | |
252 END IF; | |
253 | |
254 IF INT'POS (IREC.COMPN) /= IDENT_INT (-63) OR | |
255 INT'POS (IREC.COMPZ) /= IDENT_INT ( 0) OR | |
256 INT'POS (IREC.COMPP) /= IDENT_INT ( 63) THEN | |
257 FAILED ("INCORRECT VALUE FOR INT'POS - 4"); | |
258 END IF; | |
259 | |
260 IF INT'SUCC (IREC.COMPN) /= IDENT (-62) OR | |
261 INT'SUCC (IREC.COMPZ) /= IDENT ( 1) THEN | |
262 FAILED ("INCORRECT VALUE FOR INT'SUCC - 4"); | |
263 END IF; | |
264 | |
265 IF INT'IMAGE (IREC.COMPN) /= IDENT_STR ("-63") OR | |
266 INT'IMAGE (IREC.COMPZ) /= IDENT_STR (" 0") OR | |
267 INT'IMAGE (IREC.COMPP) /= IDENT_STR (" 63") THEN | |
268 FAILED ("INCORRECT VALUE FOR INT'IMAGE - 4"); | |
269 END IF; | |
270 | |
271 RESULT; | |
272 END CD2A32A; |