1-- C52104X.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-- 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 02/07/83
49-- EG  10/28/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
50--               AI-00387.
51-- JRK 06/24/86  FIXED COMMENTS ABOUT NUMERIC_ERROR/CONSTRAINT_ERROR.
52-- MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X INCOMPATIBILITY
53
54WITH REPORT;
55PROCEDURE  C52104X  IS
56
57     USE  REPORT ;
58
59BEGIN
60
61     TEST( "C52104X" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE " &
62                       "ASSIGNMENTS, THE LENGTHS MUST MATCH; ALSO " &
63                       "CHECK WHETHER CONSTRAINT_ERROR " &
64                       "OR STORAGE_ERROR ARE RAISED FOR LARGE ARRAYS");
65
66     -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
67     --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
68     --
69     --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
70     --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
71
72
73     -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
74     --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
75     --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
76     --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
77     --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
78     --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
79     --    INTEGER , CHARACTER , BOOLEAN .)
80
81
82     -------------------------------------------------------------------
83
84     --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
85     --        WERE DEFINED USING THE "BOX" SYMBOL
86     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
87     --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
88
89CONSTR_ERR:         -- THIS BLOCK CATCHES CONSTRAINT_ERROR
90                    -- FOR THE SUBTYPE DECLARATION.
91     BEGIN
92
93DCL_ARR:  DECLARE        -- THIS BLOCK DECLARES THE ARRAY SUBTYPE.
94
95               TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> )  OF BOOLEAN ;
96               PRAGMA PACK (TABOX5);
97
98               SUBTYPE  TABOX51  IS  TABOX5
99                             (IDENT_INT(-6)..IDENT_INT(INTEGER'LAST-4));
100               -- CONSTRAINT_ERROR MAY BE RAISED BY THIS
101               -- SUBTYPE DECLARATION.
102
103          BEGIN
104
105               COMMENT ("NO CONSTRAINT_ERROR FOR TYPE " &
106                        "WITH 'LENGTH = INTEGER'LAST + 3");
107
108OBJ_DCL:       DECLARE   -- THIS BLOCK DECLARES TWO BOOLEAN ARRAYS THAT
109                         -- HAVE INTEGER'LAST + 3 COMPONENTS;
110                         -- STORAGE_ERROR MAY BE RAISED.
111                    ARRX51  :  TABOX51 ;
112                    ARRX52  :  TABOX5
113                             (IDENT_INT(-2)..IDENT_INT( INTEGER'LAST));
114
115               BEGIN
116
117               COMMENT ("NO STORAGE_ERROR OR " &
118                        "CONSTRAINT_ERROR RAISED WHEN ALLOCATING TWO " &
119                        "BIG BOOLEAN ARRAYS");
120
121               -- INITIALIZATION OF LHS ARRAY:
122
123NO_EXCP:       BEGIN          -- NO EXCEPTION SHOULD OCCUR IN THIS BLOCK
124                    FOR  I  IN  IDENT_INT(-2)..IDENT_INT(9)  LOOP
125                         ARRX52( I )  :=  FALSE  ;
126                    END LOOP;
127
128
129               -- INITIALIZATION OF RHS ARRAY:
130
131               -- ONLY A SHORT INITIAL SEGMENT IS INITIALIZED,
132               -- SINCE A COMPLETE INITIALIZATION MIGHT TAKE TOO LONG
133               -- AND THE EXECUTION MIGHT BE ABORTED BEFORE THE LENGTH
134               -- COMPARISON OF THE ARRAY ASSIGNMENT IS ATTEMPTED.
135
136                    FOR  I  IN  IDENT_INT(-6)..IDENT_INT(5)  LOOP
137                         ARRX51( I )  :=  TRUE  ;
138                    END LOOP;
139
140               EXCEPTION
141
142                    WHEN CONSTRAINT_ERROR =>
143                         FAILED ("CONSTRAINT_ERROR RAISED WHEN " &
144                                 "ASSIGNING TO ARRAY COMPONENTS");
145                    WHEN OTHERS =>
146                         FAILED ("OTHER EXCEPTION RAISED - 1");
147
148               END NO_EXCP;
149
150DO_SLICE:      BEGIN
151               -- SLICE ASSIGNMENT:
152
153                    ARRX52( IDENT_INT(-1)..IDENT_INT(INTEGER'LAST  )) :=
154                         ARRX51(
155                            IDENT_INT(-4)..IDENT_INT(INTEGER'LAST-4) ) ;
156                    FAILED( "EXCEPTION NOT RAISED  (12)" );
157
158               EXCEPTION
159
160                    WHEN CONSTRAINT_ERROR =>
161
162                         COMMENT ("CONSTRAINT_ERROR RAISED DURING " &
163                                  "CHECK FOR SLICE ASSIGNMENT");
164
165                         -- CHECKING THE VALUES AFTER THE SLICE
166                         -- ASSIGNMENT:
167
168                         FOR  I  IN  IDENT_INT(-2)..IDENT_INT(9)  LOOP
169
170                              IF  ARRX52( I )  /=  FALSE
171                              THEN
172                                   FAILED( "LHS ARRAY ALTERED  (12A)");
173                              END IF;
174
175                         END LOOP;
176
177
178                    WHEN STORAGE_ERROR =>
179                         COMMENT ("STORAGE_ERROR RAISED DURING CHECK " &
180                                  "FOR SLICE ASSIGNMENT");
181
182                    WHEN OTHERS =>
183                         FAILED ("SOME EXCEPTION RAISED DURING SLICE");
184
185               END DO_SLICE;
186
187          END OBJ_DCL;
188
189          EXCEPTION
190
191               WHEN STORAGE_ERROR =>
192                    COMMENT ("STORAGE_ERROR RAISED WHEN DECLARING " &
193                             "TWO PACKED BOOLEAN ARRAYS WITH " &
194                             "INTEGER'LAST + 3 COMPONENTS");
195               WHEN CONSTRAINT_ERROR =>
196                    COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING " &
197                             "TWO PACKED BOOLEAN ARRAYS WITH " &
198                             "INTEGER'LAST + 3 COMPONENTS");
199               WHEN OTHERS =>
200                    FAILED ("SOME EXCEPTION RAISED - 3");
201
202          END DCL_ARR;
203
204     EXCEPTION
205
206
207          WHEN CONSTRAINT_ERROR =>
208               COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING AN " &
209                        "ARRAY SUBTYPE WITH INTEGER'LAST + 3 " &
210                        "COMPONENTS");
211
212          WHEN STORAGE_ERROR =>
213               FAILED ("STORAGE_ERROR RAISED FOR TYPE DECLARATION");
214
215          WHEN OTHERS =>
216               FAILED ("OTHER EXCEPTION RAISED - 4");
217
218     END CONSTR_ERR;
219
220     RESULT ;
221
222END C52104X;
223