Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/ada/acats/tests/c4/c45201b.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 -- C45201B.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 ORDERING OF ENUMERATION LITERALS AS DEFINED BY THE | |
26 -- ORDERING OPERATORS IS THE SAME AS THE ORDER OF OCCURRENCE OF THE | |
27 -- LITERALS IN THE TYPE DEFINITION. | |
28 | |
29 -- THIS TEST IS DERIVED FROM C45210A.ADA . | |
30 | |
31 | |
32 -- RM 17 OCTOBER 1980 | |
33 -- JWC 7/8/85 RENAMED TO -AB | |
34 | |
35 | |
36 WITH REPORT ; | |
37 PROCEDURE C45201B IS | |
38 | |
39 USE REPORT; | |
40 | |
41 TYPE T IS ( A , SLIT , B , PLIT , C , NUL , D , 'R' , E ); | |
42 | |
43 -- S-LIT , P-LIT , NUL , 'R' CORRESPOND | |
44 -- TO 'S' , 'P' , 'M' , 'R' IN C45210A. | |
45 | |
46 SUBTYPE T1 IS T RANGE A..B ; | |
47 SUBTYPE T2 IS T RANGE A..C ; -- INCLUDES T1 | |
48 SUBTYPE T3 IS T RANGE B..D ; -- INTERSECTS T2 , T4 | |
49 SUBTYPE T4 IS T RANGE C..E ; -- DISJOINT FROM T1 , T2 | |
50 | |
51 MVAR : T3 := T'(NUL ) ; | |
52 PVAR : T2 := T'(PLIT) ; | |
53 RVAR : T4 := T'('R' ) ; | |
54 SVAR : T1 := T'(SLIT) ; | |
55 | |
56 ERROR_COUNT : INTEGER := 0 ; -- INITIAL VALUE ESSENTIAL | |
57 | |
58 PROCEDURE BUMP IS | |
59 BEGIN | |
60 ERROR_COUNT := ERROR_COUNT + 1 ; | |
61 END BUMP ; | |
62 | |
63 | |
64 BEGIN | |
65 | |
66 TEST( "C45201B","CHECK THAT THE ORDERING OF ENUMERATION LITERALS "& | |
67 " AS DEFINED BY THE ORDERING OPERATORS" & | |
68 " IS THE SAME AS THE ORDER OF OCCURRENCE OF THE " & | |
69 " LITERALS IN THE TYPE DEFINITION" ) ; | |
70 | |
71 -- 256 CASES ( 4 * 4 ORDERED PAIRS OF OPERAND VALUES, | |
72 -- 4 ORDERING OPERATORS: '<' , '<=' , '>' , '>=' | |
73 -- (IN THE TABLE: A , B , C , D ) | |
74 -- 4 VARIABLE/LITERAL FOR LEFT OPERAND, | |
75 -- VARIABLE/LITERAL FOR RIGHT OPERAND, | |
76 -- (IN THE TABLE: VV = ALPHA , | |
77 -- VL = BETA , | |
78 -- LV = GAMMA , | |
79 -- LL = DELTA ) RANDOMIZED | |
80 -- INTO 16 (ONE FOR EACH PAIR OF VALUES) ACCORDING TO THE FOL- | |
81 -- LOWING GRAECO-LATIN SQUARE (WITH ADDITIONAL PROPERTIES): | |
82 | |
83 -- RIGHT OPERAND: 'S' 'P' 'M' 'R' | |
84 -- LEFT | |
85 -- OPERAND: | |
86 | |
87 -- 'S' A-ALPHA B-BETA C-GAMMA D-DELTA | |
88 -- 'P' C-DELTA D-GAMMA A-BETA B-ALPHA | |
89 -- 'M' D-BETA C-ALPHA B-DELTA A-GAMMA | |
90 -- 'R' B-GAMMA A-DELTA D-ALPHA C-BETA | |
91 | |
92 -- (BOTH THE LATIN DIAGONAL AND THE GREEK DIAGONAL CONTAIN 4 | |
93 -- DISTINCT LETTERS, NON-TRIVIALLY PERMUTED.) | |
94 | |
95 -- THE ABOVE DESCRIBES PART 1 OF THE TEST. PART 2 PERFORMS AN | |
96 -- EXHAUSTIVE VERIFICATION OF THE 'VARIABLE VS. VARIABLE' CASE | |
97 -- ( VV , ALPHA ) FOR ALL 4 OPERATORS. | |
98 | |
99 ----------------------------------------------------------------- | |
100 | |
101 -- PART 1 | |
102 | |
103 -- 'BUMP' MEANS 'BUMP THE ERROR COUNT' | |
104 | |
105 IF T'(SVAR) < T'(SVAR) THEN BUMP ; END IF; | |
106 IF T'(SVAR) <= T'(PLIT) THEN NULL; ELSE BUMP ; END IF; | |
107 IF T'(SLIT) > T'(MVAR) THEN BUMP ; END IF; | |
108 IF T'(SLIT) >= T'('R' ) THEN BUMP ; END IF; | |
109 | |
110 IF T'(PLIT) > T'(SLIT) THEN NULL; ELSE BUMP ; END IF; | |
111 IF T'(PLIT) >= T'(PVAR) THEN NULL; ELSE BUMP ; END IF; | |
112 IF T'(PVAR) < T'(NUL ) THEN NULL; ELSE BUMP ; END IF; | |
113 IF T'(PVAR) <= T'(RVAR) THEN NULL; ELSE BUMP ; END IF; | |
114 | |
115 IF T'(MVAR) >= T'(SLIT) THEN NULL; ELSE BUMP ; END IF; | |
116 IF T'(MVAR) > T'(PVAR) THEN NULL; ELSE BUMP ; END IF; | |
117 IF T'(NUL ) <= T'(NUL ) THEN NULL; ELSE BUMP ; END IF; | |
118 IF T'(NUL ) < T'(RVAR) THEN NULL; ELSE BUMP ; END IF; | |
119 | |
120 IF T'('R' ) <= T'(SVAR) THEN BUMP ; END IF; | |
121 IF T'('R' ) < T'(PLIT) THEN BUMP ; END IF; | |
122 IF T'(RVAR) >= T'(MVAR) THEN NULL; ELSE BUMP ; END IF; | |
123 IF T'(RVAR) > T'('R' ) THEN BUMP ; END IF; | |
124 | |
125 | |
126 IF ERROR_COUNT /= 0 THEN | |
127 FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE1" ); | |
128 END IF; | |
129 | |
130 ----------------------------------------------------------------- | |
131 | |
132 -- PART 2 | |
133 | |
134 -- 'BUMP' MEANS 'INCREASE THE COUNT FOR THE NUMBER OF <TRUE>S' | |
135 | |
136 ERROR_COUNT := 0 ; | |
137 | |
138 FOR AVAR IN T'FIRST..T'LAST LOOP -- 9 VALUES | |
139 FOR BVAR IN T'FIRST..T'(PLIT) LOOP -- 4 VALUES | |
140 | |
141 IF AVAR < BVAR THEN BUMP ; END IF; -- COUNT +:= 6 | |
142 | |
143 END LOOP; | |
144 END LOOP; | |
145 | |
146 IF ERROR_COUNT /= 6 THEN -- THIS IS A PLAIN COUNT, NOT AN | |
147 -- ERROR COUNT | |
148 FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE2" ); | |
149 END IF; | |
150 | |
151 | |
152 ERROR_COUNT := 0 ; | |
153 | |
154 FOR AVAR IN T'FIRST..T'LAST LOOP -- 9 VALUES | |
155 FOR BVAR IN T'FIRST..T'(PLIT) LOOP -- 4 VALUES | |
156 | |
157 IF AVAR <= BVAR THEN BUMP ; END IF; -- COUNT +:= 10 | |
158 | |
159 END LOOP; | |
160 END LOOP; | |
161 | |
162 IF ERROR_COUNT /=10 THEN -- THIS IS A PLAIN COUNT, NOT AN | |
163 -- ERROR COUNT | |
164 FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE3" ); | |
165 END IF; | |
166 | |
167 | |
168 ERROR_COUNT := 0 ; | |
169 | |
170 FOR AVAR IN T'FIRST..T'LAST LOOP -- 9 VALUES | |
171 FOR BVAR IN T'FIRST..T'(PLIT) LOOP -- 4 VALUES | |
172 | |
173 IF AVAR > BVAR THEN BUMP ; END IF; -- COUNT +:= 26 | |
174 | |
175 END LOOP; | |
176 END LOOP; | |
177 | |
178 IF ERROR_COUNT /=26 THEN -- THIS IS A PLAIN COUNT, NOT AN | |
179 -- ERROR COUNT | |
180 FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE4" ); | |
181 END IF; | |
182 | |
183 | |
184 ERROR_COUNT := 0 ; | |
185 | |
186 FOR AVAR IN T'FIRST..T'LAST LOOP -- 9 VALUES | |
187 FOR BVAR IN T'FIRST..T'(PLIT) LOOP -- 4 VALUES | |
188 | |
189 IF AVAR >= BVAR THEN BUMP ; END IF; -- COUNT +:= 30 | |
190 | |
191 END LOOP; | |
192 END LOOP; | |
193 | |
194 IF ERROR_COUNT /=30 THEN -- THIS IS A PLAIN COUNT, NOT AN | |
195 -- ERROR COUNT | |
196 FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE5" ); | |
197 END IF; | |
198 | |
199 | |
200 -- 'BUMP' MEANS 'BUMP THE ERROR COUNT' (AGAIN) | |
201 | |
202 ERROR_COUNT := 0 ; | |
203 | |
204 FOR AVAR IN T'FIRST..T'LAST LOOP -- 9 VALUES | |
205 | |
206 FOR BVAR IN T'FIRST..T'LAST LOOP -- 9 VALUES | |
207 | |
208 IF ( AVAR < BVAR ) /= ( T'POS(AVAR) < T'POS(BVAR) )THEN | |
209 BUMP ; | |
210 END IF; | |
211 | |
212 IF ( AVAR <= BVAR ) /= ( T'POS(AVAR) <= T'POS(BVAR) )THEN | |
213 BUMP ; | |
214 END IF; | |
215 | |
216 IF ( AVAR > BVAR ) /= ( T'POS(AVAR) > T'POS(BVAR) )THEN | |
217 BUMP ; | |
218 END IF; | |
219 | |
220 IF ( AVAR >= BVAR ) /= ( T'POS(AVAR) >= T'POS(BVAR) )THEN | |
221 BUMP ; | |
222 END IF; | |
223 | |
224 END LOOP; | |
225 | |
226 END LOOP; | |
227 | |
228 | |
229 IF ERROR_COUNT /= 0 THEN -- REAL ERROR COUNT AGAIN | |
230 FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE6" ); | |
231 END IF; | |
232 | |
233 | |
234 RESULT; | |
235 | |
236 END C45201B; |