1-- C52104F.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 ELSWEWHERE.)
31
32--    DIVISION  B : STATICALLY-DETERMINABLE NULL LENGTHS.
33
34
35-- RM 07/20/81
36-- SPS 10/27/82
37
38WITH REPORT;
39PROCEDURE  C52104F  IS
40
41     USE  REPORT ;
42
43BEGIN
44
45     TEST( "C52104F" , "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:  SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC
131     --                                            ARRAYS ONLY,
132     --                                            DIVISIONS C AND D .)
133     --
134     --
135     --    (-) THE DYNAMIC-ARRAY COUNTERPARTS OF THESE TESTS ARE IN DI-
136     --        VISIONS C (FOR NON-NULL ARRAYS) AND D (FOR NULL ARRAYS).
137     --
138     --
139
140
141     -------------------------------------------------------------------
142
143     --    (1 .. 6: NOT APPLICABLE)
144     --
145     --
146
147     -------------------------------------------------------------------
148
149     --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
150     --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
151     --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
152
153     DECLARE
154
155          TYPE  TABOX0  IS  ARRAY( INTEGER RANGE <> , INTEGER RANGE <>
156                                 )  OF INTEGER ;
157
158          SUBTYPE  TABOX01  IS  TABOX0( 1..1 ,  0..7  );
159          SUBTYPE  TABOX02  IS  TABOX0 ;
160
161          ARRX01  :  TABOX01 ;
162          ARRX02  :  TABOX02( 1..0 , 0..7 );
163
164     BEGIN
165
166          -- ARRAY ASSIGNMENT:
167
168          ARRX02 := ARRX01 ;
169          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 10" );
170
171     EXCEPTION
172
173          WHEN  CONSTRAINT_ERROR =>
174
175               NULL ;
176
177          WHEN  OTHERS  =>
178
179               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 10" );
180
181     END ;
182
183
184     -------------------------------------------------------------------
185
186     --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
187     --        WERE DEFINED USING THE "BOX" SYMBOL
188     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
189     --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
190
191     DECLARE
192
193          TYPE  TABOX1  IS  ARRAY( INTEGER RANGE <> )  OF INTEGER ;
194
195          SUBTYPE  TABOX11  IS  TABOX1( 4..5 ) ;
196
197          ARRX11  :  TABOX11 ;
198          ARRX12  :  TABOX1( 5..4 );
199
200     BEGIN
201
202          -- ARRAY ASSIGNMENT:
203
204          ARRX12 := ARRX11 ;
205          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 11" );
206
207     EXCEPTION
208
209          WHEN  CONSTRAINT_ERROR =>
210
211               NULL ;
212
213          WHEN  OTHERS  =>
214
215               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 11" );
216
217     END ;
218
219
220     -------------------------------------------------------------------
221
222     --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
223     --        WERE DEFINED USING THE "BOX" SYMBOL
224     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
225     --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
226
227     DECLARE
228
229          TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> )  OF BOOLEAN ;
230
231          SUBTYPE  TABOX51  IS  TABOX5( 1..5 );
232
233          ARRX51  :  TABOX51 ;
234          ARRX52  :  TABOX5( 5..9 );
235
236     BEGIN
237
238          -- INITIALIZATION OF RHS ARRAY:
239
240          FOR  I  IN  1..5  LOOP
241               ARRX51( I )  :=  FALSE  ; -- VALUES WILL BE:  F T F F T
242          END LOOP;
243
244          ARRX51(2) := TRUE ;
245
246          ARRX51(5) := TRUE ;            -- RHS VALUES ARE:  F T F F T
247
248
249          -- INITIALIZATION OF LHS ARRAY:
250
251          FOR  I  IN  5..9  LOOP
252               ARRX52( I )  :=  TRUE   ; -- VALUES WILL BE:  T F T T F
253          END LOOP;
254
255          ARRX52(6) := FALSE ;
256
257          ARRX52(9) := FALSE ;           -- LHS VALUES ARE:  T F T T F
258
259
260          -- NULL SLICE ASSIGNMENT:
261
262          ARRX52( 6..5 ) := ARRX51( 4..4 ) ;
263          FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 12" );
264
265     EXCEPTION
266
267          WHEN  CONSTRAINT_ERROR =>
268
269               -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
270               IF  ARRX52( 5 )  /=  TRUE   OR
271                   ARRX52( 6 )  /=  FALSE  OR
272                   ARRX52( 7 )  /=  TRUE   OR
273                   ARRX52( 8 )  /=  TRUE   OR
274                   ARRX52( 9 )  /=  FALSE
275               THEN
276                    FAILED( "LHS ARRAY ALTERED  (12)" );
277               END IF;
278
279          WHEN  OTHERS =>
280
281               FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 12" );
282
283     END ;
284
285
286     -------------------------------------------------------------------
287
288
289     RESULT ;
290
291
292END C52104F;
293