annotate gcc/testsuite/ada/acats/tests/c5/c52104f.ada @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 -- C52104F.ADA
kono
parents:
diff changeset
2
kono
parents:
diff changeset
3 -- Grant of Unlimited Rights
kono
parents:
diff changeset
4 --
kono
parents:
diff changeset
5 -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
kono
parents:
diff changeset
6 -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
kono
parents:
diff changeset
7 -- unlimited rights in the software and documentation contained herein.
kono
parents:
diff changeset
8 -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
kono
parents:
diff changeset
9 -- this public release, the Government intends to confer upon all
kono
parents:
diff changeset
10 -- recipients unlimited rights equal to those held by the Government.
kono
parents:
diff changeset
11 -- These rights include rights to use, duplicate, release or disclose the
kono
parents:
diff changeset
12 -- released technical data and computer software in whole or in part, in
kono
parents:
diff changeset
13 -- any manner and for any purpose whatsoever, and to have or permit others
kono
parents:
diff changeset
14 -- to do so.
kono
parents:
diff changeset
15 --
kono
parents:
diff changeset
16 -- DISCLAIMER
kono
parents:
diff changeset
17 --
kono
parents:
diff changeset
18 -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
kono
parents:
diff changeset
19 -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
kono
parents:
diff changeset
20 -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
kono
parents:
diff changeset
21 -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
kono
parents:
diff changeset
22 -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
kono
parents:
diff changeset
23 -- PARTICULAR PURPOSE OF SAID MATERIAL.
kono
parents:
diff changeset
24 --*
kono
parents:
diff changeset
25 -- CHECK THAT LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
kono
parents:
diff changeset
26 -- MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
kono
parents:
diff changeset
27 -- ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
kono
parents:
diff changeset
28 -- INTACT AND CAUSE CONSTRAINT_ERROR TO BE RAISED.
kono
parents:
diff changeset
29 -- (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
kono
parents:
diff changeset
30 -- ARE TREATED ELSWEWHERE.)
kono
parents:
diff changeset
31
kono
parents:
diff changeset
32 -- DIVISION B : STATICALLY-DETERMINABLE NULL LENGTHS.
kono
parents:
diff changeset
33
kono
parents:
diff changeset
34
kono
parents:
diff changeset
35 -- RM 07/20/81
kono
parents:
diff changeset
36 -- SPS 10/27/82
kono
parents:
diff changeset
37
kono
parents:
diff changeset
38 WITH REPORT;
kono
parents:
diff changeset
39 PROCEDURE C52104F IS
kono
parents:
diff changeset
40
kono
parents:
diff changeset
41 USE REPORT ;
kono
parents:
diff changeset
42
kono
parents:
diff changeset
43 BEGIN
kono
parents:
diff changeset
44
kono
parents:
diff changeset
45 TEST( "C52104F" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
kono
parents:
diff changeset
46 " ASSIGNMENTS THE LENGTHS MUST MATCH" );
kono
parents:
diff changeset
47
kono
parents:
diff changeset
48
kono
parents:
diff changeset
49 -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
kono
parents:
diff changeset
50 -- THE AGGREGATES ARE STRING LITERALS); THEREFORE:
kono
parents:
diff changeset
51 --
kono
parents:
diff changeset
52 -- (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
kono
parents:
diff changeset
53 -- (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
kono
parents:
diff changeset
54
kono
parents:
diff changeset
55
kono
parents:
diff changeset
56 -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
kono
parents:
diff changeset
57 -- AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
kono
parents:
diff changeset
58 -- ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
kono
parents:
diff changeset
59 -- OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
kono
parents:
diff changeset
60 -- COMPONENT_TYPE. ACCORDINGLY WE ARE TESTING FOR SOME BUT
kono
parents:
diff changeset
61 -- NOT ALL KINDS OF COMPONENT_TYPE. (COMPONENT_TYPES INCLUDED:
kono
parents:
diff changeset
62 -- INTEGER , CHARACTER , BOOLEAN .)
kono
parents:
diff changeset
63
kono
parents:
diff changeset
64
kono
parents:
diff changeset
65 -- CASES DISTINGUISHED: ( 8 SELECTED CASES ARE IMPLEMENTED)
kono
parents:
diff changeset
66 --
kono
parents:
diff changeset
67 -- ( THE 8 SELECTIONS ARE THE 5-CASE
kono
parents:
diff changeset
68 -- SERIES 10-11-12-13-14 FOLLOWED
kono
parents:
diff changeset
69 -- BY 7 , 8 , 9 (IN THIS ORDER). )
kono
parents:
diff changeset
70 --
kono
parents:
diff changeset
71 --
kono
parents:
diff changeset
72 -- ( EACH DIVISION COMPRISES 3 FILES,
kono
parents:
diff changeset
73 -- COVERING RESPECTIVELY THE FIRST
kono
parents:
diff changeset
74 -- 3 , NEXT 2 , AND LAST 3 OF THE 8
kono
parents:
diff changeset
75 -- SELECTIONS FOR THE DIVISION.)
kono
parents:
diff changeset
76 --
kono
parents:
diff changeset
77 --
kono
parents:
diff changeset
78 -- (1..6) (DO NOT APPLY TO NON-MATCHING OBJECTS, SINCE WE WANT
kono
parents:
diff changeset
79 -- THE OBJECTS TO HAVE THE S A M E BASE TYPE.)
kono
parents:
diff changeset
80 --
kono
parents:
diff changeset
81 --
kono
parents:
diff changeset
82 -- (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE 'STRING' (BY
kono
parents:
diff changeset
83 -- THEMSELVES).
kono
parents:
diff changeset
84 --
kono
parents:
diff changeset
85 --
kono
parents:
diff changeset
86 -- (8) SLICED OBJECTS OF THE PREDEFINED TYPE 'STRING' , WITH
kono
parents:
diff changeset
87 -- STRING LITERALS.
kono
parents:
diff changeset
88 --
kono
parents:
diff changeset
89 --
kono
parents:
diff changeset
90 -- (9) SLICED OBJECTS OF THE PREDEFINED TYPE 'STRING' (BY
kono
parents:
diff changeset
91 -- THEMSELVES).
kono
parents:
diff changeset
92 --
kono
parents:
diff changeset
93 --
kono
parents:
diff changeset
94 -- (-) CONSTRAINABLE TYPES: ONLY SUBTESTS 2, 3, 4, 5, 6
kono
parents:
diff changeset
95 -- WILL BE REPLICATED -- AS SUBTESTS 10, 11, 12, 13, 14 .
kono
parents:
diff changeset
96 --
kono
parents:
diff changeset
97 --
kono
parents:
diff changeset
98 -- (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
kono
parents:
diff changeset
99 -- DEFINED USING THE "BOX" COMPOUND SYMBOL.
kono
parents:
diff changeset
100 -- (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
kono
parents:
diff changeset
101 --
kono
parents:
diff changeset
102 --
kono
parents:
diff changeset
103 -- (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
kono
parents:
diff changeset
104 -- WERE DEFINED USING THE "BOX" SYMBOL
kono
parents:
diff changeset
105 -- AND FOR WHICH THE COMPONENT TYPE IS NOT 'CHARACTER' .
kono
parents:
diff changeset
106 -- ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
kono
parents:
diff changeset
107 --
kono
parents:
diff changeset
108 --
kono
parents:
diff changeset
109 -- (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
kono
parents:
diff changeset
110 -- WERE DEFINED USING THE "BOX" SYMBOL
kono
parents:
diff changeset
111 -- AND FOR WHICH THE COMPONENT TYPE IS NOT 'CHARACTER' .
kono
parents:
diff changeset
112 -- ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
kono
parents:
diff changeset
113 --
kono
parents:
diff changeset
114 --
kono
parents:
diff changeset
115 -- (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
kono
parents:
diff changeset
116 -- WERE DEFINED USING THE "BOX" SYMBOL
kono
parents:
diff changeset
117 -- AND FOR WHICH THE COMPONENT TYPE IS 'CHARACTER' .
kono
parents:
diff changeset
118 --
kono
parents:
diff changeset
119 -- (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
kono
parents:
diff changeset
120 -- IN THIS TEST. TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
kono
parents:
diff changeset
121 -- BY THE TYPEMARK WILL NOT BE 1 .)
kono
parents:
diff changeset
122 --
kono
parents:
diff changeset
123 --
kono
parents:
diff changeset
124 -- (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
kono
parents:
diff changeset
125 -- WERE DEFINED USING THE "BOX" SYMBOL
kono
parents:
diff changeset
126 -- AND FOR WHICH THE COMPONENT TYPE IS 'CHARACTER' .
kono
parents:
diff changeset
127 --
kono
parents:
diff changeset
128 --
kono
parents:
diff changeset
129 --
kono
parents:
diff changeset
130 -- (-) SPECIAL CASES: SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC
kono
parents:
diff changeset
131 -- ARRAYS ONLY,
kono
parents:
diff changeset
132 -- DIVISIONS C AND D .)
kono
parents:
diff changeset
133 --
kono
parents:
diff changeset
134 --
kono
parents:
diff changeset
135 -- (-) THE DYNAMIC-ARRAY COUNTERPARTS OF THESE TESTS ARE IN DI-
kono
parents:
diff changeset
136 -- VISIONS C (FOR NON-NULL ARRAYS) AND D (FOR NULL ARRAYS).
kono
parents:
diff changeset
137 --
kono
parents:
diff changeset
138 --
kono
parents:
diff changeset
139
kono
parents:
diff changeset
140
kono
parents:
diff changeset
141 -------------------------------------------------------------------
kono
parents:
diff changeset
142
kono
parents:
diff changeset
143 -- (1 .. 6: NOT APPLICABLE)
kono
parents:
diff changeset
144 --
kono
parents:
diff changeset
145 --
kono
parents:
diff changeset
146
kono
parents:
diff changeset
147 -------------------------------------------------------------------
kono
parents:
diff changeset
148
kono
parents:
diff changeset
149 -- (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
kono
parents:
diff changeset
150 -- DEFINED USING THE "BOX" COMPOUND SYMBOL.
kono
parents:
diff changeset
151 -- (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
kono
parents:
diff changeset
152
kono
parents:
diff changeset
153 DECLARE
kono
parents:
diff changeset
154
kono
parents:
diff changeset
155 TYPE TABOX0 IS ARRAY( INTEGER RANGE <> , INTEGER RANGE <>
kono
parents:
diff changeset
156 ) OF INTEGER ;
kono
parents:
diff changeset
157
kono
parents:
diff changeset
158 SUBTYPE TABOX01 IS TABOX0( 1..1 , 0..7 );
kono
parents:
diff changeset
159 SUBTYPE TABOX02 IS TABOX0 ;
kono
parents:
diff changeset
160
kono
parents:
diff changeset
161 ARRX01 : TABOX01 ;
kono
parents:
diff changeset
162 ARRX02 : TABOX02( 1..0 , 0..7 );
kono
parents:
diff changeset
163
kono
parents:
diff changeset
164 BEGIN
kono
parents:
diff changeset
165
kono
parents:
diff changeset
166 -- ARRAY ASSIGNMENT:
kono
parents:
diff changeset
167
kono
parents:
diff changeset
168 ARRX02 := ARRX01 ;
kono
parents:
diff changeset
169 FAILED( "EXCEPTION NOT RAISED - SUBTEST 10" );
kono
parents:
diff changeset
170
kono
parents:
diff changeset
171 EXCEPTION
kono
parents:
diff changeset
172
kono
parents:
diff changeset
173 WHEN CONSTRAINT_ERROR =>
kono
parents:
diff changeset
174
kono
parents:
diff changeset
175 NULL ;
kono
parents:
diff changeset
176
kono
parents:
diff changeset
177 WHEN OTHERS =>
kono
parents:
diff changeset
178
kono
parents:
diff changeset
179 FAILED( "WRONG EXCEPTION RAISED - SUBTEST 10" );
kono
parents:
diff changeset
180
kono
parents:
diff changeset
181 END ;
kono
parents:
diff changeset
182
kono
parents:
diff changeset
183
kono
parents:
diff changeset
184 -------------------------------------------------------------------
kono
parents:
diff changeset
185
kono
parents:
diff changeset
186 -- (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
kono
parents:
diff changeset
187 -- WERE DEFINED USING THE "BOX" SYMBOL
kono
parents:
diff changeset
188 -- AND FOR WHICH THE COMPONENT TYPE IS NOT 'CHARACTER' .
kono
parents:
diff changeset
189 -- ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
kono
parents:
diff changeset
190
kono
parents:
diff changeset
191 DECLARE
kono
parents:
diff changeset
192
kono
parents:
diff changeset
193 TYPE TABOX1 IS ARRAY( INTEGER RANGE <> ) OF INTEGER ;
kono
parents:
diff changeset
194
kono
parents:
diff changeset
195 SUBTYPE TABOX11 IS TABOX1( 4..5 ) ;
kono
parents:
diff changeset
196
kono
parents:
diff changeset
197 ARRX11 : TABOX11 ;
kono
parents:
diff changeset
198 ARRX12 : TABOX1( 5..4 );
kono
parents:
diff changeset
199
kono
parents:
diff changeset
200 BEGIN
kono
parents:
diff changeset
201
kono
parents:
diff changeset
202 -- ARRAY ASSIGNMENT:
kono
parents:
diff changeset
203
kono
parents:
diff changeset
204 ARRX12 := ARRX11 ;
kono
parents:
diff changeset
205 FAILED( "EXCEPTION NOT RAISED - SUBTEST 11" );
kono
parents:
diff changeset
206
kono
parents:
diff changeset
207 EXCEPTION
kono
parents:
diff changeset
208
kono
parents:
diff changeset
209 WHEN CONSTRAINT_ERROR =>
kono
parents:
diff changeset
210
kono
parents:
diff changeset
211 NULL ;
kono
parents:
diff changeset
212
kono
parents:
diff changeset
213 WHEN OTHERS =>
kono
parents:
diff changeset
214
kono
parents:
diff changeset
215 FAILED( "WRONG EXCEPTION RAISED - SUBTEST 11" );
kono
parents:
diff changeset
216
kono
parents:
diff changeset
217 END ;
kono
parents:
diff changeset
218
kono
parents:
diff changeset
219
kono
parents:
diff changeset
220 -------------------------------------------------------------------
kono
parents:
diff changeset
221
kono
parents:
diff changeset
222 -- (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
kono
parents:
diff changeset
223 -- WERE DEFINED USING THE "BOX" SYMBOL
kono
parents:
diff changeset
224 -- AND FOR WHICH THE COMPONENT TYPE IS NOT 'CHARACTER' .
kono
parents:
diff changeset
225 -- ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
kono
parents:
diff changeset
226
kono
parents:
diff changeset
227 DECLARE
kono
parents:
diff changeset
228
kono
parents:
diff changeset
229 TYPE TABOX5 IS ARRAY( INTEGER RANGE <> ) OF BOOLEAN ;
kono
parents:
diff changeset
230
kono
parents:
diff changeset
231 SUBTYPE TABOX51 IS TABOX5( 1..5 );
kono
parents:
diff changeset
232
kono
parents:
diff changeset
233 ARRX51 : TABOX51 ;
kono
parents:
diff changeset
234 ARRX52 : TABOX5( 5..9 );
kono
parents:
diff changeset
235
kono
parents:
diff changeset
236 BEGIN
kono
parents:
diff changeset
237
kono
parents:
diff changeset
238 -- INITIALIZATION OF RHS ARRAY:
kono
parents:
diff changeset
239
kono
parents:
diff changeset
240 FOR I IN 1..5 LOOP
kono
parents:
diff changeset
241 ARRX51( I ) := FALSE ; -- VALUES WILL BE: F T F F T
kono
parents:
diff changeset
242 END LOOP;
kono
parents:
diff changeset
243
kono
parents:
diff changeset
244 ARRX51(2) := TRUE ;
kono
parents:
diff changeset
245
kono
parents:
diff changeset
246 ARRX51(5) := TRUE ; -- RHS VALUES ARE: F T F F T
kono
parents:
diff changeset
247
kono
parents:
diff changeset
248
kono
parents:
diff changeset
249 -- INITIALIZATION OF LHS ARRAY:
kono
parents:
diff changeset
250
kono
parents:
diff changeset
251 FOR I IN 5..9 LOOP
kono
parents:
diff changeset
252 ARRX52( I ) := TRUE ; -- VALUES WILL BE: T F T T F
kono
parents:
diff changeset
253 END LOOP;
kono
parents:
diff changeset
254
kono
parents:
diff changeset
255 ARRX52(6) := FALSE ;
kono
parents:
diff changeset
256
kono
parents:
diff changeset
257 ARRX52(9) := FALSE ; -- LHS VALUES ARE: T F T T F
kono
parents:
diff changeset
258
kono
parents:
diff changeset
259
kono
parents:
diff changeset
260 -- NULL SLICE ASSIGNMENT:
kono
parents:
diff changeset
261
kono
parents:
diff changeset
262 ARRX52( 6..5 ) := ARRX51( 4..4 ) ;
kono
parents:
diff changeset
263 FAILED( "EXCEPTION NOT RAISED - SUBTEST 12" );
kono
parents:
diff changeset
264
kono
parents:
diff changeset
265 EXCEPTION
kono
parents:
diff changeset
266
kono
parents:
diff changeset
267 WHEN CONSTRAINT_ERROR =>
kono
parents:
diff changeset
268
kono
parents:
diff changeset
269 -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
kono
parents:
diff changeset
270 IF ARRX52( 5 ) /= TRUE OR
kono
parents:
diff changeset
271 ARRX52( 6 ) /= FALSE OR
kono
parents:
diff changeset
272 ARRX52( 7 ) /= TRUE OR
kono
parents:
diff changeset
273 ARRX52( 8 ) /= TRUE OR
kono
parents:
diff changeset
274 ARRX52( 9 ) /= FALSE
kono
parents:
diff changeset
275 THEN
kono
parents:
diff changeset
276 FAILED( "LHS ARRAY ALTERED (12)" );
kono
parents:
diff changeset
277 END IF;
kono
parents:
diff changeset
278
kono
parents:
diff changeset
279 WHEN OTHERS =>
kono
parents:
diff changeset
280
kono
parents:
diff changeset
281 FAILED( "WRONG EXCEPTION RAISED - SUBTEST 12" );
kono
parents:
diff changeset
282
kono
parents:
diff changeset
283 END ;
kono
parents:
diff changeset
284
kono
parents:
diff changeset
285
kono
parents:
diff changeset
286 -------------------------------------------------------------------
kono
parents:
diff changeset
287
kono
parents:
diff changeset
288
kono
parents:
diff changeset
289 RESULT ;
kono
parents:
diff changeset
290
kono
parents:
diff changeset
291
kono
parents:
diff changeset
292 END C52104F;