1-- C52104A.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 ATTEMPTED ASSIGNMENTS BETWEEN
27--    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
28--    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
29--    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
30--    ARE TREATED ELSEWHERE.)
31
32--    DIVISION  A : STATICALLY-DETERMINABLE NON-NULL LENGTHS.
33
34
35-- RM 07/20/81
36-- SPS 3/22/83
37
38WITH REPORT;
39PROCEDURE  C52104A  IS
40
41     USE  REPORT ;
42
43BEGIN
44
45     TEST( "C52104A" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
46                       " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
47
48
49     -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
50     --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
51     --
52     --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
53     --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
54
55
56     -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
57     --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
58     --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
59     --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
60     --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
61     --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
62     --    INTEGER , CHARACTER , BOOLEAN .)
63
64
65     -- CASES DISTINGUISHED:         ( 8 SELECTED CASES ARE IMPLEMENTED)
66     --
67     --                              ( THE 8 SELECTIONS ARE THE 5-CASE
68     --                                SERIES 10-11-12-13-14 FOLLOWED
69     --                                BY  7 , 8 , 9 (IN THIS ORDER). )
70     --
71     --
72     --                              ( EACH DIVISION COMPRISES 3 FILES,
73     --                                COVERING RESPECTIVELY THE FIRST
74     --                                3 , NEXT 2 , AND LAST 3 OF THE 8
75     --                                SELECTIONS FOR THE DIVISION.)
76     --
77     --
78     --    (1..6) (DO NOT APPLY TO NON-MATCHING OBJECTS, SINCE WE WANT
79     --        THE OBJECTS TO HAVE THE   S A M E   BASE TYPE.)
80     --
81     --
82     --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
83     --        THEMSELVES).
84     --
85     --
86     --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
87     --        STRING LITERALS.
88     --
89     --
90     --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
91     --        THEMSELVES).
92     --
93     --
94     --    (-) CONSTRAINABLE TYPES:  ONLY SUBTESTS   2,  3,  4,  5,  6
95     --        WILL BE REPLICATED  --  AS SUBTESTS  10, 11, 12, 13, 14 .
96     --
97     --
98     --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
99     --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
100     --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
101     --
102     --
103     --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
104     --        WERE DEFINED USING THE "BOX" SYMBOL
105     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
106     --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
107     --
108     --
109     --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
110     --        WERE DEFINED USING THE "BOX" SYMBOL
111     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
112     --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
113     --
114     --
115     --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
116     --        WERE DEFINED USING THE "BOX" SYMBOL
117     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
118     --
119     --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
120     --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
121     --        BY THE TYPEMARK WILL NOT BE  1 .)
122     --
123     --
124     --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
125     --        WERE DEFINED USING THE "BOX" SYMBOL
126     --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
127     --
128     --
129     --
130     --    (-) SPECIAL CASES:  NULL ARRAYS....... TREATED IN DIVISION B.
131     --                        SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC
132     --                                            ARRAYS ONLY,
133     --                                            DIVISIONS C AND D .)
134     --
135     --
136     --    (-) THE DYNAMIC-ARRAY COUNTERPARTS OF THESE TESTS ARE IN DI-
137     --        VISIONS C (FOR NON-NULL ARRAYS) AND D (FOR NULL ARRAYS).
138     --
139     --
140
141
142     -------------------------------------------------------------------
143
144     --    (1..6: NOT APPLICABLE)
145     --
146     --
147
148     -------------------------------------------------------------------
149
150     --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
151     --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
152     --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
153
154     DECLARE
155
156          TYPE  TABOX0  IS  ARRAY( INTEGER RANGE <> , INTEGER RANGE <>
157                                 )  OF INTEGER ;
158
159          SUBTYPE  TABOX01  IS  TABOX0( 1..5 ,  0..7  );
160          SUBTYPE  TABOX02  IS  TABOX0( 0..5 ,  2..9  );
161
162          ARRX01  :  TABOX01 ;
163          ARRX02  :  TABOX02 ;
164
165     BEGIN
166
167          -- INITIALIZATION OF RHS ARRAY:
168
169          FOR  I  IN  1..5  LOOP
170
171               FOR  J  IN  0..7  LOOP
172                    ARRX01( I , J )  :=   I * I * J  ;
173               END LOOP;
174
175          END LOOP;
176
177
178          -- INITIALIZATION OF LHS ARRAY:
179
180          FOR  I  IN  0..5  LOOP
181
182               FOR  J  IN  2..9  LOOP
183                    ARRX02( I , J )  :=   I * I * J * 3  ;
184               END LOOP;
185
186          END LOOP;
187
188
189          -- ARRAY ASSIGNMENT:
190
191          ARRX02 := ARRX01 ;
192          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 10" );
193
194     EXCEPTION
195
196          WHEN  CONSTRAINT_ERROR =>
197
198               -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
199
200               FOR  I  IN  0..5  LOOP
201
202                    FOR  J  IN  2..9  LOOP
203
204                         IF  ARRX02( I , J )  /=   I * I * J * 3
205                         THEN
206                              FAILED( "ORIG. VALUE ALTERED (10)" );
207                         END IF;
208
209                    END LOOP;
210
211               END LOOP;
212
213          WHEN  OTHERS  =>
214               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 10" );
215
216     END ;
217
218
219     -------------------------------------------------------------------
220
221     --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
222     --        WERE DEFINED USING THE "BOX" SYMBOL
223     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
224     --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
225
226     DECLARE
227
228          TYPE  TABOX1  IS  ARRAY( INTEGER RANGE <> )  OF INTEGER ;
229
230          SUBTYPE  TABOX11  IS  TABOX1( 1..5 ) ;
231
232          ARRX11  :  TABOX11 ;
233          ARRX12  :  TABOX1( 6..9 );
234
235     BEGIN
236
237          -- INITIALIZATION OF RHS ARRAY:
238
239          FOR  I  IN  1..5  LOOP
240
241               ARRX11( I )  :=   I * I  ;
242
243          END LOOP;
244
245
246          -- INITIALIZATION OF LHS ARRAY:
247
248          FOR  I  IN  6..9  LOOP
249               ARRX12( I )  :=   I * I * 3  ;
250          END LOOP;
251
252
253          -- ARRAY ASSIGNMENT:
254
255          ARRX12 := ARRX11 ;
256          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 11" );
257
258     EXCEPTION
259
260          WHEN  CONSTRAINT_ERROR =>
261
262               -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
263
264               FOR  I  IN  6..9  LOOP
265
266                    IF  ARRX12( I )  /=   I * I * 3
267                    THEN
268                         FAILED( "ORIG. VALUE ALTERED (11)" );
269                    END IF;
270
271               END LOOP;
272
273          WHEN  OTHERS  =>
274               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 11" );
275
276     END ;
277
278
279     -------------------------------------------------------------------
280
281     --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
282     --        WERE DEFINED USING THE "BOX" SYMBOL
283     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
284     --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
285
286     DECLARE
287
288          TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> )  OF BOOLEAN ;
289
290          SUBTYPE  TABOX51  IS  TABOX5( 1..5 );
291
292          ARRX51  :  TABOX51 ;
293          ARRX52  :  TABOX5( 5..9 );
294
295     BEGIN
296
297          -- INITIALIZATION OF LHS ARRAY:
298
299          FOR  I  IN  5..9  LOOP
300               ARRX52( I )  :=  FALSE  ;
301          END LOOP;
302
303
304          -- INITIALIZATION OF RHS ARRAY:
305
306          FOR  I  IN  1..5  LOOP
307               ARRX51( I )  :=  TRUE  ;
308          END LOOP;
309
310
311          -- SLICE ASSIGNMENT:
312
313          ARRX52(6..9) := ARRX51(3..3) ;
314          FAILED( "EXCEPTION NOT RAISED  (12)" );
315
316     EXCEPTION
317
318          WHEN CONSTRAINT_ERROR =>
319
320               -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
321
322               FOR  I  IN  5..9  LOOP
323
324                    IF  ARRX52( I )  /=  FALSE
325                    THEN
326                         FAILED( "LHS ARRAY ALTERED  ( 12 ) " );
327                    END IF;
328
329               END LOOP;
330
331          WHEN  OTHERS  =>
332               FAILED( "EXCEPTION RAISED  -  SUBTEST 12" );
333
334     END ;
335
336
337     -------------------------------------------------------------------
338
339
340     RESULT ;
341
342
343END C52104A;
344