Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/ada/acats/tests/c5/c52103x.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 -- C52103X.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS. | |
26 -- MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING | |
27 -- LENGTHS DO NOT CAUSE CONSTRAINT_ERROR TO BE RAISED AND | |
28 -- ARE PERFORMED CORRECTLY. | |
29 -- (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT | |
30 -- ARE TREATED ELSEWHERE.) | |
31 | |
32 -- THIS IS A SPECIAL CASE IN | |
33 | |
34 -- DIVISION C : NON-NULL ARRAYS WHOSE LENGTHS ARE NOT DETERMINABLE | |
35 -- STATICALLY | |
36 | |
37 -- WHICH TREATS ARRAYS OF LENGTH GREATER THAN INTEGER'LAST . | |
38 -- AN ADDITIONAL OBJECTIVE OF THIS TEST IS TO CHECK WHETHER LENGTH | |
39 -- COMPARISONS (AND LENGTH COMPUTATIONS) CAUSE | |
40 -- CONSTRAINT_ERROR TO BE RAISED. | |
41 | |
42 -- *** NOTE: This test has been modified since ACVC version 1.11 to -- 9X | |
43 -- *** remove incompatibilities associated with the transition -- 9X | |
44 -- *** to Ada 9X. -- 9X | |
45 -- *** -- 9X | |
46 | |
47 -- RM 07/31/81 | |
48 -- SPS 10/26/82 | |
49 -- JBG 06/15/83 | |
50 -- EG 11/02/84 | |
51 -- EG 10/28/85 FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO | |
52 -- AI-00387. | |
53 -- JRK 06/24/86 FIXED COMMENTS ABOUT NUMERIC_ERROR/CONSTRAINT_ERROR. | |
54 -- MRM 03/30/93 REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY | |
55 | |
56 WITH REPORT; | |
57 PROCEDURE C52103X IS | |
58 | |
59 USE REPORT ; | |
60 | |
61 BEGIN | |
62 | |
63 TEST( "C52103X" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE " & | |
64 "ASSIGNMENTS, THE LENGTHS MUST MATCH; ALSO " & | |
65 "CHECK WHETHER CONSTRAINT_ERROR " & | |
66 "OR STORAGE_ERROR ARE RAISED FOR LARGE ARRAYS" ); | |
67 | |
68 -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN | |
69 -- THE AGGREGATES ARE STRING LITERALS); THEREFORE: | |
70 -- | |
71 -- (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS; | |
72 -- (2) CAN'T USE NON-NULL CONSTANT ARRAYS. | |
73 | |
74 | |
75 -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION | |
76 -- AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL | |
77 -- ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS | |
78 -- OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON | |
79 -- COMPONENT_TYPE. ACCORDINGLY WE ARE TESTING FOR SOME BUT | |
80 -- NOT ALL KINDS OF COMPONENT_TYPE. (COMPONENT_TYPES INCLUDED: | |
81 -- INTEGER , CHARACTER , BOOLEAN .) | |
82 | |
83 | |
84 ------------------------------------------------------------------- | |
85 | |
86 -- (4) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS | |
87 -- WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL | |
88 -- AND FOR WHICH THE COMPONENT TYPE IS NOT 'CHARACTER' . | |
89 -- ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.) | |
90 | |
91 CONSTR_ERR: -- THIS BLOCK CATCHES CONSTRAINT_ERROR | |
92 -- FOR THE TYPE DECLARATION. | |
93 BEGIN | |
94 | |
95 DCL_ARR: DECLARE -- THIS BLOCK DECLARES THE ARRAY TYPE | |
96 | |
97 TYPE TA42 IS ARRAY( | |
98 INTEGER RANGE IDENT_INT(-2)..IDENT_INT(INTEGER'LAST) | |
99 ) OF BOOLEAN ; | |
100 -- CONSTRAINT_ERROR MAY BE RAISED BY THE | |
101 -- ARRAY TYPE DECLARATION. | |
102 PRAGMA PACK (TA42); | |
103 | |
104 SUBTYPE TA41 IS TA42 ; | |
105 | |
106 BEGIN | |
107 | |
108 COMMENT ("NO CONSTRAINT_ERROR FOR TYPE " & | |
109 "WITH 'LENGTH = INTEGER'LAST + 3"); | |
110 | |
111 OBJ_DCL: DECLARE -- THIS BLOCK DECLARES TWO BOOLEAN ARRAYS THAT | |
112 -- HAVE INTEGER'LAST + 3 COMPONENTS; | |
113 -- STORAGE_ERROR MAY BE RAISED. | |
114 ARR41 : TA41 ; | |
115 ARR42 : TA42 ; | |
116 | |
117 BEGIN | |
118 | |
119 COMMENT ("NO STORAGE_ERROR OR CONSTRAINT_ERROR RAISED " & | |
120 "WHEN ALLOCATING TWO BIG BOOLEAN ARRAYS"); | |
121 -- INITIALIZATION OF RHS ARRAY: | |
122 | |
123 -- ONLY A SHORT INITIAL SEGMENT IS INITIALIZED, | |
124 -- SINCE A COMPLETE INITIALIZATION MIGHT TAKE TOO LONG | |
125 -- AND THE EXECUTION MIGHT BE ABORTED BEFORE THE LENGTH | |
126 -- COMPARISON OF THE ARRAY ASSIGNMENT IS ATTEMPTED. | |
127 | |
128 NO_EXCP: BEGIN -- NO EXCEPTION SHOULD OCCUR HERE. | |
129 FOR I IN IDENT_INT(-2)..IDENT_INT(2) LOOP | |
130 ARR41(I) := FALSE ; -- VALUES ARE:: FTFFT | |
131 END LOOP; | |
132 | |
133 ARR41(-1) := TRUE ; | |
134 | |
135 ARR41( 2) := TRUE ; -- RHS IS: F T F F T | |
136 | |
137 | |
138 -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY: | |
139 | |
140 ARR42( -2 ) := TRUE ; | |
141 | |
142 EXCEPTION | |
143 | |
144 WHEN CONSTRAINT_ERROR => | |
145 FAILED ("CONSTRAINT_ERROR RAISED WHEN " & | |
146 "ASSIGNING TO ARRAY COMPONENTS"); | |
147 WHEN OTHERS => | |
148 FAILED ("OTHER EXCEPTION RAISED - 1"); | |
149 | |
150 END NO_EXCP; | |
151 | |
152 DO_SLICE: BEGIN | |
153 -- SLICE ASSIGNMENT: | |
154 | |
155 ARR42( IDENT_INT(-1)..IDENT_INT(INTEGER'LAST )) := | |
156 ARR41( | |
157 IDENT_INT(-2)..IDENT_INT(INTEGER'LAST-1)) ; | |
158 | |
159 COMMENT ("NO EXCEPTION RAISED DURING SLICE " & | |
160 "ASSIGNMENT"); | |
161 | |
162 -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT: | |
163 | |
164 CHK_SLICE: BEGIN | |
165 FOR I IN IDENT_INT(-1)..IDENT_INT(2) LOOP | |
166 | |
167 IF ARR42( I ) /= FALSE AND I /= 0 | |
168 THEN | |
169 FAILED( "SLICE ASSIGNMENT NOT " & | |
170 "CORRECT (VALUES)" ); | |
171 ELSIF ARR42( I ) /= TRUE AND I = 0 | |
172 THEN | |
173 FAILED( "SLICE ASSIGNMENT NOT " & | |
174 "CORRECT (VALUES)" ); | |
175 END IF; | |
176 | |
177 END LOOP; | |
178 | |
179 IF ARR42( -2 ) /= TRUE | |
180 THEN | |
181 FAILED( "SLICE ASSIGNMENT NOT CORRECT " & | |
182 "(SLIDING)" ); | |
183 END IF; | |
184 | |
185 EXCEPTION | |
186 | |
187 WHEN OTHERS => | |
188 FAILED ("SOME EXCEPTION RAISED - 2"); | |
189 | |
190 END CHK_SLICE; | |
191 | |
192 EXCEPTION | |
193 | |
194 WHEN CONSTRAINT_ERROR => | |
195 COMMENT ("CONSTRAINT_ERROR RAISED DURING " & | |
196 "SLICE ASSIGNMENT"); | |
197 WHEN STORAGE_ERROR => | |
198 COMMENT ("STORAGE_ERROR RAISED DURING SLICE " & | |
199 "ASSIGNMENT"); | |
200 WHEN OTHERS => | |
201 FAILED ("SOME EXCEPTION DURING SLICE " & | |
202 "ASSIGNMENT"); | |
203 END DO_SLICE; | |
204 | |
205 END OBJ_DCL; | |
206 | |
207 EXCEPTION | |
208 | |
209 WHEN STORAGE_ERROR => | |
210 COMMENT ("STORAGE_ERROR RAISED WHEN DECLARING " & | |
211 "TWO PACKED BOOLEAN ARRAYS WITH " & | |
212 "INTEGER'LAST + 3 COMPONENTS"); | |
213 WHEN CONSTRAINT_ERROR => | |
214 COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING " & | |
215 "TWO PACKED BOOLEAN ARRAYS WITH " & | |
216 "INTEGER'LAST + 3 COMPONENTS"); | |
217 WHEN OTHERS => | |
218 FAILED ("SOME EXCEPTION RAISED - 3"); | |
219 | |
220 END DCL_ARR; | |
221 | |
222 EXCEPTION | |
223 | |
224 | |
225 WHEN CONSTRAINT_ERROR => | |
226 COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING AN " & | |
227 "ARRAY TYPE WITH INTEGER'LAST + 3 COMPONENTS"); | |
228 | |
229 WHEN STORAGE_ERROR => | |
230 FAILED ("STORAGE_ERROR RAISED FOR TYPE DECLARATION"); | |
231 | |
232 WHEN OTHERS => | |
233 FAILED ("OTHER EXCEPTION RAISED - 4"); | |
234 | |
235 END CONSTR_ERR; | |
236 | |
237 | |
238 RESULT ; | |
239 | |
240 | |
241 END C52103X; |