Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/c3/c34001d.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 -- C34001D.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 -- CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
26 -- (IMPLICITLY) FOR DERIVED BOOLEAN TYPES.
27
28 -- JRK 8/20/86
29
30 WITH SYSTEM; USE SYSTEM;
31 WITH REPORT; USE REPORT;
32
33 PROCEDURE C34001D IS
34
35 SUBTYPE PARENT IS BOOLEAN;
36
37 SUBTYPE SUBPARENT IS PARENT RANGE
38 PARENT'VAL (IDENT_INT (PARENT'POS (FALSE))) ..
39 PARENT'VAL (IDENT_INT (PARENT'POS (TRUE)));
40
41 TYPE T IS NEW SUBPARENT RANGE
42 PARENT'VAL (IDENT_INT (PARENT'POS (TRUE))) ..
43 PARENT'VAL (IDENT_INT (PARENT'POS (TRUE)));
44
45 X : T := TRUE;
46 W : PARENT := FALSE;
47 B : BOOLEAN := FALSE;
48
49 PROCEDURE A (X : ADDRESS) IS
50 BEGIN
51 B := IDENT_BOOL (TRUE);
52 END A;
53
54 FUNCTION IDENT (X : T) RETURN T IS
55 BEGIN
56 IF EQUAL (T'POS (X), T'POS (X)) THEN
57 RETURN X; -- ALWAYS EXECUTED.
58 END IF;
59 RETURN T'FIRST;
60 END IDENT;
61
62 BEGIN
63 TEST ("C34001D", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
64 "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
65 "BOOLEAN TYPES");
66
67 X := IDENT (TRUE);
68 IF X /= TRUE THEN
69 FAILED ("INCORRECT :=");
70 END IF;
71
72 IF T'(X) /= TRUE THEN
73 FAILED ("INCORRECT QUALIFICATION");
74 END IF;
75
76 IF T (X) /= TRUE THEN
77 FAILED ("INCORRECT SELF CONVERSION");
78 END IF;
79
80 IF EQUAL (3, 3) THEN
81 W := TRUE;
82 END IF;
83 IF T (W) /= TRUE THEN
84 FAILED ("INCORRECT CONVERSION FROM PARENT");
85 END IF;
86
87 IF PARENT (X) /= TRUE OR PARENT (T'VAL (0)) /= FALSE THEN
88 FAILED ("INCORRECT CONVERSION TO PARENT");
89 END IF;
90
91 IF IDENT (TRUE) /= TRUE OR IDENT (TRUE) = FALSE THEN
92 FAILED ("INCORRECT ENUMERATION LITERAL");
93 END IF;
94
95 IF NOT X /= FALSE OR NOT FALSE /= X THEN
96 FAILED ("INCORRECT ""NOT""");
97 END IF;
98
99 IF (X AND IDENT (TRUE)) /= TRUE OR (X AND FALSE) /= FALSE THEN
100 FAILED ("INCORRECT ""AND""");
101 END IF;
102
103 IF (X OR IDENT (TRUE)) /= TRUE OR (FALSE OR X) /= TRUE THEN
104 FAILED ("INCORRECT ""OR""");
105 END IF;
106
107 IF (X XOR IDENT (TRUE)) /= FALSE OR (X XOR FALSE) /= TRUE THEN
108 FAILED ("INCORRECT ""XOR""");
109 END IF;
110
111 IF (X AND THEN IDENT (TRUE)) /= TRUE OR
112 (X AND THEN FALSE) /= FALSE THEN
113 FAILED ("INCORRECT ""AND THEN""");
114 END IF;
115
116 IF (X OR ELSE IDENT (TRUE)) /= TRUE OR
117 (FALSE OR ELSE X) /= TRUE THEN
118 FAILED ("INCORRECT ""OR ELSE""");
119 END IF;
120
121 IF NOT (X = IDENT (TRUE)) OR X = FALSE THEN
122 FAILED ("INCORRECT =");
123 END IF;
124
125 IF X /= IDENT (TRUE) OR NOT (X /= FALSE) THEN
126 FAILED ("INCORRECT /=");
127 END IF;
128
129 IF X < IDENT (TRUE) OR X < FALSE THEN
130 FAILED ("INCORRECT <");
131 END IF;
132
133 IF X > IDENT (TRUE) OR FALSE > X THEN
134 FAILED ("INCORRECT >");
135 END IF;
136
137 IF NOT (X <= IDENT (TRUE)) OR X <= FALSE THEN
138 FAILED ("INCORRECT <=");
139 END IF;
140
141 IF NOT (X >= IDENT (TRUE)) OR FALSE >= X THEN
142 FAILED ("INCORRECT >=");
143 END IF;
144
145 IF NOT (X IN T) OR FALSE IN T THEN
146 FAILED ("INCORRECT ""IN""");
147 END IF;
148
149 IF X NOT IN T OR NOT (FALSE NOT IN T) THEN
150 FAILED ("INCORRECT ""NOT IN""");
151 END IF;
152
153 B := FALSE;
154 A (X'ADDRESS);
155 IF NOT B THEN
156 FAILED ("INCORRECT 'ADDRESS");
157 END IF;
158
159 IF T'BASE'SIZE < 1 THEN
160 FAILED ("INCORRECT 'BASE'SIZE");
161 END IF;
162
163 IF T'FIRST /= TRUE OR T'BASE'FIRST /= FALSE THEN
164 FAILED ("INCORRECT 'FIRST");
165 END IF;
166
167 IF T'IMAGE (X) /= "TRUE" OR T'IMAGE (FALSE) /= "FALSE" THEN
168 FAILED ("INCORRECT 'IMAGE");
169 END IF;
170
171 IF T'LAST /= TRUE OR T'BASE'LAST /= TRUE THEN
172 FAILED ("INCORRECT 'LAST");
173 END IF;
174
175 IF T'POS (X) /= 1 OR T'POS (FALSE) /= 0 THEN
176 FAILED ("INCORRECT 'POS");
177 END IF;
178
179 IF T'PRED (X) /= FALSE THEN
180 FAILED ("INCORRECT 'PRED");
181 END IF;
182
183 IF T'SIZE < 1 THEN
184 FAILED ("INCORRECT TYPE'SIZE");
185 END IF;
186
187 IF X'SIZE < 1 THEN
188 FAILED ("INCORRECT OBJECT'SIZE");
189 END IF;
190
191 IF T'SUCC (T'VAL (IDENT_INT (0))) /= X THEN
192 FAILED ("INCORRECT 'SUCC");
193 END IF;
194
195 IF T'VAL (IDENT_INT (1)) /= X OR T'VAL (0) /= FALSE THEN
196 FAILED ("INCORRECT 'VAL");
197 END IF;
198
199 IF T'VALUE (IDENT_STR ("TRUE")) /= X OR
200 T'VALUE ("FALSE") /= FALSE THEN
201 FAILED ("INCORRECT 'VALUE");
202 END IF;
203
204 IF T'WIDTH /= 4 OR T'BASE'WIDTH /= 5 THEN
205 FAILED ("INCORRECT 'WIDTH");
206 END IF;
207
208 RESULT;
209 END C34001D;